diff options
author | Robin Templeton <robin@terpri.org> | 2014-07-18 17:42:59 -0400 |
---|---|---|
committer | Ricardo Wurmus <rekado@elephly.net> | 2020-04-04 16:24:21 +0200 |
commit | 2149ab67fdc4891092408dead74b402ca2135b4c (patch) | |
tree | b4b6889c858fa10b0110fb4b1b09a83f8f685823 | |
parent | b5185d40c9de6cd5aef1689ea680f76681cdd132 (diff) |
restore special operator handling
(Best-ability ChangeLog annotation added by Christopher Allan Webber.)
* module/language/elisp/boot.el
(progn, eval-when-compile, if, defconst, defvar, setq, let, flet)
(labels, let*, function, defmacro, quote): Removed.
* module/language/elisp/compile-tree-il.scm (special-operators): Removed.
(compound-pair): Use find-operator to check if a 'special-operator
rather than checking the now removed special-operators table.
* module/language/elisp/runtime.scm (defspecial): Update to use
set-symbol-function!
-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))))))) |