core: Resurrect QUASIQUOTE=0.

* mes.c (mes_builtins) [!QUASIQUOTE]: Do not add unquoters.
* module/mes/base-0.mes (push!, pop!, load, mes-use-module): Rewrite
  without quasiquote.
* module/mes/quasiquote.mes (quasiquote): Rewrite using if, and.
* module/srfi/srfi-0 (cond-expand): Rewrite without quasiquote.

diff --git a/mes.c b/mes.c
index 951f75186cd03eca0b583a36bc58488bbdb960a8..24a26dc76f2e1486b3f247f51a4fc6444558d459 100644 (file)
--- a/mes.c
+++ b/mes.c
@@ -1121,12 +1121,14 @@ mes_builtins (SCM a)
 #include "string.environment.i"
 #include "type.environment.i"
 
+#if QUASIQUOTE
   SCM cell_unquote = assq_ref_cache (cell_symbol_unquote, a);
   SCM cell_unquote_splicing = assq_ref_cache (cell_symbol_unquote_splicing, a);
   SCM the_unquoters = cons (cons (cell_symbol_unquote, cell_unquote),
                             cons (cons (cell_symbol_unquote_splicing, cell_unquote_splicing),
                                   cell_nil));
   a = acons (cell_symbol_the_unquoters, the_unquoters, a);
+#endif
 
   a = add_environment (a, "*foo-bar-baz*", cell_nil); // FIXME: some off-by one?
 

