From 54815ade282ff4feb81d7d557188bde8111db376 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Thu, 5 Oct 2017 00:17:51 -0400
Subject: - Added tests for type-checking and type-coercion. - Implemented
 "eval". - Fixed bugs when analysing variants and tuples.

---
 new-luxc/source/luxc/analyser.lux           | 32 ++++++++++++++--------------
 new-luxc/source/luxc/analyser/structure.lux | 33 +++++++++++++++++++++++++++--
 new-luxc/source/luxc/eval.lux               | 17 +++++++++++++++
 3 files changed, 64 insertions(+), 18 deletions(-)
 create mode 100644 new-luxc/source/luxc/eval.lux

(limited to 'new-luxc/source')

diff --git a/new-luxc/source/luxc/analyser.lux b/new-luxc/source/luxc/analyser.lux
index 3272057f2..f17ec8496 100644
--- a/new-luxc/source/luxc/analyser.lux
+++ b/new-luxc/source/luxc/analyser.lux
@@ -76,16 +76,12 @@
                               body)))
              (&&function;analyse-function analyse func-name arg-name body)
 
-             (^ (#;Form (list [_ (#;Symbol ["" "_lux_check"])]
-                              type
-                              value)))
-             (&&type;analyse-check analyse eval type value)
-
-             (^ (#;Form (list [_ (#;Symbol ["" "_lux_coerce"])]
-                              type
-                              value)))
-             (&&type;analyse-coerce analyse eval type value)
-
+             (^template [<proc> <analyser>]
+               (^ (#;Form (list [_ (#;Symbol ["" <proc>])] type value)))
+               (<analyser> analyse eval type value))
+             (["_lux_check" &&type;analyse-check]
+              ["_lux_coerce" &&type;analyse-coerce])
+             
              (^ (#;Form (list& [_ (#;Text proc-name)] proc-args)))
              (&&procedure;analyse-procedure analyse proc-name proc-args)
 
@@ -96,13 +92,17 @@
                [paired (to-branches branches)]
                (&&case;analyse-case analyse input paired))
 
-             (^ (#;Form (list [_ (#;Nat tag)]
-                              value)))
-             (&&structure;analyse-sum analyse tag value)
+             (^template [<tag> <analyser>]
+               (^ (#;Form (list& [_ (<tag> tag)]
+                                 values)))
+               (case values
+                 (#;Cons value #;Nil)
+                 (<analyser> analyse tag value)
 
-             (^ (#;Form (list [_ (#;Tag tag)]
-                              value)))
-             (&&structure;analyse-tagged-sum analyse tag value)
+                 _
+                 (<analyser> analyse tag (` [(~@ values)]))))
+             ([#;Nat &&structure;analyse-sum]
+              [#;Tag &&structure;analyse-tagged-sum])
 
              (^ (#;Form (list& func args)))
              (do Monad<Lux>
diff --git a/new-luxc/source/luxc/analyser/structure.lux b/new-luxc/source/luxc/analyser/structure.lux
index e13d1d88a..9a42db0fa 100644
--- a/new-luxc/source/luxc/analyser/structure.lux
+++ b/new-luxc/source/luxc/analyser/structure.lux
@@ -24,12 +24,23 @@
         (analyser ["&;" common]
                   ["&;" inference])))
 
+(type: Type-Error
+  (-> Type Text))
+
+(def: (not-variant type)
+  Type-Error
+  (format "Invalid type for variant: " (%type type)))
+
+(def: (not-quantified type)
+  Type-Error
+  (format "Not a quantified type: " (%type type)))
+
 (def: #export (analyse-sum analyse tag valueC)
   (-> &;Analyser Nat Code (Lux la;Analysis))
   (do Monad<Lux>
     [expected macro;expected-type]
     (&;with-stacked-errors
-      (function [_] (format "Invalid type for variant: " (%type expected)))
+      (function [_] (not-variant expected))
       (case expected
         (#;Sum _)
         (let [flat (type;flatten-variant expected)
@@ -62,7 +73,7 @@
             ## Cannot do inference when the tag is numeric.
             ## This is because there is no way of knowing how many
             ## cases the inferred sum type would have.
-            (&;fail (format "Invalid type for variant: " (%type expected)))))
+            (&;fail (not-variant expected))))
 
         (#;UnivQ _)
         (do @
@@ -76,6 +87,15 @@
           (function [[var-id var]]
             (&;with-expected-type (assume (type;apply (list var) expected))
               (analyse-sum analyse tag valueC))))
+
+        (#;Apply inputT funT)
+        (case (type;apply (list inputT) funT)
+          #;None
+          (&;fail (not-quantified funT))
+          
+          (#;Some outputT)
+          (&;with-expected-type outputT
+            (analyse-sum analyse tag valueC)))
         
         _
         (&;fail "")))))
@@ -173,6 +193,15 @@
           (function [[var-id var]]
             (&;with-expected-type (assume (type;apply (list var) expected))
               (analyse-product analyse membersC))))
+
+        (#;Apply inputT funT)
+        (case (type;apply (list inputT) funT)
+          #;None
+          (&;fail (not-quantified funT))
+          
+          (#;Some outputT)
+          (&;with-expected-type outputT
+            (analyse-product analyse membersC)))
         
         _
         (&;fail "")
diff --git a/new-luxc/source/luxc/eval.lux b/new-luxc/source/luxc/eval.lux
new file mode 100644
index 000000000..266becee6
--- /dev/null
+++ b/new-luxc/source/luxc/eval.lux
@@ -0,0 +1,17 @@
+(;module:
+  lux
+  (lux (control [monad #+ do])
+       [macro])
+  [../base]
+  (.. [analyser]
+      [synthesizer]
+      (generator [expr]
+                 [eval])))
+
+(def: #export (eval type exprC)
+  ../base;Eval
+  (do macro;Monad<Lux>
+    [exprA (../base;with-expected-type type
+             (analyser;analyser eval exprC))
+     #let [exprS (synthesizer;synthesize exprA)]]
+    (eval;eval (expr;generate exprS))))
-- 
cgit v1.2.3