projects
/
scheme.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (from parent 1:
2fb532c
)
Fix graph not considering original binds when recursing
author
Luke Lau
<luke_lau@icloud.com>
Mon, 29 Jul 2019 13:20:47 +0000
(14:20 +0100)
committer
Luke Lau
<luke_lau@icloud.com>
Mon, 29 Jul 2019 13:20:47 +0000
(14:20 +0100)
tests.scm
patch
|
blob
|
history
typecheck.scm
patch
|
blob
|
history
diff --git
a/tests.scm
b/tests.scm
index a198dd4ac5a00e4cd71e9a88f8ae32eefbca994c..67d8b306140d6502c363fe153227ee4445c6d60e 100644
(file)
--- a/
tests.scm
+++ b/
tests.scm
@@
-50,6
+50,24
@@
bar))
'(abs a a))
bar))
'(abs a a))
+(test-types (typecheck '(let ([foo 3]
+ [bar (+ foo baz)]
+ [baz (- bar 1)])
+ bar))
+ 'int)
+
+(test-types (typecheck '(let ([foo 3]
+ [bar (baz foo)]
+ [baz (lambda (x) x)])
+ baz))
+ '(abs a a))
+
+(test-types (typecheck '(let ([foo 3]
+ [bar (baz foo)]
+ [baz (lambda (x) x)])
+ bar))
+ 'int)
+
(test-prog '(+ 1 2) 3)
(test-prog '((lambda (x) ((lambda (y) (+ x y)) 42)) 100) 142)
(test-prog '(+ 1 2) 3)
(test-prog '((lambda (x) ((lambda (y) (+ x y)) 42)) 100) 142)
diff --git
a/typecheck.scm
b/typecheck.scm
index 219b010202a7f7a0127847e8372ea7e064a05efb..e96f6943767e1c5ab463398d11146d8f8ae450ce 100644
(file)
--- a/
typecheck.scm
+++ b/
typecheck.scm
@@
-339,12
+339,13
@@
; input: a list of binds ((x . y) (y . 3))
; returns: pair of verts, edges ((x y) . (x . y))
(define (graph bs)
; input: a list of binds ((x . y) (y . 3))
; returns: pair of verts, edges ((x y) . (x . y))
(define (graph bs)
+ (define (go bs orig-bs)
(define (find-refs prog)
(ast-collect
(lambda (x)
(case (ast-type x)
; only count a reference if its a binding
(define (find-refs prog)
(ast-collect
(lambda (x)
(case (ast-type x)
; only count a reference if its a binding
-
['var (if (assoc x
bs) (list x) '())]
+
['var (if (assoc x orig-
bs) (list x) '())]
[else '()]))
prog))
(if (null? bs)
[else '()]))
prog))
(if (null? bs)
@@
-358,10
+359,11
@@
(rest (if (null? (cdr bs))
(cons '() '())
(rest (if (null? (cdr bs))
(cons '() '())
-
(graph (cdr bs)
)))
+
(go (cdr bs) orig-bs
)))
(total-verts (cons vert (car rest)))
(total-edges (append edges (cdr rest)))]
(cons total-verts total-edges))))
(total-verts (cons vert (car rest)))
(total-edges (append edges (cdr rest)))]
(cons total-verts total-edges))))
+ (go bs bs))
(define (successors graph v)
(define (go v E)
(define (successors graph v)
(define (go v E)