Bind classifiers directly into global environment.

Eliminates kludge of syntax-definitions.

diff --git a/src/runtime/ed-ffi.scm b/src/runtime/ed-ffi.scm
index 0006b5660ce232fe574b799e3c9bcbab55f8a41e..e18c6ab482fe73cf553eb8149835b7036a541648 100644 (file)
--- a/src/runtime/ed-ffi.scm
+++ b/src/runtime/ed-ffi.scm
@@ -161,7 +161,6 @@ USA.
     ("syntax"  (runtime syntax top-level))
     ("syntax-check" (runtime syntax check))
     ("syntax-declaration" (runtime syntax declaration))
-    ("syntax-definitions" (runtime syntax definitions))
     ("syntax-environment" (runtime syntax environment))
     ("syntax-items" (runtime syntax items))
     ("syntax-output" (runtime syntax output))

diff --git a/src/runtime/make.scm b/src/runtime/make.scm
index ab1cb70d07301caf87a84d1049103e4cc120b72f..e04c35a50371be75bffcdeefd64d940a08e9de8f 100644 (file)
--- a/src/runtime/make.scm
+++ b/src/runtime/make.scm
@@ -531,7 +531,6 @@ USA.
    (RUNTIME PRETTY-PRINTER)
    (RUNTIME EXTENDED-SCODE-EVAL)
    (runtime syntax top-level)
-   (RUNTIME SYNTAX DEFINITIONS)
    (runtime syntax rename)
    ;; REP Loops
    (RUNTIME INTERRUPT-HANDLER)

diff --git a/src/runtime/mit-syntax.scm b/src/runtime/mit-syntax.scm
index aed5ff544b736c20cf2b94721336801a03342ab7..14757f77d6210c8b890171371f8879e034a52a9a 100644 (file)
--- a/src/runtime/mit-syntax.scm
+++ b/src/runtime/mit-syntax.scm
@@ -42,34 +42,44 @@ USA.
                                (output/top-level-syntax-expander
                                 procedure-name transformer)))))))
 
-(define classifier:sc-macro-transformer
+(define (classifier->runtime classifier)
+  (make-unmapped-macro-reference-trap (classifier-item classifier)))
+
+(define :sc-macro-transformer
   ;; "Syntactic Closures" transformer
-  (transformer-keyword 'sc-macro-transformer->expander
-                      sc-macro-transformer->expander))
+  (classifier->runtime
+   (transformer-keyword 'sc-macro-transformer->expander
+                       sc-macro-transformer->expander)))
 
-(define classifier:rsc-macro-transformer
+(define :rsc-macro-transformer
   ;; "Reversed Syntactic Closures" transformer
-  (transformer-keyword 'rsc-macro-transformer->expander
-                      rsc-macro-transformer->expander))
+  (classifier->runtime
+   (transformer-keyword 'rsc-macro-transformer->expander
+                       rsc-macro-transformer->expander)))
 
-(define classifier:er-macro-transformer
+(define :er-macro-transformer
   ;; "Explicit Renaming" transformer
-  (transformer-keyword 'er-macro-transformer->expander
-                      er-macro-transformer->expander))
+  (classifier->runtime
+   (transformer-keyword 'er-macro-transformer->expander
+                       er-macro-transformer->expander)))
 \f
 ;;;; Core primitives
 
