artemist/mes
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

mes.c: move define, define-macro into begin_env, remove loop. fixes inner defines.

Browse source
This commit is contained in:
Jan Nieuwenhuizen 2016-07-16 22:43:13 +02:00
parent 21a5e16a88
commit d1a089caed
2 changed files with 41 additions and 43 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
loop2.mes
View file

@ -50,4 +50,4 @@
(loop2 (set-cdr! (assq (cadr e) a) (eval (caddr e) a)) (readenv a) a)) (loop2 (set-cdr! (assq (cadr e) a) (eval (caddr e) a)) (readenv a) a))
(#t (loop2 (eval e a) (readenv a) a)))) (#t (loop2 (eval e a) (readenv a) a))))
EOF 'EOF

82
mes.c
View file

@ -35,12 +35,10 @@
#define DEBUG 0 #define DEBUG 0
#define BOOT 1
#define MACROS 1 #define MACROS 1
#define QUASIQUOTE 1 #define QUASIQUOTE 1
#ifndef QUOTE_SUGAR
#define QUOTE_SUGAR 1 #define QUOTE_SUGAR 1
#endif
enum type {CHAR, NUMBER, PAIR, STRING, SYMBOL, VALUES, VECTOR, enum type {CHAR, NUMBER, PAIR, STRING, SYMBOL, VALUES, VECTOR,
FUNCTION0, FUNCTION1, FUNCTION2, FUNCTION3, FUNCTIONn}; FUNCTION0, FUNCTION1, FUNCTION2, FUNCTION3, FUNCTIONn};
@ -293,16 +291,6 @@ apply_env_ (scm *fn, scm *x, scm *a)
return &scm_unspecified; return &scm_unspecified;
} }
scm *
begin_env (scm *body, scm *a)
{
if (body == &scm_nil) return &scm_unspecified;
scm *result = eval (car (body), a);
if (cdr (body) == &scm_nil)
return result;
return begin_env (cdr (body), a);
}
scm * scm *
eval_ (scm *e, scm *a) eval_ (scm *e, scm *a)
{ {
@ -1200,42 +1188,43 @@ define_macro (scm *x, scm *a)
} }
scm * scm *
loop (scm *r, scm *e, scm *a) begin_env (scm *body, scm *a)
{ {
#if 0//DEBUG if (body == &scm_nil) return &scm_unspecified;
printf ("\nc:loop e="); scm *e = car (body);
#if DEBUG
printf ("\nc:begin_env e=");
display (e); display (e);
puts (""); puts ("");
#endif #endif
if (e == &scm_nil) if (e->type == PAIR) {
return r; if (eq_p (car (e), &scm_symbol_define) == &scm_t)
else if (eq_p (e, &scm_symbol_EOF) == &scm_t) return begin_env (cdr (body), cons (define (e, a), a));
return apply_env (cdr (assq (&scm_symbol_loop2, a)), else if (eq_p (car (e), &scm_symbol_define_macro) == &scm_t)
cons (&scm_unspecified, cons (&scm_t, cons (a, &scm_nil))), a); return begin_env (cdr (body), cons (define_macro (e, a), a));
else if (eq_p (e, &scm_symbol_EOF2) == &scm_t) else if (eq_p (car (e), &scm_symbol_set_x) == &scm_t) {
return r; set_env_x (cadr (e), eval (caddr (e), a), a);
else if (atom_p (e) == &scm_t) return begin_env (cdr (e), a);
return loop (eval (e, a), readenv (a), a); }
else if (eq_p (car (e), &scm_symbol_define) == &scm_t) #if BOOT
return loop (&scm_unspecified, else if (eq_p (e, &scm_symbol_EOF) == &scm_t)
readenv (a), return apply_env (cdr (assq (&scm_symbol_loop2, a)),
cons (define (e, a), a)); cons (&scm_unspecified, cons (&scm_t, cons (a, &scm_nil))), a);
else if (eq_p (car (e), &scm_symbol_define_macro) == &scm_t) else if (eq_p (e, &scm_symbol_EOF2) == &scm_t)
return loop (&scm_unspecified, return make_symbol ("exit boot");
readenv (a), #endif
cons (define_macro (e, a), a)); }
else if (eq_p (car (e), &scm_symbol_set_x) == &scm_t) scm *result = eval (e, a);
return loop (set_env_x (cadr (e), eval (caddr (e), a), a), readenv (a), a); if (cdr (body) == &scm_nil)
return loop (eval (e, a), readenv (a), a); return result;
return begin_env (cdr (body), a);
} }
int scm *
main (int argc, char *argv[]) read_file (scm *e, scm *a)
{ {
scm *a = mes_environment (); if (e == &scm_nil) return e;
display (loop (&scm_unspecified, readenv (a), a)); return cons (e, read_file (readenv (a), a));
newline ();
return 0;
} }
scm * scm *
@ -1275,3 +1264,12 @@ eval (scm *e, scm *a)
evalling_p = false; evalling_p = false;
return r; return r;
} }
int
main (int argc, char *argv[])
{
scm *a = mes_environment ();
display (begin_env (read_file (readenv (a), a), a));
newline ();
return 0;
}