mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-30 03:40:34 +02:00
allow definitions in with-syntax body
* module/ice-9/psyntax.scm (with-syntax): Allow definitions in the body,
as seems to be suggested by the R6RS.
* test-suite/tests/syncase.test ("with-syntax"): Add test.
* module/ice-9/psyntax-pp.scm: Regenerate.
This commit is contained in:
Andy Wingo
parent
0f1fd214f1
commit
f929b9e5ec
3 changed files with 105 additions and 39 deletions
|
|
@ -37,16 +37,10 @@
|
|||
(begin
|
||||
(#{andmap\ 225}# #{first\ 203}# #{rest\ 204}#))))))))))
|
||||
(begin
|
||||
(let ((#{make-primitive-ref\ 244}# (if #f #f))
|
||||
(#{fx+\ 283}# (if #f #f))
|
||||
(let ((#{fx+\ 283}# (if #f #f))
|
||||
(#{fx-\ 285}# (if #f #f))
|
||||
(#{fx=\ 287}# (if #f #f))
|
||||
(#{fx<\ 289}# (if #f #f))
|
||||
(#{set-syntax-object-expression!\ 354}#
|
||||
(if #f #f))
|
||||
(#{set-syntax-object-wrap!\ 356}# (if #f #f))
|
||||
(#{set-syntax-object-module!\ 358}# (if #f #f))
|
||||
(#{ribcage?\ 400}# (if #f #f)))
|
||||
(#{fx<\ 289}# (if #f #f)))
|
||||
(letrec*
|
||||
((#{make-void\ 240}#
|
||||
(lambda (#{src\ 750}#)
|
||||
|
|
@ -7718,6 +7712,10 @@
|
|||
'(#(syntax-object
|
||||
#f
|
||||
((top)
|
||||
#(ribcage
|
||||
()
|
||||
()
|
||||
())
|
||||
#(ribcage
|
||||
#(k)
|
||||
#((top))
|
||||
|
|
@ -8927,32 +8925,27 @@
|
|||
(cons #{vars\ 2791}# #{ls\ 2792}#))))))))
|
||||
(begin (#{lvl\ 2790}# #{vars\ 2784}# '() '(())))))))
|
||||
(begin
|
||||
(set! #{make-primitive-ref\ 244}#
|
||||
(lambda (#{src\ 756}# #{name\ 757}#)
|
||||
(make-struct/no-tail
|
||||
(vector-ref %expanded-vtables 2)
|
||||
#{src\ 756}#
|
||||
#{name\ 757}#)))
|
||||
(lambda (#{src\ 756}# #{name\ 757}#)
|
||||
(make-struct/no-tail
|
||||
(vector-ref %expanded-vtables 2)
|
||||
#{src\ 756}#
|
||||
#{name\ 757}#))
|
||||
(lambda (#{x\ 1134}# #{update\ 1135}#)
|
||||
(vector-set! #{x\ 1134}# 1 #{update\ 1135}#))
|
||||
(lambda (#{x\ 1138}# #{update\ 1139}#)
|
||||
(vector-set! #{x\ 1138}# 2 #{update\ 1139}#))
|
||||
(lambda (#{x\ 1142}# #{update\ 1143}#)
|
||||
(vector-set! #{x\ 1142}# 3 #{update\ 1143}#))
|
||||
(lambda (#{x\ 1223}#)
|
||||
(if (vector? #{x\ 1223}#)
|
||||
(if (= (vector-length #{x\ 1223}#) 4)
|
||||
(eq? (vector-ref #{x\ 1223}# 0) 'ribcage)
|
||||
#f)
|
||||
#f))
|
||||
(set! #{fx+\ 283}# +)
|
||||
(set! #{fx-\ 285}# -)
|
||||
(set! #{fx=\ 287}# =)
|
||||
(set! #{fx<\ 289}# <)
|
||||
(set! #{set-syntax-object-expression!\ 354}#
|
||||
(lambda (#{x\ 1134}# #{update\ 1135}#)
|
||||
(vector-set! #{x\ 1134}# 1 #{update\ 1135}#)))
|
||||
(set! #{set-syntax-object-wrap!\ 356}#
|
||||
(lambda (#{x\ 1138}# #{update\ 1139}#)
|
||||
(vector-set! #{x\ 1138}# 2 #{update\ 1139}#)))
|
||||
(set! #{set-syntax-object-module!\ 358}#
|
||||
(lambda (#{x\ 1142}# #{update\ 1143}#)
|
||||
(vector-set! #{x\ 1142}# 3 #{update\ 1143}#)))
|
||||
(set! #{ribcage?\ 400}#
|
||||
(lambda (#{x\ 1223}#)
|
||||
(if (vector? #{x\ 1223}#)
|
||||
(if (= (vector-length #{x\ 1223}#) 4)
|
||||
(eq? (vector-ref #{x\ 1223}# 0) 'ribcage)
|
||||
#f)
|
||||
#f)))
|
||||
(begin
|
||||
(#{global-extend\ 376}#
|
||||
'local-syntax
|
||||
|
|
@ -14515,7 +14508,7 @@
|
|||
(@apply
|
||||
(lambda (#{e1\ 4203}# #{e2\ 4204}#)
|
||||
(cons '#(syntax-object
|
||||
begin
|
||||
let
|
||||
((top)
|
||||
#(ribcage
|
||||
#(e1 e2)
|
||||
|
|
@ -14524,7 +14517,7 @@
|
|||
#(ribcage () () ())
|
||||
#(ribcage #(x) #((top)) #("i4198")))
|
||||
(hygiene guile))
|
||||
(cons #{e1\ 4203}# #{e2\ 4204}#)))
|
||||
(cons '() (cons #{e1\ 4203}# #{e2\ 4204}#))))
|
||||
#{tmp\ 4200}#)
|
||||
(let ((#{tmp\ 4206}#
|
||||
($sc-dispatch
|
||||
|
|
@ -14550,7 +14543,7 @@
|
|||
'()
|
||||
(list #{out\ 4211}#
|
||||
(cons '#(syntax-object
|
||||
begin
|
||||
let
|
||||
((top)
|
||||
#(ribcage
|
||||
#(out in e1 e2)
|
||||
|
|
@ -14559,7 +14552,9 @@
|
|||
#(ribcage () () ())
|
||||
#(ribcage #(x) #((top)) #("i4198")))
|
||||
(hygiene guile))
|
||||
(cons #{e1\ 4213}# #{e2\ 4214}#)))))
|
||||
(cons '()
|
||||
(cons #{e1\ 4213}#
|
||||
#{e2\ 4214}#))))))
|
||||
#{tmp\ 4206}#)
|
||||
(let ((#{tmp\ 4216}#
|
||||
($sc-dispatch
|
||||
|
|
@ -14595,7 +14590,7 @@
|
|||
'()
|
||||
(list #{out\ 4221}#
|
||||
(cons '#(syntax-object
|
||||
begin
|
||||
let
|
||||
((top)
|
||||
#(ribcage
|
||||
#(out in e1 e2)
|
||||
|
|
@ -14610,7 +14605,9 @@
|
|||
#((top))
|
||||
#("i4198")))
|
||||
(hygiene guile))
|
||||
(cons #{e1\ 4223}# #{e2\ 4224}#)))))
|
||||
(cons '()
|
||||
(cons #{e1\ 4223}#
|
||||
#{e2\ 4224}#))))))
|
||||
#{tmp\ 4216}#)
|
||||
(syntax-violation
|
||||
#f
|
||||
|
|
@ -15006,6 +15003,7 @@
|
|||
(list '#(syntax-object
|
||||
let
|
||||
((top)
|
||||
#(ribcage () () ())
|
||||
#(ribcage
|
||||
#(body binding)
|
||||
#((top) (top))
|
||||
|
|
@ -15104,6 +15102,7 @@
|
|||
(list '#(syntax-object
|
||||
let
|
||||
((top)
|
||||
#(ribcage () () ())
|
||||
#(ribcage
|
||||
#(step)
|
||||
#((top))
|
||||
|
|
@ -15131,6 +15130,7 @@
|
|||
'#(syntax-object
|
||||
doloop
|
||||
((top)
|
||||
#(ribcage () () ())
|
||||
#(ribcage
|
||||
#(step)
|
||||
#((top))
|
||||
|
|
@ -15161,6 +15161,7 @@
|
|||
(list '#(syntax-object
|
||||
if
|
||||
((top)
|
||||
#(ribcage () () ())
|
||||
#(ribcage
|
||||
#(step)
|
||||
#((top))
|
||||
|
|
@ -15188,6 +15189,7 @@
|
|||
(list '#(syntax-object
|
||||
not
|
||||
((top)
|
||||
#(ribcage () () ())
|
||||
#(ribcage
|
||||
#(step)
|
||||
#((top))
|
||||
|
|
@ -15221,6 +15223,7 @@
|
|||
(cons '#(syntax-object
|
||||
begin
|
||||
((top)
|
||||
#(ribcage () () ())
|
||||
#(ribcage
|
||||
#(step)
|
||||
#((top))
|
||||
|
|
@ -15255,6 +15258,10 @@
|
|||
(list (cons '#(syntax-object
|
||||
doloop
|
||||
((top)
|
||||
#(ribcage
|
||||
()
|
||||
()
|
||||
())
|
||||
#(ribcage
|
||||
#(step)
|
||||
#((top))
|
||||
|
|
@ -15304,6 +15311,7 @@
|
|||
#(e1 e2)
|
||||
#((top) (top))
|
||||
#("i4336" "i4337"))
|
||||
#(ribcage () () ())
|
||||
#(ribcage
|
||||
#(step)
|
||||
#((top))
|
||||
|
|
@ -15335,6 +15343,7 @@
|
|||
#(e1 e2)
|
||||
#((top) (top))
|
||||
#("i4336" "i4337"))
|
||||
#(ribcage () () ())
|
||||
#(ribcage
|
||||
#(step)
|
||||
#((top))
|
||||
|
|
@ -15369,6 +15378,7 @@
|
|||
#(e1 e2)
|
||||
#((top) (top))
|
||||
#("i4336" "i4337"))
|
||||
#(ribcage () () ())
|
||||
#(ribcage
|
||||
#(step)
|
||||
#((top))
|
||||
|
|
@ -15407,6 +15417,10 @@
|
|||
#((top) (top))
|
||||
#("i4336"
|
||||
"i4337"))
|
||||
#(ribcage
|
||||
()
|
||||
()
|
||||
())
|
||||
#(ribcage
|
||||
#(step)
|
||||
#((top))
|
||||
|
|
@ -15449,6 +15463,10 @@
|
|||
#((top) (top))
|
||||
#("i4336"
|
||||
"i4337"))
|
||||
#(ribcage
|
||||
()
|
||||
()
|
||||
())
|
||||
#(ribcage
|
||||
#(step)
|
||||
#((top))
|
||||
|
|
@ -15493,6 +15511,10 @@
|
|||
(top))
|
||||
#("i4336"
|
||||
"i4337"))
|
||||
#(ribcage
|
||||
()
|
||||
()
|
||||
())
|
||||
#(ribcage
|
||||
#(step)
|
||||
#((top))
|
||||
|
|
@ -16596,6 +16618,7 @@
|
|||
#(dy)
|
||||
#((top))
|
||||
#("i4445"))
|
||||
#(ribcage () () ())
|
||||
#(ribcage
|
||||
#(x y)
|
||||
#((top) (top))
|
||||
|
|
@ -16644,6 +16667,7 @@
|
|||
#(dy)
|
||||
#((top))
|
||||
#("i4445"))
|
||||
#(ribcage () () ())
|
||||
#(ribcage
|
||||
#(x y)
|
||||
#((top) (top))
|
||||
|
|
@ -16688,6 +16712,7 @@
|
|||
#(dy)
|
||||
#((top))
|
||||
#("i4445"))
|
||||
#(ribcage () () ())
|
||||
#(ribcage
|
||||
#(x y)
|
||||
#((top) (top))
|
||||
|
|
@ -16737,6 +16762,7 @@
|
|||
#(stuff)
|
||||
#((top))
|
||||
#("i4454"))
|
||||
#(ribcage () () ())
|
||||
#(ribcage
|
||||
#(x y)
|
||||
#((top) (top))
|
||||
|
|
@ -16785,6 +16811,7 @@
|
|||
#(stuff)
|
||||
#((top))
|
||||
#("i4457"))
|
||||
#(ribcage () () ())
|
||||
#(ribcage
|
||||
#(x y)
|
||||
#((top) (top))
|
||||
|
|
@ -16828,6 +16855,7 @@
|
|||
#(_)
|
||||
#((top))
|
||||
#("i4459"))
|
||||
#(ribcage () () ())
|
||||
#(ribcage
|
||||
#(x y)
|
||||
#((top) (top))
|
||||
|
|
@ -16914,6 +16942,7 @@
|
|||
(cons '#(syntax-object
|
||||
"append"
|
||||
((top)
|
||||
#(ribcage () () ())
|
||||
#(ribcage
|
||||
#(p)
|
||||
#((top))
|
||||
|
|
@ -16964,6 +16993,7 @@
|
|||
(cons '#(syntax-object
|
||||
"append"
|
||||
((top)
|
||||
#(ribcage () () ())
|
||||
#(ribcage
|
||||
#(p y)
|
||||
#((top) (top))
|
||||
|
|
@ -17142,6 +17172,7 @@
|
|||
(list '#(syntax-object
|
||||
"list->vector"
|
||||
((top)
|
||||
#(ribcage () () ())
|
||||
#(ribcage
|
||||
#(#{\ g4543}#)
|
||||
#((m4544 top))
|
||||
|
|
@ -17202,6 +17233,7 @@
|
|||
(cons '#(syntax-object
|
||||
"vector"
|
||||
((top)
|
||||
#(ribcage () () ())
|
||||
#(ribcage
|
||||
#(#{\ g4516}#)
|
||||
#((m4517 top))
|
||||
|
|
@ -17301,6 +17333,7 @@
|
|||
(cons '#(syntax-object
|
||||
list
|
||||
((top)
|
||||
#(ribcage () () ())
|
||||
#(ribcage
|
||||
#(#{\ g4558}#)
|
||||
#((m4559 top))
|
||||
|
|
@ -17371,6 +17404,7 @@
|
|||
(list '#(syntax-object
|
||||
cons
|
||||
((top)
|
||||
#(ribcage () () ())
|
||||
#(ribcage
|
||||
#(#{\ g4578}#
|
||||
#{\ g4577}#)
|
||||
|
|
@ -17441,6 +17475,7 @@
|
|||
(cons '#(syntax-object
|
||||
append
|
||||
((top)
|
||||
#(ribcage () () ())
|
||||
#(ribcage
|
||||
#(#{\ g4590}#)
|
||||
#((m4591 top))
|
||||
|
|
@ -17502,6 +17537,7 @@
|
|||
(cons '#(syntax-object
|
||||
vector
|
||||
((top)
|
||||
#(ribcage () () ())
|
||||
#(ribcage
|
||||
#(#{\ g4602}#)
|
||||
#((m4603 top))
|
||||
|
|
@ -17558,6 +17594,7 @@
|
|||
(list '#(syntax-object
|
||||
list->vector
|
||||
((top)
|
||||
#(ribcage () () ())
|
||||
#(ribcage
|
||||
#(#{\ g4614}#)
|
||||
#((m4615 top))
|
||||
|
|
@ -17665,6 +17702,7 @@
|
|||
(cons '#(syntax-object
|
||||
begin
|
||||
((top)
|
||||
#(ribcage () () ())
|
||||
#(ribcage
|
||||
#(exp)
|
||||
#((top))
|
||||
|
|
@ -17730,6 +17768,7 @@
|
|||
(list '#(syntax-object
|
||||
include
|
||||
((top)
|
||||
#(ribcage () () ())
|
||||
#(ribcage #(fn) #((top)) #("i4671"))
|
||||
#(ribcage () () ())
|
||||
#(ribcage () () ())
|
||||
|
|
@ -18092,6 +18131,7 @@
|
|||
#("i4726"
|
||||
"i4727"
|
||||
"i4728"))
|
||||
#(ribcage () () ())
|
||||
#(ribcage
|
||||
#(rest)
|
||||
#((top))
|
||||
|
|
@ -18126,6 +18166,10 @@
|
|||
#("i4726"
|
||||
"i4727"
|
||||
"i4728"))
|
||||
#(ribcage
|
||||
()
|
||||
()
|
||||
())
|
||||
#(ribcage
|
||||
#(rest)
|
||||
#((top))
|
||||
|
|
@ -18172,6 +18216,10 @@
|
|||
#("i4726"
|
||||
"i4727"
|
||||
"i4728"))
|
||||
#(ribcage
|
||||
()
|
||||
()
|
||||
())
|
||||
#(ribcage
|
||||
#(rest)
|
||||
#((top))
|
||||
|
|
@ -18220,6 +18268,10 @@
|
|||
#("i4726"
|
||||
"i4727"
|
||||
"i4728"))
|
||||
#(ribcage
|
||||
()
|
||||
()
|
||||
())
|
||||
#(ribcage
|
||||
#(rest)
|
||||
#((top))
|
||||
|
|
@ -18270,6 +18322,10 @@
|
|||
#("i4726"
|
||||
"i4727"
|
||||
"i4728"))
|
||||
#(ribcage
|
||||
()
|
||||
()
|
||||
())
|
||||
#(ribcage
|
||||
#(rest)
|
||||
#((top))
|
||||
|
|
@ -18320,6 +18376,7 @@
|
|||
(list '#(syntax-object
|
||||
let
|
||||
((top)
|
||||
#(ribcage () () ())
|
||||
#(ribcage #(body) #((top)) #("i4693"))
|
||||
#(ribcage
|
||||
#(e m1 m2)
|
||||
|
|
@ -18331,6 +18388,7 @@
|
|||
(list (list '#(syntax-object
|
||||
t
|
||||
((top)
|
||||
#(ribcage () () ())
|
||||
#(ribcage
|
||||
#(body)
|
||||
#((top))
|
||||
|
|
|
|||
|
|
@ -2632,12 +2632,13 @@
|
|||
(lambda (x)
|
||||
(syntax-case x ()
|
||||
((_ () e1 e2 ...)
|
||||
#'(begin e1 e2 ...))
|
||||
#'(let () e1 e2 ...))
|
||||
((_ ((out in)) e1 e2 ...)
|
||||
#'(syntax-case in () (out (begin e1 e2 ...))))
|
||||
#'(syntax-case in ()
|
||||
(out (let () e1 e2 ...))))
|
||||
((_ ((out in) ...) e1 e2 ...)
|
||||
#'(syntax-case (list in ...) ()
|
||||
((out ...) (begin e1 e2 ...)))))))
|
||||
((out ...) (let () e1 e2 ...)))))))
|
||||
|
||||
(define-syntax syntax-rules
|
||||
(lambda (x)
|
||||
|
|
|
|||
|
|
@ -68,6 +68,13 @@
|
|||
((alist ((key val) ...))
|
||||
(list '(key . val) ...))))
|
||||
|
||||
(with-test-prefix "with-syntax"
|
||||
(pass-if "definitions allowed in body"
|
||||
(equal? (with-syntax ((a 23))
|
||||
(define b #'a)
|
||||
(syntax->datum b))
|
||||
23)))
|
||||
|
||||
(with-test-prefix "tail patterns"
|
||||
(with-test-prefix "at the outermost level"
|
||||
(pass-if "non-tail invocation"
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue