diff options
-rw-r--r-- | module/language/elisp/boot.el | 14 | ||||
-rw-r--r-- | module/language/elisp/compile-tree-il.scm | 31 | ||||
-rw-r--r-- | module/language/elisp/runtime.scm | 6 |
3 files changed, 7 insertions, 44 deletions
diff --git a/module/language/elisp/boot.el b/module/language/elisp/boot.el index 1079357be..3550b5b41 100644 --- a/module/language/elisp/boot.el +++ b/module/language/elisp/boot.el @@ -742,17 +742,3 @@ (defun %set-eager-macroexpansion-mode (ignore) nil) - -(defun progn (&rest args) (error "Special operator")) -(defun eval-when-compile (&rest args) (error "Special operator")) -(defun if (&rest args) (error "Special operator")) -(defun defconst (&rest args) (error "Special operator")) -(defun defvar (&rest args) (error "Special operator")) -(defun setq (&rest args) (error "Special operator")) -(defun let (&rest args) (error "Special operator")) -(defun flet (&rest args) (error "Special operator")) -(defun labels (&rest args) (error "Special operator")) -(defun let* (&rest args) (error "Special operator")) -(defun function (&rest args) (error "Special operator")) -(defun defmacro (&rest args) (error "Special operator")) -(defun quote (&rest args) (error "Special operator")) diff --git a/module/language/elisp/compile-tree-il.scm b/module/language/elisp/compile-tree-il.scm index 92b27115a..84bbeab53 100644 --- a/module/language/elisp/compile-tree-il.scm +++ b/module/language/elisp/compile-tree-il.scm @@ -798,43 +798,18 @@ (make-void loc)) (else (report-error loc "bad %set-lexical-binding-mode" args)))) -(define special-operators (make-hash-table)) - -(for-each - (lambda (pair) (hashq-set! special-operators (car pair) (cddr pair))) - `((progn . ,compile-progn) - (eval-when-compile . ,compile-eval-when-compile) - (if . ,compile-if) - (defconst . ,compile-defconst) - (defvar . ,compile-defvar) - (setq . ,compile-setq) - (let . ,compile-let) - (flet . ,compile-flet) - (labels . ,compile-labels) - (let* . ,compile-let*) - (guile-ref . ,compile-guile-ref) - (guile-private-ref . ,compile-guile-private-ref) - (guile-primitive . ,compile-guile-primitive) - (%function . ,compile-%function) - (function . ,compile-function) - (defmacro . ,compile-defmacro) - (#{`}# . ,#{compile-`}#) - (quote . ,compile-quote) - (%funcall . ,compile-%funcall) - (%set-lexical-binding-mode . ,compile-%set-lexical-binding-mode))) - ;;; Compile a compound expression to Tree-IL. (define (compile-pair loc expr) (let ((operator (car expr)) (arguments (cdr expr))) (cond + ((find-operator operator 'special-operator) + => (lambda (special-operator-function) + (special-operator-function loc arguments))) ((find-operator operator 'macro) => (lambda (macro-function) (compile-expr (apply macro-function arguments)))) - ((hashq-ref special-operators operator) - => (lambda (special-operator-function) - (special-operator-function loc arguments))) (else (compile-expr `(%funcall (%function ,operator) ,@arguments)))))) diff --git a/module/language/elisp/runtime.scm b/module/language/elisp/runtime.scm index dbe399e70..e4bd0ffb2 100644 --- a/module/language/elisp/runtime.scm +++ b/module/language/elisp/runtime.scm @@ -274,5 +274,7 @@ (syntax-case x () ((_ name args body ...) (with-syntax ((scheme-name (make-id #'name 'compile- #'name))) - #'(define scheme-name - (cons 'special-operator (lambda args body ...)))))))) + #'(begin + (define scheme-name + (cons 'special-operator (lambda args body ...))) + (set-symbol-function! 'name scheme-name))))))) |