update macro, fix andmap.

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$$,*,'\

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,16 +1141,25 @@ 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),
+                 cons (cons (name, make_lambda (args, body)),
                        cdr (assq (&scm_macro, a))));
   display (aa);
   puts ("");
@@ -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))));
 }
 

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)
+  (list 'cond (list x x) (list #t y)))
-        (#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)
+(define-macro (if expr then else)
-  (cond ((not (eq? (c:eval expr (current-module)) #f))
+  (list 'cond
-         then)
+        (list expr then)
-        (#t
+        (list #t else)))
-         (cond ((pair? else) (car else))
+
-               (#t *unspecified*)))))
+;;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)

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)