diff --git a/GNUmakefile b/GNUmakefile index 07d8394a..1d1774e0 100644 --- a/GNUmakefile +++ b/GNUmakefile @@ -18,6 +18,7 @@ mes.h: mes.c GNUmakefile scm_name=$$(echo $$name | sed -e 's,_to_,->,' -e 's,_p$$,?,' -e 's,_x$$,!,' -e 's,^builtin_,,' -re 's,(.*)_$$,c:\1,' | sed \ -e 's,^divide$$,/,'\ -e 's,^is?$$,=,'\ + -e 's,^greater?$$,>,'\ -e 's,^less?$$,<,'\ -e 's,^minus$$,-,'\ -e 's,^multiply$$,*,'\ diff --git a/mes.c b/mes.c index 06a8c9a9..3c65c81f 100644 --- a/mes.c +++ b/mes.c @@ -988,6 +988,14 @@ hello_world () return &scm_unspecified; } +scm * +greater_p (scm *a, scm *b) +{ + assert (a->type == NUMBER); + assert (b->type == NUMBER); + return a->value > b->value ? &scm_t : &scm_f; +} + scm * less_p (scm *a, scm *b) { @@ -1123,9 +1131,9 @@ mes_environment () } scm * -define_lambda (scm *x) +make_lambda (scm *args, scm *body) { - return cons (caadr (x), cons (&scm_lambda, cons (cdadr (x), cddr (x)))); + return cons (&scm_lambda, cons (args, body)); } scm * @@ -1133,17 +1141,26 @@ define (scm *x, scm *a) { if (atom_p (cadr (x)) != &scm_f) return cons (cadr (x), eval (caddr (x), a)); - return define_lambda (x); + return cons (caadr (x), make_lambda (cdadr (x), cddr (x))); } scm * define_macro (scm *x, scm *a) { #if DEBUG - printf ("\nc:define_macro a="); + scm *name = caadr (x); + scm *args = cdadr (x); + scm *body = cddr (x); + printf ("\nc:define_macro name="); + display (name); + printf (" args="); + display (args); + printf (" body="); + display (body); + printf ("\nmacro="); scm *aa =cons (&scm_macro, - cons (define_lambda (x), - cdr (assq (&scm_macro, a)))); + cons (cons (name, make_lambda (args, body)), + cdr (assq (&scm_macro, a)))); display (aa); puts (""); #endif @@ -1152,7 +1169,7 @@ define_macro (scm *x, scm *a) cons (cons (cadr (x), eval (caddr (x), a)), cdr (assq (&scm_macro, a)))); return cons (&scm_macro, - cons (define_lambda (x), + cons (cons (caadr(x), make_lambda (cdadr (x), cddr (x))), cdr (assq (&scm_macro, a)))); } diff --git a/scm.mes b/scm.mes index 1dea3eba..3a3ee57b 100755 --- a/scm.mes +++ b/scm.mes @@ -38,13 +38,11 @@ (#t (memq x (cdr lst))))) (define memv memq) -(define-macro (and x y) - (cond (x y) - (#t #f))) - (define-macro (or x y) - (cond (x x) - (#t y))) + (list 'cond (list x x) (list #t y))) + +(define-macro (and x y) + (list 'cond (list x y) (list #t #f))) (define (split-params bindings params) (cond ((null? bindings) params) @@ -82,12 +80,19 @@ (cond (x #f) (#t #t))) -(define-macro (if expr then . else) - (cond ((not (eq? (c:eval expr (current-module)) #f)) - then) - (#t - (cond ((pair? else) (car else)) - (#t *unspecified*))))) +(define-macro (if expr then else) + (list 'cond + (list expr then) + (list #t else))) + +;;TODO +(define-macro (iif expr then . else) + (list 'cond + (list expr then) + (list #t + (list 'cond + (list (list 'pair? else) (list 'car else)) + (list #t '*unspecified*))))) (define (unspecified-bindings bindings params) (cond ((null? bindings) params) diff --git a/test.mes b/test.mes index e1769c3b..2f6f7a34 100644 --- a/test.mes +++ b/test.mes @@ -137,7 +137,7 @@ (display (= 3 '3)) (newline) -(display (if #t 'true)) +(display (if #t 'true 'FIXME)) (newline) (display (if (eq? 0 '0) 'true 'false)) (newline)