diff --git a/module/mes/loop-0.mes b/module/mes/loop-0.mes index 0b548fe6..36ad4cf2 100644 --- 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))))