mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-10 14:00:21 +02:00
Code Activity

* psyntax.ss (build-data): Don't quote self-evaluating expressions

Browse source 
in output.  (We normally *would* like also these expressions to be
quoted, but until Guile's native macros and syncase cooperates
better, it is less destructive not to quote.)
(self-evaluating?): Removed null? (In Guile, the empty list is not
self-evaluating).
(sc-chi): Export chi as sc-chi.
(external-macro): New syntax type.

* psyntax.pp: Regenerated.

* compile-psyntax.scm: Set expansion-eval-closure.

* syncase.scm: Set expansion-eval-closure to
the-syncase-eval-closure during booting so that variables are
created in the correct module.
(syncase): Set expansion-eval-closure.
(define-syntax define-syntax-public eval-when fluid-let-syntax
identifier-syntax let-syntax letrec-syntax syntax syntax-case
syntax-rules with-syntax include): Removed definitions (these are
created from within psyntax.pp).
Enable expansion of Guile macros during a syntax-case
transformation.
This commit is contained in:
Mikael Djurfeldt 2003-01-16 11:48:14 +00:00
parent cf743aeae6
commit 80f225df0e
5 changed files with 97 additions and 44 deletions
Download patch file Download diff file Expand all files Collapse all files

18
ice-9/ChangeLog
View file

@ -1,4 +1,17 @@
2003-01-15 Mikael Djurfeldt <djurfeldt@nada.kth.se>
2003-01-16 Mikael Djurfeldt <djurfeldt@nada.kth.se>
* psyntax.ss (build-data): Don't quote self-evaluating expressions
in output. (We normally *would* like also these expressions to be
quoted, but until Guile's native macros and syncase cooperates
better, it is less destructive not to quote.)
(self-evaluating?): Removed null? (In Guile, the empty list is not
self-evaluating).
(sc-chi): Export chi as sc-chi.
(external-macro): New syntax type.
* psyntax.pp: Regenerated.
* compile-psyntax.scm: Set expansion-eval-closure.
* boot-9.scm (use-syntax): Return *unspecified*.
@ -10,7 +23,8 @@
identifier-syntax let-syntax letrec-syntax syntax syntax-case
syntax-rules with-syntax include): Removed definitions (these are
created from within psyntax.pp).
Enable expansion of Guile macros during a syntax-case
transformation.
2003-01-10 Mikael Djurfeldt <djurfeldt@nada.kth.se>

20
ice-9/compile-psyntax.scm
View file

