[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] branch master updated: Document datum->syntax extensions
|
From: |
Andy Wingo |
|
Subject: |
[Guile-commits] branch master updated: Document datum->syntax extensions |
|
Date: |
Sun, 21 Feb 2021 05:35:22 -0500 |
This is an automated email from the git hooks/post-receive script.
wingo pushed a commit to branch master
in repository guile.
The following commit(s) were added to refs/heads/master by this push:
new 1bba859 Document datum->syntax extensions
1bba859 is described below
commit 1bba859000449a2b69c3c2872b11e8ddef5393c8
Author: Andy Wingo <wingo@pobox.com>
AuthorDate: Sun Feb 21 11:27:32 2021 +0100
Document datum->syntax extensions
* doc/ref/api-macros.texi (Syntax Case): Document that template-id can
be false, and document srcloc.
* module/ice-9/psyntax-pp.scm: Regenerate.
* module/ice-9/psyntax.scm (syntax?): Allow the lexical context to be
null. Allow srcloc to be a source properties alist. Inspired by
Racket.
---
doc/ref/api-macros.texi | 18 ++++++--
module/ice-9/psyntax-pp.scm | 109 ++++++++++++++++++++++----------------------
module/ice-9/psyntax.scm | 15 ++++--
3 files changed, 80 insertions(+), 62 deletions(-)
diff --git a/doc/ref/api-macros.texi b/doc/ref/api-macros.texi
index 83345a2..7bcca7a 100644
--- a/doc/ref/api-macros.texi
+++ b/doc/ref/api-macros.texi
@@ -1,6 +1,6 @@
@c -*-texinfo-*-
@c This is part of the GNU Guile Reference Manual.
-@c Copyright (C) 1996, 1997, 2000-2004, 2009-2015, 2018
+@c Copyright (C) 1996, 1997, 2000-2004, 2009-2015, 2018, 2021
@c Free Software Foundation, Inc.
@c See the file guile.texi for copying conditions.
@@ -638,9 +638,19 @@ won't have access to the binding of @code{it}.
But they can, if we explicitly introduce a binding via @code{datum->syntax}.
-@deffn {Scheme Procedure} datum->syntax template-id datum
-Create a syntax object that wraps @var{datum}, within the lexical context
-corresponding to the identifier @var{template-id}.
+@deffn {Scheme Procedure} datum->syntax template-id datum [srcloc]
+Create a syntax object that wraps @var{datum}, within the lexical
+context corresponding to the identifier @var{template-id}. If
+@var{template-id} is false, the datum will have no lexical context
+information.
+
+Syntax objects have an associated source location. @xref{Source
+Properties}. If a syntax object is passed as @var{srcloc}, the
+resulting syntax object will have the source properties of @var{srcloc}.
+Otherwise if @var{srcloc} is a source properties alist, those will be
+the source properties of the resulting syntax object. Otherwise if
+@var{srcloc} is false, the source properties are computed as
+@code{(source-properties @var{datum})}.
@end deffn
For completeness, we should mention that it is possible to strip the metadata
diff --git a/module/ice-9/psyntax-pp.scm b/module/ice-9/psyntax-pp.scm
index 1a3dcb1..da14453 100644
--- a/module/ice-9/psyntax-pp.scm
+++ b/module/ice-9/psyntax-pp.scm
@@ -991,11 +991,11 @@
(source-wrap e w (cdr w) mod)
x))
(else (decorate-source x s))))))
- (let* ((t-680b775fb37a463-d74 transformer-environment)
- (t-680b775fb37a463-d75 (lambda (k) (k e r w s rib mod))))
+ (let* ((t-680b775fb37a463-d78 transformer-environment)
+ (t-680b775fb37a463-d79 (lambda (k) (k e r w s rib mod))))
(with-fluid*
- t-680b775fb37a463-d74
- t-680b775fb37a463-d75
+ t-680b775fb37a463-d78
+ t-680b775fb37a463-d79
(lambda ()
(rebuild-macro-output
(p (source-wrap e (anti-mark w) s mod))
@@ -1562,11 +1562,11 @@
s
mod
get-formals
- (map (lambda (tmp-680b775fb37a463-fe5
- tmp-680b775fb37a463-fe4
-
tmp-680b775fb37a463-fe3)
- (cons tmp-680b775fb37a463-fe3
- (cons
tmp-680b775fb37a463-fe4 tmp-680b775fb37a463-fe5)))
+ (map (lambda (tmp-680b775fb37a463-fe9
+ tmp-680b775fb37a463-fe8
+
tmp-680b775fb37a463-fe7)
+ (cons tmp-680b775fb37a463-fe7
+ (cons
tmp-680b775fb37a463-fe8 tmp-680b775fb37a463-fe9)))
e2*
e1*
args*)))
@@ -1864,11 +1864,11 @@
(apply (lambda (args e1 e2)
(build-it
'()
- (map (lambda (tmp-680b775fb37a463-69c
- tmp-680b775fb37a463-69b
- tmp-680b775fb37a463-69a)
- (cons tmp-680b775fb37a463-69a
- (cons tmp-680b775fb37a463-69b
tmp-680b775fb37a463-69c)))
+ (map (lambda (tmp-680b775fb37a463-6a0
+ tmp-680b775fb37a463-69f
+ tmp-680b775fb37a463-69e)
+ (cons tmp-680b775fb37a463-69e
+ (cons tmp-680b775fb37a463-69f
tmp-680b775fb37a463-6a0)))
e2
e1
args)))
@@ -1880,11 +1880,11 @@
(apply (lambda (docstring args e1 e2)
(build-it
(list (cons 'documentation (syntax->datum
docstring)))
- (map (lambda (tmp-680b775fb37a463-6b2
- tmp-680b775fb37a463-6b1
- tmp-680b775fb37a463-6b0)
- (cons tmp-680b775fb37a463-6b0
- (cons tmp-680b775fb37a463-6b1
tmp-680b775fb37a463-6b2)))
+ (map (lambda (tmp-680b775fb37a463-6b6
+ tmp-680b775fb37a463-6b5
+ tmp-680b775fb37a463-6b4)
+ (cons tmp-680b775fb37a463-6b4
+ (cons tmp-680b775fb37a463-6b5
tmp-680b775fb37a463-6b6)))
e2
e1
args)))
@@ -1907,9 +1907,9 @@
(apply (lambda (args e1 e2)
(build-it
'()
- (map (lambda (tmp-680b775fb37a463-2
tmp-680b775fb37a463-1 tmp-680b775fb37a463)
+ (map (lambda (tmp-680b775fb37a463-66a
tmp-680b775fb37a463-1 tmp-680b775fb37a463)
(cons tmp-680b775fb37a463
- (cons tmp-680b775fb37a463-1
tmp-680b775fb37a463-2)))
+ (cons tmp-680b775fb37a463-1
tmp-680b775fb37a463-66a)))
e2
e1
args)))
@@ -1921,11 +1921,9 @@
(apply (lambda (docstring args e1 e2)
(build-it
(list (cons 'documentation (syntax->datum
docstring)))
- (map (lambda (tmp-680b775fb37a463-67c
- tmp-680b775fb37a463-67b
- tmp-680b775fb37a463-67a)
- (cons tmp-680b775fb37a463-67a
- (cons tmp-680b775fb37a463-67b
tmp-680b775fb37a463-67c)))
+ (map (lambda (tmp-680b775fb37a463
tmp-680b775fb37a463-67f tmp-680b775fb37a463-67e)
+ (cons tmp-680b775fb37a463-67e
+ (cons tmp-680b775fb37a463-67f
tmp-680b775fb37a463)))
e2
e1
args)))
@@ -2426,9 +2424,13 @@
(lambda* (id datum #:optional (srcloc #f))
(make-syntax
datum
- (syntax-wrap id)
- (syntax-module id)
- (if srcloc (syntax-source srcloc) (source-properties datum)))))
+ (if id (syntax-wrap id) '((top)))
+ (if id
+ (syntax-module id)
+ (cons 'hygiene (module-name (current-module))))
+ (cond ((not srcloc) (source-properties datum))
+ ((and (list? srcloc) (and-map pair? srcloc)) srcloc)
+ (else (syntax-source srcloc))))))
(set! syntax->datum (lambda (x) (strip x '(()))))
(set! generate-temporaries
(lambda (ls)
@@ -2855,11 +2857,11 @@
#f
k
(list docstring)
- (map (lambda (tmp-680b775fb37a463-112b
- tmp-680b775fb37a463-112a
- tmp-680b775fb37a463)
- (list (cons tmp-680b775fb37a463
tmp-680b775fb37a463-112a)
- tmp-680b775fb37a463-112b))
+ (map (lambda (tmp-680b775fb37a463-112f
+ tmp-680b775fb37a463-112e
+ tmp-680b775fb37a463-112d)
+ (list (cons tmp-680b775fb37a463-112d
tmp-680b775fb37a463-112e)
+ tmp-680b775fb37a463-112f))
template
pattern
keyword)))
@@ -3066,8 +3068,8 @@
(apply (lambda (p)
(if (= lev 0)
(quasiappend
- (map (lambda
(tmp-680b775fb37a463)
- (list
"value" tmp-680b775fb37a463))
+ (map (lambda
(tmp-680b775fb37a463-121c)
+ (list
"value" tmp-680b775fb37a463-121c))
p)
(quasi q lev))
(quasicons
@@ -3101,8 +3103,7 @@
(apply (lambda (p)
(if (= lev 0)
(quasilist*
- (map (lambda
(tmp-680b775fb37a463-122e)
- (list "value"
tmp-680b775fb37a463-122e))
+ (map (lambda
(tmp-680b775fb37a463) (list "value" tmp-680b775fb37a463))
p)
(vquasi q lev))
(quasicons
@@ -3212,8 +3213,7 @@
(let ((tmp-1 ls))
(let ((tmp ($sc-dispatch tmp-1 'each-any)))
(if tmp
- (apply (lambda (t-680b775fb37a463-127c)
- (cons "vector"
t-680b775fb37a463-127c))
+ (apply (lambda (t-680b775fb37a463) (cons
"vector" t-680b775fb37a463))
tmp)
(syntax-violation
#f
@@ -3223,7 +3223,8 @@
(let ((tmp-1 ($sc-dispatch tmp '(#(atom "quote")
each-any))))
(if tmp-1
(apply (lambda (y)
- (k (map (lambda (tmp-680b775fb37a463)
(list "quote" tmp-680b775fb37a463))
+ (k (map (lambda (tmp-680b775fb37a463-128c)
+ (list "quote"
tmp-680b775fb37a463-128c))
y)))
tmp-1)
(let ((tmp-1 ($sc-dispatch tmp '(#(atom "list") .
each-any))))
@@ -3234,8 +3235,8 @@
(apply (lambda (y z) (f z (lambda (ls) (k
(append y ls))))) tmp-1)
(let ((else tmp))
(let ((tmp x))
- (let ((t-680b775fb37a463 tmp))
- (list "list->vector"
t-680b775fb37a463)))))))))))))))))
+ (let ((t-680b775fb37a463-129b tmp))
+ (list "list->vector"
t-680b775fb37a463-129b)))))))))))))))))
(emit (lambda (x)
(let ((tmp x))
(let ((tmp-1 ($sc-dispatch tmp '(#(atom "quote") any))))
@@ -3248,9 +3249,9 @@
(let ((tmp-1 (map emit x)))
(let ((tmp ($sc-dispatch tmp-1
'each-any)))
(if tmp
- (apply (lambda
(t-680b775fb37a463-12a6)
+ (apply (lambda
(t-680b775fb37a463-12aa)
(cons (make-syntax 'list
'((top)) '(hygiene guile))
-
t-680b775fb37a463-12a6))
+
t-680b775fb37a463-12aa))
tmp)
(syntax-violation
#f
@@ -3266,10 +3267,10 @@
(let ((tmp-1 (list (emit (car x*))
(f (cdr x*)))))
(let ((tmp ($sc-dispatch tmp-1
'(any any))))
(if tmp
- (apply (lambda
(t-680b775fb37a463-12ba t-680b775fb37a463-12b9)
+ (apply (lambda
(t-680b775fb37a463-12be t-680b775fb37a463-12bd)
(list (make-syntax
'cons '((top)) '(hygiene guile))
-
t-680b775fb37a463-12ba
-
t-680b775fb37a463-12b9))
+
t-680b775fb37a463-12be
+
t-680b775fb37a463-12bd))
tmp)
(syntax-violation
#f
@@ -3282,9 +3283,9 @@
(let ((tmp-1 (map emit x)))
(let ((tmp ($sc-dispatch tmp-1
'each-any)))
(if tmp
- (apply (lambda
(t-680b775fb37a463-12c6)
+ (apply (lambda
(t-680b775fb37a463-12ca)
(cons (make-syntax
'append '((top)) '(hygiene guile))
-
t-680b775fb37a463-12c6))
+
t-680b775fb37a463-12ca))
tmp)
(syntax-violation
#f
@@ -3297,9 +3298,9 @@
(let ((tmp-1 (map emit x)))
(let ((tmp ($sc-dispatch
tmp-1 'each-any)))
(if tmp
- (apply (lambda
(t-680b775fb37a463-12d2)
+ (apply (lambda
(t-680b775fb37a463-12d6)
(cons
(make-syntax 'vector '((top)) '(hygiene guile))
-
t-680b775fb37a463-12d2))
+
t-680b775fb37a463-12d6))
tmp)
(syntax-violation
#f
@@ -3310,9 +3311,9 @@
(if tmp-1
(apply (lambda (x)
(let ((tmp (emit x)))
- (let
((t-680b775fb37a463-12de tmp))
+ (let
((t-680b775fb37a463-12e2 tmp))
(list (make-syntax
'list->vector '((top)) '(hygiene guile))
-
t-680b775fb37a463-12de))))
+
t-680b775fb37a463-12e2))))
tmp-1)
(let ((tmp-1 ($sc-dispatch tmp
'(#(atom "value") any))))
(if tmp-1
diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm
index f0c1f03..c5c85fd 100644
--- a/module/ice-9/psyntax.scm
+++ b/module/ice-9/psyntax.scm
@@ -2764,10 +2764,17 @@
(set! datum->syntax
(lambda* (id datum #:optional srcloc)
- (make-syntax datum (syntax-wrap id) (syntax-module id)
- (if srcloc
- (syntax-source srcloc)
- (source-properties datum)))))
+ (make-syntax datum
+ (if id
+ (syntax-wrap id)
+ top-wrap)
+ (if id
+ (syntax-module id)
+ (cons 'hygiene (module-name (current-module))))
+ (cond
+ ((not srcloc) (source-properties datum))
+ ((and (list? srcloc) (and-map pair? srcloc)) srcloc)
+ (else (syntax-source srcloc))))))
(set! syntax->datum
;; accepts any object, since syntax objects may consist partially
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] branch master updated: Document datum->syntax extensions,
Andy Wingo <=