suzanne.soy/typed-racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Various small assorted fixes.

Browse Source 
original commit: d886331807f55e5a2a4ebb464b50d50835e20393
This commit is contained in:
Sam Tobin-Hochstadt 2010-06-03 17:31:09 -04:00
parent c2b7caa66d
commit 7e4ee76e4e
4 changed files with 37 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
collects/typed-scheme/infer/constraint-structs.rkt
View File

@ -9,6 +9,9 @@
;; fixed : Listof[c]
;; rest : option[c]
;; a constraint on an index variable
;; the index variable must be instantiated with |fixed| arguments, each meeting the appropriate constraint
;; and further instantions of the index variable must respect the rest constraint, if it exists
(d-s/c dcon ([fixed (listof c?)] [rest (or/c c? #f)]) #:transparent)
;; fixed : Listof[c]
@ -19,8 +22,10 @@
;; bound : var
(d-s/c dcon-dotted ([type c?] [bound symbol?]) #:transparent)
;; map : hash mapping variable to dcon or dcon-dotted
(d-s/c dmap ([map (hash/c symbol? (or/c dcon? dcon-exact? dcon-dotted?))]) #:transparent)
(define dcon/c (or/c dcon? dcon-exact? dcon-dotted?))
;; map : hash mapping index variables to dcons
(d-s/c dmap ([map (hash/c symbol? dcon/c)]) #:transparent)
;; maps is a list of pairs of
;; - functional maps from vars to c's
@ -28,7 +33,7 @@
;; we need a bunch of mappings for each cset to handle case-lambda
;; because case-lambda can generate multiple possible solutions, and we
;; don't want to rule them out too early
(d-s/c cset ([maps (listof (cons/c (hash/c symbol? c?) dmap?))]) #:transparent)
(d-s/c cset ([maps (listof (cons/c (hash/c symbol? c? #:immutable #t) dmap?))]) #:transparent)
(define-match-expander c:
(lambda (stx)
@ -37,4 +42,4 @@
#'(struct c (s x t))])))
(provide (struct-out cset) (struct-out dmap) (struct-out dcon) (struct-out dcon-dotted) (struct-out dcon-exact) (struct-out c)
c:)
c: dcon/c)

2
collects/typed-scheme/infer/dmap.rkt
View File

@ -10,7 +10,7 @@
;; dcon-meet : dcon dcon -> dcon
(d/c (dcon-meet dc1 dc2)
(dcon? dcon? . -> . dcon?)
(dcon/c dcon/c . -> . dcon/c)
(match* (dc1 dc2)
[((struct dcon-exact (fixed1 rest1)) (or (struct dcon (fixed2 rest2))
(struct dcon-exact (fixed2 rest2))))

21
collects/typed-scheme/infer/infer-unit.rkt
View File

@ -66,7 +66,13 @@
dmap)))
cset))
(define (move-vars-to-dmap cset dbound vars)
;; dbound : index variable
;; vars : listof[type variable] - temporary variables
;; cset : the constraints being manipulated
;; takes the constraints on vars and creates a dmap entry contstraining dbound to be |vars|
;; with the constraints that cset places on vars
(d/c (move-vars-to-dmap cset dbound vars)
(cset? symbol? (listof symbol?) . -> . cset?)
(mover cset dbound vars
(λ (cmap)
(make-dcon (for/list ([v vars])
@ -74,7 +80,11 @@
(λ () (int-err "No constraint for new var ~a" v))))
#f))))
(define (move-rest-to-dmap cset dbound #:exact [exact? #f])
;; dbound : index variable
;; cset : the constraints being manipulated
;;
(d/c (move-rest-to-dmap cset dbound #:exact [exact? #f])
((cset? symbol?) (#:exact boolean?) . ->* . cset?)
(mover cset dbound (list dbound)
(λ (cmap)
((if exact? make-dcon-exact make-dcon)
@ -82,7 +92,8 @@
(hash-ref cmap dbound
(λ () (int-err "No constraint for bound ~a" dbound)))))))
(define (move-vars+rest-to-dmap cset dbound vars #:exact [exact? #f])
(d/c (move-vars+rest-to-dmap cset dbound vars #:exact [exact? #f])
((cset? symbol? (listof symbol?)) (#:exact boolean?) . ->* . cset?)
(mover cset dbound vars
(λ (cmap)
((if exact? make-dcon-exact make-dcon)
@ -91,7 +102,6 @@
(hash-ref cmap dbound
(λ () (int-err "No constraint for bound ~a" dbound)))))))
;; s and t must be *latent* filters
(define (cgen/filter V X s t)
(match* (s t)
[(e e) (empty-cset X)]
@ -194,6 +204,7 @@
[ret-mapping (cg s t)])
(cset-meet*
(list arg-mapping darg-mapping ret-mapping)))]
;; * <: ...
[((arr: ss s s-rest #f '())
(arr: ts t #f (cons t-dty dbound) '()))
(unless (memq dbound X)
@ -460,7 +471,7 @@
(match v
[(struct c (S X T))
;; fixme - handle free indexes, remove Dotted
(let ([var (hash-ref (free-vars* R) (or variable X) Constant)])
(let ([var (hash-ref (free-vars* R) (or variable X) (λ () (hash-ref (free-idxs* R) (or variable X) Constant)))])
;(printf "variance was: ~a~nR was ~a~nX was ~a~nS T ~a ~a~n" var R (or variable X) S T)
(evcase var
[Constant S]

17
collects/typed-scheme/typecheck/tc-app.rkt
View File

@ -813,7 +813,7 @@
#:return (or expected (ret (Un)))
(string-append "No function domains matched in function application:\n"
(domain-mismatches t doms rests drests rngs argtys-t #f #f))))]
;; any kind of polymorphic function
;; any kind of dotted polymorphic function without mandatory keyword args
[((tc-result1: (and t (PolyDots:
(and vars (list fixed-vars ... dotted-var))
(Function: (list (and arrs (arr: doms rngs rests drests (list (Keyword: _ _ #f) ...))) ...)))))
@ -828,11 +828,16 @@
;; only try to infer the free vars of the rng (which includes the vars in filters/objects)
;; note that we have to use argtys-t here, since argtys is a list of tc-results
(lambda (dom rng rest drest a)
(if drest
(infer/dots fixed-vars dotted-var argtys-t dom (car drest) rng (fv rng)
#:expected (and expected (tc-results->values expected)))
(infer/vararg fixed-vars (list dotted-var) argtys-t dom rest rng
(and expected (tc-results->values expected)))))
(cond
[drest
(infer/dots fixed-vars dotted-var argtys-t dom (car drest) rng (fv rng)
#:expected (and expected (tc-results->values expected)))]
[rest
(infer/vararg fixed-vars (list dotted-var) argtys-t dom rest rng
(and expected (tc-results->values expected)))]
;; no rest or drest
[else (infer fixed-vars (list dotted-var) argtys-t dom rng
(and expected (tc-results->values expected)))]))
t argtys expected)]
;; regular polymorphic functions without dotted rest, and without mandatory keyword args
[((tc-result1: