1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-01 12:20:26 +02:00

* 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.
This commit is contained in:
Mikael Djurfeldt 1997-09-05 01:21:02 +00:00
parent 1f355b4f35
commit d43f8c9708
4 changed files with 82 additions and 40 deletions

View file

@ -1,3 +1,20 @@
Fri Sep 5 03:09:09 1997 Mikael Djurfeldt <mdj@mdj.nada.kth.se>
* 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 <mdj@mdj.nada.kth.se> Thu Sep 4 14:57:04 1997 Mikael Djurfeldt <mdj@mdj.nada.kth.se>
* syncase.scm (putprop): Temporary fix which publishes new syntax * syncase.scm (putprop): Temporary fix which publishes new syntax

View file

@ -1622,15 +1622,27 @@
;; ;;
(define the-module #f) (define the-module #f)
;; Syntax case macro support
;;
(define sc-interface #f)
(define sc-expand #f)
;; set-current-module module ;; set-current-module module
;; ;;
;; set the current module as viewed by the normalizer. ;; set the current module as viewed by the normalizer.
;; ;;
(define (set-current-module m) (define (set-current-module m)
(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) (set! the-module m)
(if from-sc-module? (set! scm:eval-transformer #f))
(if m (if m
(begin
(set! *top-level-lookup-closure* (module-eval-closure the-module)) (set! *top-level-lookup-closure* (module-eval-closure the-module))
(set! *top-level-lookup-closure* #f))) (if to-sc-module? (set! scm:eval-transformer sc-expand)))
(set! *top-level-lookup-closure* #f))))
;; current-module ;; current-module
@ -1714,7 +1726,10 @@
;; ;;
(define (module-use! module interface) (define (module-use! module interface)
(set-module-uses! module (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} ;;; {Recursive Namespaces}

View file

@ -126,7 +126,7 @@
(read-char port) ; Read final newline (read-char port) ; Read final newline
#t))) #t)))
(define (emacs-load filename linum colnum interactivep) (define (emacs-load filename linum colnum module interactivep)
(set-port-filename! %%load-port filename) (set-port-filename! %%load-port filename)
(set-port-line! %%load-port linum) (set-port-line! %%load-port linum)
(set-port-column! %%load-port colnum) (set-port-column! %%load-port colnum)

View file

@ -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-public (void) *unspecified*)
(define andmap (define andmap
@ -49,32 +74,17 @@
(list why what) (list why what)
'()))) '())))
(define (putprop s p v) (define (putprop symbol key binding)
(builtin-variable s) (let* ((m (current-module))
(set-symbol-property! s p v)) (v (or (module-variable m symbol)
(define getprop symbol-property) (module-make-local-var! m symbol))))
(set-object-property! v key binding)))
(define-public sc-expand #f) (define (getprop symbol key)
(define-public install-global-transformer #f) (let* ((m (current-module))
(define-public syntax-dispatch #f) (v (module-variable m symbol)))
(define-public syntax-error #f) (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 ;;; Compatibility
@ -99,6 +109,9 @@
(apply consumer (access-values result)) (apply consumer (access-values result))
(consumer result)))))) (consumer result))))))
;;; Load the preprocessed code
(let ((old-debug #f) (let ((old-debug #f)
(old-read #f)) (old-read #f))
(dynamic-wind (lambda () (dynamic-wind (lambda ()
@ -112,17 +125,14 @@
(debug-options old-debug) (debug-options old-debug)
(read-options old-read)))) (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") ;; (load-from-path "ice-9/psyntax.ss")
(define-public (eval-options . args)
'())
;;; *fixme* ;;; Setup some hooks for the module system and the evaluator
(define-public (eval-enable x)
(variable-set! (builtin-variable 'scm:eval-transformer) sc-expand))
(define-public (eval-disable x) (variable-set! (builtin-variable 'sc-interface)
(variable-set! (builtin-variable 'scm:eval-transformer) #f)) (module-public-interface (current-module)))
(variable-set! (builtin-variable 'sc-expand) sc-expand)
(eval-enable 'syncase) (variable-set! (builtin-variable 'scm:eval-transformer) #f)