From 02dc00d11c81ccf6029cc7bafbab66b5dbf6ccf7 Mon Sep 17 00:00:00 2001
From: Jan Nieuwenhuizen <janneke@gnu.org>
Date: Sat, 16 Jul 2016 13:24:38 +0200
Subject: [PATCH] update macro, fix andmap.

---
 GNUmakefile |  1 +
 mes.c       | 31 ++++++++++++++++++++++++-------
 scm.mes     | 29 +++++++++++++++++------------
 test.mes    |  2 +-
 4 files changed, 43 insertions(+), 20 deletions(-)

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)