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

stevie is magic

Browse Source
This commit is contained in:
Sam Tobin-Hochstadt 2008-07-07 14:39:10 -04:00
parent 61cefef89c
commit 044bd551b0
1 changed files with 5 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
collects/typed-scheme/private/infer-unit.ss
View File

@ -464,12 +464,13 @@
;; and T-dotted is the repeated type ;; and T-dotted is the repeated type
(define (infer/dots X dotted-var S T T-dotted R must-vars [expected #f]) (define (infer/dots X dotted-var S T T-dotted R must-vars [expected #f])
(with-handlers ([exn:infer? (lambda _ #f)]) (with-handlers ([exn:infer? (lambda _ #f)])
(let* ([short-S (take S (length T))] (let* ([short-S (debug (take S (length T)))]
[rest-S (drop S (length T))] [rest-S (drop S (length T))]
[cs-short (cgen/list null (cons dotted-var X) short-S T)] [cs-short (cgen/list null (cons dotted-var X) short-S T)]
[new-vars (for/list ([i (in-range (length rest-S))]) (gensym dotted-var))] [new-vars (for/list ([i (in-range (length rest-S))]) (gensym dotted-var))]
[new-Ts (for/list ([v new-vars]) [new-Ts (for/list ([v new-vars])
(substitute (make-F v) dotted-var T-dotted))] (substitute (make-F v) dotted-var
(substitute-dots (map make-F new-vars) #f dotted-var T-dotted)))]
[cs-dotted (cgen/list null (append new-vars X) rest-S new-Ts)] [cs-dotted (cgen/list null (append new-vars X) rest-S new-Ts)]
[cs-dotted* (move-vars-to-dmap cs-dotted dotted-var new-vars)] [cs-dotted* (move-vars-to-dmap cs-dotted dotted-var new-vars)]
[cs (cset-meet cs-short cs-dotted*)]) [cs (cset-meet cs-short cs-dotted*)])
@ -483,4 +484,4 @@
(define (i s t r) (define (i s t r)
(infer/simple (list s) (list t) r)) (infer/simple (list s) (list t) r))
;(trace cgen/arr cgen) (trace cgen/arr cgen cgen/list)