projects
/
scheme.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (parent:
a64f709
)
WIP in let-binding pattern match stuff
author
Luke Lau
<luke_lau@icloud.com>
Fri, 2 Aug 2019 15:08:37 +0000
(16:08 +0100)
committer
Luke Lau
<luke_lau@icloud.com>
Fri, 2 Aug 2019 15:08:37 +0000
(16:08 +0100)
ast.scm
patch
|
blob
|
history
diff --git
a/ast.scm
b/ast.scm
index 469a96f7162cb09c77dac0ed71b971dcbbd179a0..23e7723cc725a3a07b2fe5229576b92e604c34b2 100644
(file)
--- a/
ast.scm
+++ b/
ast.scm
@@
-71,8
+71,16
@@
[else (p x)]))
(define (let-bindings e)
[else (p x)]))
(define (let-bindings e)
- (define (extract x) ) ; TODO
- (flat-map extract (cadr e))
+ (define (pattern-match x body)
+ (if (eqv? (ast-type x) 'var)
+ (cons x body)
+ (let* ([constructor (car x)]
+ [destructor (lambda (i) `(destruct ,i ,constructor))])
+ (flat-map (lambda (y i)
+ (pattern-match y (list (destructor i) body)))
+ (cdr x)
+ (range 0 (length (cdr x)))))))
+ (flat-map (lambda (x) (pattern-match (car x) (cdr x))) (cadr e)))
(define let-body cddr)
(define (lambda? x)
(define let-body cddr)
(define (lambda? x)
@@
-107,7
+115,12
@@
(define lambda-body caddr)
; utils
(define lambda-body caddr)
; utils
-(define (flat-map f x) (fold-left append '() (map f x)))
+(define (range s n)
+ (if (= 0 n) '()
+ (append (range s (- n 1))
+ (list (+ s (- n 1))))))
+
+(define (flat-map f . xs) (fold-left append '() (map f xs)))
(define (repeat x n) (if (<= n 0) '()
(cons x (repeat x (- n 1)))))
(define (repeat x n) (if (<= n 0) '()
(cons x (repeat x (- n 1)))))