diff options
Diffstat (limited to 'stdlib/source/library/lux/target/jvm/constant.lux')
| -rw-r--r-- | stdlib/source/library/lux/target/jvm/constant.lux | 246 |
1 files changed, 246 insertions, 0 deletions
diff --git a/stdlib/source/library/lux/target/jvm/constant.lux b/stdlib/source/library/lux/target/jvm/constant.lux new file mode 100644 index 000000000..663dc472f --- /dev/null +++ b/stdlib/source/library/lux/target/jvm/constant.lux @@ -0,0 +1,246 @@ +(.module: + [library + [lux #* + ["." ffi (#+ import:)] + ["@" target] + [abstract + [monad (#+ do)] + ["." equivalence (#+ Equivalence)]] + [data + ["." sum] + ["." product] + ["." text] + [format + [".F" binary (#+ Writer) ("#\." monoid)]] + [collection + ["." row (#+ Row)]]] + [macro + ["." template]] + [math + [number + ["." i32 (#+ I32)] + ["." i64] + ["." int] + ["." frac]]] + [type + abstract]]] + ["." / #_ + ["#." tag] + ["/#" // #_ + ["#." index (#+ Index)] + [type + ["#." category] + ["#." descriptor (#+ Descriptor)]] + [encoding + ["#." unsigned]]]]) + +(type: #export UTF8 Text) + +(def: utf8_writer + (Writer UTF8) + binaryF.utf8/16) + +(abstract: #export Class + (Index UTF8) + + (def: #export index + (-> Class (Index UTF8)) + (|>> :representation)) + + (def: #export class + (-> (Index UTF8) Class) + (|>> :abstraction)) + + (def: #export class_equivalence + (Equivalence Class) + (\ equivalence.functor map + ..index + //index.equivalence)) + + (def: class_writer + (Writer Class) + (|>> :representation //index.writer)) + ) + +(import: java/lang/Float + ["#::." + (#static floatToRawIntBits #manual [float] int)]) + +(implementation: #export float_equivalence + (Equivalence java/lang/Float) + + (def: (= parameter subject) + (for {@.old + ("jvm feq" parameter subject) + + @.jvm + ("jvm float =" + ("jvm object cast" parameter) + ("jvm object cast" subject))}))) + +(import: java/lang/Double + ["#::." + (#static doubleToRawLongBits [double] long)]) + +(abstract: #export (Value kind) + kind + + (def: #export value + (All [kind] (-> (Value kind) kind)) + (|>> :representation)) + + (def: #export (value_equivalence Equivalence<kind>) + (All [kind] + (-> (Equivalence kind) + (Equivalence (Value kind)))) + (\ equivalence.functor map + (|>> :representation) + Equivalence<kind>)) + + (template [<constructor> <type> <marker>] + [(type: #export <type> (Value <marker>)) + + (def: #export <constructor> + (-> <marker> <type>) + (|>> :abstraction))] + + [integer Integer I32] + [float Float java/lang/Float] + [long Long .Int] + [double Double Frac] + [string String (Index UTF8)] + ) + + (template [<writer_name> <type> <write> <writer>] + [(def: <writer_name> + (Writer <type>) + (`` (|>> :representation + (~~ (template.splice <write>)) + (~~ (template.splice <writer>)))))] + + [integer_writer Integer [] [binaryF.bits/32]] + [float_writer Float [java/lang/Float::floatToRawIntBits ffi.int_to_long (:as I64)] [i32.i32 binaryF.bits/32]] + [long_writer Long [] [binaryF.bits/64]] + [double_writer Double [java/lang/Double::doubleToRawLongBits] [binaryF.bits/64]] + [string_writer String [] [//index.writer]] + ) + ) + +(type: #export (Name_And_Type of) + {#name (Index UTF8) + #descriptor (Index (Descriptor of))}) + +(type: #export (Reference of) + {#class (Index Class) + #name_and_type (Index (Name_And_Type of))}) + +(template [<type> <equivalence> <writer>] + [(def: #export <equivalence> + (Equivalence (<type> Any)) + ($_ product.equivalence + //index.equivalence + //index.equivalence)) + + (def: <writer> + (Writer (<type> Any)) + ($_ binaryF.and + //index.writer + //index.writer))] + + [Name_And_Type name_and_type_equivalence name_and_type_writer] + [Reference reference_equivalence reference_writer] + ) + +(type: #export Constant + (#UTF8 UTF8) + (#Integer Integer) + (#Float Float) + (#Long Long) + (#Double Double) + (#Class Class) + (#String String) + (#Field (Reference //category.Value)) + (#Method (Reference //category.Method)) + (#Interface_Method (Reference //category.Method)) + (#Name_And_Type (Name_And_Type Any))) + +(def: #export (size constant) + (-> Constant Nat) + (case constant + (^or (#Long _) (#Double _)) + 2 + + _ + 1)) + +(def: #export equivalence + (Equivalence Constant) + ## TODO: Delete the explicit "implementation" and use the combinator + ## version below as soon as the new format for variants is implemented. + (implementation + (def: (= reference sample) + (case [reference sample] + (^template [<tag> <equivalence>] + [[(<tag> reference) (<tag> sample)] + (\ <equivalence> = reference sample)]) + ([#UTF8 text.equivalence] + [#Integer (..value_equivalence i32.equivalence)] + [#Long (..value_equivalence int.equivalence)] + [#Float (..value_equivalence float_equivalence)] + [#Double (..value_equivalence frac.equivalence)] + [#Class ..class_equivalence] + [#String (..value_equivalence //index.equivalence)] + [#Field ..reference_equivalence] + [#Method ..reference_equivalence] + [#Interface_Method ..reference_equivalence] + [#Name_And_Type ..name_and_type_equivalence]) + + _ + false))) + ## ($_ sum.equivalence + ## ## #UTF8 + ## text.equivalence + ## ## #Long + ## (..value_equivalence int.equivalence) + ## ## #Double + ## (..value_equivalence frac.equivalence) + ## ## #Class + ## ..class_equivalence + ## ## #String + ## (..value_equivalence //index.equivalence) + ## ## #Field + ## ..reference_equivalence + ## ## #Method + ## ..reference_equivalence + ## ## #Interface_Method + ## ..reference_equivalence + ## ## #Name_And_Type + ## ..name_and_type_equivalence + ## ) + ) + +(def: #export writer + (Writer Constant) + (with_expansions [<constants> (as_is [#UTF8 /tag.utf8 ..utf8_writer] + [#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] + [#String /tag.string ..string_writer] + [#Field /tag.field ..reference_writer] + [#Method /tag.method ..reference_writer] + [#Interface_Method /tag.interface_method ..reference_writer] + [#Name_And_Type /tag.name_and_type ..name_and_type_writer] + ## TODO: Method_Handle + ## TODO: Method_Type + ## TODO: Invoke_Dynamic + )] + (function (_ value) + (case value + (^template [<case> <tag> <writer>] + [(<case> value) + (binaryF\compose (/tag.writer <tag>) + (<writer> value))]) + (<constants>) + )))) |