diff options
Diffstat (limited to 'stdlib/source/library/lux/meta/compiler/target/jvm/constant.lux')
| -rw-r--r-- | stdlib/source/library/lux/meta/compiler/target/jvm/constant.lux | 251 |
1 files changed, 251 insertions, 0 deletions
diff --git a/stdlib/source/library/lux/meta/compiler/target/jvm/constant.lux b/stdlib/source/library/lux/meta/compiler/target/jvm/constant.lux new file mode 100644 index 000000000..f5cdd6cf8 --- /dev/null +++ b/stdlib/source/library/lux/meta/compiler/target/jvm/constant.lux @@ -0,0 +1,251 @@ +(.require + [library + [lux (.except Double) + ["[0]" ffi (.only import)] + [abstract + [monad (.only do)] + ["[0]" equivalence (.only Equivalence)]] + [data + ["[0]" sum] + ["[0]" product] + ["[0]" text] + ["[0]" binary + ["[1]F" \\format (.only Format) (.use "[1]#[0]" monoid)]]] + [math + [number + ["[0]" i32 (.only I32)] + ["[0]" i64] + ["[0]" int] + ["[0]" frac]]] + [meta + [macro + ["^" pattern] + ["[0]" template]] + [type + ["[0]" nominal (.except def #name)]] + [compiler + ["@" target]]]]] + ["[0]" / + ["[1][0]" tag] + ["/[1]" // + ["[1][0]" index (.only Index)] + [type + ["[1][0]" category] + ["[1][0]" descriptor (.only Descriptor)]] + [encoding + ["[1][0]" unsigned]]]]) + +(type .public UTF8 + Text) + +(def utf8_format + (Format UTF8) + binaryF.utf8_16) + +(nominal.def .public Class + (Index UTF8) + + (def .public index + (-> Class (Index UTF8)) + (|>> representation)) + + (def .public class + (-> (Index UTF8) Class) + (|>> abstraction)) + + (def .public class_equivalence + (Equivalence Class) + (of equivalence.functor each + ..index + //index.equivalence)) + + (def class_format + (Format Class) + (|>> representation //index.format)) + ) + +(import java/lang/Float + "[1]::[0]" + ("static" floatToRawIntBits "manual" [float] int)) + +(def .public float_equivalence + (Equivalence java/lang/Float) + (implementation + (def (= parameter subject) + (for @.old + ("jvm feq" parameter subject) + + @.jvm + (.jvm_float_=# (.jvm_object_cast# parameter) + (.jvm_object_cast# subject)))))) + +(import java/lang/Double + "[1]::[0]" + ("static" doubleToRawLongBits [double] long)) + +(nominal.def .public (Value kind) + kind + + (def .public value + (All (_ kind) (-> (Value kind) kind)) + (|>> representation)) + + (def .public (value_equivalence Equivalence<kind>) + (All (_ kind) + (-> (Equivalence kind) + (Equivalence (Value kind)))) + (of equivalence.functor each + (|>> representation) + Equivalence<kind>)) + + (with_template [<constructor> <type> <marker>] + [(type .public <type> + (Value <marker>)) + + (def .public <constructor> + (-> <marker> <type>) + (|>> abstraction))] + + [integer Integer I32] + [float Float java/lang/Float] + [long Long .Int] + [double Double Frac] + [string String (Index UTF8)] + ) + + (with_template [<format_name> <type> <write> <format>] + [(def <format_name> + (Format <type>) + (`` (|>> representation + (,, (template.spliced <write>)) + (,, (template.spliced <format>)))))] + + [integer_format Integer [] [binaryF.bits_32]] + [float_format Float [java/lang/Float::floatToRawIntBits ffi.of_int .i64] [i32.i32 binaryF.bits_32]] + [long_format Long [] [binaryF.bits_64]] + [double_format Double [java/lang/Double::doubleToRawLongBits ffi.of_long] [binaryF.bits_64]] + [string_format String [] [//index.format]] + ) + ) + +(type .public (Name_And_Type of) + (Record + [#name (Index UTF8) + #descriptor (Index (Descriptor of))])) + +(type .public (Reference of) + (Record + [#class (Index Class) + #name_and_type (Index (Name_And_Type of))])) + +(with_template [<type> <equivalence> <format>] + [(def .public <equivalence> + (Equivalence (<type> Any)) + (all product.equivalence + //index.equivalence + //index.equivalence)) + + (def <format> + (Format (<type> Any)) + (all binaryF.and + //index.format + //index.format))] + + [Name_And_Type name_and_type_equivalence name_and_type_format] + [Reference reference_equivalence reference_format] + ) + +(type .public Constant + (Variant + {#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 .public (size constant) + (-> Constant Nat) + (when constant + (^.or {#Long _} {#Double _}) + 2 + + _ + 1)) + +(def .public 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) + (when [reference sample] + (^.with_template [<tag> <equivalence>] + [[{<tag> reference} {<tag> sample}] + (of <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))) + ... (all 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 .public format + (Format Constant) + (with_expansions [<constants> (these [#UTF8 /tag.utf8 ..utf8_format] + [#Integer /tag.integer ..integer_format] + [#Float /tag.float ..float_format] + [#Long /tag.long ..long_format] + [#Double /tag.double ..double_format] + [#Class /tag.class ..class_format] + [#String /tag.string ..string_format] + [#Field /tag.field ..reference_format] + [#Method /tag.method ..reference_format] + [#Interface_Method /tag.interface_method ..reference_format] + [#Name_And_Type /tag.name_and_type ..name_and_type_format] + ... TODO: Method_Handle + ... TODO: Method_Type + ... TODO: Invoke_Dynamic + )] + (function (_ value) + (when value + (^.with_template [<case> <tag> <format>] + [{<case> value} + (binaryF#composite (/tag.format <tag>) + (<format> value))]) + (<constants>) + )))) |