@ -12,14 +12,16 @@
(let ((in (open-input-file source))
(out (open-output-file (string-append target ".tmp"))))
(let loop ((x (read in)))
(if (eof-object? x)
(begin
(close-port out)
(close-port in))
(begin
(write (sc-expand3 x 'c '(compile load eval)) out)
(newline out)
(loop (read in))))))
(with-fluids ((expansion-eval-closure
(module-eval-closure (current-module))))
(let loop ((x (read in)))
(if (eof-object? x)
(begin
(close-port out)
(close-port in))
(begin
(write (sc-expand3 x 'c '(compile load eval)) out)
(newline out)
(loop (read in)))))))
(system (format #f "mv -f ~s.tmp ~s" target target))

22
ice-9/psyntax.pp
View file

File diff suppressed because one or more lines are too long

34
ice-9/psyntax.ss
View file

@ -1,6 +1,6 @@
;;;; -*-scheme-*-
;;;;
;;;; Copyright (C) 2001 Free Software Foundation, Inc.
;;;; Copyright (C) 2001, 2003 Free Software Foundation, Inc.
;;;;
;;;; This program is free software; you can redistribute it and/or modify
;;;; it under the terms of the GNU General Public License as published by
@ -418,9 +418,10 @@
((_ src name) name)
((_ src level name) name)))
(define-syntax build-data
(syntax-rules ()
((_ src exp) `',exp)))
(define (build-data src exp)
(if (self-evaluating? exp)
exp
(list 'quote exp)))
(define build-sequence
(lambda (src exps)
@ -454,7 +455,7 @@
(syntax-rules ()
((_ e)
(let ((x e))
(or (boolean? x) (number? x) (string? x) (char? x) (null? x) (keyword? x))))))
(or (boolean? x) (number? x) (string? x) (char? x) (keyword? x))))))
)
(define-structure (syntax-object expression wrap))
@ -504,6 +505,7 @@
;;; <binding> ::= (macro . <procedure>) macros
;;; (core . <procedure>) core forms
;;; (external-macro . <procedure>) external-macro
;;; (begin) begin
;;; (define) define
;;; (define-syntax) define-syntax
@ -918,6 +920,7 @@
;;; type value explanation
;;; -------------------------------------------------------------------
;;; core procedure core form (including singleton)
;;; external-macro procedure external macro
;;; lexical name lexical variable reference
;;; global name global variable reference
;;; begin none begin keyword
@ -971,7 +974,7 @@
((macro)
(syntax-type (chi-macro (binding-value b) e r w rib)
r empty-wrap s rib))
((core) (values type (binding-value b) e w s))
((core external-macro) (values type (binding-value b) e w s))
((local-syntax)
(values 'local-syntax-form (binding-value b) e w s))
((begin) (values 'begin-form #f e w s))
@ -1077,15 +1080,20 @@
(chi-install-global n (chi e r w))))
(chi-void)))))
((define-form)
(let ((n (id-var-name value w)))
(case (binding-type (lookup n r))
(let* ((n (id-var-name value w))
(type (binding-type (lookup n r))))
(case type
((global)
(eval-if-c&e m
(build-global-definition s n (chi e r w))))
((displaced-lexical)
(syntax-error (wrap value w) "identifier out of context"))
(else (syntax-error (wrap value w)
"cannot define keyword at top level")))))
(else
(if (eq? type 'external-macro)
(eval-if-c&e m
(build-global-definition s n (chi e r w)))
(syntax-error (wrap value w)
"cannot define keyword at top level"))))))
(else (eval-if-c&e m (chi-expr type value e r w s))))))))
(define chi
@ -1100,7 +1108,7 @@
(case type
((lexical)
(build-lexical-reference 'value s value))
((core) (value e r w s))
((core external-macro) (value e r w s))
((lexical-call)
(chi-application
(build-lexical-reference 'fun (source-annotation (car e)) value)
@ -1351,7 +1359,7 @@
(let ((p (local-eval-hook expanded)))
(if (procedure? p)
p
(syntax-error p "nonprocedure transfomer")))))
(syntax-error p "nonprocedure transformer")))))
(define chi-void
(lambda ()
@ -2055,6 +2063,8 @@
(match* (unannotate (syntax-object-expression e))
p (syntax-object-wrap e) '()))
(else (match* (unannotate e) p empty-wrap '())))))
(set! sc-chi chi)
))
)

47
ice-9/syncase.scm
View file

@ -75,6 +75,7 @@
(define sc-expand #f)
(define sc-expand3 #f)
(define sc-chi #f)
(define install-global-transformer #f)
(define syntax-dispatch #f)
(define syntax-error #f)
@ -130,21 +131,47 @@
(fluid-set! expansion-eval-closure the-syncase-eval-closure)
(define (putprop symbol key binding)
(let* ((v ((fluid-ref expansion-eval-closure) symbol #t)))
(if (symbol-property symbol 'primitive-syntax)
(if (eq? (fluid-ref expansion-eval-closure) the-syncase-eval-closure)
(set-object-property! (module-variable the-root-module symbol)
key
binding))
(let* ((eval-closure (fluid-ref expansion-eval-closure))
;; Why not simply do (eval-closure symbol #t)?
;; Answer: That would overwrite imported bindings
(v (or (eval-closure symbol #f) ;lookup
(eval-closure symbol #t) ;create it locally
)))
;; Don't destroy Guile macros corresponding to
;; primitive syntax when syncase boots.
(if (not (and (symbol-property symbol 'primitive-syntax)
(eq? eval-closure the-syncase-eval-closure)))
(variable-set! v sc-macro))
;; Properties are tied to variable objects
(set-object-property! v key binding)))
(define (getprop symbol key)
(let* ((v ((fluid-ref expansion-eval-closure) symbol #f)))
(and v (or (object-property v key)
(let ((root-v (module-local-variable the-root-module symbol)))
(and (equal? root-v v)
(object-property root-v key)))))))
(and v
(or (object-property v key)
(and (variable-bound? v)
(macro? (variable-ref v))
(macro-transformer (variable-ref v)) ;non-primitive
guile-macro)))))
(define guile-macro
(cons 'external-macro
(lambda (e r w s)
(if (symbol? e)
;; pass the expression through
e
(let* ((eval-closure (fluid-ref expansion-eval-closure))
(m (variable-ref (eval-closure (car e) #f))))
(if (eq? (macro-type m) 'syntax)
;; pass the expression through
e
;; perform Guile macro transform
(let ((e ((macro-transformer m)
e
(append r (list eval-closure)))))
(if (null? r)
(sc-expand e)
(sc-chi e r w)))))))))
(define generated-symbols (make-weak-key-hash-table 1019))