Store macro definitions in environments rather than in syntax tables.

diff --git a/v7/src/edwin/clsmac.scm b/v7/src/edwin/clsmac.scm
index afab5d6bfff12a8379d4a3e260b7c49d1f918c00..33b839a5dc3dd8f58fce66a2da2455e14de74fe0 100644 (file)
--- a/v7/src/edwin/clsmac.scm
+++ b/v7/src/edwin/clsmac.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;$Id: clsmac.scm,v 1.5 2001/12/19 01:41:36 cph Exp $
+;;;$Id: clsmac.scm,v 1.6 2001/12/21 18:41:10 cph Exp $
 ;;;
 ;;; Copyright (c) 1986, 1989, 1999, 2001 Massachusetts Institute of Technology
 ;;;
@@ -29,13 +29,7 @@
 ;;; likely will not ever, be supported as a part of the Scheme system.
 ;;; ******************************************************************
 \f
-(define window-environment
-  (->environment '(EDWIN WINDOW)))
-
-(set-environment-syntax-table! window-environment
-                              (make-syntax-table (->environment '(EDWIN))))
-
-(syntax-table/define window-environment 'DEFINE-CLASS
+(define-syntax define-class
   (lambda (name superclass variables)
     (guarantee-symbol "Class name" name)
     (if (not (null? superclass))
@@ -50,20 +44,20 @@
                   ,(if (null? superclass) false superclass)
                   ',variables))))
 
-(syntax-table/define window-environment 'DEFINE-METHOD
+(define-syntax define-method
   (lambda (class bvl . body)
     (syntax-class-definition class bvl body
       (lambda (name expression)
        (make-syntax-closure
         (make-method-definition class name expression))))))
 
-(syntax-table/define window-environment 'WITH-INSTANCE-VARIABLES
+(define-syntax with-instance-variables
   (lambda (class self free-names . body)
     (guarantee-symbol "Self name" self)
     (make-syntax-closure
      (syntax-class-expression class self free-names body))))
 
-(syntax-table/define window-environment '=>
+(define-syntax =>
   (lambda (object operation . arguments)
     (guarantee-symbol "Operation name" operation)
     (let ((obname (string->uninterned-symbol "object")))
@@ -72,7 +66,7 @@
          ,obname
          ,@arguments)))))
 
-(syntax-table/define window-environment 'USUAL=>
+(define-syntax usual=>
   (lambda (object operation . arguments)
     (guarantee-symbol "Operation name" operation)
     (if (not *class-name*)

diff --git a/v7/src/edwin/edwin.pkg b/v7/src/edwin/edwin.pkg
index 253c367441e358c0b5523fa80823c5b69838e3af..c575c14b9fe474476e53897ecd40bc45848f3a52 100644 (file)
--- a/v7/src/edwin/edwin.pkg
+++ b/v7/src/edwin/edwin.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: edwin.pkg,v 1.278 2001/12/19 01:43:59 cph Exp $
+$Id: edwin.pkg,v 1.279 2001/12/21 18:41:18 cph Exp $
 
 Copyright (c) 1989-2001 Massachusetts Institute of Technology
 
@@ -107,6 +107,10 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
          output-buffer/write-substring-block)
   (import (runtime char-syntax)
          char-syntax-table/entries)
+  (import (runtime)
+         define-primitives
+         ucode-primitive
+         ucode-type)
   (export (edwin class-macros)
          class-instance-transforms)
   (export ()
@@ -122,6 +126,12 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
 (define-package (edwin class-macros)
   (files "clsmac")
   (parent (edwin))
+  (export (edwin window)
+         =>
+         define-class
+         define-method
+         usual=>
+         with-instance-variables)
   (import ()
          (make-scode-variable make-variable)
          (scode-variable-name variable-name)))
@@ -148,9 +158,22 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
   (parent (edwin))
   (export (edwin)
          canonicalize-name
+         command-defined?
          command-name->scheme-name
+         define-command
+         define-major-mode
+         define-minor-mode
+         define-variable
+         define-variable-per-buffer
          edwin-syntax-table
+         local-set-variable!
          mode-name->scheme-name
+         ref-command
+         ref-command-object
+         ref-mode-object
+         ref-variable
+         ref-variable-object
+         set-variable!
          variable-name->scheme-name))
 
 (define-package (edwin group-operations)

diff --git a/v7/src/edwin/macros.scm b/v7/src/edwin/macros.scm
index e89ecc6b5f8abff70811740bedfac5ad6e180642..f8d41843815b5662f5c399b8481e9f780128fc74 100644 (file)
--- a/v7/src/edwin/macros.scm
+++ b/v7/src/edwin/macros.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: macros.scm,v 1.67 2001/12/19 01:46:08 cph Exp $
+;;; $Id: macros.scm,v 1.68 2001/12/21 18:41:22 cph Exp $
 ;;;
 ;;; Copyright (c) 1986, 1989-1999 Massachusetts Institute of Technology
 ;;;
@@ -22,20 +22,9 @@
 
 (declare (usual-integrations))
 \f
-(define edwin-environment (->environment '(EDWIN)))
-(define edwin-syntax-table edwin-environment) ;upwards compatibility
+(define edwin-syntax-table (->environment '(EDWIN))) ;upwards compatibility
 
-(set-environment-syntax-table! edwin-environment
-                              (make-syntax-table (->environment '())))
-
-(let ((runtime-environment (->environment '(RUNTIME))))
-  (for-each
-   (lambda (name)
-     (syntax-table/define edwin-environment name
-                         (syntax-table/ref runtime-environment name)))
-   (syntax-table/defined-names runtime-environment)))
-
-(syntax-table/define edwin-environment 'DEFINE-COMMAND
+(define-syntax define-command
   (lambda (name description interactive procedure)
     (let ((name (canonicalize-name name)))
       (let ((scheme-name (command-name->scheme-name name)))
@@ -53,16 +42,16 @@
                                 ,@(cddr procedure))
                              procedure)))))))
 
-(syntax-table/define edwin-environment 'REF-COMMAND-OBJECT
+(define-syntax ref-command-object
   (lambda (name)
     (command-name->scheme-name (canonicalize-name name))))
 
-(syntax-table/define edwin-environment 'REF-COMMAND
+(define-syntax ref-command
   (lambda (name)
     `(COMMAND-PROCEDURE
       ,(command-name->scheme-name (canonicalize-name name)))))
 
-(syntax-table/define edwin-environment 'COMMAND-DEFINED?
+(define-syntax command-defined?
   (lambda (name)
     (let ((variable-name (command-name->scheme-name (canonicalize-name name))))
       `(LET ((_ENV (->ENVIRONMENT '(EDWIN))))
@@ -72,43 +61,46 @@
 (define (command-name->scheme-name name)
   (symbol-append 'EDWIN-COMMAND$ name))
 \f
-(let ((variable-definition
-       (lambda (buffer-local?)
-        (lambda (name description #!optional value test normalization)
-          (let ((name (canonicalize-name name)))
-            (let ((scheme-name (variable-name->scheme-name name)))
-              `(BEGIN
-                 (DEFINE ,scheme-name
-                   (MAKE-VARIABLE ',name
-                                  ,description
-                                  ,(if (default-object? value) '#F value)
-                                  ',buffer-local?))
-                 ,@(if (default-object? test)
-                       '()
-                       `((SET-VARIABLE-VALUE-VALIDITY-TEST! ,scheme-name
-                                                            ,test)))
-                 ,@(if (default-object? normalization)
-                       '()
-                       `((SET-VARIABLE-VALUE-NORMALIZATION!
-                          ,scheme-name
-                          ,normalization))))))))))
-  (syntax-table/define edwin-environment 'DEFINE-VARIABLE
-    (variable-definition false))
-  (syntax-table/define edwin-environment 'DEFINE-VARIABLE-PER-BUFFER
-    (variable-definition true)))
-
-(syntax-table/define edwin-environment 'REF-VARIABLE-OBJECT
+(define-syntax define-variable
+  (lambda args
+    (apply (variable-definition #f) args)))
+
+(define-syntax define-variable-per-buffer
+  (lambda args
+    (apply (variable-definition #t) args)))
+
+(define (variable-definition buffer-local?)
+  (lambda (name description #!optional value test normalization)
+    (let ((name (canonicalize-name name)))
+      (let ((scheme-name (variable-name->scheme-name name)))
+       `(BEGIN
+          (DEFINE ,scheme-name
+            (MAKE-VARIABLE ',name
+                           ,description
+                           ,(if (default-object? value) '#F value)
+                           ',buffer-local?))
+          ,@(if (default-object? test)
+                '()
+                `((SET-VARIABLE-VALUE-VALIDITY-TEST! ,scheme-name
+                                                     ,test)))
+          ,@(if (default-object? normalization)
+                '()
+                `((SET-VARIABLE-VALUE-NORMALIZATION!
+                   ,scheme-name
+                   ,normalization))))))))
+
+(define-syntax ref-variable-object
   (lambda (name)
     (variable-name->scheme-name (canonicalize-name name))))
 
-(syntax-table/define edwin-environment 'REF-VARIABLE
+(define-syntax ref-variable
   (lambda (name #!optional buffer)
     (let ((name (variable-name->scheme-name (canonicalize-name name))))
       (if (default-object? buffer)
          `(VARIABLE-VALUE ,name)
          `(VARIABLE-LOCAL-VALUE ,buffer ,name)))))
 
-(syntax-table/define edwin-environment 'SET-VARIABLE!
+(define-syntax set-variable!
   (lambda (name #!optional value buffer)
     (let ((name (variable-name->scheme-name (canonicalize-name name)))
          (value (if (default-object? value) '#F value)))
@@ -116,7 +108,7 @@
          `(SET-VARIABLE-VALUE! ,name ,value)
          `(SET-VARIABLE-LOCAL-VALUE! ,buffer ,name ,value)))))
 
-(syntax-table/define edwin-environment 'LOCAL-SET-VARIABLE!
+(define-syntax local-set-variable!
   (lambda (name #!optional value buffer)
     `(DEFINE-VARIABLE-LOCAL-VALUE!
       ,(if (default-object? buffer) '(CURRENT-BUFFER) buffer)
@@ -126,7 +118,7 @@
 (define (variable-name->scheme-name name)
   (symbol-append 'EDWIN-VARIABLE$ name))
 \f
-(syntax-table/define edwin-environment 'DEFINE-MAJOR-MODE
+(define-syntax define-major-mode
   (lambda (name super-mode-name display-name description
                #!optional initialization)
     (let ((name (canonicalize-name name))
@@ -156,7 +148,7 @@
                             (initialization)
                             (else `(LAMBDA (BUFFER) BUFFER UNSPECIFIC)))))))))
 
-(syntax-table/define edwin-environment 'DEFINE-MINOR-MODE
+(define-syntax define-minor-mode
   (lambda (name display-name description #!optional initialization)
     (let ((name (canonicalize-name name)))
       `(DEFINE ,(mode-name->scheme-name name)
@@ -170,7 +162,7 @@
                         initialization
                         `(LAMBDA (BUFFER) BUFFER UNSPECIFIC)))))))
 
-(syntax-table/define edwin-environment 'REF-MODE-OBJECT
+(define-syntax ref-mode-object
   (lambda (name)
     (mode-name->scheme-name (canonicalize-name name))))
 

diff --git a/v7/src/runtime/defstr.scm b/v7/src/runtime/defstr.scm
index 9252033fac6b11657906790aadfcbbd045367cb4..6fa928a661c75e4687cb5de341eff1aabbe4d422 100644 (file)
--- a/v7/src/runtime/defstr.scm
+++ b/v7/src/runtime/defstr.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: defstr.scm,v 14.34 2001/12/20 06:34:28 cph Exp $
+$Id: defstr.scm,v 14.35 2001/12/21 18:37:18 cph Exp $
 
 Copyright (c) 1988-1999, 2001 Massachusetts Institute of Technology
 
@@ -70,12 +70,7 @@ differences:
 
 |#
 \f
-(define (initialize-define-structure-macro!)
-  (syntax-table/define system-global-environment
-                      'DEFINE-STRUCTURE
-                      transform/define-structure))
-
-(define transform/define-structure
+(define-syntax define-structure
   (lambda (name-and-options . slot-descriptions)
     (let ((structure
           (with-values

diff --git a/v7/src/runtime/make.scm b/v7/src/runtime/make.scm
index f6e69731649ea057bfe4b9fa6bc39e6a2e92dc90..f3b8bb89b8f358b52f09cf43a643b7e27f1f8057 100644 (file)
--- a/v7/src/runtime/make.scm
+++ b/v7/src/runtime/make.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: make.scm,v 14.80 2001/12/21 18:22:20 cph Exp $
+$Id: make.scm,v 14.81 2001/12/21 18:37:23 cph Exp $
 
 Copyright (c) 1988-2001 Massachusetts Institute of Technology
 
@@ -475,7 +475,6 @@ USA.
    (RUNTIME SYNTAXER)
    (RUNTIME ILLEGAL-DEFINITIONS)
    (RUNTIME MACROS)
-   ((RUNTIME DEFSTRUCT) INITIALIZE-DEFINE-STRUCTURE-MACRO! #t)
    (RUNTIME UNSYNTAXER)
    (RUNTIME PRETTY-PRINTER)
    (RUNTIME EXTENDED-SCODE-EVAL)

diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index 1bae827686edc7d7b301c6e3ebcf642d00174fb7..79566fd25cb7af4aa4a97beb415669cc296a51f4 100644 (file)
--- a/v7/src/runtime/runtime.pkg
+++ b/v7/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.400 2001/12/21 18:22:33 cph Exp $
+$Id: runtime.pkg,v 14.401 2001/12/21 18:37:35 cph Exp $
 
 Copyright (c) 1988-2001 Massachusetts Institute of Technology
 
@@ -1241,6 +1241,7 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
   (files "defstr")
   (parent (runtime))
   (export ()
+         define-structure
          define-structure/keyword-parser
          define-structure/list-accessor
          define-structure/list-modifier
@@ -1250,8 +1251,7 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
          named-structure/description
          named-structure?)
   (export (runtime unparser)
-         structure-tag/unparser-method)
-  (initialization (initialize-package!)))
+         structure-tag/unparser-method))
 
 (define-package (runtime directory)
   (parent (runtime))
@@ -3755,14 +3755,12 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
   (files "syntab")
   (parent (runtime))
   (export ()
-         guarantee-syntax-table
-         make-syntax-table
-         syntax-table/define
-         syntax-table/ref
-         syntax-table?)
+         syntax-table/define)
   (export (runtime syntaxer)
+         guarantee-syntax-table
          syntax-table/environment
-         syntax-table/extend))
+         syntax-table/extend
+         syntax-table/ref))
 
 (define-package (runtime syntaxer)
   (files "syntax")

diff --git a/v7/src/sf/pardec.scm b/v7/src/sf/pardec.scm
index 03a67ac19d1d2569c9ea65db473523956db520af..45885b7ba0d39b4536198c41476cef82f3ce40ff 100644 (file)
--- a/v7/src/sf/pardec.scm
+++ b/v7/src/sf/pardec.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: pardec.scm,v 4.13 2001/12/20 06:35:49 cph Exp $
+$Id: pardec.scm,v 4.14 2001/12/21 18:39:20 cph Exp $
 
 Copyright (c) 1988-2001 Massachusetts Institute of Technology
 
@@ -272,9 +272,7 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
            externs))))
      (append-map (lambda (specification)
                   (let ((value
-                         (scode-eval
-                          (syntax specification system-global-environment)
-                          syntaxer/default-environment)))
+                         (eval specification system-global-environment)))
                     (if (pair? value)
                         (map ->pathname value)
                         (list (->pathname value)))))

diff --git a/v7/src/sf/sf.pkg b/v7/src/sf/sf.pkg
index e453e3b131e763154a86d12ee3aa7e2eafbaa865..8786d426f8c4cfc347311f72a67801067891d577 100644 (file)
--- a/v7/src/sf/sf.pkg
+++ b/v7/src/sf/sf.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: sf.pkg,v 4.14 2001/12/19 05:26:35 cph Exp $
+$Id: sf.pkg,v 4.15 2001/12/21 18:39:24 cph Exp $
 
 Copyright (c) 1987-1999, 2001 Massachusetts Institute of Technology
 
@@ -116,9 +116,7 @@ USA.
          declarations/map
          declarations/original
          declarations/parse
-         operations->external)
-  (import (runtime syntaxer)
-         syntaxer/default-environment))
+         operations->external))
 
 (define-package (scode-optimizer copy)
   (files "copy")