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

Fix up singleton values

Browse Source
This commit is contained in:
Sam Tobin-Hochstadt 2008-07-07 14:49:46 -04:00
parent 044bd551b0
commit d0939ffa1e
2 changed files with 9 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -464,7 +464,7 @@
;; 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 (debug (take S (length T)))] (let* ([short-S (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))]
@ -484,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 cgen/list) ;;(trace cgen/arr cgen cgen/list)

8
collects/typed-scheme/private/type-utils.ss
View File

@ -56,6 +56,12 @@
(make-ValuesDots (map sb types) (sb dty) dbound))]) (make-ValuesDots (map sb types) (sb dty) dbound))])
target)) target))
;; the other definition is not accessible here
(define (-values args)
(if (= (length args) 1)
(car args)
(make-Values args)))
;; substitute-dots : Listof[Type] Option[type] Name Type -> Type ;; substitute-dots : Listof[Type] Option[type] Name Type -> Type
(define (substitute-dots images rimage name target) (define (substitute-dots images rimage name target)
(define (sb t) (substitute-dots images rimage name t)) (define (sb t) (substitute-dots images rimage name t))
@ -63,7 +69,7 @@
(type-case sb target (type-case sb target
[#:ValuesDots types dty dbound [#:ValuesDots types dty dbound
(if (eq? name dbound) (if (eq? name dbound)
(make-Values (-values
(append (append
(map sb types) (map sb types)
;; We need to recur first, just to expand out any dotted usages of this. ;; We need to recur first, just to expand out any dotted usages of this.