From e0c21be8ded9924bb0fde7ae5b7bd422d77a6b03 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Sat, 17 Dec 2016 15:27:37 -0400
Subject: - Added the type-of macro.

---
 stdlib/source/lux.lux | 38 ++++++++++++++++++++++++--------------
 1 file 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")))
-- 
cgit v1.2.3