aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/base.lux
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--new-luxc/source/luxc/base.lux56
1 files changed, 34 insertions, 22 deletions
diff --git a/new-luxc/source/luxc/base.lux b/new-luxc/source/luxc/base.lux
index ee2d4464d..e900edf6c 100644
--- a/new-luxc/source/luxc/base.lux
+++ b/new-luxc/source/luxc/base.lux
@@ -3,7 +3,7 @@
(lux (control monad)
(data [text "T/" Eq<Text>]
text/format
- ["E" error])
+ ["R" result])
[macro #+ Monad<Lux>]
(type ["TC" check]))
(luxc (lang ["la" analysis])))
@@ -35,23 +35,23 @@
(All [a] (-> Type (Lux a) (Lux a)))
(function [compiler]
(case (action (set@ #;expected (#;Some expected) compiler))
- (#E;Success [compiler' output])
+ (#R;Success [compiler' output])
(let [old-expected (get@ #;expected compiler)]
- (#E;Success [(set@ #;expected old-expected compiler')
+ (#R;Success [(set@ #;expected old-expected compiler')
output]))
- (#E;Error error)
- (#E;Error error))))
+ (#R;Error error)
+ (#R;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)
+ (#R;Error error)
+ (#R;Error error)
- (#E;Success [context' output])
- (#E;Success [(set@ #;type-context context' compiler)
+ (#R;Success [context' output])
+ (#R;Success [(set@ #;type-context context' compiler)
output]))))
(def: #export (pl-contains? key mappings)
@@ -93,22 +93,22 @@
(function [compiler]
(let [old-source (get@ #;source compiler)]
(case (action (set@ #;source source compiler))
- (#E;Error error)
- (#E;Error error)
+ (#R;Error error)
+ (#R;Error error)
- (#E;Success [compiler' output])
- (#E;Success [(set@ #;source old-source compiler')
+ (#R;Success [compiler' output])
+ (#R;Success [(set@ #;source old-source compiler')
output])))))
(def: #export (with-stacked-errors handler action)
(All [a] (-> (-> [] Text) (Lux a) (Lux a)))
(function [compiler]
(case (action compiler)
- (#E;Success [compiler' output])
- (#E;Success [compiler' output])
+ (#R;Success [compiler' output])
+ (#R;Success [compiler' output])
- (#E;Error error)
- (#E;Error (if (T/= "" error)
+ (#R;Error error)
+ (#R;Error (if (T/= "" error)
(handler [])
(format error "\n-----------------------------------------\n" (handler [])))))))
@@ -128,14 +128,26 @@
(All [a] (-> (Lux a) (Lux [Scope a])))
(function [compiler]
(case (action (update@ #;scopes (|>. (#;Cons fresh-scope)) compiler))
- (#E;Success [compiler' output])
+ (#R;Success [compiler' output])
(case (get@ #;scopes compiler')
#;Nil
- (#E;Error "Impossible error: Drained scopes!")
+ (#R;Error "Impossible error: Drained scopes!")
(#;Cons head tail)
- (#E;Success [(set@ #;scopes tail compiler')
+ (#R;Success [(set@ #;scopes tail compiler')
[head output]]))
- (#E;Error error)
- (#E;Error error))))
+ (#R;Error error)
+ (#R;Error error))))
+
+(def: #export (with-cursor cursor action)
+ (All [a] (-> Cursor (Lux a) (Lux a)))
+ (function [compiler]
+ (let [old-cursor (get@ #;cursor compiler)]
+ (case (action (set@ #;cursor cursor compiler))
+ (#R;Success [compiler' output])
+ (#R;Success [(set@ #;cursor old-cursor compiler')
+ output])
+
+ (#R;Error error)
+ (#R;Error error)))))