lisp.cpp

   1
   2 #include <cctype>
   3 #include <iostream>
   4 #include <fstream>
   5 #include <boost/variant.hpp>
   6 #include <boost/function.hpp>
   7 #include <boost/shared_ptr.hpp>
   8
   9 #include "lisp.h"
  10
  11
  12 std::string name(boost::shared_ptr<lisp::object> token) {
  13         return boost::get<lisp::atom>(*token).name;
  14 };
  15
  16 boost::shared_ptr<lisp::object>& car(boost::shared_ptr<lisp::object> x)  {
  17
  18         return boost::get<lisp::cons>(*(boost::static_pointer_cast<lisp::base_object, lisp::object>(x))).car;
  19 }
  20
  21 boost::shared_ptr<lisp::object>& cdr(boost::shared_ptr<lisp::object> x)  {
  22         return boost::get<lisp::cons>(*(boost::static_pointer_cast<lisp::base_object, lisp::object>(x))).cdr;
  23 }
  24
  25 boost::shared_ptr<lisp::object> make_cons(boost::shared_ptr<lisp::object> car,
  26         boost::shared_ptr<lisp::object> cdr) {
  27         return boost::shared_ptr<lisp::object>(new lisp::object(lisp::cons(car, cdr)));
  28 }
  29
  30 boost::shared_ptr<lisp::object> make_lambda(boost::shared_ptr<lisp::object> args,
  31         boost::shared_ptr<lisp::object> sexp) {
  32         return boost::shared_ptr<lisp::object>(new lisp::object(lisp::lambda(args, sexp)));
  33 }
  34
  35 void append(boost::shared_ptr<lisp::object> list, boost::shared_ptr<lisp::object> obj) {
  36         boost::shared_ptr<lisp::object> ptr;
  37         ptr = list;
  38         while (cdr(ptr) != NULL) {
  39                 ptr = cdr(ptr);
  40         }
  41         cdr(ptr) = boost::shared_ptr<lisp::object>(make_cons(obj, boost::shared_ptr<lisp::object>()));
  42 }
  43
  44 boost::shared_ptr<lisp::object> fn_car(boost::shared_ptr<lisp::object> args,
  45                                        boost::shared_ptr<lisp::object> env) {
  46         return car(car(args));
  47 }
  48
  49 boost::shared_ptr<lisp::object> fn_cdr(boost::shared_ptr<lisp::object> args,
  50                                        boost::shared_ptr<lisp::object> env) {
  51         return cdr(car(args));
  52 }
  53
  54 boost::shared_ptr<lisp::object> fn_quote(boost::shared_ptr<lisp::object> args,
  55         boost::shared_ptr<lisp::object> env) {
  56         return car(args);
  57 }
  58
  59 boost::shared_ptr<lisp::object> fn_cons(boost::shared_ptr<lisp::object> args,
  60                                         boost::shared_ptr<lisp::object> env) {
  61
  62         boost::shared_ptr<lisp::object> list = make_cons(car(args), boost::shared_ptr<lisp::object>());
  63         args = car(cdr(args));
  64
  65         while ((args != NULL) && (args->which() == lisp::e_CONS)) {
  66                 append(list, car(args));
  67                 args = cdr(args);
  68         }
  69         return list;
  70 }
  71
  72 boost::shared_ptr<lisp::object> tee;
  73 boost::shared_ptr<lisp::object> nil;
  74
  75 boost::shared_ptr<lisp::object>  fn_equal(boost::shared_ptr<lisp::object> args,
  76         boost::shared_ptr<lisp::object> env) {
  77         boost::shared_ptr<lisp::object> first = car(args);
  78         boost::shared_ptr<lisp::object> second = car(cdr(args));
  79         if (name(first) == name(second))
  80                 return tee;
  81         else
  82                 return nil;
  83 }
  84
  85 boost::shared_ptr<lisp::object> fn_atom(boost::shared_ptr<lisp::object> args, boost::shared_ptr<lisp::object> env) {
  86         if(car(args)->which() == lisp::e_ATOM)
  87                 return tee;
  88         else
  89                 return nil;
  90 }
  91
  92 boost::shared_ptr<lisp::object> eval(boost::shared_ptr<lisp::object> args,
  93                                      boost::shared_ptr<lisp::object> env);
  94
  95 boost::shared_ptr<lisp::object> fn_cond(boost::shared_ptr<lisp::object> args,
  96                                         boost::shared_ptr<lisp::object> env) {
  97         while ((args != NULL) && (args->which() == lisp::e_CONS)) {
  98                 boost::shared_ptr<lisp::object> list = car(args);
  99                 boost::shared_ptr<lisp::object> pred = eval(car(list), env);
 100                 boost::shared_ptr<lisp::object> ret = car(cdr(list));
 101
 102                 if(pred != nil)
 103                         return eval(ret,env);
 104
 105                 args = cdr(args);
 106         }
 107
 108         return nil;
 109 }
 110
 111 boost::shared_ptr<lisp::object> interleave (boost::shared_ptr<lisp::object>     c1,
 112         boost::shared_ptr<lisp::object> c2) {
 113
 114         boost::shared_ptr<lisp::object> nul;
 115         boost::shared_ptr<lisp::object> list = make_cons(make_cons(car(c1),make_cons(car(c2),nul)),nul);
 116         c1 = cdr(c1);
 117         c2 = cdr(c2);
 118
 119         while ((c1 != NULL) && (c1->which() == lisp::e_CONS)) {
 120                 append(list,make_cons(car(c1),make_cons(car(c2), nul)));
 121                 c1 = cdr(c1);
 122                 c2 = cdr(c2);
 123         }
 124
 125         return list;
 126 }
 127
 128 boost::shared_ptr<lisp::object> replace_atom(boost::shared_ptr<lisp::object> sexp,
 129         boost::shared_ptr<lisp::object> with)  {
 130
 131         boost::shared_ptr<lisp::object> nul;
 132
 133         if(sexp->which() == lisp::e_CONS) {
 134
 135                 boost::shared_ptr<lisp::object> list = make_cons(replace_atom(car(sexp), with), nul);
 136                 sexp = cdr(sexp);
 137
 138                 while ((sexp != NULL) && (sexp->which() ==lisp:: e_CONS)) {
 139                         append(list,replace_atom(car(sexp), with));
 140                         sexp = cdr(sexp);
 141                 }
 142
 143                 return list;
 144
 145         } else {
 146                 boost::shared_ptr<lisp::object> tmp = with;
 147
 148                 while ((tmp != NULL) && (tmp->which() == lisp::e_CONS)) {
 149                         boost::shared_ptr<lisp::object> item = car(tmp);
 150                         boost::shared_ptr<lisp::object> atom = car(item);
 151                         boost::shared_ptr<lisp::object> replacement = car(cdr(item));
 152
 153                         if (name(atom) == name(sexp))
 154                                 return replacement;
 155
 156                         tmp = cdr(tmp);
 157                 }
 158
 159                 return sexp;
 160         }
 161 }
 162
 163 boost::shared_ptr<lisp::object> fn_lambda (boost::shared_ptr<lisp::object>args,
 164         boost::shared_ptr<lisp::object>env) {
 165         boost::shared_ptr<lisp::object> lambda = car(args);
 166         args = cdr(args);
 167
 168         lisp::lambda& lambda_object(boost::get<lisp::lambda>(*(boost::static_pointer_cast<lisp::base_object, lisp::object>(lambda))));
 169
 170         boost::shared_ptr<lisp::object> list = interleave(lambda_object.args, args);
 171         boost::shared_ptr<lisp::object> sexp = replace_atom(lambda_object.sexp,list);
 172         return eval(sexp,env);
 173 }
 174
 175 boost::shared_ptr<lisp::object> fn_label (boost::shared_ptr<lisp::object> args,
 176         boost::shared_ptr<lisp::object> env) {
 177         boost::shared_ptr<lisp::object> nul;
 178
 179         std::string n(name(car(args)));
 180         boost::shared_ptr<lisp::object> a(new lisp::object(n));
 181         append(env, make_cons(a,
 182                               make_cons(car(cdr(args)),
 183                                         nul)));
 184         return tee;
 185 }
 186
 187 boost::shared_ptr<lisp::object> lookup(const std::string& n,
 188                                        boost::shared_ptr<lisp::object> env) {
 189         boost::shared_ptr<lisp::object> nul;
 190         boost::shared_ptr<lisp::object>tmp = env;
 191
 192         while ((tmp != nul) && (tmp->which()) == lisp::e_CONS) {
 193                 boost::shared_ptr<lisp::object> item = car(tmp);
 194                 boost::shared_ptr<lisp::object> nm   = car(item);
 195                 boost::shared_ptr<lisp::object> val  = car(cdr(item));
 196
 197                 if (name(nm) == n)
 198                         return val;
 199                 tmp = cdr(tmp);
 200         }
 201         return nul;
 202 }
 203
 204 // I.O. I.O. It's off to port we go..
 205
 206 void print(std::ostream& out, boost::shared_ptr<lisp::object> sexp) {
 207
 208         if(sexp == NULL)
 209                 return;
 210         if(sexp->which() == lisp::e_CONS) {
 211                 out.put('(');
 212                 print(out, car(sexp));
 213                 sexp = cdr(sexp);
 214                 while ((sexp != NULL) && (sexp->which() == lisp::e_CONS)) {
 215                         out.put(' ');
 216                         print(out, car(sexp));
 217                         sexp = cdr(sexp);
 218                 }
 219                 out.put(')');
 220         } else if (sexp->which() == lisp::e_ATOM) {
 221                 out << name(sexp);
 222         } else if (sexp->which() == lisp::e_LAMBDA) {
 223                 out.put('#');
 224                 out << (boost::get<lisp::lambda>(*sexp)).args;
 225                 out << (boost::get<lisp::lambda>(*sexp)).sexp;
 226         } else
 227                 printf ("Error.");
 228 }
 229
 230
 231 boost::shared_ptr<lisp::object> next_token(std::istream& in) {
 232         char c;
 233
 234         // skip whitespace
 235         do {
 236                 c = in.get();
 237         } while (isspace(c));
 238         // process first char
 239         std::string tok;
 240         // if it is a paren, look no further
 241         if ((c == ')') || ( c== '(')) {
 242                 tok.push_back(c);
 243         } else {
 244                 // otherwise collect an atom
 245                 do {
 246                         tok.push_back(c);
 247                         c = in.get();
 248                 } while ((!isspace(c)) && (c != ')'));
 249                 in.unget();
 250         }
 251         return boost::shared_ptr<lisp::object>(new lisp::object(tok));
 252 }
 253
 254 boost::shared_ptr<lisp::object> read_tail(std::istream& in) {
 255         boost::shared_ptr<lisp::object> token(next_token(in));
 256         if (name(token) == ")")
 257                 return boost::shared_ptr<lisp::object>();
 258         else if (name(token) == "(") {
 259                 boost::shared_ptr<lisp::object> car = read_tail(in);
 260                 boost::shared_ptr<lisp::object> cdr = read_tail(in);
 261                 return make_cons(car, cdr);
 262         } else {
 263                 boost::shared_ptr<lisp::object> car = token;
 264                 boost::shared_ptr<lisp::object> cdr = read_tail(in);
 265                 return make_cons(car, cdr);
 266         }
 267 };
 268
 269 /* read gets the next token from the file, if it is a left parentheses
 270  * it calls read_tail to parse the rest of the list, otherwise returns
 271  * the token read. A list (LIST e1 ... en) is defined for each n to be
 272  * (CONS e1 (CONS ... (CONS en NIL))) so read_tail will keep calling
 273  * itself concatenating cons cells until it hits a right
 274  * parentheses. */
 275
 276 boost::shared_ptr<lisp::object> read(std::istream& in) {
 277         boost::shared_ptr<lisp::object> token = next_token(in);
 278         if (name(token) == "(")
 279                 return read_tail(in);
 280         return token;
 281 }
 282
 283
 284
 285 boost::shared_ptr<lisp::object> init_env() {
 286
 287         boost::shared_ptr<lisp::object> nul;
 288
 289         boost::shared_ptr<lisp::object> a_quote(new lisp::object(std::string("QUOTE")));
 290         boost::shared_ptr<lisp::object> f_quote(new lisp::object(fn_quote));
 291
 292         boost::shared_ptr<lisp::object> a_car(new lisp::object(std::string("CAR")));
 293         boost::shared_ptr<lisp::object> f_car(new lisp::object(fn_car));
 294
 295         boost::shared_ptr<lisp::object> a_cdr(new lisp::object(std::string("CDR")));
 296         boost::shared_ptr<lisp::object> f_cdr(new lisp::object(fn_cdr));
 297
 298         boost::shared_ptr<lisp::object> a_cons(new lisp::object(std::string("CONS")));
 299         boost::shared_ptr<lisp::object> f_cons(new lisp::object(fn_cons));
 300
 301         boost::shared_ptr<lisp::object> a_equal(new lisp::object(std::string("EQUAL")));
 302         boost::shared_ptr<lisp::object> f_equal(new lisp::object(fn_equal));
 303
 304         boost::shared_ptr<lisp::object> a_atom(new lisp::object(std::string("ATOM")));
 305         boost::shared_ptr<lisp::object> f_atom(new lisp::object(fn_atom));
 306
 307         boost::shared_ptr<lisp::object> a_cond(new lisp::object(std::string("COND")));
 308         boost::shared_ptr<lisp::object> f_cond(new lisp::object(fn_cond));
 309
 310         boost::shared_ptr<lisp::object> a_lambda(new lisp::object(std::string("LAMBDA")));
 311         boost::shared_ptr<lisp::object> f_lambda(new lisp::object(fn_lambda));
 312
 313         boost::shared_ptr<lisp::object> a_label(new lisp::object(std::string("LABEL")));
 314         boost::shared_ptr<lisp::object> f_label(new lisp::object(fn_label));
 315
 316
 317         boost::shared_ptr<lisp::object> env = make_cons(make_cons(a_quote,make_cons(f_quote,nul)),nul);
 318
 319
 320         append(env,make_cons(a_car,       make_cons(f_car,nul)));
 321         append(env,make_cons(a_cdr,       make_cons(f_cdr,nul)));
 322         append(env,make_cons(a_cons,  make_cons(f_cons,nul)));
 323         append(env,make_cons(a_equal, make_cons(f_equal,nul)));
 324         append(env,make_cons(a_atom,  make_cons(f_atom,nul)));
 325         append(env,make_cons(a_cond,  make_cons(f_cond,nul)));
 326         append(env,make_cons(a_lambda, make_cons(f_lambda,nul)));
 327         append(env,make_cons(a_label,  make_cons(f_label,nul)));
 328
 329         boost::shared_ptr<lisp::object> a_tee(new lisp::object(std::string("#T")));
 330         tee = a_tee;
 331         nil = make_cons(nul,nul);
 332
 333         return env;
 334 }
 335
 336
 337 boost::shared_ptr<lisp::object> eval_fn (boost::shared_ptr<lisp::object> sexp, boost::shared_ptr<lisp::object> env) {
 338         boost::shared_ptr<lisp::object> symbol = car(sexp);
 339         boost::shared_ptr<lisp::object> args = cdr(sexp);
 340
 341         if (symbol->which() == lisp::e_LAMBDA)
 342                 return fn_lambda(sexp,env);
 343         else if(symbol->which() == lisp::e_FUNC)
 344                 return ((boost::get<lisp::func>(*symbol)).fn)(args, env);
 345         else
 346                 return sexp;
 347 }
 348
 349 boost::shared_ptr<lisp::object> eval(boost::shared_ptr<lisp::object> sexp, boost::shared_ptr<lisp::object> env) {
 350
 351         boost::shared_ptr<lisp::object> nul;
 352
 353         if(sexp == NULL)
 354                 return nil;
 355
 356         if (sexp->which() == lisp::e_CONS) {
 357                 if ((car(sexp)->which() == lisp::e_ATOM) && (name(car(sexp)) == "LAMBDA")) {
 358                         boost::shared_ptr<lisp::object> largs = car(cdr(sexp));
 359                         boost::shared_ptr<lisp::object> lsexp = car(cdr(cdr(sexp)));
 360                         return make_lambda(largs,lsexp);
 361                 } else {
 362                         boost::shared_ptr<lisp::object> accum = make_cons(eval(car(sexp),env), nul);
 363                         sexp = cdr(sexp);
 364
 365                         while ((sexp != NULL) && (sexp->which() == lisp::e_CONS)) {
 366                                 append(accum,eval(car(sexp),env));
 367                                 sexp = cdr(sexp);
 368                         }
 369                         return eval_fn(accum,env);
 370                 }
 371         } else {
 372                 boost::shared_ptr<lisp::object> val = lookup(name(sexp),env);
 373                 if (val == NULL)
 374                         return sexp;
 375                 else
 376                         return val;
 377         }
 378 }
 379
 380
 381 //
 382 // REPL
 383 //
 384 int main(int argc, char *argv[]) {
 385         boost::shared_ptr<lisp::object> env = init_env();
 386         //std::istream& in(std::cin);
 387         std::ifstream inf;
 388         std::ostream& out(std::cout);
 389         inf.open(argv[1], std::ifstream::in);
 390         if (inf.good()) {
 391                 do {
 392                         out.put('>');
 393                         out.put(' ');
 394                         print(out, eval(read(inf), env));
 395                         out << std::endl;
 396                 } while (inf.good());
 397         }
 398         inf.close();
 399         return 0;
 400 }