artemist/mes
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

boot: support quasiquote in eval.

Browse source 
* 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
Show stats Download patch file Download diff file Expand all files Collapse all files

18
module/mes/loop-0.mes
View file

@ -145,10 +145,17 @@
((eq? (car e) 'define-macro) (env:define (env:macro (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 (caddr 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) '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))))
(#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) (define (eval e a)
(eval-expand (expand-macro-env e a) a)) (eval-expand (expand-macro-env e a) a))
@ -170,6 +177,15 @@
(if (eval (car e) a) (eval (cadr e) a) (if (eval (car e) a) (eval (cadr e) a)
(if (pair? (cddr e)) (eval (caddr 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) (define (sexp:define e a)
(if (atom? (cadr e)) (cons (cadr e) (eval (caddr 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)))) (cons (caadr e) (eval (cons 'lambda (cons (cdadr e) (cddr e))) a))))