Remove evcon from loop-0.
authorJan Nieuwenhuizen <janneke@gnu.org>
Tue, 18 Oct 2016 17:50:07 +0000 (19:50 +0200)
committerJan Nieuwenhuizen <janneke@gnu.org>
Tue, 18 Oct 2016 17:50:07 +0000 (19:50 +0200)
* module/mes/loop-0.mes (loop-0): Handle define-macro.
 (cond): New macro.
 (eval-env-expand): Remove 'cond clause.
 (evcon): Remove.

module/mes/loop-0.mes

index 28977fe6efd63449b2f65bdece2f5cf1b24ba7c5..0b548fe695ea9240f85d5e36dee55272d23094d1 100644 (file)
 ;; enter reading loop-0
 (display "loop-0 ...\n")
 
-(define (evcon c a)
-  ;; (display "evcon c=")
-  ;; (display c)
-  ;; (newline)
-  (if (null? c) *unspecified*
-      (if (eval-env (caar c) a)
-          (if (null? (cdar c) (eval-env (caar c) a))
-              (if (null? (cddar c)) (eval-env (cadar c) a)
-                  ((lambda ()
-                     (eval-env (cadar c) a)
-                     (evcon (cons (cons #t (cddar c)) '()) a)))))
-          (evcon (cdr c) a))))
+(define-macro (cond . clauses)
+  (list 'if (null? clauses) *unspecified*
+        (if (null? (cdr clauses))
+            (list 'if (car (car clauses))
+                  (list (cons 'lambda (cons '() (cons (car (car clauses)) (cdr (car clauses))))))
+                  *unspecified*)
+            (if (eq? (car (cadr clauses)) 'else)
+                (list 'if (car (car clauses))
+                      (list (cons 'lambda (cons '() (car clauses))))
+                      (list (cons 'lambda (cons '() (cons *unspecified* (cdr (cadr clauses)))))))
+                (list 'if (car (car clauses))
+                      (list (cons 'lambda (cons '() (car clauses))))
+                      (cons 'cond (cdr clauses)))))))
 
 (define (not x)
   (if x #f #t))
      ((eq? (car e) 'begin) (eval-begin-env e a))
      ((eq? (car e) 'lambda) (make-closure (cadr e) (cddr e) (assq '*closure* a)))
      ((eq? (car e) '*closure*) e)
-     ((eq? (car e) 'cond) (evcon (cdr e) a))
      ((eq? (car e) 'if) (eval-if-env (cdr e) a))
      ((eq? (car e) 'define) (env:define (cons (sexp:define e a) '()) a))
      ((eq? (car e) 'define-macro) (env:define (env:macro (sexp:define e a)) a))