Tests for JVM bytecode machinery. [Part 5]

4 files changed, 75 insertions, 24 deletions

diff --git a/stdlib/source/lux/target/jvm/bytecode.lux b/stdlib/source/lux/target/jvm/bytecode.lux
index 7db2d8e4b..32e29b82f 100644
--- a/stdlib/source/lux/target/jvm/bytecode.lux
+++ b/stdlib/source/lux/target/jvm/bytecode.lux
@@ -141,11 +141,11 @@
   (All [e] (-> (exception.Exception e) e Bytecode))
   (..fail (exception.construct exception value)))
 
-(def: #export (resolve bytecode)
-  (All [a] (-> (Bytecode a) (Resource [Environment (Row Exception) Instruction a])))
+(def: #export (resolve environment bytecode)
+  (All [a] (-> Environment (Bytecode a) (Resource [Environment (Row Exception) Instruction a])))
   (function (_ pool)
     (do try.monad
-      [[[pool environment tracker] [relative output]] (bytecode [pool /environment.start ..fresh])
+      [[[pool environment tracker] [relative output]] (bytecode [pool environment ..fresh])
        [exceptions instruction] (relative (get@ #known tracker))]
       (wrap [pool [environment exceptions instruction output]]))))
 
diff --git a/stdlib/source/lux/target/jvm/bytecode/environment.lux b/stdlib/source/lux/target/jvm/bytecode/environment.lux
index 70db71c47..51927b96e 100644
--- a/stdlib/source/lux/target/jvm/bytecode/environment.lux
+++ b/stdlib/source/lux/target/jvm/bytecode/environment.lux
@@ -1,5 +1,5 @@
 (.module:
-  [lux #*
+  [lux (#- Type static)
    [abstract
     [monad (#+ do)]
     [monoid (#+ Monoid)]]
@@ -11,16 +11,25 @@
     ["/." registry (#+ Registry)]]
    [///
     [encoding
-     [unsigned (#+ U2)]]]])
+     [unsigned (#+ U2)]]
+    [type (#+ Type)
+     [category (#+ Method)]]]])
 
 (type: #export Environment
   {#limit Limit
    #stack Stack})
 
-(def: #export start
-  Environment
-  {#limit /limit.start
-   #stack /stack.empty})
+(template [<name> <limit>]
+  [(def: #export (<name> type)
+     (-> (Type Method) (Try Environment))
+     (do try.monad
+       [limit (<limit> type)]
+       (wrap {#limit limit
+              #stack /stack.empty})))]
+
+  [static /limit.static]
+  [virtual /limit.virtual]
+  )
 
 (type: #export Condition
   (-> Environment (Try Environment)))
diff --git a/stdlib/source/lux/target/jvm/bytecode/environment/limit.lux b/stdlib/source/lux/target/jvm/bytecode/environment/limit.lux
index 2e2312fb5..1bbb40e15 100644
--- a/stdlib/source/lux/target/jvm/bytecode/environment/limit.lux
+++ b/stdlib/source/lux/target/jvm/bytecode/environment/limit.lux
@@ -1,7 +1,10 @@
 (.module:
-  [lux #*
+  [lux (#- Type static)
    [abstract
+    [monad (#+ do)]
     ["." equivalence (#+ Equivalence)]]
+   [control
+    ["." try (#+ Try)]]
    [data
     [number
      ["n" nat]]
@@ -9,16 +12,26 @@
      ["#" binary (#+ Writer) ("#@." monoid)]]]]
   ["." / #_
    ["#." stack (#+ Stack)]
-   ["#." registry (#+ Registry)]])
+   ["#." registry (#+ Registry)]
+   [////
+    [type (#+ Type)
+     [category (#+ Method)]]]])
 
 (type: #export Limit
   {#stack Stack
    #registry Registry})
 
-(def: #export start
-  Limit
-  {#stack /stack.empty
-   #registry /registry.empty})
+(template [<name> <registry>]
+  [(def: #export (<name> type)
+     (-> (Type Method) (Try Limit))
+     (do try.monad
+       [registry (<registry> type)]
+       (wrap {#stack /stack.empty
+              #registry registry})))]
+
+  [static /registry.static]
+  [virtual /registry.virtual]
+  )
 
 (def: #export length
   ($_ n.+
diff --git a/stdlib/source/lux/target/jvm/bytecode/environment/limit/registry.lux b/stdlib/source/lux/target/jvm/bytecode/environment/limit/registry.lux
index eb3820bfb..3a8bd4482 100644
--- a/stdlib/source/lux/target/jvm/bytecode/environment/limit/registry.lux
+++ b/stdlib/source/lux/target/jvm/bytecode/environment/limit/registry.lux
@@ -1,20 +1,30 @@
 (.module:
-  [lux (#- for)
+  [lux (#- Type for static)
    [abstract
     ["." equivalence (#+ Equivalence)]]
    [control
-    ["." try]]
+    ["." try (#+ Try) ("#@." functor)]]
    [data
+    [number
+     ["n" nat]]
     [format
-     [binary (#+ Writer)]]]
+     [binary (#+ Writer)]]
+    [collection
+     ["." list ("#@." functor fold)]]]
    [type
     abstract]]
   ["." ///// #_
    [encoding
-    ["#." unsigned (#+ U1 U2)]]])
+    ["#." unsigned (#+ U1 U2)]]
+   ["#." type (#+ Type)
+    [category (#+ Method)]
+    ["#/." parser]]])
 
 (type: #export Register U1)
 
+(def: normal 1)
+(def: wide 2)
+
 (abstract: #export Registry
   {}
   
@@ -24,9 +34,28 @@
     (-> U2 Registry)
     (|>> :abstraction))
 
-  (def: #export empty
-    Registry
-    (|> 0 /////unsigned.u2 try.assume :abstraction))
+  (def: (minimal type)
+    (-> (Type Method) Nat)
+    (let [[inputs output exceptions] (/////type/parser.method type)]
+      (|> inputs
+          (list@map (function (_ input)
+                      (if (or (is? /////type.long input)
+                              (is? /////type.double input))
+                        ..wide
+                        ..normal)))
+          (list@fold n.+ 0))))
+
+  (template [<start> <name>]
+    [(def: #export <name>
+       (-> (Type Method) (Try Registry))
+       (|>> ..minimal
+            (n.+ <start>)
+            /////unsigned.u2
+            (try@map ..registry)))]
+
+    [0 static]
+    [1 virtual]
+    )
 
   (def: #export equivalence
     (Equivalence Registry)
@@ -53,8 +82,8 @@
               try.assume
               :abstraction)))]
 
-    [for 1]
-    [for-wide 2]
+    [for ..normal]
+    [for-wide ..wide]
     )
   )