diff options
38 files changed, 348 insertions, 261 deletions
diff --git a/documentation/bookmark/back-end/WebAssembly (WASM).md b/documentation/bookmark/back-end/wasm.md index 4e6487d85..9cca5b8a9 100644 --- a/documentation/bookmark/back-end/WebAssembly (WASM).md +++ b/documentation/bookmark/back-end/wasm.md @@ -1,3 +1,7 @@ +# Platform + +1. [WAVM: WAVM is a WebAssembly virtual machine, designed for use in non-web applications.](https://wavm.github.io/) + # Exemplar 1. [Announcing GraalWasm — a WebAssembly engine in GraalVM](https://medium.com/graalvm/announcing-graalwasm-a-webassembly-engine-in-graalvm-25cd0400a7f2) diff --git a/documentation/bookmark/Optics (eg lenses & prisms).md b/documentation/bookmark/optics.md index 6f7acb5ca..903c2ff54 100644 --- a/documentation/bookmark/Optics (eg lenses & prisms).md +++ b/documentation/bookmark/optics.md @@ -19,6 +19,6 @@ 1. http://evincarofautumn.blogspot.com/2016/01/thoughts-on-using-fractional-types-to.html 1. https://www.slideshare.net/davidoverton/comonad 1. http://codingismycraft.com/index.php/2017/10/04/adding-descriptors-to-your-python-arsenal/ -1. https://blog.jle.im/entry/lenses-products-prisms-sums.html +1. [Lenses embody Products, Prisms embody Sums](https://blog.jle.im/entry/lenses-products-prisms-sums.html) 1. http://www.philipzucker.com/lens-as-a-divisibility-relation-goofin-off-with-the-algebra-of-types/ diff --git a/lux-jvm/source/luxc/lang/directive/jvm.lux b/lux-jvm/source/luxc/lang/directive/jvm.lux index 0d258fd5a..4d5d88548 100644 --- a/lux-jvm/source/luxc/lang/directive/jvm.lux +++ b/lux-jvm/source/luxc/lang/directive/jvm.lux @@ -1,6 +1,6 @@ (.module: [lux #* - [host (#+ import:)] + [ffi (#+ import:)] [type (#+ :share)] [abstract ["." monad (#+ do)]] diff --git a/lux-jvm/source/luxc/lang/host/jvm.lux b/lux-jvm/source/luxc/lang/host/jvm.lux index c2a2a6f41..a50090c5d 100644 --- a/lux-jvm/source/luxc/lang/host/jvm.lux +++ b/lux-jvm/source/luxc/lang/host/jvm.lux @@ -1,11 +1,11 @@ (.module: [lux (#- Definition Type) - [host (#+ import:)] + [ffi (#+ import:)] [abstract monad] [control - ["p" parser - ["s" code]]] + ["<>" parser + ["<.>" code]]] [data [binary (#+ Binary)] [collection @@ -84,10 +84,10 @@ (type: #export (Generator i) (-> Phase Archive i (Operation Inst))) -(syntax: (config: {type s.local_identifier} - {none s.local_identifier} - {++ s.local_identifier} - {options (s.tuple (p.many s.local_identifier))}) +(syntax: (config: {type <code>.local_identifier} + {none <code>.local_identifier} + {++ <code>.local_identifier} + {options (<code>.tuple (<>.many <code>.local_identifier))}) (let [g!type (code.local_identifier type) g!none (code.local_identifier none) g!tags+ (list/map code.local_tag options) diff --git a/lux-jvm/source/luxc/lang/host/jvm/def.lux b/lux-jvm/source/luxc/lang/host/jvm/def.lux index 212d9d854..b2012006a 100644 --- a/lux-jvm/source/luxc/lang/host/jvm/def.lux +++ b/lux-jvm/source/luxc/lang/host/jvm/def.lux @@ -1,6 +1,6 @@ (.module: [lux (#- Type) - ["." host (#+ import: do_to)] + ["." ffi (#+ import: do_to)] [control ["." function]] [data @@ -80,9 +80,9 @@ (def: (string_array values) (-> (List Text) (Array Text)) - (let [output (host.array java/lang/String (list.size values))] + (let [output (ffi.array java/lang/String (list.size values))] (exec (list@map (function (_ [idx value]) - (host.array_write idx value output)) + (ffi.array_write idx value output)) (list.enumeration values)) output))) @@ -168,7 +168,7 @@ [(def: #export (<name> version visibility config name constraints super interfaces definitions) (-> //.Version //.Visibility //.Class_Config Text (List Constraint) (Type Class) (List (Type Class)) //.Def - (host.type [byte])) + (ffi.type [byte])) (let [writer (|> (do_to (org/objectweb/asm/ClassWriter::new class_computes) (org/objectweb/asm/ClassWriter::visit (version_flag version) ($_ i.+ @@ -197,7 +197,7 @@ (def: #export (interface version visibility config name constraints interfaces definitions) (-> //.Version //.Visibility //.Class_Config Text (List Constraint) (List (Type Class)) //.Def - (host.type [byte])) + (ffi.type [byte])) (let [writer (|> (do_to (org/objectweb/asm/ClassWriter::new class_computes) (org/objectweb/asm/ClassWriter::visit (version_flag version) ($_ i.+ @@ -258,7 +258,7 @@ (..binary_name name) (..descriptor type) (..signature type) - (host.null) + (ffi.null) writer) (org/objectweb/asm/FieldVisitor::visitEnd))] writer))) @@ -279,13 +279,13 @@ writer)))] [boolean_field Bit type.boolean function.identity] - [byte_field Int type.byte host.long_to_byte] - [short_field Int type.short host.long_to_short] - [int_field Int type.int host.long_to_int] + [byte_field Int type.byte ffi.long_to_byte] + [short_field Int type.short ffi.long_to_short] + [int_field Int type.int ffi.long_to_int] [long_field Int type.long function.identity] - [float_field Frac type.float host.double_to_float] + [float_field Frac type.float ffi.double_to_float] [double_field Frac type.double function.identity] - [char_field Nat type.char (|>> .int host.long_to_int host.int_to_char)] + [char_field Nat type.char (|>> .int ffi.long_to_int ffi.int_to_char)] [string_field Text (type.class "java.lang.String" (list)) function.identity] ) diff --git a/lux-jvm/source/luxc/lang/host/jvm/inst.lux b/lux-jvm/source/luxc/lang/host/jvm/inst.lux index 1f9e93c71..efc4a0d0c 100644 --- a/lux-jvm/source/luxc/lang/host/jvm/inst.lux +++ b/lux-jvm/source/luxc/lang/host/jvm/inst.lux @@ -1,6 +1,6 @@ (.module: [lux (#- Type int char) - ["." host (#+ import: do_to)] + ["." ffi (#+ import: do_to)] [abstract [monad (#+ do)]] [control @@ -162,13 +162,13 @@ (-> <type> Inst) (function (_ visitor) (do_to visitor - (org/objectweb/asm/MethodVisitor::visitLdcInsn (<prepare> value)))))] + (org/objectweb/asm/MethodVisitor::visitLdcInsn (<prepare> value)))))] [boolean Bit function.identity] - [int Int host.long_to_int] + [int Int ffi.long_to_int] [long Int function.identity] [double Frac function.identity] - [char Nat (|>> .int host.long_to_int host.int_to_char)] + [char Nat (|>> .int ffi.long_to_int ffi.int_to_char)] [string Text function.identity] ) @@ -180,7 +180,7 @@ Inst (function (_ visitor) (do_to visitor - (org/objectweb/asm/MethodVisitor::visitInsn (!prefix <constant>)))))] + (org/objectweb/asm/MethodVisitor::visitInsn (!prefix <constant>)))))] [ICONST_M1] [ICONST_0] [ICONST_1] [ICONST_2] [ICONST_3] [ICONST_4] [ICONST_5] [LCONST_0] [LCONST_1] @@ -192,14 +192,14 @@ Inst (function (_ visitor) (do_to visitor - (org/objectweb/asm/MethodVisitor::visitInsn (!prefix ACONST_NULL))))) + (org/objectweb/asm/MethodVisitor::visitInsn (!prefix ACONST_NULL))))) (template [<constant>] [(def: #export (<constant> constant) (-> Int Inst) (function (_ visitor) (do_to visitor - (org/objectweb/asm/MethodVisitor::visitIntInsn (!prefix <constant>) constant))))] + (org/objectweb/asm/MethodVisitor::visitIntInsn (!prefix <constant>) constant))))] [BIPUSH] [SIPUSH] @@ -210,7 +210,7 @@ Inst (function (_ visitor) (do_to visitor - (org/objectweb/asm/MethodVisitor::visitInsn (!prefix <name>)))))] + (org/objectweb/asm/MethodVisitor::visitInsn (!prefix <name>)))))] [NOP] @@ -273,7 +273,7 @@ (-> Register Inst) (function (_ visitor) (do_to visitor - (org/objectweb/asm/MethodVisitor::visitVarInsn (!prefix <name>) (.int register)))))] + (org/objectweb/asm/MethodVisitor::visitVarInsn (!prefix <name>) (.int register)))))] [IINC] [ILOAD] [LLOAD] [FLOAD] [DLOAD] [ALOAD] @@ -285,7 +285,7 @@ (-> (Type Class) Text (Type Value) Inst) (function (_ visitor) (do_to visitor - (org/objectweb/asm/MethodVisitor::visitFieldInsn (<inst>) (..class_name class) field (..descriptor type)))))] + (org/objectweb/asm/MethodVisitor::visitFieldInsn (<inst>) (..class_name class) field (..descriptor type)))))] [GETSTATIC org/objectweb/asm/Opcodes::GETSTATIC] [PUTSTATIC org/objectweb/asm/Opcodes::PUTSTATIC] @@ -300,7 +300,7 @@ (-> (Type <category>) Inst) (function (_ visitor) (do_to visitor - (org/objectweb/asm/MethodVisitor::visitTypeInsn (<inst>) (..class_name class)))))] + (org/objectweb/asm/MethodVisitor::visitTypeInsn (<inst>) (..class_name class)))))] (~~ (template.splice <instructions>+))))] @@ -317,31 +317,31 @@ (-> (Type Primitive) Inst) (function (_ visitor) (do_to visitor - (org/objectweb/asm/MethodVisitor::visitIntInsn (org/objectweb/asm/Opcodes::NEWARRAY) - (`` (cond (~~ (template [<descriptor> <opcode>] - [(type@= <descriptor> type) (<opcode>)] - - [type.boolean org/objectweb/asm/Opcodes::T_BOOLEAN] - [type.byte org/objectweb/asm/Opcodes::T_BYTE] - [type.short org/objectweb/asm/Opcodes::T_SHORT] - [type.int org/objectweb/asm/Opcodes::T_INT] - [type.long org/objectweb/asm/Opcodes::T_LONG] - [type.float org/objectweb/asm/Opcodes::T_FLOAT] - [type.double org/objectweb/asm/Opcodes::T_DOUBLE] - [type.char org/objectweb/asm/Opcodes::T_CHAR])) - ## else - (undefined))))))) + (org/objectweb/asm/MethodVisitor::visitIntInsn (org/objectweb/asm/Opcodes::NEWARRAY) + (`` (cond (~~ (template [<descriptor> <opcode>] + [(type@= <descriptor> type) (<opcode>)] + + [type.boolean org/objectweb/asm/Opcodes::T_BOOLEAN] + [type.byte org/objectweb/asm/Opcodes::T_BYTE] + [type.short org/objectweb/asm/Opcodes::T_SHORT] + [type.int org/objectweb/asm/Opcodes::T_INT] + [type.long org/objectweb/asm/Opcodes::T_LONG] + [type.float org/objectweb/asm/Opcodes::T_FLOAT] + [type.double org/objectweb/asm/Opcodes::T_DOUBLE] + [type.char org/objectweb/asm/Opcodes::T_CHAR])) + ## else + (undefined))))))) (template [<name> <inst> <interface?>] [(def: #export (<name> class method_name method) (-> (Type Class) Text (Type Method) Inst) (function (_ visitor) (do_to visitor - (org/objectweb/asm/MethodVisitor::visitMethodInsn (<inst>) - (..class_name class) - method_name - (|> method type.descriptor descriptor.descriptor) - <interface?>))))] + (org/objectweb/asm/MethodVisitor::visitMethodInsn (<inst>) + (..class_name class) + method_name + (|> method type.descriptor descriptor.descriptor) + <interface?>))))] [INVOKESTATIC org/objectweb/asm/Opcodes::INVOKESTATIC false] [INVOKEVIRTUAL org/objectweb/asm/Opcodes::INVOKEVIRTUAL false] @@ -354,7 +354,7 @@ (-> //.Label Inst) (function (_ visitor) (do_to visitor - (org/objectweb/asm/MethodVisitor::visitJumpInsn (!prefix <name>) @where))))] + (org/objectweb/asm/MethodVisitor::visitJumpInsn (!prefix <name>) @where))))] [IF_ICMPEQ] [IF_ICMPGT] [IF_ICMPLT] [IF_ICMPNE] [IF_ICMPGE] [IF_ICMPLE] @@ -370,45 +370,45 @@ (i.< (product.left left) (product.left right))) keys+labels) array_size (list.size keys+labels) - keys_array (host.array int array_size) - labels_array (host.array org/objectweb/asm/Label array_size) + keys_array (ffi.array int array_size) + labels_array (ffi.array org/objectweb/asm/Label array_size) _ (loop [idx 0] (if (n.< array_size idx) (let [[key label] (maybe.assume (list.nth idx keys+labels))] (exec - (host.array_write idx (host.long_to_int key) keys_array) - (host.array_write idx label labels_array) + (ffi.array_write idx (ffi.long_to_int key) keys_array) + (ffi.array_write idx label labels_array) (recur (inc idx)))) []))] (do_to visitor - (org/objectweb/asm/MethodVisitor::visitLookupSwitchInsn default keys_array labels_array))))) + (org/objectweb/asm/MethodVisitor::visitLookupSwitchInsn default keys_array labels_array))))) (def: #export (TABLESWITCH min max default labels) (-> Int Int //.Label (List //.Label) Inst) (function (_ visitor) (let [num_labels (list.size labels) - labels_array (host.array org/objectweb/asm/Label num_labels) + labels_array (ffi.array org/objectweb/asm/Label num_labels) _ (loop [idx 0] (if (n.< num_labels idx) - (exec (host.array_write idx - (maybe.assume (list.nth idx labels)) - labels_array) + (exec (ffi.array_write idx + (maybe.assume (list.nth idx labels)) + labels_array) (recur (inc idx))) []))] (do_to visitor - (org/objectweb/asm/MethodVisitor::visitTableSwitchInsn min max default labels_array))))) + (org/objectweb/asm/MethodVisitor::visitTableSwitchInsn min max default labels_array))))) (def: #export (try @from @to @handler exception) (-> //.Label //.Label //.Label (Type Class) Inst) (function (_ visitor) (do_to visitor - (org/objectweb/asm/MethodVisitor::visitTryCatchBlock @from @to @handler (..class_name exception))))) + (org/objectweb/asm/MethodVisitor::visitTryCatchBlock @from @to @handler (..class_name exception))))) (def: #export (label @label) (-> //.Label Inst) (function (_ visitor) (do_to visitor - (org/objectweb/asm/MethodVisitor::visitLabel @label)))) + (org/objectweb/asm/MethodVisitor::visitLabel @label)))) (def: #export (array elementT) (-> (Type Value) Inst) diff --git a/lux-jvm/source/luxc/lang/translation/jvm.lux b/lux-jvm/source/luxc/lang/translation/jvm.lux index 84eff942e..fe651adac 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm.lux @@ -1,6 +1,6 @@ (.module: [lux (#- Module Definition) - ["." host (#+ import: do_to object)] + ["." ffi (#+ import: do_to object)] [abstract [monad (#+ do)]] [control diff --git a/lux-jvm/source/luxc/lang/translation/jvm/extension/common.lux b/lux-jvm/source/luxc/lang/translation/jvm/extension/common.lux index c9eed9489..c15d1ffcf 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/extension/common.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/extension/common.lux @@ -1,5 +1,6 @@ (.module: [lux (#- Type) + [ffi (#+ import:)] [abstract ["." monad (#+ do)]] [control @@ -30,8 +31,7 @@ [extension (#+ Nullary Unary Binary Trinary Variadic nullary unary binary trinary variadic)]] ["." extension - ["." bundle]]]]]]] - [host (#+ import:)]] + ["." bundle]]]]]]]] [luxc [lang [host diff --git a/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux b/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux index c3c522bfa..dc579c970 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux @@ -1,6 +1,6 @@ (.module: [lux (#- Type primitive int char type) - [host (#+ import:)] + [ffi (#+ import:)] [abstract ["." monad (#+ do)]] [control @@ -1048,7 +1048,7 @@ (..with_anonymous_init class total_environment super_class inputsTI) method_definitions))]] _ (generation.execute! directive) - _ (generation.save! (%.nat artifact_id) directive)] + _ (generation.save! artifact_id directive)] (..anonymous_instance generate archive class total_environment)))])) (def: bundle::class diff --git a/lux-jvm/source/luxc/lang/translation/jvm/function.lux b/lux-jvm/source/luxc/lang/translation/jvm/function.lux index 6c03bd482..0b441c92f 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/function.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/function.lux @@ -316,7 +316,7 @@ //.$Function (list) functionD)]] _ (generation.execute! directive) - _ (generation.save! (%.nat (product.right function_context)) directive)] + _ (generation.save! (product.right function_context) directive)] (wrap instanceI))) (def: #export (call generate archive [functionS argsS]) diff --git a/lux-jvm/source/luxc/lang/translation/jvm/primitive.lux b/lux-jvm/source/luxc/lang/translation/jvm/primitive.lux index b42f63c4d..3383e3856 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/primitive.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/primitive.lux @@ -1,6 +1,6 @@ (.module: [lux (#- i64) - ["." host (#+ import:)] + ["." ffi (#+ import:)] [math [number ["i" int]]] diff --git a/lux-jvm/source/luxc/lang/translation/jvm/runtime.lux b/lux-jvm/source/luxc/lang/translation/jvm/runtime.lux index 782187339..95cfd9e5a 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/runtime.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/runtime.lux @@ -20,7 +20,7 @@ ["." category (#+ Void Value' Value Return' Return Primitive Object Class Array Var Parameter Method)] ["." reflection]]]] [tool - [compiler (#+ Output) + [compiler [arity (#+ Arity)] ["." phase] [language @@ -28,7 +28,7 @@ ["." synthesis] ["." generation]]] [meta - [archive + [archive (#+ Output) ["." artifact (#+ Registry)]]]]]] [luxc [lang @@ -334,8 +334,11 @@ (-> (Type (<| Return' Value' category)) Text)) (|>> type.reflection reflection.reflection)) +(def: runtime_id + 0) + (def: translate_runtime - (Operation [Text Binary]) + (Operation [artifact.ID Binary]) (let [runtime_class (..reflection //.$Runtime) bytecode ($d.class #$.V1_6 #$.Public $.finalC runtime_class (list) (type.class "java.lang.Object" (list)) (list) (|>> adt_methods @@ -345,11 +348,14 @@ directive [runtime_class bytecode]] (do phase.monad [_ (generation.execute! directive) - _ (generation.save! "0" directive)] - (wrap ["0" bytecode])))) + _ (generation.save! ..runtime_id directive)] + (wrap [..runtime_id bytecode])))) + +(def: function_id + 1) (def: translate_function - (Operation [Text Binary]) + (Operation [artifact.ID Binary]) (let [applyI (|> (enum.range n.enum 2 num_apply_variants) (list@map (function (_ arity) ($d.method #$.Public $.noneM apply_method (apply_signature arity) @@ -379,8 +385,8 @@ directive [function_class bytecode]] (do phase.monad [_ (generation.execute! directive) - _ (generation.save! "1" directive)] - (wrap ["1" bytecode])))) + _ (generation.save! ..function_id directive)] + (wrap [..function_id bytecode])))) (def: #export translate (Operation [Registry Output]) diff --git a/lux-jvm/source/luxc/lang/translation/jvm/structure.lux b/lux-jvm/source/luxc/lang/translation/jvm/structure.lux index b3daed102..100bce9d9 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/structure.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/structure.lux @@ -1,6 +1,6 @@ (.module: [lux (#- Type) - ["." host (#+ import:)] + ["." ffi (#+ import:)] [abstract ["." monad (#+ do)]] [control diff --git a/lux-jvm/source/program.lux b/lux-jvm/source/program.lux index f6a921e86..baa76ac31 100644 --- a/lux-jvm/source/program.lux +++ b/lux-jvm/source/program.lux @@ -159,22 +159,26 @@ (promise.future (\ world/program.default exit +0))) (program: [{service /cli.service}] - (exec (do promise.monad - [_ (/.compiler {#/static.host @.jvm - #/static.host_module_extension ".jvm" - #/static.target (/cli.target service) - #/static.artifact_extension ".class"} - ..expander - analysis.bundle - ..platform - ## generation.bundle - translation.bundle - (directive.bundle ..extender) - (jvm/program.program jvm/runtime.class_name) - [_.Anchor _.Inst _.Definition] - ..extender - service - [packager.package - (format (/cli.target service) (\ file.default separator) "program.jar")])] - (..declare_success! [])) - (io.io []))) + (let [static {#/static.host @.jvm + #/static.host_module_extension ".jvm" + #/static.target (/cli.target service) + #/static.artifact_extension ".class"}] + (exec (do promise.monad + [_ (/.compiler {#/static.host @.jvm + #/static.host_module_extension ".jvm" + #/static.target (/cli.target service) + #/static.artifact_extension ".class"} + ..expander + analysis.bundle + ..platform + ## generation.bundle + translation.bundle + (directive.bundle ..extender) + (jvm/program.program jvm/runtime.class_name) + [_.Anchor _.Inst _.Definition] + ..extender + service + [(packager.package static) + (format (/cli.target service) (\ file.default separator) "program.jar")])] + (..declare_success! [])) + (io.io [])))) diff --git a/stdlib/source/lux/target/jvm/type/parser.lux b/stdlib/source/lux/target/jvm/type/parser.lux index d54c1c504..56e992082 100644 --- a/stdlib/source/lux/target/jvm/type/parser.lux +++ b/stdlib/source/lux/target/jvm/type/parser.lux @@ -61,10 +61,7 @@ (format var/head "0123456789$")) -(def: class/head - (format var/head //name.internal_separator)) - -(def: class/tail +(def: class/set (format var/tail //name.internal_separator)) (template [<type> <name> <head> <tail> <adapter>] @@ -74,7 +71,7 @@ (<t>.slice (<t>.and! (<t>.one_of! <head>) (<t>.some! (<t>.one_of! <tail>))))))] - [External class_name class/head class/tail (|>> //name.internal //name.external)] + [External class_name class/set class/set (|>> //name.internal //name.external)] [Text var_name var/head var/tail function.identity] ) diff --git a/stdlib/source/lux/time.lux b/stdlib/source/lux/time.lux index a1675dc17..fe08164d0 100644 --- a/stdlib/source/lux/time.lux +++ b/stdlib/source/lux/time.lux @@ -81,7 +81,7 @@ {#.doc "Time is defined as milliseconds since the start of the day (00:00:00.000)."} - (def: #export start + (def: #export midnight {#.doc "The instant corresponding to the start of the day: 00:00:00.000"} Time (:abstraction 0)) diff --git a/stdlib/source/lux/time/date.lux b/stdlib/source/lux/time/date.lux index 48e4e7d41..872f91f13 100644 --- a/stdlib/source/lux/time/date.lux +++ b/stdlib/source/lux/time/date.lux @@ -80,6 +80,12 @@ #day day})) (exception.throw ..invalid_day [year month day]))) + (def: #export epoch + Date + (try.assume (..date //year.epoch + #//month.January + ..minimum_day))) + (template [<name> <type> <field>] [(def: #export <name> (-> Date <type>) diff --git a/stdlib/source/lux/time/instant.lux b/stdlib/source/lux/time/instant.lux index 25df6407c..78dcadde1 100644 --- a/stdlib/source/lux/time/instant.lux +++ b/stdlib/source/lux/time/instant.lux @@ -155,6 +155,7 @@ (IO Instant) (io (..from_millis (for {@.old ("jvm invokestatic:java.lang.System:currentTimeMillis:") @.jvm (|> ("jvm member invoke static" [] "java.lang.System" "currentTimeMillis" []) + ("jvm object cast") (: (primitive "java.lang.Long")) (:coerce Int)) @.js (let [date ("js object new" ("js constant" "Date") [])] diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/function/abstract.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/function/abstract.lux index 419fca601..0b4885180 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/function/abstract.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/function/abstract.lux @@ -1,5 +1,8 @@ (.module: [lux (#- Type) + [data + [text + ["%" format]]] [target [jvm ["." type (#+ Type) @@ -9,7 +12,11 @@ [constant ["." arity]]]]) -(def: #export class (type.class "LuxFunction" (list))) +(def: #export artifact_id + 1) + +(def: #export class + (type.class (%.nat artifact_id) (list))) (def: #export init (Type Method) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux index 011734cc8..ec3080fc2 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux @@ -88,7 +88,11 @@ "/" (%.nat module) "/" (%.nat id))) -(def: #export class (type.class "LuxRuntime" (list))) +(def: artifact_id + 0) + +(def: #export class + (type.class (%.nat ..artifact_id) (list))) (def: procedure (-> Text (Type category.Method) (Bytecode Any)) @@ -532,7 +536,7 @@ (row.row)))] (do ////.monad [_ (generation.execute! [class bytecode])] - (generation.save! class [class bytecode])))) + (generation.save! ..artifact_id [class bytecode])))) (def: generate_function (Operation Any) @@ -589,7 +593,7 @@ (row.row)))] (do ////.monad [_ (generation.execute! [class bytecode])] - (generation.save! class [class bytecode])))) + (generation.save! //function.artifact_id [class bytecode])))) (def: #export generate (Operation Any) diff --git a/stdlib/source/lux/tool/compiler/meta/packager/jvm.lux b/stdlib/source/lux/tool/compiler/meta/packager/jvm.lux index 15552a656..1df76453c 100644 --- a/stdlib/source/lux/tool/compiler/meta/packager/jvm.lux +++ b/stdlib/source/lux/tool/compiler/meta/packager/jvm.lux @@ -15,8 +15,8 @@ ["." text ["%" format (#+ format)]] [collection - ["." row (#+ Row)] - ["." list ("#\." functor)]]] + ["." row (#+ Row) ("#\." fold)] + ["." list ("#\." functor fold)]]] [math [number ["n" nat]]] @@ -31,9 +31,11 @@ ["." static (#+ Static)]]] ["." // (#+ Packager) [// - ["." archive + ["." archive (#+ Output) ["." descriptor (#+ Module)] ["." artifact]] + [cache + ["." dependency]] ["." io #_ ["#" archive]] [// @@ -106,64 +108,41 @@ (-> Context java/util/jar/Manifest) (let [manifest (java/util/jar/Manifest::new)] (exec (do_to (java/util/jar/Manifest::getMainAttributes manifest) - (java/util/jar/Attributes::put (java/util/jar/Attributes$Name::MAIN_CLASS) (|> program runtime.class_name name.internal name.external)) - (java/util/jar/Attributes::put (java/util/jar/Attributes$Name::MANIFEST_VERSION) ..manifest_version)) + (java/util/jar/Attributes::put (java/util/jar/Attributes$Name::MAIN_CLASS) (|> program runtime.class_name name.internal name.external)) + (java/util/jar/Attributes::put (java/util/jar/Attributes$Name::MANIFEST_VERSION) ..manifest_version)) manifest))) -## TODO: Delete ASAP -(type: (Action ! a) - (! (Try a))) - -(def: (write_class monad file_system static context sink) - (All [!] - (-> (Monad !) (file.System !) Static Context java/util/jar/JarOutputStream - (Action ! java/util/jar/JarOutputStream))) - (do (try.with monad) - [artifact (let [[module artifact] context] - (!.use (\ file_system file) [(io.artifact file_system static module (%.nat artifact))])) - content (!.use (\ artifact content) []) - #let [class_path (format (runtime.class_name context) (get@ #static.artifact_extension static))]] - (wrap (do_to sink - (java/util/jar/JarOutputStream::putNextEntry (java/util/jar/JarEntry::new class_path)) - (java/util/zip/ZipOutputStream::write content +0 (.int (binary.size content))) +(def: (write_class static module artifact content sink) + (-> Static archive.ID artifact.ID Binary java/util/jar/JarOutputStream + java/util/jar/JarOutputStream) + (let [class_path (format (runtime.class_name [module artifact]) + (get@ #static.artifact_extension static))] + (do_to sink + (java/util/jar/JarOutputStream::putNextEntry (java/util/jar/JarEntry::new class_path)) + (java/util/zip/ZipOutputStream::write content +0 (.int (binary.size content))) + (java/io/Flushable::flush) + (java/util/zip/ZipOutputStream::closeEntry)))) + +(def: (write_module static [module output] sink) + (-> Static [archive.ID Output] java/util/jar/JarOutputStream + java/util/jar/JarOutputStream) + (row\fold (function (_ [artifact content] sink) + (..write_class static module artifact content sink)) + sink + output)) + +(def: #export (package static) + (-> Static Packager) + (function (_ archive program) + (do {! try.monad} + [order (dependency.load_order $.key archive) + #let [buffer (java/io/ByteArrayOutputStream::new (.int ..mebi_byte)) + sink (|> order + (list\map (function (_ [module [module_id [descriptor document output]]]) + [module_id output])) + (list\fold (..write_module static) + (java/util/jar/JarOutputStream::new buffer (..manifest program)))) + _ (do_to sink (java/io/Flushable::flush) - (java/util/zip/ZipOutputStream::closeEntry))))) - -(def: (write_module monad file_system static [module artifacts] sink) - (All [!] - (-> (Monad !) (file.System !) Static [archive.ID (List artifact.ID)] java/util/jar/JarOutputStream - (Action ! java/util/jar/JarOutputStream))) - (monad.fold (:assume (try.with monad)) - (function (_ artifact sink) - (..write_class monad file_system static [module artifact] sink)) - sink - artifacts)) - -(def: #export (package monad file_system static archive program) - (All [!] (Packager !)) - (do {! (try.with monad)} - [cache (:share [!] - {(Monad !) - monad} - {(! (Try (Directory !))) - (:assume (!.use (\ file_system directory) [(get@ #static.target static)]))}) - order (|> archive - archive.archived - (monad.map try.monad (function (_ module) - (do try.monad - [[descriptor document] (archive.find module archive) - module_id (archive.id module archive)] - (wrap (|> descriptor - (get@ #descriptor.registry) - artifact.artifacts - row.to_list - (list\map (|>> (get@ #artifact.id))) - [module_id]))))) - (\ monad wrap)) - #let [buffer (java/io/ByteArrayOutputStream::new (.int ..mebi_byte)) - sink (java/util/jar/JarOutputStream::new buffer (..manifest program))] - sink (monad.fold ! (..write_module monad file_system static) sink order) - #let [_ (do_to sink - (java/io/Flushable::flush) - (java/io/Closeable::close))]] - (wrap (java/io/ByteArrayOutputStream::toByteArray buffer)))) + (java/io/Closeable::close))]] + (wrap (java/io/ByteArrayOutputStream::toByteArray buffer))))) diff --git a/stdlib/source/lux/type/variance.lux b/stdlib/source/lux/type/variance.lux index 4ffe94780..863824e59 100644 --- a/stdlib/source/lux/type/variance.lux +++ b/stdlib/source/lux/type/variance.lux @@ -1,11 +1,11 @@ (.module: [lux #*]) -(type: #export (CoV t) +(type: #export (Co t) (-> Any t)) -(type: #export (ContraV t) +(type: #export (Contra t) (-> t Any)) -(type: #export (InV t) +(type: #export (In t) (-> t t)) diff --git a/stdlib/source/program/aedifex/artifact/snapshot/stamp.lux b/stdlib/source/program/aedifex/artifact/snapshot/stamp.lux index ca59b11a6..f321e11c1 100644 --- a/stdlib/source/program/aedifex/artifact/snapshot/stamp.lux +++ b/stdlib/source/program/aedifex/artifact/snapshot/stamp.lux @@ -42,11 +42,6 @@ (list (..time_format time) (//build.format build))) -## (exception: #export (mismatch {expected Instant} {actual Instant}) -## (exception.report -## ["Expected" (%.instant expected)] -## ["Actual" (%.instant actual)])) - (def: time_parser (Parser Time) (do <>.monad diff --git a/stdlib/source/program/aedifex/artifact/snapshot/time.lux b/stdlib/source/program/aedifex/artifact/snapshot/time.lux index ea9bf3047..e0cb8c112 100644 --- a/stdlib/source/program/aedifex/artifact/snapshot/time.lux +++ b/stdlib/source/program/aedifex/artifact/snapshot/time.lux @@ -16,30 +16,30 @@ [time ["." instant (#+ Instant)]]] ["." /// #_ - [time - ["#." date] - ["#." time]]]) + ["#." time + ["#/." date] + ["#/." time]]]) (type: #export Time - Instant) + ///time.Time) (def: #export equivalence (Equivalence Time) - instant.equivalence) + ///time.equivalence) (def: separator ".") -(def: #export (format value) +(def: #export (format [date time]) (%.Format Time) - (%.format (///date.format (instant.date value)) + (%.format (///time/date.format date) ..separator - (///time.format (instant.time value)))) + (///time/time.format time))) (def: #export parser (<text>.Parser Time) (do <>.monad - [date ///date.parser + [date ///time/date.parser _ (<text>.this ..separator) - time ///time.parser] - (wrap (instant.from_date_time date time)))) + time ///time/time.parser] + (wrap [date time]))) diff --git a/stdlib/source/program/aedifex/artifact/time.lux b/stdlib/source/program/aedifex/artifact/time.lux index 19eb417a5..59367c37d 100644 --- a/stdlib/source/program/aedifex/artifact/time.lux +++ b/stdlib/source/program/aedifex/artifact/time.lux @@ -1,5 +1,6 @@ (.module: [lux #* + ["." time] [abstract [equivalence (#+ Equivalence)] [monad (#+ do)]] @@ -7,29 +8,33 @@ ["<>" parser ["<.>" text (#+ Parser)]]] [data + ["." product] [text - ["%" format (#+ Format)]]] - [time - ["." instant (#+ Instant)]]] + ["%" format (#+ Format)]]]] ["." / #_ ["#." date] ["#." time]]) (type: #export Time - Instant) + [/date.Date /time.Time]) + +(def: #export epoch + Time + [/date.epoch time.midnight]) (def: #export equivalence (Equivalence Time) - instant.equivalence) + (product.equivalence /date.equivalence + time.equivalence)) -(def: #export (format value) +(def: #export (format [date time]) (Format Time) - (%.format (/date.format (instant.date value)) - (/time.format (instant.time value)))) + (%.format (/date.format date) + (/time.format time))) (def: #export parser (Parser Time) (do <>.monad [date /date.parser time /time.parser] - (wrap (instant.from_date_time date time)))) + (wrap [date time]))) diff --git a/stdlib/source/program/aedifex/artifact/time/date.lux b/stdlib/source/program/aedifex/artifact/time/date.lux index 18df2900b..989abb5fc 100644 --- a/stdlib/source/program/aedifex/artifact/time/date.lux +++ b/stdlib/source/program/aedifex/artifact/time/date.lux @@ -1,8 +1,11 @@ (.module: [lux #* [abstract - [monad (#+ do)]] + [monad (#+ do)] + [equivalence (#+ Equivalence)]] [control + ["." try (#+ Try)] + ["." exception (#+ exception:)] ["<>" parser ["<.>" text (#+ Parser)]]] [data @@ -10,11 +13,14 @@ ["%" format]]] [math [number - ["n" nat]]] + ["n" nat] + ["i" int]]] [time - ["." date (#+ Date)] + ["." date ("#\." equivalence)] ["." year] - ["." month]]]) + ["." month]] + [type + abstract]]) (def: #export (pad value) (-> Nat Text) @@ -22,18 +28,54 @@ (%.format "0" (%.nat value)) (%.nat value))) -(def: #export (format value) - (%.Format Date) - (%.format (|> value date.year year.value .nat %.nat) - (|> value date.month month.number ..pad) - (|> value date.day_of_month ..pad))) - -(def: #export parser - (Parser Date) - (do <>.monad - [year (<>.codec n.decimal (<text>.exactly 4 <text>.decimal)) - year (<>.lift (year.year (.int year))) - month (<>.codec n.decimal (<text>.exactly 2 <text>.decimal)) - month (<>.lift (month.by_number month)) - day_of_month (<>.codec n.decimal (<text>.exactly 2 <text>.decimal))] - (<>.lift (date.date year month day_of_month)))) +(def: min_year +1,000) +(def: max_year +9,999) + +(exception: #export (year_is_out_of_range {year year.Year}) + (exception.report + ["Minimum" (%.int ..min_year)] + ["Maximum" (%.int ..max_year)] + ["Year" (%.int (year.value year))])) + +(abstract: #export Date + date.Date + + (def: #export epoch + Date + (:abstraction date.epoch)) + + (def: #export (date raw) + (-> date.Date (Try Date)) + (let [year (|> raw date.year year.value)] + (if (and (i.>= ..min_year year) + (i.<= ..max_year year)) + (#try.Success (:abstraction raw)) + (exception.throw ..year_is_out_of_range [(date.year raw)])))) + + (def: #export value + (-> Date date.Date) + (|>> :representation)) + + (structure: #export equivalence + (Equivalence Date) + + (def: (= reference subject) + (date\= (:representation reference) + (:representation subject)))) + + (def: #export (format value) + (%.Format Date) + (%.format (|> value :representation date.year year.value .nat %.nat) + (|> value :representation date.month month.number ..pad) + (|> value :representation date.day_of_month ..pad))) + + (def: #export parser + (Parser Date) + (do <>.monad + [year (<>.codec n.decimal (<text>.exactly 4 <text>.decimal)) + year (<>.lift (year.year (.int year))) + month (<>.codec n.decimal (<text>.exactly 2 <text>.decimal)) + month (<>.lift (month.by_number month)) + day_of_month (<>.codec n.decimal (<text>.exactly 2 <text>.decimal)) + date (<>.lift (date.date year month day_of_month))] + (wrap (:abstraction date))))) diff --git a/stdlib/source/program/aedifex/artifact/versioning.lux b/stdlib/source/program/aedifex/artifact/versioning.lux index dab943145..a16d92796 100644 --- a/stdlib/source/program/aedifex/artifact/versioning.lux +++ b/stdlib/source/program/aedifex/artifact/versioning.lux @@ -21,7 +21,6 @@ [number ["n" nat]]] ["." time (#+ Time) - ["." instant (#+ Instant)] ["." date (#+ Date)] ["." year] ["." month]]] @@ -32,19 +31,19 @@ (type: #export Versioning {#snapshot Snapshot - #last_updated Instant + #last_updated //time.Time #versions (List Version)}) (def: #export init {#snapshot #//snapshot.Local - #last_updated instant.epoch + #last_updated //time.epoch #versions (list)}) (def: #export equivalence (Equivalence Versioning) ($_ product.equivalence //snapshot.equivalence - instant.equivalence + //time.equivalence (list.equivalence //snapshot/version.equivalence) )) @@ -58,7 +57,7 @@ ) (def: format_last_updated - (-> Instant XML) + (-> //time.Time XML) (|>> //time.format #xml.Text list (#xml.Node ..<last_updated> xml.attributes))) (def: #export (format (^slots [#snapshot #last_updated #versions])) @@ -81,7 +80,7 @@ (..sub tag <xml>.text)) (def: last_updated_parser - (Parser Instant) + (Parser //time.Time) (<text>.embed //time.parser (..text ..<last_updated>))) @@ -90,7 +89,7 @@ (<| (..sub ..<versioning>) ($_ <>.and (<>.default #//snapshot.Local (<xml>.somewhere //snapshot.parser)) - (<>.default instant.epoch (<xml>.somewhere ..last_updated_parser)) + (<>.default //time.epoch (<xml>.somewhere ..last_updated_parser)) (<| (<>.default (list)) <xml>.somewhere (..sub ..<snapshot_versions>) diff --git a/stdlib/source/test/aedifex/artifact.lux b/stdlib/source/test/aedifex/artifact.lux index 9d2cf9069..935d835bb 100644 --- a/stdlib/source/test/aedifex/artifact.lux +++ b/stdlib/source/test/aedifex/artifact.lux @@ -19,11 +19,11 @@ [net ["." uri]]]] ["." / #_ - ["#." type] ["#." extension] + ["#." snapshot] ["#." time] - ["#." versioning] - ["#." snapshot]] + ["#." type] + ["#." versioning]] {#program ["." /]}) @@ -43,9 +43,9 @@ (_.for [/.equivalence] ($equivalence.spec /.equivalence ..random)) - /type.test /extension.test + /snapshot.test /time.test + /type.test /versioning.test - /snapshot.test )))) diff --git a/stdlib/source/test/aedifex/artifact/snapshot.lux b/stdlib/source/test/aedifex/artifact/snapshot.lux index 192978ebf..d48c8f34e 100644 --- a/stdlib/source/test/aedifex/artifact/snapshot.lux +++ b/stdlib/source/test/aedifex/artifact/snapshot.lux @@ -14,10 +14,9 @@ ["." random (#+ Random) ("#\." monad)]]] ["$." / #_ ["#." build] - ["#." time] ["#." stamp] - ["#." version - ["#/." value]]] + ["#." time] + ["#." version]] {#program ["." /]}) @@ -45,8 +44,7 @@ (try.default false)))) $/build.test - $/time.test $/stamp.test + $/time.test $/version.test - $/version/value.test )))) diff --git a/stdlib/source/test/aedifex/artifact/snapshot/stamp.lux b/stdlib/source/test/aedifex/artifact/snapshot/stamp.lux index a36e5af9d..f2051d037 100644 --- a/stdlib/source/test/aedifex/artifact/snapshot/stamp.lux +++ b/stdlib/source/test/aedifex/artifact/snapshot/stamp.lux @@ -37,12 +37,10 @@ (do random.monad [expected ..random] - ($_ _.and - (_.cover [/.format /.parser] - (|> expected - /.format - (<xml>.run /.parser) - (try\map (\ /.equivalence = expected)) - (try.default false))) - )) + (_.cover [/.format /.parser] + (|> expected + /.format + (<xml>.run /.parser) + (try\map (\ /.equivalence = expected)) + (try.default false)))) ))) diff --git a/stdlib/source/test/aedifex/artifact/snapshot/time.lux b/stdlib/source/test/aedifex/artifact/snapshot/time.lux index 567c70ce4..3acb37232 100644 --- a/stdlib/source/test/aedifex/artifact/snapshot/time.lux +++ b/stdlib/source/test/aedifex/artifact/snapshot/time.lux @@ -11,15 +11,15 @@ [parser ["<.>" text]]] [math - ["." random (#+ Random)]] - [time - ["." instant]]] + ["." random (#+ Random)]]] {#program - ["." /]}) + ["." /]} + ["$." /// #_ + ["#." time]]) (def: #export random (Random /.Time) - random.instant) + $///time.random) (def: #export test Test @@ -36,7 +36,7 @@ (|> expected /.format (<text>.run /.parser) - (try\map (\ instant.equivalence = expected)) + (try\map (\ /.equivalence = expected)) (try.default false))) )) ))) diff --git a/stdlib/source/test/aedifex/artifact/snapshot/version.lux b/stdlib/source/test/aedifex/artifact/snapshot/version.lux index e08691c3c..59ed7189f 100644 --- a/stdlib/source/test/aedifex/artifact/snapshot/version.lux +++ b/stdlib/source/test/aedifex/artifact/snapshot/version.lux @@ -14,6 +14,8 @@ ["." random (#+ Random)]]] {#program ["." /]} + ["." / #_ + ["#." value]] ["$." /// #_ ["#." type] ["#." time]]) @@ -43,4 +45,6 @@ (<xml>.run /.parser) (try\map (\ /.equivalence = expected)) (try.default false)))) + + /value.test ))) diff --git a/stdlib/source/test/aedifex/artifact/time.lux b/stdlib/source/test/aedifex/artifact/time.lux index b14032a8c..b9b0ab4e0 100644 --- a/stdlib/source/test/aedifex/artifact/time.lux +++ b/stdlib/source/test/aedifex/artifact/time.lux @@ -13,9 +13,7 @@ [math ["." random (#+ Random)] [number - ["i" int]]] - [time - ["." instant]]] + ["i" int]]]] {#program ["." /]} ["." / #_ @@ -27,7 +25,7 @@ (do random.monad [date /date.random time /time.random] - (wrap (instant.from_date_time date time)))) + (wrap [date time]))) (def: #export test Test @@ -43,7 +41,7 @@ (|> expected /.format (<text>.run /.parser) - (try\map (\ instant.equivalence = expected)) + (try\map (\ /.equivalence = expected)) (try.default false)))) /date.test diff --git a/stdlib/source/test/aedifex/artifact/time/date.lux b/stdlib/source/test/aedifex/artifact/time/date.lux index 932d1698e..a68a60a56 100644 --- a/stdlib/source/test/aedifex/artifact/time/date.lux +++ b/stdlib/source/test/aedifex/artifact/time/date.lux @@ -13,25 +13,27 @@ ["n" nat] ["i" int]]] [time - ["." date (#+ Date)] + ["." date] ["." year]]] {#program ["." /]}) (def: #export random - (Random Date) + (Random /.Date) (random.one (function (_ raw) (try.to_maybe (do try.monad - [year (|> raw date.year year.value i.abs (i.% +9,000) (i.+ +1,000) year.year)] - (date.date year - (date.month raw) - (date.day_of_month raw))))) + [year (|> raw date.year year.value i.abs (i.% +9,000) (i.+ +1,000) year.year) + raw (date.date year + (date.month raw) + (date.day_of_month raw))] + (/.date raw)))) random.date)) (def: #export test Test (<| (_.covering /._) + (_.for [/.Date]) ($_ _.and (do random.monad [expected ..random] @@ -39,6 +41,6 @@ (|> expected /.format (<text>.run /.parser) - (try\map (\ date.equivalence = expected)) + (try\map (\ /.equivalence = expected)) (try.default false)))) ))) diff --git a/stdlib/source/test/aedifex/artifact/versioning.lux b/stdlib/source/test/aedifex/artifact/versioning.lux index ab0e94236..c438caca5 100644 --- a/stdlib/source/test/aedifex/artifact/versioning.lux +++ b/stdlib/source/test/aedifex/artifact/versioning.lux @@ -15,6 +15,7 @@ {#program ["." /]} ["$." // #_ + ["#." time] ["#." snapshot ["#/." version]]]) @@ -22,7 +23,7 @@ (Random /.Versioning) ($_ random.and $//snapshot.random - random.instant + $//time.random (random.list 5 $//snapshot/version.random) )) diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux index d305c19c9..ad63d30cb 100644 --- a/stdlib/source/test/lux.lux +++ b/stdlib/source/test/lux.lux @@ -7,6 +7,7 @@ [program (#+ program:)] ["_" test (#+ Test)] ["@" target] + ["." debug] [abstract [monad (#+ do)] [predicate (#+ Predicate)]] diff --git a/stdlib/source/test/lux/type.lux b/stdlib/source/test/lux/type.lux index 654aeb748..b881aec70 100644 --- a/stdlib/source/test/lux/type.lux +++ b/stdlib/source/test/lux/type.lux @@ -24,7 +24,8 @@ ["#." quotient] ["#." refinement] ["#." resource] - ["#." unit]]) + ["#." unit] + ["#." variance]]) (def: short (Random Text) @@ -178,4 +179,5 @@ /refinement.test /resource.test /unit.test + /variance.test ))) diff --git a/stdlib/source/test/lux/type/variance.lux b/stdlib/source/test/lux/type/variance.lux new file mode 100644 index 000000000..83927d03c --- /dev/null +++ b/stdlib/source/test/lux/type/variance.lux @@ -0,0 +1,34 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)]] + [math + ["." random (#+ Random)]]] + {1 + ["." / + ["/#" // #_ + ["#." check]]]}) + +(type: Super + (Ex [sub] [Text sub])) + +(type: Sub + (Super Bit)) + +(def: #export test + Test + (<| (_.covering /._) + ($_ _.and + (_.cover [/.Co] + (and (//check.checks? (type (/.Co Super)) (type (/.Co Sub))) + (not (//check.checks? (type (/.Co Sub)) (type (/.Co Super)))))) + (_.cover [/.Contra] + (and (//check.checks? (type (/.Contra Sub)) (type (/.Contra Super))) + (not (//check.checks? (type (/.Contra Super)) (type (/.Contra Sub)))))) + (_.cover [/.In] + (and (//check.checks? (type (/.In Super)) (type (/.In Super))) + (//check.checks? (type (/.In Sub)) (type (/.In Sub))) + (not (//check.checks? (type (/.In Sub)) (type (/.In Super)))) + (not (//check.checks? (type (/.In Super)) (type (/.In Sub)))))) + ))) |