diff --git a/crates/steel-core/src/rvals.rs b/crates/steel-core/src/rvals.rs index f5c5c11e3..29d8178ae 100644 --- a/crates/steel-core/src/rvals.rs +++ b/crates/steel-core/src/rvals.rs @@ -580,6 +580,7 @@ impl AsRefMutSteelVal for T { impl ast::TryFromSteelValVisitorForExprKind { pub fn visit_syntax_object(&mut self, value: &Syntax) -> Result { 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 index 1526b1cbc..2233ebd54 100644 --- 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)