Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-19 05:39:18 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

fixing bug in type inference

Browse source
This commit is contained in:
Alex Shinn 2015-12-23 17:26:51 +09:00
parent ac3ae13bcd
commit e21736ac5d
4 changed files with 28 additions and 17 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
lib/chibi/ast.c
View file

@ -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) {
sexp_assert_type(ctx, sexp_envp, SEXP_ENV, e);
return sexp_env_parent(e) ? sexp_env_parent(e) : SEXP_FALSE;
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, e1);
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) {

23
lib/chibi/modules.scm
View file

@ -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)))
(if (not (module-ast res))
(module-ast-set! res (analyze-module-source name res recursive?)))
res))
(mod (load-module name)))
(cond
((not (module-ast mod))
(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))

8
lib/chibi/modules.sld
View file

@ -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"))

4
lib/chibi/type-inference.scm
View file

@ -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,7 +272,7 @@
(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
(and (pair? ls)