aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source')
-rw-r--r--stdlib/source/lux/target/jvm/bytecode.lux26
-rw-r--r--stdlib/source/lux/tool/compiler/phase/generation/jvm/case.lux41
-rw-r--r--stdlib/source/lux/tool/compiler/phase/generation/jvm/extension/common.lux5
-rw-r--r--stdlib/source/lux/tool/compiler/phase/generation/jvm/function.lux32
-rw-r--r--stdlib/source/lux/tool/compiler/phase/generation/jvm/function/field/variable.lux14
-rw-r--r--stdlib/source/lux/tool/compiler/phase/generation/jvm/function/field/variable/foreign.lux12
-rw-r--r--stdlib/source/lux/tool/compiler/phase/generation/jvm/function/field/variable/partial.lux16
-rw-r--r--stdlib/source/lux/tool/compiler/phase/generation/jvm/function/method/apply.lux165
-rw-r--r--stdlib/source/lux/tool/compiler/phase/generation/jvm/function/method/implementation.lux20
-rw-r--r--stdlib/source/lux/tool/compiler/phase/generation/jvm/function/method/init.lux34
-rw-r--r--stdlib/source/lux/tool/compiler/phase/generation/jvm/function/method/new.lux34
-rw-r--r--stdlib/source/lux/tool/compiler/phase/generation/jvm/function/method/reset.lux20
-rw-r--r--stdlib/source/lux/tool/compiler/phase/generation/jvm/loop.lux8
-rw-r--r--stdlib/source/lux/tool/compiler/phase/generation/jvm/primitive.lux5
-rw-r--r--stdlib/source/lux/tool/compiler/phase/generation/jvm/reference.lux21
-rw-r--r--stdlib/source/lux/tool/compiler/phase/generation/jvm/runtime.lux421
-rw-r--r--stdlib/source/lux/tool/compiler/phase/generation/jvm/structure.lux14
-rw-r--r--stdlib/source/test/lux/target/jvm.lux12
18 files changed, 443 insertions, 457 deletions
diff --git a/stdlib/source/lux/target/jvm/bytecode.lux b/stdlib/source/lux/target/jvm/bytecode.lux
index 32e29b82f..34e887bc1 100644
--- a/stdlib/source/lux/target/jvm/bytecode.lux
+++ b/stdlib/source/lux/target/jvm/bytecode.lux
@@ -471,25 +471,27 @@
(exception.report
["ID" (%.nat id)]))
-(def: #export (register id)
+(def: (register id)
(-> Nat (Bytecode Register))
(case (//unsigned.u1 id)
(#try.Success register)
(:: ..monad wrap register)
(#try.Failure error)
- (..throw invalid-register [id])))
+ (..throw ..invalid-register [id])))
(template [<for> <size> <name> <general> <specials>]
[(def: #export (<name> local)
- (-> Register (Bytecode Any))
+ (-> Nat (Bytecode Any))
(with-expansions [<specials>' (template.splice <specials>)]
- (`` (case (//unsigned.value local)
+ (`` (case local
(~~ (template [<case> <instruction> <registry>]
[<case> (..bytecode $0 <size> <registry> <instruction> [])]
<specials>'))
- _ (..bytecode $0 <size> (<for> local) <general> [local])))))]
+ _ (do ..monad
+ [local (..register local)]
+ (..bytecode $0 <size> (<for> local) <general> [local]))))))]
[/registry.for $1 iload _.iload
[[0 _.iload-0 @0]
@@ -520,14 +522,16 @@
(template [<for> <size> <name> <general> <specials>]
[(def: #export (<name> local)
- (-> Register (Bytecode Any))
+ (-> Nat (Bytecode Any))
(with-expansions [<specials>' (template.splice <specials>)]
- (`` (case (//unsigned.value local)
+ (`` (case local
(~~ (template [<case> <instruction> <registry>]
[<case> (..bytecode <size> $0 <registry> <instruction> [])]
<specials>'))
- _ (..bytecode <size> $0 (<for> local) <general> [local])))))]
+ _ (do ..monad
+ [local (..register local)]
+ (..bytecode <size> $0 (<for> local) <general> [local]))))))]
[/registry.for $1 istore _.istore
[[0 _.istore-0 @0]
@@ -792,8 +796,10 @@
)
(def: #export (iinc register increase)
- (-> Register U1 (Bytecode Any))
- (..bytecode $0 $0 (/registry.for register) _.iinc [register increase]))
+ (-> Nat U1 (Bytecode Any))
+ (do ..monad
+ [register (..register register)]
+ (..bytecode $0 $0 (/registry.for register) _.iinc [register increase])))
(exception: #export (multiarray-cannot-be-zero-dimensional {class (Type Object)})
(exception.report ["Class" (..reflection class)]))
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/case.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/case.lux
index e583b36b7..cdb84ad6a 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/case.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/case.lux
@@ -1,5 +1,5 @@
(.module:
- [lux (#- Type if let case)
+ [lux (#- Type if let case int)
[abstract
["." monad (#+ do)]]
[control
@@ -10,12 +10,9 @@
["n" nat]]]
[target
[jvm
- ["." constant]
["_" bytecode (#+ Label Bytecode) ("#@." monad)]
["." type (#+ Type)
- [category (#+ Method)]]
- [encoding
- ["." unsigned]]]]]
+ [category (#+ Method)]]]]]
["." // #_
["#." type]
["#." runtime (#+ Operation Phase)]
@@ -43,17 +40,17 @@
_.pop2
(pop-alt (n.- 2 stack-depth)))))
-(def: ldc/integer
+(def: int
(-> (I64 Any) (Bytecode Any))
- (|>> .i64 i32.i32 constant.integer _.ldc/integer))
+ (|>> .i64 i32.i32 _.int))
-(def: ldc/long
+(def: long
(-> (I64 Any) (Bytecode Any))
- (|>> .int constant.long _.ldc/long))
+ (|>> .int _.long))
-(def: ldc/double
+(def: double
(-> Frac (Bytecode Any))
- (|>> constant.double _.ldc/double))
+ (|>> _.double))
(def: peek
(Bytecode Any)
@@ -76,7 +73,7 @@
(#synthesis.Bind register)
(operation@wrap ($_ _.compose
..peek
- (_.astore (unsigned.u1 register))))
+ (_.astore register)))
(^ (synthesis.path/bit value))
(operation@wrap (.let [jump (.if value _.ifeq _.ifne)]
@@ -89,7 +86,7 @@
(operation@wrap ($_ _.compose
..peek
(//value.unwrap type.long)
- (..ldc/long value)
+ (..long value)
_.lcmp
(_.ifne @else)))
@@ -97,14 +94,14 @@
(operation@wrap ($_ _.compose
..peek
(//value.unwrap type.double)
- (..ldc/double value)
+ (..double value)
_.dcmpl
(_.ifne @else)))
(^ (synthesis.path/text value))
(operation@wrap ($_ _.compose
..peek
- (_.ldc/string value)
+ (_.string value)
(_.invokevirtual //type.text ..equals-name ..equals-type)
(_.ifeq @else)))
@@ -125,7 +122,7 @@
($_ _.compose
..peek
(_.checkcast //type.variant)
- (..ldc/integer (<prepare> idx))
+ (..int (<prepare> idx))
<flag>
//runtime.case
_.dup
@@ -149,7 +146,7 @@
($_ _.compose
..peek
(_.checkcast //type.tuple)
- (..ldc/integer lefts)
+ (..int lefts)
optimized-projection
//runtime.push)))
@@ -157,7 +154,7 @@
(operation@wrap ($_ _.compose
..peek
(_.checkcast //type.tuple)
- (..ldc/integer lefts)
+ (..int lefts)
//runtime.right-projection
//runtime.push))
@@ -172,7 +169,7 @@
(_.checkcast //type.tuple)
_.iconst-0
_.aaload
- (_.astore (unsigned.u1 register))
+ (_.astore register)
thenG)))
## Extra optimization
@@ -185,9 +182,9 @@
(wrap ($_ _.compose
..peek
(_.checkcast //type.tuple)
- (..ldc/integer lefts)
+ (..int lefts)
<projection>
- (_.astore (unsigned.u1 register))
+ (_.astore register)
then!))))
([synthesis.member/left //runtime.left-projection]
[synthesis.member/right //runtime.right-projection])
@@ -252,7 +249,7 @@
bodyG (phase bodyS)]
(wrap ($_ _.compose
inputG
- (_.astore (unsigned.u1 register))
+ (_.astore register)
bodyG))))
(def: #export (case phase valueS path)
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/extension/common.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/extension/common.lux
index 1fba35532..d06a5167c 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/extension/common.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/extension/common.lux
@@ -19,7 +19,6 @@
[target
[jvm
["_" bytecode (#+ Label Bytecode) ("#@." monad)]
- ["." constant]
[encoding
["." signed (#+ S4)]]
["." type (#+ Type)
@@ -113,7 +112,7 @@
[branchG (phase branch)
@branch ///runtime.forge-label]
(wrap [(list@map (function (_ char)
- [(signed.s4 (.int char)) @branch])
+ [(try.assume (signed.s4 (.int char))) @branch])
chars)
($_ _.compose
(_.set-label @branch)
@@ -192,7 +191,7 @@
[(def: (<name> _)
(Nullary (Bytecode Any))
($_ _.compose
- (_.ldc/double (constant.double <const>))
+ (_.double <const>)
(///value.wrap type.double)))]
[f64::smallest (java/lang/Double::MIN_VALUE)]
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/function.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function.lux
index 35137a77b..c5b18f6b3 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/function.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function.lux
@@ -2,8 +2,6 @@
[lux (#- Type)
[abstract
["." monad (#+ do)]]
- [control
- [state (#+ State)]]
[data
[number
["." i32]
@@ -11,8 +9,8 @@
[collection
["." list ("#@." monoid functor)]
["." row]]
- [format
- [".F" binary]]]
+ ["." format #_
+ ["#" binary]]]
[target
[jvm
["." version]
@@ -25,7 +23,7 @@
[category (#+ Return' Value')]
["." reflection]]
["." constant
- [pool (#+ Pool)]]
+ [pool (#+ Resource)]]
[encoding
["." name (#+ External Internal)]
["." unsigned]]]]]
@@ -55,15 +53,15 @@
(def: #export (with @begin class environment arity body)
(-> Label External Environment Arity (Bytecode Any)
- (Operation [(List (State Pool Field))
- (List (State Pool Method))
+ (Operation [(List (Resource Field))
+ (List (Resource Method))
(Bytecode Any)]))
(let [classT (type.class class (list))
- fields (: (List (State Pool Field))
+ fields (: (List (Resource Field))
(list& /arity.constant
(list@compose (/foreign.variables environment)
(/partial.variables arity))))
- methods (: (List (State Pool Method))
+ methods (: (List (Resource Method))
(list& (/init.method classT environment arity)
(/reset.method classT environment arity)
(if (arity.multiary? arity)
@@ -98,16 +96,16 @@
(generation.with-anchor [@begin ..this-offset]
(generate bodyS)))
[fields methods instance] (..with @begin function-class environment arity bodyG)
+ class (phase.lift (class.class version.v6_0
+ ..modifier
+ (name.internal function-class)
+ (..internal /abstract.class) (list)
+ fields
+ methods
+ (row.row)))
_ (generation.save! true ["" function-class]
[function-class
- (<| (binaryF.run class.writer)
- (class.class version.v6_0
- ..modifier
- (name.internal function-class)
- (..internal /abstract.class) (list)
- fields
- methods
- (row.row)))])]
+ (format.run class.writer class)])]
(wrap instance)))
(def: #export (apply generate [abstractionS inputsS])
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/field/variable.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/field/variable.lux
index cbff8ea5e..30ed3a524 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/field/variable.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/field/variable.lux
@@ -1,7 +1,5 @@
(.module:
[lux (#- Type type)
- [control
- [state (#+ State)]]
[data
[collection
["." list ("#@." functor)]
@@ -10,11 +8,11 @@
[jvm
["." modifier (#+ Modifier) ("#@." monoid)]
["." field (#+ Field)]
- ["_" instruction (#+ Instruction)]
+ ["_" bytecode (#+ Bytecode)]
[type (#+ Type)
[category (#+ Value Class)]]
[constant
- [pool (#+ Pool)]]]]]
+ [pool (#+ Resource)]]]]]
["." //// #_
["#." type]
["#." reference]
@@ -24,14 +22,14 @@
(def: #export type ////type.value)
(def: #export (get class name)
- (-> (Type Class) Text (Instruction Any))
+ (-> (Type Class) Text (Bytecode Any))
($_ _.compose
////reference.this
(_.getfield class name ..type)
))
(def: #export (put naming class register value)
- (-> (-> Register Text) (Type Class) Register (Instruction Any) (Instruction Any))
+ (-> (-> Register Text) (Type Class) Register (Bytecode Any) (Bytecode Any))
($_ _.compose
////reference.this
value
@@ -45,11 +43,11 @@
))
(def: #export (variable name type)
- (-> Text (Type Value) (State Pool Field))
+ (-> Text (Type Value) (Resource Field))
(field.field ..modifier name type (row.row)))
(def: #export (variables naming amount)
- (-> (-> Register Text) Nat (List (State Pool Field)))
+ (-> (-> Register Text) Nat (List (Resource Field)))
(|> amount
list.indices
(list@map (function (_ register)
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/field/variable/foreign.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/field/variable/foreign.lux
index 0b4a2bc3d..8df5c304c 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/field/variable/foreign.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/field/variable/foreign.lux
@@ -1,17 +1,15 @@
(.module:
[lux (#- Type)
- [control
- [state (#+ State)]]
[data
[collection
["." list ("#@." functor)]
["." row]]]
[target
[jvm
- ["_" instruction (#+ Instruction)]
+ ["_" bytecode (#+ Bytecode)]
["." field (#+ Field)]
[constant
- [pool (#+ Pool)]]
+ [pool (#+ Resource)]]
[type (#+ Type)
[category (#+ Value Class)]]]]]
["." //
@@ -26,13 +24,13 @@
(list.repeat (list.size environment) //.type))
(def: #export (get class register)
- (-> (Type Class) Register (Instruction Any))
+ (-> (Type Class) Register (Bytecode Any))
(//.get class (/////reference.foreign-name register)))
(def: #export (put class register value)
- (-> (Type Class) Register (Instruction Any) (Instruction Any))
+ (-> (Type Class) Register (Bytecode Any) (Bytecode Any))
(//.put /////reference.foreign-name class register value))
(def: #export variables
- (-> Environment (List (State Pool Field)))
+ (-> Environment (List (Resource Field)))
(|>> list.size (//.variables /////reference.foreign-name)))
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/field/variable/partial.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/field/variable/partial.lux
index 39be26183..62bb75c23 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/field/variable/partial.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/field/variable/partial.lux
@@ -2,8 +2,6 @@
[lux (#- Type)
[abstract
["." monad]]
- [control
- [state (#+ State)]]
[data
[number
["n" nat]]
@@ -13,11 +11,11 @@
[target
[jvm
["." field (#+ Field)]
- ["_" instruction (#+ Label Instruction) ("#@." monad)]
+ ["_" bytecode (#+ Label Bytecode) ("#@." monad)]
[type (#+ Type)
[category (#+ Class)]]
[constant
- [pool (#+ Pool)]]]]]
+ [pool (#+ Resource)]]]]]
["." / #_
["#." count]
["/#" //
@@ -31,7 +29,7 @@
["." arity (#+ Arity)]]]]]])
(def: #export (initial amount)
- (-> Nat (Instruction Any))
+ (-> Nat (Bytecode Any))
($_ _.compose
(|> _.aconst-null
(list.repeat amount)
@@ -39,19 +37,19 @@
(_@wrap [])))
(def: #export (get class register)
- (-> (Type Class) Register (Instruction Any))
+ (-> (Type Class) Register (Bytecode Any))
(//.get class (/////reference.partial-name register)))
(def: #export (put class register value)
- (-> (Type Class) Register (Instruction Any) (Instruction Any))
+ (-> (Type Class) Register (Bytecode Any) (Bytecode Any))
(//.put /////reference.partial-name class register value))
(def: #export variables
- (-> Arity (List (State Pool Field)))
+ (-> Arity (List (Resource Field)))
(|>> (n.- ///arity.minimum) (//.variables /////reference.partial-name)))
(def: #export (new arity)
- (-> Arity (Instruction Any))
+ (-> Arity (Bytecode Any))
(if (arity.multiary? arity)
($_ _.compose
/count.initial
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/method/apply.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/method/apply.lux
index e25889a37..68e81845b 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/method/apply.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/method/apply.lux
@@ -3,7 +3,7 @@
[abstract
["." monad (#+ do)]]
[control
- [state (#+ State)]]
+ ["." try]]
[data
[number
["n" nat]
@@ -13,12 +13,11 @@
["." list ("#@." monoid functor)]]]
[target
[jvm
- ["_" instruction (#+ Label Instruction) ("#@." monad)]
+ ["_" bytecode (#+ Label Bytecode) ("#@." monad)]
["." method (#+ Method)]
- ["." constant
- [pool (#+ Pool)]]
+ [constant
+ [pool (#+ Resource)]]
[encoding
- ["." unsigned]
["." signed]]
["." type (#+ Type)
["." category (#+ Class)]]]]]
@@ -45,22 +44,22 @@
["." reference (#+ Register)]]]]])
(def: (increment by)
- (-> Nat (Instruction Any))
+ (-> Nat (Bytecode Any))
($_ _.compose
- (<| _.ldc/integer constant.integer i32.i32 .i64 by)
+ (<| _.int .i64 by)
_.iadd))
(def: (inputs offset amount)
- (-> Register Nat (Instruction Any))
+ (-> Register Nat (Bytecode Any))
($_ _.compose
(|> amount
list.indices
- (monad.map _.monad (|>> (n.+ offset) unsigned.u1 _.aload)))
+ (monad.map _.monad (|>> (n.+ offset) _.aload)))
(_@wrap [])
))
(def: (apply offset amount)
- (-> Register Nat (Instruction Any))
+ (-> Register Nat (Bytecode Any))
(let [arity (n.min amount ///arity.maximum)]
($_ _.compose
(_.checkcast ///abstract.class)
@@ -75,78 +74,86 @@
(def: this-offset 1)
(def: #export (method class environment function-arity @begin body apply-arity)
- (-> (Type Class) Environment Arity Label (Instruction Any) Arity (State Pool Method))
+ (-> (Type Class) Environment Arity Label (Bytecode Any) Arity (Resource Method))
(let [num-partials (dec function-arity)
over-extent (i.- (.int apply-arity)
- (.int function-arity))
- failure ($_ _.compose
- ////runtime.apply-failure
- _.aconst-null
- _.areturn)]
+ (.int function-arity))]
(method.method //.modifier ////runtime.apply::name
(////runtime.apply::type apply-arity)
(list)
- (do _.monad
- [@default _.new-label
- @labels (|> _.new-label
- (list.repeat num-partials)
- (monad.seq _.monad))
- #let [cases (|> (list@compose @labels (list @default))
- list.enumerate
- (list@map (function (_ [stage @case])
- (let [current-partials (|> (list.indices stage)
- (list@map (///partial.get class))
- (monad.seq _.monad))
- already-partial? (n.> 0 stage)
- exact-match? (i.= over-extent (.int stage))
- has-more-than-necessary? (i.> over-extent (.int stage))]
- (cond exact-match?
- ($_ _.compose
- (_.set-label @case)
- ////reference.this
- (if already-partial?
- (_.invokevirtual class //reset.name (//reset.type class))
- (_@wrap []))
- current-partials
- (inputs ..this-offset apply-arity)
- (_.invokevirtual class //implementation.name (//implementation.type function-arity))
- _.areturn)
-
- has-more-than-necessary?
- (let [inputs-to-completion (|> function-arity (n.- stage))
- inputs-left (|> apply-arity (n.- inputs-to-completion))]
- ($_ _.compose
- (_.set-label @case)
- ////reference.this
- (_.invokevirtual class //reset.name (//reset.type class))
- current-partials
- (inputs ..this-offset inputs-to-completion)
- (_.invokevirtual class //implementation.name (//implementation.type function-arity))
- (apply (n.+ ..this-offset inputs-to-completion) inputs-left)
- _.areturn))
+ (#.Some (case num-partials
+ 0 ($_ _.compose
+ ////reference.this
+ (..inputs ..this-offset apply-arity)
+ (_.invokevirtual class //implementation.name (//implementation.type function-arity))
+ _.areturn)
+ _ (do _.monad
+ [@default _.new-label
+ #let [failure ($_ _.compose
+ (_.set-label @default)
+ ////runtime.apply-failure
+ _.aconst-null
+ _.areturn)]
+ @labelsH _.new-label
+ @labelsT (|> _.new-label
+ (list.repeat (dec num-partials))
+ (monad.seq _.monad))
+ #let [cases (|> (#.Cons [@labelsH @labelsT])
+ list.enumerate
+ (list@map (function (_ [stage @case])
+ (let [current-partials (|> (list.indices stage)
+ (list@map (///partial.get class))
+ (monad.seq _.monad))
+ already-partial? (n.> 0 stage)
+ exact-match? (i.= over-extent (.int stage))
+ has-more-than-necessary? (i.> over-extent (.int stage))]
+ (cond exact-match?
+ ($_ _.compose
+ (_.set-label @case)
+ ////reference.this
+ (if already-partial?
+ (_.invokevirtual class //reset.name (//reset.type class))
+ (_@wrap []))
+ current-partials
+ (..inputs ..this-offset apply-arity)
+ (_.invokevirtual class //implementation.name (//implementation.type function-arity))
+ _.areturn)
+
+ has-more-than-necessary?
+ (let [inputs-to-completion (|> function-arity (n.- stage))
+ inputs-left (|> apply-arity (n.- inputs-to-completion))]
+ ($_ _.compose
+ (_.set-label @case)
+ ////reference.this
+ (_.invokevirtual class //reset.name (//reset.type class))
+ current-partials
+ (..inputs ..this-offset inputs-to-completion)
+ (_.invokevirtual class //implementation.name (//implementation.type function-arity))
+ (apply (n.+ ..this-offset inputs-to-completion) inputs-left)
+ _.areturn))
- ## (i.< over-extent (.int stage))
- (let [current-environment (|> (list.indices (list.size environment))
- (list@map (///foreign.get class))
- (monad.seq _.monad))
- missing-partials (|> _.aconst-null
- (list.repeat (|> num-partials (n.- apply-arity) (n.- stage)))
- (monad.seq _.monad))]
- ($_ _.compose
- (_.set-label @case)
- (_.new class)
- _.dup
- current-environment
- ///partial/count.value
- (..increment apply-arity)
- current-partials
- (inputs ..this-offset apply-arity)
- missing-partials
- (_.invokevirtual class //init.name (//init.type environment function-arity))
- _.areturn))))))
- (monad.seq _.monad))]]
- ($_ _.compose
- ///partial/count.value
- (_.tableswitch (signed.s4 +0) @default @labels)
- cases
- failure)))))
+ ## (i.< over-extent (.int stage))
+ (let [current-environment (|> (list.indices (list.size environment))
+ (list@map (///foreign.get class))
+ (monad.seq _.monad))
+ missing-partials (|> _.aconst-null
+ (list.repeat (|> num-partials (n.- apply-arity) (n.- stage)))
+ (monad.seq _.monad))]
+ ($_ _.compose
+ (_.set-label @case)
+ (_.new class)
+ _.dup
+ current-environment
+ ///partial/count.value
+ (..increment apply-arity)
+ current-partials
+ (..inputs ..this-offset apply-arity)
+ missing-partials
+ (_.invokevirtual class //init.name (//init.type environment function-arity))
+ _.areturn))))))
+ (monad.seq _.monad))]]
+ ($_ _.compose
+ ///partial/count.value
+ (_.tableswitch (try.assume (signed.s4 +0)) @default [@labelsH @labelsT])
+ ## cases
+ failure)))))))
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/method/implementation.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/method/implementation.lux
index f7a3edb93..a0e606194 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/method/implementation.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/method/implementation.lux
@@ -1,16 +1,14 @@
(.module:
[lux (#- Type type)
- [control
- [state (#+ State)]]
[data
[collection
["." list]]]
[target
[jvm
["." method (#+ Method)]
- ["_" instruction (#+ Label Instruction)]
+ ["_" bytecode (#+ Label Bytecode)]
[constant
- [pool (#+ Pool)]]
+ [pool (#+ Resource)]]
["." type (#+ Type)
["." category]]]]]
["." //
@@ -28,16 +26,16 @@
(list)]))
(def: #export (method' name arity @begin body)
- (-> Text Arity Label (Instruction Any) (State Pool Method))
+ (-> Text Arity Label (Bytecode Any) (Resource Method))
(method.method //.modifier name
(..type arity)
(list)
- ($_ _.compose
- (_.set-label @begin)
- body
- _.areturn
- )))
+ (#.Some ($_ _.compose
+ (_.set-label @begin)
+ body
+ _.areturn
+ ))))
(def: #export method
- (-> Arity Label (Instruction Any) (State Pool Method))
+ (-> Arity Label (Bytecode Any) (Resource Method))
(method' ..name))
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/method/init.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/method/init.lux
index 691c4df70..0a51d555d 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/method/init.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/method/init.lux
@@ -3,7 +3,7 @@
[abstract
["." monad]]
[control
- [state (#+ State)]]
+ ["." try]]
[data
[number
["n" nat]]
@@ -11,12 +11,12 @@
["." list ("#@." monoid functor)]]]
[target
[jvm
- ["_" instruction (#+ Instruction)]
+ ["_" bytecode (#+ Bytecode)]
["." method (#+ Method)]
[encoding
["." unsigned]]
[constant
- [pool (#+ Pool)]]
+ [pool (#+ Resource)]]
["." type (#+ Type)
["." category (#+ Class Value)]]]]]
["." //
@@ -52,28 +52,30 @@
type.void
(list)]))
+(def: no-partials (|> 0 unsigned.u1 try.assume _.bipush))
+
(def: #export (super environment-size arity)
- (-> Nat Arity (Instruction Any))
+ (-> Nat Arity (Bytecode Any))
(let [arity-register (inc environment-size)]
($_ _.compose
(if (arity.unary? arity)
- (_.bipush (unsigned.u1 0))
- (_.iload (unsigned.u1 arity-register)))
+ ..no-partials
+ (_.iload arity-register))
(_.invokespecial ///abstract.class ..name ///abstract.init))))
(def: (store-all amount put offset)
(-> Nat
- (-> Register (Instruction Any) (Instruction Any))
+ (-> Register (Bytecode Any) (Bytecode Any))
(-> Register Register)
- (Instruction Any))
+ (Bytecode Any))
(|> (list.indices amount)
(list@map (function (_ register)
(put register
- (_.aload (unsigned.u1 (offset register))))))
+ (_.aload (offset register)))))
(monad.seq _.monad)))
(def: #export (method class environment arity)
- (-> (Type Class) Environment Arity (State Pool Method))
+ (-> (Type Class) Environment Arity (Resource Method))
(let [environment-size (list.size environment)
offset-foreign (: (-> Register Register)
(n.+ 1))
@@ -84,9 +86,9 @@
(method.method //.modifier ..name
(..type environment arity)
(list)
- ($_ _.compose
- ////reference.this
- (..super environment-size arity)
- (store-all environment-size (///foreign.put class) offset-foreign)
- (store-all (dec arity) (///partial.put class) offset-partial)
- _.return))))
+ (#.Some ($_ _.compose
+ ////reference.this
+ (..super environment-size arity)
+ (store-all environment-size (///foreign.put class) offset-foreign)
+ (store-all (dec arity) (///partial.put class) offset-partial)
+ _.return)))))
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/method/new.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/method/new.lux
index 241ec2676..ac1347c2d 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/method/new.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/method/new.lux
@@ -2,8 +2,6 @@
[lux (#- Type type)
[abstract
["." monad (#+ do)]]
- [control
- [state (#+ State)]]
[data
[number
["n" nat]]
@@ -14,11 +12,9 @@
["." modifier (#+ Modifier) ("#@." monoid)]
["." field (#+ Field)]
["." method (#+ Method)]
- ["_" instruction (#+ Instruction)]
+ ["_" bytecode (#+ Bytecode)]
["." constant
- [pool (#+ Pool)]]
- [encoding
- ["." unsigned]]
+ [pool (#+ Resource)]]
[type (#+ Type)
["." category (#+ Class Value Return)]]]]]
["." //
@@ -41,7 +37,7 @@
["." phase]]]]])
(def: #export (instance' foreign-setup class environment arity)
- (-> (List (Instruction Any)) (Type Class) Environment Arity (Instruction Any))
+ (-> (List (Bytecode Any)) (Type Class) Environment Arity (Bytecode Any))
($_ _.compose
(_.new class)
_.dup
@@ -50,13 +46,13 @@
(_.invokespecial class //init.name (//init.type environment arity))))
(def: #export (instance class environment arity)
- (-> (Type Class) Environment Arity (Operation (Instruction Any)))
+ (-> (Type Class) Environment Arity (Operation (Bytecode Any)))
(do phase.monad
[foreign* (monad.map @ ////reference.variable environment)]
(wrap (instance' foreign* class environment arity))))
(def: #export (method class environment arity)
- (-> (Type Class) Environment Arity (State Pool Method))
+ (-> (Type Class) Environment Arity (Resource Method))
(let [after-this (: (-> Nat Nat)
(n.+ 1))
environment-size (list.size environment)
@@ -67,13 +63,13 @@
(method.method //.modifier //init.name
(//init.type environment arity)
(list)
- ($_ _.compose
- ////reference.this
- (//init.super environment-size arity)
- (monad.map _.monad (function (_ register)
- (///foreign.put class register (_.aload (unsigned.u1 (after-this register)))))
- (list.indices environment-size))
- (monad.map _.monad (function (_ register)
- (///partial.put class register (_.aload (unsigned.u1 (after-arity register)))))
- (list.indices (n.- ///arity.minimum arity)))
- _.areturn))))
+ (#.Some ($_ _.compose
+ ////reference.this
+ (//init.super environment-size arity)
+ (monad.map _.monad (function (_ register)
+ (///foreign.put class register (_.aload (after-this register))))
+ (list.indices environment-size))
+ (monad.map _.monad (function (_ register)
+ (///partial.put class register (_.aload (after-arity register))))
+ (list.indices (n.- ///arity.minimum arity)))
+ _.areturn)))))
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/method/reset.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/method/reset.lux
index 2eab6933b..c196208bc 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/method/reset.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/method/reset.lux
@@ -1,16 +1,14 @@
(.module:
[lux (#- Type type)
- [control
- [state (#+ State)]]
[data
[collection
["." list ("#@." functor)]]]
[target
[jvm
["." method (#+ Method)]
- ["_" instruction (#+ Instruction)]
+ ["_" bytecode (#+ Bytecode)]
[constant
- [pool (#+ Pool)]]
+ [pool (#+ Resource)]]
["." type (#+ Type)
["." category (#+ Class)]]]]]
["." //
@@ -32,18 +30,18 @@
(type.method [(list) class (list)]))
(def: (current-environment class)
- (-> (Type Class) Environment (List (Instruction Any)))
+ (-> (Type Class) Environment (List (Bytecode Any)))
(|>> list.size
list.indices
(list@map (///foreign.get class))))
(def: #export (method class environment arity)
- (-> (Type Class) Environment Arity (State Pool Method))
+ (-> (Type Class) Environment Arity (Resource Method))
(method.method //.modifier ..name
(..type class)
(list)
- ($_ _.compose
- (if (arity.multiary? arity)
- (//new.instance' (..current-environment class environment) class environment arity)
- ////reference.this)
- _.areturn)))
+ (#.Some ($_ _.compose
+ (if (arity.multiary? arity)
+ (//new.instance' (..current-environment class environment) class environment arity)
+ ////reference.this)
+ _.areturn))))
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/loop.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/loop.lux
index 371b900a7..f27dbc269 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/loop.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/loop.lux
@@ -12,9 +12,7 @@
["." list ("#@." functor)]]]
[target
[jvm
- ["_" bytecode (#+ Label Bytecode) ("#@." monad)]
- [encoding
- ["." unsigned]]]]]
+ ["_" bytecode (#+ Label Bytecode) ("#@." monad)]]]]
["." // #_
["#." runtime (#+ Operation Phase)]
["#." value]
@@ -50,7 +48,7 @@
..no-op])
(do @
[fetchG (translate updateS)
- #let [storeG (_.astore (unsigned.u1 register))]]
+ #let [storeG (_.astore register)]]
(wrap [fetchG storeG]))))))]
(wrap ($_ _.compose
## It may look weird that first I fetch all the values separately,
@@ -81,7 +79,7 @@
(list@map (function (_ [index initG])
($_ _.compose
initG
- (_.astore (unsigned.u1 (n.+ offset index))))))
+ (_.astore (n.+ offset index)))))
(monad.seq _.monad))]]
(wrap ($_ _.compose
initializationG
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/primitive.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/primitive.lux
index 946ea34d5..f49c3b517 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/primitive.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/primitive.lux
@@ -4,7 +4,6 @@
[monad (#+ do)]]
[target
[jvm
- ["." constant]
["_" bytecode (#+ Bytecode)]
["." type]]]
[macro
@@ -27,8 +26,8 @@
[_ (`` (|> value (~~ (template.splice <ldc>))))]
(_.invokestatic <class> "valueOf" (type.method [(list <inputD>) <class> (list)]))))]
- [i64 (I64 Any) [.int constant.long _.ldc/long] $Long type.long]
- [f64 Frac [constant.double _.ldc/double] $Double type.double]
+ [i64 (I64 Any) [.int _.long] $Long type.long]
+ [f64 Frac [_.double] $Double type.double]
)
(def: #export text _.string)
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/reference.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/reference.lux
index a5c4c3156..13f6bb846 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/reference.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/reference.lux
@@ -5,11 +5,6 @@
[data
[text
["%" format (#+ format)]]]
- [tool
- [compiler
- ["." reference (#+ Register Variable)]
- ["." phase ("operation@." monad)
- ["." generation]]]]
[target
[jvm
["_" bytecode (#+ Bytecode)]
@@ -19,11 +14,11 @@
["." // #_
[runtime (#+ Operation)]
["#." value]
- ["#." type]])
-
-(def: local
- (-> Register (Bytecode Any))
- (|>> unsigned.u1 _.aload))
+ ["#." type]
+ ["//#" /// ("operation@." monad)
+ ["." generation]
+ [//
+ ["." reference (#+ Register Variable)]]]])
(def: #export this
(Bytecode Any)
@@ -40,7 +35,7 @@
(def: (foreign variable)
(-> Register (Operation (Bytecode Any)))
- (do phase.monad
+ (do ////.monad
[function-class generation.context]
(wrap ($_ _.compose
..this
@@ -52,13 +47,13 @@
(-> Variable (Operation (Bytecode Any)))
(case variable
(#reference.Local variable)
- (operation@wrap (..local variable))
+ (operation@wrap (_.aload variable))
(#reference.Foreign variable)
(..foreign variable)))
(def: #export (constant name)
(-> Name (Operation (Bytecode Any)))
- (do phase.monad
+ (do ////.monad
[bytecode-name (generation.remember name)]
(wrap (_.getstatic (type.class bytecode-name (list)) //value.field //type.value))))
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/runtime.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/runtime.lux
index 384193d99..c8076cada 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/runtime.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/runtime.lux
@@ -26,7 +26,6 @@
["." constant
[pool (#+ Resource)]]
[encoding
- ["." unsigned]
["." name]]
["." type (#+ Type)
["." category (#+ Return' Value')]
@@ -82,10 +81,6 @@
method.strict
))
-(def: local
- (-> Nat (Bytecode Any))
- (|>> unsigned.u1 try.assume _.aload))
-
(def: this
(Bytecode Any)
_.aload-0)
@@ -126,12 +121,12 @@
(method.method ..modifier ..variant::name
..variant::type
(list)
- ($_ _.compose
- new-variant
- (..set! ..variant-tag $tag)
- (..set! ..variant-last? $last?)
- (..set! ..variant-value $value)
- _.areturn))))
+ (#.Some ($_ _.compose
+ new-variant
+ (..set! ..variant-tag $tag)
+ (..set! ..variant-last? $last?)
+ (..set! ..variant-value $value)
+ _.areturn)))))
(def: #export left-flag _.aconst-null)
(def: #export right-flag ..unit)
@@ -189,11 +184,12 @@
(method.method ..modifier ..variant::name
..variant::type
(list)
- (..risky
- ($_ _.compose
- ..this
- (_.invokestatic //type.frac "parseDouble" (type.method [(list //type.text) type.double (list)]))
- (//value.wrap type.double)))))
+ (#.Some
+ (..risky
+ ($_ _.compose
+ ..this
+ (_.invokestatic //type.frac "parseDouble" (type.method [(list //type.text) type.double (list)]))
+ (//value.wrap type.double))))))
(def: #export log!
(Bytecode Any)
@@ -224,9 +220,10 @@
(method.method ..modifier name
..failure::type
(list)
- ($_ _.compose
- (..illegal-state-exception message)
- _.athrow)))
+ (#.Some
+ ($_ _.compose
+ (..illegal-state-exception message)
+ _.athrow))))
(def: apply-failure::name "apply_failure")
(def: #export apply-failure (..procedure ..apply-failure::name ..failure::type))
@@ -251,16 +248,17 @@
(method.method ..modifier ..push::name
..push::type
(list)
- (let [new-stack-frame! ($_ _.compose
- _.iconst-2
- (_.anewarray //type.value))
- $head _.aload-1
- $tail _.aload-0]
- ($_ _.compose
- new-stack-frame!
- (..set! ..stack-head $head)
- (..set! ..stack-tail $tail)
- _.areturn))))
+ (#.Some
+ (let [new-stack-frame! ($_ _.compose
+ _.iconst-2
+ (_.anewarray //type.value))
+ $head _.aload-1
+ $tail _.aload-0]
+ ($_ _.compose
+ new-stack-frame!
+ (..set! ..stack-head $head)
+ (..set! ..stack-tail $tail)
+ _.areturn)))))
(def: case::name "case")
(def: case::type (type.method [(list //type.variant //type.tag //type.flag) //type.value (list)]))
@@ -269,79 +267,80 @@
(def: case::method
(method.method ..modifier ..case::name ..case::type
(list)
- (do _.monad
- [@loop _.new-label
- @perfect-match! _.new-label
- @tags-match! _.new-label
- @maybe-nested _.new-label
- @maybe-super-nested _.new-label
- @mismatch! _.new-label
- #let [::tag ($_ _.compose
- (..get ..variant-tag)
- (//value.unwrap type.int))
- ::last? (..get ..variant-last?)
- ::value (..get ..variant-value)
-
- $variant _.aload-0
- $tag _.iload-1
- $last? _.aload-2
-
- not-found _.aconst-null
-
- update-$tag ($_ _.compose
- _.isub
- _.istore-1)
- update-$variant ($_ _.compose
- $variant ::value
- (_.checkcast //type.variant)
- _.astore-0)
- recur (: (-> Label (Bytecode Any))
- (function (_ @loop-start)
- ($_ _.compose
- update-$tag
- update-$variant
- (_.goto @loop-start))))
-
- super-nested-tag ($_ _.compose
- $variant ::tag
- $tag _.isub)
- super-nested ($_ _.compose
- super-nested-tag
- $variant ::last?
- $variant ::value
- ..variant)]]
- ($_ _.compose
- (_.set-label @loop)
- $tag
- $variant ::tag
- _.dup2 (_.if-icmpeq @tags-match!)
- _.dup2 (_.if-icmpgt @maybe-nested)
- _.dup2 (_.if-icmplt @maybe-super-nested)
- ## _.pop2
- not-found
- _.areturn
- (_.set-label @tags-match!) ## tag, sumT
- $last? ## tag, sumT, wants-last?
- $variant ::last? ## tag, sumT, wants-last?, is-last?
- (_.if-acmpeq @perfect-match!) ## tag, sumT
- (_.set-label @maybe-nested) ## tag, sumT
- $variant ::last? ## tag, sumT, last?
- (_.ifnull @mismatch!) ## tag, sumT
- (recur @loop)
- (_.set-label @perfect-match!) ## tag, sumT
- ## _.pop2
- $variant ::value
- _.areturn
- (_.set-label @maybe-super-nested) ## tag, sumT
- $last? (_.ifnull @mismatch!)
- ## _.pop2
- super-nested
- _.areturn
- (_.set-label @mismatch!) ## tag, sumT
- ## _.pop2
- not-found
- _.areturn
- ))))
+ (#.Some
+ (do _.monad
+ [@loop _.new-label
+ @perfect-match! _.new-label
+ @tags-match! _.new-label
+ @maybe-nested _.new-label
+ @maybe-super-nested _.new-label
+ @mismatch! _.new-label
+ #let [::tag ($_ _.compose
+ (..get ..variant-tag)
+ (//value.unwrap type.int))
+ ::last? (..get ..variant-last?)
+ ::value (..get ..variant-value)
+
+ $variant _.aload-0
+ $tag _.iload-1
+ $last? _.aload-2
+
+ not-found _.aconst-null
+
+ update-$tag ($_ _.compose
+ _.isub
+ _.istore-1)
+ update-$variant ($_ _.compose
+ $variant ::value
+ (_.checkcast //type.variant)
+ _.astore-0)
+ recur (: (-> Label (Bytecode Any))
+ (function (_ @loop-start)
+ ($_ _.compose
+ update-$tag
+ update-$variant
+ (_.goto @loop-start))))
+
+ super-nested-tag ($_ _.compose
+ $variant ::tag
+ $tag _.isub)
+ super-nested ($_ _.compose
+ super-nested-tag
+ $variant ::last?
+ $variant ::value
+ ..variant)]]
+ ($_ _.compose
+ (_.set-label @loop)
+ $tag
+ $variant ::tag
+ _.dup2 (_.if-icmpeq @tags-match!)
+ _.dup2 (_.if-icmpgt @maybe-nested)
+ _.dup2 (_.if-icmplt @maybe-super-nested)
+ ## _.pop2
+ not-found
+ _.areturn
+ (_.set-label @tags-match!) ## tag, sumT
+ $last? ## tag, sumT, wants-last?
+ $variant ::last? ## tag, sumT, wants-last?, is-last?
+ (_.if-acmpeq @perfect-match!) ## tag, sumT
+ (_.set-label @maybe-nested) ## tag, sumT
+ $variant ::last? ## tag, sumT, last?
+ (_.ifnull @mismatch!) ## tag, sumT
+ (recur @loop)
+ (_.set-label @perfect-match!) ## tag, sumT
+ ## _.pop2
+ $variant ::value
+ _.areturn
+ (_.set-label @maybe-super-nested) ## tag, sumT
+ $last? (_.ifnull @mismatch!)
+ ## _.pop2
+ super-nested
+ _.areturn
+ (_.set-label @mismatch!) ## tag, sumT
+ ## _.pop2
+ not-found
+ _.areturn
+ )))))
(def: projection-type (type.method [(list //type.tuple //type.offset) //type.value (list)]))
@@ -378,53 +377,55 @@
left-projection::method
(method.method ..modifier ..left-projection::name ..projection-type
(list)
- (do _.monad
- [@loop _.new-label
- @recursive _.new-label
- #let [::left ($_ _.compose
- $lefts _.aaload)]]
- ($_ _.compose
- (_.set-label @loop)
- $lefts $last-right (_.if-icmpge @recursive)
- $tuple ::left
- _.areturn
- (_.set-label @recursive)
- ## Recursive
- (recur @loop))))
+ (#.Some
+ (do _.monad
+ [@loop _.new-label
+ @recursive _.new-label
+ #let [::left ($_ _.compose
+ $lefts _.aaload)]]
+ ($_ _.compose
+ (_.set-label @loop)
+ $lefts $last-right (_.if-icmpge @recursive)
+ $tuple ::left
+ _.areturn
+ (_.set-label @recursive)
+ ## Recursive
+ (recur @loop)))))
right-projection::method
(method.method ..modifier ..right-projection::name ..projection-type
(list)
- (do _.monad
- [@loop _.new-label
- @not-tail _.new-label
- @slice _.new-label
- #let [$right ($_ _.compose
- $lefts
- _.iconst-1
- _.iadd)
- $::nested ($_ _.compose
- $tuple _.swap _.aaload)
- super-nested ($_ _.compose
- $tuple
- $right
- $tuple::size
- (_.invokestatic (type.class "java.util.Arrays" (list)) "copyOfRange"
- (type.method [(list //type.tuple //type.index //type.index) //type.tuple (list)])))]]
- ($_ _.compose
- (_.set-label @loop)
- $last-right $right
- _.dup2 (_.if-icmpne @not-tail)
- ## _.pop
- $::nested
- _.areturn
- (_.set-label @not-tail)
- (_.if-icmpgt @slice)
- ## Must recurse
- (recur @loop)
- (_.set-label @slice)
- super-nested
- _.areturn)))]
+ (#.Some
+ (do _.monad
+ [@loop _.new-label
+ @not-tail _.new-label
+ @slice _.new-label
+ #let [$right ($_ _.compose
+ $lefts
+ _.iconst-1
+ _.iadd)
+ $::nested ($_ _.compose
+ $tuple _.swap _.aaload)
+ super-nested ($_ _.compose
+ $tuple
+ $right
+ $tuple::size
+ (_.invokestatic (type.class "java.util.Arrays" (list)) "copyOfRange"
+ (type.method [(list //type.tuple //type.index //type.index) //type.tuple (list)])))]]
+ ($_ _.compose
+ (_.set-label @loop)
+ $last-right $right
+ _.dup2 (_.if-icmpne @not-tail)
+ ## _.pop
+ $::nested
+ _.areturn
+ (_.set-label @not-tail)
+ (_.if-icmpgt @slice)
+ ## Must recurse
+ (recur @loop)
+ (_.set-label @slice)
+ super-nested
+ _.areturn))))]
[left-projection::method
right-projection::method]))
@@ -447,53 +448,55 @@
(def: try::method
(method.method ..modifier ..try::name ..try::type
(list)
- (do _.monad
- [@from _.new-label
- @to _.new-label
- @handler _.new-label
- #let [$unsafe ..this
- unit _.aconst-null
-
- ^StringWriter (type.class "java.io.StringWriter" (list))
- string-writer ($_ _.compose
- (_.new ^StringWriter)
- _.dup
- (_.invokespecial ^StringWriter "<init>" (type.method [(list) type.void (list)])))
-
- ^PrintWriter (type.class "java.io.PrintWriter" (list))
- print-writer ($_ _.compose
- ## WTW
- (_.new ^PrintWriter) ## WTWP
- _.dup-x1 ## WTPWP
- _.swap ## WTPPW
- ..true ## WTPPWZ
- (_.invokespecial ^PrintWriter "<init>" (type.method [(list (type.class "java.io.Writer" (list)) type.boolean) type.void (list)]))
- ## WTP
- )]]
- ($_ _.compose
- (_.try @from @to @handler //type.error)
- (_.set-label @from)
- $unsafe unit ..apply
- ..right-injection _.areturn
- (_.set-label @to)
- (_.set-label @handler) ## T
- string-writer ## TW
- _.dup-x1 ## WTW
- print-writer ## WTP
- (_.invokevirtual //type.error "printStackTrace" (type.method [(list ^PrintWriter) type.void (list)])) ## W
- (_.invokevirtual ^StringWriter "toString" (type.method [(list) //type.text (list)])) ## S
- ..left-injection _.areturn
- ))))
+ (#.Some
+ (do _.monad
+ [@from _.new-label
+ @to _.new-label
+ @handler _.new-label
+ #let [$unsafe ..this
+ unit _.aconst-null
+
+ ^StringWriter (type.class "java.io.StringWriter" (list))
+ string-writer ($_ _.compose
+ (_.new ^StringWriter)
+ _.dup
+ (_.invokespecial ^StringWriter "<init>" (type.method [(list) type.void (list)])))
+
+ ^PrintWriter (type.class "java.io.PrintWriter" (list))
+ print-writer ($_ _.compose
+ ## WTW
+ (_.new ^PrintWriter) ## WTWP
+ _.dup-x1 ## WTPWP
+ _.swap ## WTPPW
+ ..true ## WTPPWZ
+ (_.invokespecial ^PrintWriter "<init>" (type.method [(list (type.class "java.io.Writer" (list)) type.boolean) type.void (list)]))
+ ## WTP
+ )]]
+ ($_ _.compose
+ (_.try @from @to @handler //type.error)
+ (_.set-label @from)
+ $unsafe unit ..apply
+ ..right-injection _.areturn
+ (_.set-label @to)
+ (_.set-label @handler) ## T
+ string-writer ## TW
+ _.dup-x1 ## WTW
+ print-writer ## WTP
+ (_.invokevirtual //type.error "printStackTrace" (type.method [(list ^PrintWriter) type.void (list)])) ## W
+ (_.invokevirtual ^StringWriter "toString" (type.method [(list) //type.text (list)])) ## S
+ ..left-injection _.areturn
+ )))))
(def: reflection
(All [category]
(-> (Type (<| Return' Value' category)) Text))
(|>> type.reflection reflection.reflection))
+(def: ^Object (type.class "java.lang.Object" (list)))
+
(def: translate-runtime
(Operation Any)
- (let [^Object (type.class "java.lang.Object" (list))
- class (..reflection ..class)
+ (let [class (..reflection ..class)
modifier (: (Modifier Class)
($_ modifier@compose
class.public
@@ -517,7 +520,8 @@
left-projection::method
right-projection::method
- ..try::method))
+ ..try::method
+ ))
(row.row)))]
(do ////.monad
[_ (///.execute! class [class bytecode])]
@@ -530,35 +534,38 @@
(list@map (function (_ arity)
(method.method method.public ..apply::name (..apply::type arity)
(list)
- (let [previous-inputs (|> arity
- list.indices
- (monad.map _.monad ..local))]
- ($_ _.compose
- previous-inputs
- (_.invokevirtual //function.class ..apply::name (..apply::type (dec arity)))
- (_.checkcast //function.class)
- (..local arity)
- (_.invokevirtual //function.class ..apply::name (..apply::type //function/arity.minimum))
- _.areturn)))))
+ (#.Some
+ (let [previous-inputs (|> arity
+ list.indices
+ (monad.map _.monad _.aload))]
+ ($_ _.compose
+ previous-inputs
+ (_.invokevirtual //function.class ..apply::name (..apply::type (dec arity)))
+ (_.checkcast //function.class)
+ (_.aload arity)
+ (_.invokevirtual //function.class ..apply::name (..apply::type //function/arity.minimum))
+ _.areturn))))))
(list& (method.method (modifier@compose method.public method.abstract)
..apply::name (..apply::type //function/arity.minimum)
(list)
## TODO: It shouldn't be necessary to set the code for this method, since it's abstract.
## Setting this might be a bug. Verify & fix ASAP.
- ($_ _.compose
- ..apply-failure
- ..this
- _.areturn))))
+ (#.Some
+ ($_ _.compose
+ ..apply-failure
+ ..this
+ _.areturn)))))
<init>::method (method.method method.public "<init>" //function.init
(list)
- (let [$partials _.iload-1]
- ($_ _.compose
- ..this
- (_.invokespecial ^Object "<init>" (type.method [(list) type.void (list)]))
- ..this
- $partials
- (_.putfield //function.class //function/count.field //function/count.type)
- _.return)))
+ (#.Some
+ (let [$partials _.iload-1]
+ ($_ _.compose
+ ..this
+ (_.invokespecial ^Object "<init>" (type.method [(list) type.void (list)]))
+ ..this
+ $partials
+ (_.putfield //function.class //function/count.field //function/count.type)
+ _.return))))
modifier (: (Modifier Class)
($_ modifier@compose
class.public
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/structure.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/structure.lux
index b48711dd0..0b5ebb5e7 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/structure.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/structure.lux
@@ -9,7 +9,6 @@
["." list]]]
[target
[jvm
- ["." constant]
["_" bytecode (#+ Bytecode)]
["." type]]]]
["." // #_
@@ -24,9 +23,6 @@
(def: unitG (Bytecode Any) (//primitive.text /////synthesis.unit))
-(template: (!integer <value>)
- (|> <value> .i64 i32.i32 constant.integer))
-
(def: #export (tuple generate membersS)
(Generator (Tuple Synthesis))
(case membersS
@@ -45,11 +41,11 @@
[memberI (generate member)]
(wrap (do _.monad
[_ _.dup
- _ (_.ldc/integer (!integer idx))
+ _ (_.int (.i64 idx))
_ memberI]
_.aastore))))))]
(wrap (do _.monad
- [_ (_.ldc/integer (!integer (list.size membersS)))
+ [_ (_.int (.i64 (list.size membersS)))
_ (_.anewarray $Object)]
(monad.seq @ membersI))))))
@@ -64,9 +60,9 @@
(do ////.monad
[valueI (generate valueS)]
(wrap (do _.monad
- [_ (_.ldc/integer (!integer (if right?
- (.inc lefts)
- lefts)))
+ [_ (_.int (.i64 (if right?
+ (.inc lefts)
+ lefts)))
_ (flagG right?)
_ valueI]
(_.invokestatic //runtime.class "variant"
diff --git a/stdlib/source/test/lux/target/jvm.lux b/stdlib/source/test/lux/target/jvm.lux
index 2617eeacf..7b2283cb8 100644
--- a/stdlib/source/test/lux/target/jvm.lux
+++ b/stdlib/source/test/lux/target/jvm.lux
@@ -53,10 +53,7 @@
["#." signed]
["#." unsigned]]
["#" bytecode (#+ Label Bytecode)
- ["#." instruction]
- [environment
- [limit
- [registry (#+ Register)]]]]
+ ["#." instruction]]
["#." type (#+ Type)
["." category (#+ Value Object Class)]]]})
@@ -993,13 +990,13 @@
*wrap)))))
store-and-load (: (All [a]
(-> (Random a) (-> a (Bytecode Any)) (Bytecode Any)
- [(-> Register (Bytecode Any)) (-> Register (Bytecode Any))]
+ [(-> Nat (Bytecode Any)) (-> Nat (Bytecode Any))]
(-> a (-> Any Bit))
(Random Bit)))
(function (_ random-value literal *wrap [store load] test)
(do random.monad
[expected random-value
- register (:: @ map (|>> (n.% 128) /unsigned.u1 try.assume) random.nat)]
+ register (:: @ map (n.% 128) random.nat)]
(<| (..bytecode (test expected))
(do /.monad
[_ (literal expected)
@@ -1033,8 +1030,7 @@
(do /.monad
[_ (..$Byte::literal base)
_ /.istore-0
- @0 (/.register 0)
- _ (/.iinc @0 increment)
+ _ (/.iinc 0 increment)
_ /.iload-0
_ /.i2l]
..$Long::wrap)))))))