boot: support quasiquote in eval.

* module/mes/loop-0.mes (eval-env): Add quasiquote support.
This commit is contained in:
Jan Nieuwenhuizen 2016-10-20 23:33:35 +02:00
parent 97f1d71de6
commit 430455e886
1 changed files with 17 additions and 1 deletions

View File

@ -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))))