diff options
Diffstat (limited to 'stdlib/source')
7 files changed, 137 insertions, 21 deletions
diff --git a/stdlib/source/lux/target/jvm/constant.lux b/stdlib/source/lux/target/jvm/constant.lux index ff9847bd6..80addbcbe 100644 --- a/stdlib/source/lux/target/jvm/constant.lux +++ b/stdlib/source/lux/target/jvm/constant.lux @@ -1,11 +1,13 @@ (.module: [lux #* - [host (#+ import:)] + ["." host (#+ import:)] + ["@" target] [abstract [monad (#+ do)] ["." equivalence (#+ Equivalence)]] [data [number + ["." i64] ["." int] ["." frac]] ["." text] @@ -14,14 +16,16 @@ [collection ["." row (#+ Row)]]] [type - abstract]] + abstract] + [macro + ["." template]]] ["." / #_ ["#." tag ("#;." equivalence)] - ["." // #_ + ["/#" // #_ ["#." descriptor (#+ Descriptor)] ["#." index (#+ Index)] [encoding - [unsigned (#+ U4)]]]]) + ["#." unsigned (#+ U4)]]]]) (type: #export UTF8 Text) @@ -49,6 +53,29 @@ (|>> :representation //index.writer)) ) +(def: sign-mask Int (|> +1 (i64.left-shift 63))) +(def: number-mask Int (|> +1 (i64.left-shift 31) dec)) + +(def: #export (i32 i64) + (-> Int U4) + (|> (i64.or (|> i64 (i64.and sign-mask) (i64.arithmetic-right-shift 32)) + (|> i64 (i64.and number-mask))) + .nat + //unsigned.u4)) + +(import: #long java/lang/Float + (#static floatToRawIntBits #manual [float] int)) + +(structure: #export float-equivalence + (Equivalence java/lang/Float) + + (def: (= parameter subject) + (`` (for {(~~ (static @.old)) + ("jvm feq" parameter subject) + + (~~ (static @.jvm)) + ("jvm float =" parameter subject)})))) + (import: #long java/lang/Double (#static doubleToRawLongBits [double] long)) @@ -78,8 +105,8 @@ (|>> :abstraction))] [integer Integer U4] + [float Float java/lang/Float] [long Long .Int] - [float Float Nothing] [double Double Frac] [string String (Index UTF8)] ) @@ -87,11 +114,15 @@ (template [<writer-name> <type> <write> <writer>] [(def: <writer-name> (Writer <type>) - (|>> :representation <write> <writer>))] - - [long-writer Long (<|) binaryF.bits/64] - [double-writer Double java/lang/Double::doubleToRawLongBits binaryF.bits/64] - [string-writer String (<|) //index.writer] + (`` (|>> :representation + (~~ (template.splice <write>)) + (~~ (template.splice <writer>)))))] + + [integer-writer Integer [//unsigned.nat] [binaryF.bits/32]] + [float-writer Float [java/lang/Float::floatToRawIntBits host.int-to-long] [..i32 //unsigned.nat binaryF.bits/32]] + [long-writer Long [] [binaryF.bits/64]] + [double-writer Double [java/lang/Double::doubleToRawLongBits] [binaryF.bits/64]] + [string-writer String [] [//index.writer]] ) ) @@ -122,6 +153,8 @@ (type: #export Constant (#UTF8 UTF8) + (#Integer Integer) + (#Float Float) (#Long Long) (#Double Double) (#Class Class) @@ -151,7 +184,9 @@ [(<tag> reference) (<tag> sample)] (:: <equivalence> = reference sample)) ([#UTF8 text.equivalence] + [#Integer (..value-equivalence //unsigned.equivalence)] [#Long (..value-equivalence int.equivalence)] + [#Float (..value-equivalence float-equivalence)] [#Double (..value-equivalence frac.equivalence)] [#Class ..class-equivalence] [#String (..value-equivalence //index.equivalence)] @@ -187,8 +222,8 @@ (def: #export writer (Writer Constant) (with-expansions [<constants> (as-is [#UTF8 /tag.utf8 ..utf8-writer] - ## TODO: Integer - ## TODO: Float + [#Integer /tag.integer ..integer-writer] + [#Float /tag.float ..float-writer] [#Long /tag.long ..long-writer] [#Double /tag.double ..double-writer] [#Class /tag.class ..class-writer] diff --git a/stdlib/source/lux/target/jvm/constant/pool.lux b/stdlib/source/lux/target/jvm/constant/pool.lux index a03bba71b..590102a09 100644 --- a/stdlib/source/lux/target/jvm/constant/pool.lux +++ b/stdlib/source/lux/target/jvm/constant/pool.lux @@ -1,5 +1,6 @@ (.module: [lux #* + ["." host] [abstract ["." equivalence (#+ Equivalence)] [monad (#+ do)]] @@ -21,7 +22,7 @@ abstract] [macro ["." template]]] - ["." // (#+ UTF8 String Class Long Double Constant Name-And-Type Reference) + ["." // (#+ UTF8 String Class Integer Float Long Double Constant Name-And-Type Reference) [// [encoding ["#." name (#+ Internal External)] @@ -148,6 +149,8 @@ (Finder <type>) (!find <tag> <equivalence> <format> reference)))] + [integer Integer #//.Integer (//.value-equivalence //unsigned.equivalence) (|>> //.value //unsigned.nat %.nat)] + [float Float #//.Float (//.value-equivalence //.float-equivalence) (|>> //.value host.float-to-double %.frac)] [long Long #//.Long (//.value-equivalence int.equivalence) (|>> //.value %.int)] [double Double #//.Double (//.value-equivalence frac.equivalence) (|>> //.value %.frac)] [utf8 UTF8 #//.UTF8 text.equivalence %.text] diff --git a/stdlib/source/lux/target/jvm/program.lux b/stdlib/source/lux/target/jvm/program.lux index abfe6f5bb..13cd8ae5b 100644 --- a/stdlib/source/lux/target/jvm/program.lux +++ b/stdlib/source/lux/target/jvm/program.lux @@ -320,7 +320,9 @@ [index (..lift (<constant> value))] (..nullary (<ldc> 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] ) @@ -439,7 +441,7 @@ (template [<name> <instruction>] [(def: #export (<name> class) - (-> UTF8 (Program Any)) + (-> 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)))] diff --git a/stdlib/source/lux/tool/compiler/phase/generation/js/structure.lux b/stdlib/source/lux/tool/compiler/phase/generation/js/structure.lux index 5bdbfd1a6..c721c991c 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/js/structure.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/js/structure.lux @@ -12,11 +12,13 @@ [analysis (#+ Variant Tuple)] ["#." synthesis (#+ Synthesis)]]]]) +(def: unit Expression (//primitive.text /////synthesis.unit)) + (def: #export (tuple generate elemsS+) (-> Phase (Tuple Synthesis) (Operation Expression)) (case elemsS+ #.Nil - (:: ////.monad wrap (//primitive.text /////synthesis.unit)) + (:: ////.monad wrap ..unit) (#.Cons singletonS #.Nil) (generate singletonS) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm.lux index e9ece420f..9a4847165 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/jvm.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm.lux @@ -5,7 +5,7 @@ ["." / #_ [runtime (#+ Phase)] ["#." primitive] - ## ["." structure] + ["#." structure] ## ["." reference ("#@." system)] ## ["." function] ## ["." case] @@ -27,11 +27,11 @@ [synthesis.f64 /primitive.f64] [synthesis.text /primitive.text]) - ## (^ (synthesis.variant variantS)) - ## (/structure.variant generate variantS) + (^ (synthesis.variant variantS)) + (/structure.variant generate variantS) - ## (^ (synthesis.tuple members)) - ## (/structure.tuple generate members) + (^ (synthesis.tuple members)) + (/structure.tuple generate members) ## (#synthesis.Reference value) ## (/reference@reference 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 5a84c4990..f43fc907a 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/runtime.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/runtime.lux @@ -27,4 +27,6 @@ ) (type: #export (Generator i) - (-> i Phase (Operation (Program Any)))) + (-> Phase i (Operation (Program 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 new file mode 100644 index 000000000..6c2dfc277 --- /dev/null +++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/structure.lux @@ -0,0 +1,72 @@ +(.module: + [lux #* + [abstract + ["." monad (#+ do)]] + [data + [collection + ["." list]]] + [target + [jvm + ["|" descriptor] + ["_." constant] + ["_" program (#+ Program)]]]] + ["." // #_ + ["#." runtime (#+ Operation Phase Generator)] + ["#." primitive] + ["#//" /// + ["#/" // #_ + [analysis (#+ Variant Tuple)] + ["#." synthesis (#+ Synthesis)]]]]) + +(def: unitG (Program Any) (//primitive.text /////synthesis.unit)) + +(template: (!integer <value>) + (|> <value> .int _constant.i32 _constant.integer)) + +(def: #export (tuple generate membersS) + (Generator (Tuple Synthesis)) + (case membersS + #.Nil + (:: ////.monad wrap ..unitG) + + (#.Cons singletonS #.Nil) + (generate singletonS) + + _ + (do ////.monad + [membersI (|> membersS + list.enumerate + (monad.map @ (function (_ [idx member]) + (do @ + [memberI (generate member)] + (wrap (do _.monad + [_ _.dup + _ (_.ldc/integer (!integer idx)) + _ memberI] + _.aastore))))))] + (wrap (do _.monad + [_ (_.ldc/integer (!integer (list.size membersS))) + _ (_.anewarray "java.lang.Object")] + (monad.seq @ membersI)))))) + +(def: (flagG right?) + (-> Bit (Program Any)) + (if right? + ..unitG + _.aconst-null)) + +(def: $Object (|.object "java.lang.Object")) + +(def: #export (variant generate [lefts right? valueS]) + (Generator (Variant Synthesis)) + (do ////.monad + [valueI (generate valueS)] + (wrap (do _.monad + [_ (_.ldc/integer (!integer (if right? + (.inc lefts) + lefts))) + _ (flagG right?) + _ valueI] + (_.invokestatic //runtime.class "variant" + (list |.int $Object $Object) + (|.array $Object)))))) |