From 2793f01a820aac2a21c1100c4b827c791ad7875b Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Fri, 21 Dec 2001 18:41:22 +0000 Subject: [PATCH] Store macro definitions in environments rather than in syntax tables. --- v7/src/edwin/clsmac.scm | 18 +++----- v7/src/edwin/edwin.pkg | 25 ++++++++++- v7/src/edwin/macros.scm | 90 +++++++++++++++++--------------------- v7/src/runtime/defstr.scm | 9 +--- v7/src/runtime/make.scm | 3 +- v7/src/runtime/runtime.pkg | 16 +++---- v7/src/sf/pardec.scm | 6 +-- v7/src/sf/sf.pkg | 6 +-- 8 files changed, 85 insertions(+), 88 deletions(-) diff --git a/v7/src/edwin/clsmac.scm b/v7/src/edwin/clsmac.scm index afab5d6bf..33b839a5d 100644 --- 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. ;;; ****************************************************************** -(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 253c36744..c575c14b9 100644 --- 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 e89ecc6b5..f8d418438 100644 --- 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)) -(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)) -(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)) -(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 9252033fa..6fa928a66 100644 --- 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: |# -(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 f6e697316..f3b8bb89b 100644 --- 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 1bae82768..79566fd25 100644 --- 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 03a67ac19..45885b7ba 100644 --- 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 e453e3b13..8786d426f 100644 --- 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") -- 2.25.1