diff options
| -rw-r--r-- | share/txr/stdlib/compiler.tl | 111 |
1 files changed, 55 insertions, 56 deletions
diff --git a/share/txr/stdlib/compiler.tl b/share/txr/stdlib/compiler.tl index a1e43a25..e7cc10b9 100644 --- a/share/txr/stdlib/compiler.tl +++ b/share/txr/stdlib/compiler.tl @@ -283,62 +283,61 @@ me.(comp-var oreg env form) me.(comp-atom oreg form))) ((atom form) me.(comp-atom oreg form)) - ((consp form) - (let ((sym (car form))) - (cond - ((special-operator-p sym) - (caseq sym - (quote me.(comp-atom oreg (cadr form))) - (sys:setq me.(comp-setq oreg env form)) - (sys:lisp1-setq me.(comp-lisp1-setq oreg env form)) - (sys:setqf me.(comp-setqf oreg env form)) - (cond me.(comp-cond oreg env form)) - (if me.(comp-if oreg env form)) - (switch me.(comp-switch oreg env form)) - (unwind-protect me.(comp-unwind-protect oreg env form)) - ((block block*) me.(comp-block oreg env form)) - ((return-from sys:abscond-from) me.(comp-return-from oreg env form)) - (return me.(comp-return oreg env form)) - (handler-bind me.(comp-handler-bind oreg env form)) - (sys:catch me.(comp-catch oreg env form)) - ((let let*) me.(comp-let oreg env form)) - ((sys:fbind sys:lbind) me.(comp-fbind oreg env form)) - (lambda me.(comp-lambda oreg env form)) - (fun me.(comp-fun oreg env form)) - (sys:for-op me.(comp-for oreg env form)) - (sys:each-op me.(compile oreg env (expand-each form env))) - ((progn eval-only compile-only) me.(comp-progn oreg env (cdr form))) - (and me.(comp-and-or oreg env form)) - (or me.(comp-and-or oreg env form)) - (prog1 me.(comp-prog1 oreg env form)) - (sys:quasi me.(comp-quasi oreg env form)) - (dohash me.(compile oreg env (expand-dohash form))) - (tree-bind me.(comp-tree-bind oreg env form)) - (mac-param-bind me.(comp-mac-param-bind oreg env form)) - (tree-case me.(comp-tree-case oreg env form)) - (sys:lisp1-value me.(comp-lisp1-value oreg env form)) - (dwim me.(comp-dwim oreg env form)) - (prof me.(comp-prof oreg env form)) - (defvarl me.(compile oreg env (expand-defvarl form))) - (defun me.(compile oreg env (expand-defun form))) - (defmacro me.(compile oreg env (expand-defmacro form))) - (defsymacro me.(compile oreg env (expand-defsymacro form))) - (sys:upenv me.(compile oreg env.up (cadr form))) - (sys:dvbind me.(compile oreg env (caddr form))) - (sys:load-time-lit me.(comp-load-time-lit oreg env form)) - ((macrolet symacrolet macro-time) - (compile-error form "unexpanded ~s encountered" sym)) - ((sys:var sys:expr) - (compile-error form "meta with no meaning: ~s " form)) - ((usr:qquote usr:unquote usr:splice - sys:qquote sys:unquote sys:splice) - (compile-error form "unexpanded quasiquote encountered")) - (t - (compile-error form "unrecognized special operator ~s" sym)))) - ((bindable sym) me.(comp-fun-form oreg env form)) - ((and (consp sym) - (eq (car sym) 'lambda)) me.(compile oreg env ^(call ,*form))) - (t (compile-error form "invalid operator"))))))) + (t (let ((sym (car form))) + (cond + ((special-operator-p sym) + (caseq sym + (quote me.(comp-atom oreg (cadr form))) + (sys:setq me.(comp-setq oreg env form)) + (sys:lisp1-setq me.(comp-lisp1-setq oreg env form)) + (sys:setqf me.(comp-setqf oreg env form)) + (cond me.(comp-cond oreg env form)) + (if me.(comp-if oreg env form)) + (switch me.(comp-switch oreg env form)) + (unwind-protect me.(comp-unwind-protect oreg env form)) + ((block block*) me.(comp-block oreg env form)) + ((return-from sys:abscond-from) me.(comp-return-from oreg env form)) + (return me.(comp-return oreg env form)) + (handler-bind me.(comp-handler-bind oreg env form)) + (sys:catch me.(comp-catch oreg env form)) + ((let let*) me.(comp-let oreg env form)) + ((sys:fbind sys:lbind) me.(comp-fbind oreg env form)) + (lambda me.(comp-lambda oreg env form)) + (fun me.(comp-fun oreg env form)) + (sys:for-op me.(comp-for oreg env form)) + (sys:each-op me.(compile oreg env (expand-each form env))) + ((progn eval-only compile-only) me.(comp-progn oreg env (cdr form))) + (and me.(comp-and-or oreg env form)) + (or me.(comp-and-or oreg env form)) + (prog1 me.(comp-prog1 oreg env form)) + (sys:quasi me.(comp-quasi oreg env form)) + (dohash me.(compile oreg env (expand-dohash form))) + (tree-bind me.(comp-tree-bind oreg env form)) + (mac-param-bind me.(comp-mac-param-bind oreg env form)) + (tree-case me.(comp-tree-case oreg env form)) + (sys:lisp1-value me.(comp-lisp1-value oreg env form)) + (dwim me.(comp-dwim oreg env form)) + (prof me.(comp-prof oreg env form)) + (defvarl me.(compile oreg env (expand-defvarl form))) + (defun me.(compile oreg env (expand-defun form))) + (defmacro me.(compile oreg env (expand-defmacro form))) + (defsymacro me.(compile oreg env (expand-defsymacro form))) + (sys:upenv me.(compile oreg env.up (cadr form))) + (sys:dvbind me.(compile oreg env (caddr form))) + (sys:load-time-lit me.(comp-load-time-lit oreg env form)) + ((macrolet symacrolet macro-time) + (compile-error form "unexpanded ~s encountered" sym)) + ((sys:var sys:expr) + (compile-error form "meta with no meaning: ~s " form)) + ((usr:qquote usr:unquote usr:splice + sys:qquote sys:unquote sys:splice) + (compile-error form "unexpanded quasiquote encountered")) + (t + (compile-error form "unrecognized special operator ~s" sym)))) + ((bindable sym) me.(comp-fun-form oreg env form)) + ((and (consp sym) + (eq (car sym) 'lambda)) me.(compile oreg env ^(call ,*form))) + (t (compile-error form "invalid operator"))))))) (defmeth compiler comp-atom (me oreg form) (cond |