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/base.lux | 66 +++++++++++++++++++++++++++++++++++++++++--
 1 file changed, 64 insertions(+), 2 deletions(-)

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

diff --git a/new-luxc/source/luxc/base.lux b/new-luxc/source/luxc/base.lux
index ce872e9da..8660d7ccf 100644
--- a/new-luxc/source/luxc/base.lux
+++ b/new-luxc/source/luxc/base.lux
@@ -1,8 +1,11 @@
 (;module:
   lux
   (lux (control monad)
-       (data text/format)
-       [macro #+ Monad<Lux>]))
+       (data [text "T/" Eq<Text>]
+             text/format
+             ["E" error])
+       [macro #+ Monad<Lux>]
+       (type ["TC" check])))
 
 (type: #export Path Text)
 
@@ -19,3 +22,62 @@
                             "," (|> col nat-to-int %i))]]
     (macro;fail (format "@ " location
                         "\n" message))))
+
+(def: #export (with-expected-type expected action)
+  (All [a] (-> Type (Lux a) (Lux a)))
+  (function [compiler]
+    (case (action (set@ #;expected (#;Some expected) compiler))
+      (#E;Success [compiler' output])
+      (let [old-expected (get@ #;expected compiler)]
+        (#E;Success [(set@ #;expected old-expected compiler')
+                     output]))
+
+      (#E;Error error)
+      (#E;Error error))))
+
+(def: #export (within-type-env action)
+  (All [a] (-> (TC;Check a) (Lux a)))
+  (function [compiler]
+    (case (action (get@ #;type-context compiler))
+      (#E;Error error)
+      (#E;Error error)
+
+      (#E;Success [context' output])
+      (#E;Success [(set@ #;type-context context' compiler)
+                   output]))))
+
+(def: #export (pl::put key val table)
+  (All [a] (-> Text a (List [Text a]) (List [Text a])))
+  (case table
+    #;Nil
+    (list [key val])
+
+    (#;Cons [k' v'] table')
+    (if (T/= key k')
+      (#;Cons [key val]
+              table')
+      (#;Cons [k' v']
+              (pl::put key val table')))))
+
+(def: #export (pl::get key table)
+  (All [a] (-> Text (List [Text a]) (Maybe a)))
+  (case table
+    #;Nil
+    #;None
+
+    (#;Cons [k' v'] table')
+    (if (T/= key k')
+      (#;Some v')
+      (pl::get key table'))))
+
+(def: #export (with-source-code source action)
+  (All [a] (-> [Cursor Text] (Lux a) (Lux a)))
+  (function [compiler]
+    (let [old-source (get@ #;source compiler)]
+      (case (action (set@ #;source source compiler))
+        (#E;Error error)
+        (#E;Error error)
+
+        (#E;Success [compiler' output])
+        (#E;Success [(set@ #;source old-source compiler')
+                     output])))))
-- 
cgit v1.2.3