fix syntax case expansion

mattwparas · Dec 28, 2024 · 9814f34 · 9814f34
1 parent 4ec34ce
commit 9814f34
Show file tree

Hide file tree

Showing 2 changed files with 57 additions and 16 deletions.
diff --git a/crates/steel-core/src/rvals.rs b/crates/steel-core/src/rvals.rs
@@ -580,6 +580,7 @@ impl<T: CustomType + MaybeSendSyncStatic> AsRefMutSteelVal for T {
 impl ast::TryFromSteelValVisitorForExprKind {
     pub fn visit_syntax_object(&mut self, value: &Syntax) -> Result<ExprKind> {
         let span = value.span;
+
         // dbg!(&span);
         // let source = self.source.clone();
         match &value.syntax {

diff --git a/crates/steel-core/src/scheme/stdlib.scm b/crates/steel-core/src/scheme/stdlib.scm
@@ -160,23 +160,30 @@
      (append (list (list 'unsyntax-splicing (quasisyntax #%internal-crunch x)))
              (quasisyntax #%internal-crunch (xs ...)))]
 
-    [(quasisyntax #%internal-crunch ()) (list)]
+    [(quasisyntax #%internal-crunch ()) (#%syntax/raw '() '() '(0 0 0))]
     [(quasisyntax #%internal-crunch (x xs ...))
      ;; TODO: Wrap this up in a syntax/raw?
      (#%syntax/raw (quote (x xs ...))
-                   (cons (quasisyntax #%internal-crunch x) (quasisyntax #%internal-crunch (xs ...)))
+                   (cons (quasisyntax #%internal-crunch x)
+                         (syntax-e (quasisyntax #%internal-crunch (xs ...))))
                    (#%syntax-span (x xs ...)))]
 
     ;; Internal, we don't do anything special
-    [(quasisyntax #%internal-crunch x) (if (empty? 'x) (list) (#%syntax/raw 'x 'x (#%syntax-span x)))]
+    [(quasisyntax #%internal-crunch x)
+     (if (empty? 'x)
+         (#%syntax/raw '() '() (#%syntax-span x))
+         (#%syntax/raw 'x 'x (#%syntax-span x)))]
 
     [(quasisyntax (x xs ...))
      (syntax (#%syntax/raw (quote (x xs ...))
                            (cons (quasisyntax #%internal-crunch x)
-                                 (quasisyntax #%internal-crunch (xs ...)))
+                                 (syntax-e (quasisyntax #%internal-crunch (xs ...))))
                            (#%syntax-span (x xs ...))))]
 
-    [(quasisyntax x) (if (empty? 'x) (list) (syntax (#%syntax/raw 'x 'x (#%syntax-span x))))]))
+    [(quasisyntax x)
+     (if (empty? 'x)
+         (#%syntax/raw '() '() (#%syntax-span x))
+         (syntax (#%syntax/raw 'x 'x (#%syntax-span x))))]))
 
 (define-syntax or
   (syntax-rules ()
@@ -510,7 +517,9 @@
 ; (define compose (lambda (f g) (lambda (arg) (f (g arg)))))
 
 (define (foldl func accum lst)
-  (if (null? lst) accum (foldl func (func (car lst) accum) (cdr lst))))
+  (if (null? lst)
+      accum
+      (foldl func (func (car lst) accum) (cdr lst))))
 
 (define (map func lst . lsts)
 
@@ -534,11 +543,16 @@
 ;     (transduce lst (mapping func) (into-list))))
 
 (define foldr
-  (lambda (func accum lst) (if (null? lst) accum (func (car lst) (foldr func accum (cdr lst))))))
+  (lambda (func accum lst)
+    (if (null? lst)
+        accum
+        (func (car lst) (foldr func accum (cdr lst))))))
 
 (define unfold
   (lambda (func init pred)
-    (if (pred init) (cons init '()) (cons init (unfold func (func init) pred)))))
+    (if (pred init)
+        (cons init '())
+        (cons init (unfold func (func init) pred)))))
 
 (define fold (lambda (f a l) (foldl f a l)))
 (define reduce (lambda (f a l) (fold f a l)))
@@ -578,13 +592,25 @@
     [else (contains? pred? (cdr lst))]))
 
 (define (assoc thing alist)
-  (if (null? alist) #f (if (equal? (car (car alist)) thing) (car alist) (assoc thing (cdr alist)))))
+  (if (null? alist)
+      #f
+      (if (equal? (car (car alist)) thing)
+          (car alist)
+          (assoc thing (cdr alist)))))
 
 (define (assq thing alist)
-  (if (null? alist) #f (if (eq? (car (car alist)) thing) (car alist) (assq thing (cdr alist)))))
+  (if (null? alist)
+      #f
+      (if (eq? (car (car alist)) thing)
+          (car alist)
+          (assq thing (cdr alist)))))
 
 (define (assv thing alist)
-  (if (null? alist) #f (if (eq? (car (car alist)) thing) (car alist) (assv thing (cdr alist)))))
+  (if (null? alist)
+      #f
+      (if (eq? (car (car alist)) thing)
+          (car alist)
+          (assv thing (cdr alist)))))
 
 ;;@doc
 ;; Returns new list, keeping elements from `lst` which applying `pred` to the element
@@ -597,7 +623,9 @@
 ;; (filter even? (range 0 5)) ;; '(0 2 4)
 ;; ```
 (define (filter pred lst)
-  (if (empty? lst) '() (transduce lst (filtering pred) (into-list))))
+  (if (empty? lst)
+      '()
+      (transduce lst (filtering pred) (into-list))))
 
 ; (define (fact n)
 ;   (define factorial-tail (lambda (n acc)
@@ -606,8 +634,16 @@
 ;                                (factorial-tail (- n 1)  (* acc n )))))
 ;   (factorial-tail n 1))
 
-(define even-rec? (lambda (x) (if (= x 0) #t (odd-rec? (- x 1)))))
-(define odd-rec? (lambda (x) (if (= x 0) #f (even-rec? (- x 1)))))
+(define even-rec?
+  (lambda (x)
+    (if (= x 0)
+        #t
+        (odd-rec? (- x 1)))))
+(define odd-rec?
+  (lambda (x)
+    (if (= x 0)
+        #f
+        (even-rec? (- x 1)))))
 
 (define sum (lambda (x) (reduce + 0 x)))
 ;; (define head car)
@@ -629,7 +665,9 @@
 
 (define (drop lst n)
   (define (loop x l)
-    (if (zero? x) l (loop (sub1 x) (cdr l))))
+    (if (zero? x)
+        l
+        (loop (sub1 x) (cdr l))))
   (loop n lst))
 
 (define (slice l offset n)
@@ -647,7 +685,9 @@
     [else (gcd b (modulo a b))]))
 
 (define (lcm a b)
-  (if (or (zero? a) (zero? b)) 0 (abs (* b (floor (/ a (gcd a b)))))))
+  (if (or (zero? a) (zero? b))
+      0
+      (abs (* b (floor (/ a (gcd a b)))))))
 
 (define (for-each func lst)
   (if (null? lst)