1 files changed, 110 insertions, 0 deletions
diff --git a/stdlib/source/library/lux/meta/compiler/target/jvm/bytecode/environment.lux b/stdlib/source/library/lux/meta/compiler/target/jvm/bytecode/environment.lux
new file mode 100644
index 000000000..9fd4d7250
--- /dev/null
+++ b/stdlib/source/library/lux/meta/compiler/target/jvm/bytecode/environment.lux
@@ -0,0 +1,110 @@
+(.require
+ [library
+  [lux (.except Type static has)
+   [abstract
+    [monad (.only do)]
+    [monoid (.only Monoid)]]
+   [control
+    ["[0]" try (.only Try)]
+    ["[0]" exception (.only Exception)]]]]
+ [/
+  ["/[0]" limit (.only Limit)
+   ["/[0]" stack (.only Stack)]
+   ["/[0]" registry (.only Registry)]]
+  [///
+   [encoding
+    [unsigned (.only U2)]]
+   [type (.only Type)
+    [category (.only Method)]]]])
+
+(type .public Environment
+  (Record
+   [#limit Limit
+    #stack (Maybe Stack)]))
+
+(with_template [<name> <limit>]
+  [(def .public (<name> type)
+     (-> (Type Method) (Try Environment))
+     (do try.monad
+       [limit (<limit> type)]
+       (in [#limit limit
+            #stack {.#Some /stack.empty}])))]
+
+  [static /limit.static]
+  [virtual /limit.virtual]
+  )
+
+(type .public Condition
+  (-> Environment (Try Environment)))
+
+(def .public monoid
+  (Monoid Condition)
+  (implementation
+   (def identity
+     (|>> {try.#Success}))
+
+   (def (composite left right)
+     (function (_ environment)
+       (do try.monad
+         [environment (left environment)]
+         (right environment))))))
+
+(exception.def .public discontinuity)
+
+(def .public (stack environment)
+  (-> Environment (Try Stack))
+  (when (the ..#stack environment)
+    {.#Some stack}
+    {try.#Success stack}
+
+    {.#None}
+    (exception.except ..discontinuity [])))
+
+(def .public discontinue
+  (-> Environment Environment)
+  (.has ..#stack {.#None}))
+
+(exception.def .public (mismatched_stacks [expected actual])
+  (Exception [Stack Stack])
+  (exception.report
+   (list ["Expected" (/stack.text expected)]
+         ["Actual" (/stack.text actual)])))
+
+(def .public (continue expected environment)
+  (-> Stack Environment (Try [Stack Environment]))
+  (when (the ..#stack environment)
+    {.#Some actual}
+    (if (of /stack.equivalence = expected actual)
+      {try.#Success [actual environment]}
+      (exception.except ..mismatched_stacks [expected actual]))
+
+    {.#None}
+    {try.#Success [expected (.has ..#stack {.#Some expected} environment)]}))
+
+(def .public (consumes amount)
+  (-> U2 Condition)
+  ... TODO: Revisit this definition once lenses/optics have been implemented,
+  ... since it can probably be simplified with them.
+  (function (_ environment)
+    (do try.monad
+      [previous (..stack environment)
+       current (/stack.pop amount previous)]
+      (in (.has ..#stack {.#Some current} environment)))))
+
+(def .public (produces amount)
+  (-> U2 Condition)
+  (function (_ environment)
+    (do try.monad
+      [previous (..stack environment)
+       current (/stack.push amount previous)
+       .let [limit (|> environment
+                       (the [..#limit /limit.#stack])
+                       (/stack.max current))]]
+      (in (|> environment
+              (.has ..#stack {.#Some current})
+              (.has [..#limit /limit.#stack] limit))))))
+
+(def .public (has registry)
+  (-> Registry Condition)
+  (|>> (revised [..#limit /limit.#registry] (/registry.has registry))
+       {try.#Success}))