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