more tests

mattwparas · Dec 29, 2024 · e43ca92 · e43ca92
1 parent 880fc6c
commit e43ca92
Show file tree

Hide file tree

Showing 2 changed files with 19 additions and 5 deletions.
diff --git a/crates/steel-core/src/scheme/stdlib.scm b/crates/steel-core/src/scheme/stdlib.scm
@@ -151,16 +151,25 @@
 
     [(quasisyntax #%internal-crunch (#%unsyntax x)) x]
 
-    [(quasisyntax #%internal-crunch ((#%unsyntax-splicing x))) (append x '())]
+    [(quasisyntax #%internal-crunch ((#%unsyntax-splicing x)))
+     (#%syntax/raw (quote x) (append (syntax-e x) '()) (#%syntax-span x))]
+
     [(quasisyntax #%internal-crunch ((#%unsyntax-splicing x) xs ...))
-     (append x (quasisyntax #%internal-crunch (xs ...)))]
+     (#%syntax/raw (quote (xs ...))
+                   (append (syntax-e x) (syntax-e (quasisyntax #%internal-crunch (xs ...))))
+                   (#%syntax-span (xs ...)))]
 
     ;; TODO: Do unquote-splicing as well, follow the same rules as unquote
     [(quasisyntax #%internal-crunch ((unsyntax-splicing x)))
-     (append (list (list 'unsyntax-splicing (quasisyntax #%internal-crunch x))) '())]
+     (#%syntax/raw (quote '())
+                   (append (list (list 'unsyntax-splicing (quasisyntax #%internal-crunch x))) '())
+                   (#%syntax-span x))]
+
     [(quasisyntax #%internal-crunch ((unsyntax-splicing x) xs ...))
-     (append (list (list 'unsyntax-splicing (quasisyntax #%internal-crunch x)))
-             (quasisyntax #%internal-crunch (xs ...)))]
+     (#%syntax/raw (quote xs ...)
+                   (append (list (list 'unsyntax-splicing (quasisyntax #%internal-crunch x)))
+                           (syntax-e (quasisyntax #%internal-crunch (xs ...))))
+                   (#%syntax-span (xs ...)))]
 
     [(quasisyntax #%internal-crunch ()) (#%syntax/raw '() '() '(0 0 0))]
     [(quasisyntax #%internal-crunch (x xs ...))

diff --git a/crates/steel-core/src/tests/success/syntax_case.scm b/crates/steel-core/src/tests/success/syntax_case.scm
@@ -12,3 +12,8 @@
          #`(list name place #,foo #,bar baz)))]))
 
 (assert! (equal? (hello 500 1000) '(500 1000 10 20 10)))
+
+(define test #`(40 50 60))
+(define res #`(list 10 20 30 #,@test))
+
+(assert! (equal? (map syntax-e (syntax-e res)) '(list 10 20 30 40 50 60)))