X-Git-Url: https://git.lukelau.me/?p=scheme.git;a=blobdiff_plain;f=ast.scm;fp=ast.scm;h=b70317a70e6fd3a14aa9fab5c94be57991427f2e;hp=342fe453a4d9276c36237e43e1a7069b5ec75670;hb=8e106ca13666680051f91ab3f49ce2bd7e19ead7;hpb=e4dc23d659849c88cec8c7e57d0d463f9493850e diff --git a/ast.scm b/ast.scm index 342fe45..b70317a 100644 --- a/ast.scm +++ b/ast.scm @@ -1,3 +1,5 @@ +(load "utils.scm") + (define (ast-type x) (define (builtin? x) (case x @@ -33,7 +35,7 @@ ('app (map f x)) ('lambda `(lambda ,(lambda-args x) ,(f (lambda-body x)))) ('if `(if ,@(map f (cdr x)))) - ('stack `(stack ,(cadr x) ,(map f (caddr x)))) + ('stack `(stack ,(cadr x) ,(f (caddr x)))) (else x))) (define (ast-collect f x) @@ -329,26 +331,3 @@ (strong-connect v))) (car graph))) result)) - - - ; utils - -(define (range s n) - (if (= 0 n) '() - (append (range s (- n 1)) - (list (+ s (- n 1)))))) - -(define (flat-map f . xs) (fold-left append '() (apply map (cons f xs)))) -(define (repeat x n) (if (<= n 0) '() - (cons x (repeat x (- n 1))))) - - -(define-syntax push! - (syntax-rules () - ((_ s x) (set! s (cons x s))))) - -(define-syntax pop! - (syntax-rules () - ((_ s) (let ([x (car s)]) - (set! s (cdr s)) - x))))