Add notes on ownership

[scheme.git] / typecheck.scm

diff --git a/typecheck.scm b/typecheck.scm
index a767ed07fb1c2244819c0bcbbb2539ff9ecc12bf..e96f6943767e1c5ab463398d11146d8f8ae450ce 100644 (file)
--- 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)