boot: support quasiquote in eval.

* module/mes/loop-0.mes (eval-env): Add quasiquote support.

diff --git a/module/mes/loop-0.mes b/module/mes/loop-0.mes
index 0b548fe695ea9240f85d5e36dee55272d23094d1..36ad4cf2c51af955fdae46853995dbcebac6bcbc 100644 (file)
--- a/module/mes/loop-0.mes
+++ b/module/mes/loop-0.mes
@@ -145,10 +145,17 @@
      ((eq? (car e) 'define-macro) (env:define (env:macro (sexp:define e a)) a))
      ((eq? (car e) 'set!) (set-env! (cadr e) (eval (caddr e) a) a))
      ((eq? (car e) 'unquote) (eval (cadr e) a))
-     ((eq? (car e) 'quasiquote) (eval-quasiquote (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 (unquote x) (cons 'unquote x))
+(define (unquote-splicing x) (cons 'quasiquote x))
+
+(define (add-unquoters a)
+  (cons (cons 'unquote unquote)
+        (cons (cons 'unquote-splicing unquote-splicing) a)))
+
 (define (eval e a)
   (eval-expand (expand-macro-env e a) a))
 
@@ -170,6 +177,15 @@
   (if (eval (car e) a) (eval (cadr e) a)
       (if (pair? (cddr e)) (eval (caddr e) a))))
 
+(define (eval-quasiquote e a)
+  (cond ((null? e) e)
+        ((atom? e) e)
+        ((eq? (car e) 'unquote) (eval (cadr e) a))
+        ((and (pair? (car e))
+              (eq? (caar e) 'unquote-splicing))
+         (append2 (eval (cadar e) a) (eval-quasiquote (cdr e) a)))
+        (#t (cons (eval-quasiquote (car e) a) (eval-quasiquote (cdr e) a)))))
+
 (define (sexp:define e a)
   (if (atom? (cadr e)) (cons (cadr e) (eval (caddr e) a))
       (cons (caadr e) (eval (cons 'lambda (cons (cdadr e) (cddr e))) a))))