1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00

new syntax procedures to (system syntax)

* module/ice-9/boot-9.scm:
* module/ice-9/psyntax.scm (syntax-module, syntax-local-binding)
  (syntax-locally-bound-identifiers): After boot, move these definitions
  to a new (system syntax) module.

* module/ice-9/psyntax-pp.scm: Regenerate.

* doc/ref/api-macros.texi: Add some words about syntax-module and
  friends being in (system syntax).
This commit is contained in:
Andy Wingo 2012-01-25 21:29:53 +01:00
parent 1ace4fbf3d
commit 68fcf71189
4 changed files with 12375 additions and 12338 deletions

View file

@ -706,6 +706,18 @@ Return the source properties that correspond to the syntax object
@var{x}. @xref{Source Properties}, for more information.
@end deffn
Guile also offers some more experimental interfaces in a separate
module. As was the case with the Large Hadron Collider, it is unclear
to our senior macrologists whether adding these interfaces will result
in awesomeness or in the destruction of Guile via the creation of a
singularity. We will preserve their functionality through the 2.0
series, but we reserve the right to modify them in a future stable
series, to a more than usual degree.
@example
(use-modules (system syntax))
@end example
@deffn {Scheme Procedure} syntax-module id
Return the name of the module whose source contains the identifier
@var{id}.

View file

@ -385,13 +385,10 @@ If there is no handler at all, Guile prints an error and then exits."
(define datum->syntax #f)
(define syntax->datum #f)
(define syntax-source #f)
(define syntax-module #f)
(define identifier? #f)
(define generate-temporaries #f)
(define bound-identifier=? #f)
(define free-identifier=? #f)
(define syntax-local-binding #f)
(define syntax-locally-bound-identifiers #f)
;; $sc-dispatch is an implementation detail of psyntax. It is used by
;; expanded macros, to dispatch an input against a set of patterns.
@ -3863,12 +3860,43 @@ module '(ice-9 q) '(make-q q-length))}."
;;; Place the user in the guile-user module.
;;; SRFI-4 in the default environment. FIXME: we should figure out how
;;; to deprecate this.
;;;
;; FIXME:
(module-use! the-scm-module (resolve-interface '(srfi srfi-4)))
;;; A few identifiers that need to be defined in this file are really
;;; internal implementation details. We shove them off into internal
;;; modules, removing them from the (guile) module.
;;;
(define-module (system syntax))
(let ()
(define (steal-bindings! from to ids)
(for-each
(lambda (sym)
(let ((v (module-local-variable from sym)))
(module-remove! from sym)
(module-add! to sym v)))
ids)
(module-export! to ids))
(steal-bindings! the-root-module (resolve-module '(system syntax))
'(syntax-local-binding
syntax-module
syntax-locally-bound-identifiers)))
;;; Place the user in the guile-user module.
;;;
;; Set filename to #f to prevent reload.
(define-module (guile-user)
#:autoload (system base compile) (compile compile-file)

File diff suppressed because it is too large Load diff

View file

@ -2525,44 +2525,6 @@
(set! syntax-source
(lambda (x) (source-annotation x)))
(set! syntax-module
(lambda (id)
(arg-check nonsymbol-id? id 'syntax-module)
(cdr (syntax-object-module id))))
(set! syntax-local-binding
(lambda (id)
(arg-check nonsymbol-id? id 'syntax-local-binding)
(with-transformer-environment
(lambda (e r w s rib mod)
(define (strip-anti-mark w)
(let ((ms (wrap-marks w)) (s (wrap-subst w)))
(if (and (pair? ms) (eq? (car ms) the-anti-mark))
;; output is from original text
(make-wrap (cdr ms) (if rib (cons rib (cdr s)) (cdr s)))
;; output introduced by macro
(make-wrap ms (if rib (cons rib s) s)))))
(call-with-values (lambda ()
(resolve-identifier
(syntax-object-expression id)
(strip-anti-mark (syntax-object-wrap id))
r
(syntax-object-module id)))
(lambda (type value mod)
(case type
((lexical) (values 'lexical value))
((macro) (values 'macro value))
((syntax) (values 'pattern-variable value))
((displaced-lexical) (values 'displaced-lexical #f))
((global) (values 'global (cons value (cdr mod))))
(else (values 'other #f)))))))))
(set! syntax-locally-bound-identifiers
(lambda (x)
(arg-check nonsymbol-id? x 'syntax-locally-bound-identifiers)
(locally-bound-identifiers (syntax-object-wrap x)
(syntax-object-module x))))
(set! generate-temporaries
(lambda (ls)
(arg-check list? ls 'generate-temporaries)
@ -2591,6 +2553,50 @@
(strip form empty-wrap)
(and subform (strip subform empty-wrap)))))
(let ()
(define (syntax-module id)
(arg-check nonsymbol-id? id 'syntax-module)
(cdr (syntax-object-module id)))
(define (syntax-local-binding id)
(arg-check nonsymbol-id? id 'syntax-local-binding)
(with-transformer-environment
(lambda (e r w s rib mod)
(define (strip-anti-mark w)
(let ((ms (wrap-marks w)) (s (wrap-subst w)))
(if (and (pair? ms) (eq? (car ms) the-anti-mark))
;; output is from original text
(make-wrap (cdr ms) (if rib (cons rib (cdr s)) (cdr s)))
;; output introduced by macro
(make-wrap ms (if rib (cons rib s) s)))))
(call-with-values (lambda ()
(resolve-identifier
(syntax-object-expression id)
(strip-anti-mark (syntax-object-wrap id))
r
(syntax-object-module id)))
(lambda (type value mod)
(case type
((lexical) (values 'lexical value))
((macro) (values 'macro value))
((syntax) (values 'pattern-variable value))
((displaced-lexical) (values 'displaced-lexical #f))
((global) (values 'global (cons value (cdr mod))))
(else (values 'other #f))))))))
(define (syntax-locally-bound-identifiers id)
(arg-check nonsymbol-id? id 'syntax-locally-bound-identifiers)
(locally-bound-identifiers (syntax-object-wrap id)
(syntax-object-module id)))
;; Using define! instead of set! to avoid warnings at
;; compile-time, after the variables are stolen away into (system
;; syntax). See the end of boot-9.scm.
;;
(define! 'syntax-module syntax-module)
(define! 'syntax-local-binding syntax-local-binding)
(define! 'syntax-locally-bound-identifiers syntax-locally-bound-identifiers))
;; $sc-dispatch expects an expression and a pattern. If the expression
;; matches the pattern a list of the matching expressions for each
;; "any" is returned. Otherwise, #f is returned. (This use of #f will