5 #include <boost/variant.hpp>
6 #include <boost/function.hpp>
7 #include <boost/shared_ptr.hpp>
12 std::string
name(boost::shared_ptr
<lisp::object
> token
) {
13 return boost::get
<lisp::atom
>(*token
).name
;
16 boost::shared_ptr
<lisp::object
>& car(boost::shared_ptr
<lisp::object
> x
) {
18 return boost::get
<lisp::cons
>(*(boost::static_pointer_cast
<lisp::base_object
, lisp::object
>(x
))).car
;
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
;
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
)));
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
)));
35 void append(boost::shared_ptr
<lisp::object
> list
, boost::shared_ptr
<lisp::object
> obj
) {
36 boost::shared_ptr
<lisp::object
> ptr
;
38 while (cdr(ptr
) != NULL
) {
41 cdr(ptr
) = boost::shared_ptr
<lisp::object
>(make_cons(obj
, boost::shared_ptr
<lisp::object
>()));
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
));
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
));
54 boost::shared_ptr
<lisp::object
> fn_quote(boost::shared_ptr
<lisp::object
> args
,
55 boost::shared_ptr
<lisp::object
> env
) {
59 boost::shared_ptr
<lisp::object
> fn_cons(boost::shared_ptr
<lisp::object
> args
,
60 boost::shared_ptr
<lisp::object
> env
) {
62 boost::shared_ptr
<lisp::object
> list
= make_cons(car(args
), boost::shared_ptr
<lisp::object
>());
63 args
= car(cdr(args
));
65 while ((args
!= NULL
) && (args
->which() == lisp::e_CONS
)) {
66 append(list
, car(args
));
72 boost::shared_ptr
<lisp::object
> tee
;
73 boost::shared_ptr
<lisp::object
> nil
;
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
))
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
)
92 boost::shared_ptr
<lisp::object
> eval(boost::shared_ptr
<lisp::object
> args
,
93 boost::shared_ptr
<lisp::object
> env
);
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
));
103 return eval(ret
,env
);
111 boost::shared_ptr
<lisp::object
> interleave (boost::shared_ptr
<lisp::object
> c1
,
112 boost::shared_ptr
<lisp::object
> c2
) {
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
);
119 while ((c1
!= NULL
) && (c1
->which() == lisp::e_CONS
)) {
120 append(list
,make_cons(car(c1
),make_cons(car(c2
), nul
)));
128 boost::shared_ptr
<lisp::object
> replace_atom(boost::shared_ptr
<lisp::object
> sexp
,
129 boost::shared_ptr
<lisp::object
> with
) {
131 boost::shared_ptr
<lisp::object
> nul
;
133 if(sexp
->which() == lisp::e_CONS
) {
135 boost::shared_ptr
<lisp::object
> list
= make_cons(replace_atom(car(sexp
), with
), nul
);
138 while ((sexp
!= NULL
) && (sexp
->which() ==lisp:: e_CONS
)) {
139 append(list
,replace_atom(car(sexp
), with
));
146 boost::shared_ptr
<lisp::object
> tmp
= with
;
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
));
153 if (name(atom
) == name(sexp
))
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
);
168 lisp::lambda
& lambda_object(boost::get
<lisp::lambda
>(*(boost::static_pointer_cast
<lisp::base_object
, lisp::object
>(lambda
))));
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
);
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
;
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
)),
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
;
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
));
204 // I.O. I.O. It's off to port we go..
206 void print(std::ostream
& out
, boost::shared_ptr
<lisp::object
> sexp
) {
210 if(sexp
->which() == lisp::e_CONS
) {
212 print(out
, car(sexp
));
214 while ((sexp
!= NULL
) && (sexp
->which() == lisp::e_CONS
)) {
216 print(out
, car(sexp
));
220 } else if (sexp
->which() == lisp::e_ATOM
) {
222 } else if (sexp
->which() == lisp::e_LAMBDA
) {
224 out
<< (boost::get
<lisp::lambda
>(*sexp
)).args
;
225 out
<< (boost::get
<lisp::lambda
>(*sexp
)).sexp
;
231 boost::shared_ptr
<lisp::object
> next_token(std::istream
& in
) {
237 } while (isspace(c
));
238 // process first char
240 // if it is a paren, look no further
241 if ((c
== ')') || ( c
== '(')) {
244 // otherwise collect an atom
248 } while ((!isspace(c
)) && (c
!= ')'));
251 return boost::shared_ptr
<lisp::object
>(new lisp::object(tok
));
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
);
263 boost::shared_ptr
<lisp::object
> car
= token
;
264 boost::shared_ptr
<lisp::object
> cdr
= read_tail(in
);
265 return make_cons(car
, cdr
);
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
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
);
285 boost::shared_ptr
<lisp::object
> init_env() {
287 boost::shared_ptr
<lisp::object
> nul
;
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(lisp::func(fn_quote
)));
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(lisp::func(fn_car
)));
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(lisp::func(fn_cdr
)));
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(lisp::func(fn_cons
)));
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(lisp::func(fn_equal
)));
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(lisp::func(fn_atom
)));
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(lisp::func(fn_cond
)));
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(lisp::func(fn_lambda
)));
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(lisp::func(fn_label
)));
317 boost::shared_ptr
<lisp::object
> env
= make_cons(make_cons(a_quote
,make_cons(f_quote
,nul
)),nul
);
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
)));
329 boost::shared_ptr
<lisp::object
> a_tee(new lisp::object(std::string("#T")));
331 nil
= make_cons(nul
,nul
);
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
);
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
);
349 boost::shared_ptr
<lisp::object
> eval(boost::shared_ptr
<lisp::object
> sexp
, boost::shared_ptr
<lisp::object
> env
) {
351 boost::shared_ptr
<lisp::object
> nul
;
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
);
362 boost::shared_ptr
<lisp::object
> accum
= make_cons(eval(car(sexp
),env
), nul
);
365 while ((sexp
!= NULL
) && (sexp
->which() == lisp::e_CONS
)) {
366 append(accum
,eval(car(sexp
),env
));
369 return eval_fn(accum
,env
);
372 boost::shared_ptr
<lisp::object
> val
= lookup(name(sexp
),env
);
384 int main(int argc
, char *argv
[]) {
385 boost::shared_ptr
<lisp::object
> env
= init_env();
386 //std::istream& in(std::cin);
388 std::ostream
& out(std::cout
);
389 inf
.open(argv
[1], std::ifstream::in
);
394 print(out
, eval(read(inf
), env
));
396 } while (inf
.good());