1 files changed, 115 insertions, 0 deletions
diff --git a/stdlib/source/lux/platform/compiler/default/phase.lux b/stdlib/source/lux/platform/compiler/default/phase.lux
new file mode 100644
index 000000000..a81d5dfa7
--- /dev/null
+++ b/stdlib/source/lux/platform/compiler/default/phase.lux
@@ -0,0 +1,115 @@
+(.module:
+  [lux #*
+   [control
+    ["." state]
+    ["ex" exception (#+ Exception exception:)]
+    [monad (#+ do)]]
+   [data
+    ["." product]
+    ["." error (#+ Error) ("error/." Functor<Error>)]
+    ["." text
+     format]]
+   [time
+    ["." instant]
+    ["." duration]]
+   ["." io]
+   [macro
+    ["s" syntax (#+ syntax:)]]])
+
+(type: #export (Operation s o)
+  (state.State' Error s o))
+
+(def: #export Monad<Operation>
+  (state.Monad<State'> error.Monad<Error>))
+
+(type: #export (Phase s i o)
+  (-> i (Operation s o)))
+
+(def: #export (run' state operation)
+  (All [s o]
+    (-> s (Operation s o) (Error [s o])))
+  (operation state))
+
+(def: #export (run state operation)
+  (All [s o]
+    (-> s (Operation s o) (Error o)))
+  (|> state
+      operation
+      (:: error.Monad<Error> map product.right)))
+
+(def: #export get-state
+  (All [s o]
+    (Operation s s))
+  (function (_ state)
+    (#error.Success [state state])))
+
+(def: #export (set-state state)
+  (All [s o]
+    (-> s (Operation s Any)))
+  (function (_ _)
+    (#error.Success [state []])))
+
+(def: #export (sub [get set] operation)
+  (All [s s' o]
+    (-> [(-> s s') (-> s' s s)]
+        (Operation s' o)
+        (Operation s o)))
+  (function (_ state)
+    (do error.Monad<Error>
+      [[state' output] (operation (get state))]
+      (wrap [(set state' state) output]))))
+
+(def: #export fail
+  (-> Text Operation)
+  (|>> error.fail (state.lift error.Monad<Error>)))
+
+(def: #export (throw exception parameters)
+  (All [e] (-> (Exception e) e Operation))
+  (state.lift error.Monad<Error>
+              (ex.throw exception parameters)))
+
+(def: #export (lift error)
+  (All [s a] (-> (Error a) (Operation s a)))
+  (function (_ state)
+    (error/map (|>> [state]) error)))
+
+(syntax: #export (assert exception message test)
+  (wrap (list (` (if (~ test)
+                   (:: ..Monad<Operation> (~' wrap) [])
+                   (..throw (~ exception) (~ message)))))))
+
+(def: #export (with-stack exception message action)
+  (All [e s o] (-> (Exception e) e (Operation s o) (Operation s o)))
+  (<<| (ex.with-stack exception message)
+       action))
+
+(def: #export identity
+  (All [s a] (Phase s a a))
+  (function (_ input state)
+    (#error.Success [state input])))
+
+(def: #export (compose pre post)
+  (All [s0 s1 i t o]
+    (-> (Phase s0 i t)
+        (Phase s1 t o)
+        (Phase [s0 s1] i o)))
+  (function (_ input [pre/state post/state])
+    (do error.Monad<Error>
+      [[pre/state' temp] (pre input pre/state)
+       [post/state' output] (post temp post/state)]
+      (wrap [[pre/state' post/state'] output]))))
+
+(def: #export (timed definition description operation)
+  (All [s a]
+    (-> Name Text (Operation s a) (Operation s a)))
+  (do Monad<Operation>
+    [_ (wrap [])
+     #let [pre (io.run instant.now)]
+     output operation
+     #let [_ (log! (|> instant.now
+                       io.run
+                       instant.relative
+                       (duration.difference (instant.relative pre))
+                       %duration
+                       (format (%name definition) " [" description "]: ")))]]
+    (wrap output)))