[Guile-commits] 15/36: restore special operator handling

[Christopher Allan Webber]

cwebber pushed a commit to branch wip-elisp
in repository guile.

commit ee48df0ec1edd4236f4b5f4cde23ad22b7a8a7a0
Author: Robin Templeton <address@hidden>
Date:   Fri Jul 18 17:42:59 2014 -0400

    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!
---
 module/language/elisp/boot.el             |   14 -------------
 module/language/elisp/compile-tree-il.scm |   31 ++--------------------------
 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 1079357..3550b5b 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 1e09334..2716c8f 100644
--- a/module/language/elisp/compile-tree-il.scm
+++ b/module/language/elisp/compile-tree-il.scm
@@ -779,43 +779,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 dbe399e..e4bd0ff 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)))))))