diff options
| -rw-r--r-- | stdlib/source/lux.lux | 38 |
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"))) |