From fce7824d8f99a9705d64cf499bad20d61ec26007 Mon Sep 17 00:00:00 2001
From: Jan Nieuwenhuizen <janneke@gnu.org>
Date: Sat, 29 Oct 2016 09:38:18 +0200
Subject: [PATCH] Revert "comment-out COND"

This reverts commit 0d799d85f69730340c6ef827e553e0a0bfc11c22.
---
 module/mes/mes-0.mes | 184 +++++++++++++++++++++----------------------
 1 file changed, 92 insertions(+), 92 deletions(-)

diff --git a/module/mes/mes-0.mes b/module/mes/mes-0.mes
index 1d43563a..e779f345 100644
--- a/module/mes/mes-0.mes
+++ b/module/mes/mes-0.mes
@@ -34,84 +34,84 @@
 
 ;;; Code:
 
-;; (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-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 (map f l . r)
-;;   (if (null? l) '()
-;;       (if (null? r) (cons (f (car l)) (map f (cdr l)))
-;;           (if (null? (cdr r))
-;;               (cons (f (car l) (caar r)) (map f (cdr l) (cdar r)))))))
+(define (map f l . r)
+  (if (null? l) '()
+      (if (null? r) (cons (f (car l)) (map f (cdr l)))
+          (if (null? (cdr r))
+              (cons (f (car l) (caar r)) (map f (cdr l) (cdar r)))))))
 
