Re-phrase scope analysis as constraint collection

2 files changed, 21 insertions, 11 deletions

diff --git a/compiler/passes/extract-identifiers.scm b/compiler/passes/extract-identifiers.scm
index d96528c..ef9bc38 100644
--- a/compiler/passes/extract-identifiers.scm
+++ b/compiler/passes/extract-identifiers.scm
@@ -27,6 +27,8 @@
   #:use-module (srfi srfi-69)
   #:export (extract-identifiers))
 
+(define any-type '(null bool number string array object))
+
 (define (identify-variables policy)
   "Recursively search the body of a <rule> for variable occurrences"
   (define new-scope (make <scope> #:identifiers (make-hash-table)))
@@ -35,18 +37,24 @@
       (($ <lean-intro-locals> identifiers _)
        (for-each (match-lambda
                    ((identifier ($ <constant> value))
-                    (add-to-scope new-scope breadcrumb (make <reference> #:parts `(,identifier)) (scheme-value->type value)))
-                   ;; TODO: Even if the right-hand side isn't a constant, we
-                   ;; still have a constraint we can add.
-                   (_ #f))
+                    (add-to-scope new-scope breadcrumb
+                                  (make <reference> #:parts `(,identifier))
+                                  `(== ,identifier ,(scheme-value->type value))))
+                   ((left-identifier right-identifier)
+                    (add-to-scope new-scope breadcrumb
+                                  (make <reference> #:parts `(,left-identifier))
+                                  `(== ,left-identifier ,right-identifier)))
+                   (_ (error "unreachable")))
                  identifiers))
 
       (($ <lean-exists> variables body)
-       (for-each (lambda (x) add-to-scope new-scope breadcrumb (make <reference> #:parts `(,x)) 'any)
+       (for-each (lambda (x)
+                   (add-to-scope new-scope breadcrumb
+                                 (make <reference> #:parts `(,x))
+                                 `(membero ,x ,any-type)))
                  variables))
 
-      (_ #t)
-      ))
+      (_ #t)))
   (policy-map policy process)
   new-scope)
 
diff --git a/compiler/types.scm b/compiler/types.scm
index 613b303..0c54bf4 100644
--- a/compiler/types.scm
+++ b/compiler/types.scm
@@ -258,15 +258,17 @@ and `identifier' is a <reference>"
   (assert (list? breadcrumb))
   (recur breadcrumb))
 
-(define (add-to-scope scope breadcrumb identifier type)
+(define (add-to-scope scope breadcrumb identifier constraint)
   "Add a new IDENTIFIER with TYPE to BREADCRUMB in SCOPE"
   (define looking-at (hash-table-ref/default (inner scope) breadcrumb '()))
   (assert (is-a? scope <scope>))
   (assert (is-a? identifier <reference>))
   (assert (list? breadcrumb))
-  (hash-table-set! (inner scope)
-                   breadcrumb
-                   (assoc-set! looking-at identifier type)))
+  (let* ((constraints (or (assoc-ref looking-at identifier) '()))
+         (constraints (cons constraint constraints)))
+    (hash-table-set! (inner scope)
+                     breadcrumb
+                     (assoc-set! looking-at identifier constraints))))
 
 (define-class <funcall> ()
   (ref  #:init-keyword #:name) ; <reference> (to the function being called)