-(define (classifier:lambda form senv hist)
-  (syntax-check '(_ mit-bvl + form) form)
-  (classify-lambda scode-lambda-name:unnamed
-                  (cadr form)
-                  form senv hist))
+(define :lambda
+  (classifier->runtime
+   (lambda (form senv hist)
+     (syntax-check '(_ mit-bvl + form) form)
+     (classify-lambda scode-lambda-name:unnamed
+                     (cadr form)
+                     form senv hist))))
 
-(define (classifier:named-lambda form senv hist)
-  (syntax-check '(_ (identifier . mit-bvl) + form) form)
-  (classify-lambda (identifier->symbol (caadr form))
-                  (cdadr form)
-                  form senv hist))
+(define :named-lambda
+  (classifier->runtime
+   (lambda (form senv hist)
+     (syntax-check '(_ (identifier . mit-bvl) + form) form)
+     (classify-lambda (identifier->symbol (caadr form))
+                     (cdadr form)
+                     form senv hist))))
 
 (define (classify-lambda name bvl form senv hist)
   (let ((senv (make-internal-senv senv)))
@@ -84,51 +94,74 @@ USA.
                     (body-item
                      (classify-forms-in-order-cddr form senv hist)))))))
 
-(define (classifier:begin form senv hist)
-  (syntax-check '(_ * form) form)
-  (seq-item (classify-forms-in-order-cdr form senv hist)))
-
-(define (classifier:if form senv hist)
-  (syntax-check '(_ expression expression ? expression) form)
-  (if-item (classify-form-cadr form senv hist)
-          (classify-form-caddr form senv hist)
-          (if (pair? (cdddr form))
-              (classify-form-cadddr form senv hist)
-              (unspecific-item))))
-
-(define (classifier:quote form senv hist)
-  (declare (ignore senv hist))
-  (syntax-check '(_ datum) form)
-  (constant-item (strip-syntactic-closures (cadr form))))
-
-(define (classifier:quote-identifier form senv hist)
-  (declare (ignore hist))
-  (syntax-check '(_ identifier) form)
-  (let ((item (lookup-identifier (cadr form) senv)))
-    (if (not (var-item? item))
-       (syntax-error "Can't quote a keyword identifier:" form))
-    (quoted-id-item item)))
-
-(define (classifier:set! form senv hist)
-  (syntax-check '(_ form ? expression) form)
-  (let ((lhs-item (classify-form-cadr form senv hist))
-       (rhs-item
-        (if (pair? (cddr form))
-            (classify-form-caddr form senv hist)
-            (unassigned-item))))
-    (cond ((var-item? lhs-item)
-          (assignment-item (var-item-id lhs-item) rhs-item))
-         ((access-item? lhs-item)
-          (access-assignment-item (access-item-name lhs-item)
-                                  (access-item-env lhs-item)
-                                  rhs-item))
-         (else
-          (syntax-error "Variable required in this context:" (cadr form))))))
-
-(define (classifier:delay form senv hist)
-  (syntax-check '(_ expression) form)
-  (delay-item (lambda () (classify-form-cadr form senv hist))))
+(define :delay
+  (classifier->runtime
+   (lambda (form senv hist)
+     (syntax-check '(_ expression) form)
+     (delay-item (lambda () (classify-form-cadr form senv hist))))))
+
+(define :begin
+  (classifier->runtime
+   (lambda (form senv hist)
+     (syntax-check '(_ * form) form)
+     (seq-item (classify-forms-in-order-cdr form senv hist)))))
+
+(define :if
+  (classifier->runtime
+   (lambda (form senv hist)
+     (syntax-check '(_ expression expression ? expression) form)
+     (if-item (classify-form-cadr form senv hist)
+             (classify-form-caddr form senv hist)
+             (if (pair? (cdddr form))
+                 (classify-form-cadddr form senv hist)
+                 (unspecific-item))))))
+
+(define :quote
+  (classifier->runtime
+   (lambda (form senv hist)
+     (declare (ignore senv hist))
+     (syntax-check '(_ datum) form)
+     (constant-item (strip-syntactic-closures (cadr form))))))
+
+(define :quote-identifier
+  (classifier->runtime
+   (lambda (form senv hist)
+     (declare (ignore hist))
+     (syntax-check '(_ identifier) form)
+     (let ((item (lookup-identifier (cadr form) senv)))
+       (if (not (var-item? item))
+          (syntax-error "Can't quote a keyword identifier:" form))
+       (quoted-id-item item)))))
 \f
+(define :set!
+  (classifier->runtime
+   (lambda (form senv hist)
+     (syntax-check '(_ form ? expression) form)
+     (let ((lhs-item (classify-form-cadr form senv hist))
+          (rhs-item
+           (if (pair? (cddr form))
+               (classify-form-caddr form senv hist)
+               (unassigned-item))))
+       (cond ((var-item? lhs-item)
+             (assignment-item (var-item-id lhs-item) rhs-item))
+            ((access-item? lhs-item)
+             (access-assignment-item (access-item-name lhs-item)
+                                     (access-item-env lhs-item)
+                                     rhs-item))
+            (else
+             (syntax-error "Variable required in this context:"
+                           (cadr form))))))))
+
+;; TODO: this is a classifier rather than a macro because it uses the
+;; special OUTPUT/DISJUNCTION.  Unfortunately something downstream in
+;; the compiler wants this, but it would be nice to eliminate this
+;; hack.
+(define :or
+  (classifier->runtime
+   (lambda (form senv hist)
+     (syntax-check '(_ * expression) form)
+     (or-item (classify-forms-cdr form senv hist)))))
+
 ;;;; Definitions
 
 (define keyword:define
@@ -137,16 +170,18 @@ USA.
      (let ((id (bind-variable (cadr form) senv)))
        (defn-item id (classify-form-caddr form senv hist))))))
 
-(define (classifier:define-syntax form senv hist)
-  (syntax-check '(_ identifier expression) form)
-  (let ((name (cadr form))
-       (item (classify-form-caddr form senv hist)))
-    (keyword-binder senv name item)
-    ;; User-defined macros at top level are preserved in the output.
-    (if (and (senv-top-level? senv)
-            (expander-item? item))
-       (syntax-defn-item name (expander-item-expr item))
-       (seq-item '()))))
+(define :define-syntax
+  (classifier->runtime
+   (lambda (form senv hist)
+     (syntax-check '(_ identifier expression) form)
+     (let ((name (cadr form))
+          (item (classify-form-caddr form senv hist)))
+       (keyword-binder senv name item)
+       ;; User-defined macros at top level are preserved in the output.
+       (if (and (senv-top-level? senv)
+               (expander-item? item))
+          (syntax-defn-item name (expander-item-expr item))
+          (seq-item '()))))))
 
 (define (keyword-binder senv name item)
   (if (not (keyword-item? item))
@@ -184,37 +219,34 @@ USA.
     (seq-item
      (classify-forms-in-order-cddr form body-senv hist))))
 
+(define :let-syntax
+  (classifier->runtime classifier:let-syntax))
+
 (define keyword:let-syntax
   (classifier->keyword classifier:let-syntax))
 
-(define (classifier:letrec-syntax form senv hist)
-  (syntax-check '(_ (* (identifier expression)) + form) form)
-  (let ((binding-senv (make-internal-senv senv)))
-    (let ((bindings (cadr form)))
-      (for-each (lambda (binding)
-                 (reserve-identifier (car binding) binding-senv))
-               bindings)
-      ;; Classify right-hand sides first, in order to catch references to
-      ;; reserved names.  Then bind names prior to classifying body.
-      (for-each (lambda (binding item)
-                 (keyword-binder binding-senv (car binding) item))
-               bindings
-               (map (lambda (binding hist)
-                      (classify-form-cadr binding binding-senv hist))
-                    bindings
-                    (subform-hists bindings (hist-cadr hist)))))
-    (seq-item
-     (classify-forms-in-order-cddr form
-                                  (make-internal-senv binding-senv)
-                                  hist))))
-
-;; TODO: this is a classifier rather than a macro because it uses the
-;; special OUTPUT/DISJUNCTION.  Unfortunately something downstream in
-;; the compiler wants this, but it would be nice to eliminate this
-;; hack.
-(define (classifier:or form senv hist)
-  (syntax-check '(_ * expression) form)
-  (or-item (classify-forms-cdr form senv hist)))
+(define :letrec-syntax
+  (classifier->runtime
+   (lambda (form senv hist)
+     (syntax-check '(_ (* (identifier expression)) + form) form)
+     (let ((binding-senv (make-internal-senv senv)))
+       (let ((bindings (cadr form)))
+        (for-each (lambda (binding)
+                    (reserve-identifier (car binding) binding-senv))
+                  bindings)
+        ;; Classify right-hand sides first, in order to catch references to
+        ;; reserved names.  Then bind names prior to classifying body.
+        (for-each (lambda (binding item)
+                    (keyword-binder binding-senv (car binding) item))
+                  bindings
+                  (map (lambda (binding hist)
+                         (classify-form-cadr binding binding-senv hist))
+                       bindings
+                       (subform-hists bindings (hist-cadr hist)))))
+       (seq-item
+       (classify-forms-in-order-cddr form
+                                     (make-internal-senv binding-senv)
+                                     hist))))))
 \f
 ;;;; MIT-specific syntax
 
@@ -235,12 +267,14 @@ USA.
     (output/access-reference (access-item-name item)
                             (compile-expr-item (access-item-env item)))))
 
-(define (classifier:the-environment form senv hist)
-  (declare (ignore hist))
-  (syntax-check '(_) form)
-  (if (not (senv-top-level? senv))
-      (syntax-error "This form allowed only at top level:" form))
-  (the-environment-item))
+(define :the-environment
+  (classifier->runtime
+   (lambda (form senv hist)
+     (declare (ignore hist))
+     (syntax-check '(_) form)
+     (if (not (senv-top-level? senv))
+        (syntax-error "This form allowed only at top level:" form))
+     (the-environment-item))))
 
 (define keyword:unspecific
   (classifier->keyword
@@ -253,14 +287,16 @@ USA.
    (lambda (form senv hist)
      (declare (ignore form senv hist))
      (unassigned-item))))
-\f
+
 ;;;; Declarations
 
-(define (classifier:declare form senv hist)
-  (syntax-check '(_ * (identifier * datum)) form)
-  (decl-item
-   (lambda ()
-     (classify-decls (cdr form) senv (hist-cdr hist)))))
+(define :declare
+  (classifier->runtime
+   (lambda (form senv hist)
+     (syntax-check '(_ * (identifier * datum)) form)
+     (decl-item
+      (lambda ()
+       (classify-decls (cdr form) senv (hist-cdr hist)))))))
 
 (define (classify-decls decls senv hist)
   (map (lambda (decl hist)

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 6a6c8c80f1d9484c023e9c76fdf8759cf92d2217..3be7548c55487ad6d99fb09fc167a968106a0013 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -4569,24 +4569,24 @@ USA.
 (define-package (runtime syntax mit)
   (files "mit-syntax")
   (parent (runtime syntax))
-  (export (runtime syntax definitions)
-         classifier:begin
-         classifier:declare
-         classifier:define-syntax
-         classifier:delay
-         classifier:er-macro-transformer
-         classifier:if
-         classifier:lambda
-         classifier:let-syntax
-         classifier:letrec-syntax
-         classifier:named-lambda
-         classifier:or
-         classifier:quote
-         classifier:quote-identifier
-         classifier:rsc-macro-transformer
-         classifier:sc-macro-transformer
-         classifier:set!
-         classifier:the-environment)
+  (export ()
+         (begin :begin)
+         (declare :declare)
+         (define-syntax :define-syntax)
+         (delay :delay)
+         (er-macro-transformer :er-macro-transformer)
+         (if :if)
+         (lambda :lambda)
+         (let-syntax :let-syntax)
+         (letrec-syntax :letrec-syntax)
+         (named-lambda :named-lambda)
+         (or :or)
+         (quote :quote)
+         (quote-identifier :quote-identifier)
+         (rsc-macro-transformer :rsc-macro-transformer)
+         (sc-macro-transformer :sc-macro-transformer)
+         (set! :set!)
+         (the-environment :the-environment))
   (export (runtime mit-macros)
          keyword:access
          keyword:define
@@ -4643,11 +4643,6 @@ USA.
   (export ()
          define-structure))
 
-(define-package (runtime syntax definitions)
-  (files "syntax-definitions")
-  (parent (runtime syntax))
-  (initialization (initialize-package!)))
-
 (define-package (runtime system-macros)
   (files "sysmac")
   (parent (runtime))

diff --git a/src/runtime/syntax-definitions.scm b/src/runtime/syntax-definitions.scm
deleted file mode 100644 (file)
index 55053e8..0000000
--- a/src/runtime/syntax-definitions.scm
+++ /dev/null
@@ -1,56 +0,0 @@
-#| -*-Scheme-*-
-
-Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
-    1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
-    2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016,
-    2017 Massachusetts Institute of Technology
-
-This file is part of MIT/GNU Scheme.
-
-MIT/GNU Scheme is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2 of the License, or (at
-your option) any later version.
-
-MIT/GNU Scheme is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with MIT/GNU Scheme; if not, write to the Free Software
-Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301,
-USA.
-
-|#
-
-;;;; Code to install syntax keywords in global environment
-;;; package: (runtime syntax definitions)
-
-(declare (usual-integrations))
-\f
-(add-boot-init!
- (lambda ()
-
-   (define (define-classifier name classifier)
-     (environment-define-macro system-global-environment
-                              name
-                              (classifier-item classifier)))
-
-   (define-classifier 'begin classifier:begin)
-   (define-classifier 'declare classifier:declare)
-   (define-classifier 'define-syntax classifier:define-syntax)
-   (define-classifier 'delay classifier:delay)
-   (define-classifier 'er-macro-transformer classifier:er-macro-transformer)
-   (define-classifier 'if classifier:if)
-   (define-classifier 'lambda classifier:lambda)
-   (define-classifier 'let-syntax classifier:let-syntax)
-   (define-classifier 'letrec-syntax classifier:letrec-syntax)
-   (define-classifier 'named-lambda classifier:named-lambda)
-   (define-classifier 'or classifier:or)
-   (define-classifier 'quote classifier:quote)
-   (define-classifier 'quote-identifier classifier:quote-identifier)
-   (define-classifier 'rsc-macro-transformer classifier:rsc-macro-transformer)
-   (define-classifier 'sc-macro-transformer classifier:sc-macro-transformer)
-   (define-classifier 'set! classifier:set!)
-   (define-classifier 'the-environment classifier:the-environment)))
\ No newline at end of file