+(load "utils.scm")
+
(define (ast-type x)
(define (builtin? x)
(case x
('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)
(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))))
'((data A [foo Int]
[bar Bool])
(let ([(foo x) (foo 0)]) x))))
+
+(test-prog '((data A [foo Int])
+ (let ([x (foo 42)])
+ (let ([(foo y) x])
+ (+ 1 y))))
+ 43)
+
+(test-prog '((data A [foo Int])
+ (data B [bar A])
+ (let ([(bar (foo x)) (bar (foo 42))])
+ x))
+ 42)
--- /dev/null
+(define (drop n xs)
+ (case n
+ [(0) xs]
+ [else (drop (- n 1) (cdr xs))]))
+
+(define (drop-end n xs)
+ (reverse (drop n (reverse xs))))
+
+(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))))