From 878b67a4a6a177ac609fad8e7732b636dc02d5fd Mon Sep 17 00:00:00 2001 From: Asumu Takikawa Date: Fri, 20 Dec 2013 04:47:09 -0500 Subject: [PATCH] Add types for `syntax/stx` as `typed/syntax/stx` --- .../typed-racket-more/typed/syntax/stx.rkt | 31 +++++++++++++++++++ 1 file changed, 31 insertions(+) create mode 100644 pkgs/typed-racket-pkgs/typed-racket-more/typed/syntax/stx.rkt diff --git a/pkgs/typed-racket-pkgs/typed-racket-more/typed/syntax/stx.rkt b/pkgs/typed-racket-pkgs/typed-racket-more/typed/syntax/stx.rkt new file mode 100644 index 0000000000..ed8bad3673 --- /dev/null +++ b/pkgs/typed-racket-pkgs/typed-racket-more/typed/syntax/stx.rkt @@ -0,0 +1,31 @@ +#lang s-exp typed-racket/base-env/extra-env-lang + +(require syntax/stx) + +[stx-null? (make-pred-ty (Un (-val '()) (-Syntax (-val '()))))] +[stx-pair? (make-pred-ty (Un (-pair Univ Univ) (-Syntax (-pair Univ Univ))))] +[stx-list? (make-pred-ty (Un (-lst Univ) (-Syntax (-lst Univ))))] +[stx-car (-poly (a b) + (cl->* + (-> (-pair a b) a) + (-> (-lst a) a) + (-> (-Syntax (-pair a b)) (-Syntax a)) + (-> (-Syntax (-lst a)) (-Syntax a))))] +[stx-cdr (-poly (a b) + (cl->* + (-> (-pair a b) b) + (-> (-lst a) (-lst a)) + (-> (-Syntax (-pair a (-lst b))) (-lst (-Syntax b))) + (-> (-Syntax (-pair a b)) (-Syntax b)) + (-> (-Syntax (-lst a)) (-lst (-Syntax a)))))] +[stx-map (-polydots (c a b) + (cl->* + (-> (-> (-Syntax a) c) (-pair a (-lst a)) (-pair c (-lst c))) + (-> (-> (-Syntax a) c) (-Syntax (-pair a (-lst a))) (-pair c (-lst c))) + ((list + ((list (-Syntax a)) ((-Syntax b) b) . ->... . c) + (Un (-lst a) (-Syntax (-lst a)))) + ((Un (-lst b) (-Syntax (-lst b))) b) . ->... .(-lst c))))] +[module-or-top-identifier=? + (-> (-Syntax -Symbol) (-Syntax -Symbol) -Boolean)] +