fixing bug in type inference

lib/chibi/ast.c

@@ -212,9 +212,11 @@ static sexp sexp_type_of (sexp ctx, sexp self, sexp_sint_t n, sexp x) {
     return sexp_type_by_index(ctx, SEXP_OBJECT);
 }
 
-static sexp sexp_env_parent_set_op (sexp ctx, sexp self, sexp_sint_t n, sexp e) {
+static sexp sexp_env_parent_set_op (sexp ctx, sexp self, sexp_sint_t n, sexp e1, sexp e2) {
-  sexp_assert_type(ctx, sexp_envp, SEXP_ENV, e);
+  sexp_assert_type(ctx, sexp_envp, SEXP_ENV, e1);
-  return sexp_env_parent(e) ? sexp_env_parent(e) : SEXP_FALSE;
+  if (sexp_truep(e2)) sexp_assert_type(ctx, sexp_envp, SEXP_ENV, e2);
+  sexp_env_parent(e1) = e2;
+  return SEXP_VOID;
 }
 
 static sexp sexp_env_lambda_op (sexp ctx, sexp self, sexp_sint_t n, sexp e) {

lib/chibi/modules.scm

@@ -69,12 +69,13 @@
             (else (lp (cdr ls) res))))))
 
 (define (analyze-module-source name mod recursive?)
-  (let ((env (module-env mod))
+  (let ((env (make-environment))
         (dir (module-dir mod)))
     (define (include-source file)
       (cond ((find-module-file (string-append dir file))
-             => (lambda (x) (cons 'body (file->sexp-list x))))
+             => (lambda (x) (cons 'begin (file->sexp-list x))))
             (else (error "couldn't find include" file))))
+    (env-parent-set! env (module-env mod))
     (let lp ((ls (module-meta-data mod)) (res '()))
       (cond
        ((not (pair? ls))
@@ -90,9 +91,11 @@
                     (analyze-module mod2-name #t))))
             (cdar ls))
            (lp (cdr ls) res))
-          ((include)
+          ((include include-ci)
            (lp (append (map include-source (cdar ls)) (cdr ls)) res))
-          ((body begin)
+          ((include-library-declarations)
+           (lp (append (append-map file->sexp-list (cdar ls)) (cdr ls)) res))
+          ((begin body)
            (let lp2 ((ls2 (cdar ls)) (res res))
              (cond
               ((pair? ls2)
@@ -104,10 +107,12 @@
 
 (define (analyze-module name . o)
   (let ((recursive? (and (pair? o) (car o)))
-        (res (load-module name)))
+        (mod (load-module name)))
-    (if (not (module-ast res))
+    (cond
-        (module-ast-set! res (analyze-module-source name res recursive?)))
+     ((not (module-ast mod))
-    res))
+      (module-ast-set! mod '())       ; break cycles, just in case
+      (module-ast-set! mod (analyze-module-source name mod recursive?))))
+    mod))
 
 (define (module-ref mod var-name . o)
   (let ((cell (env-cell (module-env (if (module? mod) mod (load-module mod)))
@@ -121,8 +126,6 @@
        #t))
 
 (define (module-defines? name mod var-name)
-  (if (not (module-ast mod))
-      (module-ast-set! mod (analyze-module-source name mod #f)))
   (let lp ((ls (module-ast mod)))
     (and (pair? ls)
          (or (and (set? (car ls))

lib/chibi/modules.sld

@@ -1,11 +1,15 @@
 
 (define-library (chibi modules)
-  (export module-name module-dir module-includes module-shared-includes
+  (export module? module-name module-dir module-includes module-shared-includes
           module-include-library-declarations
           module-ast module-ast-set! module-ref module-contains?
           analyze-module containing-module load-module module-exports
           module-name->file procedure-analysis find-module
           available-modules-in-directory available-modules
           modules-exporting-identifier file->sexp-list)
-  (import (chibi) (meta) (srfi 1) (chibi ast) (chibi filesystem))
+  (import (chibi) (srfi 1) (chibi ast) (chibi filesystem)
+          (only (meta)
+                module-env module-meta-data module-exports
+                make-module load-module find-module resolve-import
+                module-name-prefix module-name->file *modules*))
   (include "modules.scm"))

lib/chibi/type-inference.scm

@@ -68,6 +68,8 @@
     (if (union-type? b)
         (cons (car a) (lset-union type=? (cdr a) (cdr b)))
         (cons (car a) (lset-adjoin type=? (cdr a) b))))
+   ((union-type? b)
+    (cons (car b) (lset-adjoin type=? (cdr b) a)))
    (else (list 'or a b))))
 
 ;; XXXX check for conflicts
@@ -270,9 +272,9 @@
 
 (define (type-analyze-module name)
   (let* ((mod (analyze-module name))
-         (ls (and (vector? mod) (module-ast mod))))
+         (ls (and (module? mod) (module-ast mod))))
     (and ls
-         (let ((x (let lp ((ls ls)) ;; first lambda
+         (let ((x (let lp ((ls ls))  ;; first lambda
                     (and (pair? ls)
                          (if (and (set? (car ls))
                                   (lambda? (set-value (car ls))))