diff options
Diffstat (limited to 'stdlib/source/lux/target/jvm/instruction.lux')
-rw-r--r-- | stdlib/source/lux/target/jvm/instruction.lux | 66 |
1 files changed, 64 insertions, 2 deletions
diff --git a/stdlib/source/lux/target/jvm/instruction.lux b/stdlib/source/lux/target/jvm/instruction.lux index 25b10cc9e..628079110 100644 --- a/stdlib/source/lux/target/jvm/instruction.lux +++ b/stdlib/source/lux/target/jvm/instruction.lux @@ -2,7 +2,7 @@ [lux #* [abstract [monoid (#+ Monoid)] - [monad (#+ Monad do)]] + ["." monad (#+ Monad do)]] [control ["." state (#+ State)] ["." writer (#+ Writer)] @@ -10,6 +10,8 @@ ["." try (#+ Try)] ["." exception (#+ exception:)]] [data + ["." product] + ["." maybe] [text ["%" format (#+ format)]] [number @@ -28,7 +30,7 @@ [encoding ["#." name (#+ External)] ["#." unsigned (#+ U1 U2)] - ["#." signed]] + ["#." signed (#+ S4)]] ["#." constant (#+ UTF8) ["#/."pool (#+ Pool)]]]]) @@ -440,6 +442,66 @@ [jsr /bytecode.jsr /bytecode.jsr-w] ) +(def: (big-jump jump) + (-> (Either Jump Big-Jump) Big-Jump) + (case jump + (#.Left small) + (/jump.lift small) + + (#.Right big) + big)) + +(exception: #export invalid-tableswitch) + +(def: #export (tableswitch minimum default cases) + (-> S4 Label (List Label) (Instruction Any)) + (function (_ [pool tracker]) + (let [@from (get@ #program-counter tracker)] + [[pool tracker] + [(function (_ resolver) + (let [get (: (-> Label (Maybe Address)) + (function (_ label) + (dictionary.get label resolver)))] + (case (do maybe.monad + [@default (get default) + @cases (monad.map @ get cases) + #let [>default (big-jump (jump @from @default)) + >cases (list@map (|>> (jump @from) big-jump) + @cases)]] + (wrap (/bytecode.tableswitch minimum >default >cases))) + (#.Some bytecode) + (#try.Success bytecode) + + #.None + (exception.throw ..invalid-tableswitch [])))) + []]]))) + +(exception: #export invalid-lookupswitch) + +(def: #export (lookupswitch default cases) + (-> Label (List [S4 Label]) (Instruction Any)) + (function (_ [pool tracker]) + (let [@from (get@ #program-counter tracker)] + [[pool tracker] + [(function (_ resolver) + (let [get (: (-> Label (Maybe Address)) + (function (_ label) + (dictionary.get label resolver)))] + (case (do maybe.monad + [@default (get default) + @cases (monad.map @ (|>> product.right get) cases) + #let [>default (big-jump (jump @from @default)) + >cases (|> @cases + (list@map (|>> (jump @from) big-jump)) + (list.zip2 (list@map product.left cases)))]] + (wrap (/bytecode.lookupswitch >default >cases))) + (#.Some bytecode) + (#try.Success bytecode) + + #.None + (exception.throw ..invalid-lookupswitch [])))) + []]]))) + (template [<name> <bytecode>] [(def: #export (<name> class) (-> External (Instruction Any)) |