From bf47bd7b3d4f70bc3a481761b8e9ff074313fb44 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Wed, 3 May 2017 18:17:00 -0400
Subject: - WIP: Implemented more functionality. - Lots of refactorings.

---
 new-luxc/source/luxc/analyser/common.lux | 78 ++++++++++++++++++++++++++++++++
 1 file changed, 78 insertions(+)
 create mode 100644 new-luxc/source/luxc/analyser/common.lux

(limited to 'new-luxc/source/luxc/analyser/common.lux')

diff --git a/new-luxc/source/luxc/analyser/common.lux b/new-luxc/source/luxc/analyser/common.lux
new file mode 100644
index 000000000..0deceaa39
--- /dev/null
+++ b/new-luxc/source/luxc/analyser/common.lux
@@ -0,0 +1,78 @@
+(;module:
+  lux
+  (lux (control monad
+                pipe)
+       (data text/format
+             [product])
+       [macro #+ Monad<Lux>]
+       [type]
+       (type ["TC" check]))
+  (luxc ["&" base]
+        lang))
+
+(def: #export get-type
+  (-> Analysis Type)
+  (|>. product;left
+       product;left))
+
+(def: #export (replace-type replacement analysis)
+  (-> Type Analysis Analysis)
+  (let [[[_type _cursor] _analysis] analysis]
+    (: Analysis
+       [[(: Type replacement)
+         (: Cursor _cursor)]
+        (: (Analysis' Analysis)
+           _analysis)])))
+
+(def: #export (clean type analysis)
+  (-> Type Analysis (Lux Analysis))
+  (case type
+    (#;VarT id)
+    (do Monad<Lux>
+      [=type (&;within-type-env
+              (TC;clean id type))]
+      (wrap (replace-type =type analysis)))
+    
+    (#;ExT id)
+    (undefined)
+    
+    _
+    (&;fail (format "Cannot clean type: " (%type type)))))
+
+(def: #export (with-unknown-type action)
+  (All [a] (-> (Lux Analysis) (Lux Analysis)))
+  (do Monad<Lux>
+    [[var-id var-type] (&;within-type-env
+                        TC;create-var)
+     analysis (|> (wrap action)
+                  (%> @
+                      [(&;with-expected-type var-type)]
+                      [(clean var-type)]))
+     _ (&;within-type-env
+        (TC;delete-var var-id))]
+    (wrap analysis)))
+
+(def: #export (realize expected)
+  (-> Type (TC;Check [(List Type) Type]))
+  (case expected
+    (#;NamedT [module name] _expected)
+    (realize _expected)
+
+    (#;UnivQ env body)
+    (do TC;Monad<Check>
+      [[var-id var-type] TC;create-var
+       [tail =expected] (realize (default (undefined)
+                                   (type;apply-type expected var-type)))]
+      (wrap [(list& var-type tail)
+             =expected]))
+
+    (#;ExQ env body)
+    (do TC;Monad<Check>
+      [[ex-id ex-type] TC;existential
+       [tail =expected] (realize (default (undefined)
+                                   (type;apply-type expected ex-type)))]
+      (wrap [(list& ex-type tail)
+             =expected]))
+
+    _
+    (:: TC;Monad<Check> wrap [(list) expected])))
-- 
cgit v1.2.3