From 8e106ca13666680051f91ab3f49ce2bd7e19ead7 Mon Sep 17 00:00:00 2001 From: Luke Lau Date: Tue, 13 Aug 2019 16:06:28 +0100 Subject: [PATCH] Move utils into its onw file --- ast.scm | 27 +++------------------------ tests.scm | 12 ++++++++++++ utils.scm | 27 +++++++++++++++++++++++++++ 3 files changed, 42 insertions(+), 24 deletions(-) create mode 100644 utils.scm 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)))) diff --git a/tests.scm b/tests.scm index 6dfbd9f..ecee99e 100644 --- a/tests.scm +++ b/tests.scm @@ -260,3 +260,15 @@ '((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) diff --git a/utils.scm b/utils.scm new file mode 100644 index 0000000..e063b85 --- /dev/null +++ b/utils.scm @@ -0,0 +1,27 @@ +(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)))) -- 2.30.2