aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEduardo Julian2016-12-17 15:27:37 -0400
committerEduardo Julian2016-12-17 15:27:37 -0400
commite0c21be8ded9924bb0fde7ae5b7bd422d77a6b03 (patch)
tree212283ea4eb3afb08b02b7c4f8cfd1d3b7a20ba4
parent1a226a76290d4a47b9b79bafc5358bc9a4077757 (diff)
- Added the type-of macro.
-rw-r--r--stdlib/source/lux.lux38
1 files changed, 24 insertions, 14 deletions
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux
index b834649e8..4a19939c2 100644
--- a/stdlib/source/lux.lux
+++ b/stdlib/source/lux.lux
@@ -4904,11 +4904,11 @@
(#Cons y ys')
(list& x y (interleave xs' ys')))))
-(def: (type->ast type)
+(def: (type-to-ast type)
(-> Type AST)
(case type
(#HostT name params)
- (` (#HostT (~ (text$ name)) (~ (untemplate-list (map type->ast params)))))
+ (` (#HostT (~ (text$ name)) (~ (untemplate-list (map type-to-ast params)))))
#VoidT
(` #VoidT)
@@ -4918,11 +4918,11 @@
(^template [<tag>]
(<tag> left right)
- (` (<tag> (~ (type->ast left)) (~ (type->ast right)))))
+ (` (<tag> (~ (type-to-ast left)) (~ (type-to-ast right)))))
([#SumT] [#ProdT])
(#LambdaT in out)
- (` (#LambdaT (~ (type->ast in)) (~ (type->ast out))))
+ (` (#LambdaT (~ (type-to-ast in)) (~ (type-to-ast out))))
(#BoundT idx)
(` (#BoundT (~ (nat$ idx))))
@@ -4934,18 +4934,18 @@
(` (#ExT (~ (nat$ id))))
(#UnivQ env type)
- (let [env' (untemplate-list (map type->ast env))]
- (` (#UnivQ (~ env') (~ (type->ast type)))))
+ (let [env' (untemplate-list (map type-to-ast env))]
+ (` (#UnivQ (~ env') (~ (type-to-ast type)))))
(#ExQ env type)
- (let [env' (untemplate-list (map type->ast env))]
- (` (#ExQ (~ env') (~ (type->ast type)))))
+ (let [env' (untemplate-list (map type-to-ast env))]
+ (` (#ExQ (~ env') (~ (type-to-ast type)))))
(#AppT fun arg)
- (` (#AppT (~ (type->ast fun)) (~ (type->ast arg))))
+ (` (#AppT (~ (type-to-ast fun)) (~ (type-to-ast arg))))
(#NamedT [module name] type)
- (` (#NamedT [(~ (text$ module)) (~ (text$ name))] (~ (type->ast type))))
+ (` (#NamedT [(~ (text$ module)) (~ (text$ name))] (~ (type-to-ast type))))
))
(macro: #export (loop tokens)
@@ -4969,8 +4969,8 @@
#None (fail "Wrong syntax for loop")))
init-types (mapM Monad<Lux> find-type inits')
expected get-expected-type]
- (return (list (` ((;_lux_: (-> (~@ (map type->ast init-types))
- (~ (type->ast expected)))
+ (return (list (` ((;_lux_: (-> (~@ (map type-to-ast init-types))
+ (~ (type-to-ast expected)))
(lambda (~ (symbol$ ["" "recur"])) [(~@ vars)]
(~ body)))
(~@ inits))))))
@@ -5273,7 +5273,7 @@
expected get-expected-type
g!temp (gensym "temp")]
(let [output (list g!temp
- (` (;_lux_case (;_lux_: (#;AppT Maybe (~ (type->ast expected)))
+ (` (;_lux_case (;_lux_: (#;AppT Maybe (~ (type-to-ast expected)))
(case (~ g!temp)
(~@ (multi-level-case$ g!temp [mlc body]))
@@ -5398,7 +5398,7 @@
(^ (list expr))
(do Monad<Lux>
[type get-expected-type]
- (wrap (list (` (;_lux_:! (~ (type->ast type)) (~ expr))))))
+ (wrap (list (` (;_lux_:! (~ (type-to-ast type)) (~ expr))))))
_
(fail "Wrong syntax for :!!")))
@@ -5485,3 +5485,13 @@
[real-to-frac ["real" "to-frac"] Real Frac]
[frac-to-real ["frac" "to-real"] Frac Real]
)
+
+(macro: #export (type-of tokens)
+ (case tokens
+ (^ (list [_ (#;SymbolS var-name)]))
+ (do Monad<Lux>
+ [var-type (find-type var-name)]
+ (wrap (list (type-to-ast var-type))))
+
+ _
+ (fail "Wrong syntax for type-of")))