-;; (define-macro (simple-let bindings . rest)
-;;   (cons (cons 'lambda (cons (map car bindings) rest))
-;;         (map cadr bindings)))
+(define-macro (simple-let bindings . rest)
+  (cons (cons 'lambda (cons (map car bindings) rest))
+        (map cadr bindings)))
 
-;; (define-macro (let bindings . rest)
-;;   (cons 'simple-let (cons bindings rest)))
+(define-macro (let bindings . rest)
+  (cons 'simple-let (cons bindings rest)))
 
-;; (define-macro (or . x)
-;;   (if (null? x) #f
-;;       (if (null? (cdr x)) (car x)
-;;           (list 'if (car x) (car x)
-;;                 (cons 'or (cdr x))))))
+(define-macro (or . x)
+  (if (null? x) #f
+      (if (null? (cdr x)) (car x)
+          (list 'if (car x) (car x)
+                (cons 'or (cdr x))))))
 
-;; (define-macro (and . x)
-;;   (if (null? x) #t
-;;       (if (null? (cdr x)) (car x)
-;;           (list 'if (car x) (cons 'and (cdr x))
-;;                 #f))))
+(define-macro (and . x)
+  (if (null? x) #t
+      (if (null? (cdr x)) (car x)
+          (list 'if (car x) (cons 'and (cdr x))
+                #f))))
 
 (define (not x)
   (if x #f #t))
 
-;; (define (evlis-env m a)
-;;   (cond
-;;    ((null? m) '())
-;;    ((not (pair? m)) (eval-expand m a))
-;;    (#t (cons (eval-expand (car m) a) (evlis-env (cdr m) a)))))
+(define (evlis-env m a)
+  (cond
+   ((null? m) '())
+   ((not (pair? m)) (eval-expand m a))
+   (#t (cons (eval-expand (car m) a) (evlis-env (cdr m) a)))))
 
 (define (evlis-env m a)
   (if (null? m) '()
       (if (not (pair? m)) (eval m a)
           (cons (eval (car m) a) (evlis-env (cdr m) a)))))
 
-;; (define (apply-env fn x a) 
-;;   (cond
-;;    ((atom? fn)
-;;     (cond
-;;      ((builtin? fn) (call fn x))
-;;      ((eq? fn 'call-with-values) (c:apply-env 'call-with-values x a))
-;;      ((eq? fn 'current-module) a)
-;;      (#t (apply-env (eval-expand fn a) x a))))
-;;    ((eq? (car fn) 'lambda)
-;;     (let ((p (pairlis (cadr fn) x a)))
-;;       (cache-invalidate-range p (cdr a))
-;;       (let ((r (eval-begin-env (cddr fn) (cons (cons '*closure* p) p))))
-;;         (cache-invalidate-range p (cdr a))
-;;         r)))
-;;    ((eq? (car fn) '*closure*)
-;;     (let ((args (caddr fn))
-;;           (body (cdddr fn))
-;;           (a (cddr (cadr fn))))
-;;       (let ((p (pairlis args x a)))
-;;         (cache-invalidate-range p (cdr a))
-;;         (let ((r (eval-begin-env body (cons (cons '*closure* p) p))))
-;;           (cache-invalidate-range p (cdr a))
-;;           r))))
-;;    ;;((eq? (car fn) 'label) (apply-env (caddr fn) x (cons (cons (cadr fn) (caddr fn)) a)))
-;;    (#t (apply-env (eval-expand fn a) x a))))
+(define (apply-env fn x a) 
+  (cond
+   ((atom? fn)
+    (cond
+     ((builtin? fn) (call fn x))
+     ((eq? fn 'call-with-values) (c:apply-env 'call-with-values x a))
+     ((eq? fn 'current-module) a)
+     (#t (apply-env (eval-expand fn a) x a))))
+   ((eq? (car fn) 'lambda)
+    (let ((p (pairlis (cadr fn) x a)))
+      (cache-invalidate-range p (cdr a))
+      (let ((r (eval-begin-env (cddr fn) (cons (cons '*closure* p) p))))
+        (cache-invalidate-range p (cdr a))
+        r)))
+   ((eq? (car fn) '*closure*)
+    (let ((args (caddr fn))
+          (body (cdddr fn))
+          (a (cddr (cadr fn))))
+      (let ((p (pairlis args x a)))
+        (cache-invalidate-range p (cdr a))
+        (let ((r (eval-begin-env body (cons (cons '*closure* p) p))))
+          (cache-invalidate-range p (cdr a))
+          r))))
+   ;;((eq? (car fn) 'label) (apply-env (caddr fn) x (cons (cons (cadr fn) (caddr fn)) a)))
+   (#t (apply-env (eval-expand fn a) x a))))
 
 (define (apply-env fn x a) 
   (if (atom? fn) (if (builtin? fn) (call fn x)
@@ -153,27 +153,27 @@
               ;;((eq? (car fn) 'label) (apply-env (caddr fn) x (cons (cons (cadr fn) (caddr fn)) a)))
               (apply-env (eval fn a) x a)))))
 
-;; (define (eval-expand e a)
-;;   (display "mes:eval-expand e=") (display e) (newline)
-;;   (cond
-;;    ((symbol? e) (assq-ref-cache e a))
-;;    ((atom? e) e)
-;;    ((atom? (car e))
-;;     (cond
-;;      ((eq? (car e) 'quote) (cadr e))
-;;      ((eq? (car e) 'syntax) (cadr e))
-;;      ((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) '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))
-;;      ((eq? (car e) 'set!) (set-env! (cadr e) (eval-expand (caddr e) a) a))
-;;      ((eq? (car e) 'apply-env) (apply-env (eval-expand (cadr e) a) (evlis-env (caddr e) a) a))
-;;      ((eq? (car e) 'unquote) (eval-expand (cadr e) a))
-;;      ((eq? (car e) 'quasiquote) (eval-quasiquote (cadr e) (add-unquoters a)))
-;;      (#t (apply-env (car e) (evlis-env (cdr e) a) a))))
-;;    (#t (apply-env (car e) (evlis-env (cdr e) a) a))))
+(define (eval-expand e a)
+  (display "mes:eval-expand e=") (display e) (newline)
+  (cond
+   ((symbol? e) (assq-ref-cache e a))
+   ((atom? e) e)
+   ((atom? (car e))
+    (cond
+     ((eq? (car e) 'quote) (cadr e))
+     ((eq? (car e) 'syntax) (cadr e))
+     ((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) '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))
+     ((eq? (car e) 'set!) (set-env! (cadr e) (eval-expand (caddr e) a) a))
+     ((eq? (car e) 'apply-env) (apply-env (eval-expand (cadr e) a) (evlis-env (caddr e) a) a))
+     ((eq? (car e) 'unquote) (eval-expand (cadr e) a))
+     ((eq? (car e) 'quasiquote) (eval-quasiquote (cadr e) (add-unquoters a)))
+     (#t (apply-env (car e) (evlis-env (cdr e) a) a))))
+   (#t (apply-env (car e) (evlis-env (cdr e) a) a))))
 
 (define (eval-expand e a)
   (if (symbol? e) (assq-ref-cache e a)
@@ -227,14 +227,14 @@
   (if (eval-expand (car e) a) (eval-expand (cadr e) a)
       (if (pair? (cddr e)) (eval-expand (caddr e) a))))
 
-;; (define (eval-quasiquote e a)
-;;   (cond ((null? e) e)
-;;         ((atom? e) e)
-;;         ((eq? (car e) 'unquote) (eval-expand (cadr e) a))
-;;         ((and (pair? (car e))
-;;               (eq? (caar e) 'unquote-splicing))
-;;          (append2 (eval-expand (cadar e) a) (eval-quasiquote (cdr e) a)))
-;;         (#t (cons (eval-quasiquote (car e) a) (eval-quasiquote (cdr e) a)))))
+(define (eval-quasiquote e a)
+  (cond ((null? e) e)
+        ((atom? e) e)
+        ((eq? (car e) 'unquote) (eval-expand (cadr e) a))
+        ((and (pair? (car e))
+              (eq? (caar e) 'unquote-splicing))
+         (append2 (eval-expand (cadar e) a) (eval-quasiquote (cdr e) a)))
+        (#t (cons (eval-quasiquote (car e) a) (eval-quasiquote (cdr e) a)))))
 
 (define (eval-quasiquote e a)
   (if (null? e) e