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.

diff --git a/module/ice-9/psyntax-pp.scm b/module/ice-9/psyntax-pp.scm
index fb862d0193b61e05f7add44326c9cb253954f84b..5c26e96c376078ccd327360ec8849861d97f475c 100644 (file)
--- a/module/ice-9/psyntax-pp.scm
+++ b/module/ice-9/psyntax-pp.scm
@@ -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))

diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm
index f5a7305b6e31a94eb66a381052fdcf2a56077b29..4266400957cf621ee2ce5aab27b52427b5be11d3 100644 (file)
--- a/module/ice-9/psyntax.scm
+++ b/module/ice-9/psyntax.scm
@@ -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)

diff --git a/test-suite/tests/syncase.test b/test-suite/tests/syncase.test
index 84f1cfc8ba1e3556e4251f48503f10c3ff76dc17..6183df8138a29babe02341d1d743bfa90703fe56 100644 (file)
--- a/test-suite/tests/syncase.test
+++ b/test-suite/tests/syncase.test
@@ -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"