From a952343569f321006d0183ef7ce250e3f8b996cb Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 8 Jul 2019 00:24:20 -0400 Subject: * Re-named "Instruction" to "Bytecode". * Re-named "Program" to "Instruction". --- stdlib/source/lux/target/jvm/attribute/code.lux | 2 +- .../lux/target/jvm/attribute/code/exception.lux | 2 +- .../source/lux/target/jvm/attribute/constant.lux | 4 +- stdlib/source/lux/target/jvm/instruction.lux | 523 +++++++++++++++++++++ .../source/lux/target/jvm/instruction/bytecode.lux | 490 +++++++++++++++++++ .../lux/target/jvm/instruction/condition.lux | 80 ++++ stdlib/source/lux/target/jvm/instruction/jump.lux | 17 + .../lux/target/jvm/instruction/resources.lux | 44 ++ stdlib/source/lux/target/jvm/method.lux | 14 +- stdlib/source/lux/target/jvm/program.lux | 523 --------------------- stdlib/source/lux/target/jvm/program/condition.lux | 80 ---- .../source/lux/target/jvm/program/instruction.lux | 490 ------------------- stdlib/source/lux/target/jvm/program/jump.lux | 17 - stdlib/source/lux/target/jvm/program/resources.lux | 44 -- .../compiler/phase/generation/jvm/primitive.lux | 6 +- .../tool/compiler/phase/generation/jvm/runtime.lux | 6 +- .../compiler/phase/generation/jvm/structure.lux | 6 +- stdlib/source/test/lux/target/jvm.lux | 17 +- 18 files changed, 1182 insertions(+), 1183 deletions(-) create mode 100644 stdlib/source/lux/target/jvm/instruction.lux create mode 100644 stdlib/source/lux/target/jvm/instruction/bytecode.lux create mode 100644 stdlib/source/lux/target/jvm/instruction/condition.lux create mode 100644 stdlib/source/lux/target/jvm/instruction/jump.lux create mode 100644 stdlib/source/lux/target/jvm/instruction/resources.lux delete mode 100644 stdlib/source/lux/target/jvm/program.lux delete mode 100644 stdlib/source/lux/target/jvm/program/condition.lux delete mode 100644 stdlib/source/lux/target/jvm/program/instruction.lux delete mode 100644 stdlib/source/lux/target/jvm/program/jump.lux delete mode 100644 stdlib/source/lux/target/jvm/program/resources.lux diff --git a/stdlib/source/lux/target/jvm/attribute/code.lux b/stdlib/source/lux/target/jvm/attribute/code.lux index 44b3b1b5b..61c19ccfa 100644 --- a/stdlib/source/lux/target/jvm/attribute/code.lux +++ b/stdlib/source/lux/target/jvm/attribute/code.lux @@ -10,7 +10,7 @@ [collection ["." row (#+ Row) ("#@." functor fold)]]]] ["." /// #_ - [program + [instruction ["#." resources (#+ Resources)]] [encoding ["#." unsigned (#+ U2)]]] diff --git a/stdlib/source/lux/target/jvm/attribute/code/exception.lux b/stdlib/source/lux/target/jvm/attribute/code/exception.lux index 003bad74f..b291baf3e 100644 --- a/stdlib/source/lux/target/jvm/attribute/code/exception.lux +++ b/stdlib/source/lux/target/jvm/attribute/code/exception.lux @@ -9,7 +9,7 @@ ["//#" /// #_ [constant (#+ Class)] ["#." index (#+ Index)] - [program + [instruction ["#." jump (#+ Jump)]] [encoding ["#." unsigned (#+ U2)]]]]) diff --git a/stdlib/source/lux/target/jvm/attribute/constant.lux b/stdlib/source/lux/target/jvm/attribute/constant.lux index 4dae93140..dd8c7c395 100644 --- a/stdlib/source/lux/target/jvm/attribute/constant.lux +++ b/stdlib/source/lux/target/jvm/attribute/constant.lux @@ -7,9 +7,9 @@ [binary (#+ Writer)]]]] ["." /// #_ [constant (#+ Value)] + ["#." index (#+ Index)] [encoding - ["#." unsigned (#+ U2 U4)]] - ["#." index (#+ Index)]]) + ["#." unsigned (#+ U2 U4)]]]) (type: #export Constant (Index (Value Any))) diff --git a/stdlib/source/lux/target/jvm/instruction.lux b/stdlib/source/lux/target/jvm/instruction.lux new file mode 100644 index 000000000..8ae42752f --- /dev/null +++ b/stdlib/source/lux/target/jvm/instruction.lux @@ -0,0 +1,523 @@ +(.module: + [lux #* + [abstract + [monoid (#+ Monoid)] + [monad (#+ Monad do)]] + [control + ["." state (#+ State)] + ["." writer (#+ Writer)] + ["." function] + ["." try (#+ Try)] + ["." exception (#+ exception:)]] + [data + [text + ["%" format (#+ format)]] + [number + ["." nat]] + [collection + ["." list ("#@." functor fold)] + ["." dictionary (#+ Dictionary)]]]] + ["." / #_ + ["#." condition (#+ Local)] + ["#." jump (#+ Jump Big-Jump)] + ["#." bytecode (#+ Primitive-Array-Type Bytecode) ("#@." monoid)] + ["/#" // #_ + ["#." index] + ["#." descriptor (#+ Descriptor Value Return Field)] + [encoding + ["#." name (#+ External)] + ["#." unsigned (#+ U1 U2)] + ["#." signed]] + ["#." constant (#+ UTF8) + ["#/."pool (#+ Pool)]]]]) + +(type: #export Label Nat) + +(type: #export Address Nat) + +(type: Resolver (Dictionary Label Address)) + +(type: Tracker + {#program-counter Address + #next-label Label + #known-labels Resolver}) + +(def: fresh + Tracker + {#program-counter 0 + #next-label 0 + #known-labels (dictionary.new nat.hash)}) + +(type: #export Partial + (-> Resolver (Try Bytecode))) + +(def: partial-identity + Partial + (function.constant (#try.Success /bytecode.nop))) + +(structure: partial-monoid + (Monoid Partial) + + (def: identity ..partial-identity) + + (def: (compose left right) + (cond (is? ..partial-identity left) + right + + (is? ..partial-identity right) + left + + ## else + (function (_ resolver) + (do try.monad + [left (left resolver) + right (right resolver)] + (wrap (/bytecode@compose left right))))))) + +(type: #export (Instruction a) + (State [Pool Tracker] (Writer Partial a))) + +(def: #export new-label + (Instruction Label) + (function (_ [pool tracker]) + [[pool + (update@ #next-label inc tracker)] + [..partial-identity + (get@ #next-label tracker)]])) + +(def: #export (set-label label) + (-> Label (Instruction Any)) + (function (_ [pool tracker]) + [[pool + (update@ #known-labels + (dictionary.put label (get@ #program-counter tracker)) + tracker)] + [..partial-identity + []]])) + +(def: #export monad + ## TODO: Remove the coercion. It was added because the type-checker + ## seems to have a bug that is being triggered here. + (:coerce (Monad Instruction) + (writer.with ..partial-monoid + (: (Monad (State [Pool Tracker])) + state.monad)))) + +(def: #export (resolve instruction) + (All [a] (-> (Instruction a) (State Pool (Try [Bytecode a])))) + (function (_ pool) + (let [[[pool tracker] [partial output]] (state.run [pool ..fresh] instruction)] + [pool (do try.monad + [bytecode (partial (get@ #known-labels tracker))] + (wrap [bytecode output]))]))) + +(def: (nullary bytecode) + (-> Bytecode (Instruction Any)) + (function (_ [pool tracker]) + [[pool tracker] + [(function.constant (#try.Success bytecode)) + []]])) + +(template [ ] + [(def: #export (nullary ))] + + [nop /bytecode.nop] + [aconst-null /bytecode.aconst-null] + + [iconst-m1 /bytecode.iconst-m1] + [iconst-0 /bytecode.iconst-0] + [iconst-1 /bytecode.iconst-1] + [iconst-2 /bytecode.iconst-2] + [iconst-3 /bytecode.iconst-3] + [iconst-4 /bytecode.iconst-4] + [iconst-5 /bytecode.iconst-5] + + [lconst-0 /bytecode.lconst-0] + [lconst-1 /bytecode.lconst-1] + + [fconst-0 /bytecode.fconst-0] + [fconst-1 /bytecode.fconst-1] + [fconst-2 /bytecode.fconst-2] + + [dconst-0 /bytecode.dconst-0] + [dconst-1 /bytecode.dconst-1] + + [pop /bytecode.pop] + [pop2 /bytecode.pop2] + + [dup /bytecode.dup] + [dup-x1 /bytecode.dup-x1] + [dup-x2 /bytecode.dup-x2] + [dup2 /bytecode.dup2] + [dup2-x1 /bytecode.dup2-x1] + [dup2-x2 /bytecode.dup2-x2] + + [swap /bytecode.swap] + + [istore-0 /bytecode.istore-0] + [istore-1 /bytecode.istore-1] + [istore-2 /bytecode.istore-2] + [istore-3 /bytecode.istore-3] + + [lstore-0 /bytecode.lstore-0] + [lstore-1 /bytecode.lstore-1] + [lstore-2 /bytecode.lstore-2] + [lstore-3 /bytecode.lstore-3] + + [fstore-0 /bytecode.fstore-0] + [fstore-1 /bytecode.fstore-1] + [fstore-2 /bytecode.fstore-2] + [fstore-3 /bytecode.fstore-3] + + [dstore-0 /bytecode.dstore-0] + [dstore-1 /bytecode.dstore-1] + [dstore-2 /bytecode.dstore-2] + [dstore-3 /bytecode.dstore-3] + + [astore-0 /bytecode.astore-0] + [astore-1 /bytecode.astore-1] + [astore-2 /bytecode.astore-2] + [astore-3 /bytecode.astore-3] + + [iaload /bytecode.iaload] + [laload /bytecode.laload] + [faload /bytecode.faload] + [daload /bytecode.daload] + [aaload /bytecode.aaload] + [baload /bytecode.baload] + [caload /bytecode.caload] + [saload /bytecode.saload] + + [iastore /bytecode.iastore] + [lastore /bytecode.lastore] + [fastore /bytecode.fastore] + [dastore /bytecode.dastore] + [aastore /bytecode.aastore] + [bastore /bytecode.bastore] + [castore /bytecode.castore] + [sastore /bytecode.sastore] + + [iadd /bytecode.iadd] + [isub /bytecode.isub] + [imul /bytecode.imul] + [idiv /bytecode.idiv] + [irem /bytecode.irem] + [ineg /bytecode.ineg] + [ishl /bytecode.ishl] + [ishr /bytecode.ishr] + [iushr /bytecode.iushr] + [iand /bytecode.iand] + [ior /bytecode.ior] + [ixor /bytecode.ixor] + + [ladd /bytecode.ladd] + [lsub /bytecode.lsub] + [lmul /bytecode.lmul] + [ldiv /bytecode.ldiv] + [lrem /bytecode.lrem] + [lneg /bytecode.lneg] + [land /bytecode.land] + [lor /bytecode.lor] + [lxor /bytecode.lxor] + + [fadd /bytecode.fadd] + [fsub /bytecode.fsub] + [fmul /bytecode.fmul] + [fdiv /bytecode.fdiv] + [frem /bytecode.frem] + [fneg /bytecode.fneg] + + [dadd /bytecode.dadd] + [dsub /bytecode.dsub] + [dmul /bytecode.dmul] + [ddiv /bytecode.ddiv] + [drem /bytecode.drem] + [dneg /bytecode.dneg] + + [lshl /bytecode.lshl] + [lshr /bytecode.lshr] + [lushr /bytecode.lushr] + + [l2i /bytecode.l2i] + [l2f /bytecode.l2f] + [l2d /bytecode.l2d] + + [f2i /bytecode.f2i] + [f2l /bytecode.f2l] + [f2d /bytecode.f2d] + + [d2i /bytecode.d2i] + [d2l /bytecode.d2l] + [d2f /bytecode.d2f] + + [i2l /bytecode.i2l] + [i2f /bytecode.i2f] + [i2d /bytecode.i2d] + [i2b /bytecode.i2b] + [i2c /bytecode.i2c] + [i2s /bytecode.i2s] + + [lcmp /bytecode.lcmp] + + [fcmpl /bytecode.fcmpl] + [fcmpg /bytecode.fcmpg] + + [dcmpl /bytecode.dcmpl] + [dcmpg /bytecode.dcmpg] + + [ireturn /bytecode.ireturn] + [lreturn /bytecode.lreturn] + [freturn /bytecode.freturn] + [dreturn /bytecode.dreturn] + [areturn /bytecode.areturn] + [return /bytecode.return] + + [arraylength /bytecode.arraylength] + + [athrow /bytecode.athrow] + + [monitorenter /bytecode.monitorenter] + [monitorexit /bytecode.monitorexit] + ) + +(def: #export (bipush byte) + (-> U1 (Instruction Any)) + (function (_ [pool tracker]) + [[pool tracker] + [(function.constant (#try.Success (/bytecode.bipush byte))) + []]])) + +(def: (lift on-pool) + (All [a] + (-> (State Pool a) + (Instruction a))) + (function (_ [pool tracker]) + (let [[pool' output] (state.run pool on-pool)] + [[pool' tracker] + [..partial-identity + output]]))) + +(def: max-u1 + (|> //unsigned.max-u1 //unsigned.nat //unsigned.u2)) + +(template [ ] + [(def: #export ( value) + (-> (Instruction Any)) + (do ..monad + [index (..lift ( value)) + #let [index' (//index.number index)]] + (..nullary (if (:: //unsigned.order < ..max-u1 index') + (/bytecode.ldc (|> index' //unsigned.nat //unsigned.u1)) + ( index)))))] + + [ldc/string //constant.UTF8 //constant/pool.string /bytecode.ldc-w/string] + ) + +(template [ ] + [(def: #export ( value) + (-> (Instruction Any)) + (do ..monad + [index (..lift ( value))] + (..nullary ( index))))] + + [ldc/integer //constant.Integer //constant/pool.integer /bytecode.ldc-w/integer] + [ldc/long //constant.Long //constant/pool.long /bytecode.ldc2-w/long] + [ldc/float //constant.Float //constant/pool.float /bytecode.ldc-w/float] + [ldc/double //constant.Double //constant/pool.double /bytecode.ldc2-w/double] + ) + +(template [ ] + [(def: #export + (-> (Instruction Any)) + (|>> nullary))] + + [iload /bytecode.iload Local] + [lload /bytecode.lload Local] + [fload /bytecode.fload Local] + [dload /bytecode.dload Local] + [aload /bytecode.aload Local] + + [istore /bytecode.istore Local] + [lstore /bytecode.lstore Local] + [fstore /bytecode.fstore Local] + [dstore /bytecode.dstore Local] + [astore /bytecode.astore Local] + + [ret /bytecode.ret Local] + + [newarray /bytecode.newarray Primitive-Array-Type] + + [sipush /bytecode.sipush U2] + ) + +(exception: #export (unknown-label {label Label}) + (exception.report + ["Label" (%.nat label)])) + +(exception: #export (cannot-do-a-big-jump {label Label} + {@from Address} + {jump Big-Jump}) + (exception.report + ["Label" (%.nat label)] + ["Start" (%.nat @from)] + ["Target" (|> jump //signed.int %.int)])) + +(def: (jump @from @to) + (-> Address Address (Either Jump Big-Jump)) + (let [jump (.int (n/- @to @from)) + big? (n/> (//unsigned.nat //unsigned.max-u2) + (.nat (i/* (if (i/>= +0 jump) + +1 + -1) + jump)))] + (if big? + (#.Right (//signed.s4 jump)) + (#.Left (//signed.s2 jump))))) + +(template [ ] + [(def: #export ( label) + (-> Label (Instruction Any)) + (function (_ [pool tracker]) + (let [@from (get@ #program-counter tracker)] + [[pool tracker] + [(function (_ resolver) + (case (dictionary.get label resolver) + (#.Some @to) + (case (jump @from @to) + (#.Left jump) + (#try.Success ( jump)) + + (#.Right jump) + (exception.throw ..cannot-do-a-big-jump [label @from jump])) + + #.None + (exception.throw ..unknown-label [label]))) + []]])))] + + [ifeq /bytecode.ifeq] + [ifne /bytecode.ifne] + [iflt /bytecode.iflt] + [ifge /bytecode.ifge] + [ifgt /bytecode.ifgt] + [ifle /bytecode.ifle] + + [if-icmpeq /bytecode.if-icmpeq] + [if-icmpne /bytecode.if-icmpne] + [if-icmplt /bytecode.if-icmplt] + [if-icmpge /bytecode.if-icmpge] + [if-icmpgt /bytecode.if-icmpgt] + [if-icmple /bytecode.if-icmple] + + [if-acmpeq /bytecode.if-acmpeq] + [if-acmpne /bytecode.if-acmpne] + + [ifnull /bytecode.ifnull] + [ifnonnull /bytecode.ifnonnull] + ) + +(template [ ] + [(def: #export ( label) + (-> Label (Instruction Any)) + (function (_ [pool tracker]) + (let [@from (get@ #program-counter tracker)] + [[pool tracker] + [(function (_ resolver) + (case (dictionary.get label resolver) + (#.Some @to) + (case (jump @from @to) + (#.Left jump) + (#try.Success ( jump)) + + (#.Right jump) + (#try.Success ( jump))) + + #.None + (exception.throw ..unknown-label [label]))) + []]])))] + + [goto /bytecode.goto /bytecode.goto-w] + [jsr /bytecode.jsr /bytecode.jsr-w] + ) + +(template [ ] + [(def: #export ( class) + (-> External (Instruction Any)) + (do ..monad + ## TODO: Make sure it"s impossible to have indexes greater than U2. + [index (..lift (//constant/pool.class (//name.internal class)))] + (..nullary ( index))))] + + [new /bytecode.new] + [anewarray /bytecode.anewarray] + [checkcast /bytecode.checkcast] + [instanceof /bytecode.instanceof] + ) + +(def: #export (iinc register increase) + (-> Local U1 (Instruction Any)) + (..nullary (/bytecode.iinc register increase))) + +(def: #export (multianewarray class count) + (-> External U1 (Instruction Any)) + (do ..monad + [index (..lift (//constant/pool.class (//name.internal class)))] + (..nullary (/bytecode.multianewarray index count)))) + +(def: (descriptor-size descriptor) + (-> (Descriptor (Return Any)) U1) + (//unsigned.u1 + (cond (is? //descriptor.void descriptor) + 0 + + (is? //descriptor.long descriptor) + 2 + + (is? //descriptor.double descriptor) + 2 + + ## else + 1))) + +(template [ ] + [(def: #export ( class method inputs output) + (-> External Text (List (Descriptor (Value Any))) (Descriptor (Return Any)) (Instruction Any)) + (do ..monad + [index (<| ..lift + (//constant/pool.method class) + {#//constant/pool.name method + #//constant/pool.descriptor (//descriptor.method inputs output)})] + (..nullary ( + index + (|> inputs + (list@map descriptor-size) + (list@fold //unsigned.u1/+ (//unsigned.u1 (if 0 1)))) + (descriptor-size output)))))] + + [#1 invokestatic /bytecode.invokestatic] + [#0 invokevirtual /bytecode.invokevirtual] + [#0 invokespecial /bytecode.invokespecial] + [#0 invokeinterface /bytecode.invokeinterface] + ) + +(template [ <1> <2>] + [(def: #export ( class field type) + (-> External Text (Descriptor Field) (Instruction Any)) + (do ..monad + [index (<| ..lift + (//constant/pool.field class) + {#//constant/pool.name field + #//constant/pool.descriptor type})] + (..nullary (cond (is? //descriptor.long type) + (<2> index) + + (is? //descriptor.double type) + (<2> index) + + ## else + (<1> index)))))] + + [getstatic /bytecode.getstatic/1 /bytecode.getstatic/2] + [putstatic /bytecode.putstatic/1 /bytecode.putstatic/2] + [getfield /bytecode.getfield/1 /bytecode.getfield/2] + [putfield /bytecode.putfield/1 /bytecode.putfield/2] + ) diff --git a/stdlib/source/lux/target/jvm/instruction/bytecode.lux b/stdlib/source/lux/target/jvm/instruction/bytecode.lux new file mode 100644 index 000000000..bef2628f6 --- /dev/null +++ b/stdlib/source/lux/target/jvm/instruction/bytecode.lux @@ -0,0 +1,490 @@ +(.module: + [lux (#- Code) + [abstract + [monad (#+ do)] + [monoid (#+ Monoid)]] + [control + ["." try (#+ Try)] + ["." exception (#+ exception:)]] + [data + [number (#+ hex)] + ["." binary] + [text + ["%" format (#+ format)]] + [format + [".F" binary (#+ Mutation Specification)]]] + [macro + ["." template]] + [type + abstract]] + ["." // #_ + ["#." resources (#+ Resources)] + ["/" condition (#+ Environment Condition Local) ("#@." monoid)] + ["#." jump (#+ Jump Big-Jump)] + ["/#" // #_ + ["#." index (#+ Index)] + ["#." descriptor (#+ Field Method)] + ["#." constant (#+ Class Reference)] + [encoding + ["#." unsigned (#+ U1 U2 U4)] + ["#." signed (#+ S2 S4)]]]]) + +(type: #export Size Nat) + +(type: #export Bytecode + [Size (-> [Environment Specification] (Try [Environment Specification]))]) + +(def: #export (run bytecode) + (-> Bytecode (Try [Environment Specification])) + (let [[_ bytecode'] bytecode] + (bytecode' [/.start binaryF.no-op]))) + +(def: (bytecode size condition transform) + (-> Size Condition (-> Specification Specification) Bytecode) + [size + (function (_ [environment specification]) + (do try.monad + [environment' (condition environment)] + (wrap [environment' + (transform specification)])))]) + +(type: Code Nat) + +(def: (nullary' code) + (-> Code Mutation) + (function (_ [offset binary]) + [(n/+ 1 offset) + (try.assume + (binary.write/8 offset code binary))])) + +(def: (nullary code [size mutation]) + (-> Code (-> Specification Specification)) + [(n/+ 1 size) + (|>> mutation ((nullary' code)))]) + +(template [ ] + [(with-expansions [ (template.identifier [ "'"])] + (def: ( code input0) + (-> Code Mutation) + (function (_ [offset binary]) + [(n/+ offset) + (try.assume + (do try.monad + [_ (binary.write/8 offset code binary)] + ( (n/+ 1 offset) ( input0) binary)))])) + + (def: ( code input0 [size mutation]) + (-> Code (-> Specification Specification)) + [(n/+ size) + (|>> mutation (( code input0)))]))] + + [2 unary/1 U1 binary.write/8 ///unsigned.nat] + [3 unary/2 U2 binary.write/16 ///unsigned.nat] + [3 jump/2 S2 binary.write/16 ///signed.int] + [5 jump/4 S4 binary.write/32 ///signed.int] + ) + +(def: (binary/11' code input0 input1) + (-> Code U1 U1 Mutation) + (function (_ [offset binary]) + [(n/+ 3 offset) + (try.assume + (do try.monad + [_ (binary.write/8 offset code binary) + _ (binary.write/8 (n/+ 1 offset) (///unsigned.nat input0) binary)] + (binary.write/8 (n/+ 2 offset) (///unsigned.nat input1) binary)))])) + +(def: (binary/11 code input0 input1 [size mutation]) + (-> Code U1 U1 (-> Specification Specification)) + [(n/+ 3 size) + (|>> mutation ((binary/11' code input0 input1)))]) + +(def: (binary/21' code input0 input1) + (-> Code U2 U1 Mutation) + (function (_ [offset binary]) + [(n/+ 4 offset) + (try.assume + (do try.monad + [_ (binary.write/8 offset code binary) + _ (binary.write/16 (n/+ 1 offset) (///unsigned.nat input0) binary)] + (binary.write/8 (n/+ 3 offset) (///unsigned.nat input1) binary)))])) + +(def: (binary/21 code input0 input1 [size mutation]) + (-> Code U2 U1 (-> Specification Specification)) + [(n/+ 4 size) + (|>> mutation ((binary/21' code input0 input1)))]) + +(def: (trinary/211' code input0 input1 input2) + (-> Code U2 U1 U1 Mutation) + (function (_ [offset binary]) + [(n/+ 5 offset) + (try.assume + (do try.monad + [_ (binary.write/8 offset code binary) + _ (binary.write/16 (n/+ 1 offset) (///unsigned.nat input0) binary) + _ (binary.write/8 (n/+ 3 offset) (///unsigned.nat input1) binary)] + (binary.write/8 (n/+ 4 offset) (///unsigned.nat input2) binary)))])) + +(def: (trinary/211 code input0 input1 input2 [size mutation]) + (-> Code U2 U1 U1 (-> Specification Specification)) + [(n/+ 5 size) + (|>> mutation ((trinary/211' code input0 input1 input2)))]) + +(abstract: #export Primitive-Array-Type + {} + + U1 + + (def: code + (-> Primitive-Array-Type U1) + (|>> :representation)) + + (template [ ] + [(def: #export (|> ///unsigned.u1 :abstraction))] + + [04 t-boolean] + [05 t-char] + [06 t-float] + [07 t-double] + [08 t-byte] + [09 t-short] + [10 t-int] + [11 t-long] + )) + +## https://docs.oracle.com/javase/specs/jvms/se8/html/jvms-6.html#jvms-6.5 +(with-expansions [ (template [ ] + [[ [] [] 0 []]] + + ["01" aconst-null 1] + + ["02" iconst-m1 1] + ["03" iconst-0 1] + ["04" iconst-1 1] + ["05" iconst-2 1] + ["06" iconst-3 1] + ["07" iconst-4 1] + ["08" iconst-5 1] + + ["09" lconst-0 2] + ["0A" lconst-1 2] + + ["0B" fconst-0 1] + ["0C" fconst-1 1] + ["0D" fconst-2 1] + + ["0E" dconst-0 2] + ["0F" dconst-1 2]) + (template [ ] + [[ [[local Local]] [local] 0 [[local]]]] + + ["15" iload 1] + ["16" lload 2] + ["17" fload 1] + ["18" dload 2] + ["19" aload 1]) + (template [ ] + [[ [] [] 0 [[(///unsigned.u1 )]]]] + + ["1A" iload-0 1 0] + ["1B" iload-1 1 1] + ["1C" iload-2 1 2] + ["1D" iload-3 1 3] + + ["1E" lload-0 2 1] + ["1F" lload-1 2 2] + ["20" lload-2 2 3] + ["21" lload-3 2 4] + + ["22" fload-0 1 0] + ["23" fload-1 1 1] + ["24" fload-2 1 2] + ["25" fload-3 1 3] + + ["26" dload-0 2 1] + ["27" dload-1 2 2] + ["28" dload-2 2 3] + ["29" dload-3 2 4] + + ["2A" aload-0 1 0] + ["2B" aload-1 1 1] + ["2C" aload-2 1 2] + ["2D" aload-3 1 3]) + (template [ ] + [[ [[local Local]] [local] 0 [[local]]]] + + ["36" istore 1] + ["37" lstore 2] + ["38" fstore 1] + ["39" dstore 2] + ["3A" astore 1]) + (template [ ] + [[ [] [] 0 [[(///unsigned.u1 )]]]] + + ["3B" istore-0 1 0] + ["3C" istore-1 1 1] + ["3D" istore-2 1 2] + ["3E" istore-3 1 3] + + ["3F" lstore-0 2 1] + ["40" lstore-1 2 2] + ["41" lstore-2 2 3] + ["42" lstore-3 2 4] + + ["43" fstore-0 1 0] + ["44" fstore-1 1 1] + ["45" fstore-2 1 2] + ["46" fstore-3 1 3] + + ["47" dstore-0 2 1] + ["48" dstore-1 2 2] + ["49" dstore-2 2 3] + ["4A" dstore-3 2 4] + + ["4B" astore-0 1 0] + ["4C" astore-1 1 1] + ["4D" astore-2 1 2] + ["4E" astore-3 1 3]) + (template [ ] + [[ [] [] 2 []]] + + ["2E" iaload 1] + ["2F" laload 2] + ["30" faload 1] + ["31" daload 2] + ["32" aaload 1] + ["33" baload 1] + ["34" caload 1] + ["35" saload 1]) + (template [ ] + [[ [] [] 0 []]] + + ["4f" iastore 3] + ["50" lastore 4] + ["51" fastore 3] + ["52" dastore 4] + ["53" aastore 3] + ["54" bastore 3] + ["55" castore 3] + ["56" sastore 3]) + (template [ ] + [[ [] [] []]] + + ["60" iadd 2 1] + ["64" isub 2 1] + ["68" imul 2 1] + ["6c" idiv 2 1] + ["70" irem 2 1] + ["74" ineg 1 1] + ["78" ishl 2 1] + ["7a" ishr 2 1] + ["7c" iushr 2 1] + ["7e" iand 2 1] + ["80" ior 2 1] + ["82" ixor 2 1] + + ["61" ladd 4 2] + ["65" lsub 4 2] + ["69" lmul 4 2] + ["6D" ldiv 4 2] + ["71" lrem 4 2] + ["75" lneg 2 2] + ["7F" land 4 2] + ["81" lor 4 2] + ["83" lxor 4 2] + + ["62" fadd 2 1] + ["66" fsub 2 1] + ["6A" fmul 2 1] + ["6E" fdiv 2 1] + ["72" frem 2 1] + ["76" fneg 1 1] + + ["63" dadd 4 2] + ["67" dsub 4 2] + ["6B" dmul 4 2] + ["6F" ddiv 4 2] + ["73" drem 4 2] + ["77" dneg 2 2]) + (template [ ] + [[ [] [] []]] + + ["88" l2i 2 1] + ["89" l2f 2 1] + ["8A" l2d 2 2] + + ["8B" f2i 1 1] + ["8C" f2l 1 2] + ["8D" f2d 1 2] + + ["8E" d2i 2 1] + ["8F" d2l 2 2] + ["90" d2f 2 1] + + ["85" i2l 1 2] + ["86" i2f 1 1] + ["87" i2d 1 2] + ["91" i2b 1 1] + ["92" i2c 1 1] + ["93" i2s 1 1]) + (template [ ] + [[ [] [] 1 []]] + + ["94" lcmp 4] + + ["95" fcmpl 2] + ["96" fcmpg 2] + + ["97" dcmpl 4] + ["98" dcmpg 4]) + (template [ ] + [[ [] [] 0 []]] + + ["AC" ireturn 1] + ["AD" lreturn 2] + ["AE" freturn 1] + ["AF" dreturn 2] + ["B0" areturn 1] + ["B1" return 0] + ) + (template [ ] + [[ [[jump Jump]] [jump] []]] + + ["99" ifeq 2 0] + ["9A" ifne 2 0] + ["9B" iflt 2 0] + ["9C" ifge 2 0] + ["9D" ifgt 2 0] + ["9E" ifle 2 0] + + ["9F" if-icmpeq 2 0] + ["A0" if-icmpne 2 0] + ["A1" if-icmplt 2 0] + ["A2" if-icmpge 2 0] + ["A3" if-icmpgt 2 0] + ["A4" if-icmple 2 0] + + ["A5" if-acmpeq 2 0] + ["A6" if-acmpne 2 0] + + ["A7" goto 0 0] + ["A8" jsr 0 1] + + ["C6" ifnull 1 0] + ["C7" ifnonnull 1 0]) + (template [ ] + [[ [[index (Index (Reference Field))]] [(///index.number index)] []]] + + ["B2" getstatic/1 0 1] ["B2" getstatic/2 0 2] + ["B3" putstatic/1 1 1] ["B3" putstatic/2 1 2] + ["B4" getfield/1 1 1] ["B4" getfield/2 1 2] + ["B5" putfield/1 2 1] ["B5" putfield/2 2 2])] + (template [ ] + [(with-expansions [' (template.splice )] + (template [ ] + [(with-expansions [' (template.splice ) + (template [ ] + [] + + ') + (template [ ] + [] + + ') + ' (template.splice )] + (def: #export ( ) + (-> Bytecode) + (..bytecode + + (`` ($_ /@compose + (/.consumes ) + (/.produces ) + (~~ (template [] + [(/.has-local )] + + ')))) + (`` ( (hex ) (~~ (template.splice )))))))] + + ' + ))] + + [..nullary 1 + [["00" nop [] [] 0 0 []] + + ["57" pop [] [] 1 0 []] + ["58" pop2 [] [] 2 0 []] + ["59" dup [] [] 1 2 []] + ["5A" dup-x1 [] [] 2 3 []] + ["5B" dup-x2 [] [] 3 4 []] + ["5C" dup2 [] [] 2 4 []] + ["5D" dup2-x1 [] [] 3 5 []] + ["5E" dup2-x2 [] [] 4 6 []] + ["5F" swap [] [] 2 2 []] + + + + + + ["79" lshl [] [] 3 2 []] + ["7B" lshr [] [] 3 2 []] + ["7D" lushr [] [] 3 2 []] + + + + ["BE" arraylength [] [] 1 1 []] + ["BF" athrow [] [] 1 0 []] + ["C2" monitorenter [] [] 1 0 []] + ["C3" monitorexit [] [] 1 0 []]]] + + [..unary/1 2 + [["10" bipush [[byte U1]] [byte] 0 1 []] + ["12" ldc [[index U1]] [index] 0 1 []] + + + ["A9" ret [[local Local]] [local] 0 0 [[local]]] + ["BC" newarray [[type Primitive-Array-Type]] [(..code type)] 1 1 []]]] + + [..unary/2 3 + [["11" sipush [[short U2]] [short] 0 1 []] + ["13" ldc-w/integer [[index (Index ///constant.Integer)]] [(///index.number index)] 0 1 []] + ["13" ldc-w/float [[index (Index ///constant.Float)]] [(///index.number index)] 0 1 []] + ["13" ldc-w/string [[index (Index ///constant.String)]] [(///index.number index)] 0 1 []] + ["14" ldc2-w/long [[index (Index ///constant.Long)]] [(///index.number index)] 0 2 []] + ["14" ldc2-w/double [[index (Index ///constant.Double)]] [(///index.number index)] 0 2 []] + + ["BB" new [[index (Index Class)]] [(///index.number index)] 0 1 []] + ["BD" anewarray [[index (Index Class)]] [(///index.number index)] 1 1 []] + ["C0" checkcast [[index (Index Class)]] [(///index.number index)] 1 1 []] + ["C1" instanceof [[index (Index Class)]] [(///index.number index)] 1 1 []] + ["B6" invokevirtual [[index (Index (Reference Method))] [count U1] [output-count U1]] [(///index.number index)] (///unsigned.nat count) (///unsigned.nat output-count) []] + ["B7" invokespecial [[index (Index (Reference Method))] [count U1] [output-count U1]] [(///index.number index)] (///unsigned.nat count) (///unsigned.nat output-count) []] + ["B8" invokestatic [[index (Index (Reference Method))] [count U1] [output-count U1]] [(///index.number index)] (///unsigned.nat count) (///unsigned.nat output-count) []]]] + + [..jump/2 3 + []] + + [..jump/4 5 + [["C8" goto-w [[jump Big-Jump]] [jump] 0 0 []] + ["C9" jsr-w [[jump Big-Jump]] [jump] 0 1 []]]] + + [..binary/11 3 + [["84" iinc [[local Local] [byte U1]] [local byte] 0 0 [[local]]]]] + + [..binary/21 4 + [["C5" multianewarray [[index (Index Class)] [count U1]] [(///index.number index) count] (///unsigned.nat count) 1 []]]] + + [..trinary/211 5 + [["B9" invokeinterface [[index (Index (Reference Method))] [count U1] [output-count U1]] [(///index.number index) count (///unsigned.u1 0)] (///unsigned.nat count) (///unsigned.nat output-count) []]]] + )) + +(structure: #export monoid + (Monoid Bytecode) + + (def: identity ..nop) + + (def: (compose [left-size left] [right-size right]) + [(n/+ left-size right-size) + (function (_ input) + (do try.monad + [temp (left input)] + (right temp)))])) diff --git a/stdlib/source/lux/target/jvm/instruction/condition.lux b/stdlib/source/lux/target/jvm/instruction/condition.lux new file mode 100644 index 000000000..04bb8c60b --- /dev/null +++ b/stdlib/source/lux/target/jvm/instruction/condition.lux @@ -0,0 +1,80 @@ +(.module: + [lux #* + [abstract + [monad (#+ do)] + [monoid (#+ Monoid)]] + [control + ["." try (#+ Try)] + ["." exception (#+ exception:)]] + [data + [number (#+ hex)] + ["." binary] + [text + ["%" format (#+ format)]] + [format + [".F" binary (#+ Mutation Specification)]]]] + ["." // #_ + ["#." resources (#+ Resources)] + ["/#" // #_ + [encoding + ["#." unsigned (#+ U1 U2)]]]]) + +(type: #export Environment + {#resources Resources + #stack U2}) + +(def: #export start + Environment + {#resources //resources.start + #stack (///unsigned.u2 0)}) + +(type: #export Condition + (-> Environment (Try Environment))) + +(structure: #export monoid + (Monoid Condition) + + (def: identity (|>> #try.Success)) + + (def: (compose left right) + (function (_ environment) + (do try.monad + [environment (left environment)] + (right environment))))) + +(def: #export (produces amount env) + (-> Nat Condition) + (let [stack (n/+ amount + (///unsigned.nat (get@ #stack env))) + max-stack (n/max stack + (///unsigned.nat (get@ [#resources #//resources.max-stack] env)))] + (|> env + (set@ #stack (///unsigned.u2 stack)) + (set@ [#resources #//resources.max-stack] (///unsigned.u2 max-stack)) + #try.Success))) + +(exception: #export (cannot-pop-stack {stack-size Nat} + {wanted-pops Nat}) + (exception.report + ["Stack Size" (%.nat stack-size)] + ["Wanted Pops" (%.nat wanted-pops)])) + +(def: #export (consumes wanted-pops env) + (-> Nat Condition) + (let [stack-size (///unsigned.nat (get@ #stack env))] + (if (n/<= stack-size wanted-pops) + (#try.Success (update@ #stack + (|>> ///unsigned.nat (n/- wanted-pops) ///unsigned.u2) + env)) + (exception.throw ..cannot-pop-stack [stack-size wanted-pops])))) + +(type: #export Local U1) + +(def: #export (has-local local environment) + (-> Local Condition) + (let [max-locals (n/max (///unsigned.nat (get@ [#resources #//resources.max-locals] environment)) + (///unsigned.nat local))] + (|> environment + (set@ [#resources #//resources.max-locals] + (///unsigned.u2 max-locals)) + #try.Success))) diff --git a/stdlib/source/lux/target/jvm/instruction/jump.lux b/stdlib/source/lux/target/jvm/instruction/jump.lux new file mode 100644 index 000000000..19f667cfe --- /dev/null +++ b/stdlib/source/lux/target/jvm/instruction/jump.lux @@ -0,0 +1,17 @@ +(.module: + [lux #* + [abstract + [equivalence (#+ Equivalence)]]] + ["." /// #_ + [encoding + ["#." signed (#+ S2 S4)]]]) + +(type: #export Jump S2) + +(def: #export equivalence + ///signed.equivalence) + +(def: #export writer + ///signed.s2-writer) + +(type: #export Big-Jump S4) diff --git a/stdlib/source/lux/target/jvm/instruction/resources.lux b/stdlib/source/lux/target/jvm/instruction/resources.lux new file mode 100644 index 000000000..fa83c4071 --- /dev/null +++ b/stdlib/source/lux/target/jvm/instruction/resources.lux @@ -0,0 +1,44 @@ +(.module: + [lux #* + [abstract + ["." equivalence (#+ Equivalence)]] + [data + [format + [".F" binary (#+ Writer) ("#@." monoid)]]]] + ["." /// #_ + [encoding + ["#." unsigned (#+ U2)]]]) + +(type: #export Resources + {#max-stack U2 + #max-locals U2}) + +(def: #export start + Resources + {#max-stack (///unsigned.u2 0) + #max-locals (///unsigned.u2 0)}) + +(def: #export length + ($_ n/+ + ## u2 max_stack; + ///unsigned.u2-bytes + ## u2 max_locals; + ///unsigned.u2-bytes)) + +(def: #export equivalence + (Equivalence Resources) + ($_ equivalence.product + ## u2 max_stack; + ///unsigned.equivalence + ## u2 max_locals; + ///unsigned.equivalence + )) + +(def: #export (writer resources) + (Writer Resources) + ($_ binaryF@compose + ## u2 max_stack; + (///unsigned.u2-writer (get@ #max-stack resources)) + ## u2 max_locals; + (///unsigned.u2-writer (get@ #max-locals resources)) + )) diff --git a/stdlib/source/lux/target/jvm/method.lux b/stdlib/source/lux/target/jvm/method.lux index 2b47be482..f3fcf3207 100644 --- a/stdlib/source/lux/target/jvm/method.lux +++ b/stdlib/source/lux/target/jvm/method.lux @@ -24,9 +24,9 @@ ["#/." code]] ["#." constant (#+ UTF8) ["#/." pool (#+ Pool)]] - ["#." program (#+ Program) + ["#." instruction (#+ Instruction) ["#/." condition] - ["#/." instruction]]]) + ["#/." bytecode]]]) (type: #export #rec Method {#modifier (Modifier Method) @@ -50,16 +50,16 @@ ) (def: #export (method modifier name descriptor attributes code) - (-> (Modifier Method) UTF8 (Descriptor //descriptor.Method) (List (State Pool Attribute)) (Program Any) + (-> (Modifier Method) UTF8 (Descriptor //descriptor.Method) (List (State Pool Attribute)) (Instruction Any) (State Pool Method)) (do state.monad [@name (//constant/pool.utf8 name) @descriptor (//constant/pool.descriptor descriptor) attributes (monad.seq @ attributes) - ?code (//program.resolve code) + ?code (//instruction.resolve code) [environment bytecode] (case (do try.monad - [[instruction output] ?code - [environment specification] (//program/instruction.run instruction)] + [[bytecode output] ?code + [environment specification] (//instruction/bytecode.run bytecode)] (wrap [environment (binaryF.instance specification)])) (#try.Success [environment bytecode]) (wrap [environment bytecode]) @@ -68,7 +68,7 @@ ## TODO: Allow error-management within ## the monad. (undefined)) - @code (//attribute.code {#//attribute/code.resources (get@ #//program/condition.resources environment) + @code (//attribute.code {#//attribute/code.resources (get@ #//instruction/condition.resources environment) #//attribute/code.code bytecode #//attribute/code.exception-table (row.row) #//attribute/code.attributes (row.row)})] diff --git a/stdlib/source/lux/target/jvm/program.lux b/stdlib/source/lux/target/jvm/program.lux deleted file mode 100644 index 13cd8ae5b..000000000 --- a/stdlib/source/lux/target/jvm/program.lux +++ /dev/null @@ -1,523 +0,0 @@ -(.module: - [lux #* - [abstract - [monoid (#+ Monoid)] - [monad (#+ Monad do)]] - [control - ["." state (#+ State)] - ["." writer (#+ Writer)] - ["." function] - ["." try (#+ Try)] - ["." exception (#+ exception:)]] - [data - [text - ["%" format (#+ format)]] - [number - ["." nat]] - [collection - ["." list ("#@." functor fold)] - ["." dictionary (#+ Dictionary)]]]] - ["." / #_ - ["#." condition (#+ Local)] - ["#." jump (#+ Jump Big-Jump)] - ["#." instruction (#+ Primitive-Array-Type Instruction) ("#@." monoid)] - ["/#" // #_ - ["#." index] - ["#." descriptor (#+ Descriptor Value Return Field)] - [encoding - ["#." name (#+ External)] - ["#." unsigned (#+ U1 U2)] - ["#." signed]] - ["#." constant (#+ UTF8) - ["#/."pool (#+ Pool)]]]]) - -(type: #export Label Nat) - -(type: #export Address Nat) - -(type: Resolver (Dictionary Label Address)) - -(type: Tracker - {#program-counter Address - #next-label Label - #known-labels Resolver}) - -(def: fresh - Tracker - {#program-counter 0 - #next-label 0 - #known-labels (dictionary.new nat.hash)}) - -(type: #export Partial - (-> Resolver (Try Instruction))) - -(def: partial-identity - Partial - (function.constant (#try.Success /instruction.nop))) - -(structure: partial-monoid - (Monoid Partial) - - (def: identity ..partial-identity) - - (def: (compose left right) - (cond (is? ..partial-identity left) - right - - (is? ..partial-identity right) - left - - ## else - (function (_ resolver) - (do try.monad - [left (left resolver) - right (right resolver)] - (wrap (/instruction@compose left right))))))) - -(type: #export (Program a) - (State [Pool Tracker] (Writer Partial a))) - -(def: #export new-label - (Program Label) - (function (_ [pool tracker]) - [[pool - (update@ #next-label inc tracker)] - [..partial-identity - (get@ #next-label tracker)]])) - -(def: #export (set-label label) - (-> Label (Program Any)) - (function (_ [pool tracker]) - [[pool - (update@ #known-labels - (dictionary.put label (get@ #program-counter tracker)) - tracker)] - [..partial-identity - []]])) - -(def: #export monad - ## TODO: Remove the coercion. It was added because the type-checker - ## seems to have a bug that is being triggered here. - (:coerce (Monad Program) - (writer.with ..partial-monoid - (: (Monad (State [Pool Tracker])) - state.monad)))) - -(def: #export (resolve program) - (All [a] (-> (Program a) (State Pool (Try [Instruction a])))) - (function (_ pool) - (let [[[pool tracker] [partial output]] (state.run [pool ..fresh] program)] - [pool (do try.monad - [instruction (partial (get@ #known-labels tracker))] - (wrap [instruction output]))]))) - -(def: (nullary instruction) - (-> Instruction (Program Any)) - (function (_ [pool tracker]) - [[pool tracker] - [(function.constant (#try.Success instruction)) - []]])) - -(template [ ] - [(def: #export (nullary ))] - - [nop /instruction.nop] - [aconst-null /instruction.aconst-null] - - [iconst-m1 /instruction.iconst-m1] - [iconst-0 /instruction.iconst-0] - [iconst-1 /instruction.iconst-1] - [iconst-2 /instruction.iconst-2] - [iconst-3 /instruction.iconst-3] - [iconst-4 /instruction.iconst-4] - [iconst-5 /instruction.iconst-5] - - [lconst-0 /instruction.lconst-0] - [lconst-1 /instruction.lconst-1] - - [fconst-0 /instruction.fconst-0] - [fconst-1 /instruction.fconst-1] - [fconst-2 /instruction.fconst-2] - - [dconst-0 /instruction.dconst-0] - [dconst-1 /instruction.dconst-1] - - [pop /instruction.pop] - [pop2 /instruction.pop2] - - [dup /instruction.dup] - [dup-x1 /instruction.dup-x1] - [dup-x2 /instruction.dup-x2] - [dup2 /instruction.dup2] - [dup2-x1 /instruction.dup2-x1] - [dup2-x2 /instruction.dup2-x2] - - [swap /instruction.swap] - - [istore-0 /instruction.istore-0] - [istore-1 /instruction.istore-1] - [istore-2 /instruction.istore-2] - [istore-3 /instruction.istore-3] - - [lstore-0 /instruction.lstore-0] - [lstore-1 /instruction.lstore-1] - [lstore-2 /instruction.lstore-2] - [lstore-3 /instruction.lstore-3] - - [fstore-0 /instruction.fstore-0] - [fstore-1 /instruction.fstore-1] - [fstore-2 /instruction.fstore-2] - [fstore-3 /instruction.fstore-3] - - [dstore-0 /instruction.dstore-0] - [dstore-1 /instruction.dstore-1] - [dstore-2 /instruction.dstore-2] - [dstore-3 /instruction.dstore-3] - - [astore-0 /instruction.astore-0] - [astore-1 /instruction.astore-1] - [astore-2 /instruction.astore-2] - [astore-3 /instruction.astore-3] - - [iaload /instruction.iaload] - [laload /instruction.laload] - [faload /instruction.faload] - [daload /instruction.daload] - [aaload /instruction.aaload] - [baload /instruction.baload] - [caload /instruction.caload] - [saload /instruction.saload] - - [iastore /instruction.iastore] - [lastore /instruction.lastore] - [fastore /instruction.fastore] - [dastore /instruction.dastore] - [aastore /instruction.aastore] - [bastore /instruction.bastore] - [castore /instruction.castore] - [sastore /instruction.sastore] - - [iadd /instruction.iadd] - [isub /instruction.isub] - [imul /instruction.imul] - [idiv /instruction.idiv] - [irem /instruction.irem] - [ineg /instruction.ineg] - [ishl /instruction.ishl] - [ishr /instruction.ishr] - [iushr /instruction.iushr] - [iand /instruction.iand] - [ior /instruction.ior] - [ixor /instruction.ixor] - - [ladd /instruction.ladd] - [lsub /instruction.lsub] - [lmul /instruction.lmul] - [ldiv /instruction.ldiv] - [lrem /instruction.lrem] - [lneg /instruction.lneg] - [land /instruction.land] - [lor /instruction.lor] - [lxor /instruction.lxor] - - [fadd /instruction.fadd] - [fsub /instruction.fsub] - [fmul /instruction.fmul] - [fdiv /instruction.fdiv] - [frem /instruction.frem] - [fneg /instruction.fneg] - - [dadd /instruction.dadd] - [dsub /instruction.dsub] - [dmul /instruction.dmul] - [ddiv /instruction.ddiv] - [drem /instruction.drem] - [dneg /instruction.dneg] - - [lshl /instruction.lshl] - [lshr /instruction.lshr] - [lushr /instruction.lushr] - - [l2i /instruction.l2i] - [l2f /instruction.l2f] - [l2d /instruction.l2d] - - [f2i /instruction.f2i] - [f2l /instruction.f2l] - [f2d /instruction.f2d] - - [d2i /instruction.d2i] - [d2l /instruction.d2l] - [d2f /instruction.d2f] - - [i2l /instruction.i2l] - [i2f /instruction.i2f] - [i2d /instruction.i2d] - [i2b /instruction.i2b] - [i2c /instruction.i2c] - [i2s /instruction.i2s] - - [lcmp /instruction.lcmp] - - [fcmpl /instruction.fcmpl] - [fcmpg /instruction.fcmpg] - - [dcmpl /instruction.dcmpl] - [dcmpg /instruction.dcmpg] - - [ireturn /instruction.ireturn] - [lreturn /instruction.lreturn] - [freturn /instruction.freturn] - [dreturn /instruction.dreturn] - [areturn /instruction.areturn] - [return /instruction.return] - - [arraylength /instruction.arraylength] - - [athrow /instruction.athrow] - - [monitorenter /instruction.monitorenter] - [monitorexit /instruction.monitorexit] - ) - -(def: #export (bipush byte) - (-> U1 (Program Any)) - (function (_ [pool tracker]) - [[pool tracker] - [(function.constant (#try.Success (/instruction.bipush byte))) - []]])) - -(def: (lift on-pool) - (All [a] - (-> (State Pool a) - (Program a))) - (function (_ [pool tracker]) - (let [[pool' output] (state.run pool on-pool)] - [[pool' tracker] - [..partial-identity - output]]))) - -(def: max-u1 - (|> //unsigned.max-u1 //unsigned.nat //unsigned.u2)) - -(template [ ] - [(def: #export ( value) - (-> (Program Any)) - (do ..monad - [index (..lift ( value)) - #let [index' (//index.number index)]] - (..nullary (if (:: //unsigned.order < ..max-u1 index') - (/instruction.ldc (|> index' //unsigned.nat //unsigned.u1)) - ( index)))))] - - [ldc/string //constant.UTF8 //constant/pool.string /instruction.ldc-w/string] - ) - -(template [ ] - [(def: #export ( value) - (-> (Program Any)) - (do ..monad - [index (..lift ( value))] - (..nullary ( index))))] - - [ldc/integer //constant.Integer //constant/pool.integer /instruction.ldc-w/integer] - [ldc/long //constant.Long //constant/pool.long /instruction.ldc2-w/long] - [ldc/float //constant.Float //constant/pool.float /instruction.ldc-w/float] - [ldc/double //constant.Double //constant/pool.double /instruction.ldc2-w/double] - ) - -(template [ ] - [(def: #export - (-> (Program Any)) - (|>> nullary))] - - [iload /instruction.iload Local] - [lload /instruction.lload Local] - [fload /instruction.fload Local] - [dload /instruction.dload Local] - [aload /instruction.aload Local] - - [istore /instruction.istore Local] - [lstore /instruction.lstore Local] - [fstore /instruction.fstore Local] - [dstore /instruction.dstore Local] - [astore /instruction.astore Local] - - [ret /instruction.ret Local] - - [newarray /instruction.newarray Primitive-Array-Type] - - [sipush /instruction.sipush U2] - ) - -(exception: #export (unknown-label {label Label}) - (exception.report - ["Label" (%.nat label)])) - -(exception: #export (cannot-do-a-big-jump {label Label} - {@from Address} - {jump Big-Jump}) - (exception.report - ["Label" (%.nat label)] - ["Start" (%.nat @from)] - ["Target" (|> jump //signed.int %.int)])) - -(def: (jump @from @to) - (-> Address Address (Either Jump Big-Jump)) - (let [jump (.int (n/- @to @from)) - big? (n/> (//unsigned.nat //unsigned.max-u2) - (.nat (i/* (if (i/>= +0 jump) - +1 - -1) - jump)))] - (if big? - (#.Right (//signed.s4 jump)) - (#.Left (//signed.s2 jump))))) - -(template [ ] - [(def: #export ( label) - (-> Label (Program Any)) - (function (_ [pool tracker]) - (let [@from (get@ #program-counter tracker)] - [[pool tracker] - [(function (_ resolver) - (case (dictionary.get label resolver) - (#.Some @to) - (case (jump @from @to) - (#.Left jump) - (#try.Success ( jump)) - - (#.Right jump) - (exception.throw ..cannot-do-a-big-jump [label @from jump])) - - #.None - (exception.throw ..unknown-label [label]))) - []]])))] - - [ifeq /instruction.ifeq] - [ifne /instruction.ifne] - [iflt /instruction.iflt] - [ifge /instruction.ifge] - [ifgt /instruction.ifgt] - [ifle /instruction.ifle] - - [if-icmpeq /instruction.if-icmpeq] - [if-icmpne /instruction.if-icmpne] - [if-icmplt /instruction.if-icmplt] - [if-icmpge /instruction.if-icmpge] - [if-icmpgt /instruction.if-icmpgt] - [if-icmple /instruction.if-icmple] - - [if-acmpeq /instruction.if-acmpeq] - [if-acmpne /instruction.if-acmpne] - - [ifnull /instruction.ifnull] - [ifnonnull /instruction.ifnonnull] - ) - -(template [ ] - [(def: #export ( label) - (-> Label (Program Any)) - (function (_ [pool tracker]) - (let [@from (get@ #program-counter tracker)] - [[pool tracker] - [(function (_ resolver) - (case (dictionary.get label resolver) - (#.Some @to) - (case (jump @from @to) - (#.Left jump) - (#try.Success ( jump)) - - (#.Right jump) - (#try.Success ( jump))) - - #.None - (exception.throw ..unknown-label [label]))) - []]])))] - - [goto /instruction.goto /instruction.goto-w] - [jsr /instruction.jsr /instruction.jsr-w] - ) - -(template [ ] - [(def: #export ( class) - (-> External (Program Any)) - (do ..monad - ## TODO: Make sure it"s impossible to have indexes greater than U2. - [index (..lift (//constant/pool.class (//name.internal class)))] - (..nullary ( index))))] - - [new /instruction.new] - [anewarray /instruction.anewarray] - [checkcast /instruction.checkcast] - [instanceof /instruction.instanceof] - ) - -(def: #export (iinc register increase) - (-> Local U1 (Program Any)) - (..nullary (/instruction.iinc register increase))) - -(def: #export (multianewarray class count) - (-> External U1 (Program Any)) - (do ..monad - [index (..lift (//constant/pool.class (//name.internal class)))] - (..nullary (/instruction.multianewarray index count)))) - -(def: (descriptor-size descriptor) - (-> (Descriptor (Return Any)) U1) - (//unsigned.u1 - (cond (is? //descriptor.void descriptor) - 0 - - (is? //descriptor.long descriptor) - 2 - - (is? //descriptor.double descriptor) - 2 - - ## else - 1))) - -(template [ ] - [(def: #export ( class method inputs output) - (-> External Text (List (Descriptor (Value Any))) (Descriptor (Return Any)) (Program Any)) - (do ..monad - [index (<| ..lift - (//constant/pool.method class) - {#//constant/pool.name method - #//constant/pool.descriptor (//descriptor.method inputs output)})] - (..nullary ( - index - (|> inputs - (list@map descriptor-size) - (list@fold //unsigned.u1/+ (//unsigned.u1 (if 0 1)))) - (descriptor-size output)))))] - - [#1 invokestatic /instruction.invokestatic] - [#0 invokevirtual /instruction.invokevirtual] - [#0 invokespecial /instruction.invokespecial] - [#0 invokeinterface /instruction.invokeinterface] - ) - -(template [ <1> <2>] - [(def: #export ( class field type) - (-> External Text (Descriptor Field) (Program Any)) - (do ..monad - [index (<| ..lift - (//constant/pool.field class) - {#//constant/pool.name field - #//constant/pool.descriptor type})] - (..nullary (cond (is? //descriptor.long type) - (<2> index) - - (is? //descriptor.double type) - (<2> index) - - ## else - (<1> index)))))] - - [getstatic /instruction.getstatic/1 /instruction.getstatic/2] - [putstatic /instruction.putstatic/1 /instruction.putstatic/2] - [getfield /instruction.getfield/1 /instruction.getfield/2] - [putfield /instruction.putfield/1 /instruction.putfield/2] - ) diff --git a/stdlib/source/lux/target/jvm/program/condition.lux b/stdlib/source/lux/target/jvm/program/condition.lux deleted file mode 100644 index 04bb8c60b..000000000 --- a/stdlib/source/lux/target/jvm/program/condition.lux +++ /dev/null @@ -1,80 +0,0 @@ -(.module: - [lux #* - [abstract - [monad (#+ do)] - [monoid (#+ Monoid)]] - [control - ["." try (#+ Try)] - ["." exception (#+ exception:)]] - [data - [number (#+ hex)] - ["." binary] - [text - ["%" format (#+ format)]] - [format - [".F" binary (#+ Mutation Specification)]]]] - ["." // #_ - ["#." resources (#+ Resources)] - ["/#" // #_ - [encoding - ["#." unsigned (#+ U1 U2)]]]]) - -(type: #export Environment - {#resources Resources - #stack U2}) - -(def: #export start - Environment - {#resources //resources.start - #stack (///unsigned.u2 0)}) - -(type: #export Condition - (-> Environment (Try Environment))) - -(structure: #export monoid - (Monoid Condition) - - (def: identity (|>> #try.Success)) - - (def: (compose left right) - (function (_ environment) - (do try.monad - [environment (left environment)] - (right environment))))) - -(def: #export (produces amount env) - (-> Nat Condition) - (let [stack (n/+ amount - (///unsigned.nat (get@ #stack env))) - max-stack (n/max stack - (///unsigned.nat (get@ [#resources #//resources.max-stack] env)))] - (|> env - (set@ #stack (///unsigned.u2 stack)) - (set@ [#resources #//resources.max-stack] (///unsigned.u2 max-stack)) - #try.Success))) - -(exception: #export (cannot-pop-stack {stack-size Nat} - {wanted-pops Nat}) - (exception.report - ["Stack Size" (%.nat stack-size)] - ["Wanted Pops" (%.nat wanted-pops)])) - -(def: #export (consumes wanted-pops env) - (-> Nat Condition) - (let [stack-size (///unsigned.nat (get@ #stack env))] - (if (n/<= stack-size wanted-pops) - (#try.Success (update@ #stack - (|>> ///unsigned.nat (n/- wanted-pops) ///unsigned.u2) - env)) - (exception.throw ..cannot-pop-stack [stack-size wanted-pops])))) - -(type: #export Local U1) - -(def: #export (has-local local environment) - (-> Local Condition) - (let [max-locals (n/max (///unsigned.nat (get@ [#resources #//resources.max-locals] environment)) - (///unsigned.nat local))] - (|> environment - (set@ [#resources #//resources.max-locals] - (///unsigned.u2 max-locals)) - #try.Success))) diff --git a/stdlib/source/lux/target/jvm/program/instruction.lux b/stdlib/source/lux/target/jvm/program/instruction.lux deleted file mode 100644 index 4f9c43f56..000000000 --- a/stdlib/source/lux/target/jvm/program/instruction.lux +++ /dev/null @@ -1,490 +0,0 @@ -(.module: - [lux (#- Code) - [abstract - [monad (#+ do)] - [monoid (#+ Monoid)]] - [control - ["." try (#+ Try)] - ["." exception (#+ exception:)]] - [data - [number (#+ hex)] - ["." binary] - [text - ["%" format (#+ format)]] - [format - [".F" binary (#+ Mutation Specification)]]] - [macro - ["." template]] - [type - abstract]] - ["." // #_ - ["#." resources (#+ Resources)] - ["/" condition (#+ Environment Condition Local) ("#@." monoid)] - ["#." jump (#+ Jump Big-Jump)] - ["/#" // #_ - ["#." index (#+ Index)] - ["#." descriptor (#+ Field Method)] - ["#." constant (#+ Class Reference)] - [encoding - ["#." unsigned (#+ U1 U2 U4)] - ["#." signed (#+ S2 S4)]]]]) - -(type: #export Size Nat) - -(type: #export Instruction - [Size (-> [Environment Specification] (Try [Environment Specification]))]) - -(def: #export (run instruction) - (-> Instruction (Try [Environment Specification])) - (let [[_ instruction'] instruction] - (instruction' [/.start binaryF.no-op]))) - -(def: (instruction size condition transform) - (-> Size Condition (-> Specification Specification) Instruction) - [size - (function (_ [environment specification]) - (do try.monad - [environment' (condition environment)] - (wrap [environment' - (transform specification)])))]) - -(type: Code Nat) - -(def: (nullary' code) - (-> Code Mutation) - (function (_ [offset binary]) - [(n/+ 1 offset) - (try.assume - (binary.write/8 offset code binary))])) - -(def: (nullary code [size mutation]) - (-> Code (-> Specification Specification)) - [(n/+ 1 size) - (|>> mutation ((nullary' code)))]) - -(template [ ] - [(with-expansions [ (template.identifier [ "'"])] - (def: ( code input0) - (-> Code Mutation) - (function (_ [offset binary]) - [(n/+ offset) - (try.assume - (do try.monad - [_ (binary.write/8 offset code binary)] - ( (n/+ 1 offset) ( input0) binary)))])) - - (def: ( code input0 [size mutation]) - (-> Code (-> Specification Specification)) - [(n/+ size) - (|>> mutation (( code input0)))]))] - - [2 unary/1 U1 binary.write/8 ///unsigned.nat] - [3 unary/2 U2 binary.write/16 ///unsigned.nat] - [3 jump/2 S2 binary.write/16 ///signed.int] - [5 jump/4 S4 binary.write/32 ///signed.int] - ) - -(def: (binary/11' code input0 input1) - (-> Code U1 U1 Mutation) - (function (_ [offset binary]) - [(n/+ 3 offset) - (try.assume - (do try.monad - [_ (binary.write/8 offset code binary) - _ (binary.write/8 (n/+ 1 offset) (///unsigned.nat input0) binary)] - (binary.write/8 (n/+ 2 offset) (///unsigned.nat input1) binary)))])) - -(def: (binary/11 code input0 input1 [size mutation]) - (-> Code U1 U1 (-> Specification Specification)) - [(n/+ 3 size) - (|>> mutation ((binary/11' code input0 input1)))]) - -(def: (binary/21' code input0 input1) - (-> Code U2 U1 Mutation) - (function (_ [offset binary]) - [(n/+ 4 offset) - (try.assume - (do try.monad - [_ (binary.write/8 offset code binary) - _ (binary.write/16 (n/+ 1 offset) (///unsigned.nat input0) binary)] - (binary.write/8 (n/+ 3 offset) (///unsigned.nat input1) binary)))])) - -(def: (binary/21 code input0 input1 [size mutation]) - (-> Code U2 U1 (-> Specification Specification)) - [(n/+ 4 size) - (|>> mutation ((binary/21' code input0 input1)))]) - -(def: (trinary/211' code input0 input1 input2) - (-> Code U2 U1 U1 Mutation) - (function (_ [offset binary]) - [(n/+ 5 offset) - (try.assume - (do try.monad - [_ (binary.write/8 offset code binary) - _ (binary.write/16 (n/+ 1 offset) (///unsigned.nat input0) binary) - _ (binary.write/8 (n/+ 3 offset) (///unsigned.nat input1) binary)] - (binary.write/8 (n/+ 4 offset) (///unsigned.nat input2) binary)))])) - -(def: (trinary/211 code input0 input1 input2 [size mutation]) - (-> Code U2 U1 U1 (-> Specification Specification)) - [(n/+ 5 size) - (|>> mutation ((trinary/211' code input0 input1 input2)))]) - -(abstract: #export Primitive-Array-Type - {} - - U1 - - (def: code - (-> Primitive-Array-Type U1) - (|>> :representation)) - - (template [ ] - [(def: #export (|> ///unsigned.u1 :abstraction))] - - [04 t-boolean] - [05 t-char] - [06 t-float] - [07 t-double] - [08 t-byte] - [09 t-short] - [10 t-int] - [11 t-long] - )) - -## https://docs.oracle.com/javase/specs/jvms/se8/html/jvms-6.html#jvms-6.5 -(with-expansions [ (template [ ] - [[ [] [] 0 []]] - - ["01" aconst-null 1] - - ["02" iconst-m1 1] - ["03" iconst-0 1] - ["04" iconst-1 1] - ["05" iconst-2 1] - ["06" iconst-3 1] - ["07" iconst-4 1] - ["08" iconst-5 1] - - ["09" lconst-0 2] - ["0A" lconst-1 2] - - ["0B" fconst-0 1] - ["0C" fconst-1 1] - ["0D" fconst-2 1] - - ["0E" dconst-0 2] - ["0F" dconst-1 2]) - (template [ ] - [[ [[local Local]] [local] 0 [[local]]]] - - ["15" iload 1] - ["16" lload 2] - ["17" fload 1] - ["18" dload 2] - ["19" aload 1]) - (template [ ] - [[ [] [] 0 [[(///unsigned.u1 )]]]] - - ["1A" iload-0 1 0] - ["1B" iload-1 1 1] - ["1C" iload-2 1 2] - ["1D" iload-3 1 3] - - ["1E" lload-0 2 1] - ["1F" lload-1 2 2] - ["20" lload-2 2 3] - ["21" lload-3 2 4] - - ["22" fload-0 1 0] - ["23" fload-1 1 1] - ["24" fload-2 1 2] - ["25" fload-3 1 3] - - ["26" dload-0 2 1] - ["27" dload-1 2 2] - ["28" dload-2 2 3] - ["29" dload-3 2 4] - - ["2A" aload-0 1 0] - ["2B" aload-1 1 1] - ["2C" aload-2 1 2] - ["2D" aload-3 1 3]) - (template [ ] - [[ [[local Local]] [local] 0 [[local]]]] - - ["36" istore 1] - ["37" lstore 2] - ["38" fstore 1] - ["39" dstore 2] - ["3A" astore 1]) - (template [ ] - [[ [] [] 0 [[(///unsigned.u1 )]]]] - - ["3B" istore-0 1 0] - ["3C" istore-1 1 1] - ["3D" istore-2 1 2] - ["3E" istore-3 1 3] - - ["3F" lstore-0 2 1] - ["40" lstore-1 2 2] - ["41" lstore-2 2 3] - ["42" lstore-3 2 4] - - ["43" fstore-0 1 0] - ["44" fstore-1 1 1] - ["45" fstore-2 1 2] - ["46" fstore-3 1 3] - - ["47" dstore-0 2 1] - ["48" dstore-1 2 2] - ["49" dstore-2 2 3] - ["4A" dstore-3 2 4] - - ["4B" astore-0 1 0] - ["4C" astore-1 1 1] - ["4D" astore-2 1 2] - ["4E" astore-3 1 3]) - (template [ ] - [[ [] [] 2 []]] - - ["2E" iaload 1] - ["2F" laload 2] - ["30" faload 1] - ["31" daload 2] - ["32" aaload 1] - ["33" baload 1] - ["34" caload 1] - ["35" saload 1]) - (template [ ] - [[ [] [] 0 []]] - - ["4f" iastore 3] - ["50" lastore 4] - ["51" fastore 3] - ["52" dastore 4] - ["53" aastore 3] - ["54" bastore 3] - ["55" castore 3] - ["56" sastore 3]) - (template [ ] - [[ [] [] []]] - - ["60" iadd 2 1] - ["64" isub 2 1] - ["68" imul 2 1] - ["6c" idiv 2 1] - ["70" irem 2 1] - ["74" ineg 1 1] - ["78" ishl 2 1] - ["7a" ishr 2 1] - ["7c" iushr 2 1] - ["7e" iand 2 1] - ["80" ior 2 1] - ["82" ixor 2 1] - - ["61" ladd 4 2] - ["65" lsub 4 2] - ["69" lmul 4 2] - ["6D" ldiv 4 2] - ["71" lrem 4 2] - ["75" lneg 2 2] - ["7F" land 4 2] - ["81" lor 4 2] - ["83" lxor 4 2] - - ["62" fadd 2 1] - ["66" fsub 2 1] - ["6A" fmul 2 1] - ["6E" fdiv 2 1] - ["72" frem 2 1] - ["76" fneg 1 1] - - ["63" dadd 4 2] - ["67" dsub 4 2] - ["6B" dmul 4 2] - ["6F" ddiv 4 2] - ["73" drem 4 2] - ["77" dneg 2 2]) - (template [ ] - [[ [] [] []]] - - ["88" l2i 2 1] - ["89" l2f 2 1] - ["8A" l2d 2 2] - - ["8B" f2i 1 1] - ["8C" f2l 1 2] - ["8D" f2d 1 2] - - ["8E" d2i 2 1] - ["8F" d2l 2 2] - ["90" d2f 2 1] - - ["85" i2l 1 2] - ["86" i2f 1 1] - ["87" i2d 1 2] - ["91" i2b 1 1] - ["92" i2c 1 1] - ["93" i2s 1 1]) - (template [ ] - [[ [] [] 1 []]] - - ["94" lcmp 4] - - ["95" fcmpl 2] - ["96" fcmpg 2] - - ["97" dcmpl 4] - ["98" dcmpg 4]) - (template [ ] - [[ [] [] 0 []]] - - ["AC" ireturn 1] - ["AD" lreturn 2] - ["AE" freturn 1] - ["AF" dreturn 2] - ["B0" areturn 1] - ["B1" return 0] - ) - (template [ ] - [[ [[jump Jump]] [jump] []]] - - ["99" ifeq 2 0] - ["9A" ifne 2 0] - ["9B" iflt 2 0] - ["9C" ifge 2 0] - ["9D" ifgt 2 0] - ["9E" ifle 2 0] - - ["9F" if-icmpeq 2 0] - ["A0" if-icmpne 2 0] - ["A1" if-icmplt 2 0] - ["A2" if-icmpge 2 0] - ["A3" if-icmpgt 2 0] - ["A4" if-icmple 2 0] - - ["A5" if-acmpeq 2 0] - ["A6" if-acmpne 2 0] - - ["A7" goto 0 0] - ["A8" jsr 0 1] - - ["C6" ifnull 1 0] - ["C7" ifnonnull 1 0]) - (template [ ] - [[ [[index (Index (Reference Field))]] [(///index.number index)] []]] - - ["B2" getstatic/1 0 1] ["B2" getstatic/2 0 2] - ["B3" putstatic/1 1 1] ["B3" putstatic/2 1 2] - ["B4" getfield/1 1 1] ["B4" getfield/2 1 2] - ["B5" putfield/1 2 1] ["B5" putfield/2 2 2])] - (template [ ] - [(with-expansions [' (template.splice )] - (template [ ] - [(with-expansions [' (template.splice ) - (template [ ] - [] - - ') - (template [ ] - [] - - ') - ' (template.splice )] - (def: #export ( ) - (-> Instruction) - (..instruction - - (`` ($_ /@compose - (/.consumes ) - (/.produces ) - (~~ (template [] - [(/.has-local )] - - ')))) - (`` ( (hex ) (~~ (template.splice )))))))] - - ' - ))] - - [..nullary 1 - [["00" nop [] [] 0 0 []] - - ["57" pop [] [] 1 0 []] - ["58" pop2 [] [] 2 0 []] - ["59" dup [] [] 1 2 []] - ["5A" dup-x1 [] [] 2 3 []] - ["5B" dup-x2 [] [] 3 4 []] - ["5C" dup2 [] [] 2 4 []] - ["5D" dup2-x1 [] [] 3 5 []] - ["5E" dup2-x2 [] [] 4 6 []] - ["5F" swap [] [] 2 2 []] - - - - - - ["79" lshl [] [] 3 2 []] - ["7B" lshr [] [] 3 2 []] - ["7D" lushr [] [] 3 2 []] - - - - ["BE" arraylength [] [] 1 1 []] - ["BF" athrow [] [] 1 0 []] - ["C2" monitorenter [] [] 1 0 []] - ["C3" monitorexit [] [] 1 0 []]]] - - [..unary/1 2 - [["10" bipush [[byte U1]] [byte] 0 1 []] - ["12" ldc [[index U1]] [index] 0 1 []] - - - ["A9" ret [[local Local]] [local] 0 0 [[local]]] - ["BC" newarray [[type Primitive-Array-Type]] [(..code type)] 1 1 []]]] - - [..unary/2 3 - [["11" sipush [[short U2]] [short] 0 1 []] - ["13" ldc-w/integer [[index (Index ///constant.Integer)]] [(///index.number index)] 0 1 []] - ["13" ldc-w/float [[index (Index ///constant.Float)]] [(///index.number index)] 0 1 []] - ["13" ldc-w/string [[index (Index ///constant.String)]] [(///index.number index)] 0 1 []] - ["14" ldc2-w/long [[index (Index ///constant.Long)]] [(///index.number index)] 0 2 []] - ["14" ldc2-w/double [[index (Index ///constant.Double)]] [(///index.number index)] 0 2 []] - - ["BB" new [[index (Index Class)]] [(///index.number index)] 0 1 []] - ["BD" anewarray [[index (Index Class)]] [(///index.number index)] 1 1 []] - ["C0" checkcast [[index (Index Class)]] [(///index.number index)] 1 1 []] - ["C1" instanceof [[index (Index Class)]] [(///index.number index)] 1 1 []] - ["B6" invokevirtual [[index (Index (Reference Method))] [count U1] [output-count U1]] [(///index.number index)] (///unsigned.nat count) (///unsigned.nat output-count) []] - ["B7" invokespecial [[index (Index (Reference Method))] [count U1] [output-count U1]] [(///index.number index)] (///unsigned.nat count) (///unsigned.nat output-count) []] - ["B8" invokestatic [[index (Index (Reference Method))] [count U1] [output-count U1]] [(///index.number index)] (///unsigned.nat count) (///unsigned.nat output-count) []]]] - - [..jump/2 3 - []] - - [..jump/4 5 - [["C8" goto-w [[jump Big-Jump]] [jump] 0 0 []] - ["C9" jsr-w [[jump Big-Jump]] [jump] 0 1 []]]] - - [..binary/11 3 - [["84" iinc [[local Local] [byte U1]] [local byte] 0 0 [[local]]]]] - - [..binary/21 4 - [["C5" multianewarray [[index (Index Class)] [count U1]] [(///index.number index) count] (///unsigned.nat count) 1 []]]] - - [..trinary/211 5 - [["B9" invokeinterface [[index (Index (Reference Method))] [count U1] [output-count U1]] [(///index.number index) count (///unsigned.u1 0)] (///unsigned.nat count) (///unsigned.nat output-count) []]]] - )) - -(structure: #export monoid - (Monoid Instruction) - - (def: identity ..nop) - - (def: (compose [left-size left] [right-size right]) - [(n/+ left-size right-size) - (function (_ input) - (do try.monad - [temp (left input)] - (right temp)))])) diff --git a/stdlib/source/lux/target/jvm/program/jump.lux b/stdlib/source/lux/target/jvm/program/jump.lux deleted file mode 100644 index 19f667cfe..000000000 --- a/stdlib/source/lux/target/jvm/program/jump.lux +++ /dev/null @@ -1,17 +0,0 @@ -(.module: - [lux #* - [abstract - [equivalence (#+ Equivalence)]]] - ["." /// #_ - [encoding - ["#." signed (#+ S2 S4)]]]) - -(type: #export Jump S2) - -(def: #export equivalence - ///signed.equivalence) - -(def: #export writer - ///signed.s2-writer) - -(type: #export Big-Jump S4) diff --git a/stdlib/source/lux/target/jvm/program/resources.lux b/stdlib/source/lux/target/jvm/program/resources.lux deleted file mode 100644 index fa83c4071..000000000 --- a/stdlib/source/lux/target/jvm/program/resources.lux +++ /dev/null @@ -1,44 +0,0 @@ -(.module: - [lux #* - [abstract - ["." equivalence (#+ Equivalence)]] - [data - [format - [".F" binary (#+ Writer) ("#@." monoid)]]]] - ["." /// #_ - [encoding - ["#." unsigned (#+ U2)]]]) - -(type: #export Resources - {#max-stack U2 - #max-locals U2}) - -(def: #export start - Resources - {#max-stack (///unsigned.u2 0) - #max-locals (///unsigned.u2 0)}) - -(def: #export length - ($_ n/+ - ## u2 max_stack; - ///unsigned.u2-bytes - ## u2 max_locals; - ///unsigned.u2-bytes)) - -(def: #export equivalence - (Equivalence Resources) - ($_ equivalence.product - ## u2 max_stack; - ///unsigned.equivalence - ## u2 max_locals; - ///unsigned.equivalence - )) - -(def: #export (writer resources) - (Writer Resources) - ($_ binaryF@compose - ## u2 max_stack; - (///unsigned.u2-writer (get@ #max-stack resources)) - ## u2 max_locals; - (///unsigned.u2-writer (get@ #max-locals resources)) - )) 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 d0d819925..2807487ae 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/primitive.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/primitive.lux @@ -6,21 +6,21 @@ [jvm ["|" descriptor] ["." constant] - ["_" program (#+ Program)]]] + ["_" instruction (#+ Instruction)]]] [macro ["." template]]] ["." // #_ ["#." runtime]]) (def: #export (bit value) - (-> Bit (Program Any)) + (-> Bit (Instruction Any)) (_.getstatic "java.lang.Boolean" (if value "TRUE" "FALSE") (|.object "java.lang.Boolean"))) (template [ ] [(def: #export ( value) - (-> (Program Any)) + (-> (Instruction Any)) (do _.monad [_ (`` (|> value (~~ (template.splice ))))] (_.invokestatic "valueOf" 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 f43fc907a..b45965dc5 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/runtime.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/runtime.lux @@ -4,7 +4,7 @@ [binary (#+ Binary)]] [target [jvm - ["_" program (#+ Label Program)]]]] + ["_" instruction (#+ Label Instruction)]]]] ["." /// [/// [reference (#+ Register)]]] @@ -18,7 +18,7 @@ (template [ ] [(type: #export - ( Anchor (Program Any) Definition))] + ( Anchor (Instruction Any) Definition))] [Operation ///.Operation] [Phase ///.Phase] @@ -27,6 +27,6 @@ ) (type: #export (Generator i) - (-> Phase i (Operation (Program Any)))) + (-> Phase i (Operation (Instruction Any)))) (def: #export class "LuxRuntime") 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 beeeea2c7..1282ac245 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/structure.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/structure.lux @@ -11,7 +11,7 @@ [jvm ["|" descriptor] ["_." constant] - ["_" program (#+ Program)]]]] + ["_" instruction (#+ Instruction)]]]] ["." // #_ ["#." runtime (#+ Operation Phase Generator)] ["#." primitive] @@ -20,7 +20,7 @@ [analysis (#+ Variant Tuple)] ["#." synthesis (#+ Synthesis)]]]]) -(def: unitG (Program Any) (//primitive.text /////synthesis.unit)) +(def: unitG (Instruction Any) (//primitive.text /////synthesis.unit)) (template: (!integer ) (|> .i64 i32.i32 _constant.integer)) @@ -52,7 +52,7 @@ (monad.seq @ membersI)))))) (def: (flagG right?) - (-> Bit (Program Any)) + (-> Bit (Instruction Any)) (if right? ..unitG _.aconst-null)) diff --git a/stdlib/source/test/lux/target/jvm.lux b/stdlib/source/test/lux/target/jvm.lux index 8f97645b4..def28b2a0 100644 --- a/stdlib/source/test/lux/target/jvm.lux +++ b/stdlib/source/test/lux/target/jvm.lux @@ -39,9 +39,8 @@ ["#/." pool]] [encoding ["#." name]] - ["#." program - ["#/." condition (#+ Environment)] - ["#/." instruction]]]}) + ["#." instruction + ["#/." condition (#+ Environment)]]]}) ## (def: (write-class! name bytecode) ## (-> Text Binary (IO Text)) @@ -132,12 +131,12 @@ method-name (/descriptor.method inputsJT outputJT) (list) - (do /program.monad - [_ (/program.ldc/long (/constant.long expected)) - _ (/program.invokestatic "java.lang.Long" "valueOf" - (list /descriptor.long) - (/descriptor.object "java.lang.Long"))] - /program.areturn))) + (do /instruction.monad + [_ (/instruction.ldc/long (/constant.long expected)) + _ (/instruction.invokestatic "java.lang.Long" "valueOf" + (list /descriptor.long) + (/descriptor.object "java.lang.Long"))] + /instruction.areturn))) (row.row)) (binaryF.run /class.writer)) loader (/loader.memory (/loader.new-library []))] -- cgit v1.2.3