@@ -2,21 +2,13 @@ ;;; An interpreter environment is a list of alists, each mapping -(define interpreter-builtin-forms ()) -(define interpreter-builtin-body-forms ()) +(define interpreter-builtin-forms (make-symboltable)) (defmarco (define-interpreter-builtin-form keyword . body) (quasiquote - (let* ((a (cons (unquote keyword) - (lambda (keyword args env) (unquote-splicing body))))) - (push a interpreter-builtin-forms) - (push a interpreter-builtin-body-forms)))) - -(defmarco (define-interpreter-builtin-body-form keyword . body) - (quasiquote - (let* ((a (cons (unquote keyword) - (lambda (keyword args env) (unquote-splicing body))))) - (push a interpreter-builtin-body-forms)))) + (symboltable-set! interpreter-builtin-forms '(unquote keyword) + (lambda (keyword args env in-body) + (unquote-splicing body))))) (define interpreter-builtin-vars ()) @@ -26,13 +18,15 @@ (define (make-initial-interpreter-env) (list interpreter-builtin-vars)) -(define (eval-form-aux form env builtin-forms) +(define (eval-form-aux form env in-body) (cond ((pair? form) (let* ((keyword (car form)) (args (cdr form)) - (builtin (and (symbol? keyword) (assoc keyword builtin-forms)))) + (builtin (and (symbol? keyword) + (symboltable-ref interpreter-builtin-forms + keyword)))) (if builtin - (funcall (cdr builtin) keyword args env) + (funcall builtin keyword args env in-body) (eval-call form env)))) ((symbol? form) (let* ((var (lassoc form env))) @@ -41,10 +35,10 @@ (true form))) (define (eval-form form env) - (eval-form-aux form env interpreter-builtin-forms)) + (eval-form-aux form env false)) (define (eval-body-form form env) - (eval-form-aux form env interpreter-builtin-body-forms)) + (eval-form-aux form env true)) (define (eval-body forms env) (let* ((result unspecified)) @@ -63,7 +57,7 @@ (acons (car formals) (car actuals) (make-lambda-alist (cdr formals) (cdr actuals))))))) -(define-interpreter-builtin-form 'lambda +(define-interpreter-builtin-form lambda (lambda (actuals) (eval-body (cdr args) (cons (make-lambda-alist (car args) actuals) env)))) @@ -71,13 +65,15 @@ (let* ((evaled-subforms (mapfor (subform form) (eval-form subform env)))) (funcall (car evaled-subforms) (cdr evaled-subforms)))) -(define-interpreter-builtin-form 'begin +(define-interpreter-builtin-form begin (eval-body args (cons () env))) -(define-interpreter-builtin-body-form 'definitions +(define-interpreter-builtin-form definitions + (unless in-body (error "definitions not in body")) (eval-body args env)) -(define-interpreter-builtin-body-form 'define +(define-interpreter-builtin-form define + (unless in-body (error "definitions not in body")) (let* ((var (first args)) (val (if (null? (cdr args)) unspecified (eval-form (second args) env)))) @@ -86,24 +82,24 @@ (lapush var val env) val)) -(define-interpreter-builtin-form 'set! +(define-interpreter-builtin-form set! (let* ((val (eval-form (second args) env)) (var (lassoc (first args) env))) (if var (rplacd var val) (error "unbound variable ~S" (first args))) val)) -(define-interpreter-builtin-form 'if +(define-interpreter-builtin-form if (if (subject-language-boolean (eval-form (first args) env)) (eval-form (second args) env) (if (null? (cddr args)) 'unspecified (eval-form (third args) env)))) -(define-interpreter-builtin-form 'quote +(define-interpreter-builtin-form quote (first args)) (defmarco (define-interpreter-builtin-op op . body) (quasiquote - (define-interpreter-builtin-form '(unquote op) + (define-interpreter-builtin-form (unquote op) (let* ((evaled-args (mapfor (arg args) (eval-form arg env)))) (unquote (cond ((null? body) (quasiquote @@ -118,7 +114,7 @@ (defmarco (define-interpreter-builtin-boolean-op op) (quasiquote - (define-interpreter-builtin-form '(unquote op) + (define-interpreter-builtin-form (unquote op) (if (apply (function (unquote op)) (mapfor (arg args) (eval-form arg env))) 'true 'false)))) @@ -132,6 +128,7 @@ (define-interpreter-builtin-op gensym) (define-interpreter-builtin-op symbol-name (sym) (subject-language-symbol-name sym)) +(define-interpreter-builtin-op symbol-id) (define-interpreter-builtin-op intern (str) (subject-language-intern str)) language/interpreter.pco 85f30384bdd59b1f5e4ec1966ca7ee722e2092bb David Wragg david@wragg.org http://github.com/dpw/pachuco/commit/063eef508ffd7efb7d263e677f10f84c5d30b28f 063eef508ffd7efb7d263e677f10f84c5d30b28f 2008-11-08T16:33:22-08:00 2008-11-08T16:33:22-08:00 Convert interpreter builtin-form table to a symboltable 69440139da8ab466e0cb15215cd35643f7cc010a David Wragg david@wragg.org