mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-15 02:00:22 +02:00
restore special operator handling
(Best-ability ChangeLog annotation added by Christine Lemmer-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!
This commit is contained in:
parent
08380a632b
commit
8a4905f2cb
3 changed files with 7 additions and 44 deletions
|
@ -742,17 +742,3 @@
|
||||||
|
|
||||||
(defun %set-eager-macroexpansion-mode (ignore)
|
(defun %set-eager-macroexpansion-mode (ignore)
|
||||||
nil)
|
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"))
|
|
||||||
|
|
|
@ -785,43 +785,18 @@
|
||||||
(make-void loc))
|
(make-void loc))
|
||||||
(else (report-error loc "bad %set-lexical-binding-mode" args))))
|
(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.
|
;;; Compile a compound expression to Tree-IL.
|
||||||
|
|
||||||
(define (compile-pair loc expr)
|
(define (compile-pair loc expr)
|
||||||
(let ((operator (car expr))
|
(let ((operator (car expr))
|
||||||
(arguments (cdr expr)))
|
(arguments (cdr expr)))
|
||||||
(cond
|
(cond
|
||||||
|
((find-operator operator 'special-operator)
|
||||||
|
=> (lambda (special-operator-function)
|
||||||
|
(special-operator-function loc arguments)))
|
||||||
((find-operator operator 'macro)
|
((find-operator operator 'macro)
|
||||||
=> (lambda (macro-function)
|
=> (lambda (macro-function)
|
||||||
(compile-expr (apply macro-function arguments))))
|
(compile-expr (apply macro-function arguments))))
|
||||||
((hashq-ref special-operators operator)
|
|
||||||
=> (lambda (special-operator-function)
|
|
||||||
(special-operator-function loc arguments)))
|
|
||||||
(else
|
(else
|
||||||
(compile-expr `(%funcall (%function ,operator) ,@arguments))))))
|
(compile-expr `(%funcall (%function ,operator) ,@arguments))))))
|
||||||
|
|
||||||
|
|
|
@ -274,5 +274,7 @@
|
||||||
(syntax-case x ()
|
(syntax-case x ()
|
||||||
((_ name args body ...)
|
((_ name args body ...)
|
||||||
(with-syntax ((scheme-name (make-id #'name 'compile- #'name)))
|
(with-syntax ((scheme-name (make-id #'name 'compile- #'name)))
|
||||||
#'(define scheme-name
|
#'(begin
|
||||||
(cons 'special-operator (lambda args body ...))))))))
|
(define scheme-name
|
||||||
|
(cons 'special-operator (lambda args body ...)))
|
||||||
|
(set-symbol-function! 'name scheme-name)))))))
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue