diff --git a/ice-9/ChangeLog b/ice-9/ChangeLog index fb83cf599..b89b95233 100644 --- a/ice-9/ChangeLog +++ b/ice-9/ChangeLog @@ -1,3 +1,20 @@ +Fri Sep 5 03:09:09 1997 Mikael Djurfeldt + + * emacs.scm (emacs-load): Added new parameter `module'. + + * syncase.scm (putprop, getprop): Modified to use the object + properties of the variable object corresponding to the symbol; + This way we can ride on the mechanisms of the module system. + Changed `builtin-variable' calls to `define-public' calls. + Setup the hooks sc-expand and sc-interface. + + * boot-9.scm (sc-interface, sc-expand): New builtin variables. + (set-current-module): Switch to and from sc-expand as + scm:eval-transformer when going into and out of modules using + syncase macros. + (module-use!): Set scm:eval-transformer to sc-expand when adding + the syncase interface. + Thu Sep 4 14:57:04 1997 Mikael Djurfeldt * syncase.scm (putprop): Temporary fix which publishes new syntax diff --git a/ice-9/boot-9.scm b/ice-9/boot-9.scm index 42d645b71..4ab5c429f 100644 --- a/ice-9/boot-9.scm +++ b/ice-9/boot-9.scm @@ -1622,15 +1622,27 @@ ;; (define the-module #f) +;; Syntax case macro support +;; +(define sc-interface #f) +(define sc-expand #f) + ;; set-current-module module ;; ;; set the current module as viewed by the normalizer. ;; (define (set-current-module m) - (set! the-module m) - (if m - (set! *top-level-lookup-closure* (module-eval-closure the-module)) - (set! *top-level-lookup-closure* #f))) + (let ((from-sc-module? (and the-module + (memq sc-interface (module-uses the-module)))) + (to-sc-module? (and m + (memq sc-interface (module-uses m))))) + (set! the-module m) + (if from-sc-module? (set! scm:eval-transformer #f)) + (if m + (begin + (set! *top-level-lookup-closure* (module-eval-closure the-module)) + (if to-sc-module? (set! scm:eval-transformer sc-expand))) + (set! *top-level-lookup-closure* #f)))) ;; current-module @@ -1714,7 +1726,10 @@ ;; (define (module-use! module interface) (set-module-uses! module - (cons interface (delq! interface (module-uses module))))) + (cons interface (delq! interface (module-uses module)))) + (if (and (eq? interface sc-interface) + (eq? module (current-module))) + (set! scm:eval-transformer sc-expand))) ;;; {Recursive Namespaces} diff --git a/ice-9/emacs.scm b/ice-9/emacs.scm index 8bad32624..76867dc34 100644 --- a/ice-9/emacs.scm +++ b/ice-9/emacs.scm @@ -126,7 +126,7 @@ (read-char port) ; Read final newline #t))) -(define (emacs-load filename linum colnum interactivep) +(define (emacs-load filename linum colnum module interactivep) (set-port-filename! %%load-port filename) (set-port-line! %%load-port linum) (set-port-column! %%load-port colnum) diff --git a/ice-9/syncase.scm b/ice-9/syncase.scm index b5b20a984..a02487585 100644 --- a/ice-9/syncase.scm +++ b/ice-9/syncase.scm @@ -21,6 +21,31 @@ +;;; Exported variables + +(define-public install-global-transformer #f) +(define-public syntax-dispatch #f) +(define-public syntax-error #f) + +(define-public bound-identifier=? #f) +(define-public datum->syntax-object #f) +(define-public define-syntax #f) +(define-public fluid-let-syntax #f) +(define-public free-identifier=? #f) +(define-public generate-temporaries #f) +(define-public identifier? #f) +(define-public identifier-syntax #f) +(define-public let-syntax #f) +(define-public letrec-syntax #f) +(define-public syntax #f) +(define-public syntax-case #f) +(define-public syntax-object->datum #f) +(define-public syntax-rules #f) +(define-public with-syntax #f) + + +;;; Hooks needed by the syntax-case macro package + (define-public (void) *unspecified*) (define andmap @@ -49,32 +74,17 @@ (list why what) '()))) -(define (putprop s p v) - (builtin-variable s) - (set-symbol-property! s p v)) -(define getprop symbol-property) +(define (putprop symbol key binding) + (let* ((m (current-module)) + (v (or (module-variable m symbol) + (module-make-local-var! m symbol)))) + (set-object-property! v key binding))) -(define-public sc-expand #f) -(define-public install-global-transformer #f) -(define-public syntax-dispatch #f) -(define-public syntax-error #f) +(define (getprop symbol key) + (let* ((m (current-module)) + (v (module-variable m symbol))) + (and v (object-property v key)))) -;;;*fixme* builtin-variable -(define-public bound-identifier=? #f) -(define-public datum->syntax-object #f) -(builtin-variable 'define-syntax) -(builtin-variable 'fluid-let-syntax) -(define-public free-identifier=? #f) -(define-public generate-temporaries #f) -(define-public identifier? #f) -(builtin-variable 'identifier-syntax) -(builtin-variable 'let-syntax) -(builtin-variable 'letrec-syntax) -(builtin-variable 'syntax) -(builtin-variable 'syntax-case) -(define-public syntax-object->datum #f) -(builtin-variable 'syntax-rules) -(builtin-variable 'with-syntax) ;;; Compatibility @@ -99,6 +109,9 @@ (apply consumer (access-values result)) (consumer result)))))) + +;;; Load the preprocessed code + (let ((old-debug #f) (old-read #f)) (dynamic-wind (lambda () @@ -112,17 +125,14 @@ (debug-options old-debug) (read-options old-read)))) -;; The followin line is necessary only if we start making changes + +;;; The following line is necessary only if we start making changes ;; (load-from-path "ice-9/psyntax.ss") -(define-public (eval-options . args) - '()) -;;; *fixme* -(define-public (eval-enable x) - (variable-set! (builtin-variable 'scm:eval-transformer) sc-expand)) +;;; Setup some hooks for the module system and the evaluator -(define-public (eval-disable x) - (variable-set! (builtin-variable 'scm:eval-transformer) #f)) - -(eval-enable 'syncase) +(variable-set! (builtin-variable 'sc-interface) + (module-public-interface (current-module))) +(variable-set! (builtin-variable 'sc-expand) sc-expand) +(variable-set! (builtin-variable 'scm:eval-transformer) #f)