fix types of stx->list, stx-car, etc.

This commit is contained in:
AlexKnauth 2014-09-08 18:25:51 -04:00 committed by Asumu Takikawa
parent b19f5a34ee
commit 56faac79c4

View File

@ -12,27 +12,27 @@
[stx-list? (make-pred-ty (-stx-list Univ))] [stx-list? (make-pred-ty (-stx-list Univ))]
[stx->list (-poly (a) [stx->list (-poly (a)
(cl->* (-> (-lst a) (-lst a)) (cl->* (-> (-lst a) (-lst a))
(-> (-Syntax (-lst a)) (-lst (-Syntax a))) (-> (-Syntax (-lst a)) (-lst a))
(-> (-Syntax Univ) (-val #f))))] (-> (-Syntax Univ) (-val #f))))]
[stx-car (-poly (a b) [stx-car (-poly (a b)
(cl->* (cl->*
(-> (-pair a b) a) (-> (-pair a b) a)
(-> (-lst a) a) (-> (-lst a) a)
(-> (-Syntax (-pair a b)) (-Syntax a)) (-> (-Syntax (-pair a b)) a)
(-> (-Syntax (-lst a)) (-Syntax a))))] (-> (-Syntax (-lst a)) a)))]
[stx-cdr (-poly (a b) [stx-cdr (-poly (a b)
(cl->* (cl->*
(-> (-pair a b) b) (-> (-pair a b) b)
(-> (-lst a) (-lst a)) (-> (-lst a) (-lst a))
(-> (-Syntax (-pair a (-lst b))) (-lst (-Syntax b))) (-> (-Syntax (-pair a (-lst b))) (-lst b))
(-> (-Syntax (-pair a b)) (-Syntax b)) (-> (-Syntax (-pair a b)) b)
(-> (-Syntax (-lst a)) (-lst (-Syntax a)))))] (-> (-Syntax (-lst a)) (-lst a))))]
[stx-map (-polydots (c a b) [stx-map (-polydots (c a b)
(cl->* (cl->*
(-> (-> a c) (-pair a (-lst a)) (-pair c (-lst c))) (-> (-> a c) (-pair a (-lst a)) (-pair c (-lst c)))
(-> (-> a c) (-Syntax (-pair a (-lst a))) (-pair c (-lst c))) (-> (-> a c) (-Syntax (-pair a (-lst a))) (-pair c (-lst c)))
((list ((list
((list (-Syntax a)) ((-Syntax b) b) . ->... . c) ((list a) (b b) . ->... . c)
(Un (-lst a) (-Syntax (-lst a)))) (Un (-lst a) (-Syntax (-lst a))))
((Un (-lst b) (-Syntax (-lst b))) b) . ->... .(-lst c))))] ((Un (-lst b) (-Syntax (-lst b))) b) . ->... .(-lst c))))]
[module-or-top-identifier=? [module-or-top-identifier=?