X-Git-Url: http://git.lukelau.me/?p=scheme.git;a=blobdiff_plain;f=typecheck.scm;h=e96f6943767e1c5ab463398d11146d8f8ae450ce;hp=a767ed07fb1c2244819c0bcbbb2539ff9ecc12bf;hb=f605bff88ce12e5f4384ab308c036350bfa86cb5;hpb=d486b87b4fb6311cd627887fe3da67a8f8d4cbb4

diff --git a/typecheck.scm b/typecheck.scm
index a767ed0..e96f694 100644
--- a/typecheck.scm
+++ b/typecheck.scm
@@ -180,8 +180,9 @@
 		 (let* [(func-type (env-lookup env (car x)))
 			(return-type (fresh-tvar))
 			(other-func-type `(abs ,func-type ,return-type))
-			(cs (~ func-type other-func-type))]
-		   (list cs return-type))
+			(cs (~ func-type other-func-type))
+			(resolved-return-type (substitute cs return-type))]
+		   (list cs resolved-return-type))
 
 					; regular function
 		 (let* ((arg-type-res (check env (cadr x)))
@@ -244,10 +245,16 @@
 
 					; TODO: what's the most appropriate substitution?
 					; should all constraints just be limited to a pair?
+					; this is currently horrific and i don't know what im doing.
+					; should probably use ast-find here or during consolidation
+					; to detect substitutions more than one layer deep
+					; e.g. (abs t1 int) ~ (abs bool int)
+					; substituting these constraints with t1 should resolve t1 with bool
 (define (substitute cs t)
 					; gets the first concrete type
 					; otherwise returns the last type variable
 
+					; removes t itself from cs, to prevent infinite recursion
   (define cs-without-t
     (map (lambda (c)
 	   (filter (lambda (x) (not (eqv? t x))) c))
@@ -324,18 +331,21 @@
 	      (lambda (acc c)
 		(if (tvar? c) acc #f))]
 	     [test (lambda (acc c)
-		     (and acc (fold-left test-kind #t c)))])
+		     (and acc
+			  (fold-left test-kind #t c) ; check only tvar substitutions
+			  (<= (length c) 2)))])	     ; check maximum 2 subs per equality group
 	  (fold-left test #t cs)))))
 
 					; 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
-	 ['var (if (assoc x bs) (list x) '())]
+	   ['var (if (assoc x orig-bs) (list x) '())]
 	   [else '()]))
        prog))
     (if (null? bs)
@@ -349,10 +359,11 @@
 
 	       (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))))
+  (go bs bs))
 
 (define (successors graph v)
   (define (go v E)