diff --git a/module/mes/base-0.mes b/module/mes/base-0.mes
index 9128020dcf8ee450c8b5455d7d042436b313ada7..bc5c110325078a989a45d11f64686c09ea64bfec 100644 (file)
--- a/module/mes/base-0.mes
+++ b/module/mes/base-0.mes
@@ -90,20 +90,21 @@
 
 (define *input-ports* '())
 (define-macro (push! stack o)
-  `(begin
-     (set! ,stack (cons ,o ,stack))
-     ,stack))
+  (cons
+   'begin
+   (list
+    (list 'set! stack (list cons o stack))
+    stack)))
 (define-macro (pop! stack)
-  `(let ((o (car ,stack)))
-     (set! ,stack (cdr ,stack))
-     o))
+  (list 'let (list (list 'o (list car stack)))
+        (list 'set! stack (list cdr stack))
+        'o))
 (define-macro (load file)
-  `(begin
-     (push! *input-ports* (current-input-port))
-     (set-current-input-port (open-input-file ,file))
-     (primitive-load)
-     (set-current-input-port (pop! *input-ports*))))
-
+  (list 'begin
+     (list 'push! '*input-ports* (list current-input-port))
+     (list 'set-current-input-port (list open-input-file file))
+     (list 'primitive-load)
+     (list 'set-current-input-port (list 'pop! '*input-ports*))))
 (define (memq x lst)
   (if (null? lst) #f
       (if (eq? x (car lst)) lst
@@ -126,18 +127,19 @@
                      a)))
     (set-current-input-port (pop! *input-ports*))
     x))
-(define-macro (mes-use-module module)
-  `(begin
-     (if (not (memq (string->symbol ,(module->file module)) *modules*))
-         (begin
-           (set! *modules* (cons (string->symbol ,(module->file module)) *modules*))
-           ;; (display "loading file=" (current-error-port))
-           ;; (display ,(module->file module) (current-error-port))
-           ;; (newline (current-error-port))
-           (load ,(string-append *mes-prefix* (module->file module)))))))
-
 (define (not x)
   (if x #f #t))
+(define-macro (mes-use-module module)
+  (list
+   'begin
+   (list 'if (list 'not (list 'memq (list string->symbol (module->file module)) '*modules*))
+         (list
+          'begin
+          (list 'set! '*modules* (list cons (list string->symbol (module->file module)) '*modules*))
+          ;; (list display "loading file=" (list current-error-port))
+          ;; (list display (module->file module) (list current-error-port))
+          ;; (list newline (list current-error-port))
+          (list 'load (list string-append '*mes-prefix* (module->file module)))))))
 
 (mes-use-module (srfi srfi-0))
 (mes-use-module (mes base))

diff --git a/module/mes/quasiquote.mes b/module/mes/quasiquote.mes
index 8712370a253421cb41adc4043c695d931e4ea6a9..05bf41b88a296118b87a3c3fae21c86660265cf8 100644 (file)
--- a/module/mes/quasiquote.mes
+++ b/module/mes/quasiquote.mes
@@ -28,67 +28,26 @@
 (mes-use-module (mes base))
 
 (define-macro (quasiquote x)
-  (define (check x)
-    (cond ((pair? (cdr x)) (cond ((null? (cddr x)))
-                                 (#t (error (car x) "invalid form ~s" x))))))
   (define (loop x)
-    ;;(display "LOOP") (newline)
-    (cond
-     ((not (pair? x)) (cons 'quote (cons x '())))
-     ((eq? (car x) 'quasiquote) (check x) (loop (loop (cadr x))))
-     ((eq? (car x) 'unquote) (check x) (cadr x))
-     ((eq? (car x) 'unquote-splicing)
-      (error 'unquote-splicing "invalid context for ~s" x))
-     (;;(and (pair? (car x)) (eq? (caar x) 'unquote-splicing))
-      (cond ((pair? (car x)) (eq? (caar x) 'unquote-splicing))
-            (#t #f))
-      (check (car x))
-      ;; (let ((d (loop (cdr x))))
-      ;;   (cond ((equal? d '(quote ())) (cadar x))
-      ;;         ;;(#t `(append ,(cadar x) ,d))
-      ;;         (#t (list 'append (cadar x) d))
-      ;;         ))
-      ((lambda (d)
-         (list 'append (cadar x) d))
-       (loop (cdr x))))
-     (#t
-      ;; (let ((a (loop (car x)))
-      ;;       (d (loop (cdr x))))
-      ;;   (cond ((pair? d)
-      ;;          (cond ((eq? (car d) 'quote)
-      ;;                 (cond ((and (pair? a) (eq? (car a) 'quote))
-      ;;                        `'(,(cadr a) . ,(cadr d)))
-      ;;                       (#t (cond ((null? (cadr d))
-      ;;                                  `(list ,a))
-      ;;                                 (#t `(cons* ,a ,d))))))
-      ;;                (#t (cond ((memq (car d) '(list cons*))
-      ;;                           `(,(car d) ,a ,@(cdr d)))
-      ;;                          (#t `(cons* ,a ,d))))))
-      ;;         (#t `(cons* ,a ,d))))
-
-      ((lambda (a d)
-         ;;(display "LAMBDA AD") (newline)
-         (cond ((pair? d)
-                (cond ((eq? (car d) 'quote)
-                       (cond (;;(and (pair? a) (eq? (car a) 'quote))
-                              (cond ((pair? a) (eq? (car a) 'quote))
-                                    (#t #f))
-                              (list 'quote (cons (cadr a) (cadr d))))
-                             (#t (cond ((null? (cadr d))
-                                        (list 'list a))
-                                       (#t (list 'cons* a d))))))
-                      (#t (cond ((memq (car d) '(list cons*))
-                                 ;;`(,(car d) ,a ,@(cdr d))
-                                 (cons (car d) (cons a (cdr d)))
-                                 )
-                                ;;(#t `(cons* ,a ,d))
-                                (#t (list 'cons* a d))
-                                ))))
-               ;;(#t `(cons* ,a ,d))
-               (#t (list 'cons* a d))
-               ))
-       (loop (car x))
-       (loop (cdr x)))
-
-      )))
+    (if (not (pair? x)) (cons 'quote (cons x '()))
+        (if (eq? (car x) 'quasiquote) (loop (loop (cadr x)))
+            (if (eq? (car x) 'unquote) (cadr x)
+                (if (and (pair? (car x)) (eq? (caar x) 'unquote-splicing))
+                    ((lambda (d)
+                       (list 'append (cadar x) d))
+                     (loop (cdr x)))
+                    ((lambda (a d)
+                       (if (pair? d)
+                           (if (eq? (car d) 'quote)
+                               (if (and (pair? a) (eq? (car a) 'quote))
+                                   (list 'quote (cons (cadr a) (cadr d)))
+                                   (if (null? (cadr d))
+                                       (list 'list a)
+                                       (list 'cons* a d)))
+                               (if (memq (car d) '(list cons*))
+                                   (cons (car d) (cons a (cdr d)))
+                                   (list 'cons* a d)))
+                           (list 'cons* a d)))
+                     (loop (car x))
+                     (loop (cdr x))))))))
   (loop x))

diff --git a/module/srfi/srfi-0.mes b/module/srfi/srfi-0.mes
index e5ff2e5bf36f2f6394f187acb6604c29849ebe13..5330b067d9d554049a40ac72ba9034a858dec07b 100644 (file)
--- a/module/srfi/srfi-0.mes
+++ b/module/srfi/srfi-0.mes
@@ -32,4 +32,4 @@
       (cond-expand-expander (cdr clauses))))
 
 (define-macro (cond-expand . clauses)
-  `(begin ,@(cond-expand-expander clauses)))
+  (cons 'begin (cond-expand-expander clauses)))

diff --git a/quasiquote.c b/quasiquote.c
index 6230f0873d47cfeb45bd16954949853e0150bdd0..6a7cb5bcd063ba449f6ace2f6aa1ba800e229872 100644 (file)
--- a/quasiquote.c
+++ b/quasiquote.c
@@ -65,6 +65,10 @@ add_unquoters (SCM a)
 SCM add_unquoters (SCM a){}
 SCM eval_quasiquote (SCM e, SCM a){}
 
+SCM unquote (SCM x){}
+SCM unquote_splicing (SCM x){}
+SCM vm_eval_quasiquote () {}
+
 #endif // QUASIQUOTE
 
 #if QUASISYNTAX
@@ -112,7 +116,6 @@ SCM syntax (SCM x){}
 SCM unsyntax (SCM x){}
 SCM unsyntax_splicing (SCM x){}
 SCM add_unsyntaxers (SCM a){}
-SCM eval_unsyntax (SCM e, SCM a){}
 SCM eval_quasisyntax (SCM e, SCM a){}
 
 #endif // !QUASISYNTAX