diff options
| author | Eduardo Julian | 2020-12-29 00:38:21 -0400 |
|---|---|---|
| committer | Eduardo Julian | 2020-12-29 00:38:21 -0400 |
| commit | 832a9361b632331e82a64c07baa560487ca8abde (patch) | |
| tree | 5fec882399315def4d789ecef1746d90e761df93 | |
| parent | 92dca9f487c625d27f6c291784ef709b0cc13a72 (diff) | |
Moved "lux/data/number" to "lux/math/number".
337 files changed, 5129 insertions, 4879 deletions
diff --git a/lux-jvm/source/luxc/lang/directive/jvm.lux b/lux-jvm/source/luxc/lang/directive/jvm.lux index 8f1fab5e2..f73182c03 100644 --- a/lux-jvm/source/luxc/lang/directive/jvm.lux +++ b/lux-jvm/source/luxc/lang/directive/jvm.lux @@ -82,8 +82,8 @@ (..literal literal) )) -(def: (int-arithmetic instruction) - (-> /.Int-Arithmetic Inst) +(def: (int_arithmetic instruction) + (-> /.Int_Arithmetic Inst) (case instruction #/.IADD _.IADD #/.ISUB _.ISUB @@ -92,8 +92,8 @@ #/.IREM _.IREM #/.INEG _.INEG)) -(def: (long-arithmetic instruction) - (-> /.Long-Arithmetic Inst) +(def: (long_arithmetic instruction) + (-> /.Long_Arithmetic Inst) (case instruction #/.LADD _.LADD #/.LSUB _.LSUB @@ -102,8 +102,8 @@ #/.LREM _.LREM #/.LNEG _.LNEG)) -(def: (float-arithmetic instruction) - (-> /.Float-Arithmetic Inst) +(def: (float_arithmetic instruction) + (-> /.Float_Arithmetic Inst) (case instruction #/.FADD _.FADD #/.FSUB _.FSUB @@ -112,8 +112,8 @@ #/.FREM _.FREM #/.FNEG _.FNEG)) -(def: (double-arithmetic instruction) - (-> /.Double-Arithmetic Inst) +(def: (double_arithmetic instruction) + (-> /.Double_Arithmetic Inst) (case instruction #/.DADD _.DADD #/.DSUB _.DSUB @@ -125,20 +125,20 @@ (def: (arithmetic instruction) (-> /.Arithmetic Inst) (case instruction - (#/.Int-Arithmetic int-arithmetic) - (..int-arithmetic int-arithmetic) + (#/.Int_Arithmetic int_arithmetic) + (..int_arithmetic int_arithmetic) - (#/.Long-Arithmetic long-arithmetic) - (..long-arithmetic long-arithmetic) + (#/.Long_Arithmetic long_arithmetic) + (..long_arithmetic long_arithmetic) - (#/.Float-Arithmetic float-arithmetic) - (..float-arithmetic float-arithmetic) + (#/.Float_Arithmetic float_arithmetic) + (..float_arithmetic float_arithmetic) - (#/.Double-Arithmetic double-arithmetic) - (..double-arithmetic double-arithmetic))) + (#/.Double_Arithmetic double_arithmetic) + (..double_arithmetic double_arithmetic))) -(def: (int-bitwise instruction) - (-> /.Int-Bitwise Inst) +(def: (int_bitwise instruction) + (-> /.Int_Bitwise Inst) (case instruction #/.IOR _.IOR #/.IXOR _.IXOR @@ -147,8 +147,8 @@ #/.ISHR _.ISHR #/.IUSHR _.IUSHR)) -(def: (long-bitwise instruction) - (-> /.Long-Bitwise Inst) +(def: (long_bitwise instruction) + (-> /.Long_Bitwise Inst) (case instruction #/.LOR _.LOR #/.LXOR _.LXOR @@ -160,11 +160,11 @@ (def: (bitwise instruction) (-> /.Bitwise Inst) (case instruction - (#/.Int-Bitwise int-bitwise) - (..int-bitwise int-bitwise) + (#/.Int_Bitwise int_bitwise) + (..int_bitwise int_bitwise) - (#/.Long-Bitwise long-bitwise) - (..long-bitwise long-bitwise))) + (#/.Long_Bitwise long_bitwise) + (..long_bitwise long_bitwise))) (def: (conversion instruction) (-> /.Conversion Inst) @@ -224,8 +224,8 @@ (-> /.Object Inst) (case instruction (^template [<tag> <inst>] - [(<tag> class field-name field-type) - (<inst> class field-name field-type)]) + [(<tag> class field_name field_type) + (<inst> class field_name field_type)]) ([#/.GETSTATIC _.GETSTATIC] [#/.PUTSTATIC _.PUTSTATIC] [#/.GETFIELD _.GETFIELD] @@ -237,40 +237,40 @@ (#/.CHECKCAST type) (_.CHECKCAST type) (^template [<tag> <inst>] - [(<tag> class method-name method-type) - (<inst> class method-name method-type)]) + [(<tag> class method_name method_type) + (<inst> class method_name method_type)]) ([#/.INVOKEINTERFACE _.INVOKEINTERFACE] [#/.INVOKESPECIAL _.INVOKESPECIAL] [#/.INVOKESTATIC _.INVOKESTATIC] [#/.INVOKEVIRTUAL _.INVOKEVIRTUAL]) )) -(def: (local-int instruction) - (-> /.Local-Int Inst) +(def: (local_int instruction) + (-> /.Local_Int Inst) (case instruction (#/.ILOAD register) (_.ILOAD register) (#/.ISTORE register) (_.ISTORE register))) -(def: (local-long instruction) - (-> /.Local-Long Inst) +(def: (local_long instruction) + (-> /.Local_Long Inst) (case instruction (#/.LLOAD register) (_.LLOAD register) (#/.LSTORE register) (_.LSTORE register))) -(def: (local-float instruction) - (-> /.Local-Float Inst) +(def: (local_float instruction) + (-> /.Local_Float Inst) (case instruction (#/.FLOAD register) (_.FLOAD register) (#/.FSTORE register) (_.FSTORE register))) -(def: (local-double instruction) - (-> /.Local-Double Inst) +(def: (local_double instruction) + (-> /.Local_Double Inst) (case instruction (#/.DLOAD register) (_.DLOAD register) (#/.DSTORE register) (_.DSTORE register))) -(def: (local-object instruction) - (-> /.Local-Object Inst) +(def: (local_object instruction) + (-> /.Local_Object Inst) (case instruction (#/.ALOAD register) (_.ALOAD register) (#/.ASTORE register) (_.ASTORE register))) @@ -278,12 +278,12 @@ (def: (local instruction) (-> /.Local Inst) (case instruction - (#/.Local-Int instruction) (..local-int instruction) + (#/.Local_Int instruction) (..local_int instruction) (#/.IINC register) (_.IINC register) - (#/.Local-Long instruction) (..local-long instruction) - (#/.Local-Float instruction) (..local-float instruction) - (#/.Local-Double instruction) (..local-double instruction) - (#/.Local-Object instruction) (..local-object instruction))) + (#/.Local_Long instruction) (..local_long instruction) + (#/.Local_Float instruction) (..local_float instruction) + (#/.Local_Double instruction) (..local_double instruction) + (#/.Local_Object instruction) (..local_object instruction))) (def: (stack instruction) (-> /.Stack Inst) @@ -385,12 +385,12 @@ (type: Mapping (Dictionary /.Label org/objectweb/asm/Label)) -(type: (Re-labeler context) +(type: (Re_labeler context) (-> [Mapping (context /.Label)] [Mapping (context org/objectweb/asm/Label)])) (def: (relabel [mapping label]) - (Re-labeler Identity) + (Re_labeler Identity) (case (dictionary.get label mapping) (#.Some label) [mapping label] @@ -399,8 +399,8 @@ (let [label' (org/objectweb/asm/Label::new)] [(dictionary.put label label' mapping) label']))) -(def: (relabel-branching [mapping instruction]) - (Re-labeler /.Branching) +(def: (relabel_branching [mapping instruction]) + (Re_labeler /.Branching) (case instruction (^template [<tag>] [(<tag> label) @@ -428,8 +428,8 @@ [mapping (#/.LOOKUPSWITCH default (list.reverse keys+labels))]) )) -(def: (relabel-exception [mapping instruction]) - (Re-labeler /.Exception) +(def: (relabel_exception [mapping instruction]) + (Re_labeler /.Exception) (case instruction (#/.Try start end handler exception) (let [[mapping start] (..relabel [mapping start]) @@ -441,16 +441,16 @@ [mapping #/.ATHROW] )) -(def: (relabel-control [mapping instruction]) - (Re-labeler /.Control) +(def: (relabel_control [mapping instruction]) + (Re_labeler /.Control) (case instruction (^template [<tag> <relabel>] [(<tag> instruction) (let [[mapping instruction] (<relabel> [mapping instruction])] [mapping (<tag> instruction)])]) ([#/.GOTO ..relabel] - [#/.Branching ..relabel-branching] - [#/.Exception ..relabel-exception]) + [#/.Branching ..relabel_branching] + [#/.Exception ..relabel_exception]) (^template [<tag>] [(<tag> instruction) @@ -458,8 +458,8 @@ ([#/.Concurrency] [#/.Return]) )) -(def: (relabel-instruction [mapping instruction]) - (Re-labeler /.Instruction) +(def: (relabel_instruction [mapping instruction]) + (Re_labeler /.Instruction) (case instruction #/.NOP [mapping #/.NOP] @@ -477,13 +477,13 @@ [#/.Comparison]) (#/.Control instruction) - (let [[mapping instruction] (..relabel-control [mapping instruction])] + (let [[mapping instruction] (..relabel_control [mapping instruction])] [mapping (#/.Control instruction)]))) -(def: (relabel-bytecode [mapping bytecode]) - (Re-labeler /.Bytecode) +(def: (relabel_bytecode [mapping bytecode]) + (Re_labeler /.Bytecode) (row@fold (function (_ input [mapping output]) - (let [[mapping input] (..relabel-instruction [mapping input])] + (let [[mapping input] (..relabel_instruction [mapping input])] [mapping (row.add input output)])) [mapping (row.row)] bytecode)) @@ -495,41 +495,41 @@ (def: bytecode (-> (/.Bytecode /.Label) jvm.Inst) (|>> [..fresh] - ..relabel-bytecode + ..relabel_bytecode product.right (row@map ..instruction) - row.to-list + row.to_list _.fuse)) (type: Handler (generation.Handler jvm.Anchor (/.Bytecode /.Label) jvm.Definition)) -(def: (true-handler extender pseudo) +(def: (true_handler extender pseudo) (-> jvm.Extender Any jvm.Handler) - (function (_ extension-name phase archive inputs) + (function (_ extension_name phase archive inputs) (do phase.monad - [bytecode ((extender pseudo) extension-name phase archive inputs)] + [bytecode ((extender pseudo) extension_name phase archive inputs)] (wrap (..bytecode (:coerce (/.Bytecode /.Label) bytecode)))))) (def: (def::generation extender) (-> jvm.Extender (directive.Handler jvm.Anchor jvm.Inst jvm.Definition)) - (function (handler extension-name phase archive inputsC+) + (function (handler extension_name phase archive inputsC+) (case inputsC+ (^ (list nameC valueC)) (do phase.monad [[_ _ name] (lux/.evaluate! archive Text nameC) [_ handlerV] (lux/.generator archive (:coerce Text name) ..Handler valueC) _ (|> handlerV - (..true-handler extender) + (..true_handler extender) (extension.install extender (:coerce Text name)) - directive.lift-generation) - _ (directive.lift-generation + directive.lift_generation) + _ (directive.lift_generation (generation.log! (format "Generation " (%.text (:coerce Text name)))))] - (wrap directive.no-requirements)) + (wrap directive.no_requirements)) _ - (phase.throw extension.invalid-syntax [extension-name %.code inputsC+])))) + (phase.throw extension.invalid_syntax [extension_name %.code inputsC+])))) (def: #export (bundle extender) (-> jvm.Extender diff --git a/lux-jvm/source/luxc/lang/host/jvm.lux b/lux-jvm/source/luxc/lang/host/jvm.lux index dea97851a..c2a2a6f41 100644 --- a/lux-jvm/source/luxc/lang/host/jvm.lux +++ b/lux-jvm/source/luxc/lang/host/jvm.lux @@ -84,20 +84,20 @@ (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))}) - (let [g!type (code.local-identifier type) - g!none (code.local-identifier none) - g!tags+ (list/map code.local-tag options) - g!_left (code.local-identifier "_left") - g!_right (code.local-identifier "_right") +(syntax: (config: {type s.local_identifier} + {none s.local_identifier} + {++ s.local_identifier} + {options (s.tuple (p.many s.local_identifier))}) + (let [g!type (code.local_identifier type) + g!none (code.local_identifier none) + g!tags+ (list/map code.local_tag options) + g!_left (code.local_identifier "_left") + g!_right (code.local_identifier "_right") g!options+ (list/map (function (_ option) - (` (def: (~' #export) (~ (code.local-identifier option)) + (` (def: (~' #export) (~ (code.local_identifier option)) (~ g!type) (|> (~ g!none) - (set@ (~ (code.local-tag option)) #1))))) + (set@ (~ (code.local_tag option)) #1))))) options)] (wrap (list& (` (type: (~' #export) (~ g!type) (~ (code.record (list/map (function (_ tag) @@ -110,7 +110,7 @@ [tag (` #0)]) g!tags+))))) - (` (def: (~' #export) ((~ (code.local-identifier ++)) (~ g!_left) (~ g!_right)) + (` (def: (~' #export) ((~ (code.local_identifier ++)) (~ g!_left) (~ g!_right)) (-> (~ g!type) (~ g!type) (~ g!type)) (~ (code.record (list/map (function (_ tag) [tag (` (or (get@ (~ tag) (~ g!_left)) @@ -119,15 +119,15 @@ g!options+)))) -(config: Class-Config noneC ++C [finalC]) -(config: Method-Config noneM ++M [finalM staticM synchronizedM strictM]) -(config: Field-Config noneF ++F [finalF staticF transientF volatileF]) +(config: Class_Config noneC ++C [finalC]) +(config: Method_Config noneM ++M [finalM staticM synchronizedM strictM]) +(config: Field_Config noneF ++F [finalF staticF transientF volatileF]) -(def: #export new-label +(def: #export new_label (-> Any Label) (function (_ _) (org/objectweb/asm/Label::new))) -(def: #export (simple-class name) +(def: #export (simple_class name) (-> Text (Type Class)) (type.class name (list))) diff --git a/lux-jvm/source/luxc/lang/host/jvm/def.lux b/lux-jvm/source/luxc/lang/host/jvm/def.lux index a9003b485..12e2fe412 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)] + ["." host (#+ import: do_to)] [control ["." function]] [data @@ -24,7 +24,7 @@ (def: signature (|>> type.signature signature.signature)) (def: descriptor (|>> type.descriptor descriptor.descriptor)) -(def: class-name (|>> type.descriptor descriptor.class-name name.read)) +(def: class_name (|>> type.descriptor descriptor.class_name name.read)) (import: java/lang/Object) (import: java/lang/String) @@ -77,15 +77,15 @@ (visitMethod [int java/lang/String java/lang/String java/lang/String [java/lang/String]] org/objectweb/asm/MethodVisitor) (toByteArray [] [byte])]) -(def: (string-array values) +(def: (string_array values) (-> (List Text) (Array Text)) (let [output (host.array java/lang/String (list.size values))] (exec (list@map (function (_ [idx value]) - (host.array-write idx value output)) + (host.array_write idx value output)) (list.enumeration values)) output))) -(def: (version-flag version) +(def: (version_flag version) (-> //.Version Int) (case version #//.V1_1 (org/objectweb/asm/Opcodes::V1_1) @@ -97,7 +97,7 @@ #//.V1_7 (org/objectweb/asm/Opcodes::V1_7) #//.V1_8 (org/objectweb/asm/Opcodes::V1_8))) -(def: (visibility-flag visibility) +(def: (visibility_flag visibility) (-> //.Visibility Int) (case visibility #//.Public (org/objectweb/asm/Opcodes::ACC_PUBLIC) @@ -105,82 +105,82 @@ #//.Private (org/objectweb/asm/Opcodes::ACC_PRIVATE) #//.Default +0)) -(def: (class-flags config) - (-> //.Class-Config Int) +(def: (class_flags config) + (-> //.Class_Config Int) ($_ i.+ (if (get@ #//.finalC config) (org/objectweb/asm/Opcodes::ACC_FINAL) +0))) -(def: (method-flags config) - (-> //.Method-Config Int) +(def: (method_flags config) + (-> //.Method_Config Int) ($_ i.+ (if (get@ #//.staticM config) (org/objectweb/asm/Opcodes::ACC_STATIC) +0) (if (get@ #//.finalM config) (org/objectweb/asm/Opcodes::ACC_FINAL) +0) (if (get@ #//.synchronizedM config) (org/objectweb/asm/Opcodes::ACC_SYNCHRONIZED) +0) (if (get@ #//.strictM config) (org/objectweb/asm/Opcodes::ACC_STRICT) +0))) -(def: (field-flags config) - (-> //.Field-Config Int) +(def: (field_flags config) + (-> //.Field_Config Int) ($_ i.+ (if (get@ #//.staticF config) (org/objectweb/asm/Opcodes::ACC_STATIC) +0) (if (get@ #//.finalF config) (org/objectweb/asm/Opcodes::ACC_FINAL) +0) (if (get@ #//.transientF config) (org/objectweb/asm/Opcodes::ACC_TRANSIENT) +0) (if (get@ #//.volatileF config) (org/objectweb/asm/Opcodes::ACC_VOLATILE) +0))) -(def: param-signature +(def: param_signature (-> (Type Class) Text) (|>> ..signature (format ":"))) -(def: (formal-param [name super interfaces]) +(def: (formal_param [name super interfaces]) (-> Constraint Text) (format name - (param-signature super) + (param_signature super) (|> interfaces - (list@map param-signature) - (text.join-with "")))) + (list@map param_signature) + (text.join_with "")))) -(def: (constraints-signature constraints super interfaces) +(def: (constraints_signature constraints super interfaces) (-> (List Constraint) (Type Class) (List (Type Class)) Text) - (let [formal-params (if (list.empty? constraints) + (let [formal_params (if (list.empty? constraints) "" (format "<" (|> constraints - (list@map formal-param) - (text.join-with "")) + (list@map formal_param) + (text.join_with "")) ">"))] - (format formal-params + (format formal_params (..signature super) (|> interfaces (list@map ..signature) - (text.join-with ""))))) + (text.join_with ""))))) -(def: class-computes +(def: class_computes Int ($_ i.+ (org/objectweb/asm/ClassWriter::COMPUTE_MAXS) ## (org/objectweb/asm/ClassWriter::COMPUTE_FRAMES) )) -(def: binary-name (|>> name.internal name.read)) +(def: binary_name (|>> name.internal name.read)) (template [<name> <flag>] [(def: #export (<name> version visibility config name constraints super interfaces definitions) - (-> //.Version //.Visibility //.Class-Config Text (List Constraint) (Type Class) (List (Type Class)) //.Def + (-> //.Version //.Visibility //.Class_Config Text (List Constraint) (Type Class) (List (Type Class)) //.Def (host.type [byte])) - (let [writer (|> (do-to (org/objectweb/asm/ClassWriter::new class-computes) - (org/objectweb/asm/ClassWriter::visit (version-flag version) + (let [writer (|> (do_to (org/objectweb/asm/ClassWriter::new class_computes) + (org/objectweb/asm/ClassWriter::visit (version_flag version) ($_ i.+ (org/objectweb/asm/Opcodes::ACC_SUPER) <flag> - (visibility-flag visibility) - (class-flags config)) - (..binary-name name) - (constraints-signature constraints super interfaces) - (..class-name super) + (visibility_flag visibility) + (class_flags config)) + (..binary_name name) + (constraints_signature constraints super interfaces) + (..class_name super) (|> interfaces - (list@map ..class-name) - string-array))) + (list@map ..class_name) + string_array))) definitions) _ (org/objectweb/asm/ClassWriter::visitEnd writer)] (org/objectweb/asm/ClassWriter::toByteArray writer)))] @@ -195,36 +195,36 @@ (def: #export (interface version visibility config name constraints interfaces definitions) - (-> //.Version //.Visibility //.Class-Config Text (List Constraint) (List (Type Class)) //.Def + (-> //.Version //.Visibility //.Class_Config Text (List Constraint) (List (Type Class)) //.Def (host.type [byte])) - (let [writer (|> (do-to (org/objectweb/asm/ClassWriter::new class-computes) - (org/objectweb/asm/ClassWriter::visit (version-flag version) + (let [writer (|> (do_to (org/objectweb/asm/ClassWriter::new class_computes) + (org/objectweb/asm/ClassWriter::visit (version_flag version) ($_ i.+ (org/objectweb/asm/Opcodes::ACC_SUPER) (org/objectweb/asm/Opcodes::ACC_INTERFACE) - (visibility-flag visibility) - (class-flags config)) - (..binary-name name) - (constraints-signature constraints $Object interfaces) - (..class-name $Object) + (visibility_flag visibility) + (class_flags config)) + (..binary_name name) + (constraints_signature constraints $Object interfaces) + (..class_name $Object) (|> interfaces - (list@map ..class-name) - string-array))) + (list@map ..class_name) + string_array))) definitions) _ (org/objectweb/asm/ClassWriter::visitEnd writer)] (org/objectweb/asm/ClassWriter::toByteArray writer))) (def: #export (method visibility config name type then) - (-> //.Visibility //.Method-Config Text (Type Method) //.Inst + (-> //.Visibility //.Method_Config Text (Type Method) //.Inst //.Def) (function (_ writer) (let [=method (org/objectweb/asm/ClassWriter::visitMethod ($_ i.+ - (visibility-flag visibility) - (method-flags config)) - (..binary-name name) + (visibility_flag visibility) + (method_flags config)) + (..binary_name name) (..descriptor type) (..signature type) - (string-array (list)) + (string_array (list)) writer) _ (org/objectweb/asm/MethodVisitor::visitCode =method) _ (then =method) @@ -232,29 +232,29 @@ _ (org/objectweb/asm/MethodVisitor::visitEnd =method)] writer))) -(def: #export (abstract-method visibility config name type) - (-> //.Visibility //.Method-Config Text (Type Method) +(def: #export (abstract_method visibility config name type) + (-> //.Visibility //.Method_Config Text (Type Method) //.Def) (function (_ writer) (let [=method (org/objectweb/asm/ClassWriter::visitMethod ($_ i.+ - (visibility-flag visibility) - (method-flags config) + (visibility_flag visibility) + (method_flags config) (org/objectweb/asm/Opcodes::ACC_ABSTRACT)) - (..binary-name name) + (..binary_name name) (..descriptor type) (..signature type) - (string-array (list)) + (string_array (list)) writer) _ (org/objectweb/asm/MethodVisitor::visitEnd =method)] writer))) (def: #export (field visibility config name type) - (-> //.Visibility //.Field-Config Text (Type Value) //.Def) + (-> //.Visibility //.Field_Config Text (Type Value) //.Def) (function (_ writer) - (let [=field (do-to (org/objectweb/asm/ClassWriter::visitField ($_ i.+ - (visibility-flag visibility) - (field-flags config)) - (..binary-name name) + (let [=field (do_to (org/objectweb/asm/ClassWriter::visitField ($_ i.+ + (visibility_flag visibility) + (field_flags config)) + (..binary_name name) (..descriptor type) (..signature type) (host.null) @@ -262,30 +262,30 @@ (org/objectweb/asm/FieldVisitor::visitEnd))] writer))) -(template [<name> <lux-type> <jvm-type> <prepare>] +(template [<name> <lux_type> <jvm_type> <prepare>] [(def: #export (<name> visibility config name value) - (-> //.Visibility //.Field-Config Text <lux-type> //.Def) + (-> //.Visibility //.Field_Config Text <lux_type> //.Def) (function (_ writer) - (let [=field (do-to (org/objectweb/asm/ClassWriter::visitField ($_ i.+ - (visibility-flag visibility) - (field-flags config)) - (..binary-name name) - (..descriptor <jvm-type>) - (..signature <jvm-type>) + (let [=field (do_to (org/objectweb/asm/ClassWriter::visitField ($_ i.+ + (visibility_flag visibility) + (field_flags config)) + (..binary_name name) + (..descriptor <jvm_type>) + (..signature <jvm_type>) (<prepare> value) writer) (org/objectweb/asm/FieldVisitor::visitEnd))] 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] - [long-field Int type.long function.identity] - [float-field Frac type.float host.double-to-float] - [double-field Frac type.double function.identity] - [char-field Nat type.char (|>> .int host.long-to-int host.int-to-char)] - [string-field Text (type.class "java.lang.String" (list)) function.identity] + [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] + [long_field Int type.long function.identity] + [float_field Frac type.float host.double_to_float] + [double_field Frac type.double function.identity] + [char_field Nat type.char (|>> .int host.long_to_int host.int_to_char)] + [string_field Text (type.class "java.lang.String" (list)) function.identity] ) (def: #export (fuse defs) diff --git a/lux-jvm/source/luxc/lang/host/jvm/inst.lux b/lux-jvm/source/luxc/lang/host/jvm/inst.lux index 9d51a15bb..341ded0e4 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)] + ["." host (#+ import: do_to)] [abstract [monad (#+ do)]] [control @@ -34,7 +34,7 @@ [phase (#+ Operation)]]]] ["." // (#+ Inst)]) -(def: class-name (|>> type.descriptor descriptor.class-name name.read)) +(def: class_name (|>> type.descriptor descriptor.class_name name.read)) (def: descriptor (|>> type.descriptor descriptor.descriptor)) (def: reflection (|>> type.reflection reflection.reflection)) @@ -42,9 +42,9 @@ (import: java/lang/Object) (import: java/lang/String) -(syntax: (declare {codes (p.many s.local-identifier)}) +(syntax: (declare {codes (p.many s.local_identifier)}) (|> codes - (list@map (function (_ code) (` ((~' #static) (~ (code.local-identifier code)) (~' int))))) + (list@map (function (_ code) (` ((~' #static) (~ (code.local_identifier code)) (~' int))))) wrap)) (`` (import: org/objectweb/asm/Opcodes @@ -147,12 +147,12 @@ ]) ## [Insts] -(def: #export make-label +(def: #export make_label (All [s] (Operation s org/objectweb/asm/Label)) (function (_ state) (#try.Success [state (org/objectweb/asm/Label::new)]))) -(def: #export (with-label action) +(def: #export (with_label action) (All [a] (-> (-> org/objectweb/asm/Label a) a)) (action (org/objectweb/asm/Label::new))) @@ -160,14 +160,14 @@ [(def: #export (<name> value) (-> <type> Inst) (function (_ visitor) - (do-to visitor - (org/objectweb/asm/MethodVisitor::visitLdcInsn (<prepare> value)))))] + (do_to visitor + (org/objectweb/asm/MethodVisitor::visitLdcInsn (<prepare> value)))))] [boolean Bit function.identity] - [int Int host.long-to-int] + [int Int host.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 host.long_to_int host.int_to_char)] [string Text function.identity] ) @@ -178,8 +178,8 @@ [(def: #export <constant> Inst (function (_ visitor) - (do-to visitor - (org/objectweb/asm/MethodVisitor::visitInsn (!prefix <constant>)))))] + (do_to visitor + (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] @@ -190,15 +190,15 @@ (def: #export NULL Inst (function (_ visitor) - (do-to visitor - (org/objectweb/asm/MethodVisitor::visitInsn (!prefix ACONST_NULL))))) + (do_to visitor + (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))))] + (do_to visitor + (org/objectweb/asm/MethodVisitor::visitIntInsn (!prefix <constant>) constant))))] [BIPUSH] [SIPUSH] @@ -208,8 +208,8 @@ [(def: #export <name> Inst (function (_ visitor) - (do-to visitor - (org/objectweb/asm/MethodVisitor::visitInsn (!prefix <name>)))))] + (do_to visitor + (org/objectweb/asm/MethodVisitor::visitInsn (!prefix <name>)))))] [NOP] @@ -271,8 +271,8 @@ [(def: #export (<name> register) (-> Register Inst) (function (_ visitor) - (do-to visitor - (org/objectweb/asm/MethodVisitor::visitVarInsn (!prefix <name>) (.int register)))))] + (do_to visitor + (org/objectweb/asm/MethodVisitor::visitVarInsn (!prefix <name>) (.int register)))))] [IINC] [ILOAD] [LLOAD] [FLOAD] [DLOAD] [ALOAD] @@ -283,8 +283,8 @@ [(def: #export (<name> class field type) (-> (Type Class) Text (Type Value) Inst) (function (_ visitor) - (do-to visitor - (org/objectweb/asm/MethodVisitor::visitFieldInsn (<inst>) (..class-name class) field (..descriptor type)))))] + (do_to visitor + (org/objectweb/asm/MethodVisitor::visitFieldInsn (<inst>) (..class_name class) field (..descriptor type)))))] [GETSTATIC org/objectweb/asm/Opcodes::GETSTATIC] [PUTSTATIC org/objectweb/asm/Opcodes::PUTSTATIC] @@ -298,8 +298,8 @@ [(def: #export (<name> class) (-> (Type <category>) Inst) (function (_ visitor) - (do-to visitor - (org/objectweb/asm/MethodVisitor::visitTypeInsn (<inst>) (..class-name class)))))] + (do_to visitor + (org/objectweb/asm/MethodVisitor::visitTypeInsn (<inst>) (..class_name class)))))] (~~ (template.splice <instructions>+))))] @@ -315,32 +315,32 @@ (def: #export (NEWARRAY type) (-> (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))))))) + (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))))))) (template [<name> <inst> <interface?>] - [(def: #export (<name> class method-name method) + [(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?>))))] + (do_to visitor + (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] @@ -352,8 +352,8 @@ [(def: #export (<name> @where) (-> //.Label Inst) (function (_ visitor) - (do-to visitor - (org/objectweb/asm/MethodVisitor::visitJumpInsn (!prefix <name>) @where))))] + (do_to visitor + (org/objectweb/asm/MethodVisitor::visitJumpInsn (!prefix <name>) @where))))] [IF_ICMPEQ] [IF_ICMPGT] [IF_ICMPLT] [IF_ICMPNE] [IF_ICMPGE] [IF_ICMPLE] @@ -368,46 +368,46 @@ (let [keys+labels (list.sort (function (_ left right) (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) + array_size (list.size keys+labels) + keys_array (host.array int array_size) + labels_array (host.array org/objectweb/asm/Label array_size) _ (loop [idx 0] - (if (n.< array-size idx) + (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) + (host.array_write idx (host.long_to_int key) keys_array) + (host.array_write idx label labels_array) (recur (inc idx)))) []))] - (do-to visitor - (org/objectweb/asm/MethodVisitor::visitLookupSwitchInsn default keys-array labels-array))))) + (do_to visitor + (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) + (let [num_labels (list.size labels) + labels_array (host.array org/objectweb/asm/Label num_labels) _ (loop [idx 0] - (if (n.< num-labels idx) - (exec (host.array-write idx + (if (n.< num_labels idx) + (exec (host.array_write idx (maybe.assume (list.nth idx labels)) - labels-array) + labels_array) (recur (inc idx))) []))] - (do-to visitor - (org/objectweb/asm/MethodVisitor::visitTableSwitchInsn min max default labels-array))))) + (do_to visitor + (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))))) + (do_to visitor + (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)))) + (do_to visitor + (org/objectweb/asm/MethodVisitor::visitLabel @label)))) (def: #export (array elementT) (-> (Type Value) Inst) @@ -435,24 +435,24 @@ ## else (undefined))))] - [primitive-wrapper + [primitive_wrapper box.boolean box.byte box.short box.int box.long box.float box.double box.char] - [primitive-unwrap + [primitive_unwrap "booleanValue" "byteValue" "shortValue" "intValue" "longValue" "floatValue" "doubleValue" "charValue"] ) (def: #export (wrap type) (-> (Type Primitive) Inst) - (let [wrapper (type.class (primitive-wrapper type) (list))] + (let [wrapper (type.class (primitive_wrapper type) (list))] (INVOKESTATIC wrapper "valueOf" (type.method [(list type) wrapper (list)])))) (def: #export (unwrap type) (-> (Type Primitive) Inst) - (let [wrapper (type.class (primitive-wrapper type) (list))] + (let [wrapper (type.class (primitive_wrapper type) (list))] (|>> (CHECKCAST wrapper) - (INVOKEVIRTUAL wrapper (primitive-unwrap type) (type.method [(list) type (list)]))))) + (INVOKEVIRTUAL wrapper (primitive_unwrap type) (type.method [(list) type (list)]))))) (def: #export (fuse insts) (-> (List Inst) Inst) diff --git a/lux-jvm/source/luxc/lang/translation/jvm.lux b/lux-jvm/source/luxc/lang/translation/jvm.lux index 88dc6a96f..84eff942e 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)] + ["." host (#+ import: do_to object)] [abstract [monad (#+ do)]] [control @@ -30,7 +30,7 @@ ["." version] ["." generation]]] [meta - [io (#+ lux-context)] + [io (#+ lux_context)] [archive [descriptor (#+ Module)] ["." artifact]]]]]] @@ -57,27 +57,27 @@ (type: #export ByteCode Binary) -(def: #export value-field Text "_value") +(def: #export value_field Text "_value") (def: #export $Value (type.class "java.lang.Object" (list))) -(exception: #export (cannot-load {class Text} {error Text}) +(exception: #export (cannot_load {class Text} {error Text}) (exception.report ["Class" class] ["Error" error])) -(exception: #export (invalid-field {class Text} {field Text} {error Text}) +(exception: #export (invalid_field {class Text} {field Text} {error Text}) (exception.report ["Class" class] ["Field" field] ["Error" error])) -(exception: #export (invalid-value {class Text}) +(exception: #export (invalid_value {class Text}) (exception.report ["Class" class])) -(def: (class-value class-name class) +(def: (class_value class_name class) (-> Text (java/lang/Class java/lang/Object) (Try Any)) - (case (java/lang/Class::getField ..value-field class) + (case (java/lang/Class::getField ..value_field class) (#try.Success field) (case (java/lang/reflect/Field::get #.None field) (#try.Success ?value) @@ -86,73 +86,73 @@ (#try.Success value) #.None - (exception.throw ..invalid-value class-name)) + (exception.throw ..invalid_value class_name)) (#try.Failure error) - (exception.throw ..cannot-load [class-name error])) + (exception.throw ..cannot_load [class_name error])) (#try.Failure error) - (exception.throw ..invalid-field [class-name ..value-field error]))) + (exception.throw ..invalid_field [class_name ..value_field error]))) -(def: class-path-separator ".") +(def: class_path_separator ".") -(def: #export bytecode-name +(def: #export bytecode_name (-> Text Text) - (text.replace-all ..class-path-separator .module-separator)) + (text.replace_all ..class_path_separator .module_separator)) -(def: #export (class-name [module-id artifact-id]) +(def: #export (class_name [module_id artifact_id]) (-> generation.Context Text) - (format lux-context - ..class-path-separator (%.nat version.version) - ..class-path-separator (%.nat module-id) - ..class-path-separator (%.nat artifact-id))) + (format lux_context + ..class_path_separator (%.nat version.version) + ..class_path_separator (%.nat module_id) + ..class_path_separator (%.nat artifact_id))) (def: (evaluate! library loader context valueI) (-> Library java/lang/ClassLoader generation.Context Inst (Try [Any Definition])) - (let [eval-class (..class-name context) - bytecode-name (..bytecode-name eval-class) + (let [eval_class (..class_name context) + bytecode_name (..bytecode_name eval_class) bytecode (def.class #jvm.V1_6 #jvm.Public jvm.noneC - bytecode-name + bytecode_name (list) $Value (list) (|>> (def.field #jvm.Public ($_ jvm.++F jvm.finalF jvm.staticF) - ..value-field ..$Value) + ..value_field ..$Value) (def.method #jvm.Public ($_ jvm.++M jvm.staticM jvm.strictM) "<clinit>" (type.method [(list) type.void (list)]) (|>> valueI - (inst.PUTSTATIC (type.class bytecode-name (list)) ..value-field ..$Value) + (inst.PUTSTATIC (type.class bytecode_name (list)) ..value_field ..$Value) inst.RETURN))))] (io.run (do (try.with io.monad) - [_ (loader.store eval-class bytecode library) - class (loader.load eval-class loader) - value (\ io.monad wrap (..class-value eval-class class))] + [_ (loader.store eval_class bytecode library) + class (loader.load eval_class loader) + value (\ io.monad wrap (..class_value eval_class class))] (wrap [value - [eval-class bytecode]]))))) + [eval_class bytecode]]))))) -(def: (execute! library loader [class-name class-bytecode]) +(def: (execute! library loader [class_name class_bytecode]) (-> Library java/lang/ClassLoader Definition (Try Any)) (io.run (do (try.with io.monad) - [existing-class? (|> (atom.read library) + [existing_class? (|> (atom.read library) (\ io.monad map (function (_ library) - (dictionary.key? library class-name))) + (dictionary.key? library class_name))) (try.lift io.monad) (: (IO (Try Bit)))) - _ (if existing-class? + _ (if existing_class? (wrap []) - (loader.store class-name class-bytecode library))] - (loader.load class-name loader)))) + (loader.store class_name class_bytecode library))] + (loader.load class_name loader)))) (def: (define! library loader context valueI) (-> Library java/lang/ClassLoader generation.Context Inst (Try [Text Any Definition])) (do try.monad [[value definition] (evaluate! library loader context valueI)] - (wrap [(..class-name context) value definition]))) + (wrap [(..class_name context) value definition]))) (def: #export host (IO Host) - (io (let [library (loader.new-library []) + (io (let [library (loader.new_library []) loader (loader.memory library)] (: Host (structure @@ -167,21 +167,21 @@ (..define! library loader)) (def: (ingest context bytecode) - [(..class-name context) bytecode]) + [(..class_name context) bytecode]) - (def: (re-learn context [_ bytecode]) + (def: (re_learn context [_ bytecode]) (io.run - (loader.store (..class-name context) bytecode library))) + (loader.store (..class_name context) bytecode library))) - (def: (re-load context [_ bytecode]) + (def: (re_load context [_ bytecode]) (io.run (do (try.with io.monad) - [#let [class-name (..class-name context)] - _ (loader.store class-name bytecode library) - class (loader.load class-name loader)] - (\ io.monad wrap (..class-value class-name class)))))))))) + [#let [class_name (..class_name context)] + _ (loader.store class_name bytecode library) + class (loader.load class_name loader)] + (\ io.monad wrap (..class_value class_name class)))))))))) (def: #export $Variant (type.array ..$Value)) (def: #export $Tuple (type.array ..$Value)) -(def: #export $Runtime (type.class (..class-name [0 0]) (list))) -(def: #export $Function (type.class (..class-name [0 1]) (list))) +(def: #export $Runtime (type.class (..class_name [0 0]) (list))) +(def: #export $Function (type.class (..class_name [0 1]) (list))) diff --git a/lux-jvm/source/luxc/lang/translation/jvm/case.lux b/lux-jvm/source/luxc/lang/translation/jvm/case.lux index 68d9b4347..b9d6ec6d1 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/case.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/case.lux @@ -33,15 +33,15 @@ ["." runtime] ["." structure]]) -(def: (pop-altI stack-depth) +(def: (pop_altI stack_depth) (-> Nat Inst) - (.case stack-depth + (.case stack_depth 0 function.identity 1 _.POP 2 _.POP2 _ ## (n.> 2) (|>> _.POP2 - (pop-altI (n.- 2 stack-depth))))) + (pop_altI (n.- 2 stack_depth))))) (def: peekI Inst @@ -69,7 +69,7 @@ 5 _.ICONST_5 _ (_.int (.int value)))) -(def: (left-projection lefts) +(def: (left_projection lefts) (-> Nat Inst) (.let [[indexI accessI] (.case lefts 0 @@ -83,13 +83,13 @@ indexI accessI))) -(def: (right-projection lefts) +(def: (right_projection lefts) (-> Nat Inst) (|>> (_.CHECKCAST //.$Tuple) (leftsI lefts) (_.INVOKESTATIC //.$Runtime "tuple_right" (type.method [(list //.$Tuple runtime.$Index) //.$Value (list)])))) -(def: (path' stack-depth @else @end phase archive path) +(def: (path' stack_depth @else @end phase archive path) (-> Nat Label Label Phase Archive Path (Operation Inst)) (.case path #synthesis.Pop @@ -99,17 +99,17 @@ (operation@wrap (|>> peekI (_.ASTORE register))) - (#synthesis.Bit-Fork when thenP elseP) + (#synthesis.Bit_Fork when thenP elseP) (do phase.monad - [thenG (path' stack-depth @else @end phase archive thenP) + [thenG (path' stack_depth @else @end phase archive thenP) elseG (.case elseP (#.Some elseP) - (path' stack-depth @else @end phase archive elseP) + (path' stack_depth @else @end phase archive elseP) #.None (wrap (_.GOTO @else))) #let [ifI (.if when _.IFEQ _.IFNE)]] - (wrap (<| _.with-label (function (_ @else)) + (wrap (<| _.with_label (function (_ @else)) (|>> peekI (_.unwrap type.boolean) (ifI @else) @@ -123,8 +123,8 @@ [forkG (: (Operation Inst) (monad.fold @ (function (_ [test thenP] elseG) (do @ - [thenG (path' stack-depth @else @end phase archive thenP)] - (wrap (<| _.with-label (function (_ @else)) + [thenG (path' stack_depth @else @end phase archive thenP)] + (wrap (<| _.with_label (function (_ @else)) (|>> <dup> (<test> test) <comparison> @@ -139,23 +139,23 @@ (wrap (|>> peekI <unwrap> forkG)))]) - ([#synthesis.I64-Fork (_.unwrap type.long) _.DUP2 _.POP2 (|>> .int _.long) _.LCMP _.IFNE] - [#synthesis.F64-Fork (_.unwrap type.double) _.DUP2 _.POP2 _.double _.DCMPL _.IFNE] - [#synthesis.Text-Fork (|>) _.DUP _.POP _.string + ([#synthesis.I64_Fork (_.unwrap type.long) _.DUP2 _.POP2 (|>> .int _.long) _.LCMP _.IFNE] + [#synthesis.F64_Fork (_.unwrap type.double) _.DUP2 _.POP2 _.double _.DCMPL _.IFNE] + [#synthesis.Text_Fork (|>) _.DUP _.POP _.string (_.INVOKEVIRTUAL (type.class "java.lang.Object" (list)) "equals" (type.method [(list //.$Value) type.boolean (list)])) _.IFEQ]) (#synthesis.Then bodyS) (do phase.monad [bodyI (phase archive bodyS)] - (wrap (|>> (pop-altI stack-depth) + (wrap (|>> (pop_altI stack_depth) bodyI (_.GOTO @end)))) (^template [<pattern> <right?>] [(^ (<pattern> lefts)) - (operation@wrap (<| _.with-label (function (_ @success)) - _.with-label (function (_ @fail)) + (operation@wrap (<| _.with_label (function (_ @success)) + _.with_label (function (_ @fail)) (|>> peekI (_.CHECKCAST //.$Variant) (structure.tagI lefts <right?>) @@ -181,31 +181,31 @@ (^ (synthesis.path/seq (<path> lefts) - (synthesis.!bind-top register thenP))) + (synthesis.!bind_top register thenP))) (do phase.monad - [then! (path' stack-depth @else @end phase archive thenP)] + [then! (path' stack_depth @else @end phase archive thenP)] (wrap (|>> peekI (<projection> lefts) (_.ASTORE register) then!)))]) - ([synthesis.member/left ..left-projection] - [synthesis.member/right ..right-projection]) + ([synthesis.member/left ..left_projection] + [synthesis.member/right ..right_projection]) (#synthesis.Seq leftP rightP) (do phase.monad - [leftI (path' stack-depth @else @end phase archive leftP) - rightI (path' stack-depth @else @end phase archive rightP)] + [leftI (path' stack_depth @else @end phase archive leftP) + rightI (path' stack_depth @else @end phase archive rightP)] (wrap (|>> leftI rightI))) (#synthesis.Alt leftP rightP) (do phase.monad - [@alt-else _.make-label - leftI (path' (inc stack-depth) @alt-else @end phase archive leftP) - rightI (path' stack-depth @else @end phase archive rightP)] + [@alt_else _.make_label + leftI (path' (inc stack_depth) @alt_else @end phase archive leftP) + rightI (path' stack_depth @else @end phase archive rightP)] (wrap (|>> _.DUP leftI - (_.label @alt-else) + (_.label @alt_else) _.POP rightI))) )) @@ -213,7 +213,7 @@ (def: (path @end phase archive path) (-> Label Phase Archive Path (Operation Inst)) (do phase.monad - [@else _.make-label + [@else _.make_label pathI (..path' 1 @else @end phase archive path)] (wrap (|>> pathI (_.label @else) @@ -228,8 +228,8 @@ [testI (phase archive testS) thenI (phase archive thenS) elseI (phase archive elseS)] - (wrap (<| _.with-label (function (_ @else)) - _.with-label (function (_ @end)) + (wrap (<| _.with_label (function (_ @else)) + _.with_label (function (_ @end)) (|>> testI (_.unwrap type.boolean) (_.IFEQ @else) @@ -252,21 +252,21 @@ (Generator [(List synthesis.Member) Synthesis]) (do phase.monad [recordG (phase archive recordS)] - (wrap (list@fold (function (_ step so-far) + (wrap (list@fold (function (_ step so_far) (.let [next (.case step (#.Left lefts) - (..left-projection lefts) + (..left_projection lefts) (#.Right lefts) - (..right-projection lefts))] - (|>> so-far next))) + (..right_projection lefts))] + (|>> so_far next))) recordG (list.reverse path))))) (def: #export (case phase archive [valueS path]) (Generator [Synthesis Path]) (do phase.monad - [@end _.make-label + [@end _.make_label valueI (phase archive valueS) pathI (..path @end phase archive path)] (wrap (|>> _.NULL 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 e73ea068e..ff56c7824 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/extension/common.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/extension/common.lux @@ -44,13 +44,13 @@ (-> [(Parser s) (-> Text Phase Archive s (Operation Inst))] Handler)) - (function (_ extension-name phase archive input) + (function (_ extension_name phase archive input) (case (<s>.run parser input) (#try.Success input') - (handler extension-name phase archive input') + (handler extension_name phase archive input') (#try.Failure error) - (phase.throw extension.invalid-syntax [extension-name %synthesis input])))) + (phase.throw extension.invalid_syntax [extension_name %synthesis input])))) (import: java/lang/Double ["#::." @@ -62,16 +62,16 @@ (def: $System (type.class "java.lang.System" (list))) (def: $Object (type.class "java.lang.Object" (list))) -(def: lux-intI Inst (|>> _.I2L (_.wrap type.long))) -(def: jvm-intI Inst (|>> (_.unwrap type.long) _.L2I)) -(def: check-stringI Inst (_.CHECKCAST $String)) +(def: lux_intI Inst (|>> _.I2L (_.wrap type.long))) +(def: jvm_intI Inst (|>> (_.unwrap type.long) _.L2I)) +(def: check_stringI Inst (_.CHECKCAST $String)) (def: (predicateI tester) (-> (-> Label Inst) Inst) (let [$Boolean (type.class "java.lang.Boolean" (list))] - (<| _.with-label (function (_ @then)) - _.with-label (function (_ @end)) + (<| _.with_label (function (_ @then)) + _.with_label (function (_ @end)) (|>> (tester @then) (_.GETSTATIC $Boolean "FALSE" $Boolean) (_.GOTO @end) @@ -83,16 +83,16 @@ (def: unitI Inst (_.string synthesis.unit)) ## TODO: Get rid of this ASAP -(def: lux::syntax-char-case! +(def: lux::syntax_char_case! (..custom [($_ <>.and <s>.any <s>.any (<>.some (<s>.tuple ($_ <>.and (<s>.tuple (<>.many <s>.i64)) <s>.any)))) - (function (_ extension-name phase archive [input else conditionals]) - (<| _.with-label (function (_ @end)) - _.with-label (function (_ @else)) + (function (_ extension_name phase archive [input else conditionals]) + (<| _.with_label (function (_ @end)) + _.with_label (function (_ @else)) (do {@ phase.monad} [inputG (phase archive input) elseG (phase archive else) @@ -101,7 +101,7 @@ (monad.map @ (function (_ [chars branch]) (do @ [branchG (phase archive branch)] - (wrap (<| _.with-label (function (_ @branch)) + (wrap (<| _.with_label (function (_ @branch)) [(list@map (function (_ char) [(.int char) @branch]) chars) @@ -151,13 +151,13 @@ [(def: (<name> [shiftI inputI]) (Binary Inst) (|>> inputI (_.unwrap type.long) - shiftI jvm-intI + shiftI jvm_intI <op> (_.wrap type.long)))] - [i64::left-shift _.LSHL] - [i64::arithmetic-right-shift _.LSHR] - [i64::logical-right-shift _.LUSHR] + [i64::left_shift _.LSHL] + [i64::arithmetic_right_shift _.LSHR] + [i64::logical_right_shift _.LUSHR] ) (template [<name> <const> <type>] @@ -220,76 +220,76 @@ [f64::i64 (_.unwrap type.double) (<| (_.wrap type.long) _.D2L)] [f64::encode (_.unwrap type.double) (_.INVOKESTATIC (type.class "java.lang.Double" (list)) "toString" (type.method [(list type.double) $String (list)]))] - [f64::decode ..check-stringI + [f64::decode ..check_stringI (_.INVOKESTATIC ///.$Runtime "decode_frac" (type.method [(list $String) ///.$Variant (list)]))] ) (def: (text::size inputI) (Unary Inst) (|>> inputI - ..check-stringI + ..check_stringI (_.INVOKEVIRTUAL $String "length" (type.method [(list) type.int (list)])) - lux-intI)) + lux_intI)) -(template [<name> <pre-subject> <pre-param> <op> <post>] +(template [<name> <pre_subject> <pre_param> <op> <post>] [(def: (<name> [paramI subjectI]) (Binary Inst) - (|>> subjectI <pre-subject> - paramI <pre-param> + (|>> subjectI <pre_subject> + paramI <pre_param> <op> <post>))] [text::= (<|) (<|) (_.INVOKEVIRTUAL $Object "equals" (type.method [(list $Object) type.boolean (list)])) (_.wrap type.boolean)] - [text::< ..check-stringI ..check-stringI + [text::< ..check_stringI ..check_stringI (_.INVOKEVIRTUAL $String "compareTo" (type.method [(list $String) type.int (list)])) (predicateI _.IFLT)] - [text::char ..check-stringI jvm-intI + [text::char ..check_stringI jvm_intI (_.INVOKEVIRTUAL $String "charAt" (type.method [(list type.int) type.char (list)])) - lux-intI] + lux_intI] ) (def: (text::concat [leftI rightI]) (Binary Inst) - (|>> leftI ..check-stringI - rightI ..check-stringI + (|>> leftI ..check_stringI + rightI ..check_stringI (_.INVOKEVIRTUAL $String "concat" (type.method [(list $String) $String (list)])))) (def: (text::clip [startI endI subjectI]) (Trinary Inst) - (|>> subjectI ..check-stringI - startI jvm-intI - endI jvm-intI + (|>> subjectI ..check_stringI + startI jvm_intI + endI jvm_intI (_.INVOKEVIRTUAL $String "substring" (type.method [(list type.int type.int) $String (list)])))) -(def: index-method (type.method [(list $String type.int) type.int (list)])) +(def: index_method (type.method [(list $String type.int) type.int (list)])) (def: (text::index [startI partI textI]) (Trinary Inst) - (<| _.with-label (function (_ @not-found)) - _.with-label (function (_ @end)) - (|>> textI ..check-stringI - partI ..check-stringI - startI jvm-intI - (_.INVOKEVIRTUAL $String "indexOf" index-method) + (<| _.with_label (function (_ @not_found)) + _.with_label (function (_ @end)) + (|>> textI ..check_stringI + partI ..check_stringI + startI jvm_intI + (_.INVOKEVIRTUAL $String "indexOf" index_method) _.DUP (_.int -1) - (_.IF_ICMPEQ @not-found) - lux-intI + (_.IF_ICMPEQ @not_found) + lux_intI runtime.someI (_.GOTO @end) - (_.label @not-found) + (_.label @not_found) _.POP runtime.noneI (_.label @end)))) -(def: string-method (type.method [(list $String) type.void (list)])) +(def: string_method (type.method [(list $String) type.void (list)])) (def: (io::log messageI) (Unary Inst) (let [$PrintStream (type.class "java.io.PrintStream" (list))] (|>> (_.GETSTATIC $System "out" $PrintStream) messageI - ..check-stringI - (_.INVOKEVIRTUAL $PrintStream "println" string-method) + ..check_stringI + (_.INVOKEVIRTUAL $PrintStream "println" string_method) unitI))) (def: (io::error messageI) @@ -298,17 +298,17 @@ (|>> (_.NEW $Error) _.DUP messageI - ..check-stringI - (_.INVOKESPECIAL $Error "<init>" string-method) + ..check_stringI + (_.INVOKESPECIAL $Error "<init>" string_method) _.ATHROW))) (def: (io::exit codeI) (Unary Inst) - (|>> codeI jvm-intI + (|>> codeI jvm_intI (_.INVOKESTATIC $System "exit" (type.method [(list type.int) type.void (list)])) _.NULL)) -(def: (io::current-time _) +(def: (io::current_time _) (Nullary Inst) (|>> (_.INVOKESTATIC $System "currentTimeMillis" (type.method [(list) type.long (list)])) (_.wrap type.long))) @@ -316,7 +316,7 @@ (def: bundle::lux Bundle (|> (: Bundle bundle.empty) - (bundle.install "syntax char case!" lux::syntax-char-case!) + (bundle.install "syntax char case!" lux::syntax_char_case!) (bundle.install "is" (binary lux::is)) (bundle.install "try" (unary lux::try)))) @@ -327,9 +327,9 @@ (bundle.install "and" (binary i64::and)) (bundle.install "or" (binary i64::or)) (bundle.install "xor" (binary i64::xor)) - (bundle.install "left-shift" (binary i64::left-shift)) - (bundle.install "logical-right-shift" (binary i64::logical-right-shift)) - (bundle.install "arithmetic-right-shift" (binary i64::arithmetic-right-shift)) + (bundle.install "left-shift" (binary i64::left_shift)) + (bundle.install "logical-right-shift" (binary i64::logical_right_shift)) + (bundle.install "arithmetic-right-shift" (binary i64::arithmetic_right_shift)) (bundle.install "=" (binary i64::=)) (bundle.install "<" (binary i64::<)) (bundle.install "+" (binary i64::+)) @@ -377,7 +377,7 @@ (bundle.install "log" (unary io::log)) (bundle.install "error" (unary io::error)) (bundle.install "exit" (unary io::exit)) - (bundle.install "current-time" (nullary io::current-time))))) + (bundle.install "current-time" (nullary io::current_time))))) (def: #export bundle Bundle 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 77f421703..d83a6d841 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux @@ -74,11 +74,11 @@ [return Return parser.return] ) -(exception: #export (not-an-object-array {arrayJT (Type Array)}) +(exception: #export (not_an_object_array {arrayJT (Type Array)}) (exception.report ["JVM Type" (|> arrayJT type.signature signature.signature)])) -(def: #export object-array +(def: #export object_array (Parser (Type Object)) (do <>.monad [arrayJT (<t>.embed parser.array <s>.text)] @@ -89,7 +89,7 @@ (wrap elementJT) #.None - (<>.fail (exception.construct ..not-an-object-array arrayJT))) + (<>.fail (exception.construct ..not_an_object_array arrayJT))) #.None (undefined)))) @@ -112,60 +112,60 @@ (|>> inputI <conversion>)))] - [_.D2F conversion::double-to-float] - [_.D2I conversion::double-to-int] - [_.D2L conversion::double-to-long] - [_.F2D conversion::float-to-double] - [_.F2I conversion::float-to-int] - [_.F2L conversion::float-to-long] - [_.I2B conversion::int-to-byte] - [_.I2C conversion::int-to-char] - [_.I2D conversion::int-to-double] - [_.I2F conversion::int-to-float] - [_.I2L conversion::int-to-long] - [_.I2S conversion::int-to-short] - [_.L2D conversion::long-to-double] - [_.L2F conversion::long-to-float] - [_.L2I conversion::long-to-int] - [..L2S conversion::long-to-short] - [..L2B conversion::long-to-byte] - [..L2C conversion::long-to-char] - [_.I2B conversion::char-to-byte] - [_.I2S conversion::char-to-short] - [_.NOP conversion::char-to-int] - [_.I2L conversion::char-to-long] - [_.I2L conversion::byte-to-long] - [_.I2L conversion::short-to-long] + [_.D2F conversion::double_to_float] + [_.D2I conversion::double_to_int] + [_.D2L conversion::double_to_long] + [_.F2D conversion::float_to_double] + [_.F2I conversion::float_to_int] + [_.F2L conversion::float_to_long] + [_.I2B conversion::int_to_byte] + [_.I2C conversion::int_to_char] + [_.I2D conversion::int_to_double] + [_.I2F conversion::int_to_float] + [_.I2L conversion::int_to_long] + [_.I2S conversion::int_to_short] + [_.L2D conversion::long_to_double] + [_.L2F conversion::long_to_float] + [_.L2I conversion::long_to_int] + [..L2S conversion::long_to_short] + [..L2B conversion::long_to_byte] + [..L2C conversion::long_to_char] + [_.I2B conversion::char_to_byte] + [_.I2S conversion::char_to_short] + [_.NOP conversion::char_to_int] + [_.I2L conversion::char_to_long] + [_.I2L conversion::byte_to_long] + [_.I2L conversion::short_to_long] ) (def: conversion Bundle (<| (bundle.prefix "conversion") (|> (: Bundle bundle.empty) - (bundle.install "double-to-float" (unary conversion::double-to-float)) - (bundle.install "double-to-int" (unary conversion::double-to-int)) - (bundle.install "double-to-long" (unary conversion::double-to-long)) - (bundle.install "float-to-double" (unary conversion::float-to-double)) - (bundle.install "float-to-int" (unary conversion::float-to-int)) - (bundle.install "float-to-long" (unary conversion::float-to-long)) - (bundle.install "int-to-byte" (unary conversion::int-to-byte)) - (bundle.install "int-to-char" (unary conversion::int-to-char)) - (bundle.install "int-to-double" (unary conversion::int-to-double)) - (bundle.install "int-to-float" (unary conversion::int-to-float)) - (bundle.install "int-to-long" (unary conversion::int-to-long)) - (bundle.install "int-to-short" (unary conversion::int-to-short)) - (bundle.install "long-to-double" (unary conversion::long-to-double)) - (bundle.install "long-to-float" (unary conversion::long-to-float)) - (bundle.install "long-to-int" (unary conversion::long-to-int)) - (bundle.install "long-to-short" (unary conversion::long-to-short)) - (bundle.install "long-to-byte" (unary conversion::long-to-byte)) - (bundle.install "long-to-char" (unary conversion::long-to-char)) - (bundle.install "char-to-byte" (unary conversion::char-to-byte)) - (bundle.install "char-to-short" (unary conversion::char-to-short)) - (bundle.install "char-to-int" (unary conversion::char-to-int)) - (bundle.install "char-to-long" (unary conversion::char-to-long)) - (bundle.install "byte-to-long" (unary conversion::byte-to-long)) - (bundle.install "short-to-long" (unary conversion::short-to-long)) + (bundle.install "double-to-float" (unary conversion::double_to_float)) + (bundle.install "double-to-int" (unary conversion::double_to_int)) + (bundle.install "double-to-long" (unary conversion::double_to_long)) + (bundle.install "float-to-double" (unary conversion::float_to_double)) + (bundle.install "float-to-int" (unary conversion::float_to_int)) + (bundle.install "float-to-long" (unary conversion::float_to_long)) + (bundle.install "int-to-byte" (unary conversion::int_to_byte)) + (bundle.install "int-to-char" (unary conversion::int_to_char)) + (bundle.install "int-to-double" (unary conversion::int_to_double)) + (bundle.install "int-to-float" (unary conversion::int_to_float)) + (bundle.install "int-to-long" (unary conversion::int_to_long)) + (bundle.install "int-to-short" (unary conversion::int_to_short)) + (bundle.install "long-to-double" (unary conversion::long_to_double)) + (bundle.install "long-to-float" (unary conversion::long_to_float)) + (bundle.install "long-to-int" (unary conversion::long_to_int)) + (bundle.install "long-to-short" (unary conversion::long_to_short)) + (bundle.install "long-to-byte" (unary conversion::long_to_byte)) + (bundle.install "long-to-char" (unary conversion::long_to_char)) + (bundle.install "char-to-byte" (unary conversion::char_to_byte)) + (bundle.install "char-to-short" (unary conversion::char_to_short)) + (bundle.install "char-to-int" (unary conversion::char_to_int)) + (bundle.install "char-to-long" (unary conversion::char_to_long)) + (bundle.install "byte-to-long" (unary conversion::byte_to_long)) + (bundle.install "short-to-long" (unary conversion::short_to_long)) ))) (template [<name> <op>] @@ -219,8 +219,8 @@ (template [<name> <op>] [(def: (<name> [referenceI subjectI]) (Binary Inst) - (<| _.with-label (function (_ @then)) - _.with-label (function (_ @end)) + (<| _.with_label (function (_ @then)) + _.with_label (function (_ @end)) (|>> subjectI referenceI (<op> @then) @@ -240,8 +240,8 @@ (template [<name> <op> <reference>] [(def: (<name> [referenceI subjectI]) (Binary Inst) - (<| _.with-label (function (_ @then)) - _.with-label (function (_ @end)) + (<| _.with_label (function (_ @then)) + _.with_label (function (_ @end)) (|>> subjectI referenceI <op> @@ -335,72 +335,72 @@ (bundle.install "<" (binary char::<)) ))) -(def: (primitive-array-length-handler jvm-primitive) +(def: (primitive_array_length_handler jvm_primitive) (-> (Type Primitive) Handler) (..custom [<s>.any - (function (_ extension-name generate archive arrayS) + (function (_ extension_name generate archive arrayS) (do phase.monad [arrayI (generate archive arrayS)] (wrap (|>> arrayI - (_.CHECKCAST (type.array jvm-primitive)) + (_.CHECKCAST (type.array jvm_primitive)) _.ARRAYLENGTH))))])) (def: array::length::object Handler (..custom - [($_ <>.and ..object-array <s>.any) - (function (_ extension-name generate archive [elementJT arrayS]) + [($_ <>.and ..object_array <s>.any) + (function (_ extension_name generate archive [elementJT arrayS]) (do phase.monad [arrayI (generate archive arrayS)] (wrap (|>> arrayI (_.CHECKCAST (type.array elementJT)) _.ARRAYLENGTH))))])) -(def: (new-primitive-array-handler jvm-primitive) +(def: (new_primitive_array_handler jvm_primitive) (-> (Type Primitive) Handler) - (function (_ extension-name generate archive inputs) + (function (_ extension_name generate archive inputs) (case inputs (^ (list lengthS)) (do phase.monad [lengthI (generate archive lengthS)] (wrap (|>> lengthI - (_.array jvm-primitive)))) + (_.array jvm_primitive)))) _ - (phase.throw extension.invalid-syntax [extension-name %synthesis inputs])))) + (phase.throw extension.invalid_syntax [extension_name %synthesis inputs])))) (def: array::new::object Handler (..custom [($_ <>.and ..object <s>.any) - (function (_ extension-name generate archive [objectJT lengthS]) + (function (_ extension_name generate archive [objectJT lengthS]) (do phase.monad [lengthI (generate archive lengthS)] (wrap (|>> lengthI (_.ANEWARRAY objectJT)))))])) -(def: (read-primitive-array-handler jvm-primitive loadI) +(def: (read_primitive_array_handler jvm_primitive loadI) (-> (Type Primitive) Inst Handler) - (function (_ extension-name generate archive inputs) + (function (_ extension_name generate archive inputs) (case inputs (^ (list idxS arrayS)) (do phase.monad [arrayI (generate archive arrayS) idxI (generate archive idxS)] (wrap (|>> arrayI - (_.CHECKCAST (type.array jvm-primitive)) + (_.CHECKCAST (type.array jvm_primitive)) idxI loadI))) _ - (phase.throw extension.invalid-syntax [extension-name %synthesis inputs])))) + (phase.throw extension.invalid_syntax [extension_name %synthesis inputs])))) (def: array::read::object Handler (..custom - [($_ <>.and ..object-array <s>.any <s>.any) - (function (_ extension-name generate archive [elementJT idxS arrayS]) + [($_ <>.and ..object_array <s>.any <s>.any) + (function (_ extension_name generate archive [elementJT idxS arrayS]) (do phase.monad [arrayI (generate archive arrayS) idxI (generate archive idxS)] @@ -409,9 +409,9 @@ idxI _.AALOAD))))])) -(def: (write-primitive-array-handler jvm-primitive storeI) +(def: (write_primitive_array_handler jvm_primitive storeI) (-> (Type Primitive) Inst Handler) - (function (_ extension-name generate archive inputs) + (function (_ extension_name generate archive inputs) (case inputs (^ (list idxS valueS arrayS)) (do phase.monad @@ -419,20 +419,20 @@ idxI (generate archive idxS) valueI (generate archive valueS)] (wrap (|>> arrayI - (_.CHECKCAST (type.array jvm-primitive)) + (_.CHECKCAST (type.array jvm_primitive)) _.DUP idxI valueI storeI))) _ - (phase.throw extension.invalid-syntax [extension-name %synthesis inputs])))) + (phase.throw extension.invalid_syntax [extension_name %synthesis inputs])))) (def: array::write::object Handler (..custom - [($_ <>.and ..object-array <s>.any <s>.any <s>.any) - (function (_ extension-name generate archive [elementJT idxS valueS arrayS]) + [($_ <>.and ..object_array <s>.any <s>.any <s>.any) + (function (_ extension_name generate archive [elementJT idxS valueS arrayS]) (do phase.monad [arrayI (generate archive arrayS) idxI (generate archive idxS) @@ -450,47 +450,47 @@ (|> bundle.empty (dictionary.merge (<| (bundle.prefix "length") (|> bundle.empty - (bundle.install (reflection.reflection reflection.boolean) (primitive-array-length-handler type.boolean)) - (bundle.install (reflection.reflection reflection.byte) (primitive-array-length-handler type.byte)) - (bundle.install (reflection.reflection reflection.short) (primitive-array-length-handler type.short)) - (bundle.install (reflection.reflection reflection.int) (primitive-array-length-handler type.int)) - (bundle.install (reflection.reflection reflection.long) (primitive-array-length-handler type.long)) - (bundle.install (reflection.reflection reflection.float) (primitive-array-length-handler type.float)) - (bundle.install (reflection.reflection reflection.double) (primitive-array-length-handler type.double)) - (bundle.install (reflection.reflection reflection.char) (primitive-array-length-handler type.char)) + (bundle.install (reflection.reflection reflection.boolean) (primitive_array_length_handler type.boolean)) + (bundle.install (reflection.reflection reflection.byte) (primitive_array_length_handler type.byte)) + (bundle.install (reflection.reflection reflection.short) (primitive_array_length_handler type.short)) + (bundle.install (reflection.reflection reflection.int) (primitive_array_length_handler type.int)) + (bundle.install (reflection.reflection reflection.long) (primitive_array_length_handler type.long)) + (bundle.install (reflection.reflection reflection.float) (primitive_array_length_handler type.float)) + (bundle.install (reflection.reflection reflection.double) (primitive_array_length_handler type.double)) + (bundle.install (reflection.reflection reflection.char) (primitive_array_length_handler type.char)) (bundle.install "object" array::length::object)))) (dictionary.merge (<| (bundle.prefix "new") (|> bundle.empty - (bundle.install (reflection.reflection reflection.boolean) (new-primitive-array-handler type.boolean)) - (bundle.install (reflection.reflection reflection.byte) (new-primitive-array-handler type.byte)) - (bundle.install (reflection.reflection reflection.short) (new-primitive-array-handler type.short)) - (bundle.install (reflection.reflection reflection.int) (new-primitive-array-handler type.int)) - (bundle.install (reflection.reflection reflection.long) (new-primitive-array-handler type.long)) - (bundle.install (reflection.reflection reflection.float) (new-primitive-array-handler type.float)) - (bundle.install (reflection.reflection reflection.double) (new-primitive-array-handler type.double)) - (bundle.install (reflection.reflection reflection.char) (new-primitive-array-handler type.char)) + (bundle.install (reflection.reflection reflection.boolean) (new_primitive_array_handler type.boolean)) + (bundle.install (reflection.reflection reflection.byte) (new_primitive_array_handler type.byte)) + (bundle.install (reflection.reflection reflection.short) (new_primitive_array_handler type.short)) + (bundle.install (reflection.reflection reflection.int) (new_primitive_array_handler type.int)) + (bundle.install (reflection.reflection reflection.long) (new_primitive_array_handler type.long)) + (bundle.install (reflection.reflection reflection.float) (new_primitive_array_handler type.float)) + (bundle.install (reflection.reflection reflection.double) (new_primitive_array_handler type.double)) + (bundle.install (reflection.reflection reflection.char) (new_primitive_array_handler type.char)) (bundle.install "object" array::new::object)))) (dictionary.merge (<| (bundle.prefix "read") (|> bundle.empty - (bundle.install (reflection.reflection reflection.boolean) (read-primitive-array-handler type.boolean _.BALOAD)) - (bundle.install (reflection.reflection reflection.byte) (read-primitive-array-handler type.byte _.BALOAD)) - (bundle.install (reflection.reflection reflection.short) (read-primitive-array-handler type.short _.SALOAD)) - (bundle.install (reflection.reflection reflection.int) (read-primitive-array-handler type.int _.IALOAD)) - (bundle.install (reflection.reflection reflection.long) (read-primitive-array-handler type.long _.LALOAD)) - (bundle.install (reflection.reflection reflection.float) (read-primitive-array-handler type.float _.FALOAD)) - (bundle.install (reflection.reflection reflection.double) (read-primitive-array-handler type.double _.DALOAD)) - (bundle.install (reflection.reflection reflection.char) (read-primitive-array-handler type.char _.CALOAD)) + (bundle.install (reflection.reflection reflection.boolean) (read_primitive_array_handler type.boolean _.BALOAD)) + (bundle.install (reflection.reflection reflection.byte) (read_primitive_array_handler type.byte _.BALOAD)) + (bundle.install (reflection.reflection reflection.short) (read_primitive_array_handler type.short _.SALOAD)) + (bundle.install (reflection.reflection reflection.int) (read_primitive_array_handler type.int _.IALOAD)) + (bundle.install (reflection.reflection reflection.long) (read_primitive_array_handler type.long _.LALOAD)) + (bundle.install (reflection.reflection reflection.float) (read_primitive_array_handler type.float _.FALOAD)) + (bundle.install (reflection.reflection reflection.double) (read_primitive_array_handler type.double _.DALOAD)) + (bundle.install (reflection.reflection reflection.char) (read_primitive_array_handler type.char _.CALOAD)) (bundle.install "object" array::read::object)))) (dictionary.merge (<| (bundle.prefix "write") (|> bundle.empty - (bundle.install (reflection.reflection reflection.boolean) (write-primitive-array-handler type.boolean _.BASTORE)) - (bundle.install (reflection.reflection reflection.byte) (write-primitive-array-handler type.byte _.BASTORE)) - (bundle.install (reflection.reflection reflection.short) (write-primitive-array-handler type.short _.SASTORE)) - (bundle.install (reflection.reflection reflection.int) (write-primitive-array-handler type.int _.IASTORE)) - (bundle.install (reflection.reflection reflection.long) (write-primitive-array-handler type.long _.LASTORE)) - (bundle.install (reflection.reflection reflection.float) (write-primitive-array-handler type.float _.FASTORE)) - (bundle.install (reflection.reflection reflection.double) (write-primitive-array-handler type.double _.DASTORE)) - (bundle.install (reflection.reflection reflection.char) (write-primitive-array-handler type.char _.CASTORE)) + (bundle.install (reflection.reflection reflection.boolean) (write_primitive_array_handler type.boolean _.BASTORE)) + (bundle.install (reflection.reflection reflection.byte) (write_primitive_array_handler type.byte _.BASTORE)) + (bundle.install (reflection.reflection reflection.short) (write_primitive_array_handler type.short _.SASTORE)) + (bundle.install (reflection.reflection reflection.int) (write_primitive_array_handler type.int _.IASTORE)) + (bundle.install (reflection.reflection reflection.long) (write_primitive_array_handler type.long _.LASTORE)) + (bundle.install (reflection.reflection reflection.float) (write_primitive_array_handler type.float _.FASTORE)) + (bundle.install (reflection.reflection reflection.double) (write_primitive_array_handler type.double _.DASTORE)) + (bundle.install (reflection.reflection reflection.char) (write_primitive_array_handler type.char _.CASTORE)) (bundle.install "object" array::write::object)))) ))) @@ -500,8 +500,8 @@ (def: (object::null? objectI) (Unary Inst) - (<| _.with-label (function (_ @then)) - _.with-label (function (_ @end)) + (<| _.with_label (function (_ @then)) + _.with_label (function (_ @end)) (|>> objectI (_.IFNULL @then) falseI @@ -526,7 +526,7 @@ (def: $Class (type.class "java.lang.Class" (list))) -(def: (object::class extension-name generate archive inputs) +(def: (object::class extension_name generate archive inputs) Handler (case inputs (^ (list (synthesis.text class))) @@ -536,20 +536,20 @@ (_.INVOKESTATIC $Class "forName" (type.method [(list (type.class "java.lang.String" (list))) $Class (list)]))))) _ - (phase.throw extension.invalid-syntax [extension-name %synthesis inputs]))) + (phase.throw extension.invalid_syntax [extension_name %synthesis inputs]))) (def: object::instance? Handler (..custom [($_ <>.and <s>.text <s>.any) - (function (_ extension-name generate archive [class objectS]) + (function (_ extension_name generate archive [class objectS]) (do phase.monad [objectI (generate archive objectS)] (wrap (|>> objectI (_.INSTANCEOF (type.class class (list))) (_.wrap type.boolean)))))])) -(def: (object::cast extension-name generate archive inputs) +(def: (object::cast extension_name generate archive inputs) Handler (case inputs (^ (list (synthesis.text from) (synthesis.text to) valueS)) @@ -580,9 +580,9 @@ (wrap valueI)))) _ - (phase.throw extension.invalid-syntax [extension-name %synthesis inputs]))) + (phase.throw extension.invalid_syntax [extension_name %synthesis inputs]))) -(def: object-bundle +(def: object_bundle Bundle (<| (bundle.prefix "object") (|> (: Bundle bundle.empty) @@ -605,13 +605,13 @@ [(reflection.reflection reflection.float) type.float] [(reflection.reflection reflection.double) type.double] [(reflection.reflection reflection.char) type.char]) - (dictionary.from-list text.hash))) + (dictionary.from_list text.hash))) (def: get::static Handler (..custom [($_ <>.and <s>.text <s>.text <s>.text) - (function (_ extension-name generate archive [class field unboxed]) + (function (_ extension_name generate archive [class field unboxed]) (do phase.monad [] (case (dictionary.get unboxed ..primitives) @@ -625,7 +625,7 @@ Handler (..custom [($_ <>.and <s>.text <s>.text <s>.text <s>.any) - (function (_ extension-name generate archive [class field unboxed valueS]) + (function (_ extension_name generate archive [class field unboxed valueS]) (do phase.monad [valueI (generate archive valueS) #let [$class (type.class class (list))]] @@ -645,7 +645,7 @@ Handler (..custom [($_ <>.and <s>.text <s>.text <s>.text <s>.any) - (function (_ extension-name generate archive [class field unboxed objectS]) + (function (_ extension_name generate archive [class field unboxed objectS]) (do phase.monad [objectI (generate archive objectS) #let [$class (type.class class (list)) @@ -663,7 +663,7 @@ Handler (..custom [($_ <>.and <s>.text <s>.text <s>.text <s>.any <s>.any) - (function (_ extension-name generate archive [class field unboxed valueS objectS]) + (function (_ extension_name generate archive [class field unboxed valueS objectS]) (do phase.monad [valueI (generate archive valueS) objectI (generate archive objectS) @@ -688,7 +688,7 @@ (Parser Input) (<s>.tuple (<>.and ..value <s>.any))) -(def: (generate-input generate archive [valueT valueS]) +(def: (generate_input generate archive [valueT valueS]) (-> Phase Archive Input (Operation (Typed Inst))) (do phase.monad @@ -703,7 +703,7 @@ (def: voidI (_.string synthesis.unit)) -(def: (prepare-output outputT) +(def: (prepare_output outputT) (-> (Type Return) Inst) (case (type.void? outputT) (#.Right outputT) @@ -716,22 +716,22 @@ Handler (..custom [($_ <>.and ..class <s>.text ..return (<>.some ..input)) - (function (_ extension-name generate archive [class method outputT inputsTS]) + (function (_ extension_name generate archive [class method outputT inputsTS]) (do {@ phase.monad} - [inputsTI (monad.map @ (generate-input generate archive) inputsTS)] + [inputsTI (monad.map @ (generate_input generate archive) inputsTS)] (wrap (|>> (_.fuse (list@map product.right inputsTI)) (_.INVOKESTATIC class method (type.method [(list@map product.left inputsTI) outputT (list)])) - (prepare-output outputT)))))])) + (prepare_output outputT)))))])) (template [<name> <invoke>] [(def: <name> Handler (..custom [($_ <>.and ..class <s>.text ..return <s>.any (<>.some ..input)) - (function (_ extension-name generate archive [class method outputT objectS inputsTS]) + (function (_ extension_name generate archive [class method outputT objectS inputsTS]) (do {@ phase.monad} [objectI (generate archive objectS) - inputsTI (monad.map @ (generate-input generate archive) inputsTS)] + inputsTI (monad.map @ (generate_input generate archive) inputsTS)] (wrap (|>> objectI (_.CHECKCAST class) (_.fuse (list@map product.right inputsTI)) @@ -739,7 +739,7 @@ (type.method [(list@map product.left inputsTI) outputT (list)])) - (prepare-output outputT)))))]))] + (prepare_output outputT)))))]))] [invoke::virtual _.INVOKEVIRTUAL] [invoke::special _.INVOKESPECIAL] @@ -750,9 +750,9 @@ Handler (..custom [($_ <>.and ..class (<>.some ..input)) - (function (_ extension-name generate archive [class inputsTS]) + (function (_ extension_name generate archive [class inputsTS]) (do {@ phase.monad} - [inputsTI (monad.map @ (generate-input generate archive) inputsTS)] + [inputsTI (monad.map @ (generate_input generate archive) inputsTS)] (wrap (|>> (_.NEW class) _.DUP (_.fuse (list@map product.right inputsTI)) @@ -779,28 +779,28 @@ (bundle.install "constructor" invoke::constructor)))) ))) -(def: annotation-parameter - (Parser (/.Annotation-Parameter Synthesis)) +(def: annotation_parameter + (Parser (/.Annotation_Parameter Synthesis)) (<s>.tuple (<>.and <s>.text <s>.any))) (def: annotation (Parser (/.Annotation Synthesis)) - (<s>.tuple (<>.and <s>.text (<>.some ..annotation-parameter)))) + (<s>.tuple (<>.and <s>.text (<>.some ..annotation_parameter)))) (def: argument (Parser Argument) (<s>.tuple (<>.and <s>.text ..value))) -(def: overriden-method-definition - (Parser [(Environment Synthesis) (/.Overriden-Method Synthesis)]) +(def: overriden_method_definition + (Parser [(Environment Synthesis) (/.Overriden_Method Synthesis)]) (<s>.tuple (do <>.monad - [_ (<s>.text! /.overriden-tag) + [_ (<s>.text! /.overriden_tag) ownerT ..class name <s>.text - strict-fp? <s>.bit + strict_fp? <s>.bit annotations (<s>.tuple (<>.some ..annotation)) vars (<s>.tuple (<>.some ..var)) - self-name <s>.text + self_name <s>.text arguments (<s>.tuple (<>.some ..argument)) returnT ..return exceptionsT (<s>.tuple (<>.some ..class)) @@ -809,11 +809,11 @@ (<s>.tuple <s>.any)))] (wrap [environment [ownerT name - strict-fp? annotations vars - self-name arguments returnT exceptionsT + strict_fp? annotations vars + self_name arguments returnT exceptionsT body]])))) -(def: (normalize-path normalize) +(def: (normalize_path normalize) (-> (-> Synthesis Synthesis) (-> Path Path)) (function (recur path) @@ -834,21 +834,21 @@ [#synthesis.Bind] [#synthesis.Access]) - (#synthesis.Bit-Fork when then else) - (#synthesis.Bit-Fork when (recur then) (maybe@map recur else)) + (#synthesis.Bit_Fork when then else) + (#synthesis.Bit_Fork when (recur then) (maybe@map recur else)) (^template [<tag>] [(<tag> [[test then] elses]) (<tag> [[test (recur then)] - (list@map (function (_ [else-test else-then]) - [else-test (recur else-then)]) + (list@map (function (_ [else_test else_then]) + [else_test (recur else_then)]) elses)])]) - ([#synthesis.I64-Fork] - [#synthesis.F64-Fork] - [#synthesis.Text-Fork]) + ([#synthesis.I64_Fork] + [#synthesis.F64_Fork] + [#synthesis.Text_Fork]) ))) -(def: (normalize-method-body mapping) +(def: (normalize_method_body mapping) (-> (Dictionary Synthesis Variable) Synthesis Synthesis) (function (recur body) (case body @@ -871,7 +871,7 @@ synthesis.variable) (^ (synthesis.branch/case [inputS pathS])) - (synthesis.branch/case [(recur inputS) (normalize-path recur pathS)]) + (synthesis.branch/case [(recur inputS) (normalize_path recur pathS)]) (^ (synthesis.branch/let [inputS register outputS])) (synthesis.branch/let [(recur inputS) register (recur outputS)]) @@ -911,37 +911,37 @@ (def: $Object (type.class "java.lang.Object" (list))) -(def: (anonymous-init-method env) +(def: (anonymous_init_method env) (-> (Environment Synthesis) (Type Method)) (type.method [(list.repeat (list.size env) $Object) type.void (list)])) -(def: (with-anonymous-init class env super-class inputsTI) +(def: (with_anonymous_init class env super_class inputsTI) (-> (Type Class) (Environment Synthesis) (Type Class) (List (Typed Inst)) Def) - (let [store-capturedI (|> env + (let [store_capturedI (|> env list.size list.indices (list@map (.function (_ register) (|>> (_.ALOAD 0) (_.ALOAD (inc register)) - (_.PUTFIELD class (///reference.foreign-name register) $Object)))) + (_.PUTFIELD class (///reference.foreign_name register) $Object)))) _.fuse)] - (_def.method #$.Public $.noneM "<init>" (anonymous-init-method env) + (_def.method #$.Public $.noneM "<init>" (anonymous_init_method env) (|>> (_.ALOAD 0) ((_.fuse (list@map product.right inputsTI))) - (_.INVOKESPECIAL super-class "<init>" (type.method [(list@map product.left inputsTI) type.void (list)])) - store-capturedI + (_.INVOKESPECIAL super_class "<init>" (type.method [(list@map product.left inputsTI) type.void (list)])) + store_capturedI _.RETURN)))) -(def: (anonymous-instance generate archive class env) +(def: (anonymous_instance generate archive class env) (-> Phase Archive (Type Class) (Environment Synthesis) (Operation Inst)) (do {@ phase.monad} [captureI+ (monad.map @ (generate archive) env)] (wrap (|>> (_.NEW class) _.DUP (_.fuse captureI+) - (_.INVOKESPECIAL class "<init>" (anonymous-init-method env)))))) + (_.INVOKESPECIAL class "<init>" (anonymous_init_method env)))))) (def: (returnI returnT) (-> (Type Return) Inst) @@ -979,58 +979,58 @@ ..class (<s>.tuple (<>.some ..class)) (<s>.tuple (<>.some ..input)) - (<s>.tuple (<>.some ..overriden-method-definition))) - (function (_ extension-name generate archive [super-class super-interfaces + (<s>.tuple (<>.some ..overriden_method_definition))) + (function (_ extension_name generate archive [super_class super_interfaces inputsTS - overriden-methods]) + overriden_methods]) (do {@ phase.monad} - [[context _] (generation.with-new-context archive (wrap [])) - #let [[module-id artifact-id] context - anonymous-class-name (///.class-name context) - class (type.class anonymous-class-name (list)) - total-environment (|> overriden-methods + [[context _] (generation.with_new_context archive (wrap [])) + #let [[module_id artifact_id] context + anonymous_class_name (///.class_name context) + class (type.class anonymous_class_name (list)) + total_environment (|> overriden_methods ## Get all the environments. (list@map product.left) ## Combine them. list@join ## Remove duplicates. - (set.from-list synthesis.hash) - set.to-list) - global-mapping (|> total-environment + (set.from_list synthesis.hash) + set.to_list) + global_mapping (|> total_environment ## Give them names as "foreign" variables. list.enumeration (list@map (function (_ [id capture]) [capture (#variable.Foreign id)])) - (dictionary.from-list synthesis.hash)) - normalized-methods (list@map (function (_ [environment + (dictionary.from_list synthesis.hash)) + normalized_methods (list@map (function (_ [environment [ownerT name - strict-fp? annotations vars - self-name arguments returnT exceptionsT + strict_fp? annotations vars + self_name arguments returnT exceptionsT body]]) - (let [local-mapping (|> environment + (let [local_mapping (|> environment list.enumeration - (list@map (function (_ [foreign-id capture]) - [(synthesis.variable/foreign foreign-id) - (|> global-mapping + (list@map (function (_ [foreign_id capture]) + [(synthesis.variable/foreign foreign_id) + (|> global_mapping (dictionary.get capture) maybe.assume)])) - (dictionary.from-list synthesis.hash))] + (dictionary.from_list synthesis.hash))] [ownerT name - strict-fp? annotations vars - self-name arguments returnT exceptionsT - (normalize-method-body local-mapping body)])) - overriden-methods)] - inputsTI (monad.map @ (generate-input generate archive) inputsTS) - method-definitions (|> normalized-methods + strict_fp? annotations vars + self_name arguments returnT exceptionsT + (normalize_method_body local_mapping body)])) + overriden_methods)] + inputsTI (monad.map @ (generate_input generate archive) inputsTS) + method_definitions (|> normalized_methods (monad.map @ (function (_ [ownerT name - strict-fp? annotations vars - self-name arguments returnT exceptionsT + strict_fp? annotations vars + self_name arguments returnT exceptionsT bodyS]) (do @ - [bodyG (generation.with-context artifact-id + [bodyG (generation.with_context artifact_id (generate archive bodyS))] (wrap (_def.method #$.Public - (if strict-fp? + (if strict_fp? ($_ $.++M $.finalM $.strictM) $.finalM) name @@ -1039,16 +1039,16 @@ exceptionsT]) (|>> bodyG (returnI returnT))))))) (\ @ map _def.fuse)) - #let [directive [anonymous-class-name + #let [directive [anonymous_class_name (_def.class #$.V1_6 #$.Public $.finalC - anonymous-class-name (list) - super-class super-interfaces - (|>> (///function.with-environment total-environment) - (..with-anonymous-init class total-environment super-class inputsTI) - method-definitions))]] + anonymous_class_name (list) + super_class super_interfaces + (|>> (///function.with_environment total_environment) + (..with_anonymous_init class total_environment super_class inputsTI) + method_definitions))]] _ (generation.execute! directive) - _ (generation.save! (%.nat artifact-id) directive)] - (..anonymous-instance generate archive class total-environment)))])) + _ (generation.save! (%.nat artifact_id) directive)] + (..anonymous_instance generate archive class total_environment)))])) (def: bundle::class Bundle @@ -1067,7 +1067,7 @@ (dictionary.merge ..double) (dictionary.merge ..char) (dictionary.merge ..array) - (dictionary.merge ..object-bundle) + (dictionary.merge ..object_bundle) (dictionary.merge ..member) (dictionary.merge ..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 97b32f8c2..0fe7717fb 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/function.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/function.lux @@ -42,35 +42,35 @@ ["#." runtime] ["." reference]]) -(def: arity-field Text "arity") +(def: arity_field Text "arity") -(def: (poly-arg? arity) +(def: poly_arg? (-> Arity Bit) - (n.> 1 arity)) + (n.> 1)) -(def: (captured-args env) +(def: (captured_args env) (-> (Environment Synthesis) (List (Type Value))) (list.repeat (list.size env) //.$Value)) -(def: (init-method env arity) +(def: (init_method env arity) (-> (Environment Synthesis) Arity (Type Method)) - (if (poly-arg? arity) - (type.method [(list.concat (list (captured-args env) + (if (poly_arg? arity) + (type.method [(list.concat (list (captured_args env) (list type.int) (list.repeat (dec arity) //.$Value))) type.void (list)]) - (type.method [(captured-args env) type.void (list)]))) + (type.method [(captured_args env) type.void (list)]))) -(def: (implementation-method arity) +(def: (implementation_method arity) (type.method [(list.repeat arity //.$Value) //.$Value (list)])) -(def: get-amount-of-partialsI +(def: get_amount_of_partialsI Inst (|>> (_.ALOAD 0) - (_.GETFIELD //.$Function //runtime.partials-field type.int))) + (_.GETFIELD //.$Function //runtime.partials_field type.int))) -(def: (load-fieldI class field) +(def: (load_fieldI class field) (-> (Type Class) Text Inst) (|>> (_.ALOAD 0) (_.GETFIELD class field //.$Value))) @@ -83,16 +83,16 @@ (def: (applysI start amount) (-> Register Nat Inst) - (let [max-args (n.min amount //runtime.num-apply-variants) - later-applysI (if (n.> //runtime.num-apply-variants amount) - (applysI (n.+ //runtime.num-apply-variants start) (n.- //runtime.num-apply-variants amount)) + (let [max_args (n.min amount //runtime.num_apply_variants) + later_applysI (if (n.> //runtime.num_apply_variants amount) + (applysI (n.+ //runtime.num_apply_variants start) (n.- //runtime.num_apply_variants amount)) function.identity)] (|>> (_.CHECKCAST //.$Function) - (inputsI start max-args) - (_.INVOKEVIRTUAL //.$Function //runtime.apply-method (//runtime.apply-signature max-args)) - later-applysI))) + (inputsI start max_args) + (_.INVOKEVIRTUAL //.$Function //runtime.apply_method (//runtime.apply_signature max_args)) + later_applysI))) -(def: (inc-intI by) +(def: (inc_intI by) (-> Nat Inst) (|>> (_.int (.int by)) _.IADD)) @@ -107,7 +107,7 @@ (-> Phase Archive (Type Class) Arity (Environment Synthesis) (Operation Inst)) (do {@ phase.monad} [captureI+ (monad.map @ (generate archive) env) - #let [argsI (if (poly-arg? arity) + #let [argsI (if (poly_arg? arity) (|> (nullsI (dec arity)) (list (_.int +0)) _.fuse) @@ -116,23 +116,23 @@ _.DUP (_.fuse captureI+) argsI - (_.INVOKESPECIAL class "<init>" (init-method env arity)))))) + (_.INVOKESPECIAL class "<init>" (init_method env arity)))))) -(def: (reset-method return) +(def: (reset_method return) (-> (Type Class) (Type Method)) (type.method [(list) return (list)])) -(def: (with-reset class arity env) +(def: (with_reset class arity env) (-> (Type Class) Arity (Environment Synthesis) Def) - (def.method #$.Public $.noneM "reset" (reset-method class) - (if (poly-arg? arity) - (let [env-size (list.size env) - captureI (|> (case env-size + (def.method #$.Public $.noneM "reset" (reset_method class) + (if (poly_arg? arity) + (let [env_size (list.size env) + captureI (|> (case env_size 0 (list) - _ (enum.range n.enum 0 (dec env-size))) + _ (enum.range n.enum 0 (dec env_size))) (list@map (.function (_ source) (|>> (_.ALOAD 0) - (_.GETFIELD class (reference.foreign-name source) //.$Value)))) + (_.GETFIELD class (reference.foreign_name source) //.$Value)))) _.fuse) argsI (|> (nullsI (dec arity)) (list (_.int +0)) @@ -141,159 +141,159 @@ _.DUP captureI argsI - (_.INVOKESPECIAL class "<init>" (init-method env arity)) + (_.INVOKESPECIAL class "<init>" (init_method env arity)) _.ARETURN)) (|>> (_.ALOAD 0) _.ARETURN)))) -(def: (with-implementation arity @begin bodyI) +(def: (with_implementation arity @begin bodyI) (-> Nat Label Inst Def) - (def.method #$.Public $.strictM "impl" (implementation-method arity) + (def.method #$.Public $.strictM "impl" (implementation_method arity) (|>> (_.label @begin) bodyI _.ARETURN))) -(def: function-init-method +(def: function_init_method (type.method [(list type.int) type.void (list)])) -(def: (function-init arity env-size) +(def: (function_init arity env_size) (-> Arity Nat Inst) (if (n.= 1 arity) (|>> (_.int +0) - (_.INVOKESPECIAL //.$Function "<init>" function-init-method)) - (|>> (_.ILOAD (inc env-size)) - (_.INVOKESPECIAL //.$Function "<init>" function-init-method)))) + (_.INVOKESPECIAL //.$Function "<init>" function_init_method)) + (|>> (_.ILOAD (inc env_size)) + (_.INVOKESPECIAL //.$Function "<init>" function_init_method)))) -(def: (with-init class env arity) +(def: (with_init class env arity) (-> (Type Class) (Environment Synthesis) Arity Def) - (let [env-size (list.size env) - offset-partial (: (-> Nat Nat) - (|>> inc (n.+ env-size))) - store-capturedI (|> (case env-size + (let [env_size (list.size env) + offset_partial (: (-> Nat Nat) + (|>> inc (n.+ env_size))) + store_capturedI (|> (case env_size 0 (list) - _ (enum.range n.enum 0 (dec env-size))) + _ (enum.range n.enum 0 (dec env_size))) (list@map (.function (_ register) (|>> (_.ALOAD 0) (_.ALOAD (inc register)) - (_.PUTFIELD class (reference.foreign-name register) //.$Value)))) + (_.PUTFIELD class (reference.foreign_name register) //.$Value)))) _.fuse) - store-partialI (if (poly-arg? arity) + store_partialI (if (poly_arg? arity) (|> (enum.range n.enum 0 (n.- 2 arity)) (list@map (.function (_ idx) - (let [register (offset-partial idx)] + (let [register (offset_partial idx)] (|>> (_.ALOAD 0) (_.ALOAD (inc register)) - (_.PUTFIELD class (reference.partial-name idx) //.$Value))))) + (_.PUTFIELD class (reference.partial_name idx) //.$Value))))) _.fuse) function.identity)] - (def.method #$.Public $.noneM "<init>" (init-method env arity) + (def.method #$.Public $.noneM "<init>" (init_method env arity) (|>> (_.ALOAD 0) - (function-init arity env-size) - store-capturedI - store-partialI + (function_init arity env_size) + store_capturedI + store_partialI _.RETURN)))) -(def: (with-apply class env function-arity @begin bodyI apply-arity) +(def: (with_apply class env function_arity @begin bodyI apply_arity) (-> (Type Class) (Environment Synthesis) Arity Label Inst Arity Def) - (let [num-partials (dec function-arity) - @default ($.new-label []) - @labels (list@map $.new-label (list.repeat num-partials [])) - over-extent (|> (.int function-arity) (i.- (.int apply-arity))) + (let [num_partials (dec function_arity) + @default ($.new_label []) + @labels (list@map $.new_label (list.repeat num_partials [])) + over_extent (|> (.int function_arity) (i.- (.int apply_arity))) casesI (|> (list@compose @labels (list @default)) - (list.zip/2 (enum.range n.enum 0 num-partials)) + (list.zip/2 (enum.range n.enum 0 num_partials)) (list@map (.function (_ [stage @label]) - (let [load-partialsI (if (n.> 0 stage) + (let [load_partialsI (if (n.> 0 stage) (|> (enum.range n.enum 0 (dec stage)) - (list@map (|>> reference.partial-name (load-fieldI class))) + (list@map (|>> reference.partial_name (load_fieldI class))) _.fuse) function.identity)] - (cond (i.= over-extent (.int stage)) + (cond (i.= over_extent (.int stage)) (|>> (_.label @label) (_.ALOAD 0) (when> [(new> (n.> 0 stage) [])] - [(_.INVOKEVIRTUAL class "reset" (reset-method class))]) - load-partialsI - (inputsI 1 apply-arity) - (_.INVOKEVIRTUAL class "impl" (implementation-method function-arity)) + [(_.INVOKEVIRTUAL class "reset" (reset_method class))]) + load_partialsI + (inputsI 1 apply_arity) + (_.INVOKEVIRTUAL class "impl" (implementation_method function_arity)) _.ARETURN) - (i.> over-extent (.int stage)) - (let [args-to-completion (|> function-arity (n.- stage)) - args-left (|> apply-arity (n.- args-to-completion))] + (i.> over_extent (.int stage)) + (let [args_to_completion (|> function_arity (n.- stage)) + args_left (|> apply_arity (n.- args_to_completion))] (|>> (_.label @label) (_.ALOAD 0) - (_.INVOKEVIRTUAL class "reset" (reset-method class)) - load-partialsI - (inputsI 1 args-to-completion) - (_.INVOKEVIRTUAL class "impl" (implementation-method function-arity)) - (applysI (inc args-to-completion) args-left) + (_.INVOKEVIRTUAL class "reset" (reset_method class)) + load_partialsI + (inputsI 1 args_to_completion) + (_.INVOKEVIRTUAL class "impl" (implementation_method function_arity)) + (applysI (inc args_to_completion) args_left) _.ARETURN)) - ## (i.< over-extent (.int stage)) - (let [env-size (list.size env) - load-capturedI (|> (case env-size + ## (i.< over_extent (.int stage)) + (let [env_size (list.size env) + load_capturedI (|> (case env_size 0 (list) - _ (enum.range n.enum 0 (dec env-size))) - (list@map (|>> reference.foreign-name (load-fieldI class))) + _ (enum.range n.enum 0 (dec env_size))) + (list@map (|>> reference.foreign_name (load_fieldI class))) _.fuse)] (|>> (_.label @label) (_.NEW class) _.DUP - load-capturedI - get-amount-of-partialsI - (inc-intI apply-arity) - load-partialsI - (inputsI 1 apply-arity) - (nullsI (|> num-partials (n.- apply-arity) (n.- stage))) - (_.INVOKESPECIAL class "<init>" (init-method env function-arity)) + load_capturedI + get_amount_of_partialsI + (inc_intI apply_arity) + load_partialsI + (inputsI 1 apply_arity) + (nullsI (|> num_partials (n.- apply_arity) (n.- stage))) + (_.INVOKESPECIAL class "<init>" (init_method env function_arity)) _.ARETURN)) )))) _.fuse)] - (def.method #$.Public $.noneM //runtime.apply-method (//runtime.apply-signature apply-arity) - (|>> get-amount-of-partialsI - (_.TABLESWITCH +0 (|> num-partials dec .int) + (def.method #$.Public $.noneM //runtime.apply_method (//runtime.apply_signature apply_arity) + (|>> get_amount_of_partialsI + (_.TABLESWITCH +0 (|> num_partials dec .int) @default @labels) casesI )))) -(def: #export with-environment +(def: #export with_environment (-> (Environment Synthesis) Def) (|>> list.enumeration - (list@map (.function (_ [env-idx env-source]) - (def.field #$.Private $.finalF (reference.foreign-name env-idx) //.$Value))) + (list@map (.function (_ [env_idx env_source]) + (def.field #$.Private $.finalF (reference.foreign_name env_idx) //.$Value))) def.fuse)) -(def: (with-partial arity) +(def: (with_partial arity) (-> Arity Def) - (if (poly-arg? arity) + (if (poly_arg? arity) (|> (enum.range n.enum 0 (n.- 2 arity)) (list@map (.function (_ idx) - (def.field #$.Private $.finalF (reference.partial-name idx) //.$Value))) + (def.field #$.Private $.finalF (reference.partial_name idx) //.$Value))) def.fuse) function.identity)) -(def: #export (with-function generate archive @begin class env arity bodyI) +(def: #export (with_function generate archive @begin class env arity bodyI) (-> Phase Archive Label Text (Environment Synthesis) Arity Inst (Operation [Def Inst])) (let [classD (type.class class (list)) applyD (: Def - (if (poly-arg? arity) - (|> (n.min arity //runtime.num-apply-variants) + (if (poly_arg? arity) + (|> (n.min arity //runtime.num_apply_variants) (enum.range n.enum 1) - (list@map (with-apply classD env arity @begin bodyI)) - (list& (with-implementation arity @begin bodyI)) + (list@map (with_apply classD env arity @begin bodyI)) + (list& (with_implementation arity @begin bodyI)) def.fuse) - (def.method #$.Public $.strictM //runtime.apply-method (//runtime.apply-signature 1) + (def.method #$.Public $.strictM //runtime.apply_method (//runtime.apply_signature 1) (|>> (_.label @begin) bodyI _.ARETURN)))) functionD (: Def - (|>> (def.int-field #$.Public ($_ $.++F $.staticF $.finalF) arity-field (.int arity)) - (with-environment env) - (with-partial arity) - (with-init classD env arity) - (with-reset classD arity env) + (|>> (def.int_field #$.Public ($_ $.++F $.staticF $.finalF) arity_field (.int arity)) + (with_environment env) + (with_partial arity) + (with_init classD env arity) + (with_reset classD arity env) applyD ))] (do phase.monad @@ -303,19 +303,19 @@ (def: #export (function generate archive [env arity bodyS]) (Generator Abstraction) (do phase.monad - [@begin _.make-label - [function-context bodyI] (generation.with-new-context archive - (generation.with-anchor [@begin 1] + [@begin _.make_label + [function_context bodyI] (generation.with_new_context archive + (generation.with_anchor [@begin 1] (generate archive bodyS))) - #let [function-class (//.class-name function-context)] - [functionD instanceI] (..with-function generate archive @begin function-class env arity bodyI) - #let [directive [function-class + #let [function_class (//.class_name function_context)] + [functionD instanceI] (..with_function generate archive @begin function_class env arity bodyI) + #let [directive [function_class (def.class #$.V1_6 #$.Public $.finalC - function-class (list) + function_class (list) //.$Function (list) functionD)]] _ (generation.execute! directive) - _ (generation.save! (%.nat (product.right function-context)) directive)] + _ (generation.save! (%.nat (product.right function_context)) directive)] (wrap instanceI))) (def: #export (call generate archive [functionS argsS]) @@ -324,11 +324,11 @@ [functionI (generate archive functionS) argsI (monad.map @ (generate archive) argsS) #let [applyI (|> argsI - (list.chunk //runtime.num-apply-variants) + (list.chunk //runtime.num_apply_variants) (list@map (.function (_ chunkI+) (|>> (_.CHECKCAST //.$Function) (_.fuse chunkI+) - (_.INVOKEVIRTUAL //.$Function //runtime.apply-method (//runtime.apply-signature (list.size chunkI+)))))) + (_.INVOKEVIRTUAL //.$Function //runtime.apply_method (//runtime.apply_signature (list.size chunkI+)))))) _.fuse)]] (wrap (|>> functionI applyI)))) diff --git a/lux-jvm/source/luxc/lang/translation/jvm/loop.lux b/lux-jvm/source/luxc/lang/translation/jvm/loop.lux index 1d22b0e63..4b44561c7 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/loop.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/loop.lux @@ -69,9 +69,9 @@ (def: #export (scope translate archive [start initsS+ iterationS]) (Generator [Nat (List Synthesis) Synthesis]) (do {@ phase.monad} - [@begin _.make-label + [@begin _.make_label initsI+ (monad.map @ (translate archive) initsS+) - iterationI (generation.with-anchor [@begin start] + iterationI (generation.with_anchor [@begin start] (translate archive iterationS)) #let [initializationI (|> (list.enumeration initsI+) (list@map (function (_ [register initI]) diff --git a/lux-jvm/source/luxc/lang/translation/jvm/program.lux b/lux-jvm/source/luxc/lang/translation/jvm/program.lux index 2c4f1d3f2..234c20fa9 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/program.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/program.lux @@ -24,10 +24,10 @@ (def: ^Object ($t.class "java.lang.Object" (list))) -(def: #export (program artifact-name context programI) +(def: #export (program artifact_name context programI) (-> (-> Context Text) (Program _.Inst _.Definition)) (let [nilI runtime.noneI - num-inputsI (|>> ($i.ALOAD 0) $i.ARRAYLENGTH) + num_inputsI (|>> ($i.ALOAD 0) $i.ARRAYLENGTH) decI (|>> ($i.int +1) $i.ISUB) headI (|>> $i.DUP ($i.ALOAD 0) @@ -53,10 +53,10 @@ $i.DUP2_X1 $i.POP2 runtime.variantI) - prepare-input-listI (<| $i.with-label (function (_ @loop)) - $i.with-label (function (_ @end)) + prepare_input_listI (<| $i.with_label (function (_ @loop)) + $i.with_label (function (_ @end)) (|>> nilI - num-inputsI + num_inputsI ($i.label @loop) decI $i.DUP @@ -68,23 +68,23 @@ ($i.GOTO @loop) ($i.label @end) $i.POP)) - feed-inputsI ($i.INVOKEVIRTUAL jvm.$Function runtime.apply-method (runtime.apply-signature 1)) - run-ioI (|>> ($i.CHECKCAST jvm.$Function) + feed_inputsI ($i.INVOKEVIRTUAL jvm.$Function runtime.apply_method (runtime.apply_signature 1)) + run_ioI (|>> ($i.CHECKCAST jvm.$Function) $i.NULL - ($i.INVOKEVIRTUAL jvm.$Function runtime.apply-method (runtime.apply-signature 1))) - main-type ($t.method [(list ($t.array ($t.class "java.lang.String" (list)))) + ($i.INVOKEVIRTUAL jvm.$Function runtime.apply_method (runtime.apply_signature 1))) + main_type ($t.method [(list ($t.array ($t.class "java.lang.String" (list)))) $t.void (list)]) - class (artifact-name context)] + class (artifact_name context)] [class ($d.class #_.V1_6 #_.Public _.finalC class (list) ..^Object (list) - (|>> ($d.method #_.Public _.staticM "main" main-type + (|>> ($d.method #_.Public _.staticM "main" main_type (|>> programI - prepare-input-listI - feed-inputsI - run-ioI + prepare_input_listI + feed_inputsI + run_ioI $i.RETURN))))])) diff --git a/lux-jvm/source/luxc/lang/translation/jvm/reference.lux b/lux-jvm/source/luxc/lang/translation/jvm/reference.lux index c7570d01a..d2a524a82 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/reference.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/reference.lux @@ -31,18 +31,18 @@ (-> Nat Text) (|>> %.nat (format <prefix>)))] - [foreign-name "f"] - [partial-name "p"] + [foreign_name "f"] + [partial_name "p"] ) (def: (foreign archive variable) (-> Archive Register (Operation Inst)) (do {@ phase.monad} - [class-name (\ @ map //.class-name + [class_name (\ @ map //.class_name (generation.context archive))] (wrap (|>> (_.ALOAD 0) - (_.GETFIELD (type.class class-name (list)) - (|> variable .nat foreign-name) + (_.GETFIELD (type.class class_name (list)) + (|> variable .nat foreign_name) //.$Value))))) (def: local @@ -61,6 +61,6 @@ (def: #export (constant archive name) (-> Archive Name (Operation Inst)) (do {@ phase.monad} - [class-name (\ @ map //.class-name + [class_name (\ @ map //.class_name (generation.remember archive name))] - (wrap (_.GETSTATIC (type.class class-name (list)) //.value-field //.$Value)))) + (wrap (_.GETSTATIC (type.class class_name (list)) //.value_field //.$Value)))) diff --git a/lux-jvm/source/luxc/lang/translation/jvm/runtime.lux b/lux-jvm/source/luxc/lang/translation/jvm/runtime.lux index e7a37584e..061972df1 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/runtime.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/runtime.lux @@ -46,10 +46,10 @@ (def: #export $Stack (type.array $Value)) (def: $Throwable (type.class "java.lang.Throwable" (list))) -(def: nullary-init-methodT +(def: nullary_init_methodT (type.method [(list) type.void (list)])) -(def: throw-methodT +(def: throw_methodT (type.method [(list) type.void (list)])) (def: #export logI @@ -61,12 +61,12 @@ (|>> outI (_.string "LOG: ") (printI "print") outI _.SWAP (printI "println")))) -(def: variant-method +(def: variant_method (type.method [(list $Tag $Flag $Value) //.$Variant (list)])) (def: #export variantI Inst - (_.INVOKESTATIC //.$Runtime "variant_make" variant-method)) + (_.INVOKESTATIC //.$Runtime "variant_make" variant_method)) (def: #export leftI Inst @@ -95,9 +95,9 @@ (def: (tryI unsafeI) (-> Inst Inst) - (<| _.with-label (function (_ @from)) - _.with-label (function (_ @to)) - _.with-label (function (_ @handler)) + (<| _.with_label (function (_ @from)) + _.with_label (function (_ @to)) + _.with_label (function (_ @handler)) (|>> (_.try @from @to @handler (type.class "java.lang.Exception" (list))) (_.label @from) unsafeI @@ -108,29 +108,29 @@ noneI _.ARETURN))) -(def: #export partials-field Text "partials") -(def: #export apply-method Text "apply") -(def: #export num-apply-variants Nat 8) +(def: #export partials_field Text "partials") +(def: #export apply_method Text "apply") +(def: #export num_apply_variants Nat 8) -(def: #export (apply-signature arity) +(def: #export (apply_signature arity) (-> Arity (Type Method)) (type.method [(list.repeat arity $Value) $Value (list)])) -(def: adt-methods +(def: adt_methods Def - (let [store-tagI (|>> _.DUP _.ICONST_0 (_.ILOAD 0) (_.wrap type.int) _.AASTORE) - store-flagI (|>> _.DUP _.ICONST_1 (_.ALOAD 1) _.AASTORE) - store-valueI (|>> _.DUP _.ICONST_2 (_.ALOAD 2) _.AASTORE)] + (let [store_tagI (|>> _.DUP _.ICONST_0 (_.ILOAD 0) (_.wrap type.int) _.AASTORE) + store_flagI (|>> _.DUP _.ICONST_1 (_.ALOAD 1) _.AASTORE) + store_valueI (|>> _.DUP _.ICONST_2 (_.ALOAD 2) _.AASTORE)] (|>> ($d.method #$.Public $.staticM "variant_make" (type.method [(list $Tag $Flag $Value) //.$Variant (list)]) (|>> _.ICONST_3 (_.ANEWARRAY $Value) - store-tagI - store-flagI - store-valueI + store_tagI + store_flagI + store_valueI _.ARETURN))))) -(def: frac-methods +(def: frac_methods Def (|>> ($d.method #$.Public $.staticM "decode_frac" (type.method [(list $Text) //.$Variant (list)]) (tryI @@ -139,7 +139,7 @@ (_.wrap type.double)))) )) -(def: (illegal-state-exception message) +(def: (illegal_state_exception message) (-> Text Inst) (let [IllegalStateException (type.class "java.lang.IllegalStateException" (list))] (|>> (_.NEW IllegalStateException) @@ -147,32 +147,32 @@ (_.string message) (_.INVOKESPECIAL IllegalStateException "<init>" (type.method [(list $Text) type.void (list)]))))) -(def: pm-methods +(def: pm_methods Def - (let [tuple-sizeI (|>> (_.ALOAD 0) + (let [tuple_sizeI (|>> (_.ALOAD 0) _.ARRAYLENGTH) - last-rightI (|>> tuple-sizeI + last_rightI (|>> tuple_sizeI _.ICONST_1 _.ISUB) leftsI (_.ILOAD 1) - left-indexI leftsI - sub-leftsI (|>> leftsI - last-rightI + left_indexI leftsI + sub_leftsI (|>> leftsI + last_rightI _.ISUB) - sub-tupleI (|>> (_.ALOAD 0) - last-rightI + sub_tupleI (|>> (_.ALOAD 0) + last_rightI _.AALOAD (_.CHECKCAST //.$Tuple)) recurI (: (-> Label Inst) (function (_ @loop) - (|>> sub-leftsI (_.ISTORE 1) - sub-tupleI (_.ASTORE 0) + (|>> sub_leftsI (_.ISTORE 1) + sub_tupleI (_.ASTORE 0) (_.GOTO @loop))))] - (|>> ($d.method #$.Public $.staticM "pm_fail" throw-methodT - (|>> (illegal-state-exception "Invalid expression for pattern-matching.") + (|>> ($d.method #$.Public $.staticM "pm_fail" throw_methodT + (|>> (illegal_state_exception "Invalid expression for pattern-matching.") _.ATHROW)) - ($d.method #$.Public $.staticM "apply_fail" throw-methodT - (|>> (illegal-state-exception "Error while applying function.") + ($d.method #$.Public $.staticM "apply_fail" throw_methodT + (|>> (illegal_state_exception "Error while applying function.") _.ATHROW)) ($d.method #$.Public $.staticM "pm_push" (type.method [(list $Stack $Value) $Stack (list)]) (|>> _.ICONST_2 @@ -187,119 +187,119 @@ _.AASTORE _.ARETURN)) ($d.method #$.Public $.staticM "pm_variant" (type.method [(list //.$Variant $Tag $Flag) $Value (list)]) - (<| _.with-label (function (_ @loop)) - _.with-label (function (_ @perfect-match!)) - _.with-label (function (_ @tags-match!)) - _.with-label (function (_ @maybe-nested)) - _.with-label (function (_ @mismatch!)) + (<| _.with_label (function (_ @loop)) + _.with_label (function (_ @perfect_match!)) + _.with_label (function (_ @tags_match!)) + _.with_label (function (_ @maybe_nested)) + _.with_label (function (_ @mismatch!)) (let [$variant (_.ALOAD 0) $tag (_.ILOAD 1) $last? (_.ALOAD 2) - variant-partI (: (-> Nat Inst) + variant_partI (: (-> Nat Inst) (function (_ idx) (|>> (_.int (.int idx)) _.AALOAD))) ::tag (: Inst - (|>> (variant-partI 0) (_.unwrap type.int))) - ::last? (variant-partI 1) - ::value (variant-partI 2) + (|>> (variant_partI 0) (_.unwrap type.int))) + ::last? (variant_partI 1) + ::value (variant_partI 2) - super-nested-tag (|>> _.SWAP ## variant::tag, tag + super_nested_tag (|>> _.SWAP ## variant::tag, tag _.ISUB) - super-nested (|>> super-nested-tag ## super-tag - $variant ::last? ## super-tag, super-last - $variant ::value ## super-tag, super-last, super-value + super_nested (|>> super_nested_tag ## super_tag + $variant ::last? ## super_tag, super_last + $variant ::value ## super_tag, super_last, super_value ..variantI) - update-$tag _.ISUB - update-$variant (|>> $variant ::value + update_$tag _.ISUB + update_$variant (|>> $variant ::value (_.CHECKCAST //.$Variant) (_.ASTORE 0)) iterate! (: (-> Label Inst) (function (_ @loop) - (|>> update-$variant - update-$tag + (|>> update_$variant + update_$tag (_.GOTO @loop)))) - not-found _.NULL]) + not_found _.NULL]) (|>> $tag ## tag (_.label @loop) $variant ::tag ## tag, variant::tag - _.DUP2 (_.IF_ICMPEQ @tags-match!) ## tag, variant::tag - _.DUP2 (_.IF_ICMPGT @maybe-nested) ## tag, variant::tag + _.DUP2 (_.IF_ICMPEQ @tags_match!) ## tag, variant::tag + _.DUP2 (_.IF_ICMPGT @maybe_nested) ## tag, variant::tag $last? (_.IFNULL @mismatch!) ## tag, variant::tag - super-nested ## super-variant + super_nested ## super_variant _.ARETURN - (_.label @tags-match!) ## tag, variant::tag + (_.label @tags_match!) ## tag, variant::tag $last? ## tag, variant::tag, last? $variant ::last? ## tag, variant::tag, last?, variant::last? - (_.IF_ACMPEQ @perfect-match!) ## tag, variant::tag - (_.label @maybe-nested) ## tag, variant::tag + (_.IF_ACMPEQ @perfect_match!) ## tag, variant::tag + (_.label @maybe_nested) ## tag, variant::tag $variant ::last? ## tag, variant::tag, variant::last? (_.IFNULL @mismatch!) ## tag, variant::tag (iterate! @loop) - (_.label @perfect-match!) ## tag, variant::tag + (_.label @perfect_match!) ## tag, variant::tag ## _.POP2 $variant ::value _.ARETURN (_.label @mismatch!) ## tag, variant::tag ## _.POP2 - not-found + not_found _.ARETURN))) ($d.method #$.Public $.staticM "tuple_left" (type.method [(list //.$Tuple $Index) $Value (list)]) - (<| _.with-label (function (_ @loop)) - _.with-label (function (_ @recursive)) - (let [left-accessI (|>> (_.ALOAD 0) left-indexI _.AALOAD)]) + (<| _.with_label (function (_ @loop)) + _.with_label (function (_ @recursive)) + (let [left_accessI (|>> (_.ALOAD 0) left_indexI _.AALOAD)]) (|>> (_.label @loop) - leftsI last-rightI (_.IF_ICMPGE @recursive) - left-accessI + leftsI last_rightI (_.IF_ICMPGE @recursive) + left_accessI _.ARETURN (_.label @recursive) ## Recursive (recurI @loop)))) ($d.method #$.Public $.staticM "tuple_right" (type.method [(list //.$Tuple $Index) $Value (list)]) - (<| _.with-label (function (_ @loop)) - _.with-label (function (_ @not-tail)) - _.with-label (function (_ @slice)) - (let [right-indexI (|>> leftsI + (<| _.with_label (function (_ @loop)) + _.with_label (function (_ @not_tail)) + _.with_label (function (_ @slice)) + (let [right_indexI (|>> leftsI _.ICONST_1 _.IADD) - right-accessI (|>> (_.ALOAD 0) + right_accessI (|>> (_.ALOAD 0) _.SWAP _.AALOAD) - sub-rightI (|>> (_.ALOAD 0) - right-indexI - tuple-sizeI + sub_rightI (|>> (_.ALOAD 0) + right_indexI + tuple_sizeI (_.INVOKESTATIC (type.class "java.util.Arrays" (list)) "copyOfRange" (type.method [(list //.$Tuple $Index $Index) //.$Tuple (list)])))]) (|>> (_.label @loop) - last-rightI right-indexI - _.DUP2 (_.IF_ICMPNE @not-tail) + last_rightI right_indexI + _.DUP2 (_.IF_ICMPNE @not_tail) ## _.POP - right-accessI + right_accessI _.ARETURN - (_.label @not-tail) + (_.label @not_tail) (_.IF_ICMPGT @slice) ## Must recurse (recurI @loop) (_.label @slice) - sub-rightI + sub_rightI _.ARETURN ))) ))) (def: #export try (type.method [(list //.$Function) //.$Variant (list)])) -(def: io-methods +(def: io_methods Def (let [StringWriter (type.class "java.io.StringWriter" (list)) PrintWriter (type.class "java.io.PrintWriter" (list)) - string-writerI (|>> (_.NEW StringWriter) + string_writerI (|>> (_.NEW StringWriter) _.DUP - (_.INVOKESPECIAL StringWriter "<init>" nullary-init-methodT)) - print-writerI (|>> (_.NEW PrintWriter) + (_.INVOKESPECIAL StringWriter "<init>" nullary_init_methodT)) + print_writerI (|>> (_.NEW PrintWriter) _.SWAP _.DUP2 _.POP @@ -308,21 +308,21 @@ (_.INVOKESPECIAL PrintWriter "<init>" (type.method [(list (type.class "java.io.Writer" (list)) type.boolean) type.void (list)])) )] (|>> ($d.method #$.Public $.staticM "try" ..try - (<| _.with-label (function (_ @from)) - _.with-label (function (_ @to)) - _.with-label (function (_ @handler)) + (<| _.with_label (function (_ @from)) + _.with_label (function (_ @to)) + _.with_label (function (_ @handler)) (|>> (_.try @from @to @handler $Throwable) (_.label @from) (_.ALOAD 0) _.NULL - (_.INVOKEVIRTUAL //.$Function apply-method (apply-signature 1)) + (_.INVOKEVIRTUAL //.$Function apply_method (apply_signature 1)) rightI _.ARETURN (_.label @to) (_.label @handler) - string-writerI ## TW + string_writerI ## TW _.DUP2 ## TWTW - print-writerI ## TWTP + print_writerI ## TWTP (_.INVOKEVIRTUAL $Throwable "printStackTrace" (type.method [(list (type.class "java.io.PrintWriter" (list))) type.void (list)])) ## TW (_.INVOKEVIRTUAL StringWriter "toString" (type.method [(list) $Text (list)])) ## TS _.SWAP _.POP leftI @@ -334,49 +334,49 @@ (-> (Type (<| Return' Value' category)) Text)) (|>> type.reflection reflection.reflection)) -(def: translate-runtime +(def: translate_runtime (Operation [Text 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 - frac-methods - pm-methods - io-methods)) - directive [runtime-class bytecode]] + (let [runtime_class (..reflection //.$Runtime) + bytecode ($d.class #$.V1_6 #$.Public $.finalC runtime_class (list) (type.class "java.lang.Object" (list)) (list) + (|>> adt_methods + frac_methods + pm_methods + io_methods)) + directive [runtime_class bytecode]] (do phase.monad [_ (generation.execute! directive) _ (generation.save! "0" directive)] (wrap ["0" bytecode])))) -(def: translate-function +(def: translate_function (Operation [Text Binary]) - (let [applyI (|> (enum.range n.enum 2 num-apply-variants) + (let [applyI (|> (enum.range n.enum 2 num_apply_variants) (list@map (function (_ arity) - ($d.method #$.Public $.noneM apply-method (apply-signature arity) + ($d.method #$.Public $.noneM apply_method (apply_signature arity) (let [preI (|> (enum.range n.enum 0 (dec arity)) (list@map _.ALOAD) _.fuse)] (|>> preI - (_.INVOKEVIRTUAL //.$Function apply-method (apply-signature (dec arity))) + (_.INVOKEVIRTUAL //.$Function apply_method (apply_signature (dec arity))) (_.CHECKCAST //.$Function) (_.ALOAD arity) - (_.INVOKEVIRTUAL //.$Function apply-method (apply-signature 1)) + (_.INVOKEVIRTUAL //.$Function apply_method (apply_signature 1)) _.ARETURN))))) - (list& ($d.abstract-method #$.Public $.noneM apply-method (apply-signature 1))) + (list& ($d.abstract_method #$.Public $.noneM apply_method (apply_signature 1))) $d.fuse) $Object (type.class "java.lang.Object" (list)) - function-class (..reflection //.$Function) - bytecode ($d.abstract #$.V1_6 #$.Public $.noneC function-class (list) $Object (list) - (|>> ($d.field #$.Public $.finalF partials-field type.int) + function_class (..reflection //.$Function) + bytecode ($d.abstract #$.V1_6 #$.Public $.noneC function_class (list) $Object (list) + (|>> ($d.field #$.Public $.finalF partials_field type.int) ($d.method #$.Public $.noneM "<init>" (type.method [(list type.int) type.void (list)]) (|>> (_.ALOAD 0) - (_.INVOKESPECIAL $Object "<init>" nullary-init-methodT) + (_.INVOKESPECIAL $Object "<init>" nullary_init_methodT) (_.ALOAD 0) (_.ILOAD 1) - (_.PUTFIELD //.$Function partials-field type.int) + (_.PUTFIELD //.$Function partials_field type.int) _.RETURN)) applyI)) - directive [function-class bytecode]] + directive [function_class bytecode]] (do phase.monad [_ (generation.execute! directive) _ (generation.save! "1" directive)] @@ -385,12 +385,12 @@ (def: #export translate (Operation [Registry Output]) (do phase.monad - [runtime-payload ..translate-runtime - function-payload ..translate-function] + [runtime_payload ..translate_runtime + function_payload ..translate_function] (wrap [(|> artifact.empty artifact.resource product.right artifact.resource product.right) - (row.row runtime-payload - function-payload)]))) + (row.row runtime_payload + function_payload)]))) diff --git a/lux-jvm/source/luxc/lang/translation/jvm/structure.lux b/lux-jvm/source/luxc/lang/translation/jvm/structure.lux index d91ed3d14..a93b4845f 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/structure.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/structure.lux @@ -35,7 +35,7 @@ ["." // ["#." runtime]]) -(exception: #export (not-a-tuple {size Nat}) +(exception: #export (not_a_tuple {size Nat}) (exception.report ["Expected size" ">= 2"] ["Actual size" (%.nat size)])) @@ -44,7 +44,7 @@ (Generator (List Synthesis)) (do {@ phase.monad} [#let [size (list.size members)] - _ (phase.assert not-a-tuple size + _ (phase.assert ..not_a_tuple size (n.>= 2 size)) membersI (|> members list.enumeration diff --git a/lux-jvm/source/program.lux b/lux-jvm/source/program.lux index c07ecd3e3..a7e2f395c 100644 --- a/lux-jvm/source/program.lux +++ b/lux-jvm/source/program.lux @@ -78,39 +78,39 @@ ["#::." (getClass [] (java/lang/Class java/lang/Object))]) -(def: _object-class +(def: _object_class (java/lang/Class java/lang/Object) - (host.class-for java/lang/Object)) + (host.class_for java/lang/Object)) -(def: _apply2-args +(def: _apply2_args (Array (java/lang/Class java/lang/Object)) (|> (host.array (java/lang/Class java/lang/Object) 2) - (host.array-write 0 _object-class) - (host.array-write 1 _object-class))) + (host.array_write 0 _object_class) + (host.array_write 1 _object_class))) -(def: _apply5-args +(def: _apply5_args (Array (java/lang/Class java/lang/Object)) (|> (host.array (java/lang/Class java/lang/Object) 5) - (host.array-write 0 _object-class) - (host.array-write 1 _object-class) - (host.array-write 2 _object-class) - (host.array-write 3 _object-class) - (host.array-write 4 _object-class))) + (host.array_write 0 _object_class) + (host.array_write 1 _object_class) + (host.array_write 2 _object_class) + (host.array_write 3 _object_class) + (host.array_write 4 _object_class))) (def: #export (expander macro inputs lux) Expander (do try.monad - [apply-method (|> macro + [apply_method (|> macro (:coerce java/lang/Object) (java/lang/Object::getClass) - (java/lang/Class::getMethod "apply" _apply2-args))] + (java/lang/Class::getMethod "apply" _apply2_args))] (:coerce (Try (Try [Lux (List Code)])) (java/lang/reflect/Method::invoke (:coerce java/lang/Object macro) (|> (host.array java/lang/Object 2) - (host.array-write 0 (:coerce java/lang/Object inputs)) - (host.array-write 1 (:coerce java/lang/Object lux))) - apply-method)))) + (host.array_write 0 (:coerce java/lang/Object inputs)) + (host.array_write 1 (:coerce java/lang/Object lux))) + apply_method)))) (def: #export platform ## (IO (Platform Anchor (Bytecode Any) Definition)) @@ -118,7 +118,7 @@ (do io.monad [## host jvm/host.host host jvm.host] - (wrap {#platform.&file-system (file.async file.default) + (wrap {#platform.&file_system (file.async file.default) #platform.host host ## #platform.phase jvm.generate #platform.phase expression.translate @@ -144,38 +144,38 @@ [method (|> handler (:coerce java/lang/Object) (java/lang/Object::getClass) - (java/lang/Class::getMethod "apply" _apply5-args))] + (java/lang/Class::getMethod "apply" _apply5_args))] (java/lang/reflect/Method::invoke (:coerce java/lang/Object handler) (|> (host.array java/lang/Object 5) - (host.array-write 0 (:coerce java/lang/Object name)) - (host.array-write 1 (:coerce java/lang/Object phase)) - (host.array-write 2 (:coerce java/lang/Object archive)) - (host.array-write 3 (:coerce java/lang/Object parameters)) - (host.array-write 4 (:coerce java/lang/Object state))) + (host.array_write 0 (:coerce java/lang/Object name)) + (host.array_write 1 (:coerce java/lang/Object phase)) + (host.array_write 2 (:coerce java/lang/Object archive)) + (host.array_write 3 (:coerce java/lang/Object parameters)) + (host.array_write 4 (:coerce java/lang/Object state))) method)))) -(def: (declare-success! _) +(def: (declare_success! _) (-> Any (Promise Any)) (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.host_module_extension ".jvm" #/static.target (/cli.target service) - #/static.artifact-extension ".class"} + #/static.artifact_extension ".class"} ..expander analysis.bundle ..platform ## generation.bundle translation.bundle (directive.bundle ..extender) - (jvm/program.program jvm/runtime.class-name) + (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! [])) + (..declare_success! [])) (io.io []))) diff --git a/lux-mode/lux-mode.el b/lux-mode/lux-mode.el index 45f314b44..d416c3b25 100644 --- a/lux-mode/lux-mode.el +++ b/lux-mode/lux-mode.el @@ -442,7 +442,7 @@ highlighted region)." (font-lock-syntactic-face-function . lux-font-lock-syntactic-face-function)))) -(defvar withRE (concat "\\`" "with" (altRE "-" "\\'"))) +(defvar withRE (concat "\\`" "with" (altRE "_" "\\'"))) (defvar definitionRE ":\\'") (defun lux-indent-function (indent-point state) diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index 4d0ac9c4d..2185bbb99 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -5170,25 +5170,25 @@ "Wherever a binding appears, the bound codes will be spliced in there." (test: "Code operations & structures" (with_expansions - [<tests> (template [<expr> <text> <pattern>] - [(compare <pattern> <expr>) - (compare <text> (\ Code/encode encode <expr>)) - (compare #1 (\ equivalence = <expr> <expr>))] - - [(bit #1) "#1" [_ (#.Bit #1)]] - [(bit #0) "#0" [_ (#.Bit #0)]] - [(int +123) "+123" [_ (#.Int +123)]] - [(frac +123.0) "+123.0" [_ (#.Frac +123.0)]] - [(text "123") "'123'" [_ (#.Text "123")]] - [(tag ["yolo" "lol"]) "#yolo.lol" [_ (#.Tag ["yolo" "lol"])]] - [(identifier ["yolo" "lol"]) "yolo.lol" [_ (#.Identifier ["yolo" "lol"])]] - [(form (list (bit #1) (int +123))) "(#1 +123)" (^ [_ (#.Form (list [_ (#.Bit #1)] [_ (#.Int +123)]))])] - [(tuple (list (bit #1) (int +123))) "[#1 +123]" (^ [_ (#.Tuple (list [_ (#.Bit #1)] [_ (#.Int +123)]))])] - [(record (list [(bit #1) (int +123)])) "{#1 +123}" (^ [_ (#.Record (list [[_ (#.Bit #1)] [_ (#.Int +123)]]))])] - [(local_tag "lol") "#lol" [_ (#.Tag ["" "lol"])]] - [(local_identifier "lol") "lol" [_ (#.Identifier ["" "lol"])]] - )] - (test_all <tests>))))} + [<tests> (template [<expr> <text> <pattern>] + [(compare <pattern> <expr>) + (compare <text> (\ Code/encode encode <expr>)) + (compare #1 (\ equivalence = <expr> <expr>))] + + [(bit #1) "#1" [_ (#.Bit #1)]] + [(bit #0) "#0" [_ (#.Bit #0)]] + [(int +123) "+123" [_ (#.Int +123)]] + [(frac +123.0) "+123.0" [_ (#.Frac +123.0)]] + [(text "123") "'123'" [_ (#.Text "123")]] + [(tag ["yolo" "lol"]) "#yolo.lol" [_ (#.Tag ["yolo" "lol"])]] + [(identifier ["yolo" "lol"]) "yolo.lol" [_ (#.Identifier ["yolo" "lol"])]] + [(form (list (bit #1) (int +123))) "(#1 +123)" (^ [_ (#.Form (list [_ (#.Bit #1)] [_ (#.Int +123)]))])] + [(tuple (list (bit #1) (int +123))) "[#1 +123]" (^ [_ (#.Tuple (list [_ (#.Bit #1)] [_ (#.Int +123)]))])] + [(record (list [(bit #1) (int +123)])) "{#1 +123}" (^ [_ (#.Record (list [[_ (#.Bit #1)] [_ (#.Int +123)]]))])] + [(local_tag "lol") "#lol" [_ (#.Tag ["" "lol"])]] + [(local_identifier "lol") "lol" [_ (#.Identifier ["" "lol"])]] + )] + (test_all <tests>))))} (case tokens (^ (list& [_ (#Tuple bindings)] bodies)) (case bindings @@ -5196,8 +5196,8 @@ (do meta_monad [expansion (macro_expand_once macro_expr)] (case (place_tokens var_name expansion (` (.with_expansions - [(~+ bindings')] - (~+ bodies)))) + [(~+ bindings')] + (~+ bodies)))) (#Some output) (wrap output) @@ -5678,30 +5678,30 @@ (#Cons [key pick] options') (with_expansions [<try_again> (target_pick target options' default)] - (case key - [_ (#Text platform)] - (if (text\= target platform) - (return (list pick)) - <try_again>) - - [_ (#Identifier identifier)] - (do meta_monad - [identifier (..resolve_global_identifier identifier) - type+value (..find_def_value identifier) - #let [[type value] type+value]] - (case (..flatten_alias type) - (#Named ["lux" "Text"] (#Primitive "#Text" #Nil)) - (if (text\= target (:coerce ..Text value)) - (wrap (list pick)) - <try_again>) + (case key + [_ (#Text platform)] + (if (text\= target platform) + (return (list pick)) + <try_again>) - _ - (fail ($_ text\compose - "Invalid target platform (must be a value of type Text): " (name\encode identifier) - " : " (..code\encode (..type_to_code type)))))) + [_ (#Identifier identifier)] + (do meta_monad + [identifier (..resolve_global_identifier identifier) + type+value (..find_def_value identifier) + #let [[type value] type+value]] + (case (..flatten_alias type) + (#Named ["lux" "Text"] (#Primitive "#Text" #Nil)) + (if (text\= target (:coerce ..Text value)) + (wrap (list pick)) + <try_again>) - _ - <try_again>)) + _ + (fail ($_ text\compose + "Invalid target platform (must be a value of type Text): " (name\encode identifier) + " : " (..code\encode (..type_to_code type)))))) + + _ + <try_again>)) )) (macro: #export (for tokens) @@ -5768,7 +5768,7 @@ (wrap (list (` (with_expansions [(~+ (|> labels (list\map (function (_ [label expansion]) (list label expansion))) list\join))] - (~ labelled)))))) + (~ labelled)))))) _ (fail (..wrong_syntax_error (name_of ..``))) @@ -5873,7 +5873,7 @@ (list\map (function (_ [localT valueT]) (list localT (` (..as_is (~ valueT)))))) (list\fold list\compose (list))))] - (~ bodyT))))) + (~ bodyT))))) (..fail ":let requires an even number of parts")) _ diff --git a/stdlib/source/lux/abstract/comonad.lux b/stdlib/source/lux/abstract/comonad.lux index fd325759a..eeccf9351 100644 --- a/stdlib/source/lux/abstract/comonad.lux +++ b/stdlib/source/lux/abstract/comonad.lux @@ -1,10 +1,11 @@ (.module: [lux #* [data - [number - ["n" nat]] [collection ["." list ("#\." fold)]]] + [math + [number + ["n" nat]]] [meta ["." location]]] [// diff --git a/stdlib/source/lux/control/concatenative.lux b/stdlib/source/lux/control/concatenative.lux index de3d5a10d..faa7b77d9 100644 --- a/stdlib/source/lux/control/concatenative.lux +++ b/stdlib/source/lux/control/concatenative.lux @@ -1,5 +1,6 @@ (.module: [lux (#- Alias if loop) + ["." meta (#+ with_gensyms)] [abstract ["." monad]] [data @@ -7,20 +8,20 @@ ["." text ["%" format (#+ format)]] [collection - ["." list ("#\." fold functor)]] - [number - ["n" nat] - ["i" int] - ["r" rev] - ["f" frac]]] - ["." meta (#+ with_gensyms)] + ["." list ("#\." fold functor)]]] [macro ["." code] [syntax (#+ syntax:) ["cs" common ["csr" reader] ["csw" writer] - ["|.|" export]]]]] + ["|.|" export]]]] + [math + [number + ["n" nat] + ["i" int] + ["r" rev] + ["f" frac]]]] [// ["<>" parser ("#\." monad) ["<c>" code (#+ Parser)]]]) diff --git a/stdlib/source/lux/control/concurrency/actor.lux b/stdlib/source/lux/control/concurrency/actor.lux index 6355a43b7..dac5f151b 100644 --- a/stdlib/source/lux/control/concurrency/actor.lux +++ b/stdlib/source/lux/control/concurrency/actor.lux @@ -12,8 +12,6 @@ ["<c>" code (#+ Parser)]]] [data ["." product] - [number - ["n" nat]] [text ["%" format (#+ format)]] [collection @@ -25,6 +23,9 @@ ["csr" reader] ["csw" writer] ["|.|" export]]]] + [math + [number + ["n" nat]]] ["." meta (#+ with_gensyms monad) ["." annotation]] [type (#+ :share) diff --git a/stdlib/source/lux/control/concurrency/atom.lux b/stdlib/source/lux/control/concurrency/atom.lux index 3920c0214..3b690ea7d 100644 --- a/stdlib/source/lux/control/concurrency/atom.lux +++ b/stdlib/source/lux/control/concurrency/atom.lux @@ -18,10 +18,10 @@ (new [a]) (get [] a) (compareAndSet [a a] boolean)]))] - (for {@.old <jvm> - @.jvm <jvm>} - - (as_is))) + (for {@.old <jvm> + @.jvm <jvm>} + + (as_is))) (abstract: #export (Atom a) (for {@.old diff --git a/stdlib/source/lux/control/concurrency/semaphore.lux b/stdlib/source/lux/control/concurrency/semaphore.lux index 9e6ff9b29..5be5582de 100644 --- a/stdlib/source/lux/control/concurrency/semaphore.lux +++ b/stdlib/source/lux/control/concurrency/semaphore.lux @@ -9,11 +9,12 @@ [data [text ["%" format (#+ format)]] - [number - ["n" nat] - ["i" int]] [collection ["." queue (#+ Queue)]]] + [math + [number + ["n" nat] + ["i" int]]] [type abstract ["." refinement]]] diff --git a/stdlib/source/lux/control/concurrency/thread.lux b/stdlib/source/lux/control/concurrency/thread.lux index 8bdd2b9c9..d1ab65886 100644 --- a/stdlib/source/lux/control/concurrency/thread.lux +++ b/stdlib/source/lux/control/concurrency/thread.lux @@ -8,10 +8,11 @@ ["ex" exception (#+ exception:)] ["." io (#+ IO io)]] [data - [number - ["n" nat]] [collection - ["." list]]]] + ["." list]]] + [math + [number + ["n" nat]]]] [// ["." atom (#+ Atom)]]) diff --git a/stdlib/source/lux/control/exception.lux b/stdlib/source/lux/control/exception.lux index 9d7b7acca..161597421 100644 --- a/stdlib/source/lux/control/exception.lux +++ b/stdlib/source/lux/control/exception.lux @@ -1,5 +1,6 @@ (.module: {#.doc "Exception-handling functionality."} [lux #* + ["." meta] [abstract [monad (#+ do)]] [control @@ -9,18 +10,18 @@ ["." maybe] ["." product] ["." text ("#\." monoid)] - [number - ["n" nat ("#\." decimal)]] [collection ["." list ("#\." functor fold)]]] - ["." meta] [macro ["." code] [syntax (#+ syntax:) ["sc" common ["scr" reader] ["scw" writer] - ["|.|" export]]]]] + ["|.|" export]]]] + [math + [number + ["n" nat ("#\." decimal)]]]] [// ["//" try (#+ Try)]]) diff --git a/stdlib/source/lux/control/function/contract.lux b/stdlib/source/lux/control/function/contract.lux index 02ff4ddf8..f49e7d1c5 100644 --- a/stdlib/source/lux/control/function/contract.lux +++ b/stdlib/source/lux/control/function/contract.lux @@ -1,16 +1,17 @@ (.module: [lux #* + [meta (#+ with_gensyms)] [control ["." exception (#+ exception:)]] [data - [number - ["i" int]] [text ["%" format (#+ format)]]] - [meta (#+ with_gensyms)] [macro [syntax (#+ syntax:)] - ["." code]]]) + ["." code]] + [math + [number + ["i" int]]]]) (template [<name>] [(exception: (<name> {condition Code}) diff --git a/stdlib/source/lux/control/parser.lux b/stdlib/source/lux/control/parser.lux index 8f896cf39..8ee53fcb8 100644 --- a/stdlib/source/lux/control/parser.lux +++ b/stdlib/source/lux/control/parser.lux @@ -9,10 +9,11 @@ ["." try (#+ Try)]] [data ["." product] - [number - ["n" nat]] [collection - ["." list ("#\." functor monoid)]]]]) + ["." list ("#\." functor monoid)]]] + [math + [number + ["n" nat]]]]) (type: #export (Parser s a) {#.doc "A generic parser."} diff --git a/stdlib/source/lux/control/parser/analysis.lux b/stdlib/source/lux/control/parser/analysis.lux index 6a7a1c407..eaf659129 100644 --- a/stdlib/source/lux/control/parser/analysis.lux +++ b/stdlib/source/lux/control/parser/analysis.lux @@ -8,16 +8,17 @@ [data ["." bit] ["." name] + ["." text + ["%" format (#+ format)]] + [collection + ["." list ("#\." functor)]]] + [math [number ["." i64] ["." nat] ["." int] ["." rev] - ["." frac]] - ["." text - ["%" format (#+ format)]] - [collection - ["." list ("#\." functor)]]] + ["." frac]]] [tool [compiler [arity (#+ Arity)] diff --git a/stdlib/source/lux/control/parser/binary.lux b/stdlib/source/lux/control/parser/binary.lux index 32750d535..1dcba78cb 100644 --- a/stdlib/source/lux/control/parser/binary.lux +++ b/stdlib/source/lux/control/parser/binary.lux @@ -2,25 +2,26 @@ [lux (#- and or nat int rev list type) [type (#+ :share)] [abstract - [monad (#+ do)] - [hash (#+ Hash)]] + [hash (#+ Hash)] + [monad (#+ do)]] [control ["." try (#+ Try)] ["." exception (#+ exception:)]] [data ["/" binary (#+ Binary)] - [number - ["n" nat] - ["." frac]] [text - ["." encoding] - ["%" format (#+ format)]] + ["%" format (#+ format)] + ["." encoding]] [collection ["." list] ["." row (#+ Row)] ["." set (#+ Set)]]] [macro - ["." template]]] + ["." template]] + [math + [number + ["n" nat] + ["." frac]]]] ["." // ("#\." monad)]) (type: #export Offset Nat) diff --git a/stdlib/source/lux/control/parser/code.lux b/stdlib/source/lux/control/parser/code.lux index 82f5fbca8..86ee0a1d8 100644 --- a/stdlib/source/lux/control/parser/code.lux +++ b/stdlib/source/lux/control/parser/code.lux @@ -8,15 +8,16 @@ ["." bit] ["." text ("#\." monoid)] ["." name] + [collection + ["." list ("#\." functor)]]] + [macro + ["." code ("#\." equivalence)]] + [math [number ["." nat] ["." int] ["." rev] - ["." frac]] - [collection - ["." list ("#\." functor)]]] - [macro - ["." code ("#\." equivalence)]]] + ["." frac]]]] ["." //]) (def: (join_pairs pairs) diff --git a/stdlib/source/lux/control/parser/json.lux b/stdlib/source/lux/control/parser/json.lux index 9035d41fe..abc3ded7c 100644 --- a/stdlib/source/lux/control/parser/json.lux +++ b/stdlib/source/lux/control/parser/json.lux @@ -8,8 +8,6 @@ [data ["." bit] ["." text ("#\." equivalence monoid)] - [number - ["." frac]] [collection ["." list ("#\." functor)] ["." row] @@ -17,7 +15,10 @@ [format ["/" json (#+ JSON)]]] [macro - ["." code]]] + ["." code]] + [math + [number + ["." frac]]]] ["." // ("#\." functor)]) (type: #export (Parser a) diff --git a/stdlib/source/lux/control/parser/synthesis.lux b/stdlib/source/lux/control/parser/synthesis.lux index ad376d059..8deecd32f 100644 --- a/stdlib/source/lux/control/parser/synthesis.lux +++ b/stdlib/source/lux/control/parser/synthesis.lux @@ -8,12 +8,13 @@ [data ["." bit] ["." name] - [number - ["." i64] - ["n" nat] - ["." frac]] ["." text ["%" format (#+ format)]]] + [math + [number + ["n" nat] + ["." i64] + ["." frac]]] [tool [compiler [reference diff --git a/stdlib/source/lux/control/parser/text.lux b/stdlib/source/lux/control/parser/text.lux index 919de78c4..9fe3b55fd 100644 --- a/stdlib/source/lux/control/parser/text.lux +++ b/stdlib/source/lux/control/parser/text.lux @@ -6,15 +6,16 @@ ["." try (#+ Try)] ["." exception (#+ exception:)]] [data + ["/" text (#+ Char) ("#\." monoid)] ["." product] ["." maybe] - ["/" text (#+ Char) ("#\." monoid)] - [number - ["n" nat ("#\." decimal)]] [collection ["." list ("#\." fold)]]] [macro - ["." code]]] + ["." code]] + [math + [number + ["n" nat ("#\." decimal)]]]] ["." //]) (type: #export Offset Nat) diff --git a/stdlib/source/lux/control/parser/type.lux b/stdlib/source/lux/control/parser/type.lux index 32329abbe..ce58c5ce3 100644 --- a/stdlib/source/lux/control/parser/type.lux +++ b/stdlib/source/lux/control/parser/type.lux @@ -7,8 +7,6 @@ ["." exception (#+ exception:)] ["." function]] [data - [number - ["n" nat ("#\." decimal)]] ["." text ("#\." monoid) ["%" format (#+ format)]] [collection @@ -16,6 +14,9 @@ ["." dictionary (#+ Dictionary)]]] [macro ["." code]] + [math + [number + ["n" nat ("#\." decimal)]]] ["." type ("#\." equivalence) ["." check]]] ["." //]) diff --git a/stdlib/source/lux/control/pipe.lux b/stdlib/source/lux/control/pipe.lux index 4c98b5f3f..bfed2a99a 100644 --- a/stdlib/source/lux/control/pipe.lux +++ b/stdlib/source/lux/control/pipe.lux @@ -1,5 +1,6 @@ (.module: {#.doc "Composable extensions to the piping macros (|> and <|) that enhance them with various abilities."} [lux #* + [meta (#+ with_gensyms)] [abstract [monad (#+ do)]] [control @@ -8,15 +9,15 @@ ["s" code (#+ Parser)]]] [data ["." identity] - [number - ["n" nat] - ["i" int]] [collection ["." list ("#\." fold monad)]]] - [meta (#+ with_gensyms)] [macro [syntax (#+ syntax:)] - ["." code]]]) + ["." code]] + [math + [number + ["n" nat] + ["i" int]]]]) (def: body^ (Parser (List Code)) diff --git a/stdlib/source/lux/control/security/capability.lux b/stdlib/source/lux/control/security/capability.lux index 8d1ef44ad..bd7c0368a 100644 --- a/stdlib/source/lux/control/security/capability.lux +++ b/stdlib/source/lux/control/security/capability.lux @@ -22,7 +22,8 @@ [common ["." reader] ["." writer] - ["|.|" export]]]]]) + ["|.|" export] + ["|.|" declaration]]]]]) (abstract: #export (Capability brand input output) (-> input output) @@ -44,7 +45,7 @@ ((:representation capability) input)) (syntax: #export (capability: {export |export|.parser} - {declaration reader.declaration} + {declaration |declaration|.parser} {annotations (<>.maybe reader.annotations)} {[forge input output] (<c>.form ($_ <>.and <c>.local_identifier <c>.any <c>.any))}) (do {! meta.monad} @@ -54,7 +55,7 @@ (meta.gensym (format (%.name [this_module name])))) #let [capability (` (..Capability (.primitive (~ g!brand)) (~ input) (~ output)))]] (wrap (list (` (type: (~+ (|export|.write export)) - (~ (writer.declaration declaration)) + (~ (|declaration|.write declaration)) (~ capability))) (` (def: (~ (code.local_identifier forge)) (All [(~+ (list\map code.local_identifier vars))] diff --git a/stdlib/source/lux/data/binary.lux b/stdlib/source/lux/data/binary.lux index a9c2de090..fc0ba98ec 100644 --- a/stdlib/source/lux/data/binary.lux +++ b/stdlib/source/lux/data/binary.lux @@ -11,14 +11,15 @@ ["." exception (#+ exception:)]] [data ["." maybe] - [number - ["." i64] - ["n" nat] - ["f" frac]] [text ["%" format (#+ format)]] [collection - ["." array]]]]) + ["." array]]] + [math + [number + ["n" nat] + ["f" frac] + ["." i64]]]]) (exception: #export (index_out_of_bounds {size Nat} {index Nat}) (exception.report diff --git a/stdlib/source/lux/data/collection/array.lux b/stdlib/source/lux/data/collection/array.lux index 705654ca0..470640bcf 100644 --- a/stdlib/source/lux/data/collection/array.lux +++ b/stdlib/source/lux/data/collection/array.lux @@ -5,15 +5,16 @@ [monoid (#+ Monoid)] [functor (#+ Functor)] [equivalence (#+ Equivalence)] - fold + [fold (#+ Fold)] [predicate (#+ Predicate)]] [data ["." product] ["." maybe] - [number - ["n" nat]] [collection - ["." list ("#\." fold)]]]]) + ["." list ("#\." fold)]]] + [math + [number + ["n" nat]]]]) (def: #export type_name "#Array") diff --git a/stdlib/source/lux/data/collection/bits.lux b/stdlib/source/lux/data/collection/bits.lux index 7f65fbfd5..a50ec0903 100644 --- a/stdlib/source/lux/data/collection/bits.lux +++ b/stdlib/source/lux/data/collection/bits.lux @@ -6,11 +6,12 @@ pipe] [data ["." maybe] - [number - ["." i64] - ["n" nat]] [collection - ["." array (#+ Array) ("#\." fold)]]]]) + ["." array (#+ Array) ("#\." fold)]]] + [math + [number + ["n" nat] + ["." i64]]]]) (type: #export Chunk I64) diff --git a/stdlib/source/lux/data/collection/dictionary.lux b/stdlib/source/lux/data/collection/dictionary.lux index 46f299e31..9691c87cd 100644 --- a/stdlib/source/lux/data/collection/dictionary.lux +++ b/stdlib/source/lux/data/collection/dictionary.lux @@ -10,12 +10,13 @@ [data ["." maybe] ["." product] - ["." number - ["." i64] - ["n" nat]] [collection ["." list ("#\." fold functor monoid)] - ["." array (#+ Array) ("#\." functor fold)]]]]) + ["." array (#+ Array) ("#\." functor fold)]]] + [math + ["." number + ["n" nat] + ["." i64]]]]) ## This implementation of Hash Array Mapped Trie (HAMT) is based on ## Clojure's PersistentHashMap implementation. diff --git a/stdlib/source/lux/data/collection/dictionary/ordered.lux b/stdlib/source/lux/data/collection/dictionary/ordered.lux index 6907bfdc5..5b2039a47 100644 --- a/stdlib/source/lux/data/collection/dictionary/ordered.lux +++ b/stdlib/source/lux/data/collection/dictionary/ordered.lux @@ -7,12 +7,13 @@ [data ["p" product] ["." maybe] - [number - ["n" nat]] [collection ["." list ("#\." monoid fold)]]] [macro - ["." code]]]) + ["." code]] + [math + [number + ["n" nat]]]]) (def: error_message "Invariant violation") diff --git a/stdlib/source/lux/data/collection/dictionary/plist.lux b/stdlib/source/lux/data/collection/dictionary/plist.lux index d10f59789..320bf2f51 100644 --- a/stdlib/source/lux/data/collection/dictionary/plist.lux +++ b/stdlib/source/lux/data/collection/dictionary/plist.lux @@ -6,7 +6,8 @@ ["." product] ["." text ("#\." equivalence)] [collection - ["." list ("#\." functor)]] + ["." list ("#\." functor)]]] + [math [number ["n" nat]]]]) diff --git a/stdlib/source/lux/data/collection/list.lux b/stdlib/source/lux/data/collection/list.lux index 108c4a509..62e88645a 100644 --- a/stdlib/source/lux/data/collection/list.lux +++ b/stdlib/source/lux/data/collection/list.lux @@ -13,7 +13,8 @@ ["." enum]] [data ["." bit] - ["." product] + ["." product]] + [math [number ["n" nat]]]]) diff --git a/stdlib/source/lux/data/collection/queue.lux b/stdlib/source/lux/data/collection/queue.lux index b7b7f56e2..e351a4956 100644 --- a/stdlib/source/lux/data/collection/queue.lux +++ b/stdlib/source/lux/data/collection/queue.lux @@ -4,10 +4,11 @@ [equivalence (#+ Equivalence)] [functor (#+ Functor)]] [data - [number - ["n" nat]] [collection - ["." list ("#\." monoid functor)]]]]) + ["." list ("#\." monoid functor)]]] + [math + [number + ["n" nat]]]]) (type: #export (Queue a) {#front (List a) diff --git a/stdlib/source/lux/data/collection/queue/priority.lux b/stdlib/source/lux/data/collection/queue/priority.lux index 6904497d2..0f2b1e039 100644 --- a/stdlib/source/lux/data/collection/queue/priority.lux +++ b/stdlib/source/lux/data/collection/queue/priority.lux @@ -5,11 +5,12 @@ [monad (#+ do Monad)]] [data ["." maybe] - [number - ["n" nat ("#\." interval)]] [collection ["." tree #_ ["#" finger (#+ Tree)]]]] + [math + [number + ["n" nat ("#\." interval)]]] [type (#+ :by_example) [abstract (#+ abstract: :abstraction :representation)]]]) diff --git a/stdlib/source/lux/data/collection/row.lux b/stdlib/source/lux/data/collection/row.lux index bcfd297a2..2248abb83 100644 --- a/stdlib/source/lux/data/collection/row.lux +++ b/stdlib/source/lux/data/collection/row.lux @@ -1,5 +1,6 @@ (.module: [lux #* + [meta (#+ with_gensyms)] ["@" target] [abstract [functor (#+ Functor)] @@ -17,16 +18,16 @@ [data ["." maybe] ["." product] - [number - ["." i64] - ["n" nat]] [collection ["." list ("#\." fold functor monoid)] ["." array (#+ Array) ("#\." functor fold)]]] - [meta (#+ with_gensyms)] [macro ["." code] - [syntax (#+ syntax:)]]]) + [syntax (#+ syntax:)]] + [math + [number + ["." i64] + ["n" nat]]]]) (type: (Node a) (#Base (Array a)) diff --git a/stdlib/source/lux/data/collection/sequence.lux b/stdlib/source/lux/data/collection/sequence.lux index ddb508c39..4a26e8120 100644 --- a/stdlib/source/lux/data/collection/sequence.lux +++ b/stdlib/source/lux/data/collection/sequence.lux @@ -1,5 +1,6 @@ (.module: [lux #* + [meta (#+ with_gensyms)] [abstract [functor (#+ Functor)] [comonad (#+ CoMonad)]] @@ -7,16 +8,16 @@ ["//" continuation (#+ Cont)] ["<>" parser ["<.>" code (#+ Parser)]]] - [meta (#+ with_gensyms)] [macro [syntax (#+ syntax:)] ["." code]] [data ["." bit] - [number - ["n" nat]] [collection - ["." list ("#\." monad)]]]]) + ["." list ("#\." monad)]]] + [math + [number + ["n" nat]]]]) (type: #export (Sequence a) {#.doc "An infinite sequence of values."} diff --git a/stdlib/source/lux/data/collection/set.lux b/stdlib/source/lux/data/collection/set.lux index 67e241b78..d0341b402 100644 --- a/stdlib/source/lux/data/collection/set.lux +++ b/stdlib/source/lux/data/collection/set.lux @@ -6,11 +6,12 @@ [monoid (#+ Monoid)] ["." hash (#+ Hash)]] [data - [number - ["n" nat]] [collection ["//" dictionary (#+ Dictionary)] - ["." list ("#\." fold)]]]]) + ["." list ("#\." fold)]]] + [math + [number + ["n" nat]]]]) (type: #export (Set a) (Dictionary a Any)) diff --git a/stdlib/source/lux/data/collection/set/multi.lux b/stdlib/source/lux/data/collection/set/multi.lux index 727cf2d8d..fe5b2b8cb 100644 --- a/stdlib/source/lux/data/collection/set/multi.lux +++ b/stdlib/source/lux/data/collection/set/multi.lux @@ -6,6 +6,9 @@ [hash (#+ Hash)]] [control ["." function]] + [math + [number + ["n" nat]]] [type [abstract (#+ abstract: :abstraction :representation ^:representation)]]] ["." // @@ -13,9 +16,7 @@ ["." list ("#\." fold monoid)] ["." dictionary (#+ Dictionary)] [// - ["." maybe] - [number - ["n" nat]]]]]) + ["." maybe]]]]) (abstract: #export (Set a) (Dictionary a Nat) diff --git a/stdlib/source/lux/data/collection/tree/zipper.lux b/stdlib/source/lux/data/collection/tree/zipper.lux index aeac74de4..8007000d8 100644 --- a/stdlib/source/lux/data/collection/tree/zipper.lux +++ b/stdlib/source/lux/data/collection/tree/zipper.lux @@ -2,8 +2,8 @@ [lux #* ["@" target] [abstract - functor - comonad + [functor (#+ Functor)] + [comonad (#+ CoMonad)] [monad (#+ do)] [equivalence (#+ Equivalence)]] [data diff --git a/stdlib/source/lux/data/color.lux b/stdlib/source/lux/data/color.lux index 85ebe77ba..6e82155b6 100644 --- a/stdlib/source/lux/data/color.lux +++ b/stdlib/source/lux/data/color.lux @@ -5,15 +5,15 @@ [monoid (#+ Monoid)] ["." hash (#+ Hash)]] [data + [collection + ["." list ("#\." functor)]]] + ["." math [number ["n" nat] + ["f" frac] ["." int] ["." rev ("#\." interval)] - ["f" frac] - ["." i64]] - [collection - ["." list ("#\." functor)]]] - ["." math] + ["." i64]]] [type abstract]]) diff --git a/stdlib/source/lux/data/color/named.lux b/stdlib/source/lux/data/color/named.lux index 39c762081..54c9a4563 100644 --- a/stdlib/source/lux/data/color/named.lux +++ b/stdlib/source/lux/data/color/named.lux @@ -1,6 +1,6 @@ (.module: [lux #* - [data + [math [number (#+ hex)]]] ["." // (#+ Color)]) diff --git a/stdlib/source/lux/data/format/binary.lux b/stdlib/source/lux/data/format/binary.lux index 078331963..35c44af0d 100644 --- a/stdlib/source/lux/data/format/binary.lux +++ b/stdlib/source/lux/data/format/binary.lux @@ -3,7 +3,6 @@ [type (#+ :share)] [abstract [monoid (#+ Monoid)] - ["." fold] [monad (#+ Monad do)] [equivalence (#+ Equivalence)]] [control @@ -15,17 +14,18 @@ [data ["." product] ["." binary (#+ Binary)] - [number - ["." i64] - ["n" nat] - ["." frac]] [text ["." encoding] ["%" format (#+ format)]] [collection ["." list] ["." row (#+ Row) ("#\." functor)] - ["." set (#+ Set)]]]]) + ["." set (#+ Set)]]] + [math + [number + ["." i64] + ["n" nat] + ["." frac]]]]) (def: mask (-> Size (I64 Any)) diff --git a/stdlib/source/lux/data/format/json.lux b/stdlib/source/lux/data/format/json.lux index 0ac868859..22d587352 100644 --- a/stdlib/source/lux/data/format/json.lux +++ b/stdlib/source/lux/data/format/json.lux @@ -17,16 +17,17 @@ ["." maybe] ["." product] ["." text ("#\." equivalence monoid)] - [number - ["n" nat] - ["f" frac ("#\." decimal)]] [collection ["." list ("#\." fold functor)] ["." row (#+ Row row) ("#\." monad)] ["." dictionary (#+ Dictionary)]]] [macro [syntax (#+ syntax:)] - ["." code]]]) + ["." code]] + [math + [number + ["n" nat] + ["f" frac ("#\." decimal)]]]]) (template [<name> <type>] [(type: #export <name> diff --git a/stdlib/source/lux/data/format/tar.lux b/stdlib/source/lux/data/format/tar.lux index 168939344..052f35f77 100644 --- a/stdlib/source/lux/data/format/tar.lux +++ b/stdlib/source/lux/data/format/tar.lux @@ -14,14 +14,15 @@ ["." text (#+ Char) ["%" format (#+ format)] ["." encoding]] - ["." number - ["n" nat] - ["." i64]] ["." format #_ ["#" binary (#+ Writer) ("#\." monoid)]] [collection ["." list ("#\." fold)] ["." row (#+ Row) ("#\." fold)]]] + [math + ["." number + ["n" nat] + ["." i64]]] [time ["." instant (#+ Instant)] ["." duration]] diff --git a/stdlib/source/lux/data/format/xml.lux b/stdlib/source/lux/data/format/xml.lux index 8c040d828..3683e9e57 100644 --- a/stdlib/source/lux/data/format/xml.lux +++ b/stdlib/source/lux/data/format/xml.lux @@ -12,12 +12,13 @@ ["." product] ["." name ("#\." equivalence codec)] ["." text ("#\." equivalence monoid)] - [number - ["n" nat] - ["." int]] [collection ["." list ("#\." functor)] - ["." dictionary (#+ Dictionary)]]]]) + ["." dictionary (#+ Dictionary)]]] + [math + [number + ["n" nat] + ["." int]]]]) (type: #export Tag Name) diff --git a/stdlib/source/lux/data/text.lux b/stdlib/source/lux/data/text.lux index 2997c388b..b27a42eec 100644 --- a/stdlib/source/lux/data/text.lux +++ b/stdlib/source/lux/data/text.lux @@ -10,11 +10,12 @@ [codec (#+ Codec)]] [data ["." maybe] + [collection + ["." list ("#\." fold)]]] + [math [number ["." i64] - ["n" nat]] - [collection - ["." list ("#\." fold)]]]]) + ["n" nat]]]]) (type: #export Char Nat) @@ -285,9 +286,9 @@ [..carriage_return] [..form_feed] )] - (`` (case char - (^or <options>) - true + (`` (case char + (^or <options>) + true - _ - false)))) + _ + false)))) diff --git a/stdlib/source/lux/data/text/buffer.lux b/stdlib/source/lux/data/text/buffer.lux index 13316dcc5..e58e10405 100644 --- a/stdlib/source/lux/data/text/buffer.lux +++ b/stdlib/source/lux/data/text/buffer.lux @@ -6,12 +6,13 @@ ["." function]] [data ["." product] - [number - ["n" nat]] [text ["%" format (#+ format)]] [collection ["." row (#+ Row) ("#\." fold)]]] + [math + [number + ["n" nat]]] [type abstract]] ["." //]) diff --git a/stdlib/source/lux/data/text/format.lux b/stdlib/source/lux/data/text/format.lux index a57258bfc..0775eaa45 100644 --- a/stdlib/source/lux/data/text/format.lux +++ b/stdlib/source/lux/data/text/format.lux @@ -10,12 +10,6 @@ [data ["." bit] ["." name] - [number - ["." nat] - ["." int] - ["." rev] - ["." frac] - ["." ratio]] ["." text] [format ["." xml] @@ -27,7 +21,13 @@ ["." duration] ["." date]] [math - ["." modular]] + ["." modular] + [number + ["." nat] + ["." int] + ["." rev] + ["." frac] + ["." ratio]]] [macro [syntax (#+ syntax:)] ["." code] diff --git a/stdlib/source/lux/data/text/regex.lux b/stdlib/source/lux/data/text/regex.lux index 050e55475..c94797a6d 100644 --- a/stdlib/source/lux/data/text/regex.lux +++ b/stdlib/source/lux/data/text/regex.lux @@ -1,5 +1,6 @@ (.module: [lux #* + ["." meta (#+ with_gensyms)] [abstract monad] [control @@ -10,14 +11,14 @@ [data ["." product] ["." maybe] - [number (#+ hex) - ["n" nat ("#\." decimal)]] [collection ["." list ("#\." fold monad)]]] - ["." meta (#+ with_gensyms)] [macro [syntax (#+ syntax:)] - ["." code]]] + ["." code]] + [math + [number (#+ hex) + ["n" nat ("#\." decimal)]]]] ["." // ["%" format (#+ format)]]) @@ -486,8 +487,8 @@ _ do_something_else))} (with_gensyms [g!temp] - (wrap (list& (` (^multi (~ g!temp) - [((~! <t>.run) (..regex (~ (code.text pattern))) (~ g!temp)) - (#try.Success (~ (maybe.default g!temp bindings)))])) - body - branches)))) + (wrap (list& (` (^multi (~ g!temp) + [((~! <t>.run) (..regex (~ (code.text pattern))) (~ g!temp)) + (#try.Success (~ (maybe.default g!temp bindings)))])) + body + branches)))) diff --git a/stdlib/source/lux/data/text/unicode/block.lux b/stdlib/source/lux/data/text/unicode/block.lux index 7e81ff850..4e522c8d3 100644 --- a/stdlib/source/lux/data/text/unicode/block.lux +++ b/stdlib/source/lux/data/text/unicode/block.lux @@ -5,7 +5,7 @@ [hash (#+ Hash)] [monoid (#+ Monoid)] ["." interval (#+ Interval)]] - [data + [math [number (#+ hex) ["n" nat ("#\." interval)] ["." i64]]] diff --git a/stdlib/source/lux/host.js.lux b/stdlib/source/lux/host.js.lux index 43e3e90bf..aa07be184 100644 --- a/stdlib/source/lux/host.js.lux +++ b/stdlib/source/lux/host.js.lux @@ -1,5 +1,6 @@ (.module: [lux #* + ["." meta (#+ with-gensyms)] [abstract [monad (#+ do)]] [control @@ -15,7 +16,6 @@ ["." list ("#\." functor fold)]]] [type abstract] - ["." meta (#+ with-gensyms)] [macro [syntax (#+ syntax:)] ["." code] diff --git a/stdlib/source/lux/host.jvm.lux b/stdlib/source/lux/host.jvm.lux index 8386da339..bf975129a 100644 --- a/stdlib/source/lux/host.jvm.lux +++ b/stdlib/source/lux/host.jvm.lux @@ -1,6 +1,6 @@ (.module: - [lux (#- Type type int char) - ["lux-." type ("#\." equivalence)] + ["." lux (#- Type type int char) + ["#_." type ("#\." equivalence)] [abstract ["." monad (#+ Monad do)] ["." enum]] @@ -10,12 +10,10 @@ ["." try (#+ Try)] ["." exception (#+ Exception exception:)] ["<>" parser ("#\." monad) - ["<t>" text] - ["<c>" code (#+ Parser)]]] + ["<.>" code (#+ Parser)]]] [data ["." maybe] ["." product] - number ["." text ("#\." equivalence) ["%" format (#+ format)]] [collection @@ -164,7 +162,6 @@ ) (def: constructor_method_name "<init>") -(def: member_separator "::") (type: Primitive_Mode #ManualPrM @@ -377,14 +374,14 @@ (-> Text Text (Parser Code)) (do <>.monad [#let [dotted_name (format "::" field_name)] - _ (<c>.this! (code.identifier ["" dotted_name]))] + _ (<code>.this! (code.identifier ["" dotted_name]))] (wrap (get_static_field class_name field_name)))) (def: (make_get_var_parser class_name field_name) (-> Text Text (Parser Code)) (do <>.monad [#let [dotted_name (format "::" field_name)] - _ (<c>.this! (code.identifier ["" dotted_name]))] + _ (<code>.this! (code.identifier ["" dotted_name]))] (wrap (get_virtual_field class_name field_name (' _jvm_this))))) (def: (make_put_var_parser class_name field_name) @@ -392,7 +389,7 @@ (do <>.monad [#let [dotted_name (format "::" field_name)] [_ _ value] (: (Parser [Any Any Code]) - (<c>.form ($_ <>.and (<c>.this! (' :=)) (<c>.this! (code.identifier ["" dotted_name])) <c>.any)))] + (<code>.form ($_ <>.and (<code>.this! (' :=)) (<code>.this! (code.identifier ["" dotted_name])) <code>.any)))] (wrap (`' ((~ (code.text (format "jvm putfield" ":" class_name ":" field_name))) _jvm_this (~ value)))))) (def: (pre_walk_replace f input) @@ -441,8 +438,8 @@ (-> Text (List Argument) (Parser Code)) (do <>.monad [args (: (Parser (List Code)) - (<c>.form (<>.after (<c>.this! (' ::new!)) - (<c>.tuple (<>.exactly (list.size arguments) <c>.any)))))] + (<code>.form (<>.after (<code>.this! (' ::new!)) + (<code>.tuple (<>.exactly (list.size arguments) <code>.any)))))] (wrap (` ("jvm member invoke constructor" (~ (code.text class_name)) (~+ (|> args (list.zip/2 (list\map product.right arguments)) @@ -453,8 +450,8 @@ (do <>.monad [#let [dotted_name (format "::" method_name "!")] args (: (Parser (List Code)) - (<c>.form (<>.after (<c>.this! (code.identifier ["" dotted_name])) - (<c>.tuple (<>.exactly (list.size arguments) <c>.any)))))] + (<code>.form (<>.after (<code>.this! (code.identifier ["" dotted_name])) + (<code>.tuple (<>.exactly (list.size arguments) <code>.any)))))] (wrap (` ("jvm member invoke static" (~ (code.text class_name)) (~ (code.text method_name)) (~+ (|> args (list.zip/2 (list\map product.right arguments)) @@ -466,8 +463,8 @@ (do <>.monad [#let [dotted_name (format "::" method_name "!")] args (: (Parser (List Code)) - (<c>.form (<>.after (<c>.this! (code.identifier ["" dotted_name])) - (<c>.tuple (<>.exactly (list.size arguments) <c>.any)))))] + (<code>.form (<>.after (<code>.this! (code.identifier ["" dotted_name])) + (<code>.tuple (<>.exactly (list.size arguments) <code>.any)))))] (wrap (` (<jvm_op> (~ (code.text class_name)) (~ (code.text method_name)) (~' _jvm_this) (~+ (|> args @@ -501,17 +498,17 @@ (Parser Privacy) (let [(^open ".") <>.monad] ($_ <>.or - (<c>.this! (' #public)) - (<c>.this! (' #private)) - (<c>.this! (' #protected)) + (<code>.this! (' #public)) + (<code>.this! (' #private)) + (<code>.this! (' #protected)) (wrap [])))) (def: inheritance_modifier^ (Parser InheritanceModifier) (let [(^open ".") <>.monad] ($_ <>.or - (<c>.this! (' #final)) - (<c>.this! (' #abstract)) + (<code>.this! (' #final)) + (<code>.this! (' #abstract)) (wrap [])))) (exception: #export (class_names_cannot_contain_periods {name Text}) @@ -542,7 +539,7 @@ (def: (valid_class_name type_vars) (-> (List (Type Var)) (Parser External)) (do <>.monad - [name <c>.local_identifier + [name <code>.local_identifier _ (assert_valid_class_name type_vars name)] (wrap name))) @@ -554,8 +551,8 @@ ($_ <>.either (<>.and (valid_class_name type_vars) (<>\wrap (list))) - (<c>.form (<>.and <c>.local_identifier - (<>.some (parameter^ type_vars))))))] + (<code>.form (<>.and <code>.local_identifier + (<>.some (parameter^ type_vars))))))] (wrap (type.class (name.sanitize name) parameters)))) (exception: #export (unexpected_type_variable {name Text} @@ -567,7 +564,7 @@ (def: (variable^ type_vars) (-> (List (Type Var)) (Parser (Type Parameter))) (do <>.monad - [name <c>.local_identifier + [name <code>.local_identifier _ (..assert ..unexpected_type_variable [name type_vars] (list.member? text.equivalence (list\map parser.name type_vars) name))] (wrap (type.var name)))) @@ -575,15 +572,15 @@ (def: wildcard^ (Parser (Type Parameter)) (do <>.monad - [_ (<c>.this! (' ?))] + [_ (<code>.this! (' ?))] (wrap type.wildcard))) (template [<name> <comparison> <constructor>] [(def: <name> (-> (Parser (Type Class)) (Parser (Type Parameter))) - (|>> (<>.after (<c>.this! (' <comparison>))) + (|>> (<>.after (<code>.this! (' <comparison>))) (<>.after ..wildcard^) - <c>.tuple + <code>.tuple (\ <>.monad map <constructor>)))] [upper^ < type.upper] @@ -608,7 +605,7 @@ (-> (Type (<| Return' Value' category)) (Parser (Type (<| Return' Value' category))))) (do <>.monad - [_ (<c>.identifier! ["" (..reflection type)])] + [_ (<code>.identifier! ["" (..reflection type)])] (wrap type))) (def: primitive^ @@ -626,7 +623,7 @@ (def: array^ (-> (Parser (Type Value)) (Parser (Type Array))) - (|>> <c>.tuple + (|>> <code>.tuple (\ <>.monad map type.array))) (def: (type^ type_vars) @@ -642,7 +639,7 @@ (def: void^ (Parser (Type Void)) (do <>.monad - [_ (<c>.identifier! ["" (reflection.reflection reflection.void)])] + [_ (<code>.identifier! ["" (reflection.reflection reflection.void)])] (wrap type.void))) (def: (return^ type_vars) @@ -652,11 +649,11 @@ (def: var^ (Parser (Type Var)) - (\ <>.monad map type.var <c>.local_identifier)) + (\ <>.monad map type.var <code>.local_identifier)) (def: vars^ (Parser (List (Type Var))) - (<c>.tuple (<>.some var^))) + (<code>.tuple (<>.some var^))) (def: declaration^ (Parser (Type Declaration)) @@ -664,8 +661,8 @@ [[name variables] (: (Parser [External (List (Type Var))]) (<>.either (<>.and (valid_class_name (list)) (<>\wrap (list))) - (<c>.form (<>.and (valid_class_name (list)) - (<>.some var^))) + (<code>.form (<>.and (valid_class_name (list)) + (<>.some var^))) ))] (wrap (type.declaration name variables)))) @@ -675,21 +672,21 @@ (def: annotation_parameters^ (Parser (List Annotation_Parameter)) - (<c>.record (<>.some (<>.and <c>.local_tag <c>.any)))) + (<code>.record (<>.some (<>.and <code>.local_tag <code>.any)))) (def: annotation^ (Parser Annotation) (<>.either (do <>.monad - [ann_name <c>.local_identifier] + [ann_name <code>.local_identifier] (wrap [ann_name (list)])) - (<c>.form (<>.and <c>.local_identifier - annotation_parameters^)))) + (<code>.form (<>.and <code>.local_identifier + annotation_parameters^)))) (def: annotations^' (Parser (List Annotation)) (do <>.monad - [_ (<c>.this! (' #ann))] - (<c>.tuple (<>.some ..annotation^)))) + [_ (<code>.this! (' #ann))] + (<code>.tuple (<>.some ..annotation^)))) (def: annotations^ (Parser (List Annotation)) @@ -701,51 +698,51 @@ (-> (List (Type Var)) (Parser (List (Type Class)))) (<| (<>.default (list)) (do <>.monad - [_ (<c>.this! (' #throws))] - (<c>.tuple (<>.some (..class^ type_vars)))))) + [_ (<code>.this! (' #throws))] + (<code>.tuple (<>.some (..class^ type_vars)))))) (def: (method_decl^ type_vars) (-> (List (Type Var)) (Parser [Member_Declaration MethodDecl])) - (<c>.form (do <>.monad - [tvars (<>.default (list) ..vars^) - name <c>.local_identifier - anns ..annotations^ - inputs (<c>.tuple (<>.some (..type^ type_vars))) - output (..return^ type_vars) - exs (throws_decl^ type_vars)] - (wrap [[name #PublicP anns] {#method_tvars tvars - #method_inputs inputs - #method_output output - #method_exs exs}])))) + (<code>.form (do <>.monad + [tvars (<>.default (list) ..vars^) + name <code>.local_identifier + anns ..annotations^ + inputs (<code>.tuple (<>.some (..type^ type_vars))) + output (..return^ type_vars) + exs (throws_decl^ type_vars)] + (wrap [[name #PublicP anns] {#method_tvars tvars + #method_inputs inputs + #method_output output + #method_exs exs}])))) (def: state_modifier^ (Parser StateModifier) ($_ <>.or - (<c>.this! (' #volatile)) - (<c>.this! (' #final)) + (<code>.this! (' #volatile)) + (<code>.this! (' #final)) (\ <>.monad wrap []))) (def: (field_decl^ type_vars) (-> (List (Type Var)) (Parser [Member_Declaration FieldDecl])) - (<>.either (<c>.form (do <>.monad - [_ (<c>.this! (' #const)) - name <c>.local_identifier - anns ..annotations^ - type (..type^ type_vars) - body <c>.any] - (wrap [[name #PublicP anns] (#ConstantField [type body])]))) - (<c>.form (do <>.monad - [pm privacy_modifier^ - sm state_modifier^ - name <c>.local_identifier - anns ..annotations^ - type (..type^ type_vars)] - (wrap [[name pm anns] (#VariableField [sm type])]))))) + (<>.either (<code>.form (do <>.monad + [_ (<code>.this! (' #const)) + name <code>.local_identifier + anns ..annotations^ + type (..type^ type_vars) + body <code>.any] + (wrap [[name #PublicP anns] (#ConstantField [type body])]))) + (<code>.form (do <>.monad + [pm privacy_modifier^ + sm state_modifier^ + name <code>.local_identifier + anns ..annotations^ + type (..type^ type_vars)] + (wrap [[name pm anns] (#VariableField [sm type])]))))) (def: (argument^ type_vars) (-> (List (Type Var)) (Parser Argument)) - (<c>.record (<>.and <c>.local_identifier - (..type^ type_vars)))) + (<code>.record (<>.and <code>.local_identifier + (..type^ type_vars)))) (def: (arguments^ type_vars) (-> (List (Type Var)) (Parser (List Argument))) @@ -753,126 +750,126 @@ (def: (constructor_arg^ type_vars) (-> (List (Type Var)) (Parser (Typed Code))) - (<c>.record (<>.and (..type^ type_vars) <c>.any))) + (<code>.record (<>.and (..type^ type_vars) <code>.any))) (def: (constructor_args^ type_vars) (-> (List (Type Var)) (Parser (List (Typed Code)))) - (<c>.tuple (<>.some (..constructor_arg^ type_vars)))) + (<code>.tuple (<>.some (..constructor_arg^ type_vars)))) (def: (constructor_method^ class_vars) - (List (Type Var)) (Parser [Member_Declaration Method_Definition]) - (<c>.form (do <>.monad - [pm privacy_modifier^ - strict_fp? (<>.parses? (<c>.this! (' #strict))) - method_vars (<>.default (list) ..vars^) - #let [total_vars (list\compose class_vars method_vars)] - [_ self_name arguments] (<c>.form ($_ <>.and - (<c>.this! (' new)) - <c>.local_identifier - (..arguments^ total_vars))) - constructor_args (..constructor_args^ total_vars) - exs (throws_decl^ total_vars) - annotations ..annotations^ - body <c>.any] - (wrap [{#member_name constructor_method_name - #member_privacy pm - #member_anns annotations} - (#ConstructorMethod strict_fp? method_vars self_name arguments constructor_args body exs)])))) + (-> (List (Type Var)) (Parser [Member_Declaration Method_Definition])) + (<code>.form (do <>.monad + [pm privacy_modifier^ + strict_fp? (<>.parses? (<code>.this! (' #strict))) + method_vars (<>.default (list) ..vars^) + #let [total_vars (list\compose class_vars method_vars)] + [_ self_name arguments] (<code>.form ($_ <>.and + (<code>.this! (' new)) + <code>.local_identifier + (..arguments^ total_vars))) + constructor_args (..constructor_args^ total_vars) + exs (throws_decl^ total_vars) + annotations ..annotations^ + body <code>.any] + (wrap [{#member_name constructor_method_name + #member_privacy pm + #member_anns annotations} + (#ConstructorMethod strict_fp? method_vars self_name arguments constructor_args body exs)])))) (def: (virtual_method_def^ class_vars) (-> (List (Type Var)) (Parser [Member_Declaration Method_Definition])) - (<c>.form (do <>.monad - [pm privacy_modifier^ - strict_fp? (<>.parses? (<c>.this! (' #strict))) - final? (<>.parses? (<c>.this! (' #final))) - method_vars (<>.default (list) ..vars^) - #let [total_vars (list\compose class_vars method_vars)] - [name self_name arguments] (<c>.form ($_ <>.and - <c>.local_identifier - <c>.local_identifier - (..arguments^ total_vars))) - return_type (..return^ total_vars) - exs (throws_decl^ total_vars) - annotations ..annotations^ - body <c>.any] - (wrap [{#member_name name - #member_privacy pm - #member_anns annotations} - (#VirtualMethod final? strict_fp? method_vars self_name arguments return_type body exs)])))) + (<code>.form (do <>.monad + [pm privacy_modifier^ + strict_fp? (<>.parses? (<code>.this! (' #strict))) + final? (<>.parses? (<code>.this! (' #final))) + method_vars (<>.default (list) ..vars^) + #let [total_vars (list\compose class_vars method_vars)] + [name self_name arguments] (<code>.form ($_ <>.and + <code>.local_identifier + <code>.local_identifier + (..arguments^ total_vars))) + return_type (..return^ total_vars) + exs (throws_decl^ total_vars) + annotations ..annotations^ + body <code>.any] + (wrap [{#member_name name + #member_privacy pm + #member_anns annotations} + (#VirtualMethod final? strict_fp? method_vars self_name arguments return_type body exs)])))) (def: overriden_method_def^ (Parser [Member_Declaration Method_Definition]) - (<c>.form (do <>.monad - [strict_fp? (<>.parses? (<c>.this! (' #strict))) - owner_class ..declaration^ - method_vars (<>.default (list) ..vars^) - #let [total_vars (list\compose (product.right (parser.declaration owner_class)) - method_vars)] - [name self_name arguments] (<c>.form ($_ <>.and - <c>.local_identifier - <c>.local_identifier - (..arguments^ total_vars))) - return_type (..return^ total_vars) - exs (throws_decl^ total_vars) - annotations ..annotations^ - body <c>.any] - (wrap [{#member_name name - #member_privacy #PublicP - #member_anns annotations} - (#OverridenMethod strict_fp? owner_class method_vars self_name arguments return_type body exs)])))) + (<code>.form (do <>.monad + [strict_fp? (<>.parses? (<code>.this! (' #strict))) + owner_class ..declaration^ + method_vars (<>.default (list) ..vars^) + #let [total_vars (list\compose (product.right (parser.declaration owner_class)) + method_vars)] + [name self_name arguments] (<code>.form ($_ <>.and + <code>.local_identifier + <code>.local_identifier + (..arguments^ total_vars))) + return_type (..return^ total_vars) + exs (throws_decl^ total_vars) + annotations ..annotations^ + body <code>.any] + (wrap [{#member_name name + #member_privacy #PublicP + #member_anns annotations} + (#OverridenMethod strict_fp? owner_class method_vars self_name arguments return_type body exs)])))) (def: static_method_def^ (Parser [Member_Declaration Method_Definition]) - (<c>.form (do <>.monad - [pm privacy_modifier^ - strict_fp? (<>.parses? (<c>.this! (' #strict))) - _ (<c>.this! (' #static)) - method_vars (<>.default (list) ..vars^) - #let [total_vars method_vars] - [name arguments] (<c>.form (<>.and <c>.local_identifier - (..arguments^ total_vars))) - return_type (..return^ total_vars) - exs (throws_decl^ total_vars) - annotations ..annotations^ - body <c>.any] - (wrap [{#member_name name - #member_privacy pm - #member_anns annotations} - (#StaticMethod strict_fp? method_vars arguments return_type body exs)])))) + (<code>.form (do <>.monad + [pm privacy_modifier^ + strict_fp? (<>.parses? (<code>.this! (' #strict))) + _ (<code>.this! (' #static)) + method_vars (<>.default (list) ..vars^) + #let [total_vars method_vars] + [name arguments] (<code>.form (<>.and <code>.local_identifier + (..arguments^ total_vars))) + return_type (..return^ total_vars) + exs (throws_decl^ total_vars) + annotations ..annotations^ + body <code>.any] + (wrap [{#member_name name + #member_privacy pm + #member_anns annotations} + (#StaticMethod strict_fp? method_vars arguments return_type body exs)])))) (def: abstract_method_def^ (Parser [Member_Declaration Method_Definition]) - (<c>.form (do <>.monad - [pm privacy_modifier^ - _ (<c>.this! (' #abstract)) - method_vars (<>.default (list) ..vars^) - #let [total_vars method_vars] - [name arguments] (<c>.form (<>.and <c>.local_identifier - (..arguments^ total_vars))) - return_type (..return^ total_vars) - exs (throws_decl^ total_vars) - annotations ..annotations^] - (wrap [{#member_name name - #member_privacy pm - #member_anns annotations} - (#AbstractMethod method_vars arguments return_type exs)])))) + (<code>.form (do <>.monad + [pm privacy_modifier^ + _ (<code>.this! (' #abstract)) + method_vars (<>.default (list) ..vars^) + #let [total_vars method_vars] + [name arguments] (<code>.form (<>.and <code>.local_identifier + (..arguments^ total_vars))) + return_type (..return^ total_vars) + exs (throws_decl^ total_vars) + annotations ..annotations^] + (wrap [{#member_name name + #member_privacy pm + #member_anns annotations} + (#AbstractMethod method_vars arguments return_type exs)])))) (def: native_method_def^ (Parser [Member_Declaration Method_Definition]) - (<c>.form (do <>.monad - [pm privacy_modifier^ - _ (<c>.this! (' #native)) - method_vars (<>.default (list) ..vars^) - #let [total_vars method_vars] - [name arguments] (<c>.form (<>.and <c>.local_identifier - (..arguments^ total_vars))) - return_type (..return^ total_vars) - exs (throws_decl^ total_vars) - annotations ..annotations^] - (wrap [{#member_name name - #member_privacy pm - #member_anns annotations} - (#NativeMethod method_vars arguments return_type exs)])))) + (<code>.form (do <>.monad + [pm privacy_modifier^ + _ (<code>.this! (' #native)) + method_vars (<>.default (list) ..vars^) + #let [total_vars method_vars] + [name arguments] (<code>.form (<>.and <code>.local_identifier + (..arguments^ total_vars))) + return_type (..return^ total_vars) + exs (throws_decl^ total_vars) + annotations ..annotations^] + (wrap [{#member_name name + #member_privacy pm + #member_anns annotations} + (#NativeMethod method_vars arguments return_type exs)])))) (def: (method_def^ class_vars) (-> (List (Type Var)) (Parser [Member_Declaration Method_Definition])) @@ -886,103 +883,110 @@ (def: partial_call^ (Parser Partial_Call) - (<c>.form (<>.and <c>.identifier (<>.some <c>.any)))) + (<code>.form (<>.and <code>.identifier (<>.some <code>.any)))) (def: class_kind^ (Parser Class_Kind) (<>.either (do <>.monad - [_ (<c>.this! (' #class))] + [_ (<code>.this! (' #class))] (wrap #Class)) (do <>.monad - [_ (<c>.this! (' #interface))] + [_ (<code>.this! (' #interface))] (wrap #Interface)) )) (def: import_member_alias^ (Parser (Maybe Text)) (<>.maybe (do <>.monad - [_ (<c>.this! (' #as))] - <c>.local_identifier))) + [_ (<code>.this! (' #as))] + <code>.local_identifier))) (def: (import_member_args^ type_vars) (-> (List (Type Var)) (Parser (List [Bit (Type Value)]))) - (<c>.tuple (<>.some (<>.and (<>.parses? (<c>.tag! ["" "?"])) - (..type^ type_vars))))) + (<code>.tuple (<>.some (<>.and (<>.parses? (<code>.tag! ["" "?"])) + (..type^ type_vars))))) (def: import_member_return_flags^ (Parser [Bit Bit Bit]) ($_ <>.and - (<>.parses? (<c>.this! (' #io))) - (<>.parses? (<c>.this! (' #try))) - (<>.parses? (<c>.this! (' #?))))) + (<>.parses? (<code>.this! (' #io))) + (<>.parses? (<code>.this! (' #try))) + (<>.parses? (<code>.this! (' #?))))) (def: primitive_mode^ (Parser Primitive_Mode) - (<>.or (<c>.tag! ["" "manual"]) - (<c>.tag! ["" "auto"]))) + (<>.or (<code>.tag! ["" "manual"]) + (<code>.tag! ["" "auto"]))) (def: (import_member_decl^ owner_vars) (-> (List (Type Var)) (Parser Import_Member_Declaration)) ($_ <>.either - (<c>.form (do <>.monad - [_ (<c>.this! (' #enum)) - enum_members (<>.some <c>.local_identifier)] - (wrap (#EnumDecl enum_members)))) - (<c>.form (do <>.monad - [tvars (<>.default (list) ..vars^) - _ (<c>.identifier! ["" "new"]) - ?alias import_member_alias^ - #let [total_vars (list\compose owner_vars tvars)] - ?prim_mode (<>.maybe primitive_mode^) - args (..import_member_args^ total_vars) - [io? try? maybe?] import_member_return_flags^] - (wrap (#ConstructorDecl [{#import_member_mode (maybe.default #AutoPrM ?prim_mode) - #import_member_alias (maybe.default "new" ?alias) - #import_member_kind #VirtualIMK - #import_member_tvars tvars - #import_member_args args - #import_member_maybe? maybe? - #import_member_try? try? - #import_member_io? io?} - {}])) - )) - (<c>.form (do <>.monad - [kind (: (Parser ImportMethodKind) - (<>.or (<c>.tag! ["" "static"]) - (wrap []))) - tvars (<>.default (list) ..vars^) - name <c>.local_identifier - ?alias import_member_alias^ - #let [total_vars (list\compose owner_vars tvars)] - ?prim_mode (<>.maybe primitive_mode^) - args (..import_member_args^ total_vars) - [io? try? maybe?] import_member_return_flags^ - return (..return^ total_vars)] - (wrap (#MethodDecl [{#import_member_mode (maybe.default #AutoPrM ?prim_mode) - #import_member_alias (maybe.default name ?alias) - #import_member_kind kind - #import_member_tvars tvars - #import_member_args args - #import_member_maybe? maybe? - #import_member_try? try? - #import_member_io? io?} - {#import_method_name name - #import_method_return return}])))) - (<c>.form (do <>.monad - [static? (<>.parses? (<c>.this! (' #static))) - name <c>.local_identifier - ?prim_mode (<>.maybe primitive_mode^) - gtype (..type^ owner_vars) - maybe? (<>.parses? (<c>.this! (' #?))) - setter? (<>.parses? (<c>.this! (' #!)))] - (wrap (#FieldAccessDecl {#import_field_mode (maybe.default #AutoPrM ?prim_mode) - #import_field_name name - #import_field_static? static? - #import_field_maybe? maybe? - #import_field_setter? setter? - #import_field_type gtype})))) + (<code>.form (do <>.monad + [_ (<code>.this! (' #enum)) + enum_members (<>.some <code>.local_identifier)] + (wrap (#EnumDecl enum_members)))) + (<code>.form (do <>.monad + [tvars (<>.default (list) ..vars^) + _ (<code>.identifier! ["" "new"]) + ?alias import_member_alias^ + #let [total_vars (list\compose owner_vars tvars)] + ?prim_mode (<>.maybe primitive_mode^) + args (..import_member_args^ total_vars) + [io? try? maybe?] import_member_return_flags^] + (wrap (#ConstructorDecl [{#import_member_mode (maybe.default #AutoPrM ?prim_mode) + #import_member_alias (maybe.default "new" ?alias) + #import_member_kind #VirtualIMK + #import_member_tvars tvars + #import_member_args args + #import_member_maybe? maybe? + #import_member_try? try? + #import_member_io? io?} + {}])) + )) + (<code>.form (do <>.monad + [kind (: (Parser ImportMethodKind) + (<>.or (<code>.tag! ["" "static"]) + (wrap []))) + tvars (<>.default (list) ..vars^) + name <code>.local_identifier + ?alias import_member_alias^ + #let [total_vars (list\compose owner_vars tvars)] + ?prim_mode (<>.maybe primitive_mode^) + args (..import_member_args^ total_vars) + [io? try? maybe?] import_member_return_flags^ + return (..return^ total_vars)] + (wrap (#MethodDecl [{#import_member_mode (maybe.default #AutoPrM ?prim_mode) + #import_member_alias (maybe.default name ?alias) + #import_member_kind kind + #import_member_tvars tvars + #import_member_args args + #import_member_maybe? maybe? + #import_member_try? try? + #import_member_io? io?} + {#import_method_name name + #import_method_return return}])))) + (<code>.form (do <>.monad + [static? (<>.parses? (<code>.this! (' #static))) + name <code>.local_identifier + ?prim_mode (<>.maybe primitive_mode^) + gtype (..type^ owner_vars) + maybe? (<>.parses? (<code>.this! (' #?))) + setter? (<>.parses? (<code>.this! (' #!)))] + (wrap (#FieldAccessDecl {#import_field_mode (maybe.default #AutoPrM ?prim_mode) + #import_field_name name + #import_field_static? static? + #import_field_maybe? maybe? + #import_field_setter? setter? + #import_field_type gtype})))) )) +(def: bundle + (-> (List (Type Var)) (Parser [Text (List Import_Member_Declaration)])) + (|>> ..import_member_decl^ + <>.some + (<>.and <code>.text) + <code>.tuple)) + (def: (privacy_modifier$ pm) (-> Privacy Code) (case pm @@ -1098,16 +1102,16 @@ (~ (pre_walk_replace replacer body)))) (#OverridenMethod strict_fp? declaration type_vars self_name arguments return_type body exs) - (let [super_replacer (parser_>replacer (<c>.form (do <>.monad - [_ (<c>.this! (' ::super!)) - args (<c>.tuple (<>.exactly (list.size arguments) <c>.any))] - (wrap (` ("jvm member invoke special" - (~ (code.text (product.left (parser.read_class super_class)))) - (~ (code.text name)) - (~' _jvm_this) - (~+ (|> args - (list.zip/2 (list\map product.right arguments)) - (list\map ..decorate_input)))))))))] + (let [super_replacer (parser->replacer (<code>.form (do <>.monad + [_ (<code>.this! (' ::super!)) + args (<code>.tuple (<>.exactly (list.size arguments) <code>.any))] + (wrap (` ("jvm member invoke special" + (~ (code.text (product.left (parser.read_class super_class)))) + (~ (code.text name)) + (~' _jvm_this) + (~+ (|> args + (list.zip/2 (list\map product.right arguments)) + (list\map ..decorate_input)))))))))] (` ("override" (~ (declaration$ declaration)) (~ (code.text name)) @@ -1171,7 +1175,7 @@ {super (<>.default $Object (class^ class_vars))} {interfaces (<>.default (list) - (<c>.tuple (<>.some (class^ class_vars))))} + (<code>.tuple (<>.some (class^ class_vars))))} {annotations ..annotations^} {fields (<>.some (..field_decl^ class_vars))} {methods (<>.some (..method_def^ class_vars))}) @@ -1208,9 +1212,9 @@ (do meta.monad [current_module meta.current_module_name #let [fully_qualified_class_name (name.qualify current_module full_class_name) - field_parsers (list\map (field_>parser fully_qualified_class_name) fields) - method_parsers (list\map (method_>parser fully_qualified_class_name) methods) - replacer (parser_>replacer (list\fold <>.either + field_parsers (list\map (field->parser fully_qualified_class_name) fields) + method_parsers (list\map (method->parser fully_qualified_class_name) methods) + replacer (parser->replacer (list\fold <>.either (<>.fail "") (list\compose field_parsers method_parsers)))]] (wrap (list (` ("jvm class" @@ -1226,7 +1230,7 @@ {#let [! <>.monad]} {[full_class_name class_vars] (\ ! map parser.declaration ..declaration^)} {supers (<>.default (list) - (<c>.tuple (<>.some (class^ class_vars))))} + (<code>.tuple (<>.some (class^ class_vars))))} {annotations ..annotations^} {members (<>.some (..method_decl^ class_vars))}) {#.doc (doc "Allows defining JVM interfaces." @@ -1245,7 +1249,7 @@ {super (<>.default $Object (class^ class_vars))} {interfaces (<>.default (list) - (<c>.tuple (<>.some (class^ class_vars))))} + (<code>.tuple (<>.some (class^ class_vars))))} {constructor_args (..constructor_args^ class_vars)} {methods (<>.some ..overriden_method_def^)}) {#.doc (doc "Allows defining anonymous classes." @@ -1287,10 +1291,10 @@ (= (??? "YOLO") (#.Some "YOLO")))} (with_gensyms [g!temp] - (wrap (list (` (let [(~ g!temp) (~ expr)] - (if ("jvm object null?" (~ g!temp)) - #.None - (#.Some (~ g!temp))))))))) + (wrap (list (` (let [(~ g!temp) (~ expr)] + (if ("jvm object null?" (~ g!temp)) + #.None + (#.Some (~ g!temp))))))))) (syntax: #export (!!! expr) {#.doc (doc "Takes a (Maybe ObjectType) and returns a ObjectType." @@ -1300,12 +1304,12 @@ (= "foo" (!!! (??? "foo"))))} (with_gensyms [g!value] - (wrap (list (` ({(#.Some (~ g!value)) - (~ g!value) + (wrap (list (` ({(#.Some (~ g!value)) + (~ g!value) - #.None - ("jvm object null")} - (~ expr))))))) + #.None + ("jvm object null")} + (~ expr))))))) (syntax: #export (try expression) {#.doc (doc (case (try (risky_computation input)) @@ -1317,31 +1321,31 @@ (wrap (list (` ("lux try" ((~! io.io) (~ expression))))))) (syntax: #export (check {class (..type^ (list))} - {unchecked (<>.maybe <c>.any)}) + {unchecked (<>.maybe <code>.any)}) {#.doc (doc "Checks whether an object is an instance of a particular class." "Caveat emptor: Cannot check for polymorphism, so avoid using parameterized classes." (case (check String "YOLO") (#.Some value_as_string) #.None))} (with_gensyms [g!_ g!unchecked] - (let [class_name (..reflection class) - class_type (` (.primitive (~ (code.text class_name)))) - check_type (` (.Maybe (~ class_type))) - check_code (` (if ("jvm object instance?" (~ (code.text class_name)) (~ g!unchecked)) - (#.Some (.:coerce (~ class_type) - (~ g!unchecked))) - #.None))] - (case unchecked - (#.Some unchecked) - (wrap (list (` (: (~ check_type) - (let [(~ g!unchecked) (~ unchecked)] - (~ check_code)))))) - - #.None - (wrap (list (` (: (-> (primitive "java.lang.Object") (~ check_type)) - (function ((~ g!_) (~ g!unchecked)) - (~ check_code)))))) - )))) + (let [class_name (..reflection class) + class_type (` (.primitive (~ (code.text class_name)))) + check_type (` (.Maybe (~ class_type))) + check_code (` (if ("jvm object instance?" (~ (code.text class_name)) (~ g!unchecked)) + (#.Some (.:coerce (~ class_type) + (~ g!unchecked))) + #.None))] + (case unchecked + (#.Some unchecked) + (wrap (list (` (: (~ check_type) + (let [(~ g!unchecked) (~ unchecked)] + (~ check_code)))))) + + #.None + (wrap (list (` (: (-> (primitive "java.lang.Object") (~ check_type)) + (function ((~ g!_) (~ g!unchecked)) + (~ check_code)))))) + )))) (syntax: #export (synchronized lock body) {#.doc (doc "Evaluates body, while holding a lock on a given object." @@ -1357,9 +1361,9 @@ (ClassName::method1 arg0 arg1 arg2) (ClassName::method2 arg3 arg4 arg5)))} (with_gensyms [g!obj] - (wrap (list (` (let [(~ g!obj) (~ obj)] - (exec (~+ (list\map (complete_call$ g!obj) methods)) - (~ g!obj)))))))) + (wrap (list (` (let [(~ g!obj) (~ obj)] + (exec (~+ (list\map (complete_call$ g!obj) methods)) + (~ g!obj)))))))) (def: (class_import$ declaration) (-> (Type Declaration) Code) @@ -1374,7 +1378,7 @@ [(~+ params')])))))) (def: (member_type_vars class_tvars member) - (_> (List (Type Var)) Import_Member_Declaration (List (Type Var))) + (-> (List (Type Var)) Import_Member_Declaration (List (Type Var))) (case member (#ConstructorDecl [commons _]) (list\compose class_tvars (get@ #import_member_tvars commons)) @@ -1400,7 +1404,7 @@ (: (-> [Bit (Type Value)] (Meta [Bit Code])) (function (_ [maybe? _]) (with_gensyms [arg_name] - (wrap [maybe? arg_name])))) + (wrap [maybe? arg_name])))) import_member_args) #let [input_jvm_types (list\map product.right import_member_args) arg_types (list\map (: (-> [Bit (Type Value)] Code) @@ -1468,18 +1472,18 @@ <cond_cases> (template [<old> <new> <pre> <post>] [(\ type.equivalence = <old> unboxed) (with_expansions [<post>' (template.splice <post>)] - [<new> - (` (.|> (~ raw) (~+ <pre>))) - (list <post>')])] + [<new> + (` (.|> (~ raw) (~+ <pre>))) + (list <post>')])] <special+>')] - (cond <cond_cases> - ## else - [unboxed - (if <input?> - (` ("jvm object cast" (~ raw))) - raw) - (list)])))) + (cond <cond_cases> + ## else + [unboxed + (if <input?> + (` ("jvm object cast" (~ raw))) + raw) + (list)])))) unboxed/boxed (case (dictionary.get unboxed ..boxes) (#.Some boxed) (<unbox/box> unboxed boxed refined) @@ -1533,8 +1537,14 @@ (list.zip/2 classes) (list\map (auto_convert_input mode)))) -(def: (member_def_interop vars kind class [arg_function_inputs input_jvm_types arg_types] member method_prefix) - (-> (List (Type Var)) Class_Kind (Type Declaration) [(List [Bit Code]) (List (Type Value)) (List Code)] Import_Member_Declaration Text (Meta (List Code))) +(def: (import_name format class member) + (-> Text Text Text Text) + (|> format + (text.replace_all "#" class) + (text.replace_all "." member))) + +(def: (member_def_interop vars kind class [arg_function_inputs input_jvm_types arg_types] member method_prefix import_format) + (-> (List (Type Var)) Class_Kind (Type Declaration) [(List [Bit Code]) (List (Type Value)) (List Code)] Import_Member_Declaration Text Text (Meta (List Code))) (let [[full_name class_tvars] (parser.declaration class)] (case member (#EnumDecl enum_members) @@ -1549,7 +1559,7 @@ (` (All [(~+ =class_tvars)] (primitive (~ (code.text full_name)) [(~+ =class_tvars)])))))) getter_interop (: (-> Text Code) (function (_ name) - (let [getter_name (code.identifier ["" (format method_prefix member_separator name)])] + (let [getter_name (code.identifier ["" (..import_name import_format method_prefix name)])] (` (def: (~ getter_name) (~ enum_type) (~ (get_static_field full_name name)))))))]] @@ -1558,7 +1568,7 @@ (#ConstructorDecl [commons _]) (do meta.monad [#let [classT (type.class full_name (list)) - def_name (code.identifier ["" (format method_prefix member_separator (get@ #import_member_alias commons))]) + def_name (code.identifier ["" (..import_name import_format method_prefix (get@ #import_member_alias commons))]) jvm_interop (|> [classT (` ("jvm member invoke constructor" [(~+ (list\map ..var$ class_tvars))] @@ -1576,110 +1586,110 @@ (#MethodDecl [commons method]) (with_gensyms [g!obj] - (do meta.monad - [#let [def_name (code.identifier ["" (format method_prefix member_separator (get@ #import_member_alias commons))]) - (^slots [#import_member_kind]) commons - (^slots [#import_method_name]) method - [jvm_op object_ast] (: [Text (List Code)] - (case import_member_kind - #StaticIMK - ["jvm member invoke static" - (list)] - - #VirtualIMK - (case kind - #Class - ["jvm member invoke virtual" - (list g!obj)] - - #Interface - ["jvm member invoke interface" - (list g!obj)] - ))) - method_return (get@ #import_method_return method) - callC (: Code - (` ((~ (code.text jvm_op)) - [(~+ (list\map ..var$ class_tvars))] - (~ (code.text full_name)) - (~ (code.text import_method_name)) - [(~+ (list\map ..var$ (get@ #import_member_tvars commons)))] - (~+ (|> object_ast - (list\map ..un_quote) - (list.zip/2 (list (type.class full_name (list)))) - (list\map (auto_convert_input (get@ #import_member_mode commons))))) - (~+ (|> (jvm_invoke_inputs (get@ #import_member_mode commons) input_jvm_types arg_function_inputs) - (list.zip/2 input_jvm_types) - (list\map ..decorate_input)))))) - jvm_interop (: Code - (case (type.void? method_return) - (#.Left method_return) - (|> [method_return - callC] - (auto_convert_output (get@ #import_member_mode commons)) - (decorate_return_maybe member false method_return) - (decorate_return_try member) - (decorate_return_io member)) - - - (#.Right method_return) - (|> callC - (decorate_return_try member) - (decorate_return_io member))))]] - (wrap (list (` ((~! syntax:) ((~ def_name) (~+ (list\map product.right arg_function_inputs)) (~+ object_ast)) - ((~' wrap) (.list (.` (~ jvm_interop)))))))))) + (do meta.monad + [#let [def_name (code.identifier ["" (..import_name import_format method_prefix (get@ #import_member_alias commons))]) + (^slots [#import_member_kind]) commons + (^slots [#import_method_name]) method + [jvm_op object_ast] (: [Text (List Code)] + (case import_member_kind + #StaticIMK + ["jvm member invoke static" + (list)] + + #VirtualIMK + (case kind + #Class + ["jvm member invoke virtual" + (list g!obj)] + + #Interface + ["jvm member invoke interface" + (list g!obj)] + ))) + method_return (get@ #import_method_return method) + callC (: Code + (` ((~ (code.text jvm_op)) + [(~+ (list\map ..var$ class_tvars))] + (~ (code.text full_name)) + (~ (code.text import_method_name)) + [(~+ (list\map ..var$ (get@ #import_member_tvars commons)))] + (~+ (|> object_ast + (list\map ..un_quote) + (list.zip/2 (list (type.class full_name (list)))) + (list\map (auto_convert_input (get@ #import_member_mode commons))))) + (~+ (|> (jvm_invoke_inputs (get@ #import_member_mode commons) input_jvm_types arg_function_inputs) + (list.zip/2 input_jvm_types) + (list\map ..decorate_input)))))) + jvm_interop (: Code + (case (type.void? method_return) + (#.Left method_return) + (|> [method_return + callC] + (auto_convert_output (get@ #import_member_mode commons)) + (decorate_return_maybe member false method_return) + (decorate_return_try member) + (decorate_return_io member)) + + + (#.Right method_return) + (|> callC + (decorate_return_try member) + (decorate_return_io member))))]] + (wrap (list (` ((~! syntax:) ((~ def_name) (~+ (list\map product.right arg_function_inputs)) (~+ object_ast)) + ((~' wrap) (.list (.` (~ jvm_interop)))))))))) (#FieldAccessDecl fad) (do meta.monad [#let [(^open ".") fad - getter_name (code.identifier ["" (format method_prefix member_separator import_field_name)]) - setter_name (code.identifier ["" (format method_prefix member_separator import_field_name "!")])] + getter_name (code.identifier ["" (..import_name import_format method_prefix import_field_name)]) + setter_name (code.identifier ["" (..import_name import_format method_prefix (format import_field_name "!"))])] getter_interop (with_gensyms [g!obj] - (let [getter_call (if import_field_static? - (` ((~ getter_name))) - (` ((~ getter_name) (~ g!obj)))) - getter_body (<| (auto_convert_output import_field_mode) - [import_field_type - (if import_field_static? - (get_static_field full_name import_field_name) - (get_virtual_field full_name import_field_name (un_quote g!obj)))]) - getter_body (if import_field_maybe? - (` ((~! ???) (~ getter_body))) - getter_body) - getter_body (if import_field_setter? - (` ((~! io.io) (~ getter_body))) - getter_body)] - (wrap (` ((~! syntax:) (~ getter_call) - ((~' wrap) (.list (.` (~ getter_body))))))))) + (let [getter_call (if import_field_static? + (` ((~ getter_name))) + (` ((~ getter_name) (~ g!obj)))) + getter_body (<| (auto_convert_output import_field_mode) + [import_field_type + (if import_field_static? + (get_static_field full_name import_field_name) + (get_virtual_field full_name import_field_name (un_quote g!obj)))]) + getter_body (if import_field_maybe? + (` ((~! ???) (~ getter_body))) + getter_body) + getter_body (if import_field_setter? + (` ((~! io.io) (~ getter_body))) + getter_body)] + (wrap (` ((~! syntax:) (~ getter_call) + ((~' wrap) (.list (.` (~ getter_body))))))))) setter_interop (: (Meta (List Code)) (if import_field_setter? (with_gensyms [g!obj g!value] - (let [setter_call (if import_field_static? - (` ((~ setter_name) (~ g!value))) - (` ((~ setter_name) (~ g!value) (~ g!obj)))) - setter_value (|> [import_field_type (un_quote g!value)] - (auto_convert_input import_field_mode)) - setter_value (if import_field_maybe? - (` ((~! !!!) (~ setter_value))) - setter_value) - setter_command (format (if import_field_static? "jvm putstatic" "jvm putfield") - ":" full_name ":" import_field_name) - g!obj+ (: (List Code) - (if import_field_static? - (list) - (list (un_quote g!obj))))] - (wrap (list (` ((~! syntax:) (~ setter_call) - ((~' wrap) (.list (.` ((~! io.io) ((~ (code.text setter_command)) (~+ g!obj+) (~ setter_value)))))))))))) + (let [setter_call (if import_field_static? + (` ((~ setter_name) (~ g!value))) + (` ((~ setter_name) (~ g!value) (~ g!obj)))) + setter_value (|> [import_field_type (un_quote g!value)] + (auto_convert_input import_field_mode)) + setter_value (if import_field_maybe? + (` ((~! !!!) (~ setter_value))) + setter_value) + setter_command (format (if import_field_static? "jvm putstatic" "jvm putfield") + ":" full_name ":" import_field_name) + g!obj+ (: (List Code) + (if import_field_static? + (list) + (list (un_quote g!obj))))] + (wrap (list (` ((~! syntax:) (~ setter_call) + ((~' wrap) (.list (.` ((~! io.io) ((~ (code.text setter_command)) (~+ g!obj+) (~ setter_value)))))))))))) (wrap (list))))] (wrap (list& getter_interop setter_interop))) ))) -(def: (member_import$ vars kind class member) - (-> (List (Type Var)) Class_Kind (Type Declaration) Import_Member_Declaration (Meta (List Code))) +(def: (member_import$ vars kind class [import_format member]) + (-> (List (Type Var)) Class_Kind (Type Declaration) [Text Import_Member_Declaration] (Meta (List Code))) (let [[full_name _] (parser.declaration class) method_prefix (..internal full_name)] (do meta.monad [=args (member_def_arg_bindings vars member)] - (member_def_interop vars kind class =args member method_prefix)))) + (member_def_interop vars kind class =args member method_prefix import_format)))) (def: interface? (All [a] (-> (primitive "java.lang.Class" [a]) Bit)) @@ -1709,13 +1719,15 @@ (syntax: #export (import: {declaration ..declaration^} - {members (<>.some (..import_member_decl^ class_type_vars))}) + {#let [[class_name class_type_vars] (parser.declaration declaration)]} + {bundles (<>.some (..bundle class_type_vars))}) {#.doc (doc "Allows importing JVM classes, and using them as types." "Their methods, fields and enum options can also be imported." (import: java/lang/Object - (new []) - (equals [java/lang/Object] boolean) - (wait [int] #io #try void)) + ["#::." + (new []) + (equals [java/lang/Object] boolean) + (wait [int] #io #try void)]) "Special options can also be given for the return values." "#? means that the values will be returned inside a Maybe type. That way, null becomes #.None." @@ -1723,31 +1735,36 @@ "#io means the computation has side effects, and will be wrapped by the IO type." "These options must show up in the following order [#io #try #?] (although, each option can be used independently)." (import: java/lang/String - (new [[byte]]) - (#static valueOf [char] java/lang/String) - (#static valueOf #as int_valueOf [int] java/lang/String)) + ["#::." + (new [[byte]]) + (#static valueOf [char] java/lang/String) + (#static valueOf #as int_valueOf [int] java/lang/String)]) (import: (java/util/List e) - (size [] int) - (get [int] e)) + ["#::." + (size [] int) + (get [int] e)]) (import: (java/util/ArrayList a) - ([T] toArray [[T]] [T])) + ["#::." + ([T] toArray [[T]] [T])]) "The class-type that is generated is of the fully-qualified name." "This avoids a clash between the java.util.List type, and Lux's own List type." "All enum options to be imported must be specified." (import: java/lang/Character$UnicodeScript - (#enum ARABIC CYRILLIC LATIN)) + ["#::." + (#enum ARABIC CYRILLIC LATIN)]) "It should also be noted, the only types that may show up in method arguments or return values may be Java classes, arrays, primitives, void or type-vars." "Lux types, such as Maybe cannot be named (otherwise, they'd be confused for Java classes)." (import: (lux/concurrency/promise/JvmPromise A) - (resolve [A] boolean) - (poll [] A) - (wasResolved [] boolean) - (waitOn [lux/Function] void) - (#static [A] make [A] (lux/concurrency/promise/JvmPromise A))) + ["#::." + (resolve [A] boolean) + (poll [] A) + (wasResolved [] boolean) + (waitOn [lux/Function] void) + (#static [A] make [A] (lux/concurrency/promise/JvmPromise A))]) "Also, the names of the imported members will look like Class::member" (java/lang/Object::new []) @@ -1757,7 +1774,11 @@ )} (do {! meta.monad} [kind (class_kind declaration) - =members (monad.map ! (member_import$ class_type_vars kind declaration) members)] + =members (|> bundles + (list\map (function (_ [import_format members]) + (list\map (|>> [import_format]) members))) + list.concat + (monad.map ! (member_import$ class_type_vars kind declaration)))] (wrap (list& (class_import$ declaration) (list\join =members))))) (syntax: #export (array {type (..type^ (list))} @@ -1790,95 +1811,95 @@ ["Lux Type" (%.type type)])) (with_expansions [<failure> (as_is (meta.fail (exception.construct ..cannot_convert_to_jvm_type [type])))] - (def: (lux_type->jvm_type type) - (-> .Type (Meta (Type Value))) - (if (lux_type\= Any type) - (\ meta.monad wrap $Object) - (case type - (#.Primitive name params) - (`` (cond (~~ (template [<type>] - [(text\= (..reflection <type>) name) - (case params - #.Nil - (\ meta.monad wrap <type>) - - _ - <failure>)] - - [type.boolean] - [type.byte] - [type.short] - [type.int] - [type.long] - [type.float] - [type.double] - [type.char])) - - (~~ (template [<type>] - [(text\= (..reflection (type.array <type>)) name) - (case params - #.Nil - (\ meta.monad wrap (type.array <type>)) - - _ - <failure>)] - - [type.boolean] - [type.byte] - [type.short] - [type.int] - [type.long] - [type.float] - [type.double] - [type.char])) - - (text\= array.type_name name) - (case params - (#.Cons elementLT #.Nil) - (\ meta.monad map type.array - (lux_type->jvm_type elementLT)) - - _ - <failure>) - - (text.starts_with? descriptor.array_prefix name) - (case params - #.Nil - (let [[_ unprefixed] (maybe.assume (text.split_with descriptor.array_prefix name))] - (\ meta.monad map type.array - (lux_type->jvm_type (#.Primitive unprefixed (list))))) - - _ - <failure>) - - ## else - (\ meta.monad map (type.class name) - (: (Meta (List (Type Parameter))) - (monad.map meta.monad - (function (_ paramLT) - (do meta.monad - [paramJT (lux_type->jvm_type paramLT)] - (case (parser.parameter? paramJT) - (#.Some paramJT) - (wrap paramJT) - - #.None - <failure>))) - params))))) - - (#.Apply A F) - (case (lux_type.apply (list A) F) - #.None - <failure> - - (#.Some type') - (lux_type->jvm_type type')) - - (#.Named _ type') - (lux_type->jvm_type type') - - _ - <failure>)))) + (def: (lux_type->jvm_type type) + (-> .Type (Meta (Type Value))) + (if (lux_type\= Any type) + (\ meta.monad wrap $Object) + (case type + (#.Primitive name params) + (`` (cond (~~ (template [<type>] + [(text\= (..reflection <type>) name) + (case params + #.Nil + (\ meta.monad wrap <type>) + + _ + <failure>)] + + [type.boolean] + [type.byte] + [type.short] + [type.int] + [type.long] + [type.float] + [type.double] + [type.char])) + + (~~ (template [<type>] + [(text\= (..reflection (type.array <type>)) name) + (case params + #.Nil + (\ meta.monad wrap (type.array <type>)) + + _ + <failure>)] + + [type.boolean] + [type.byte] + [type.short] + [type.int] + [type.long] + [type.float] + [type.double] + [type.char])) + + (text\= array.type_name name) + (case params + (#.Cons elementLT #.Nil) + (\ meta.monad map type.array + (lux_type->jvm_type elementLT)) + + _ + <failure>) + + (text.starts_with? descriptor.array_prefix name) + (case params + #.Nil + (let [[_ unprefixed] (maybe.assume (text.split_with descriptor.array_prefix name))] + (\ meta.monad map type.array + (lux_type->jvm_type (#.Primitive unprefixed (list))))) + + _ + <failure>) + + ## else + (\ meta.monad map (type.class name) + (: (Meta (List (Type Parameter))) + (monad.map meta.monad + (function (_ paramLT) + (do meta.monad + [paramJT (lux_type->jvm_type paramLT)] + (case (parser.parameter? paramJT) + (#.Some paramJT) + (wrap paramJT) + + #.None + <failure>))) + params))))) + + (#.Apply A F) + (case (lux_type.apply (list A) F) + #.None + <failure> + + (#.Some type') + (lux_type->jvm_type type')) + + (#.Named _ type') + (lux_type->jvm_type type') + + _ + <failure>)))) (syntax: #export (array_length array) {#.doc (doc "Gives the length of an array." @@ -1913,8 +1934,8 @@ _ (with_gensyms [g!array] - (wrap (list (` (let [(~ g!array) (~ array)] - (..array_length (~ g!array))))))))) + (wrap (list (` (let [(~ g!array) (~ array)] + (..array_length (~ g!array))))))))) (syntax: #export (array_read idx array) {#.doc (doc "Loads an element from an array." @@ -1951,8 +1972,8 @@ _ (with_gensyms [g!array] - (wrap (list (` (let [(~ g!array) (~ array)] - (..array_read (~ idx) (~ g!array))))))))) + (wrap (list (` (let [(~ g!array) (~ array)] + (..array_read (~ idx) (~ g!array))))))))) (syntax: #export (array_write idx value array) {#.doc (doc "Stores an element into an array." @@ -1990,8 +2011,8 @@ _ (with_gensyms [g!array] - (wrap (list (` (let [(~ g!array) (~ array)] - (..array_write (~ idx) (~ value) (~ g!array))))))))) + (wrap (list (` (let [(~ g!array) (~ array)] + (..array_write (~ idx) (~ value) (~ g!array))))))))) (syntax: #export (class_for {type (..type^ (list))}) {#.doc (doc "Loads the class as a java.lang.Class object." diff --git a/stdlib/source/lux/host.old.lux b/stdlib/source/lux/host.old.lux index 461a99a77..95e2cb1ed 100644 --- a/stdlib/source/lux/host.old.lux +++ b/stdlib/source/lux/host.old.lux @@ -1,5 +1,6 @@ (.module: [lux (#- type) + ["." type ("#\." equivalence)] [abstract ["." monad (#+ Monad do)] ["." enum]] @@ -13,13 +14,11 @@ ["." maybe] ["." product] ["." bit ("#\." codec)] - number ["." text ("#\." equivalence monoid) ["%" format (#+ format)]] [collection ["." array (#+ Array)] ["." list ("#\." monad fold monoid)]]] - ["." type ("#\." equivalence)] [macro ["." code] [syntax (#+ syntax:)]] @@ -1357,8 +1356,8 @@ (syntax: #export (do_to obj {methods (p.some partial_call^)}) {#.doc (doc "Call a variety of methods on an object. Then, return the object." (do_to object - (ClassName::method1 arg0 arg1 arg2) - (ClassName::method2 arg3 arg4 arg5)))} + (ClassName::method1 arg0 arg1 arg2) + (ClassName::method2 arg3 arg4 arg5)))} (with_gensyms [g!obj] (wrap (list (` (let [(~ g!obj) (~ obj)] (exec (~+ (list\map (complete_call$ g!obj) methods)) diff --git a/stdlib/source/lux/macro/code.lux b/stdlib/source/lux/macro/code.lux index f20bc1eab..b208522ce 100644 --- a/stdlib/source/lux/macro/code.lux +++ b/stdlib/source/lux/macro/code.lux @@ -6,14 +6,15 @@ ["." product] ["." bit] ["." name] + ["." text ("#\." monoid equivalence)] + [collection + ["." list ("#\." functor fold)]]] + [math [number ["." nat] ["." int] ["." rev] - ["." frac]] - ["." text ("#\." monoid equivalence)] - [collection - ["." list ("#\." functor fold)]]] + ["." frac]]] [meta ["." location]]]) diff --git a/stdlib/source/lux/macro/poly.lux b/stdlib/source/lux/macro/poly.lux index 1475bf2b4..a50493fc6 100644 --- a/stdlib/source/lux/macro/poly.lux +++ b/stdlib/source/lux/macro/poly.lux @@ -1,5 +1,7 @@ (.module: [lux #* + ["." meta (#+ with_gensyms)] + ["." type] [abstract ["." monad (#+ do)]] [control @@ -10,12 +12,9 @@ ["." product] ["." maybe] ["." text] - [number - ["n" nat]] [collection ["." list ("#\." fold functor)] ["." dictionary]]] - ["." meta (#+ with_gensyms)] [macro ["." code] [syntax (#+ syntax:) @@ -23,7 +22,9 @@ ["csr" reader] ["csw" writer] ["|.|" export]]]] - ["." type]]) + [math + [number + ["n" nat]]]]) (syntax: #export (poly: {export |export|.parser} {name s.local_identifier} diff --git a/stdlib/source/lux/macro/syntax.lux b/stdlib/source/lux/macro/syntax.lux index d5506100c..4dcbc725f 100644 --- a/stdlib/source/lux/macro/syntax.lux +++ b/stdlib/source/lux/macro/syntax.lux @@ -1,5 +1,6 @@ (.module: [lux #* + ["." meta (#+ with_gensyms)] [abstract ["." monad (#+ do)]] [control @@ -9,14 +10,14 @@ [data ["." maybe] ["." text ("#\." monoid)] + [collection + ["." list ("#\." functor)]]] + [math [number ["." nat] ["." int] ["." rev] - ["." frac]] - [collection - ["." list ("#\." functor)]]] - ["." meta (#+ with_gensyms)]] + ["." frac]]]] [// ["." code]]) diff --git a/stdlib/source/lux/macro/syntax/common.lux b/stdlib/source/lux/macro/syntax/common.lux index c29361ee4..aa805649b 100644 --- a/stdlib/source/lux/macro/syntax/common.lux +++ b/stdlib/source/lux/macro/syntax/common.lux @@ -2,10 +2,6 @@ "The goal is to be able to reuse common syntax in macro definitions across libraries.")} [lux #*]) -(type: #export Declaration - {#declaration_name Text - #declaration_args (List Text)}) - (type: #export Annotations (List [Name Code])) diff --git a/stdlib/source/lux/macro/syntax/common/declaration.lux b/stdlib/source/lux/macro/syntax/common/declaration.lux new file mode 100644 index 000000000..9a72a8a0c --- /dev/null +++ b/stdlib/source/lux/macro/syntax/common/declaration.lux @@ -0,0 +1,46 @@ +(.module: + [lux #* + [abstract + [equivalence (#+ Equivalence)]] + [control + ["<>" parser ("#\." monad) + ["<.>" code (#+ Parser)]]] + [data + ["." product] + ["." text] + [collection + ["." list ("#\." functor)]]] + [macro + ["." code]]]) + +(type: #export Declaration + {#name Text + #arguments (List Text)}) + +(def: #export equivalence + (Equivalence Declaration) + ($_ product.equivalence + text.equivalence + (list.equivalence text.equivalence) + )) + +(def: #export parser + {#.doc (doc "A parser for declaration syntax." + "Such as:" + quux + (foo bar baz))} + (Parser Declaration) + (<>.either (<>.and <code>.local_identifier + (<>\wrap (list))) + (<code>.form (<>.and <code>.local_identifier + (<>.some <code>.local_identifier))))) + +(def: #export (write value) + (-> Declaration Code) + (let [g!name (code.local_identifier (get@ #name value))] + (case (get@ #arguments value) + #.Nil + g!name + + arguments + (` ((~ g!name) (~+ (list\map code.local_identifier arguments))))))) diff --git a/stdlib/source/lux/macro/syntax/common/reader.lux b/stdlib/source/lux/macro/syntax/common/reader.lux index 98e1165a5..5a683ed3c 100644 --- a/stdlib/source/lux/macro/syntax/common/reader.lux +++ b/stdlib/source/lux/macro/syntax/common/reader.lux @@ -14,17 +14,6 @@ ["." meta]] ["." //]) -(def: #export declaration - {#.doc (doc "A reader for declaration syntax." - "Such as:" - quux - (foo bar baz))} - (Parser //.Declaration) - (p.either (p.and s.local_identifier - (p\wrap (list))) - (s.form (p.and s.local_identifier - (p.some s.local_identifier))))) - (def: #export annotations {#.doc "Reader for the common annotations syntax used by def: statements."} (Parser //.Annotations) diff --git a/stdlib/source/lux/macro/syntax/common/writer.lux b/stdlib/source/lux/macro/syntax/common/writer.lux index 9e946e139..22a4400c2 100644 --- a/stdlib/source/lux/macro/syntax/common/writer.lux +++ b/stdlib/source/lux/macro/syntax/common/writer.lux @@ -11,12 +11,6 @@ ["." code]]] ["." //]) -(def: #export (declaration declaration) - (-> //.Declaration Code) - (` ((~ (code.local_identifier (get@ #//.declaration_name declaration))) - (~+ (list\map code.local_identifier - (get@ #//.declaration_args declaration)))))) - (def: #export annotations (-> //.Annotations Code) (|>> (list\map (product.both code.tag function.identity)) diff --git a/stdlib/source/lux/macro/template.lux b/stdlib/source/lux/macro/template.lux index c250a3456..0e50c5d50 100644 --- a/stdlib/source/lux/macro/template.lux +++ b/stdlib/source/lux/macro/template.lux @@ -1,5 +1,6 @@ (.module: [lux #* + ["." meta] [abstract ["." monad (#+ do)]] [control @@ -8,14 +9,14 @@ [data ["." bit ("#\." codec)] ["." text] + [collection + ["." list ("#\." monad)]]] + [math [number ["." nat ("#\." decimal)] ["." int ("#\." decimal)] ["." rev ("#\." decimal)] - ["." frac ("#\." decimal)]] - [collection - ["." list ("#\." monad)]]] - ["." meta]] + ["." frac ("#\." decimal)]]]] [// [syntax (#+ syntax:)] ["." code]]) diff --git a/stdlib/source/lux/math.lux b/stdlib/source/lux/math.lux index fac508ca5..6c52b62fd 100644 --- a/stdlib/source/lux/math.lux +++ b/stdlib/source/lux/math.lux @@ -1,7 +1,7 @@ (.module: {#.doc "Common mathematical constants and functions."} [lux #* ["@" target] - [data + [math [number ["n" nat] ["i" int]]]]) diff --git a/stdlib/source/lux/math/infix.lux b/stdlib/source/lux/math/infix.lux index bd8629525..674544ae8 100644 --- a/stdlib/source/lux/math/infix.lux +++ b/stdlib/source/lux/math/infix.lux @@ -7,14 +7,15 @@ ["<.>" code (#+ Parser)]]] [data ["." product] - [number - ["n" nat] - ["i" int]] [collection ["." list ("#\." fold)]]] [macro [syntax (#+ syntax:)] - ["." code]]]) + ["." code]] + [math + [number + ["n" nat] + ["i" int]]]]) (type: #rec Infix (#Const Code) diff --git a/stdlib/source/lux/math/logic/continuous.lux b/stdlib/source/lux/math/logic/continuous.lux index 8fe207c65..5d5c8668d 100644 --- a/stdlib/source/lux/math/logic/continuous.lux +++ b/stdlib/source/lux/math/logic/continuous.lux @@ -1,19 +1,27 @@ (.module: [lux (#- false true or and not) - [data + [abstract + [monoid (#+ Monoid)]] + [math [number ["r" rev ("#\." interval)]]]]) -(def: #export true Rev r\top) (def: #export false Rev r\bottom) +(def: #export true Rev r\top) -(template [<name> <chooser>] +(template [<name> <chooser> <monoid> <identity>] [(def: #export <name> (-> Rev Rev Rev) - <chooser>)] + <chooser>) + + (structure: #export <monoid> + (Monoid Rev) - [and r.min] - [or r.max] + (def: identity <identity>) + (def: compose <name>))] + + [or r.max disjunction ..false] + [and r.min conjunction ..true] ) (def: #export (not input) @@ -25,16 +33,6 @@ (or (not antecedent) consequent)) -(def: #export (includes sub super) - (-> Rev Rev Rev) - (let [-sub (not sub) - sum (r.+ -sub super) - no-overflow? (.and (r.>= -sub sum) - (r.>= super sum))] - (if no-overflow? - sum - ..true))) - (def: #export (= left right) (-> Rev Rev Rev) (and (or (not left) right) diff --git a/stdlib/source/lux/math/logic/fuzzy.lux b/stdlib/source/lux/math/logic/fuzzy.lux index 780fe9898..617cd8929 100644 --- a/stdlib/source/lux/math/logic/fuzzy.lux +++ b/stdlib/source/lux/math/logic/fuzzy.lux @@ -3,11 +3,12 @@ [abstract [predicate (#+ Predicate)]] [data - [number - ["r" rev]] [collection ["." list] - ["." set (#+ Set)]]]] + ["." set (#+ Set)]]] + [math + [number + ["r" rev]]]] [// ["&" continuous]]) diff --git a/stdlib/source/lux/math/modular.lux b/stdlib/source/lux/math/modular.lux index 755693576..088201e94 100644 --- a/stdlib/source/lux/math/modular.lux +++ b/stdlib/source/lux/math/modular.lux @@ -14,14 +14,15 @@ ["<.>" code]]] [data ["." product] - ["." text ("#\." monoid)] + ["." text ("#\." monoid)]] + [macro + [syntax (#+ syntax:)] + ["." code]] + [math [number ["i" int ("#\." decimal)]]] [type - abstract] - [macro - [syntax (#+ syntax:)] - ["." code]]] + abstract]] ["." // #_ ["#" modulus (#+ Modulus)]]) diff --git a/stdlib/source/lux/math/modulus.lux b/stdlib/source/lux/math/modulus.lux index 6b38d96ff..00949f6ce 100644 --- a/stdlib/source/lux/math/modulus.lux +++ b/stdlib/source/lux/math/modulus.lux @@ -1,5 +1,6 @@ (.module: [lux #* + ["." meta] [abstract [monad (#+ do)]] [control @@ -7,15 +8,14 @@ ["." exception (#+ exception:)] [parser ["<.>" code]]] - [data + [macro + [syntax (#+ syntax:)] + ["." code]] + [math [number ["i" int]]] [type - abstract] - ["." meta] - [macro - [syntax (#+ syntax:)] - ["." code]]]) + abstract]]) (exception: #export zero_cannot_be_a_modulus) diff --git a/stdlib/source/lux/data/number.lux b/stdlib/source/lux/math/number.lux index dd7dba194..dd7dba194 100644 --- a/stdlib/source/lux/data/number.lux +++ b/stdlib/source/lux/math/number.lux diff --git a/stdlib/source/lux/data/number/complex.lux b/stdlib/source/lux/math/number/complex.lux index 500b9870a..d1a2957f0 100644 --- a/stdlib/source/lux/data/number/complex.lux +++ b/stdlib/source/lux/math/number/complex.lux @@ -10,15 +10,16 @@ ["<.>" code (#+ Parser)]]] [data ["." maybe] - [number - ["n" nat] - ["f" frac] - ["." int]] [collection ["." list ("#\." functor)]]] [macro [syntax (#+ syntax:)] - ["." code]]]) + ["." code]] + [math + [number + ["n" nat] + ["f" frac] + ["." int]]]]) (type: #export Complex {#real Frac diff --git a/stdlib/source/lux/data/number/frac.lux b/stdlib/source/lux/math/number/frac.lux index 3e1fadc2e..3e1fadc2e 100644 --- a/stdlib/source/lux/data/number/frac.lux +++ b/stdlib/source/lux/math/number/frac.lux diff --git a/stdlib/source/lux/data/number/i16.lux b/stdlib/source/lux/math/number/i16.lux index 9168b5925..9168b5925 100644 --- a/stdlib/source/lux/data/number/i16.lux +++ b/stdlib/source/lux/math/number/i16.lux diff --git a/stdlib/source/lux/data/number/i32.lux b/stdlib/source/lux/math/number/i32.lux index 3a1811b81..3a1811b81 100644 --- a/stdlib/source/lux/data/number/i32.lux +++ b/stdlib/source/lux/math/number/i32.lux diff --git a/stdlib/source/lux/data/number/i64.lux b/stdlib/source/lux/math/number/i64.lux index 71bb8ef2b..b25015bf9 100644 --- a/stdlib/source/lux/data/number/i64.lux +++ b/stdlib/source/lux/math/number/i64.lux @@ -5,10 +5,9 @@ [hash (#+ Hash)] [monoid (#+ Monoid)]] [control - ["." try]] - [data - [number - ["n" nat]]]]) + ["." try]]] + [// + ["n" nat]]) (def: #export bits_per_byte 8) diff --git a/stdlib/source/lux/data/number/i8.lux b/stdlib/source/lux/math/number/i8.lux index bea35ff22..bea35ff22 100644 --- a/stdlib/source/lux/data/number/i8.lux +++ b/stdlib/source/lux/math/number/i8.lux diff --git a/stdlib/source/lux/data/number/int.lux b/stdlib/source/lux/math/number/int.lux index e5b753725..ec4df8389 100644 --- a/stdlib/source/lux/data/number/int.lux +++ b/stdlib/source/lux/math/number/int.lux @@ -104,6 +104,7 @@ ## else +1)) +## https://rob.conery.io/2018/08/21/mod-and-remainder-are-not-the-same/ (def: #export (mod divisor dividend) (All [m] (-> Int Int Int)) (let [remainder (..% divisor dividend)] diff --git a/stdlib/source/lux/data/number/nat.lux b/stdlib/source/lux/math/number/nat.lux index 267846c89..267846c89 100644 --- a/stdlib/source/lux/data/number/nat.lux +++ b/stdlib/source/lux/math/number/nat.lux diff --git a/stdlib/source/lux/data/number/ratio.lux b/stdlib/source/lux/math/number/ratio.lux index 943e10a87..d754f6df4 100644 --- a/stdlib/source/lux/data/number/ratio.lux +++ b/stdlib/source/lux/math/number/ratio.lux @@ -15,13 +15,12 @@ [data ["." product] ["." maybe] - [number - ["n" nat ("#\." decimal)]] ["." text ("#\." monoid)]] - ["." math] [macro - ["." code] - [syntax (#+ syntax:)]]]) + [syntax (#+ syntax:)] + ["." code]]] + [// + ["n" nat ("#\." decimal)]]) (type: #export Ratio {#numerator Nat diff --git a/stdlib/source/lux/data/number/rev.lux b/stdlib/source/lux/math/number/rev.lux index 36436bf99..36436bf99 100644 --- a/stdlib/source/lux/data/number/rev.lux +++ b/stdlib/source/lux/math/number/rev.lux diff --git a/stdlib/source/lux/math/random.lux b/stdlib/source/lux/math/random.lux index 389ba9690..0f16553de 100644 --- a/stdlib/source/lux/math/random.lux +++ b/stdlib/source/lux/math/random.lux @@ -8,13 +8,6 @@ [data ["." product] ["." maybe] - [number (#+ hex) - ["." i64] - ["n" nat] - ["i" int] - ["r" ratio] - ["c" complex] - ["f" frac]] ["." text (#+ Char) ("#\." monoid) ["." unicode #_ ["#" set]]] @@ -28,6 +21,14 @@ ["." row (#+ Row)] [tree ["." finger (#+ Tree)]]]] + [math + [number (#+ hex) + ["n" nat] + ["i" int] + ["r" ratio] + ["c" complex] + ["f" frac] + ["." i64]]] [time ["." instant (#+ Instant)] ["." date (#+ Date)] diff --git a/stdlib/source/lux/meta.lux b/stdlib/source/lux/meta.lux index 95f64650d..8a7ae3b59 100644 --- a/stdlib/source/lux/meta.lux +++ b/stdlib/source/lux/meta.lux @@ -11,13 +11,14 @@ ["." maybe] ["." text ("#\." monoid equivalence)] ["." name ("#\." codec equivalence)] - [number - ["n" nat] - ["i" int]] [collection ["." list ("#\." monoid monad)]]] [macro - ["." code]]] + ["." code]] + [math + [number + ["n" nat] + ["i" int]]]] [/ ["." location]]) @@ -117,12 +118,17 @@ (#try.Success [compiler []]) (#try.Failure message)))) -(def: #export (fail msg) - {#.doc "Fails with the given message."} +(def: (with_location location error) + (-> Location Text Text) + ($_ text\compose (location.format location) text.new_line + error)) + +(def: #export (fail error) + {#.doc "Fails with the given error message."} (All [a] (-> Text (Meta a))) - (function (_ _) - (#try.Failure msg))) + (function (_ state) + (#try.Failure (..with_location (get@ #.location state) error)))) (def: #export (find_module name) (-> Text (Meta Module)) diff --git a/stdlib/source/lux/target/js.lux b/stdlib/source/lux/target/js.lux index ae3591668..89f3ed25a 100644 --- a/stdlib/source/lux/target/js.lux +++ b/stdlib/source/lux/target/js.lux @@ -3,15 +3,16 @@ [control [pipe (#+ case>)]] [data - [number - ["i" int] - ["f" frac]] ["." text ["%" format (#+ format)]] [collection ["." list ("#\." functor fold)]]] [macro ["." template]] + [math + [number + ["i" int] + ["f" frac]]] [type abstract]]) diff --git a/stdlib/source/lux/target/jvm/attribute.lux b/stdlib/source/lux/target/jvm/attribute.lux index 0f5c9ddc7..0b8457a9c 100644 --- a/stdlib/source/lux/target/jvm/attribute.lux +++ b/stdlib/source/lux/target/jvm/attribute.lux @@ -9,10 +9,11 @@ [data ["." sum] ["." product] - [number - ["n" nat]] [format - [".F" binary (#+ Writer)]]]] + [".F" binary (#+ Writer)]]] + [math + [number + ["n" nat]]]] ["." // #_ ["#." index (#+ Index)] [encoding diff --git a/stdlib/source/lux/target/jvm/attribute/code.lux b/stdlib/source/lux/target/jvm/attribute/code.lux index 328214859..212d44765 100644 --- a/stdlib/source/lux/target/jvm/attribute/code.lux +++ b/stdlib/source/lux/target/jvm/attribute/code.lux @@ -6,12 +6,13 @@ [data ["." product] ["." binary (#+ Binary)] - [number - ["n" nat]] [format [".F" binary (#+ Writer) ("#\." monoid)]] [collection - ["." row (#+ Row) ("#\." functor fold)]]]] + ["." row (#+ Row) ("#\." functor fold)]]] + [math + [number + ["n" nat]]]] ["." /// #_ [bytecode [environment diff --git a/stdlib/source/lux/target/jvm/attribute/code/exception.lux b/stdlib/source/lux/target/jvm/attribute/code/exception.lux index 0e9082167..9ae264438 100644 --- a/stdlib/source/lux/target/jvm/attribute/code/exception.lux +++ b/stdlib/source/lux/target/jvm/attribute/code/exception.lux @@ -4,10 +4,11 @@ [equivalence (#+ Equivalence)]] [data ["." product] - [number - ["n" nat]] ["." format #_ - ["#" binary (#+ Writer)]]]] + ["#" binary (#+ Writer)]]] + [math + [number + ["n" nat]]]] ["." // #_ ["//#" /// #_ [constant (#+ Class)] diff --git a/stdlib/source/lux/target/jvm/bytecode.lux b/stdlib/source/lux/target/jvm/bytecode.lux index 700f3b27e..6e24b790a 100644 --- a/stdlib/source/lux/target/jvm/bytecode.lux +++ b/stdlib/source/lux/target/jvm/bytecode.lux @@ -15,16 +15,17 @@ ["." maybe] [text ["%" format (#+ format)]] - [number - ["n" nat] - ["i" int] - ["." i32 (#+ I32)]] [collection ["." list ("#\." functor fold)] ["." dictionary (#+ Dictionary)] ["." row (#+ Row)]]] [macro - ["." template]]] + ["." template]] + [math + [number + ["n" nat] + ["i" int] + ["." i32 (#+ I32)]]]] ["." / #_ ["#." address (#+ Address)] ["#." jump (#+ Jump Big_Jump)] diff --git a/stdlib/source/lux/target/jvm/bytecode/address.lux b/stdlib/source/lux/target/jvm/bytecode/address.lux index 6a16ab5cd..b434403f1 100644 --- a/stdlib/source/lux/target/jvm/bytecode/address.lux +++ b/stdlib/source/lux/target/jvm/bytecode/address.lux @@ -8,10 +8,11 @@ [data [format [binary (#+ Writer)]] - [number - ["n" nat]] [text ["%" format (#+ Format)]]] + [math + [number + ["n" nat]]] [type abstract]] ["." // #_ diff --git a/stdlib/source/lux/target/jvm/bytecode/environment/limit.lux b/stdlib/source/lux/target/jvm/bytecode/environment/limit.lux index fc65ac6db..7c277d4c6 100644 --- a/stdlib/source/lux/target/jvm/bytecode/environment/limit.lux +++ b/stdlib/source/lux/target/jvm/bytecode/environment/limit.lux @@ -7,10 +7,11 @@ ["." try (#+ Try)]] [data ["." product] - [number - ["n" nat]] ["." format #_ - ["#" binary (#+ Writer) ("#\." monoid)]]]] + ["#" binary (#+ Writer) ("#\." monoid)]]] + [math + [number + ["n" nat]]]] ["." / #_ ["#." stack (#+ Stack)] ["#." registry (#+ Registry)] diff --git a/stdlib/source/lux/target/jvm/bytecode/environment/limit/registry.lux b/stdlib/source/lux/target/jvm/bytecode/environment/limit/registry.lux index 802b99320..9165dfacb 100644 --- a/stdlib/source/lux/target/jvm/bytecode/environment/limit/registry.lux +++ b/stdlib/source/lux/target/jvm/bytecode/environment/limit/registry.lux @@ -5,12 +5,13 @@ [control ["." try (#+ Try) ("#\." functor)]] [data - [number - ["n" nat]] [format [binary (#+ Writer)]] [collection ["." list ("#\." functor fold)]]] + [math + [number + ["n" nat]]] [type abstract]] ["." ///// #_ diff --git a/stdlib/source/lux/target/jvm/bytecode/instruction.lux b/stdlib/source/lux/target/jvm/bytecode/instruction.lux index 91bba4ec3..218d14dab 100644 --- a/stdlib/source/lux/target/jvm/bytecode/instruction.lux +++ b/stdlib/source/lux/target/jvm/bytecode/instruction.lux @@ -9,14 +9,15 @@ [data ["." product] ["." binary] - [number (#+ hex) - ["n" nat]] ["." format #_ ["#" binary (#+ Mutation Specification)]] [collection ["." list]]] [macro ["." template]] + [math + [number (#+ hex) + ["n" nat]]] [type abstract]] ["." // #_ diff --git a/stdlib/source/lux/target/jvm/constant.lux b/stdlib/source/lux/target/jvm/constant.lux index 6b953e008..fbfbfebb3 100644 --- a/stdlib/source/lux/target/jvm/constant.lux +++ b/stdlib/source/lux/target/jvm/constant.lux @@ -8,20 +8,21 @@ [data ["." sum] ["." product] - [number - ["." i32 (#+ I32)] - ["." i64] - ["." int] - ["." frac]] ["." text] [format [".F" binary (#+ Writer) ("#\." monoid)]] [collection ["." row (#+ Row)]]] - [type - abstract] [macro - ["." template]]] + ["." template]] + [math + [number + ["." i32 (#+ I32)] + ["." i64] + ["." int] + ["." frac]]] + [type + abstract]] ["." / #_ ["#." tag] ["/#" // #_ diff --git a/stdlib/source/lux/target/jvm/constant/pool.lux b/stdlib/source/lux/target/jvm/constant/pool.lux index 700c6ee85..95dac3986 100644 --- a/stdlib/source/lux/target/jvm/constant/pool.lux +++ b/stdlib/source/lux/target/jvm/constant/pool.lux @@ -9,20 +9,21 @@ ["." try (#+ Try)]] [data ["." product] - [number - ["." i32] - ["n" nat] - ["." int] - ["." frac]] ["." text] ["." format #_ ["#" binary (#+ Writer) ("specification\." monoid)]] [collection ["." row (#+ Row) ("#\." fold)]]] - [type - abstract] [macro - ["." template]]] + ["." template]] + [math + [number + ["." i32] + ["n" nat] + ["." int] + ["." frac]]] + [type + abstract]] ["." // (#+ UTF8 String Class Integer Float Long Double Constant Name_And_Type Reference) [// [encoding diff --git a/stdlib/source/lux/target/jvm/encoding/signed.lux b/stdlib/source/lux/target/jvm/encoding/signed.lux index 1cc3fe07f..671cbb17d 100644 --- a/stdlib/source/lux/target/jvm/encoding/signed.lux +++ b/stdlib/source/lux/target/jvm/encoding/signed.lux @@ -7,16 +7,17 @@ ["." try (#+ Try)] ["." exception (#+ exception:)]] [data - [number - ["." i64] - ["n" nat] - ["i" int]] [text ["%" format (#+ format)]] ["." format #_ ["#" binary (#+ Writer)]]] [macro ["." template]] + [math + [number + ["." i64] + ["n" nat] + ["i" int]]] [type abstract]]) diff --git a/stdlib/source/lux/target/jvm/encoding/unsigned.lux b/stdlib/source/lux/target/jvm/encoding/unsigned.lux index c145dcdab..1c2edd25a 100644 --- a/stdlib/source/lux/target/jvm/encoding/unsigned.lux +++ b/stdlib/source/lux/target/jvm/encoding/unsigned.lux @@ -7,15 +7,16 @@ ["." try (#+ Try)] ["." exception (#+ exception:)]] [data - [number - ["." i64] - ["n" nat]] [text ["%" format (#+ format)]] ["." format #_ ["#" binary (#+ Writer)]]] [macro ["." template]] + [math + [number + ["n" nat] + ["." i64]]] [type abstract]]) diff --git a/stdlib/source/lux/target/jvm/loader.lux b/stdlib/source/lux/target/jvm/loader.lux index acda83ca9..a6a236e47 100644 --- a/stdlib/source/lux/target/jvm/loader.lux +++ b/stdlib/source/lux/target/jvm/loader.lux @@ -76,7 +76,7 @@ (do_to (java/lang/Class::getDeclaredMethod "defineClass" signature (host.class_for java/lang/ClassLoader)) - (java/lang/reflect/AccessibleObject::setAccessible true))))) + (java/lang/reflect/AccessibleObject::setAccessible true))))) (def: #export (define class_name bytecode loader) (-> Text Binary java/lang/ClassLoader (Try java/lang/Object)) diff --git a/stdlib/source/lux/target/jvm/magic.lux b/stdlib/source/lux/target/jvm/magic.lux index 408de3d84..370d8e09b 100644 --- a/stdlib/source/lux/target/jvm/magic.lux +++ b/stdlib/source/lux/target/jvm/magic.lux @@ -2,7 +2,7 @@ [lux #* [control ["." try]] - [data + [math [number (#+ hex)]]] ["." // #_ [encoding diff --git a/stdlib/source/lux/target/jvm/modifier.lux b/stdlib/source/lux/target/jvm/modifier.lux index 6037ab372..6f74aadbd 100644 --- a/stdlib/source/lux/target/jvm/modifier.lux +++ b/stdlib/source/lux/target/jvm/modifier.lux @@ -1,5 +1,6 @@ (.module: [lux #* + [meta (#+ with_gensyms)] [abstract ["." equivalence (#+ Equivalence)] ["." monoid (#+ Monoid)]] @@ -8,16 +9,16 @@ ["<>" parser ["<c>" code]]] [data - ["." number (#+ hex) - ["." i64]] [format [".F" binary (#+ Writer)]]] - [type - abstract] - [meta (#+ with_gensyms)] [macro [syntax (#+ syntax:)] - ["." code]]] + ["." code]] + [math + ["." number (#+ hex) + ["." i64]]] + [type + abstract]] ["." // #_ [encoding ["#." unsigned]]]) diff --git a/stdlib/source/lux/target/jvm/reflection.lux b/stdlib/source/lux/target/jvm/reflection.lux index 4dfdbc30c..040c277b8 100644 --- a/stdlib/source/lux/target/jvm/reflection.lux +++ b/stdlib/source/lux/target/jvm/reflection.lux @@ -102,18 +102,18 @@ (getConstructors [] [(java/lang/reflect/Constructor java/lang/Object)]) (getDeclaredMethods [] [java/lang/reflect/Method])]) -(exception: #export (unknown-class {class External}) +(exception: #export (unknown_class {class External}) (exception.report ["Class" (%.text class)])) (template [<name>] - [(exception: #export (<name> {jvm-type java/lang/reflect/Type}) + [(exception: #export (<name> {jvm_type java/lang/reflect/Type}) (exception.report - ["Type" (java/lang/reflect/Type::getTypeName jvm-type)] - ["Class" (|> jvm-type java/lang/Object::getClass java/lang/Object::toString)]))] + ["Type" (java/lang/reflect/Type::getTypeName jvm_type)] + ["Class" (|> jvm_type java/lang/Object::getClass java/lang/Object::toString)]))] - [not-a-class] - [cannot-convert-to-a-lux-type] + [not_a_class] + [cannot_convert_to_a_lux_type] ) (def: #export (load name) @@ -123,7 +123,7 @@ (#try.Success class) (#try.Failure _) - (exception.throw ..unknown-class name))) + (exception.throw ..unknown_class name))) (def: #export (sub? super sub) (-> External External (Try Bit)) @@ -138,12 +138,12 @@ (Try (/.Type Class))) (<| (case (host.check java/lang/Class reflection) (#.Some class) - (let [class-name (|> class + (let [class_name (|> class (:coerce (java/lang/Class java/lang/Object)) java/lang/Class::getName)] (`` (if (or (~~ (template [<reflection>] [(text\= (/reflection.reflection <reflection>) - class-name)] + class_name)] [/reflection.boolean] [/reflection.byte] @@ -153,9 +153,9 @@ [/reflection.float] [/reflection.double] [/reflection.char])) - (text.starts-with? /descriptor.array-prefix class-name)) - (exception.throw ..not-a-class reflection) - (#try.Success (/.class class-name (list)))))) + (text.starts_with? /descriptor.array_prefix class_name)) + (exception.throw ..not_a_class reflection) + (#try.Success (/.class class_name (list)))))) _) (case (host.check java/lang/reflect/ParameterizedType reflection) (#.Some reflection) @@ -165,7 +165,7 @@ (do {! try.monad} [paramsT (|> reflection java/lang/reflect/ParameterizedType::getActualTypeArguments - array.to-list + array.to_list (monad.map ! parameter))] (wrap (/.class (|> raw (:coerce (java/lang/Class java/lang/Object)) @@ -173,10 +173,10 @@ paramsT))) _ - (exception.throw ..not-a-class raw))) + (exception.throw ..not_a_class raw))) _) ## else - (exception.throw ..cannot-convert-to-a-lux-type reflection))) + (exception.throw ..cannot_convert_to_a_lux_type reflection))) (def: #export (parameter reflection) (-> java/lang/reflect/Type (Try (/.Type Parameter))) @@ -217,12 +217,12 @@ (-> java/lang/reflect/Type (Try (/.Type Value))) (<| (case (host.check java/lang/Class reflection) (#.Some reflection) - (let [class-name (|> reflection + (let [class_name (|> reflection (:coerce (java/lang/Class java/lang/Object)) java/lang/Class::getName)] (`` (cond (~~ (template [<reflection> <type>] [(text\= (/reflection.reflection <reflection>) - class-name) + class_name) (#try.Success <type>)] [/reflection.boolean /.boolean] @@ -233,9 +233,9 @@ [/reflection.float /.float] [/reflection.double /.double] [/reflection.char /.char])) - (if (text.starts-with? /descriptor.array-prefix class-name) - (<t>.run /parser.value (|> class-name //name.internal //name.read)) - (#try.Success (/.class class-name (list))))))) + (if (text.starts_with? /descriptor.array_prefix class_name) + (<t>.run /parser.value (|> class_name //name.internal //name.read)) + (#try.Success (/.class class_name (list))))))) _) (case (host.check java/lang/reflect/GenericArrayType reflection) (#.Some reflection) @@ -249,27 +249,27 @@ (def: #export (return reflection) (-> java/lang/reflect/Type (Try (/.Type Return))) - (with-expansions [<else> (as-is (..type reflection))] + (with_expansions [<else> (as_is (..type reflection))] (case (host.check java/lang/Class reflection) (#.Some class) - (let [class-name (|> reflection + (let [class_name (|> reflection (:coerce (java/lang/Class java/lang/Object)) java/lang/Class::getName)] (if (text\= (/reflection.reflection /reflection.void) - class-name) + class_name) (#try.Success /.void) <else>)) #.None <else>))) -(exception: #export (cannot-correspond {class (java/lang/Class java/lang/Object)} +(exception: #export (cannot_correspond {class (java/lang/Class java/lang/Object)} {type Type}) (exception.report ["Class" (java/lang/Object::toString class)] ["Type" (%.type type)])) -(exception: #export (type-parameter-mismatch {expected Nat} +(exception: #export (type_parameter_mismatch {expected Nat} {actual Nat} {class (java/lang/Class java/lang/Object)} {type Type}) @@ -279,7 +279,7 @@ ["Class" (java/lang/Object::toString class)] ["Type" (%.type type)])) -(exception: #export (non-jvm-type {type Type}) +(exception: #export (non_jvm_type {type Type}) (exception.report ["Type" (%.type type)])) @@ -287,21 +287,21 @@ (-> (java/lang/Class java/lang/Object) Type (Try Mapping)) (case type (#.Primitive name params) - (let [class-name (java/lang/Class::getName class) - class-params (array.to-list (java/lang/Class::getTypeParameters class)) - num-class-params (list.size class-params) - num-type-params (list.size params)] - (if (text\= class-name name) - (if (n.= num-class-params num-type-params) + (let [class_name (java/lang/Class::getName class) + class_params (array.to_list (java/lang/Class::getTypeParameters class)) + num_class_params (list.size class_params) + num_type_params (list.size params)] + (if (text\= class_name name) + (if (n.= num_class_params num_type_params) (|> params (list.zip/2 (list\map (|>> java/lang/reflect/TypeVariable::getName) - class-params)) + class_params)) (list\fold (function (_ [name paramT] mapping) (dictionary.put name paramT mapping)) /lux.fresh) #try.Success) - (exception.throw ..type-parameter-mismatch [num-class-params num-type-params class type])) - (exception.throw ..cannot-correspond [class type]))) + (exception.throw ..type_parameter_mismatch [num_class_params num_type_params class type])) + (exception.throw ..cannot_correspond [class type]))) (#.Named name anonymousT) (correspond class anonymousT) @@ -312,12 +312,12 @@ (correspond class outputT) #.None - (exception.throw ..non-jvm-type [type])) + (exception.throw ..non_jvm_type [type])) _ - (exception.throw ..non-jvm-type [type]))) + (exception.throw ..non_jvm_type [type]))) -(exception: #export (mistaken-field-owner {field java/lang/reflect/Field} +(exception: #export (mistaken_field_owner {field java/lang/reflect/Field} {owner (java/lang/Class java/lang/Object)} {target (java/lang/Class java/lang/Object)}) (exception.report @@ -332,9 +332,9 @@ ["Field" (%.text field)] ["Class" (java/lang/Object::toString class)]))] - [unknown-field] - [not-a-static-field] - [not-a-virtual-field] + [unknown_field] + [not_a_static_field] + [not_a_virtual_field] ) (def: #export (field field target) @@ -344,10 +344,10 @@ (let [owner (java/lang/reflect/Field::getDeclaringClass field)] (if (is? owner target) (#try.Success field) - (exception.throw ..mistaken-field-owner [field owner target]))) + (exception.throw ..mistaken_field_owner [field owner target]))) (#try.Failure _) - (exception.throw ..unknown-field [field target]))) + (exception.throw ..unknown_field [field target]))) (template [<name> <exception> <then?> <else?>] [(def: #export (<name> field class) @@ -362,6 +362,6 @@ (\ ! map (|>> [(java/lang/reflect/Modifier::isFinal modifiers)]))) <else?> (exception.throw <exception> [field class]))))] - [static-field ..not-a-static-field #1 #0] - [virtual-field ..not-a-virtual-field #0 #1] + [static_field ..not_a_static_field #1 #0] + [virtual_field ..not_a_virtual_field #0 #1] ) diff --git a/stdlib/source/lux/target/jvm/type.lux b/stdlib/source/lux/target/jvm/type.lux index 17456f011..3db4a584f 100644 --- a/stdlib/source/lux/target/jvm/type.lux +++ b/stdlib/source/lux/target/jvm/type.lux @@ -7,10 +7,11 @@ ["." maybe] ["." text ["%" format (#+ Format)]] - [number - ["n" nat]] [collection ["." list ("#\." functor)]]] + [math + [number + ["n" nat]]] [type abstract]] ["." // #_ diff --git a/stdlib/source/lux/target/jvm/type/alias.lux b/stdlib/source/lux/target/jvm/type/alias.lux index 9439f7d64..e474250ca 100644 --- a/stdlib/source/lux/target/jvm/type/alias.lux +++ b/stdlib/source/lux/target/jvm/type/alias.lux @@ -42,14 +42,14 @@ (def: (class parameter) (-> (Parser (Type Parameter)) (Parser (Type Class))) (|> (do <>.monad - [name //parser.class-name + [name //parser.class_name parameters (|> (<>.some parameter) - (<>.after (<t>.this //signature.parameters-start)) - (<>.before (<t>.this //signature.parameters-end)) + (<>.after (<t>.this //signature.parameters_start)) + (<>.before (<t>.this //signature.parameters_end)) (<>.default (list)))] (wrap (//.class name parameters))) - (<>.after (<t>.this //descriptor.class-prefix)) - (<>.before (<t>.this //descriptor.class-suffix)))) + (<>.after (<t>.this //descriptor.class_prefix)) + (<>.before (<t>.this //descriptor.class_suffix)))) (template [<name> <prefix> <bound> <constructor>] [(def: <name> @@ -57,8 +57,8 @@ (|>> (<>.after (<t>.this <prefix>)) (\ <>.monad map <bound>)))] - [lower //signature.lower-prefix //.lower ..Lower] - [upper //signature.upper-prefix //.upper ..Upper] + [lower //signature.lower_prefix //.lower ..Lower] + [upper //signature.upper_prefix //.upper ..Upper] ) (def: (parameter aliasing) @@ -87,8 +87,8 @@ (def: (inputs aliasing) (-> Aliasing (Parser (List (Type Value)))) (|> (<>.some (..value aliasing)) - (<>.after (<t>.this //signature.arguments-start)) - (<>.before (<t>.this //signature.arguments-end)))) + (<>.after (<t>.this //signature.arguments_start)) + (<>.before (<t>.this //signature.arguments_end)))) (def: (return aliasing) (-> Aliasing (Parser (Type Return))) @@ -100,7 +100,7 @@ (def: (exception aliasing) (-> Aliasing (Parser (Type Class))) (|> (..class (..parameter aliasing)) - (<>.after (<t>.this //signature.exception-prefix)))) + (<>.after (<t>.this //signature.exception_prefix)))) (def: #export (method aliasing type) (-> Aliasing (Type Method) (Type Method)) diff --git a/stdlib/source/lux/target/jvm/type/descriptor.lux b/stdlib/source/lux/target/jvm/type/descriptor.lux index 949cf70ea..fd511e780 100644 --- a/stdlib/source/lux/target/jvm/type/descriptor.lux +++ b/stdlib/source/lux/target/jvm/type/descriptor.lux @@ -4,12 +4,13 @@ [equivalence (#+ Equivalence)]] [data ["." maybe] - [number - ["n" nat]] ["." text ("#\." equivalence) ["%" format (#+ format)]] [collection ["." list ("#\." functor)]]] + [math + [number + ["n" nat]]] [type abstract]] ["." // #_ diff --git a/stdlib/source/lux/target/jvm/type/lux.lux b/stdlib/source/lux/target/jvm/type/lux.lux index 44562bb1a..e42c54610 100644 --- a/stdlib/source/lux/target/jvm/type/lux.lux +++ b/stdlib/source/lux/target/jvm/type/lux.lux @@ -40,7 +40,7 @@ Mapping (dictionary.new text.hash)) -(exception: #export (unknown-var {var Text}) +(exception: #export (unknown_var {var Text}) (exception.report ["Var" (%.text var)])) @@ -90,7 +90,7 @@ [var //parser.var'] (wrap (case (dictionary.get var mapping) #.None - (check.throw ..unknown-var [var]) + (check.throw ..unknown_var [var]) (#.Some type) (check\wrap type))))) @@ -98,16 +98,16 @@ (def: (class' parameter) (-> (Parser (Check Type)) (Parser (Check Type))) (|> (do <>.monad - [name //parser.class-name + [name //parser.class_name parameters (|> (<>.some parameter) - (<>.after (<t>.this //signature.parameters-start)) - (<>.before (<t>.this //signature.parameters-end)) + (<>.after (<t>.this //signature.parameters_start)) + (<>.before (<t>.this //signature.parameters_end)) (<>.default (list)))] (wrap (do {! check.monad} [parameters (monad.seq ! parameters)] (wrap (#.Primitive name parameters))))) - (<>.after (<t>.this //descriptor.class-prefix)) - (<>.before (<t>.this //descriptor.class-suffix)))) + (<>.after (<t>.this //descriptor.class_prefix)) + (<>.before (<t>.this //descriptor.class_suffix)))) (template [<name> <prefix> <constructor>] [(def: <name> @@ -117,8 +117,8 @@ ## (<>\map (check\map (|>> <ctor> .type))) ))] - [lower //signature.lower-prefix ..Lower] - [upper //signature.upper-prefix ..Upper] + [lower //signature.lower_prefix ..Lower] + [upper //signature.upper_prefix ..Upper] ) (def: (parameter mapping) @@ -159,7 +159,7 @@ _ (|> elementT array.Array .type))))) - (<>.after (<t>.this //descriptor.array-prefix)))) + (<>.after (<t>.this //descriptor.array_prefix)))) (def: #export (type mapping) (-> Mapping (Parser (Check Type))) diff --git a/stdlib/source/lux/target/jvm/type/parser.lux b/stdlib/source/lux/target/jvm/type/parser.lux index 0013866f7..d54c1c504 100644 --- a/stdlib/source/lux/target/jvm/type/parser.lux +++ b/stdlib/source/lux/target/jvm/type/parser.lux @@ -59,7 +59,7 @@ (def: var/tail (format var/head - "0123456789")) + "0123456789$")) (def: class/head (format var/head //name.internal_separator)) diff --git a/stdlib/source/lux/test.lux b/stdlib/source/lux/test.lux index 972e41d0b..fb3e9a990 100644 --- a/stdlib/source/lux/test.lux +++ b/stdlib/source/lux/test.lux @@ -1,5 +1,6 @@ (.module: {#.doc "Tools for unit & property-based/generative testing."} [lux (#- and for) + ["." meta] [abstract ["." monad (#+ do)]] [control @@ -14,9 +15,6 @@ ["." maybe] ["." product] ["." name] - [number (#+ hex) - ["n" nat] - ["f" frac]] ["." text ["%" format (#+ format)]] [collection @@ -26,8 +24,10 @@ ["." instant] ["." duration (#+ Duration)]] [math - ["." random (#+ Random) ("#\." monad)]] - ["." meta] + ["." random (#+ Random) ("#\." monad)] + [number (#+ hex) + ["n" nat] + ["f" frac]]] [macro [syntax (#+ syntax:)] ["." code]] diff --git a/stdlib/source/lux/time.lux b/stdlib/source/lux/time.lux index 6b880316c..a1675dc17 100644 --- a/stdlib/source/lux/time.lux +++ b/stdlib/source/lux/time.lux @@ -12,7 +12,8 @@ ["<>" parser ["<t>" text (#+ Parser)]]] [data - ["." text ("#\." monoid)] + ["." text ("#\." monoid)]] + [math [number ["n" nat ("#\." decimal)]]] [type diff --git a/stdlib/source/lux/time/date.lux b/stdlib/source/lux/time/date.lux index 375c2a924..41e66d4a8 100644 --- a/stdlib/source/lux/time/date.lux +++ b/stdlib/source/lux/time/date.lux @@ -14,12 +14,13 @@ [data ["." maybe] ["." text ("#\." monoid)] - [number - ["n" nat ("#\." decimal)] - ["i" int]] [collection ["." list ("#\." fold)] ["." dictionary (#+ Dictionary)]]] + [math + [number + ["n" nat ("#\." decimal)] + ["i" int]]] [type abstract]] ["." // #_ diff --git a/stdlib/source/lux/time/day.lux b/stdlib/source/lux/time/day.lux index 3011e841c..6d9b7f4a5 100644 --- a/stdlib/source/lux/time/day.lux +++ b/stdlib/source/lux/time/day.lux @@ -4,7 +4,7 @@ [equivalence (#+ Equivalence)] [order (#+ Order)] [enum (#+ Enum)]] - [data + [math [number ["n" nat]]]]) diff --git a/stdlib/source/lux/time/duration.lux b/stdlib/source/lux/time/duration.lux index a973eea89..fbe116ee1 100644 --- a/stdlib/source/lux/time/duration.lux +++ b/stdlib/source/lux/time/duration.lux @@ -11,10 +11,11 @@ ["<>" parser ["<t>" text (#+ Parser)]]] [data - [number - ["." nat ("#\." decimal)] - ["i" int]] ["." text ("#\." monoid)]] + [math + [number + ["i" int] + ["." nat ("#\." decimal)]]] [type abstract]]) diff --git a/stdlib/source/lux/time/instant.lux b/stdlib/source/lux/time/instant.lux index 707dac89a..33cd2e5a4 100644 --- a/stdlib/source/lux/time/instant.lux +++ b/stdlib/source/lux/time/instant.lux @@ -14,11 +14,12 @@ ["<t>" text (#+ Parser)]]] [data ["." maybe] - [number - ["i" int]] ["." text ("#\." monoid)] [collection ["." row]]] + [math + [number + ["i" int]]] [type abstract]] ["." // (#+ Time) diff --git a/stdlib/source/lux/time/month.lux b/stdlib/source/lux/time/month.lux index dcfd3d1a2..ba0408e34 100644 --- a/stdlib/source/lux/time/month.lux +++ b/stdlib/source/lux/time/month.lux @@ -7,7 +7,7 @@ [control ["." try (#+ Try)] ["." exception (#+ exception:)]] - [data + [math [number ["n" nat]]]]) diff --git a/stdlib/source/lux/time/year.lux b/stdlib/source/lux/time/year.lux index 5994eaf35..a65d4eb01 100644 --- a/stdlib/source/lux/time/year.lux +++ b/stdlib/source/lux/time/year.lux @@ -11,7 +11,8 @@ ["<>" parser ["<t>" text (#+ Parser)]]] [data - ["." text ("#\." monoid)] + ["." text ("#\." monoid)]] + [math [number ["n" nat ("#\." decimal)] ["i" int ("#\." decimal)]]] diff --git a/stdlib/source/lux/tool/compiler.lux b/stdlib/source/lux/tool/compiler.lux index 867fb4012..c64f03ab5 100644 --- a/stdlib/source/lux/tool/compiler.lux +++ b/stdlib/source/lux/tool/compiler.lux @@ -44,6 +44,6 @@ (type: #export (Instancer s d o) (-> (Key d) (List Parameter) (Compiler s d o))) -(exception: #export (cannot-compile {module Module}) +(exception: #export (cannot_compile {module Module}) (exception.report ["Module" module])) diff --git a/stdlib/source/lux/tool/compiler/arity.lux b/stdlib/source/lux/tool/compiler/arity.lux index 84c2b8e9e..72140b6c6 100644 --- a/stdlib/source/lux/tool/compiler/arity.lux +++ b/stdlib/source/lux/tool/compiler/arity.lux @@ -1,6 +1,6 @@ (.module: [lux #* - [data + [math [number ["n" nat]]]]) diff --git a/stdlib/source/lux/tool/compiler/default/init.lux b/stdlib/source/lux/tool/compiler/default/init.lux index bc089eeaa..70f66d8bb 100644 --- a/stdlib/source/lux/tool/compiler/default/init.lux +++ b/stdlib/source/lux/tool/compiler/default/init.lux @@ -49,7 +49,7 @@ ["." artifact] ["." document]]]]]) -(def: #export (state target module expander host-analysis host generate generation-bundle host-directive-bundle program anchorT,expressionT,directiveT extender) +(def: #export (state target module expander host_analysis host generate generation_bundle host_directive_bundle program anchorT,expressionT,directiveT extender) (All [anchor expression directive] (-> Host Module @@ -62,28 +62,28 @@ (Program expression directive) [Type Type Type] Extender (///directive.State+ anchor expression directive))) - (let [synthesis-state [synthesisE.bundle ///synthesis.init] - generation-state [generation-bundle (///generation.state host module)] - eval (///analysis/evaluation.evaluator expander synthesis-state generation-state generate) - analysis-state [(analysisE.bundle eval host-analysis) + (let [synthesis_state [synthesisE.bundle ///synthesis.init] + generation_state [generation_bundle (///generation.state host module)] + eval (///analysis/evaluation.evaluator expander synthesis_state generation_state generate) + analysis_state [(analysisE.bundle eval host_analysis) (///analysis.state (///analysis.info ///version.version target))]] - [(dictionary.merge host-directive-bundle - (luxD.bundle expander host-analysis program anchorT,expressionT,directiveT extender)) - {#///directive.analysis {#///directive.state analysis-state + [(dictionary.merge host_directive_bundle + (luxD.bundle expander host_analysis program anchorT,expressionT,directiveT extender)) + {#///directive.analysis {#///directive.state analysis_state #///directive.phase (analysisP.phase expander)} - #///directive.synthesis {#///directive.state synthesis-state + #///directive.synthesis {#///directive.state synthesis_state #///directive.phase synthesisP.phase} - #///directive.generation {#///directive.state generation-state + #///directive.generation {#///directive.state generation_state #///directive.phase generate}}])) (type: Reader (-> Source (Either [Source Text] [Source Code]))) -(def: (reader current-module aliases [location offset source-code]) +(def: (reader current_module aliases [location offset source_code]) (-> Module Aliases Source (///analysis.Operation Reader)) (function (_ [bundle state]) (#try.Success [[bundle state] - (///syntax.parse current-module aliases ("lux text size" source-code))]))) + (///syntax.parse current_module aliases ("lux text size" source_code))]))) (def: (read source reader) (-> Source Reader (///analysis.Operation [Source Code])) @@ -114,14 +114,14 @@ [Source (Payload directive)]))) (do ///phase.monad [#let [module (get@ #///.module input)] - _ (///directive.set-current-module module)] - (///directive.lift-analysis + _ (///directive.set_current_module module)] + (///directive.lift_analysis (do {! ///phase.monad} [_ (module.create hash module) _ (monad.map ! module.import dependencies) #let [source (///analysis.source (get@ #///.module input) (get@ #///.code input))] - _ (///analysis.set-source-code source)] - (wrap [source [///generation.empty-buffer + _ (///analysis.set_source_code source)] + (wrap [source [///generation.empty_buffer artifact.empty]]))))) (def: (end module) @@ -129,100 +129,100 @@ (All [anchor expression directive] (///directive.Operation anchor expression directive [.Module (Payload directive)]))) (do ///phase.monad - [_ (///directive.lift-analysis - (module.set-compiled module)) - analysis-module (<| (: (Operation .Module)) - ///directive.lift-analysis + [_ (///directive.lift_analysis + (module.set_compiled module)) + analysis_module (<| (: (Operation .Module)) + ///directive.lift_analysis extension.lift - meta.current-module) - final-buffer (///directive.lift-generation + meta.current_module) + final_buffer (///directive.lift_generation ///generation.buffer) - final-registry (///directive.lift-generation - ///generation.get-registry)] - (wrap [analysis-module [final-buffer - final-registry]]))) + final_registry (///directive.lift_generation + ///generation.get_registry)] + (wrap [analysis_module [final_buffer + final_registry]]))) ## TODO: Inline ASAP -(def: (get-current-payload _) +(def: (get_current_payload _) (All [directive] (-> (Payload directive) (All [anchor expression] (///directive.Operation anchor expression directive (Payload directive))))) (do ///phase.monad - [buffer (///directive.lift-generation + [buffer (///directive.lift_generation ///generation.buffer) - registry (///directive.lift-generation - ///generation.get-registry)] + registry (///directive.lift_generation + ///generation.get_registry)] (wrap [buffer registry]))) ## TODO: Inline ASAP -(def: (process-directive archive expander pre-payoad code) +(def: (process_directive archive expander pre_payoad code) (All [directive] (-> Archive Expander (Payload directive) Code (All [anchor expression] (///directive.Operation anchor expression directive [Requirements (Payload directive)])))) (do ///phase.monad - [#let [[pre-buffer pre-registry] pre-payoad] - _ (///directive.lift-generation - (///generation.set-buffer pre-buffer)) - _ (///directive.lift-generation - (///generation.set-registry pre-registry)) + [#let [[pre_buffer pre_registry] pre_payoad] + _ (///directive.lift_generation + (///generation.set_buffer pre_buffer)) + _ (///directive.lift_generation + (///generation.set_registry pre_registry)) requirements (let [execute! (directiveP.phase expander)] (execute! archive code)) - post-payload (..get-current-payload pre-payoad)] - (wrap [requirements post-payload]))) + post_payload (..get_current_payload pre_payoad)] + (wrap [requirements post_payload]))) -(def: (iteration archive expander reader source pre-payload) +(def: (iteration archive expander reader source pre_payload) (All [directive] (-> Archive Expander Reader Source (Payload directive) (All [anchor expression] (///directive.Operation anchor expression directive [Source Requirements (Payload directive)])))) (do ///phase.monad - [[source code] (///directive.lift-analysis + [[source code] (///directive.lift_analysis (..read source reader)) - [requirements post-payload] (process-directive archive expander pre-payload code)] - (wrap [source requirements post-payload]))) + [requirements post_payload] (process_directive archive expander pre_payload code)] + (wrap [source requirements post_payload]))) -(def: (iterate archive expander module source pre-payload aliases) +(def: (iterate archive expander module source pre_payload aliases) (All [directive] (-> Archive Expander Module Source (Payload directive) Aliases (All [anchor expression] (///directive.Operation anchor expression directive (Maybe [Source Requirements (Payload directive)]))))) (do ///phase.monad - [reader (///directive.lift-analysis + [reader (///directive.lift_analysis (..reader module aliases source))] (function (_ state) - (case (///phase.run' state (..iteration archive expander reader source pre-payload)) + (case (///phase.run' state (..iteration archive expander reader source pre_payload)) (#try.Success [state source&requirements&buffer]) (#try.Success [state (#.Some source&requirements&buffer)]) (#try.Failure error) - (if (exception.match? ///syntax.end-of-file error) + (if (exception.match? ///syntax.end_of_file error) (#try.Success [state #.None]) - (exception.with ///.cannot-compile module (#try.Failure error))))))) + (exception.with ///.cannot_compile module (#try.Failure error))))))) -(def: (default-dependencies prelude input) +(def: (default_dependencies prelude input) (-> Module ///.Input (List Module)) - (list& archive.runtime-module + (list& archive.runtime_module (if (text\= prelude (get@ #///.module input)) (list) (list prelude)))) -(def: module-aliases +(def: module_aliases (-> .Module Aliases) - (|>> (get@ #.module-aliases) (dictionary.from-list text.hash))) + (|>> (get@ #.module_aliases) (dictionary.from_list text.hash))) -(def: #export (compiler expander prelude write-directive) +(def: #export (compiler expander prelude write_directive) (All [anchor expression directive] (-> Expander Module (-> directive Binary) (Instancer (///directive.State+ anchor expression directive) .Module))) (let [execute! (directiveP.phase expander)] (function (_ key parameters input) - (let [dependencies (default-dependencies prelude input)] + (let [dependencies (default_dependencies prelude input)] {#///.dependencies dependencies #///.process (function (_ state archive) (do {! try.monad} @@ -231,27 +231,27 @@ (..begin dependencies hash input)) #let [module (get@ #///.module input)]] (loop [iteration (<| (///phase.run' state) - (..iterate archive expander module source buffer ///syntax.no-aliases))] + (..iterate archive expander module source buffer ///syntax.no_aliases))] (do ! - [[state ?source&requirements&temporary-payload] iteration] - (case ?source&requirements&temporary-payload + [[state ?source&requirements&temporary_payload] iteration] + (case ?source&requirements&temporary_payload #.None (do ! - [[state [analysis-module [final-buffer final-registry]]] (///phase.run' state (..end module)) + [[state [analysis_module [final_buffer final_registry]]] (///phase.run' state (..end module)) #let [descriptor {#descriptor.hash hash #descriptor.name module #descriptor.file (get@ #///.file input) - #descriptor.references (set.from-list text.hash dependencies) + #descriptor.references (set.from_list text.hash dependencies) #descriptor.state #.Compiled - #descriptor.registry final-registry}]] + #descriptor.registry final_registry}]] (wrap [state - (#.Right [[descriptor (document.write key analysis-module)] - (|> final-buffer + (#.Right [[descriptor (document.write key analysis_module)] + (|> final_buffer (row\map (function (_ [name directive]) - [name (write-directive directive)])))])])) + [name (write_directive directive)])))])])) - (#.Some [source requirements temporary-payload]) - (let [[temporary-buffer temporary-registry] temporary-payload] + (#.Some [source requirements temporary_payload]) + (let [[temporary_buffer temporary_registry] temporary_payload] (wrap [state (#.Left {#///.dependencies (|> requirements (get@ #///directive.imports) @@ -259,17 +259,17 @@ #///.process (function (_ state archive) (recur (<| (///phase.run' state) (do {! ///phase.monad} - [analysis-module (<| (: (Operation .Module)) - ///directive.lift-analysis + [analysis_module (<| (: (Operation .Module)) + ///directive.lift_analysis extension.lift - meta.current-module) - _ (///directive.lift-generation - (///generation.set-buffer temporary-buffer)) - _ (///directive.lift-generation - (///generation.set-registry temporary-registry)) + meta.current_module) + _ (///directive.lift_generation + (///generation.set_buffer temporary_buffer)) + _ (///directive.lift_generation + (///generation.set_registry temporary_registry)) _ (|> requirements (get@ #///directive.referrals) (monad.map ! (execute! archive))) - temporary-payload (..get-current-payload temporary-payload)] - (..iterate archive expander module source temporary-payload (..module-aliases analysis-module))))))})])) + temporary_payload (..get_current_payload temporary_payload)] + (..iterate archive expander module source temporary_payload (..module_aliases analysis_module))))))})])) )))))})))) diff --git a/stdlib/source/lux/tool/compiler/default/platform.lux b/stdlib/source/lux/tool/compiler/default/platform.lux index 7a99aa09b..15b7165f4 100644 --- a/stdlib/source/lux/tool/compiler/default/platform.lux +++ b/stdlib/source/lux/tool/compiler/default/platform.lux @@ -61,7 +61,7 @@ ["." import (#+ Import)]]]) (type: #export (Platform anchor expression directive) - {#&file-system (file.System Promise) + {#&file_system (file.System Promise) #host (///generation.Host expression directive) #phase (///generation.Phase anchor expression directive) #runtime (///generation.Operation anchor expression directive [Registry Output]) @@ -76,86 +76,86 @@ (:coerce (Monad Action) (try.with promise.monad))) -(with-expansions [<type-vars> (as-is anchor expression directive) - <Platform> (as-is (Platform <type-vars>)) - <State+> (as-is (///directive.State+ <type-vars>)) - <Bundle> (as-is (///generation.Bundle <type-vars>))] +(with_expansions [<type_vars> (as_is anchor expression directive) + <Platform> (as_is (Platform <type_vars>)) + <State+> (as_is (///directive.State+ <type_vars>)) + <Bundle> (as_is (///generation.Bundle <type_vars>))] (def: writer (Writer [Descriptor (Document .Module)]) (_.and descriptor.writer (document.writer $.writer))) - (def: (cache-module static platform module-id [[descriptor document] output]) - (All [<type-vars>] + (def: (cache_module static platform module_id [[descriptor document] output]) + (All [<type_vars>] (-> Static <Platform> archive.ID [[Descriptor (Document Any)] Output] (Promise (Try Any)))) - (let [system (get@ #&file-system platform) - write-artifact! (: (-> [Text Binary] (Action Any)) + (let [system (get@ #&file_system platform) + write_artifact! (: (-> [Text Binary] (Action Any)) (function (_ [name content]) - (ioW.write system static module-id name content)))] + (ioW.write system static module_id name content)))] (do ..monad - [_ (ioW.prepare system static module-id) + [_ (ioW.prepare system static module_id) _ (|> output - row.to-list - (monad.map ..monad write-artifact!) + row.to_list + (monad.map ..monad write_artifact!) (: (Action (List Any)))) document (\ promise.monad wrap (document.check $.key document))] - (ioW.cache system static module-id + (ioW.cache system static module_id (_.run ..writer [descriptor document]))))) ## TODO: Inline ASAP - (def: initialize-buffer! - (All [<type-vars>] - (///generation.Operation <type-vars> Any)) - (///generation.set-buffer ///generation.empty-buffer)) + (def: initialize_buffer! + (All [<type_vars>] + (///generation.Operation <type_vars> Any)) + (///generation.set_buffer ///generation.empty_buffer)) ## TODO: Inline ASAP - (def: (compile-runtime! platform) - (All [<type-vars>] - (-> <Platform> (///generation.Operation <type-vars> [Registry Output]))) + (def: (compile_runtime! platform) + (All [<type_vars>] + (-> <Platform> (///generation.Operation <type_vars> [Registry Output]))) (do ///phase.monad - [_ ..initialize-buffer!] + [_ ..initialize_buffer!] (get@ #runtime platform))) - (def: (runtime-descriptor registry) + (def: (runtime_descriptor registry) (-> Registry Descriptor) {#descriptor.hash 0 - #descriptor.name archive.runtime-module + #descriptor.name archive.runtime_module #descriptor.file "" #descriptor.references (set.new text.hash) #descriptor.state #.Compiled #descriptor.registry registry}) - (def: runtime-document + (def: runtime_document (Document .Module) (document.write $.key (module.new 0))) - (def: (process-runtime archive platform) - (All [<type-vars>] + (def: (process_runtime archive platform) + (All [<type_vars>] (-> Archive <Platform> - (///directive.Operation <type-vars> + (///directive.Operation <type_vars> [Archive [[Descriptor (Document .Module)] Output]]))) (do ///phase.monad - [[registry payload] (///directive.lift-generation - (..compile-runtime! platform)) - #let [descriptor,document [(..runtime-descriptor registry) ..runtime-document]] - archive (///phase.lift (if (archive.reserved? archive archive.runtime-module) - (archive.add archive.runtime-module descriptor,document archive) + [[registry payload] (///directive.lift_generation + (..compile_runtime! platform)) + #let [descriptor,document [(..runtime_descriptor registry) ..runtime_document]] + archive (///phase.lift (if (archive.reserved? archive archive.runtime_module) + (archive.add archive.runtime_module descriptor,document archive) (do try.monad - [[_ archive] (archive.reserve archive.runtime-module archive)] - (archive.add archive.runtime-module descriptor,document archive))))] + [[_ archive] (archive.reserve archive.runtime_module archive)] + (archive.add archive.runtime_module descriptor,document archive))))] (wrap [archive [descriptor,document payload]]))) - (def: (initialize-state extender + (def: (initialize_state extender [analysers synthesizers generators directives] - analysis-state + analysis_state state) - (All [<type-vars>] + (All [<type_vars>] (-> Extender [(Dictionary Text ///analysis.Handler) (Dictionary Text ///synthesis.Handler) @@ -164,34 +164,34 @@ .Lux <State+> (Try <State+>))) - (|> (:share [<type-vars>] + (|> (:share [<type_vars>] {<State+> state} - {(///directive.Operation <type-vars> Any) + {(///directive.Operation <type_vars> Any) (do ///phase.monad - [_ (///directive.lift-analysis - (///analysis.install analysis-state)) - _ (///directive.lift-analysis + [_ (///directive.lift_analysis + (///analysis.install analysis_state)) + _ (///directive.lift_analysis (extension.with extender analysers)) - _ (///directive.lift-synthesis + _ (///directive.lift_synthesis (extension.with extender synthesizers)) - _ (///directive.lift-generation + _ (///directive.lift_generation (extension.with extender (:assume generators))) _ (extension.with extender (:assume directives))] (wrap []))}) (///phase.run' state) (\ try.monad map product.left))) - (def: #export (initialize static module expander host-analysis platform generation-bundle host-directive-bundle program anchorT,expressionT,directiveT extender - import compilation-sources) - (All [<type-vars>] + (def: #export (initialize static module expander host_analysis platform generation_bundle host_directive_bundle program anchorT,expressionT,directiveT extender + import compilation_sources) + (All [<type_vars>] (-> Static Module Expander ///analysis.Bundle <Platform> <Bundle> - (///directive.Bundle <type-vars>) + (///directive.Bundle <type_vars>) (Program expression directive) [Type Type Type] Extender Import (List Context) @@ -200,28 +200,28 @@ [#let [state (//init.state (get@ #static.host static) module expander - host-analysis + host_analysis (get@ #host platform) (get@ #phase platform) - generation-bundle - host-directive-bundle + generation_bundle + host_directive_bundle program anchorT,expressionT,directiveT extender)] - _ (ioW.enable (get@ #&file-system platform) static) - [archive analysis-state bundles] (ioW.thaw (get@ #host platform) (get@ #&file-system platform) static import compilation-sources) - state (promise\wrap (initialize-state extender bundles analysis-state state))] - (if (archive.archived? archive archive.runtime-module) + _ (ioW.enable (get@ #&file_system platform) static) + [archive analysis_state bundles] (ioW.thaw (get@ #host platform) (get@ #&file_system platform) static import compilation_sources) + state (promise\wrap (initialize_state extender bundles analysis_state state))] + (if (archive.archived? archive archive.runtime_module) (wrap [state archive]) (do (try.with promise.monad) - [[state [archive payload]] (|> (..process-runtime archive platform) + [[state [archive payload]] (|> (..process_runtime archive platform) (///phase.run' state) promise\wrap) - _ (..cache-module static platform 0 payload)] + _ (..cache_module static platform 0 payload)] (wrap [state archive]))))) - (def: module-compilation-log - (All [<type-vars>] + (def: module_compilation_log + (All [<type_vars>] (-> <State+> Text)) (|>> (get@ [#extension.state #///directive.generation @@ -229,11 +229,11 @@ #extension.state #///generation.log]) (row\fold (function (_ right left) - (format left text.new-line right)) + (format left text.new_line right)) ""))) - (def: with-reset-log - (All [<type-vars>] + (def: with_reset_log + (All [<type_vars>] (-> <State+> <State+>)) (set@ [#extension.state #///directive.generation @@ -250,48 +250,48 @@ (Dictionary Module (Set Module))) (type: Dependence - {#depends-on Mapping - #depended-by Mapping}) + {#depends_on Mapping + #depended_by Mapping}) (def: independence Dependence (let [empty (dictionary.new text.hash)] - {#depends-on empty - #depended-by empty})) + {#depends_on empty + #depended_by empty})) (def: (depend module import dependence) (-> Module Module Dependence Dependence) - (let [transitive-dependency (: (-> (-> Dependence Mapping) Module (Set Module)) + (let [transitive_dependency (: (-> (-> Dependence Mapping) Module (Set Module)) (function (_ lens module) (|> dependence lens (dictionary.get module) (maybe.default ..empty)))) - transitive-depends-on (transitive-dependency (get@ #depends-on) import) - transitive-depended-by (transitive-dependency (get@ #depended-by) module) - update-dependence (: (-> [Module (Set Module)] [Module (Set Module)] + transitive_depends_on (transitive_dependency (get@ #depends_on) import) + transitive_depended_by (transitive_dependency (get@ #depended_by) module) + update_dependence (: (-> [Module (Set Module)] [Module (Set Module)] (-> Mapping Mapping)) (function (_ [source forward] [target backward]) (function (_ mapping) - (let [with-dependence+transitives + (let [with_dependence+transitives (|> mapping (dictionary.upsert source ..empty (set.add target)) (dictionary.update source (set.union forward)))] (list\fold (function (_ previous) (dictionary.upsert previous ..empty (set.add target))) - with-dependence+transitives - (set.to-list backward))))))] + with_dependence+transitives + (set.to_list backward))))))] (|> dependence - (update@ #depends-on - (update-dependence - [module transitive-depends-on] - [import transitive-depended-by])) - (update@ #depended-by - ((function.flip update-dependence) - [module transitive-depends-on] - [import transitive-depended-by]))))) - - (def: (circular-dependency? module import dependence) + (update@ #depends_on + (update_dependence + [module transitive_depends_on] + [import transitive_depended_by])) + (update@ #depended_by + ((function.flip update_dependence) + [module transitive_depends_on] + [import transitive_depended_by]))))) + + (def: (circular_dependency? module import dependence) (-> Module Module Dependence Bit) (let [dependence? (: (-> Module (-> Dependence Mapping) Module Bit) (function (_ from relationship to) @@ -300,43 +300,43 @@ (dictionary.get from) (maybe.default ..empty))] (set.member? targets to))))] - (or (dependence? import (get@ #depends-on) module) - (dependence? module (get@ #depended-by) import)))) + (or (dependence? import (get@ #depends_on) module) + (dependence? module (get@ #depended_by) import)))) - (exception: #export (module-cannot-import-itself {module Module}) + (exception: #export (module_cannot_import_itself {module Module}) (exception.report ["Module" (%.text module)])) - (exception: #export (cannot-import-circular-dependency {importer Module} + (exception: #export (cannot_import_circular_dependency {importer Module} {importee Module}) (exception.report ["Importer" (%.text importer)] ["importee" (%.text importee)])) - (def: (verify-dependencies importer importee dependence) + (def: (verify_dependencies importer importee dependence) (-> Module Module Dependence (Try Any)) (cond (text\= importer importee) - (exception.throw ..module-cannot-import-itself [importer]) + (exception.throw ..module_cannot_import_itself [importer]) - (..circular-dependency? importer importee dependence) - (exception.throw ..cannot-import-circular-dependency [importer importee]) + (..circular_dependency? importer importee dependence) + (exception.throw ..cannot_import_circular_dependency [importer importee]) ## else (#try.Success []))) - (with-expansions [<Context> (as-is [Archive <State+>]) - <Result> (as-is (Try <Context>)) - <Return> (as-is (Promise <Result>)) - <Signal> (as-is (Resolver <Result>)) - <Pending> (as-is [<Return> <Signal>]) - <Importer> (as-is (-> Module Module <Return>)) - <Compiler> (as-is (-> <Importer> archive.ID <Context> Module <Return>))] + (with_expansions [<Context> (as_is [Archive <State+>]) + <Result> (as_is (Try <Context>)) + <Return> (as_is (Promise <Result>)) + <Signal> (as_is (Resolver <Result>)) + <Pending> (as_is [<Return> <Signal>]) + <Importer> (as_is (-> Module Module <Return>)) + <Compiler> (as_is (-> <Importer> archive.ID <Context> Module <Return>))] (def: (parallel initial) - (All [<type-vars>] + (All [<type_vars>] (-> <Context> (-> <Compiler> <Importer>))) (let [current (stm.var initial) - pending (:share [<type-vars>] + pending (:share [<type_vars>] {<Context> initial} {(Var (Dictionary Module <Pending>)) @@ -346,7 +346,7 @@ (function (_ compile) (function (import! importer module) (do {! promise.monad} - [[return signal] (:share [<type-vars>] + [[return signal] (:share [<type_vars>] {<Context> initial} {(Promise [<Return> (Maybe [<Context> @@ -355,12 +355,12 @@ (:assume (stm.commit (do {! stm.monad} - [dependence (if (text\= archive.runtime-module importer) + [dependence (if (text\= archive.runtime_module importer) (stm.read dependence) (do ! [[_ dependence] (stm.update (..depend importer module) dependence)] (wrap dependence)))] - (case (..verify-dependencies importer module dependence) + (case (..verify_dependencies importer module dependence) (#try.Failure error) (wrap [(promise.resolved (#try.Failure error)) #.None]) @@ -381,13 +381,13 @@ #.None (case (if (archive.reserved? archive module) (do try.monad - [module-id (archive.id module archive)] - (wrap [module-id archive])) + [module_id (archive.id module archive)] + (wrap [module_id archive])) (archive.reserve module archive)) - (#try.Success [module-id archive]) + (#try.Success [module_id archive]) (do ! [_ (stm.write [archive state] current) - #let [[return signal] (:share [<type-vars>] + #let [[return signal] (:share [<type_vars>] {<Context> initial} {<Pending> @@ -395,7 +395,7 @@ _ (stm.update (dictionary.put module [return signal]) pending)] (wrap [return (#.Some [[archive state] - module-id + module_id signal])])) (#try.Failure error) @@ -405,44 +405,44 @@ #.None (wrap []) - (#.Some [context module-id resolver]) + (#.Some [context module_id resolver]) (do ! - [result (compile import! module-id context module) + [result (compile import! module_id context module) result (case result (#try.Failure error) (wrap result) - (#try.Success [resulting-archive resulting-state]) + (#try.Success [resulting_archive resulting_state]) (stm.commit (do stm.monad - [[_ [merged-archive _]] (stm.update (function (_ [archive state]) - [(archive.merge resulting-archive archive) + [[_ [merged_archive _]] (stm.update (function (_ [archive state]) + [(archive.merge resulting_archive archive) state]) current)] - (wrap (#try.Success [merged-archive resulting-state]))))) + (wrap (#try.Success [merged_archive resulting_state]))))) _ (promise.future (resolver result))] (wrap [])))] return))))) ## TODO: Find a better way, as this only works for the Lux compiler. - (def: (updated-state archive state) - (All [<type-vars>] + (def: (updated_state archive state) + (All [<type_vars>] (-> Archive <State+> (Try <State+>))) (do {! try.monad} [modules (monad.map ! (function (_ module) (do ! [[descriptor document] (archive.find module archive) - lux-module (document.read $.key document)] - (wrap [module lux-module]))) + lux_module (document.read $.key document)] + (wrap [module lux_module]))) (archive.archived archive)) #let [additions (|> modules (list\map product.left) - (set.from-list text.hash))]] + (set.from_list text.hash))]] (wrap (update@ [#extension.state #///directive.analysis #///directive.state #extension.state] - (function (_ analysis-state) - (|> analysis-state + (function (_ analysis_state) + (|> analysis_state (:coerce .Lux) (update@ #.modules (function (_ current) (list\compose (list.filter (|>> product.left @@ -453,19 +453,19 @@ :assume)) state)))) - (def: (set-current-module module state) - (All [<type-vars>] + (def: (set_current_module module state) + (All [<type_vars>] (-> Module <State+> <State+>)) - (|> (///directive.set-current-module module) + (|> (///directive.set_current_module module) (///phase.run' state) try.assume product.left)) (def: #export (compile import static expander platform compilation context) - (All [<type-vars>] + (All [<type_vars>] (-> Import Static Expander <Platform> Compilation <Context> <Return>)) - (let [[compilation-sources compilation-libraries compilation-target compilation-module] compilation - base-compiler (:share [<type-vars>] + (let [[compilation_sources compilation_libraries compilation_target compilation_module] compilation + base_compiler (:share [<type_vars>] {<Context> context} {(///.Compiler <State+> .Module Any) @@ -473,21 +473,21 @@ ((//init.compiler expander syntax.prelude (get@ #write platform)) $.key (list)))}) compiler (..parallel context - (function (_ import! module-id [archive state] module) + (function (_ import! module_id [archive state] module) (do {! (try.with promise.monad)} - [#let [state (..set-current-module module state)] - input (context.read (get@ #&file-system platform) + [#let [state (..set_current_module module state)] + input (context.read (get@ #&file_system platform) import - compilation-sources - (get@ #static.host-module-extension static) + compilation_sources + (get@ #static.host_module_extension static) module)] (loop [[archive state] [archive state] - compilation (base-compiler (:coerce ///.Input input)) - all-dependencies (: (List Module) + compilation (base_compiler (:coerce ///.Input input)) + all_dependencies (: (List Module) (list))] - (let [new-dependencies (get@ #///.dependencies compilation) - all-dependencies (list\compose new-dependencies all-dependencies) - continue! (:share [<type-vars>] + (let [new_dependencies (get@ #///.dependencies compilation) + all_dependencies (list\compose new_dependencies all_dependencies) + continue! (:share [<type_vars>] {<Platform> platform} {(-> <Context> (///.Compilation <State+> .Module Any) (List Module) @@ -495,24 +495,24 @@ (:assume recur)})] (do ! - [[archive state] (case new-dependencies + [[archive state] (case new_dependencies #.Nil (wrap [archive state]) (#.Cons _) (do ! - [archive,document+ (|> new-dependencies + [archive,document+ (|> new_dependencies (list\map (import! module)) (monad.seq ..monad)) #let [archive (|> archive,document+ (list\map product.left) (list\fold archive.merge archive))]] (wrap [archive (try.assume - (..updated-state archive state))])))] + (..updated_state archive state))])))] (case ((get@ #///.process compilation) - ## TODO: The "///directive.set-current-module" below shouldn't be necessary. Remove it ASAP. + ## TODO: The "///directive.set_current_module" below shouldn't be necessary. Remove it ASAP. ## TODO: The context shouldn't need to be re-set either. - (|> (///directive.set-current-module module) + (|> (///directive.set_current_module module) (///phase.run' state) try.assume product.left) @@ -520,24 +520,24 @@ (#try.Success [state more|done]) (case more|done (#.Left more) - (continue! [archive state] more all-dependencies) + (continue! [archive state] more all_dependencies) (#.Right [[descriptor document] output]) (do ! - [#let [_ (log! (..module-compilation-log state)) - descriptor (set@ #descriptor.references (set.from-list text.hash all-dependencies) descriptor)] - _ (..cache-module static platform module-id [[descriptor document] output])] + [#let [_ (log! (..module_compilation_log state)) + descriptor (set@ #descriptor.references (set.from_list text.hash all_dependencies) descriptor)] + _ (..cache_module static platform module_id [[descriptor document] output])] (case (archive.add module [descriptor document] archive) (#try.Success archive) (wrap [archive - (..with-reset-log state)]) + (..with_reset_log state)]) (#try.Failure error) (promise\wrap (#try.Failure error))))) (#try.Failure error) (do ! - [_ (ioW.freeze (get@ #&file-system platform) static archive)] + [_ (ioW.freeze (get@ #&file_system platform) static archive)] (promise\wrap (#try.Failure error))))))))))] - (compiler archive.runtime-module compilation-module))) + (compiler archive.runtime_module compilation_module))) )) diff --git a/stdlib/source/lux/tool/compiler/language/lux.lux b/stdlib/source/lux/tool/compiler/language/lux.lux index 0d77cbe6c..1d507b52f 100644 --- a/stdlib/source/lux/tool/compiler/language/lux.lux +++ b/stdlib/source/lux/tool/compiler/language/lux.lux @@ -17,7 +17,7 @@ ["." signature] ["." key (#+ Key)]]]]]) -## TODO: Remove #module-hash, #imports & #module-state ASAP. +## TODO: Remove #module_hash, #imports & #module_state ASAP. ## TODO: Not just from this parser, but from the lux.Module type. (def: #export writer (Writer .Module) @@ -42,9 +42,9 @@ _.bit _.type))] ($_ _.and - ## #module-hash + ## #module_hash _.nat - ## #module-aliases + ## #module_aliases (_.list alias) ## #definitions (_.list (_.and _.text global)) @@ -54,9 +54,9 @@ (_.list (_.and _.text tag)) ## #types (_.list (_.and _.text type)) - ## #module-annotations + ## #module_annotations (_.maybe _.code) - ## #module-state + ## #module_state _.any))) (def: #export parser @@ -82,9 +82,9 @@ <b>.bit <b>.type))] ($_ <>.and - ## #module-hash + ## #module_hash <b>.nat - ## #module-aliases + ## #module_aliases (<b>.list alias) ## #definitions (<b>.list (<>.and <b>.text global)) @@ -94,13 +94,13 @@ (<b>.list (<>.and <b>.text tag)) ## #types (<b>.list (<>.and <b>.text type)) - ## #module-annotations + ## #module_annotations (<b>.maybe <b>.code) - ## #module-state + ## #module_state (\ <>.monad wrap #.Cached)))) (def: #export key (Key .Module) - (key.key {#signature.name (name-of ..compiler) + (key.key {#signature.name (name_of ..compiler) #signature.version /version.version} (module.new 0))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/analysis.lux b/stdlib/source/lux/tool/compiler/language/lux/analysis.lux index 619f3c1d5..d2382537a 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/analysis.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/analysis.lux @@ -12,15 +12,16 @@ ["." product] ["." maybe] ["." bit ("#\." equivalence)] - [number - ["n" nat] - ["i" int] - ["r" rev] - ["f" frac]] ["." text ("#\." equivalence) ["%" format (#+ Format format)]] [collection ["." list ("#\." functor fold)]]] + [math + [number + ["n" nat] + ["i" int] + ["r" rev] + ["f" frac]]] [meta ["." location]]] [// @@ -459,7 +460,7 @@ (def: (locate_error location error) (-> Location Text Text) - (format "@ " (%.location location) text.new_line + (format (%.location location) text.new_line error)) (def: #export (fail error) diff --git a/stdlib/source/lux/tool/compiler/language/lux/analysis/evaluation.lux b/stdlib/source/lux/tool/compiler/language/lux/analysis/evaluation.lux index 56a99ce97..19dada86b 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/analysis/evaluation.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/analysis/evaluation.lux @@ -30,12 +30,12 @@ (type: #export Eval (-> Archive Nat Type Code (Operation Any))) -(def: (context [module-id artifact-id]) +(def: (context [module_id artifact_id]) (-> Context Context) ## TODO: Find a better way that doesn't rely on clever tricks. - [(n.- module-id 0) artifact-id]) + [(n.- module_id 0) artifact_id]) -(def: #export (evaluator expander synthesis-state generation-state generate) +(def: #export (evaluator expander synthesis_state generation_state generate) (All [anchor expression artifact] (-> Expander synthesis.State+ @@ -45,14 +45,14 @@ (let [analyze (analysisP.phase expander)] (function (eval archive count type exprC) (do phase.monad - [exprA (type.with-type type + [exprA (type.with_type type (analyze archive exprC)) module (extensionP.lift - meta.current-module-name)] + meta.current_module_name)] (phase.lift (do try.monad - [exprS (|> exprA (synthesisP.phase archive) (phase.run synthesis-state))] - (phase.run generation-state + [exprS (|> exprA (synthesisP.phase archive) (phase.run synthesis_state))] + (phase.run generation_state (do phase.monad [exprO (generate archive exprS) - module-id (generation.module-id module archive)] - (generation.evaluate! (..context [module-id count]) exprO))))))))) + module_id (generation.module_id module archive)] + (generation.evaluate! (..context [module_id count]) exprO))))))))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/analysis/macro.lux b/stdlib/source/lux/tool/compiler/language/lux/analysis/macro.lux index e9c260789..9a84c0259 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/analysis/macro.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/analysis/macro.lux @@ -12,13 +12,13 @@ [///// ["." phase]]) -(exception: #export (expansion-failed {macro Name} {inputs (List Code)} {error Text}) +(exception: #export (expansion_failed {macro Name} {inputs (List Code)} {error Text}) (exception.report ["Macro" (%.name macro)] ["Inputs" (exception.enumerate %.code inputs)] ["Error" error])) -(exception: #export (must-have-single-expansion {macro Name} {inputs (List Code)} {outputs (List Code)}) +(exception: #export (must_have_single_expansion {macro Name} {inputs (List Code)} {outputs (List Code)}) (exception.report ["Macro" (%.name macro)] ["Inputs" (exception.enumerate %.code inputs)] @@ -37,9 +37,9 @@ (#try.Success output) (#try.Failure error) - ((phase.throw ..expansion-failed [name inputs error]) state))))) + ((meta.fail (exception.construct ..expansion_failed [name inputs error])) state))))) -(def: #export (expand-one expander name macro inputs) +(def: #export (expand_one expander name macro inputs) (-> Expander Name Macro (List Code) (Meta Code)) (do meta.monad [expansion (expand expander name macro inputs)] @@ -48,4 +48,4 @@ (wrap single) _ - (phase.throw ..must-have-single-expansion [name inputs expansion])))) + (meta.fail (exception.construct ..must_have_single_expansion [name inputs expansion]))))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/generation.lux b/stdlib/source/lux/tool/compiler/language/lux/generation.lux index 85a9ded21..bdcaeae42 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/generation.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/generation.lux @@ -12,11 +12,12 @@ ["." name] ["." text ("#\." equivalence) ["%" format (#+ format)]] - [number - ["n" nat]] [collection ["." row (#+ Row)] - ["." list ("#\." functor)]]]] + ["." list ("#\." functor)]]] + [math + [number + ["n" nat]]]] [// [synthesis (#+ Synthesis)] [phase diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis.lux index 482ae99bb..9e0748422 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis.lux @@ -27,7 +27,7 @@ [meta [archive (#+ Archive)]]]]]]) -(exception: #export (unrecognized-syntax {code Code}) +(exception: #export (unrecognized_syntax {code Code}) (exception.report ["Code" (%.code code)])) ## TODO: Had to split the 'compile' function due to compilation issues @@ -59,10 +59,10 @@ values))) (case values (#.Cons value #.Nil) - (/structure.tagged-sum compile tag archive value) + (/structure.tagged_sum compile tag archive value) _ - (/structure.tagged-sum compile tag archive (` [(~+ values)]))) + (/structure.tagged_sum compile tag archive (` [(~+ values)]))) (^ (#.Form (list& [_ (#.Nat lefts)] [_ (#.Bit right?)] values))) @@ -74,7 +74,7 @@ (/structure.sum compile lefts right? archive (` [(~+ values)]))) (#.Tag tag) - (/structure.tagged-sum compile tag archive (' [])) + (/structure.tagged_sum compile tag archive (' [])) (^ (#.Tuple (list))) /primitive.unit @@ -100,26 +100,26 @@ (^ (#.Form (list [_ (#.Record branches)] input))) (/case.case compile branches archive input) - (^ (#.Form (list& [_ (#.Text extension-name)] extension-args))) - (//extension.apply archive compile [extension-name extension-args]) + (^ (#.Form (list& [_ (#.Text extension_name)] extension_args))) + (//extension.apply archive compile [extension_name extension_args]) - (^ (#.Form (list [_ (#.Tuple (list [_ (#.Identifier ["" function-name])] - [_ (#.Identifier ["" arg-name])]))] + (^ (#.Form (list [_ (#.Tuple (list [_ (#.Identifier ["" function_name])] + [_ (#.Identifier ["" arg_name])]))] body))) - (/function.function compile function-name arg-name archive body) + (/function.function compile function_name arg_name archive body) (^ (#.Form (list& functionC argsC+))) (do {! //.monad} - [[functionT functionA] (/type.with-inference + [[functionT functionA] (/type.with_inference (compile archive functionC))] (case functionA - (#/.Reference (#reference.Constant def-name)) + (#/.Reference (#reference.Constant def_name)) (do ! - [?macro (//extension.lift (meta.find-macro def-name))] + [?macro (//extension.lift (meta.find_macro def_name))] (case ?macro (#.Some macro) (do ! - [expansion (//extension.lift (/macro.expand-one expander def-name macro argsC+))] + [expansion (//extension.lift (/macro.expand_one expander def_name macro argsC+))] (compile archive expansion)) _ @@ -129,7 +129,7 @@ (/function.apply compile argsC+ functionT functionA archive functionC))) _ - (//.throw unrecognized-syntax [location.dummy code']))) + (//.throw ..unrecognized_syntax [location.dummy code']))) (def: #export (phase expander) (-> Expander Phase) @@ -137,7 +137,7 @@ (let [[location code'] code] ## The location must be set in the state for the sake ## of having useful error messages. - (/.with-location location + (/.with_location location (compile|primitive (compile|structure archive compile (compile|others expander archive compile)) code'))))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/case.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/case.lux index 33cf36f32..dec7625fa 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/case.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/case.lux @@ -32,36 +32,36 @@ [/// ["#" phase]]]]]]) -(exception: #export (cannot-match-with-pattern {type Type} {pattern Code}) +(exception: #export (cannot_match_with_pattern {type Type} {pattern Code}) (ex.report ["Type" (%.type type)] ["Pattern" (%.code pattern)])) -(exception: #export (sum-has-no-case {case Nat} {type Type}) +(exception: #export (sum_has_no_case {case Nat} {type Type}) (ex.report ["Case" (%.nat case)] ["Type" (%.type type)])) -(exception: #export (not-a-pattern {code Code}) +(exception: #export (not_a_pattern {code Code}) (ex.report ["Code" (%.code code)])) -(exception: #export (cannot-simplify-for-pattern-matching {type Type}) +(exception: #export (cannot_simplify_for_pattern_matching {type Type}) (ex.report ["Type" (%.type type)])) -(exception: #export (non-exhaustive-pattern-matching {input Code} {branches (List [Code Code])} {coverage Coverage}) +(exception: #export (non_exhaustive_pattern_matching {input Code} {branches (List [Code Code])} {coverage Coverage}) (ex.report ["Input" (%.code input)] ["Branches" (%.code (code.record branches))] ["Coverage" (/coverage.%coverage coverage)])) -(exception: #export (cannot-have-empty-branches {message Text}) +(exception: #export (cannot_have_empty_branches {message Text}) message) -(def: (re-quantify envs baseT) +(def: (re_quantify envs baseT) (-> (List (List Type)) Type Type) (.case envs #.Nil baseT (#.Cons head tail) - (re-quantify tail (#.UnivQ head baseT)))) + (re_quantify tail (#.UnivQ head baseT)))) ## Type-checking on the input value is done during the analysis of a ## "case" expression, to ensure that the patterns being used make @@ -70,7 +70,7 @@ ## type-variables or quantifications. ## This function makes it easier for "case" analysis to properly ## type-check the input with respect to the patterns. -(def: (simplify-case caseT) +(def: (simplify_case caseT) (-> Type (Operation Type)) (loop [envs (: (List (List Type)) (list)) @@ -78,14 +78,14 @@ (.case caseT (#.Var id) (do ///.monad - [?caseT' (//type.with-env + [?caseT' (//type.with_env (check.read id))] (.case ?caseT' (#.Some caseT') (recur envs caseT') _ - (/.throw ..cannot-simplify-for-pattern-matching caseT))) + (/.throw ..cannot_simplify_for_pattern_matching caseT))) (#.Named name unnamedT) (recur envs unnamedT) @@ -95,23 +95,23 @@ (#.ExQ _) (do ///.monad - [[var-id varT] (//type.with-env + [[var_id varT] (//type.with_env check.var)] (recur envs (maybe.assume (type.apply (list varT) caseT)))) (#.Apply inputT funcT) (.case funcT - (#.Var funcT-id) + (#.Var funcT_id) (do ///.monad - [funcT' (//type.with-env + [funcT' (//type.with_env (do check.monad - [?funct' (check.read funcT-id)] + [?funct' (check.read funcT_id)] (.case ?funct' (#.Some funct') (wrap funct') _ - (check.throw cannot-simplify-for-pattern-matching caseT))))] + (check.throw ..cannot_simplify_for_pattern_matching caseT))))] (recur envs (#.Apply inputT funcT'))) _ @@ -120,23 +120,23 @@ (recur envs outputT) #.None - (/.throw ..cannot-simplify-for-pattern-matching caseT))) + (/.throw ..cannot_simplify_for_pattern_matching caseT))) (#.Product _) (|> caseT - type.flatten-tuple - (list\map (re-quantify envs)) + type.flatten_tuple + (list\map (re_quantify envs)) type.tuple (\ ///.monad wrap)) _ - (\ ///.monad wrap (re-quantify envs caseT))))) + (\ ///.monad wrap (re_quantify envs caseT))))) -(def: (analyse-primitive type inputT location output next) +(def: (analyse_primitive type inputT location output next) (All [a] (-> Type Type Location Pattern (Operation a) (Operation [Pattern a]))) - (/.with-location location + (/.with_location location (do ///.monad - [_ (//type.with-env + [_ (//type.with_env (check.check inputT type)) outputA next] (wrap [output outputA])))) @@ -157,51 +157,51 @@ ## body expressions. ## That is why the body must be analysed in the context of the ## pattern, and not separately. -(def: (analyse-pattern num-tags inputT pattern next) +(def: (analyse_pattern num_tags inputT pattern next) (All [a] (-> (Maybe Nat) Type Code (Operation a) (Operation [Pattern a]))) (.case pattern [location (#.Identifier ["" name])] - (/.with-location location + (/.with_location location (do ///.monad - [outputA (//scope.with-local [name inputT] + [outputA (//scope.with_local [name inputT] next) - idx //scope.next-local] + idx //scope.next_local] (wrap [(#/.Bind idx) outputA]))) (^template [<type> <input> <output>] [[location <input>] - (analyse-primitive <type> inputT location (#/.Simple <output>) next)]) - ([Bit (#.Bit pattern-value) (#/.Bit pattern-value)] - [Nat (#.Nat pattern-value) (#/.Nat pattern-value)] - [Int (#.Int pattern-value) (#/.Int pattern-value)] - [Rev (#.Rev pattern-value) (#/.Rev pattern-value)] - [Frac (#.Frac pattern-value) (#/.Frac pattern-value)] - [Text (#.Text pattern-value) (#/.Text pattern-value)] + (analyse_primitive <type> inputT location (#/.Simple <output>) next)]) + ([Bit (#.Bit pattern_value) (#/.Bit pattern_value)] + [Nat (#.Nat pattern_value) (#/.Nat pattern_value)] + [Int (#.Int pattern_value) (#/.Int pattern_value)] + [Rev (#.Rev pattern_value) (#/.Rev pattern_value)] + [Frac (#.Frac pattern_value) (#/.Frac pattern_value)] + [Text (#.Text pattern_value) (#/.Text pattern_value)] [Any (#.Tuple #.Nil) #/.Unit]) (^ [location (#.Tuple (list singleton))]) - (analyse-pattern #.None inputT singleton next) + (analyse_pattern #.None inputT singleton next) - [location (#.Tuple sub-patterns)] - (/.with-location location + [location (#.Tuple sub_patterns)] + (/.with_location location (do {! ///.monad} - [inputT' (simplify-case inputT)] + [inputT' (simplify_case inputT)] (.case inputT' (#.Product _) - (let [subs (type.flatten-tuple inputT') - num-subs (maybe.default (list.size subs) - num-tags) - num-sub-patterns (list.size sub-patterns) - matches (cond (n.< num-subs num-sub-patterns) - (let [[prefix suffix] (list.split (dec num-sub-patterns) subs)] - (list.zip/2 (list\compose prefix (list (type.tuple suffix))) sub-patterns)) - - (n.> num-subs num-sub-patterns) - (let [[prefix suffix] (list.split (dec num-subs) sub-patterns)] + (let [subs (type.flatten_tuple inputT') + num_subs (maybe.default (list.size subs) + num_tags) + num_sub_patterns (list.size sub_patterns) + matches (cond (n.< num_subs num_sub_patterns) + (let [[prefix suffix] (list.split (dec num_sub_patterns) subs)] + (list.zip/2 (list\compose prefix (list (type.tuple suffix))) sub_patterns)) + + (n.> num_subs num_sub_patterns) + (let [[prefix suffix] (list.split (dec num_subs) sub_patterns)] (list.zip/2 subs (list\compose prefix (list (code.tuple suffix))))) - ## (n.= num-subs num-sub-patterns) - (list.zip/2 subs sub-patterns))] + ## (n.= num_subs num_sub_patterns) + (list.zip/2 subs sub_patterns))] (do ! [[memberP+ thenA] (list\fold (: (All [a] (-> [Type Code] (Operation [(List Pattern) a]) @@ -209,7 +209,7 @@ (function (_ [memberT memberC] then) (do ! [[memberP [memberP+ thenA]] ((:coerce (All [a] (-> (Maybe Nat) Type Code (Operation a) (Operation [Pattern a]))) - analyse-pattern) + analyse_pattern) #.None memberT memberC then)] (wrap [(list& memberP memberP+) thenA])))) (do ! @@ -220,7 +220,7 @@ thenA]))) _ - (/.throw ..cannot-match-with-pattern [inputT' pattern]) + (/.throw ..cannot_match_with_pattern [inputT' pattern]) ))) [location (#.Record record)] @@ -229,68 +229,68 @@ [members recordT] (//structure.order record) _ (.case inputT (#.Var _id) - (//type.with-env + (//type.with_env (check.check inputT recordT)) _ (wrap []))] - (analyse-pattern (#.Some (list.size members)) inputT [location (#.Tuple members)] next)) + (analyse_pattern (#.Some (list.size members)) inputT [location (#.Tuple members)] next)) [location (#.Tag tag)] - (/.with-location location - (analyse-pattern #.None inputT (` ((~ pattern))) next)) + (/.with_location location + (analyse_pattern #.None inputT (` ((~ pattern))) next)) (^ [location (#.Form (list& [_ (#.Nat lefts)] [_ (#.Bit right?)] values))]) - (/.with-location location + (/.with_location location (do ///.monad - [inputT' (simplify-case inputT)] + [inputT' (simplify_case inputT)] (.case inputT' (#.Sum _) - (let [flat-sum (type.flatten-variant inputT') - size-sum (list.size flat-sum) - num-cases (maybe.default size-sum num-tags) + (let [flat_sum (type.flatten_variant inputT') + size_sum (list.size flat_sum) + num_cases (maybe.default size_sum num_tags) idx (/.tag lefts right?)] - (.case (list.nth idx flat-sum) + (.case (list.nth idx flat_sum) (^multi (#.Some caseT) - (n.< num-cases idx)) + (n.< num_cases idx)) (do ///.monad - [[testP nextA] (if (and (n.> num-cases size-sum) - (n.= (dec num-cases) idx)) - (analyse-pattern #.None - (type.variant (list.drop (dec num-cases) flat-sum)) + [[testP nextA] (if (and (n.> num_cases size_sum) + (n.= (dec num_cases) idx)) + (analyse_pattern #.None + (type.variant (list.drop (dec num_cases) flat_sum)) (` [(~+ values)]) next) - (analyse-pattern #.None caseT (` [(~+ values)]) next))] + (analyse_pattern #.None caseT (` [(~+ values)]) next))] (wrap [(/.pattern/variant [lefts right? testP]) nextA])) _ - (/.throw ..sum-has-no-case [idx inputT]))) + (/.throw ..sum_has_no_case [idx inputT]))) (#.UnivQ _) (do ///.monad - [[ex-id exT] (//type.with-env + [[ex_id exT] (//type.with_env check.existential)] - (analyse-pattern num-tags + (analyse_pattern num_tags (maybe.assume (type.apply (list exT) inputT')) pattern next)) _ - (/.throw ..cannot-match-with-pattern [inputT' pattern])))) + (/.throw ..cannot_match_with_pattern [inputT' pattern])))) (^ [location (#.Form (list& [_ (#.Tag tag)] values))]) - (/.with-location location + (/.with_location location (do ///.monad [tag (///extension.lift (meta.normalize tag)) - [idx group variantT] (///extension.lift (meta.resolve-tag tag)) - _ (//type.with-env + [idx group variantT] (///extension.lift (meta.resolve_tag tag)) + _ (//type.with_env (check.check inputT variantT)) #let [[lefts right?] (/.choice (list.size group) idx)]] - (analyse-pattern (#.Some (list.size group)) inputT (` ((~ (code.nat lefts)) (~ (code.bit right?)) (~+ values))) next))) + (analyse_pattern (#.Some (list.size group)) inputT (` ((~ (code.nat lefts)) (~ (code.bit right?)) (~+ values))) next))) _ - (/.throw ..not-a-pattern pattern) + (/.throw ..not_a_pattern pattern) )) (def: #export (case analyse branches archive inputC) @@ -298,18 +298,18 @@ (.case branches (#.Cons [patternH bodyH] branchesT) (do {! ///.monad} - [[inputT inputA] (//type.with-inference + [[inputT inputA] (//type.with_inference (analyse archive inputC)) - outputH (analyse-pattern #.None inputT patternH (analyse archive bodyH)) + outputH (analyse_pattern #.None inputT patternH (analyse archive bodyH)) outputT (monad.map ! (function (_ [patternT bodyT]) - (analyse-pattern #.None inputT patternT (analyse archive bodyT))) + (analyse_pattern #.None inputT patternT (analyse archive bodyT))) branchesT) outputHC (|> outputH product.left /coverage.determine) outputTC (monad.map ! (|>> product.left /coverage.determine) outputT) _ (.case (monad.fold try.monad /coverage.merge outputHC outputTC) (#try.Success coverage) - (///.assert non-exhaustive-pattern-matching [inputC branches coverage] + (///.assert non_exhaustive_pattern_matching [inputC branches coverage] (/coverage.exhaustive? coverage)) (#try.Failure error) @@ -317,4 +317,4 @@ (wrap (#/.Case inputA [outputH outputT]))) #.Nil - (/.throw ..cannot-have-empty-branches ""))) + (/.throw ..cannot_have_empty_branches ""))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/case/coverage.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/case/coverage.lux index 136decfa8..82f23b0f6 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/case/coverage.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/case/coverage.lux @@ -22,14 +22,14 @@ [/// ["#" phase ("#\." monad)]]]]) -(exception: #export (invalid-tuple-pattern) +(exception: #export (invalid_tuple_pattern) "Tuple size must be >= 2") (def: cases (-> (Maybe Nat) Nat) (|>> (maybe.default 0))) -(def: known-cases? +(def: known_cases? (-> Nat Bit) (n.> 0)) @@ -73,14 +73,14 @@ %.bit (text.enclose ["(#Bit " ")"])) - (#Variant ?max-cases cases) + (#Variant ?max_cases cases) (|> cases dictionary.entries (list\map (function (_ [idx coverage]) (format (%.nat idx) " " (%coverage coverage)))) - (text.join-with " ") + (text.join_with " ") (text.enclose ["{" "}"]) - (format (%.nat (..cases ?max-cases)) " ") + (format (%.nat (..cases ?max_cases)) " ") (text.enclose ["(#Variant " ")"])) (#Seq left right) @@ -121,7 +121,7 @@ (#/.Complex (#/.Tuple membersP+)) (case (list.reverse membersP+) (^or #.Nil (#.Cons _ #.Nil)) - (/.throw invalid-tuple-pattern []) + (/.throw ..invalid_tuple_pattern []) (#.Cons lastP prevsP+) (do ////.monad @@ -142,7 +142,7 @@ ## cases are handled exhaustively. (#/.Complex (#/.Variant [lefts right? value])) (do ////.monad - [value-coverage (determine value) + [value_coverage (determine value) #let [idx (if right? (inc lefts) lefts)]] @@ -150,7 +150,7 @@ (#.Some idx) #.None) (|> (dictionary.new n.hash) - (dictionary.put idx value-coverage))))))) + (dictionary.put idx value_coverage))))))) (def: (xor left right) (-> Bit Bit Bit) @@ -163,15 +163,15 @@ ## always be a pattern prior to them that would match the input. ## Because of that, the presence of redundant patterns is assumed to ## be a bug, likely due to programmer carelessness. -(exception: #export (redundant-pattern {so-far Coverage} {addition Coverage}) - (ex.report ["Coverage so-far" (%coverage so-far)] +(exception: #export (redundant_pattern {so_far Coverage} {addition Coverage}) + (ex.report ["Coverage so-far" (%coverage so_far)] ["Coverage addition" (%coverage addition)])) -(def: (flatten-alt coverage) +(def: (flatten_alt coverage) (-> Coverage (List Coverage)) (case coverage (#Alt left right) - (list& left (flatten-alt right)) + (list& left (flatten_alt right)) _ (list coverage))) @@ -195,8 +195,8 @@ (= rightR rightS)) [(#Alt _) (#Alt _)] - (let [flatR (flatten-alt reference) - flatS (flatten-alt sample)] + (let [flatR (flatten_alt reference) + flatS (flatten_alt sample)] (and (n.= (list.size flatR) (list.size flatS)) (list.every? (function (_ [coverageR coverageS]) (= coverageR coverageS)) @@ -207,17 +207,17 @@ (open: "coverage/." ..equivalence) -(exception: #export (variants-do-not-match {addition-cases Nat} {so-far-cases Nat}) - (ex.report ["So-far Cases" (%.nat so-far-cases)] - ["Addition Cases" (%.nat addition-cases)])) +(exception: #export (variants_do_not_match {addition_cases Nat} {so_far_cases Nat}) + (ex.report ["So-far Cases" (%.nat so_far_cases)] + ["Addition Cases" (%.nat addition_cases)])) ## After determining the coverage of each individual pattern, it is ## necessary to merge them all to figure out if the entire ## pattern-matching expression is exhaustive and whether it contains ## redundant patterns. -(def: #export (merge addition so-far) +(def: #export (merge addition so_far) (-> Coverage Coverage (Try Coverage)) - (case [addition so-far] + (case [addition so_far] [#Partial #Partial] (try\wrap #Partial) @@ -227,15 +227,15 @@ (try\wrap #Exhaustive) [(#Variant allA casesA) (#Variant allSF casesSF)] - (let [addition-cases (cases allSF) - so-far-cases (cases allA)] - (cond (and (known-cases? addition-cases) - (known-cases? so-far-cases) - (not (n.= addition-cases so-far-cases))) - (ex.throw variants-do-not-match [addition-cases so-far-cases]) + (let [addition_cases (cases allSF) + so_far_cases (cases allA)] + (cond (and (known_cases? addition_cases) + (known_cases? so_far_cases) + (not (n.= addition_cases so_far_cases))) + (ex.throw ..variants_do_not_match [addition_cases so_far_cases]) (\ (dictionary.equivalence ..equivalence) = casesSF casesA) - (ex.throw redundant-pattern [so-far addition]) + (ex.throw ..redundant_pattern [so_far addition]) ## else (do {! try.monad} @@ -250,9 +250,9 @@ #.None (wrap (dictionary.put tagA coverageA casesSF')))) casesSF (dictionary.entries casesA))] - (wrap (if (and (or (known-cases? addition-cases) - (known-cases? so-far-cases)) - (n.= (inc (n.max addition-cases so-far-cases)) + (wrap (if (and (or (known_cases? addition_cases) + (known_cases? so_far_cases)) + (n.= (inc (n.max addition_cases so_far_cases)) (dictionary.size casesM)) (list.every? exhaustive? (dictionary.values casesM))) #Exhaustive @@ -285,15 +285,15 @@ ## The 2 sequences cannot possibly be merged. [#0 #0] - (try\wrap (#Alt so-far addition)) + (try\wrap (#Alt so_far addition)) ## There is nothing the addition adds to the coverage. [#1 #1] - (ex.throw redundant-pattern [so-far addition])) + (ex.throw ..redundant_pattern [so_far addition])) ## The addition cannot possibly improve the coverage. [_ #Exhaustive] - (ex.throw redundant-pattern [so-far addition]) + (ex.throw ..redundant_pattern [so_far addition]) ## The addition completes the coverage. [#Exhaustive _] @@ -302,7 +302,7 @@ ## The left part will always match, so the addition is redundant. (^multi [(#Seq left right) single] (coverage/= left single)) - (ex.throw redundant-pattern [so-far addition]) + (ex.throw ..redundant_pattern [so_far addition]) ## The right part is not necessary, since it can always match the left. (^multi [single (#Seq left right)] @@ -320,7 +320,7 @@ ## merges can be done. [_ (#Alt leftS rightS)] (do {! try.monad} - [#let [fuse-once (: (-> Coverage (List Coverage) + [#let [fuse_once (: (-> Coverage (List Coverage) (Try [(Maybe Coverage) (List Coverage)])) (function (_ coverageA possibilitiesSF) @@ -344,13 +344,13 @@ (#try.Failure error) (try.fail error)) ))))] - [successA possibilitiesSF] (fuse-once addition (flatten-alt so-far))] + [successA possibilitiesSF] (fuse_once addition (flatten_alt so_far))] (loop [successA successA possibilitiesSF possibilitiesSF] (case successA (#.Some coverageA') (do ! - [[successA' possibilitiesSF'] (fuse-once coverageA' possibilitiesSF)] + [[successA' possibilitiesSF'] (fuse_once coverageA' possibilitiesSF)] (recur successA' possibilitiesSF')) #.None @@ -364,8 +364,8 @@ (undefined))))) _ - (if (coverage/= so-far addition) + (if (coverage/= so_far addition) ## The addition cannot possibly improve the coverage. - (ex.throw redundant-pattern [so-far addition]) + (ex.throw ..redundant_pattern [so_far addition]) ## There are now 2 alternative paths. - (try\wrap (#Alt so-far addition))))) + (try\wrap (#Alt so_far addition))))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/function.lux index 2f362685d..dfd9c1015 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/function.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/function.lux @@ -24,27 +24,27 @@ [/// ["#" phase]]]]]) -(exception: #export (cannot-analyse {expected Type} {function Text} {argument Text} {body Code}) +(exception: #export (cannot_analyse {expected Type} {function Text} {argument Text} {body Code}) (ex.report ["Type" (%.type expected)] ["Function" function] ["Argument" argument] ["Body" (%.code body)])) -(exception: #export (cannot-apply {functionT Type} {functionC Code} {arguments (List Code)}) +(exception: #export (cannot_apply {functionT Type} {functionC Code} {arguments (List Code)}) (ex.report ["Function type" (%.type functionT)] ["Function" (%.code functionC)] ["Arguments" (|> arguments list.enumeration (list\map (.function (_ [idx argC]) (format (%.nat idx) " " (%.code argC)))) - (text.join-with text.new-line))])) + (text.join_with text.new_line))])) -(def: #export (function analyse function-name arg-name archive body) +(def: #export (function analyse function_name arg_name archive body) (-> Phase Text Text Phase) (do {! ///.monad} - [functionT (///extension.lift meta.expected-type)] + [functionT (///extension.lift meta.expected_type)] (loop [expectedT functionT] - (/.with-stack ..cannot-analyse [expectedT function-name arg-name body] + (/.with_stack ..cannot_analyse [expectedT function_name arg_name body] (case expectedT (#.Named name unnamedT) (recur unnamedT) @@ -55,19 +55,19 @@ (recur value) #.None - (/.fail (ex.construct cannot-analyse [expectedT function-name arg-name body]))) + (/.fail (ex.construct cannot_analyse [expectedT function_name arg_name body]))) (^template [<tag> <instancer>] [(<tag> _) (do ! - [[_ instanceT] (//type.with-env <instancer>)] + [[_ instanceT] (//type.with_env <instancer>)] (recur (maybe.assume (type.apply (list instanceT) expectedT))))]) ([#.UnivQ check.existential] [#.ExQ check.var]) (#.Var id) (do ! - [?expectedT' (//type.with-env + [?expectedT' (//type.with_env (check.read id))] (case ?expectedT' (#.Some expectedT') @@ -76,11 +76,11 @@ ## Inference _ (do ! - [[input-id inputT] (//type.with-env check.var) - [output-id outputT] (//type.with-env check.var) + [[input_id inputT] (//type.with_env check.var) + [output_id outputT] (//type.with_env check.var) #let [functionT (#.Function inputT outputT)] functionA (recur functionT) - _ (//type.with-env + _ (//type.with_env (check.check expectedT functionT))] (wrap functionA)) )) @@ -90,12 +90,12 @@ (#/.Function (list\map (|>> /.variable) (//scope.environment scope)) bodyA))) - /.with-scope + /.with_scope ## Functions have access not only to their argument, but ## also to themselves, through a local variable. - (//scope.with-local [function-name expectedT]) - (//scope.with-local [arg-name inputT]) - (//type.with-type outputT) + (//scope.with_local [function_name expectedT]) + (//scope.with_local [arg_name inputT]) + (//type.with_type outputT) (analyse archive body)) _ @@ -104,7 +104,7 @@ (def: #export (apply analyse argsC+ functionT functionA archive functionC) (-> Phase (List Code) Type Analysis Phase) - (<| (/.with-stack ..cannot-apply [functionT functionC argsC+]) + (<| (/.with_stack ..cannot_apply [functionT functionC argsC+]) (do ///.monad [[applyT argsA+] (//inference.general archive analyse functionT argsC+)]) (wrap (/.apply [functionA argsA+])))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/inference.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/inference.lux index c278c1065..552216119 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/inference.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/inference.lux @@ -26,23 +26,23 @@ [meta [archive (#+ Archive)]]]]]]) -(exception: #export (variant-tag-out-of-bounds {size Nat} {tag Tag} {type Type}) +(exception: #export (variant_tag_out_of_bounds {size Nat} {tag Tag} {type Type}) (exception.report ["Tag" (%.nat tag)] ["Variant size" (%.int (.int size))] ["Variant type" (%.type type)])) -(exception: #export (cannot-infer {type Type} {args (List Code)}) +(exception: #export (cannot_infer {type Type} {args (List Code)}) (exception.report ["Type" (%.type type)] ["Arguments" (exception.enumerate %.code args)])) -(exception: #export (cannot-infer-argument {inferred Type} {argument Code}) +(exception: #export (cannot_infer_argument {inferred Type} {argument Code}) (exception.report ["Inferred Type" (%.type inferred)] ["Argument" (%.code argument)])) -(exception: #export (smaller-variant-than-expected {expected Nat} {actual Nat}) +(exception: #export (smaller_variant_than_expected {expected Nat} {actual Nat}) (exception.report ["Expected" (%.int (.int expected))] ["Actual" (%.int (.int actual))])) @@ -51,52 +51,52 @@ [(exception: #export (<name> {type Type}) (%.type type))] - [not-a-variant-type] - [not-a-record-type] - [invalid-type-application] + [not_a_variant_type] + [not_a_record_type] + [invalid_type_application] ) -(def: (replace parameter-idx replacement type) +(def: (replace parameter_idx replacement type) (-> Nat Type Type Type) (case type (#.Primitive name params) - (#.Primitive name (list\map (replace parameter-idx replacement) params)) + (#.Primitive name (list\map (replace parameter_idx replacement) params)) (^template [<tag>] [(<tag> left right) - (<tag> (replace parameter-idx replacement left) - (replace parameter-idx replacement right))]) + (<tag> (replace parameter_idx replacement left) + (replace parameter_idx replacement right))]) ([#.Sum] [#.Product] [#.Function] [#.Apply]) (#.Parameter idx) - (if (n.= parameter-idx idx) + (if (n.= parameter_idx idx) replacement type) (^template [<tag>] [(<tag> env quantified) - (<tag> (list\map (replace parameter-idx replacement) env) - (replace (n.+ 2 parameter-idx) replacement quantified))]) + (<tag> (list\map (replace parameter_idx replacement) env) + (replace (n.+ 2 parameter_idx) replacement quantified))]) ([#.UnivQ] [#.ExQ]) _ type)) -(def: (named-type location id) +(def: (named_type location id) (-> Location Nat Type) (let [name (format "{New Type " (%.location location) " " (%.nat id) "}")] (#.Primitive name (list)))) -(def: new-named-type +(def: new_named_type (Operation Type) (do ///.monad [location (///extension.lift meta.location) - [ex-id _] (//type.with-env check.existential)] - (wrap (named-type location ex-id)))) + [ex_id _] (//type.with_env check.existential)] + (wrap (named_type location ex_id)))) ## Type-inference works by applying some (potentially quantified) type ## to a sequence of values. @@ -120,22 +120,22 @@ (#.UnivQ _) (do ///.monad - [[var-id varT] (//type.with-env check.var)] + [[var_id varT] (//type.with_env check.var)] (general archive analyse (maybe.assume (type.apply (list varT) inferT)) args)) (#.ExQ _) (do {! ///.monad} - [[var-id varT] (//type.with-env check.var) + [[var_id varT] (//type.with_env check.var) output (general archive analyse (maybe.assume (type.apply (list varT) inferT)) args) - bound? (//type.with-env - (check.bound? var-id)) + bound? (//type.with_env + (check.bound? var_id)) _ (if bound? (wrap []) (do ! - [newT new-named-type] - (//type.with-env + [newT new_named_type] + (//type.with_env (check.check varT newT))))] (wrap output)) @@ -145,7 +145,7 @@ (general archive analyse outputT args) #.None - (/.throw ..invalid-type-application inferT)) + (/.throw ..invalid_type_application inferT)) ## Arguments are inferred back-to-front because, by convention, ## Lux functions take the most important arguments *last*, which @@ -157,26 +157,26 @@ (#.Function inputT outputT) (do ///.monad [[outputT' args'A] (general archive analyse outputT args') - argA (<| (/.with-stack ..cannot-infer-argument [inputT argC]) - (//type.with-type inputT) + argA (<| (/.with_stack ..cannot_infer_argument [inputT argC]) + (//type.with_type inputT) (analyse archive argC))] (wrap [outputT' (list& argA args'A)])) - (#.Var infer-id) + (#.Var infer_id) (do ///.monad - [?inferT' (//type.with-env (check.read infer-id))] + [?inferT' (//type.with_env (check.read infer_id))] (case ?inferT' (#.Some inferT') (general archive analyse inferT' args) _ - (/.throw ..cannot-infer [inferT args]))) + (/.throw ..cannot_infer [inferT args]))) _ - (/.throw ..cannot-infer [inferT args])) + (/.throw ..cannot_infer [inferT args])) )) -(def: (substitute-bound target sub) +(def: (substitute_bound target sub) (-> Nat Type Type Type) (function (recur base) (case base @@ -222,22 +222,22 @@ (record' target originalT outputT) #.None - (/.throw ..invalid-type-application inferT)) + (/.throw ..invalid_type_application inferT)) (#.Product _) (///\wrap (|> inferT - (type.function (type.flatten-tuple inferT)) - (substitute-bound target originalT))) + (type.function (type.flatten_tuple inferT)) + (substitute_bound target originalT))) _ - (/.throw ..not-a-record-type inferT))) + (/.throw ..not_a_record_type inferT))) (def: #export (record inferT) (-> Type (Operation Type)) (record' (n.- 2 0) inferT inferT)) ## Turns a variant type into the kind of function type suitable for inference. -(def: #export (variant tag expected-size inferT) +(def: #export (variant tag expected_size inferT) (-> Nat Nat Type (Operation Type)) (loop [depth 0 currentT inferT] @@ -256,11 +256,11 @@ [#.ExQ]) (#.Sum _) - (let [cases (type.flatten-variant currentT) - actual-size (list.size cases) - boundary (dec expected-size)] - (cond (or (n.= expected-size actual-size) - (and (n.> expected-size actual-size) + (let [cases (type.flatten_variant currentT) + actual_size (list.size cases) + boundary (dec expected_size)] + (cond (or (n.= expected_size actual_size) + (and (n.> expected_size actual_size) (n.< boundary tag))) (case (list.nth tag cases) (#.Some caseT) @@ -271,10 +271,10 @@ (replace' currentT))))) #.None - (/.throw ..variant-tag-out-of-bounds [expected-size tag inferT])) + (/.throw ..variant_tag_out_of_bounds [expected_size tag inferT])) - (n.< expected-size actual-size) - (/.throw ..smaller-variant-than-expected [expected-size actual-size]) + (n.< expected_size actual_size) + (/.throw ..smaller_variant_than_expected [expected_size actual_size]) (n.= boundary tag) (let [caseT (type.variant (list.drop boundary cases))] @@ -285,15 +285,15 @@ (replace' currentT)))))) ## else - (/.throw ..variant-tag-out-of-bounds [expected-size tag inferT]))) + (/.throw ..variant_tag_out_of_bounds [expected_size tag inferT]))) (#.Apply inputT funcT) (case (type.apply (list inputT) funcT) (#.Some outputT) - (variant tag expected-size outputT) + (variant tag expected_size outputT) #.None - (/.throw ..invalid-type-application inferT)) + (/.throw ..invalid_type_application inferT)) _ - (/.throw ..not-a-variant-type inferT)))) + (/.throw ..not_a_variant_type inferT)))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/module.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/module.lux index 582e7d860..1d7e5dc27 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/module.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/module.lux @@ -23,11 +23,11 @@ (type: #export Tag Text) -(exception: #export (unknown-module {module Text}) +(exception: #export (unknown_module {module Text}) (exception.report ["Module" module])) -(exception: #export (cannot-declare-tag-twice {module Text} {tag Text}) +(exception: #export (cannot_declare_tag_twice {module Text} {tag Text}) (exception.report ["Module" module] ["Tag" tag])) @@ -35,24 +35,24 @@ (template [<name>] [(exception: #export (<name> {tags (List Text)} {owner Type}) (exception.report - ["Tags" (text.join-with " " tags)] + ["Tags" (text.join_with " " tags)] ["Type" (%.type owner)]))] - [cannot-declare-tags-for-unnamed-type] - [cannot-declare-tags-for-foreign-type] + [cannot_declare_tags_for_unnamed_type] + [cannot_declare_tags_for_foreign_type] ) -(exception: #export (cannot-define-more-than-once {name Name} {already-existing Global}) +(exception: #export (cannot_define_more_than_once {name Name} {already_existing Global}) (exception.report ["Definition" (%.name name)] - ["Original" (case already-existing + ["Original" (case already_existing (#.Alias alias) (format "alias " (%.name alias)) (#.Definition definition) (format "definition " (%.name name)))])) -(exception: #export (can-only-change-state-of-active-module {module Text} {state Module-State}) +(exception: #export (can_only_change_state_of_active_module {module Text} {state Module_State}) (exception.report ["Module" module] ["Desired state" (case state @@ -60,7 +60,7 @@ #.Compiled "Compiled" #.Cached "Cached")])) -(exception: #export (cannot-set-module-annotations-more-than-once {module Text} {old Code} {new Code}) +(exception: #export (cannot_set_module_annotations_more_than_once {module Text} {old Code} {new Code}) (exception.report ["Module" module] ["Old annotations" (%.code old)] @@ -68,40 +68,40 @@ (def: #export (new hash) (-> Nat Module) - {#.module-hash hash - #.module-aliases (list) + {#.module_hash hash + #.module_aliases (list) #.definitions (list) #.imports (list) #.tags (list) #.types (list) - #.module-annotations #.None - #.module-state #.Active}) + #.module_annotations #.None + #.module_state #.Active}) -(def: #export (set-annotations annotations) +(def: #export (set_annotations annotations) (-> Code (Operation Any)) (///extension.lift (do ///.monad - [self-name meta.current-module-name - self meta.current-module] - (case (get@ #.module-annotations self) + [self_name meta.current_module_name + self meta.current_module] + (case (get@ #.module_annotations self) #.None (function (_ state) (#try.Success [(update@ #.modules - (plist.put self-name (set@ #.module-annotations (#.Some annotations) self)) + (plist.put self_name (set@ #.module_annotations (#.Some annotations) self)) state) []])) (#.Some old) - (/.throw' cannot-set-module-annotations-more-than-once [self-name old annotations]))))) + (/.throw' cannot_set_module_annotations_more_than_once [self_name old annotations]))))) (def: #export (import module) (-> Text (Operation Any)) (///extension.lift (do ///.monad - [self-name meta.current-module-name] + [self_name meta.current_module_name] (function (_ state) (#try.Success [(update@ #.modules - (plist.update self-name (update@ #.imports (function (_ current) + (plist.update self_name (update@ #.imports (function (_ current) (if (list.any? (text\= module) current) current @@ -113,10 +113,10 @@ (-> Text Text (Operation Any)) (///extension.lift (do ///.monad - [self-name meta.current-module-name] + [self_name meta.current_module_name] (function (_ state) (#try.Success [(update@ #.modules - (plist.update self-name (update@ #.module-aliases (: (-> (List [Text Text]) (List [Text Text])) + (plist.update self_name (update@ #.module_aliases (: (-> (List [Text Text]) (List [Text Text])) (|>> (#.Cons [alias module]))))) state) []]))))) @@ -135,13 +135,13 @@ (-> Text Global (Operation Any)) (///extension.lift (do ///.monad - [self-name meta.current-module-name - self meta.current-module] + [self_name meta.current_module_name + self meta.current_module] (function (_ state) (case (plist.get name (get@ #.definitions self)) #.None (#try.Success [(update@ #.modules - (plist.put self-name + (plist.put self_name (update@ #.definitions (: (-> (List [Text Global]) (List [Text Global])) (|>> (#.Cons [name definition]))) @@ -149,8 +149,8 @@ state) []]) - (#.Some already-existing) - ((/.throw' ..cannot-define-more-than-once [[self-name name] already-existing]) state)))))) + (#.Some already_existing) + ((/.throw' ..cannot_define_more_than_once [[self_name name] already_existing]) state)))))) (def: #export (create hash name) (-> Nat Text (Operation Any)) @@ -161,76 +161,76 @@ state) []])))) -(def: #export (with-module hash name action) +(def: #export (with_module hash name action) (All [a] (-> Nat Text (Operation a) (Operation [Module a]))) (do ///.monad [_ (create hash name) - output (/.with-current-module name + output (/.with_current_module name action) - module (///extension.lift (meta.find-module name))] + module (///extension.lift (meta.find_module name))] (wrap [module output]))) (template [<setter> <asker> <tag>] - [(def: #export (<setter> module-name) + [(def: #export (<setter> module_name) (-> Text (Operation Any)) (///extension.lift (function (_ state) - (case (|> state (get@ #.modules) (plist.get module-name)) + (case (|> state (get@ #.modules) (plist.get module_name)) (#.Some module) - (let [active? (case (get@ #.module-state module) + (let [active? (case (get@ #.module_state module) #.Active #1 _ #0)] (if active? (#try.Success [(update@ #.modules - (plist.put module-name (set@ #.module-state <tag> module)) + (plist.put module_name (set@ #.module_state <tag> module)) state) []]) - ((/.throw' can-only-change-state-of-active-module [module-name <tag>]) + ((/.throw' can_only_change_state_of_active_module [module_name <tag>]) state))) #.None - ((/.throw' unknown-module module-name) state))))) + ((/.throw' unknown_module module_name) state))))) - (def: #export (<asker> module-name) + (def: #export (<asker> module_name) (-> Text (Operation Bit)) (///extension.lift (function (_ state) - (case (|> state (get@ #.modules) (plist.get module-name)) + (case (|> state (get@ #.modules) (plist.get module_name)) (#.Some module) (#try.Success [state - (case (get@ #.module-state module) + (case (get@ #.module_state module) <tag> #1 _ #0)]) #.None - ((/.throw' unknown-module module-name) state)))))] + ((/.throw' unknown_module module_name) state)))))] - [set-active active? #.Active] - [set-compiled compiled? #.Compiled] - [set-cached cached? #.Cached] + [set_active active? #.Active] + [set_compiled compiled? #.Compiled] + [set_cached cached? #.Cached] ) (template [<name> <tag> <type>] - [(def: (<name> module-name) + [(def: (<name> module_name) (-> Text (Operation <type>)) (///extension.lift (function (_ state) - (case (|> state (get@ #.modules) (plist.get module-name)) + (case (|> state (get@ #.modules) (plist.get module_name)) (#.Some module) (#try.Success [state (get@ <tag> module)]) #.None - ((/.throw' unknown-module module-name) state)))))] + ((/.throw' unknown_module module_name) state)))))] [tags #.tags (List [Text [Nat (List Name) Bit Type]])] [types #.types (List [Text [(List Name) Bit Type]])] - [hash #.module-hash Nat] + [hash #.module_hash Nat] ) -(def: (ensure-undeclared-tags module-name tags) +(def: (ensure_undeclared_tags module_name tags) (-> Text (List Tag) (Operation Any)) (do {! ///.monad} - [bindings (..tags module-name) + [bindings (..tags module_name) _ (monad.map ! (function (_ tag) (case (plist.get tag bindings) @@ -238,37 +238,37 @@ (wrap []) (#.Some _) - (/.throw cannot-declare-tag-twice [module-name tag]))) + (/.throw ..cannot_declare_tag_twice [module_name tag]))) tags)] (wrap []))) -(def: #export (declare-tags tags exported? type) +(def: #export (declare_tags tags exported? type) (-> (List Tag) Bit Type (Operation Any)) (do ///.monad - [self-name (///extension.lift meta.current-module-name) - [type-module type-name] (case type - (#.Named type-name _) - (wrap type-name) + [self_name (///extension.lift meta.current_module_name) + [type_module type_name] (case type + (#.Named type_name _) + (wrap type_name) _ - (/.throw cannot-declare-tags-for-unnamed-type [tags type])) - _ (ensure-undeclared-tags self-name tags) - _ (///.assert cannot-declare-tags-for-foreign-type [tags type] - (text\= self-name type-module))] + (/.throw ..cannot_declare_tags_for_unnamed_type [tags type])) + _ (ensure_undeclared_tags self_name tags) + _ (///.assert cannot_declare_tags_for_foreign_type [tags type] + (text\= self_name type_module))] (///extension.lift (function (_ state) - (case (|> state (get@ #.modules) (plist.get self-name)) + (case (|> state (get@ #.modules) (plist.get self_name)) (#.Some module) - (let [namespaced-tags (list\map (|>> [self-name]) tags)] + (let [namespaced_tags (list\map (|>> [self_name]) tags)] (#try.Success [(update@ #.modules - (plist.update self-name - (|>> (update@ #.tags (function (_ tag-bindings) + (plist.update self_name + (|>> (update@ #.tags (function (_ tag_bindings) (list\fold (function (_ [idx tag] table) - (plist.put tag [idx namespaced-tags exported? type] table)) - tag-bindings + (plist.put tag [idx namespaced_tags exported? type] table)) + tag_bindings (list.enumeration tags)))) - (update@ #.types (plist.put type-name [namespaced-tags exported? type])))) + (update@ #.types (plist.put type_name [namespaced_tags exported? type])))) state) []])) #.None - ((/.throw' unknown-module self-name) state)))))) + ((/.throw' unknown_module self_name) state)))))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/reference.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/reference.lux index a0e141308..a3653935f 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/reference.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/reference.lux @@ -19,43 +19,43 @@ ["#." reference] ["#" phase]]]]]) -(exception: #export (foreign-module-has-not-been-imported {current Text} {foreign Text}) +(exception: #export (foreign_module_has_not_been_imported {current Text} {foreign Text}) (exception.report ["Current" current] ["Foreign" foreign])) -(exception: #export (definition-has-not-been-exported {definition Name}) +(exception: #export (definition_has_not_been_exported {definition Name}) (exception.report ["Definition" (%.name definition)])) -(def: (definition def-name) +(def: (definition def_name) (-> Name (Operation Analysis)) - (with-expansions [<return> (wrap (|> def-name ///reference.constant #/.Reference))] + (with_expansions [<return> (wrap (|> def_name ///reference.constant #/.Reference))] (do {! ///.monad} - [constant (///extension.lift (meta.find-def def-name))] + [constant (///extension.lift (meta.find_def def_name))] (case constant - (#.Left real-def-name) - (definition real-def-name) + (#.Left real_def_name) + (definition real_def_name) - (#.Right [exported? actualT def-anns _]) + (#.Right [exported? actualT def_anns _]) (do ! [_ (//type.infer actualT) - (^@ def-name [::module ::name]) (///extension.lift (meta.normalize def-name)) - current (///extension.lift meta.current-module-name)] + (^@ def_name [::module ::name]) (///extension.lift (meta.normalize def_name)) + current (///extension.lift meta.current_module_name)] (if (text\= current ::module) <return> (if exported? (do ! - [imported! (///extension.lift (meta.imported-by? ::module current))] + [imported! (///extension.lift (meta.imported_by? ::module current))] (if imported! <return> - (/.throw foreign-module-has-not-been-imported [current ::module]))) - (/.throw definition-has-not-been-exported def-name)))))))) + (/.throw foreign_module_has_not_been_imported [current ::module]))) + (/.throw definition_has_not_been_exported def_name)))))))) -(def: (variable var-name) +(def: (variable var_name) (-> Text (Operation (Maybe Analysis))) (do {! ///.monad} - [?var (//scope.find var-name)] + [?var (//scope.find var_name)] (case ?var (#.Some [actualT ref]) (do ! @@ -68,17 +68,17 @@ (def: #export (reference reference) (-> Name (Operation Analysis)) (case reference - ["" simple-name] + ["" simple_name] (do {! ///.monad} - [?var (variable simple-name)] + [?var (variable simple_name)] (case ?var (#.Some varA) (wrap varA) #.None (do ! - [this-module (///extension.lift meta.current-module-name)] - (definition [this-module simple-name])))) + [this_module (///extension.lift meta.current_module_name)] + (definition [this_module simple_name])))) _ (definition reference))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/scope.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/scope.lux index ef4ae5189..beee6a1b7 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/scope.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/scope.lux @@ -4,7 +4,7 @@ monad] [control ["." try] - ["ex" exception (#+ exception:)]] + ["." exception (#+ exception:)]] [data ["." text ("#\." equivalence)] ["." maybe ("#\." monad)] @@ -50,9 +50,9 @@ (loop [idx 0 mappings (get@ [#.captured #.mappings] scope)] (case mappings - (#.Cons [_name [_source-type _source-ref]] mappings') + (#.Cons [_name [_source_type _source_ref]] mappings') (if (text\= name _name) - (#.Some [_source-type (#variable.Foreign idx)]) + (#.Some [_source_type (#variable.Foreign idx)]) (recur (inc idx) mappings')) #.Nil @@ -78,46 +78,46 @@ (function (_ state) (let [[inner outer] (|> state (get@ #.scopes) - (list.split-with (|>> (reference? name) not)))] + (list.split_with (|>> (reference? name) not)))] (case outer #.Nil (#.Right [state #.None]) - (#.Cons top-outer _) - (let [[ref-type init-ref] (maybe.default (undefined) - (..reference name top-outer)) + (#.Cons top_outer _) + (let [[ref_type init_ref] (maybe.default (undefined) + (..reference name top_outer)) [ref inner'] (list\fold (: (-> Scope [Variable (List Scope)] [Variable (List Scope)]) (function (_ scope ref+inner) [(#variable.Foreign (get@ [#.captured #.counter] scope)) (#.Cons (update@ #.captured (: (-> Foreign Foreign) (|>> (update@ #.counter inc) - (update@ #.mappings (plist.put name [ref-type (product.left ref+inner)])))) + (update@ #.mappings (plist.put name [ref_type (product.left ref+inner)])))) scope) (product.right ref+inner))])) - [init-ref #.Nil] + [init_ref #.Nil] (list.reverse inner)) scopes (list\compose inner' outer)] (#.Right [(set@ #.scopes scopes state) - (#.Some [ref-type ref])])) + (#.Some [ref_type ref])])) ))))) -(exception: #export cannot-create-local-binding-without-a-scope) -(exception: #export invalid-scope-alteration) +(exception: #export cannot_create_local_binding_without_a_scope) +(exception: #export invalid_scope_alteration) -(def: #export (with-local [name type] action) +(def: #export (with_local [name type] action) (All [a] (-> [Text Type] (Operation a) (Operation a))) (function (_ [bundle state]) (case (get@ #.scopes state) (#.Cons head tail) - (let [old-mappings (get@ [#.locals #.mappings] head) - new-var-id (get@ [#.locals #.counter] head) - new-head (update@ #.locals + (let [old_mappings (get@ [#.locals #.mappings] head) + new_var_id (get@ [#.locals #.counter] head) + new_head (update@ #.locals (: (-> Local Local) (|>> (update@ #.counter inc) - (update@ #.mappings (plist.put name [type new-var-id])))) + (update@ #.mappings (plist.put name [type new_var_id])))) head)] - (case (///.run' [bundle (set@ #.scopes (#.Cons new-head tail) state)] + (case (///.run' [bundle (set@ #.scopes (#.Cons new_head tail) state)] action) (#try.Success [[bundle' state'] output]) (case (get@ #.scopes state') @@ -128,43 +128,43 @@ output])) _ - (ex.throw invalid-scope-alteration [])) + (exception.throw ..invalid_scope_alteration [])) (#try.Failure error) (#try.Failure error))) _ - (ex.throw cannot-create-local-binding-without-a-scope [])) + (exception.throw ..cannot_create_local_binding_without_a_scope [])) )) -(template [<name> <val-type>] +(template [<name> <val_type>] [(def: <name> - (Bindings Text [Type <val-type>]) + (Bindings Text [Type <val_type>]) {#.counter 0 #.mappings (list)})] - [init-locals Nat] - [init-captured Variable] + [init_locals Nat] + [init_captured Variable] ) -(def: (scope parent-name child-name) +(def: (scope parent_name child_name) (-> (List Text) Text Scope) - {#.name (list& child-name parent-name) + {#.name (list& child_name parent_name) #.inner 0 - #.locals init-locals - #.captured init-captured}) + #.locals init_locals + #.captured init_captured}) -(def: #export (with-scope name action) +(def: #export (with_scope name action) (All [a] (-> Text (Operation a) (Operation a))) (function (_ [bundle state]) - (let [parent-name (case (get@ #.scopes state) + (let [parent_name (case (get@ #.scopes state) #.Nil (list) (#.Cons top _) (get@ #.name top))] (case (action [bundle (update@ #.scopes - (|>> (#.Cons (scope parent-name name))) + (|>> (#.Cons (scope parent_name name))) state)]) (#try.Success [[bundle' state'] output]) (#try.Success [[bundle' (update@ #.scopes @@ -176,9 +176,9 @@ (#try.Failure error))) )) -(exception: #export cannot-get-next-reference-when-there-is-no-scope) +(exception: #export cannot_get_next_reference_when_there_is_no_scope) -(def: #export next-local +(def: #export next_local (Operation Register) (///extension.lift (function (_ state) @@ -187,9 +187,9 @@ (#try.Success [state (get@ [#.locals #.counter] top)]) #.Nil - (ex.throw cannot-get-next-reference-when-there-is-no-scope []))))) + (exception.throw ..cannot_get_next_reference_when_there_is_no_scope []))))) -(def: (ref-to-variable ref) +(def: (ref_to_variable ref) (-> Ref Variable) (case ref (#.Local register) @@ -202,4 +202,4 @@ (-> Scope (List Variable)) (|> scope (get@ [#.captured #.mappings]) - (list\map (function (_ [_ [_ ref]]) (ref-to-variable ref))))) + (list\map (function (_ [_ [_ ref]]) (ref_to_variable ref))))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/structure.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/structure.lux index 49ba590f1..fb5df2084 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/structure.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/structure.lux @@ -34,7 +34,7 @@ [meta [archive (#+ Archive)]]]]]]) -(exception: #export (invalid-variant-type {type Type} {tag Tag} {code Code}) +(exception: #export (invalid_variant_type {type Type} {tag Tag} {code Code}) (ex.report ["Type" (%.type type)] ["Tag" (%.nat tag)] ["Expression" (%.code code)])) @@ -44,11 +44,11 @@ (ex.report ["Type" (%.type type)] ["Expression" (%.code (` [(~+ members)]))]))] - [invalid-tuple-type] - [cannot-analyse-tuple] + [invalid_tuple_type] + [cannot_analyse_tuple] ) -(exception: #export (not-a-quantified-type {type Type}) +(exception: #export (not_a_quantified_type {type Type}) (%.type type)) (template [<name>] @@ -57,11 +57,11 @@ ["Tag" (%.nat tag)] ["Expression" (%.code code)]))] - [cannot-analyse-variant] - [cannot-infer-numeric-tag] + [cannot_analyse_variant] + [cannot_infer_numeric_tag] ) -(exception: #export (record-keys-must-be-tags {key Code} {record (List [Code Code])}) +(exception: #export (record_keys_must_be_tags {key Code} {record (List [Code Code])}) (ex.report ["Key" (%.code key)] ["Record" (%.code (code.record record))])) @@ -72,14 +72,14 @@ [(code.tag keyI) valC]) record)))]))] - [cannot-repeat-tag] + [cannot_repeat_tag] ) -(exception: #export (tag-does-not-belong-to-record {key Name} {type Type}) +(exception: #export (tag_does_not_belong_to_record {key Name} {type Type}) (ex.report ["Tag" (%.code (code.tag key))] ["Type" (%.type type)])) -(exception: #export (record-size-mismatch {expected Nat} {actual Nat} {type Type} {record (List [Name Code])}) +(exception: #export (record_size_mismatch {expected Nat} {actual Nat} {type Type} {record (List [Name Code])}) (ex.report ["Expected" (%.nat expected)] ["Actual" (%.nat actual)] ["Type" (%.type type)] @@ -93,131 +93,131 @@ (let [tag (/.tag lefts right?)] (function (recur valueC) (do {! ///.monad} - [expectedT (///extension.lift meta.expected-type) - expectedT' (//type.with-env + [expectedT (///extension.lift meta.expected_type) + expectedT' (//type.with_env (check.clean expectedT))] - (/.with-stack ..cannot-analyse-variant [expectedT' tag valueC] + (/.with_stack ..cannot_analyse_variant [expectedT' tag valueC] (case expectedT (#.Sum _) - (let [flat (type.flatten-variant expectedT)] + (let [flat (type.flatten_variant expectedT)] (case (list.nth tag flat) - (#.Some variant-type) + (#.Some variant_type) (do ! - [valueA (//type.with-type variant-type + [valueA (//type.with_type variant_type (analyse archive valueC))] (wrap (/.variant [lefts right? valueA]))) #.None - (/.throw //inference.variant-tag-out-of-bounds [(list.size flat) tag expectedT]))) + (/.throw //inference.variant_tag_out_of_bounds [(list.size flat) tag expectedT]))) (#.Named name unnamedT) - (//type.with-type unnamedT + (//type.with_type unnamedT (recur valueC)) (#.Var id) (do ! - [?expectedT' (//type.with-env + [?expectedT' (//type.with_env (check.read id))] (case ?expectedT' (#.Some expectedT') - (//type.with-type expectedT' + (//type.with_type expectedT' (recur valueC)) ## Cannot do inference when the tag is numeric. ## This is because there is no way of knowing how many ## cases the inferred sum type would have. _ - (/.throw ..cannot-infer-numeric-tag [expectedT tag valueC]))) + (/.throw ..cannot_infer_numeric_tag [expectedT tag valueC]))) (^template [<tag> <instancer>] [(<tag> _) (do ! - [[instance-id instanceT] (//type.with-env <instancer>)] - (//type.with-type (maybe.assume (type.apply (list instanceT) expectedT)) + [[instance_id instanceT] (//type.with_env <instancer>)] + (//type.with_type (maybe.assume (type.apply (list instanceT) expectedT)) (recur valueC)))]) ([#.UnivQ check.existential] [#.ExQ check.var]) (#.Apply inputT funT) (case funT - (#.Var funT-id) + (#.Var funT_id) (do ! - [?funT' (//type.with-env (check.read funT-id))] + [?funT' (//type.with_env (check.read funT_id))] (case ?funT' (#.Some funT') - (//type.with-type (#.Apply inputT funT') + (//type.with_type (#.Apply inputT funT') (recur valueC)) _ - (/.throw ..invalid-variant-type [expectedT tag valueC]))) + (/.throw ..invalid_variant_type [expectedT tag valueC]))) _ (case (type.apply (list inputT) funT) (#.Some outputT) - (//type.with-type outputT + (//type.with_type outputT (recur valueC)) #.None - (/.throw ..not-a-quantified-type funT))) + (/.throw ..not_a_quantified_type funT))) _ - (/.throw ..invalid-variant-type [expectedT tag valueC]))))))) + (/.throw ..invalid_variant_type [expectedT tag valueC]))))))) -(def: (typed-product archive analyse members) +(def: (typed_product archive analyse members) (-> Archive Phase (List Code) (Operation Analysis)) (do {! ///.monad} - [expectedT (///extension.lift meta.expected-type) + [expectedT (///extension.lift meta.expected_type) membersA+ (: (Operation (List Analysis)) - (loop [membersT+ (type.flatten-tuple expectedT) + (loop [membersT+ (type.flatten_tuple expectedT) membersC+ members] (case [membersT+ membersC+] [(#.Cons memberT #.Nil) _] - (//type.with-type memberT + (//type.with_type memberT (\ ! map (|>> list) (analyse archive (code.tuple membersC+)))) [_ (#.Cons memberC #.Nil)] - (//type.with-type (type.tuple membersT+) + (//type.with_type (type.tuple membersT+) (\ ! map (|>> list) (analyse archive memberC))) [(#.Cons memberT membersT+') (#.Cons memberC membersC+')] (do ! - [memberA (//type.with-type memberT + [memberA (//type.with_type memberT (analyse archive memberC)) memberA+ (recur membersT+' membersC+')] (wrap (#.Cons memberA memberA+))) _ - (/.throw ..cannot-analyse-tuple [expectedT members]))))] + (/.throw ..cannot_analyse_tuple [expectedT members]))))] (wrap (/.tuple membersA+)))) (def: #export (product archive analyse membersC) (-> Archive Phase (List Code) (Operation Analysis)) (do {! ///.monad} - [expectedT (///extension.lift meta.expected-type)] - (/.with-stack ..cannot-analyse-tuple [expectedT membersC] + [expectedT (///extension.lift meta.expected_type)] + (/.with_stack ..cannot_analyse_tuple [expectedT membersC] (case expectedT (#.Product _) - (..typed-product archive analyse membersC) + (..typed_product archive analyse membersC) (#.Named name unnamedT) - (//type.with-type unnamedT + (//type.with_type unnamedT (product archive analyse membersC)) (#.Var id) (do ! - [?expectedT' (//type.with-env + [?expectedT' (//type.with_env (check.read id))] (case ?expectedT' (#.Some expectedT') - (//type.with-type expectedT' + (//type.with_type expectedT' (product archive analyse membersC)) _ ## Must do inference... (do ! - [membersTA (monad.map ! (|>> (analyse archive) //type.with-inference) + [membersTA (monad.map ! (|>> (analyse archive) //type.with_inference) membersC) - _ (//type.with-env + _ (//type.with_env (check.check expectedT (type.tuple (list\map product.left membersTA))))] (wrap (/.tuple (list\map product.right membersTA)))))) @@ -225,50 +225,50 @@ (^template [<tag> <instancer>] [(<tag> _) (do ! - [[instance-id instanceT] (//type.with-env <instancer>)] - (//type.with-type (maybe.assume (type.apply (list instanceT) expectedT)) + [[instance_id instanceT] (//type.with_env <instancer>)] + (//type.with_type (maybe.assume (type.apply (list instanceT) expectedT)) (product archive analyse membersC)))]) ([#.UnivQ check.existential] [#.ExQ check.var]) (#.Apply inputT funT) (case funT - (#.Var funT-id) + (#.Var funT_id) (do ! - [?funT' (//type.with-env (check.read funT-id))] + [?funT' (//type.with_env (check.read funT_id))] (case ?funT' (#.Some funT') - (//type.with-type (#.Apply inputT funT') + (//type.with_type (#.Apply inputT funT') (product archive analyse membersC)) _ - (/.throw ..invalid-tuple-type [expectedT membersC]))) + (/.throw ..invalid_tuple_type [expectedT membersC]))) _ (case (type.apply (list inputT) funT) (#.Some outputT) - (//type.with-type outputT + (//type.with_type outputT (product archive analyse membersC)) #.None - (/.throw ..not-a-quantified-type funT))) + (/.throw ..not_a_quantified_type funT))) _ - (/.throw ..invalid-tuple-type [expectedT membersC]) + (/.throw ..invalid_tuple_type [expectedT membersC]) )))) -(def: #export (tagged-sum analyse tag archive valueC) +(def: #export (tagged_sum analyse tag archive valueC) (-> Phase Name Phase) (do {! ///.monad} [tag (///extension.lift (meta.normalize tag)) - [idx group variantT] (///extension.lift (meta.resolve-tag tag)) - #let [case-size (list.size group) - [lefts right?] (/.choice case-size idx)] - expectedT (///extension.lift meta.expected-type)] + [idx group variantT] (///extension.lift (meta.resolve_tag tag)) + #let [case_size (list.size group) + [lefts right?] (/.choice case_size idx)] + expectedT (///extension.lift meta.expected_type)] (case expectedT (#.Var _) (do ! - [inferenceT (//inference.variant idx case-size variantT) + [inferenceT (//inference.variant idx case_size variantT) [inferredT valueA+] (//inference.general archive analyse inferenceT (list valueC))] (wrap (/.variant [lefts right? (|> valueA+ list.head maybe.assume)]))) @@ -290,7 +290,7 @@ (wrap [key val])) _ - (/.throw ..record-keys-must-be-tags [key record]))) + (/.throw ..record_keys_must_be_tags [key record]))) record)) ## Lux already possesses the means to analyse tuples, so @@ -299,21 +299,21 @@ (def: #export (order record) (-> (List [Name Code]) (Operation [(List Code) Type])) (case record - ## empty-record = empty-tuple = unit = [] + ## empty_record = empty_tuple = unit = [] #.Nil (\ ///.monad wrap [(list) Any]) - (#.Cons [head-k head-v] _) + (#.Cons [head_k head_v] _) (do {! ///.monad} - [head-k (///extension.lift (meta.normalize head-k)) - [_ tag-set recordT] (///extension.lift (meta.resolve-tag head-k)) - #let [size-record (list.size record) - size-ts (list.size tag-set)] - _ (if (n.= size-ts size-record) + [head_k (///extension.lift (meta.normalize head_k)) + [_ tag_set recordT] (///extension.lift (meta.resolve_tag head_k)) + #let [size_record (list.size record) + size_ts (list.size tag_set)] + _ (if (n.= size_ts size_record) (wrap []) - (/.throw ..record-size-mismatch [size-ts size-record recordT record])) - #let [tuple-range (list.indices size-ts) - tag->idx (dictionary.from-list name.hash (list.zip/2 tag-set tuple-range))] + (/.throw ..record_size_mismatch [size_ts size_record recordT record])) + #let [tuple_range (list.indices size_ts) + tag->idx (dictionary.from_list name.hash (list.zip/2 tag_set tuple_range))] idx->val (monad.fold ! (function (_ [key val] idx->val) (do ! @@ -321,17 +321,17 @@ (case (dictionary.get key tag->idx) (#.Some idx) (if (dictionary.key? idx->val idx) - (/.throw ..cannot-repeat-tag [key record]) + (/.throw ..cannot_repeat_tag [key record]) (wrap (dictionary.put idx val idx->val))) #.None - (/.throw ..tag-does-not-belong-to-record [key recordT])))) + (/.throw ..tag_does_not_belong_to_record [key recordT])))) (: (Dictionary Nat Code) (dictionary.new n.hash)) record) - #let [ordered-tuple (list\map (function (_ idx) (maybe.assume (dictionary.get idx idx->val))) - tuple-range)]] - (wrap [ordered-tuple recordT])) + #let [ordered_tuple (list\map (function (_ idx) (maybe.assume (dictionary.get idx idx->val))) + tuple_range)]] + (wrap [ordered_tuple recordT])) )) (def: #export (record archive analyse members) @@ -347,7 +347,7 @@ (do {! ///.monad} [members (normalize members) [membersC recordT] (order members) - expectedT (///extension.lift meta.expected-type)] + expectedT (///extension.lift meta.expected_type)] (case expectedT (#.Var _) (do ! diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/directive.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/directive.lux index d06acc314..7176b3c3a 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/directive.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/directive.lux @@ -21,19 +21,19 @@ [/// ["//" phase]]]]) -(exception: #export (not-a-directive {code Code}) +(exception: #export (not_a_directive {code Code}) (exception.report ["Directive" (%.code code)])) -(exception: #export (invalid-macro-call {code Code}) +(exception: #export (invalid_macro_call {code Code}) (exception.report ["Code" (%.code code)])) -(exception: #export (macro-was-not-found {name Name}) +(exception: #export (macro_was_not_found {name Name}) (exception.report ["Name" (%.name name)])) -(with-expansions [<lux_def_module> (as-is [|form-location| (#.Form (list& [|text-location| (#.Text "lux def module")] annotations))])] +(with_expansions [<lux_def_module> (as_is [|form_location| (#.Form (list& [|text_location| (#.Text "lux def module")] annotations))])] (def: #export (phase expander) (-> Expander Phase) (let [analyze (//analysis.phase expander)] @@ -44,24 +44,24 @@ (^ [_ (#.Form (list& macro inputs))]) (do {! //.monad} - [expansion (/.lift-analysis + [expansion (/.lift_analysis (do ! - [macroA (//analysis/type.with-type Macro + [macroA (//analysis/type.with_type Macro (analyze archive macro))] (case macroA - (^ (///analysis.constant macro-name)) + (^ (///analysis.constant macro_name)) (do ! - [?macro (//extension.lift (meta.find-macro macro-name)) + [?macro (//extension.lift (meta.find_macro macro_name)) macro (case ?macro (#.Some macro) (wrap macro) #.None - (//.throw ..macro-was-not-found macro-name))] - (//extension.lift (///analysis/macro.expand expander macro-name macro inputs))) + (//.throw ..macro_was_not_found macro_name))] + (//extension.lift (///analysis/macro.expand expander macro_name macro inputs))) _ - (//.throw ..invalid-macro-call code))))] + (//.throw ..invalid_macro_call code))))] (case expansion (^ (list& <lux_def_module> referrals)) (|> (recur archive <lux_def_module>) @@ -70,7 +70,7 @@ _ (|> expansion (monad.map ! (recur archive)) - (\ ! map (list\fold /.merge-requirements /.no-requirements))))) + (\ ! map (list\fold /.merge_requirements /.no_requirements))))) _ - (//.throw ..not-a-directive code)))))) + (//.throw ..not_a_directive code)))))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux index 78a128fe5..8a4ef09d5 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux @@ -35,8 +35,8 @@ ["." reflection] ["." descriptor] ["." signature] - ["#-." parser] - ["#-." alias (#+ Aliasing)] + ["#_." parser] + ["#_." alias (#+ Aliasing)] [".T" lux (#+ Mapping)]]]]] ["." // #_ ["#." lux (#+ custom)] @@ -63,13 +63,13 @@ (def: signature (|>> jvm.signature signature.signature)) -(def: object-class External "java.lang.Object") +(def: object_class External "java.lang.Object") -(def: inheritance-relationship-type-name "_jvm_inheritance") -(def: #export (inheritance-relationship-type class super-class super-interfaces) +(def: inheritance_relationship_type_name "_jvm_inheritance") +(def: #export (inheritance_relationship_type class super_class super_interfaces) (-> .Type .Type (List .Type) .Type) - (#.Primitive ..inheritance-relationship-type-name - (list& class super-class super-interfaces))) + (#.Primitive ..inheritance_relationship_type_name + (list& class super_class super_interfaces))) ## TODO: Get rid of this template block and use the definition in ## lux/host.jvm.lux ASAP @@ -106,7 +106,7 @@ (Parser Member) ($_ <>.and <c>.text <c>.text)) -(type: Method-Signature +(type: Method_Signature {#method .Type #exceptions (List .Type)}) @@ -115,10 +115,10 @@ (exception.report ["Type" (%.type type)]))] - [non-object] - [non-array] - [non-parameter] - [non-jvm-type] + [non_object] + [non_array] + [non_parameter] + [non_jvm_type] ) (template [<name>] @@ -126,12 +126,12 @@ (exception.report ["Class/type" (%.text class)]))] - [non-interface] - [non-throwable] - [primitives-are-not-objects] + [non_interface] + [non_throwable] + [primitives_are_not_objects] ) -(exception: #export (cannot-set-a-final-field {field Text} {class External}) +(exception: #export (cannot_set_a_final_field {field Text} {class External}) (exception.report ["Field" (%.text field)] ["Class" (%.text class)])) @@ -140,18 +140,18 @@ [(exception: #export (<name> {class External} {method Text} {inputsJT (List (Type Value))} - {hints (List Method-Signature)}) + {hints (List Method_Signature)}) (exception.report ["Class" class] ["Method" method] ["Arguments" (exception.enumerate ..signature inputsJT)] ["Hints" (exception.enumerate %.type (list\map product.left hints))]))] - [no-candidates] - [too-many-candidates] + [no_candidates] + [too_many_candidates] ) -(exception: #export (cannot-cast {from .Type} {to .Type} {value Code}) +(exception: #export (cannot_cast {from .Type} {to .Type} {value Code}) (exception.report ["From" (%.type from)] ["To" (%.type to)] @@ -161,11 +161,11 @@ [(exception: #export (<name> {message Text}) message)] - [primitives-cannot-have-type-parameters] + [primitives_cannot_have_type_parameters] - [cannot-possibly-be-an-instance] + [cannot_possibly_be_an_instance] - [unknown-type-var] + [unknown_type_var] ) (def: bundle::conversion @@ -257,34 +257,34 @@ [(reflection.reflection reflection.float) [box.float jvm.float]] [(reflection.reflection reflection.double) [box.double jvm.double]] [(reflection.reflection reflection.char) [box.char jvm.char]]) - (dictionary.from-list text.hash))) + (dictionary.from_list text.hash))) -(def: (jvm-type luxT) +(def: (jvm_type luxT) (-> .Type (Operation (Type Value))) (case luxT (#.Named name anonymousT) - (jvm-type anonymousT) + (jvm_type anonymousT) (#.Apply inputT abstractionT) (case (type.apply (list inputT) abstractionT) (#.Some outputT) - (jvm-type outputT) + (jvm_type outputT) #.None - (/////analysis.throw ..non-jvm-type luxT)) + (/////analysis.throw ..non_jvm_type luxT)) - (^ (#.Primitive (static array.type-name) (list elemT))) - (phase\map jvm.array (jvm-type elemT)) + (^ (#.Primitive (static array.type_name) (list elemT))) + (phase\map jvm.array (jvm_type elemT)) (#.Primitive class parametersT) (case (dictionary.get class ..boxes) - (#.Some [_ primitive-type]) + (#.Some [_ primitive_type]) (case parametersT #.Nil - (phase\wrap primitive-type) + (phase\wrap primitive_type) _ - (/////analysis.throw ..primitives-cannot-have-type-parameters class)) + (/////analysis.throw ..primitives_cannot_have_type_parameters class)) #.None (do {! phase.monad} @@ -292,108 +292,108 @@ (monad.map ! (function (_ parameterT) (do phase.monad - [parameterJT (jvm-type parameterT)] - (case (jvm-parser.parameter? parameterJT) + [parameterJT (jvm_type parameterT)] + (case (jvm_parser.parameter? parameterJT) (#.Some parameterJT) (wrap parameterJT) #.None - (/////analysis.throw ..non-parameter parameterT)))) + (/////analysis.throw ..non_parameter parameterT)))) parametersT))] (wrap (jvm.class class parametersJT)))) (#.Ex _) - (phase\wrap (jvm.class ..object-class (list))) + (phase\wrap (jvm.class ..object_class (list))) _ - (/////analysis.throw ..non-jvm-type luxT))) + (/////analysis.throw ..non_jvm_type luxT))) -(def: (jvm-array-type objectT) +(def: (jvm_array_type objectT) (-> .Type (Operation (Type Array))) (do phase.monad - [objectJ (jvm-type objectT)] + [objectJ (jvm_type objectT)] (|> objectJ ..signature - (<t>.run jvm-parser.array) + (<t>.run jvm_parser.array) phase.lift))) -(def: (primitive-array-length-handler primitive-type) +(def: (primitive_array_length_handler primitive_type) (-> (Type Primitive) Handler) - (function (_ extension-name analyse archive args) + (function (_ extension_name analyse archive args) (case args (^ (list arrayC)) (do phase.monad [_ (typeA.infer ..int) - arrayA (typeA.with-type (#.Primitive (|> (jvm.array primitive-type) + arrayA (typeA.with_type (#.Primitive (|> (jvm.array primitive_type) ..reflection) (list)) (analyse archive arrayC))] - (wrap (#/////analysis.Extension extension-name (list arrayA)))) + (wrap (#/////analysis.Extension extension_name (list arrayA)))) _ - (/////analysis.throw ///.incorrect-arity [extension-name 1 (list.size args)])))) + (/////analysis.throw ///.incorrect_arity [extension_name 1 (list.size args)])))) (def: array::length::object Handler - (function (_ extension-name analyse archive args) + (function (_ extension_name analyse archive args) (case args (^ (list arrayC)) (do phase.monad [_ (typeA.infer ..int) - [var-id varT] (typeA.with-env check.var) - arrayA (typeA.with-type (.type (array.Array varT)) + [var_id varT] (typeA.with_env check.var) + arrayA (typeA.with_type (.type (array.Array varT)) (analyse archive arrayC)) - varT (typeA.with-env (check.clean varT)) - arrayJT (jvm-array-type (.type (array.Array varT)))] - (wrap (#/////analysis.Extension extension-name (list (/////analysis.text (..signature arrayJT)) + varT (typeA.with_env (check.clean varT)) + arrayJT (jvm_array_type (.type (array.Array varT)))] + (wrap (#/////analysis.Extension extension_name (list (/////analysis.text (..signature arrayJT)) arrayA)))) _ - (/////analysis.throw ///.incorrect-arity [extension-name 1 (list.size args)])))) + (/////analysis.throw ///.incorrect_arity [extension_name 1 (list.size args)])))) -(def: (new-primitive-array-handler primitive-type) +(def: (new_primitive_array_handler primitive_type) (-> (Type Primitive) Handler) - (function (_ extension-name analyse archive args) + (function (_ extension_name analyse archive args) (case args (^ (list lengthC)) (do phase.monad - [lengthA (typeA.with-type ..int + [lengthA (typeA.with_type ..int (analyse archive lengthC)) - _ (typeA.infer (#.Primitive (|> (jvm.array primitive-type) ..reflection) + _ (typeA.infer (#.Primitive (|> (jvm.array primitive_type) ..reflection) (list)))] - (wrap (#/////analysis.Extension extension-name (list lengthA)))) + (wrap (#/////analysis.Extension extension_name (list lengthA)))) _ - (/////analysis.throw ///.incorrect-arity [extension-name 1 (list.size args)])))) + (/////analysis.throw ///.incorrect_arity [extension_name 1 (list.size args)])))) (def: array::new::object Handler - (function (_ extension-name analyse archive args) + (function (_ extension_name analyse archive args) (case args (^ (list lengthC)) (do phase.monad - [lengthA (typeA.with-type ..int + [lengthA (typeA.with_type ..int (analyse archive lengthC)) - expectedT (///.lift meta.expected-type) - expectedJT (jvm-array-type expectedT) - elementJT (case (jvm-parser.array? expectedJT) + expectedT (///.lift meta.expected_type) + expectedJT (jvm_array_type expectedT) + elementJT (case (jvm_parser.array? expectedJT) (#.Some elementJT) (wrap elementJT) #.None - (/////analysis.throw ..non-array expectedT))] - (wrap (#/////analysis.Extension extension-name (list (/////analysis.text (..signature elementJT)) + (/////analysis.throw ..non_array expectedT))] + (wrap (#/////analysis.Extension extension_name (list (/////analysis.text (..signature elementJT)) lengthA)))) _ - (/////analysis.throw ///.incorrect-arity [extension-name 1 (list.size args)])))) + (/////analysis.throw ///.incorrect_arity [extension_name 1 (list.size args)])))) -(def: (check-parameter objectT) +(def: (check_parameter objectT) (-> .Type (Operation (Type Parameter))) (case objectT - (^ (#.Primitive (static array.type-name) + (^ (#.Primitive (static array.type_name) (list elementT))) - (/////analysis.throw ..non-parameter objectT) + (/////analysis.throw ..non_parameter objectT) (#.Primitive name parameters) (`` (cond (or (~~ (template [<type>] @@ -407,39 +407,39 @@ [jvm.float] [jvm.double] [jvm.char])) - (text.starts-with? descriptor.array-prefix name)) - (/////analysis.throw ..non-parameter objectT) + (text.starts_with? descriptor.array_prefix name)) + (/////analysis.throw ..non_parameter objectT) ## else (phase\wrap (jvm.class name (list))))) (#.Named name anonymous) - (check-parameter anonymous) + (check_parameter anonymous) (^template [<tag>] [(<tag> id) - (phase\wrap (jvm.class ..object-class (list)))]) + (phase\wrap (jvm.class ..object_class (list)))]) ([#.Var] [#.Ex]) (^template [<tag>] [(<tag> env unquantified) - (check-parameter unquantified)]) + (check_parameter unquantified)]) ([#.UnivQ] [#.ExQ]) (#.Apply inputT abstractionT) (case (type.apply (list inputT) abstractionT) (#.Some outputT) - (check-parameter outputT) + (check_parameter outputT) #.None - (/////analysis.throw ..non-parameter objectT)) + (/////analysis.throw ..non_parameter objectT)) _ - (/////analysis.throw ..non-parameter objectT))) + (/////analysis.throw ..non_parameter objectT))) -(def: (check-jvm objectT) +(def: (check_jvm objectT) (-> .Type (Operation (Type Value))) (case objectT (#.Primitive name #.Nil) @@ -469,144 +469,144 @@ [jvm.double] [jvm.char])) - (text.starts-with? descriptor.array-prefix name) - (let [[_ unprefixed] (maybe.assume (text.split-with descriptor.array-prefix name))] + (text.starts_with? descriptor.array_prefix name) + (let [[_ unprefixed] (maybe.assume (text.split_with descriptor.array_prefix name))] (\ phase.monad map jvm.array - (check-jvm (#.Primitive unprefixed (list))))) + (check_jvm (#.Primitive unprefixed (list))))) ## else (phase\wrap (jvm.class name (list))))) - (^ (#.Primitive (static array.type-name) + (^ (#.Primitive (static array.type_name) (list elementT))) (|> elementT - check-jvm + check_jvm (phase\map jvm.array)) (#.Primitive name parameters) (do {! phase.monad} - [parameters (monad.map ! check-parameter parameters)] + [parameters (monad.map ! check_parameter parameters)] (phase\wrap (jvm.class name parameters))) (#.Named name anonymous) - (check-jvm anonymous) + (check_jvm anonymous) (^template [<tag>] [(<tag> env unquantified) - (check-jvm unquantified)]) + (check_jvm unquantified)]) ([#.UnivQ] [#.ExQ]) (#.Apply inputT abstractionT) (case (type.apply (list inputT) abstractionT) (#.Some outputT) - (check-jvm outputT) + (check_jvm outputT) #.None - (/////analysis.throw ..non-object objectT)) + (/////analysis.throw ..non_object objectT)) _ - (check-parameter objectT))) + (check_parameter objectT))) -(def: (check-object objectT) +(def: (check_object objectT) (-> .Type (Operation External)) (do {! phase.monad} - [name (\ ! map ..reflection (check-jvm objectT))] + [name (\ ! map ..reflection (check_jvm objectT))] (if (dictionary.key? ..boxes name) - (/////analysis.throw ..primitives-are-not-objects [name]) + (/////analysis.throw ..primitives_are_not_objects [name]) (phase\wrap name)))) -(def: (check-return type) +(def: (check_return type) (-> .Type (Operation (Type Return))) (if (is? .Any type) (phase\wrap jvm.void) - (check-jvm type))) + (check_jvm type))) -(def: (read-primitive-array-handler lux-type jvm-type) +(def: (read_primitive_array_handler lux_type jvm_type) (-> .Type (Type Primitive) Handler) - (function (_ extension-name analyse archive args) + (function (_ extension_name analyse archive args) (case args (^ (list idxC arrayC)) (do phase.monad - [_ (typeA.infer lux-type) - idxA (typeA.with-type ..int + [_ (typeA.infer lux_type) + idxA (typeA.with_type ..int (analyse archive idxC)) - arrayA (typeA.with-type (#.Primitive (|> (jvm.array jvm-type) ..reflection) + arrayA (typeA.with_type (#.Primitive (|> (jvm.array jvm_type) ..reflection) (list)) (analyse archive arrayC))] - (wrap (#/////analysis.Extension extension-name (list idxA arrayA)))) + (wrap (#/////analysis.Extension extension_name (list idxA arrayA)))) _ - (/////analysis.throw ///.incorrect-arity [extension-name 2 (list.size args)])))) + (/////analysis.throw ///.incorrect_arity [extension_name 2 (list.size args)])))) (def: array::read::object Handler - (function (_ extension-name analyse archive args) + (function (_ extension_name analyse archive args) (case args (^ (list idxC arrayC)) (do phase.monad - [[var-id varT] (typeA.with-env check.var) + [[var_id varT] (typeA.with_env check.var) _ (typeA.infer varT) - arrayA (typeA.with-type (.type (array.Array varT)) + arrayA (typeA.with_type (.type (array.Array varT)) (analyse archive arrayC)) - varT (typeA.with-env + varT (typeA.with_env (check.clean varT)) - arrayJT (jvm-array-type (.type (array.Array varT))) - idxA (typeA.with-type ..int + arrayJT (jvm_array_type (.type (array.Array varT))) + idxA (typeA.with_type ..int (analyse archive idxC))] - (wrap (#/////analysis.Extension extension-name (list (/////analysis.text (..signature arrayJT)) + (wrap (#/////analysis.Extension extension_name (list (/////analysis.text (..signature arrayJT)) idxA arrayA)))) _ - (/////analysis.throw ///.incorrect-arity [extension-name 2 (list.size args)])))) + (/////analysis.throw ///.incorrect_arity [extension_name 2 (list.size args)])))) -(def: (write-primitive-array-handler lux-type jvm-type) +(def: (write_primitive_array_handler lux_type jvm_type) (-> .Type (Type Primitive) Handler) - (let [array-type (#.Primitive (|> (jvm.array jvm-type) ..reflection) + (let [array_type (#.Primitive (|> (jvm.array jvm_type) ..reflection) (list))] - (function (_ extension-name analyse archive args) + (function (_ extension_name analyse archive args) (case args (^ (list idxC valueC arrayC)) (do phase.monad - [_ (typeA.infer array-type) - idxA (typeA.with-type ..int + [_ (typeA.infer array_type) + idxA (typeA.with_type ..int (analyse archive idxC)) - valueA (typeA.with-type lux-type + valueA (typeA.with_type lux_type (analyse archive valueC)) - arrayA (typeA.with-type array-type + arrayA (typeA.with_type array_type (analyse archive arrayC))] - (wrap (#/////analysis.Extension extension-name (list idxA + (wrap (#/////analysis.Extension extension_name (list idxA valueA arrayA)))) _ - (/////analysis.throw ///.incorrect-arity [extension-name 3 (list.size args)]))))) + (/////analysis.throw ///.incorrect_arity [extension_name 3 (list.size args)]))))) (def: array::write::object Handler - (function (_ extension-name analyse archive args) + (function (_ extension_name analyse archive args) (case args (^ (list idxC valueC arrayC)) (do phase.monad - [[var-id varT] (typeA.with-env check.var) + [[var_id varT] (typeA.with_env check.var) _ (typeA.infer (.type (array.Array varT))) - arrayA (typeA.with-type (.type (array.Array varT)) + arrayA (typeA.with_type (.type (array.Array varT)) (analyse archive arrayC)) - varT (typeA.with-env + varT (typeA.with_env (check.clean varT)) - arrayJT (jvm-array-type (.type (array.Array varT))) - idxA (typeA.with-type ..int + arrayJT (jvm_array_type (.type (array.Array varT))) + idxA (typeA.with_type ..int (analyse archive idxC)) - valueA (typeA.with-type varT + valueA (typeA.with_type varT (analyse archive valueC))] - (wrap (#/////analysis.Extension extension-name (list (/////analysis.text (..signature arrayJT)) + (wrap (#/////analysis.Extension extension_name (list (/////analysis.text (..signature arrayJT)) idxA valueA arrayA)))) _ - (/////analysis.throw ///.incorrect-arity [extension-name 3 (list.size args)])))) + (/////analysis.throw ///.incorrect_arity [extension_name 3 (list.size args)])))) (def: bundle::array Bundle @@ -614,116 +614,116 @@ (|> ///bundle.empty (dictionary.merge (<| (///bundle.prefix "length") (|> ///bundle.empty - (///bundle.install (reflection.reflection reflection.boolean) (primitive-array-length-handler jvm.boolean)) - (///bundle.install (reflection.reflection reflection.byte) (primitive-array-length-handler jvm.byte)) - (///bundle.install (reflection.reflection reflection.short) (primitive-array-length-handler jvm.short)) - (///bundle.install (reflection.reflection reflection.int) (primitive-array-length-handler jvm.int)) - (///bundle.install (reflection.reflection reflection.long) (primitive-array-length-handler jvm.long)) - (///bundle.install (reflection.reflection reflection.float) (primitive-array-length-handler jvm.float)) - (///bundle.install (reflection.reflection reflection.double) (primitive-array-length-handler jvm.double)) - (///bundle.install (reflection.reflection reflection.char) (primitive-array-length-handler jvm.char)) + (///bundle.install (reflection.reflection reflection.boolean) (primitive_array_length_handler jvm.boolean)) + (///bundle.install (reflection.reflection reflection.byte) (primitive_array_length_handler jvm.byte)) + (///bundle.install (reflection.reflection reflection.short) (primitive_array_length_handler jvm.short)) + (///bundle.install (reflection.reflection reflection.int) (primitive_array_length_handler jvm.int)) + (///bundle.install (reflection.reflection reflection.long) (primitive_array_length_handler jvm.long)) + (///bundle.install (reflection.reflection reflection.float) (primitive_array_length_handler jvm.float)) + (///bundle.install (reflection.reflection reflection.double) (primitive_array_length_handler jvm.double)) + (///bundle.install (reflection.reflection reflection.char) (primitive_array_length_handler jvm.char)) (///bundle.install "object" array::length::object)))) (dictionary.merge (<| (///bundle.prefix "new") (|> ///bundle.empty - (///bundle.install (reflection.reflection reflection.boolean) (new-primitive-array-handler jvm.boolean)) - (///bundle.install (reflection.reflection reflection.byte) (new-primitive-array-handler jvm.byte)) - (///bundle.install (reflection.reflection reflection.short) (new-primitive-array-handler jvm.short)) - (///bundle.install (reflection.reflection reflection.int) (new-primitive-array-handler jvm.int)) - (///bundle.install (reflection.reflection reflection.long) (new-primitive-array-handler jvm.long)) - (///bundle.install (reflection.reflection reflection.float) (new-primitive-array-handler jvm.float)) - (///bundle.install (reflection.reflection reflection.double) (new-primitive-array-handler jvm.double)) - (///bundle.install (reflection.reflection reflection.char) (new-primitive-array-handler jvm.char)) + (///bundle.install (reflection.reflection reflection.boolean) (new_primitive_array_handler jvm.boolean)) + (///bundle.install (reflection.reflection reflection.byte) (new_primitive_array_handler jvm.byte)) + (///bundle.install (reflection.reflection reflection.short) (new_primitive_array_handler jvm.short)) + (///bundle.install (reflection.reflection reflection.int) (new_primitive_array_handler jvm.int)) + (///bundle.install (reflection.reflection reflection.long) (new_primitive_array_handler jvm.long)) + (///bundle.install (reflection.reflection reflection.float) (new_primitive_array_handler jvm.float)) + (///bundle.install (reflection.reflection reflection.double) (new_primitive_array_handler jvm.double)) + (///bundle.install (reflection.reflection reflection.char) (new_primitive_array_handler jvm.char)) (///bundle.install "object" array::new::object)))) (dictionary.merge (<| (///bundle.prefix "read") (|> ///bundle.empty - (///bundle.install (reflection.reflection reflection.boolean) (read-primitive-array-handler ..boolean jvm.boolean)) - (///bundle.install (reflection.reflection reflection.byte) (read-primitive-array-handler ..byte jvm.byte)) - (///bundle.install (reflection.reflection reflection.short) (read-primitive-array-handler ..short jvm.short)) - (///bundle.install (reflection.reflection reflection.int) (read-primitive-array-handler ..int jvm.int)) - (///bundle.install (reflection.reflection reflection.long) (read-primitive-array-handler ..long jvm.long)) - (///bundle.install (reflection.reflection reflection.float) (read-primitive-array-handler ..float jvm.float)) - (///bundle.install (reflection.reflection reflection.double) (read-primitive-array-handler ..double jvm.double)) - (///bundle.install (reflection.reflection reflection.char) (read-primitive-array-handler ..char jvm.char)) + (///bundle.install (reflection.reflection reflection.boolean) (read_primitive_array_handler ..boolean jvm.boolean)) + (///bundle.install (reflection.reflection reflection.byte) (read_primitive_array_handler ..byte jvm.byte)) + (///bundle.install (reflection.reflection reflection.short) (read_primitive_array_handler ..short jvm.short)) + (///bundle.install (reflection.reflection reflection.int) (read_primitive_array_handler ..int jvm.int)) + (///bundle.install (reflection.reflection reflection.long) (read_primitive_array_handler ..long jvm.long)) + (///bundle.install (reflection.reflection reflection.float) (read_primitive_array_handler ..float jvm.float)) + (///bundle.install (reflection.reflection reflection.double) (read_primitive_array_handler ..double jvm.double)) + (///bundle.install (reflection.reflection reflection.char) (read_primitive_array_handler ..char jvm.char)) (///bundle.install "object" array::read::object)))) (dictionary.merge (<| (///bundle.prefix "write") (|> ///bundle.empty - (///bundle.install (reflection.reflection reflection.boolean) (write-primitive-array-handler ..boolean jvm.boolean)) - (///bundle.install (reflection.reflection reflection.byte) (write-primitive-array-handler ..byte jvm.byte)) - (///bundle.install (reflection.reflection reflection.short) (write-primitive-array-handler ..short jvm.short)) - (///bundle.install (reflection.reflection reflection.int) (write-primitive-array-handler ..int jvm.int)) - (///bundle.install (reflection.reflection reflection.long) (write-primitive-array-handler ..long jvm.long)) - (///bundle.install (reflection.reflection reflection.float) (write-primitive-array-handler ..float jvm.float)) - (///bundle.install (reflection.reflection reflection.double) (write-primitive-array-handler ..double jvm.double)) - (///bundle.install (reflection.reflection reflection.char) (write-primitive-array-handler ..char jvm.char)) + (///bundle.install (reflection.reflection reflection.boolean) (write_primitive_array_handler ..boolean jvm.boolean)) + (///bundle.install (reflection.reflection reflection.byte) (write_primitive_array_handler ..byte jvm.byte)) + (///bundle.install (reflection.reflection reflection.short) (write_primitive_array_handler ..short jvm.short)) + (///bundle.install (reflection.reflection reflection.int) (write_primitive_array_handler ..int jvm.int)) + (///bundle.install (reflection.reflection reflection.long) (write_primitive_array_handler ..long jvm.long)) + (///bundle.install (reflection.reflection reflection.float) (write_primitive_array_handler ..float jvm.float)) + (///bundle.install (reflection.reflection reflection.double) (write_primitive_array_handler ..double jvm.double)) + (///bundle.install (reflection.reflection reflection.char) (write_primitive_array_handler ..char jvm.char)) (///bundle.install "object" array::write::object)))) ))) (def: object::null Handler - (function (_ extension-name analyse archive args) + (function (_ extension_name analyse archive args) (case args (^ (list)) (do phase.monad - [expectedT (///.lift meta.expected-type) - _ (check-object expectedT)] - (wrap (#/////analysis.Extension extension-name (list)))) + [expectedT (///.lift meta.expected_type) + _ (check_object expectedT)] + (wrap (#/////analysis.Extension extension_name (list)))) _ - (/////analysis.throw ///.incorrect-arity [extension-name 0 (list.size args)])))) + (/////analysis.throw ///.incorrect_arity [extension_name 0 (list.size args)])))) (def: object::null? Handler - (function (_ extension-name analyse archive args) + (function (_ extension_name analyse archive args) (case args (^ (list objectC)) (do phase.monad [_ (typeA.infer Bit) - [objectT objectA] (typeA.with-inference + [objectT objectA] (typeA.with_inference (analyse archive objectC)) - _ (check-object objectT)] - (wrap (#/////analysis.Extension extension-name (list objectA)))) + _ (check_object objectT)] + (wrap (#/////analysis.Extension extension_name (list objectA)))) _ - (/////analysis.throw ///.incorrect-arity [extension-name 1 (list.size args)])))) + (/////analysis.throw ///.incorrect_arity [extension_name 1 (list.size args)])))) (def: object::synchronized Handler - (function (_ extension-name analyse archive args) + (function (_ extension_name analyse archive args) (case args (^ (list monitorC exprC)) (do phase.monad - [[monitorT monitorA] (typeA.with-inference + [[monitorT monitorA] (typeA.with_inference (analyse archive monitorC)) - _ (check-object monitorT) + _ (check_object monitorT) exprA (analyse archive exprC)] - (wrap (#/////analysis.Extension extension-name (list monitorA exprA)))) + (wrap (#/////analysis.Extension extension_name (list monitorA exprA)))) _ - (/////analysis.throw ///.incorrect-arity [extension-name 2 (list.size args)])))) + (/////analysis.throw ///.incorrect_arity [extension_name 2 (list.size args)])))) (def: object::throw Handler - (function (_ extension-name analyse archive args) + (function (_ extension_name analyse archive args) (case args (^ (list exceptionC)) (do phase.monad [_ (typeA.infer Nothing) - [exceptionT exceptionA] (typeA.with-inference + [exceptionT exceptionA] (typeA.with_inference (analyse archive exceptionC)) - exception-class (check-object exceptionT) - ? (phase.lift (reflection!.sub? "java.lang.Throwable" exception-class)) + exception_class (check_object exceptionT) + ? (phase.lift (reflection!.sub? "java.lang.Throwable" exception_class)) _ (: (Operation Any) (if ? (wrap []) - (/////analysis.throw non-throwable exception-class)))] - (wrap (#/////analysis.Extension extension-name (list exceptionA)))) + (/////analysis.throw non_throwable exception_class)))] + (wrap (#/////analysis.Extension extension_name (list exceptionA)))) _ - (/////analysis.throw ///.incorrect-arity [extension-name 1 (list.size args)])))) + (/////analysis.throw ///.incorrect_arity [extension_name 1 (list.size args)])))) (def: object::class Handler - (function (_ extension-name analyse archive args) + (function (_ extension_name analyse archive args) (case args (^ (list classC)) (case classC @@ -731,28 +731,28 @@ (do phase.monad [_ (typeA.infer (#.Primitive "java.lang.Class" (list (#.Primitive class (list))))) _ (phase.lift (reflection!.load class))] - (wrap (#/////analysis.Extension extension-name (list (/////analysis.text class))))) + (wrap (#/////analysis.Extension extension_name (list (/////analysis.text class))))) _ - (/////analysis.throw ///.invalid-syntax [extension-name %.code args])) + (/////analysis.throw ///.invalid_syntax [extension_name %.code args])) _ - (/////analysis.throw ///.incorrect-arity [extension-name 1 (list.size args)])))) + (/////analysis.throw ///.incorrect_arity [extension_name 1 (list.size args)])))) (def: object::instance? Handler (..custom [($_ <>.and <c>.text <c>.any) - (function (_ extension-name analyse archive [sub-class objectC]) + (function (_ extension_name analyse archive [sub_class objectC]) (do phase.monad [_ (typeA.infer Bit) - [objectT objectA] (typeA.with-inference + [objectT objectA] (typeA.with_inference (analyse archive objectC)) - object-class (check-object objectT) - ? (phase.lift (reflection!.sub? object-class sub-class))] + object_class (check_object objectT) + ? (phase.lift (reflection!.sub? object_class sub_class))] (if ? - (wrap (#/////analysis.Extension extension-name (list (/////analysis.text sub-class) objectA))) - (/////analysis.throw cannot-possibly-be-an-instance (format sub-class " !<= " object-class)))))])) + (wrap (#/////analysis.Extension extension_name (list (/////analysis.text sub_class) objectA))) + (/////analysis.throw cannot_possibly_be_an_instance (format sub_class " !<= " object_class)))))])) (import: java/lang/Object ["#::." @@ -808,74 +808,74 @@ (-> Mapping (Type <category>) (Operation .Type)) (case (|> typeJ ..signature (<t>.run (<parser> mapping))) (#try.Success check) - (typeA.with-env + (typeA.with_env check) (#try.Failure error) (phase.fail error)))] - [reflection-type Value luxT.type] - [reflection-return Return luxT.return] + [reflection_type Value luxT.type] + [reflection_return Return luxT.return] ) -(def: (class-candidate-parents from-name fromT to-name to-class) +(def: (class_candidate_parents from_name fromT to_name to_class) (-> External .Type External (java/lang/Class java/lang/Object) (Operation (List [[Text .Type] Bit]))) (do {! phase.monad} - [from-class (phase.lift (reflection!.load from-name)) - mapping (phase.lift (reflection!.correspond from-class fromT))] + [from_class (phase.lift (reflection!.load from_name)) + mapping (phase.lift (reflection!.correspond from_class fromT))] (monad.map ! (function (_ superJT) (do ! [superJT (phase.lift (reflection!.type superJT)) - #let [super-name (|> superJT ..reflection)] - super-class (phase.lift (reflection!.load super-name)) - superT (reflection-type mapping superJT)] - (wrap [[super-name superT] (java/lang/Class::isAssignableFrom super-class to-class)]))) - (case (java/lang/Class::getGenericSuperclass from-class) + #let [super_name (|> superJT ..reflection)] + super_class (phase.lift (reflection!.load super_name)) + superT (reflection_type mapping superJT)] + (wrap [[super_name superT] (java/lang/Class::isAssignableFrom super_class to_class)]))) + (case (java/lang/Class::getGenericSuperclass from_class) (#.Some super) - (list& super (array.to-list (java/lang/Class::getGenericInterfaces from-class))) + (list& super (array.to_list (java/lang/Class::getGenericInterfaces from_class))) #.None - (if (java/lang/reflect/Modifier::isInterface (java/lang/Class::getModifiers from-class)) - (#.Cons (:coerce java/lang/reflect/Type (host.class-for java/lang/Object)) - (array.to-list (java/lang/Class::getGenericInterfaces from-class))) - (array.to-list (java/lang/Class::getGenericInterfaces from-class))))))) + (if (java/lang/reflect/Modifier::isInterface (java/lang/Class::getModifiers from_class)) + (#.Cons (:coerce java/lang/reflect/Type (host.class_for java/lang/Object)) + (array.to_list (java/lang/Class::getGenericInterfaces from_class))) + (array.to_list (java/lang/Class::getGenericInterfaces from_class))))))) -(def: (inheritance-candidate-parents fromT to-class toT fromC) +(def: (inheritance_candidate_parents fromT to_class toT fromC) (-> .Type (java/lang/Class java/lang/Object) .Type Code (Operation (List [[Text .Type] Bit]))) (case fromT - (^ (#.Primitive _ (list& self-classT super-classT super-interfacesT+))) + (^ (#.Primitive _ (list& self_classT super_classT super_interfacesT+))) (monad.map phase.monad (function (_ superT) (do {! phase.monad} - [super-name (\ ! map ..reflection (check-jvm superT)) - super-class (phase.lift (reflection!.load super-name))] - (wrap [[super-name superT] - (java/lang/Class::isAssignableFrom super-class to-class)]))) - (list& super-classT super-interfacesT+)) + [super_name (\ ! map ..reflection (check_jvm superT)) + super_class (phase.lift (reflection!.load super_name))] + (wrap [[super_name superT] + (java/lang/Class::isAssignableFrom super_class to_class)]))) + (list& super_classT super_interfacesT+)) _ - (/////analysis.throw cannot-cast [fromT toT fromC]))) + (/////analysis.throw cannot_cast [fromT toT fromC]))) (def: object::cast Handler - (function (_ extension-name analyse archive args) + (function (_ extension_name analyse archive args) (case args (^ (list fromC)) (do {! phase.monad} - [toT (///.lift meta.expected-type) - to-name (\ ! map ..reflection (check-jvm toT)) - [fromT fromA] (typeA.with-inference + [toT (///.lift meta.expected_type) + to_name (\ ! map ..reflection (check_jvm toT)) + [fromT fromA] (typeA.with_inference (analyse archive fromC)) - from-name (\ ! map ..reflection (check-jvm fromT)) - can-cast? (: (Operation Bit) + from_name (\ ! map ..reflection (check_jvm fromT)) + can_cast? (: (Operation Bit) (`` (cond (~~ (template [<primitive> <object>] [(let [=primitive (reflection.reflection <primitive>)] - (or (and (text\= =primitive from-name) - (or (text\= <object> to-name) - (text\= =primitive to-name))) - (and (text\= <object> from-name) - (text\= =primitive to-name)))) + (or (and (text\= =primitive from_name) + (or (text\= <object> to_name) + (text\= =primitive to_name))) + (and (text\= <object> from_name) + (text\= =primitive to_name)))) (wrap true)] [reflection.boolean box.boolean] @@ -889,42 +889,42 @@ ## else (do ! - [_ (phase.assert ..primitives-are-not-objects [from-name] - (not (dictionary.key? ..boxes from-name))) - _ (phase.assert ..primitives-are-not-objects [to-name] - (not (dictionary.key? ..boxes to-name))) - to-class (phase.lift (reflection!.load to-name)) - _ (if (text\= ..inheritance-relationship-type-name from-name) + [_ (phase.assert ..primitives_are_not_objects [from_name] + (not (dictionary.key? ..boxes from_name))) + _ (phase.assert ..primitives_are_not_objects [to_name] + (not (dictionary.key? ..boxes to_name))) + to_class (phase.lift (reflection!.load to_name)) + _ (if (text\= ..inheritance_relationship_type_name from_name) (wrap []) (do ! - [from-class (phase.lift (reflection!.load from-name))] - (phase.assert cannot-cast [fromT toT fromC] - (java/lang/Class::isAssignableFrom from-class to-class))))] - (loop [[current-name currentT] [from-name fromT]] - (if (text\= to-name current-name) + [from_class (phase.lift (reflection!.load from_name))] + (phase.assert cannot_cast [fromT toT fromC] + (java/lang/Class::isAssignableFrom from_class to_class))))] + (loop [[current_name currentT] [from_name fromT]] + (if (text\= to_name current_name) (wrap true) (do ! - [candidate-parents (: (Operation (List [[Text .Type] Bit])) - (if (text\= ..inheritance-relationship-type-name current-name) - (inheritance-candidate-parents currentT to-class toT fromC) - (class-candidate-parents current-name currentT to-name to-class)))] - (case (|> candidate-parents + [candidate_parents (: (Operation (List [[Text .Type] Bit])) + (if (text\= ..inheritance_relationship_type_name current_name) + (inheritance_candidate_parents currentT to_class toT fromC) + (class_candidate_parents current_name currentT to_name to_class)))] + (case (|> candidate_parents (list.filter product.right) (list\map product.left)) - (#.Cons [next-name nextT] _) - (recur [next-name nextT]) + (#.Cons [next_name nextT] _) + (recur [next_name nextT]) #.Nil - (/////analysis.throw cannot-cast [fromT toT fromC])) + (/////analysis.throw cannot_cast [fromT toT fromC])) )))))))] - (if can-cast? - (wrap (#/////analysis.Extension extension-name (list (/////analysis.text from-name) - (/////analysis.text to-name) + (if can_cast? + (wrap (#/////analysis.Extension extension_name (list (/////analysis.text from_name) + (/////analysis.text to_name) fromA))) - (/////analysis.throw cannot-cast [fromT toT fromC]))) + (/////analysis.throw cannot_cast [fromT toT fromC]))) _ - (/////analysis.throw ///.invalid-syntax [extension-name %.code args])))) + (/////analysis.throw ///.invalid_syntax [extension_name %.code args])))) (def: bundle::object Bundle @@ -943,15 +943,15 @@ Handler (..custom [..member - (function (_ extension-name analyse archive [class field]) + (function (_ extension_name analyse archive [class field]) (do phase.monad [[final? fieldJT] (phase.lift (do try.monad [class (reflection!.load class)] - (reflection!.static-field field class))) - fieldT (reflection-type luxT.fresh fieldJT) + (reflection!.static_field field class))) + fieldT (reflection_type luxT.fresh fieldJT) _ (typeA.infer fieldT)] - (wrap (<| (#/////analysis.Extension extension-name) + (wrap (<| (#/////analysis.Extension extension_name) (list (/////analysis.text class) (/////analysis.text field) (/////analysis.text (|> fieldJT ..reflection)))))))])) @@ -960,19 +960,19 @@ Handler (..custom [($_ <>.and ..member <c>.any) - (function (_ extension-name analyse archive [[class field] valueC]) + (function (_ extension_name analyse archive [[class field] valueC]) (do phase.monad [_ (typeA.infer Any) [final? fieldJT] (phase.lift (do try.monad [class (reflection!.load class)] - (reflection!.static-field field class))) - fieldT (reflection-type luxT.fresh fieldJT) - _ (phase.assert ..cannot-set-a-final-field [class field] + (reflection!.static_field field class))) + fieldT (reflection_type luxT.fresh fieldJT) + _ (phase.assert ..cannot_set_a_final_field [class field] (not final?)) - valueA (typeA.with-type fieldT + valueA (typeA.with_type fieldT (analyse archive valueC))] - (wrap (<| (#/////analysis.Extension extension-name) + (wrap (<| (#/////analysis.Extension extension_name) (list (/////analysis.text class) (/////analysis.text field) valueA)))))])) @@ -981,19 +981,19 @@ Handler (..custom [($_ <>.and ..member <c>.any) - (function (_ extension-name analyse archive [[class field] objectC]) + (function (_ extension_name analyse archive [[class field] objectC]) (do phase.monad - [[objectT objectA] (typeA.with-inference + [[objectT objectA] (typeA.with_inference (analyse archive objectC)) [mapping fieldJT] (phase.lift (do try.monad [class (reflection!.load class) - [final? fieldJT] (reflection!.virtual-field field class) + [final? fieldJT] (reflection!.virtual_field field class) mapping (reflection!.correspond class objectT)] (wrap [mapping fieldJT]))) - fieldT (reflection-type mapping fieldJT) + fieldT (reflection_type mapping fieldJT) _ (typeA.infer fieldT)] - (wrap (<| (#/////analysis.Extension extension-name) + (wrap (<| (#/////analysis.Extension extension_name) (list (/////analysis.text class) (/////analysis.text field) objectA)))))])) @@ -1002,63 +1002,63 @@ Handler (..custom [($_ <>.and ..member <c>.any <c>.any) - (function (_ extension-name analyse archive [[class field] valueC objectC]) + (function (_ extension_name analyse archive [[class field] valueC objectC]) (do phase.monad - [[objectT objectA] (typeA.with-inference + [[objectT objectA] (typeA.with_inference (analyse archive objectC)) _ (typeA.infer objectT) [final? mapping fieldJT] (phase.lift (do try.monad [class (reflection!.load class) - [final? fieldJT] (reflection!.virtual-field field class) + [final? fieldJT] (reflection!.virtual_field field class) mapping (reflection!.correspond class objectT)] (wrap [final? mapping fieldJT]))) - fieldT (reflection-type mapping fieldJT) - _ (phase.assert cannot-set-a-final-field [class field] + fieldT (reflection_type mapping fieldJT) + _ (phase.assert cannot_set_a_final_field [class field] (not final?)) - valueA (typeA.with-type fieldT + valueA (typeA.with_type fieldT (analyse archive valueC))] - (wrap (<| (#/////analysis.Extension extension-name) + (wrap (<| (#/////analysis.Extension extension_name) (list (/////analysis.text class) (/////analysis.text field) valueA objectA)))))])) -(type: Method-Style +(type: Method_Style #Static #Abstract #Virtual #Special #Interface) -(def: (check-method aliasing class method-name method-style inputsJT method) - (-> Aliasing (java/lang/Class java/lang/Object) Text Method-Style (List (Type Value)) java/lang/reflect/Method (Operation Bit)) +(def: (check_method aliasing class method_name method_style inputsJT method) + (-> Aliasing (java/lang/Class java/lang/Object) Text Method_Style (List (Type Value)) java/lang/reflect/Method (Operation Bit)) (do phase.monad [parameters (|> (java/lang/reflect/Method::getGenericParameterTypes method) - array.to-list + array.to_list (monad.map try.monad reflection!.type) phase.lift) #let [modifiers (java/lang/reflect/Method::getModifiers method) - correct-class? (java/lang/Object::equals class (java/lang/reflect/Method::getDeclaringClass method)) - correct-method? (text\= method-name (java/lang/reflect/Method::getName method)) - static-matches? (case method-style + correct_class? (java/lang/Object::equals class (java/lang/reflect/Method::getDeclaringClass method)) + correct_method? (text\= method_name (java/lang/reflect/Method::getName method)) + static_matches? (case method_style #Static (java/lang/reflect/Modifier::isStatic modifiers) _ true) - special-matches? (case method-style + special_matches? (case method_style #Special (not (or (java/lang/reflect/Modifier::isInterface (java/lang/Class::getModifiers class)) (java/lang/reflect/Modifier::isAbstract modifiers))) _ true) - arity-matches? (n.= (list.size inputsJT) (list.size parameters)) - inputs-match? (list\fold (function (_ [expectedJC actualJC] prev) + arity_matches? (n.= (list.size inputsJT) (list.size parameters)) + inputs_match? (list\fold (function (_ [expectedJC actualJC] prev) (and prev (jvm\= expectedJC (: (Type Value) - (case (jvm-parser.var? actualJC) + (case (jvm_parser.var? actualJC) (#.Some name) (|> aliasing (dictionary.get name) @@ -1069,18 +1069,18 @@ actualJC))))) true (list.zip/2 parameters inputsJT))]] - (wrap (and correct-class? - correct-method? - static-matches? - special-matches? - arity-matches? - inputs-match?)))) - -(def: (check-constructor aliasing class inputsJT constructor) + (wrap (and correct_class? + correct_method? + static_matches? + special_matches? + arity_matches? + inputs_match?)))) + +(def: (check_constructor aliasing class inputsJT constructor) (-> Aliasing (java/lang/Class java/lang/Object) (List (Type Value)) (java/lang/reflect/Constructor java/lang/Object) (Operation Bit)) (do phase.monad [parameters (|> (java/lang/reflect/Constructor::getGenericParameterTypes constructor) - array.to-list + array.to_list (monad.map try.monad reflection!.type) phase.lift)] (wrap (and (java/lang/Object::equals class (java/lang/reflect/Constructor::getDeclaringClass constructor)) @@ -1088,7 +1088,7 @@ (list\fold (function (_ [expectedJC actualJC] prev) (and prev (jvm\= expectedJC (: (Type Value) - (case (jvm-parser.var? actualJC) + (case (jvm_parser.var? actualJC) (#.Some name) (|> aliasing (dictionary.get name) @@ -1100,101 +1100,101 @@ true (list.zip/2 parameters inputsJT)))))) -(def: idx-to-parameter +(def: idx_to_parameter (-> Nat .Type) (|>> (n.* 2) inc #.Parameter)) -(def: (jvm-type-var-mapping owner-tvars method-tvars) +(def: (jvm_type_var_mapping owner_tvars method_tvars) (-> (List Text) (List Text) [(List .Type) Mapping]) - (let [jvm-tvars (list\compose owner-tvars method-tvars) - lux-tvars (|> jvm-tvars + (let [jvm_tvars (list\compose owner_tvars method_tvars) + lux_tvars (|> jvm_tvars list.reverse list.enumeration (list\map (function (_ [idx name]) - [name (idx-to-parameter idx)])) + [name (idx_to_parameter idx)])) list.reverse) - num-owner-tvars (list.size owner-tvars) - owner-tvarsT (|> lux-tvars (list.take num-owner-tvars) (list\map product.right)) - mapping (dictionary.from-list text.hash lux-tvars)] - [owner-tvarsT mapping])) + num_owner_tvars (list.size owner_tvars) + owner_tvarsT (|> lux_tvars (list.take num_owner_tvars) (list\map product.right)) + mapping (dictionary.from_list text.hash lux_tvars)] + [owner_tvarsT mapping])) -(def: (method-signature method-style method) - (-> Method-Style java/lang/reflect/Method (Operation Method-Signature)) +(def: (method_signature method_style method) + (-> Method_Style java/lang/reflect/Method (Operation Method_Signature)) (let [owner (java/lang/reflect/Method::getDeclaringClass method) - owner-tvars (case method-style + owner_tvars (case method_style #Static (list) _ (|> (java/lang/Class::getTypeParameters owner) - array.to-list + array.to_list (list\map (|>> java/lang/reflect/TypeVariable::getName)))) - method-tvars (|> (java/lang/reflect/Method::getTypeParameters method) - array.to-list + method_tvars (|> (java/lang/reflect/Method::getTypeParameters method) + array.to_list (list\map (|>> java/lang/reflect/TypeVariable::getName))) - [owner-tvarsT mapping] (jvm-type-var-mapping owner-tvars method-tvars)] + [owner_tvarsT mapping] (jvm_type_var_mapping owner_tvars method_tvars)] (do {! phase.monad} [inputsT (|> (java/lang/reflect/Method::getGenericParameterTypes method) - array.to-list + array.to_list (monad.map ! (|>> reflection!.type phase.lift)) - (phase\map (monad.map ! (..reflection-type mapping))) + (phase\map (monad.map ! (..reflection_type mapping))) phase\join) outputT (|> method java/lang/reflect/Method::getGenericReturnType reflection!.return phase.lift - (phase\map (..reflection-return mapping)) + (phase\map (..reflection_return mapping)) phase\join) exceptionsT (|> (java/lang/reflect/Method::getGenericExceptionTypes method) - array.to-list + array.to_list (monad.map ! (|>> reflection!.type phase.lift)) - (phase\map (monad.map ! (..reflection-type mapping))) + (phase\map (monad.map ! (..reflection_type mapping))) phase\join) - #let [methodT (<| (type.univ-q (dictionary.size mapping)) - (type.function (case method-style + #let [methodT (<| (type.univ_q (dictionary.size mapping)) + (type.function (case method_style #Static inputsT _ - (list& (#.Primitive (java/lang/Class::getName owner) owner-tvarsT) + (list& (#.Primitive (java/lang/Class::getName owner) owner_tvarsT) inputsT))) outputT)]] (wrap [methodT exceptionsT])))) -(def: (constructor-signature constructor) - (-> (java/lang/reflect/Constructor java/lang/Object) (Operation Method-Signature)) +(def: (constructor_signature constructor) + (-> (java/lang/reflect/Constructor java/lang/Object) (Operation Method_Signature)) (let [owner (java/lang/reflect/Constructor::getDeclaringClass constructor) - owner-tvars (|> (java/lang/Class::getTypeParameters owner) - array.to-list + owner_tvars (|> (java/lang/Class::getTypeParameters owner) + array.to_list (list\map (|>> java/lang/reflect/TypeVariable::getName))) - method-tvars (|> (java/lang/reflect/Constructor::getTypeParameters constructor) - array.to-list + method_tvars (|> (java/lang/reflect/Constructor::getTypeParameters constructor) + array.to_list (list\map (|>> java/lang/reflect/TypeVariable::getName))) - [owner-tvarsT mapping] (jvm-type-var-mapping owner-tvars method-tvars)] + [owner_tvarsT mapping] (jvm_type_var_mapping owner_tvars method_tvars)] (do {! phase.monad} [inputsT (|> (java/lang/reflect/Constructor::getGenericParameterTypes constructor) - array.to-list + array.to_list (monad.map ! (|>> reflection!.type phase.lift)) - (phase\map (monad.map ! (reflection-type mapping))) + (phase\map (monad.map ! (reflection_type mapping))) phase\join) exceptionsT (|> (java/lang/reflect/Constructor::getGenericExceptionTypes constructor) - array.to-list + array.to_list (monad.map ! (|>> reflection!.type phase.lift)) - (phase\map (monad.map ! (reflection-type mapping))) + (phase\map (monad.map ! (reflection_type mapping))) phase\join) - #let [objectT (#.Primitive (java/lang/Class::getName owner) owner-tvarsT) - constructorT (<| (type.univ-q (dictionary.size mapping)) + #let [objectT (#.Primitive (java/lang/Class::getName owner) owner_tvarsT) + constructorT (<| (type.univ_q (dictionary.size mapping)) (type.function inputsT) objectT)]] (wrap [constructorT exceptionsT])))) (type: Evaluation - (#Pass Method-Signature) - (#Hint Method-Signature)) + (#Pass Method_Signature) + (#Hint Method_Signature)) (template [<name> <tag>] [(def: <name> - (-> Evaluation (Maybe Method-Signature)) + (-> Evaluation (Maybe Method_Signature)) (|>> (case> (<tag> output) (#.Some output) @@ -1209,126 +1209,126 @@ [(def: <name> (-> <type> (List (Type Var))) (|>> <method> - array.to-list + array.to_list (list\map (|>> java/lang/reflect/TypeVariable::getName jvm.var))))] - [class-type-variables (java/lang/Class java/lang/Object) java/lang/Class::getTypeParameters] - [constructor-type-variables (java/lang/reflect/Constructor java/lang/Object) java/lang/reflect/Constructor::getTypeParameters] - [method-type-variables java/lang/reflect/Method java/lang/reflect/Method::getTypeParameters] + [class_type_variables (java/lang/Class java/lang/Object) java/lang/Class::getTypeParameters] + [constructor_type_variables (java/lang/reflect/Constructor java/lang/Object) java/lang/reflect/Constructor::getTypeParameters] + [method_type_variables java/lang/reflect/Method java/lang/reflect/Method::getTypeParameters] ) (def: (aliasing expected actual) (-> (List (Type Var)) (List (Type Var)) Aliasing) - (|> (list.zip/2 (list\map jvm-parser.name actual) - (list\map jvm-parser.name expected)) - (dictionary.from-list text.hash))) + (|> (list.zip/2 (list\map jvm_parser.name actual) + (list\map jvm_parser.name expected)) + (dictionary.from_list text.hash))) -(def: (method-candidate actual-class-tvars class-name actual-method-tvars method-name method-style inputsJT) - (-> (List (Type Var)) External (List (Type Var)) Text Method-Style (List (Type Value)) (Operation Method-Signature)) +(def: (method_candidate actual_class_tvars class_name actual_method_tvars method_name method_style inputsJT) + (-> (List (Type Var)) External (List (Type Var)) Text Method_Style (List (Type Value)) (Operation Method_Signature)) (do {! phase.monad} - [class (phase.lift (reflection!.load class-name)) - #let [expected-class-tvars (class-type-variables class)] + [class (phase.lift (reflection!.load class_name)) + #let [expected_class_tvars (class_type_variables class)] candidates (|> class java/lang/Class::getDeclaredMethods - array.to-list - (list.filter (|>> java/lang/reflect/Method::getName (text\= method-name))) + array.to_list + (list.filter (|>> java/lang/reflect/Method::getName (text\= method_name))) (monad.map ! (: (-> java/lang/reflect/Method (Operation Evaluation)) (function (_ method) (do ! - [#let [expected-method-tvars (method-type-variables method) - aliasing (dictionary.merge (..aliasing expected-class-tvars actual-class-tvars) - (..aliasing expected-method-tvars actual-method-tvars))] - passes? (check-method aliasing class method-name method-style inputsJT method)] + [#let [expected_method_tvars (method_type_variables method) + aliasing (dictionary.merge (..aliasing expected_class_tvars actual_class_tvars) + (..aliasing expected_method_tvars actual_method_tvars))] + passes? (check_method aliasing class method_name method_style inputsJT method)] (\ ! map (if passes? (|>> #Pass) (|>> #Hint)) - (method-signature method-style method)))))))] + (method_signature method_style method)))))))] (case (list.all pass! candidates) (#.Cons method #.Nil) (wrap method) #.Nil - (/////analysis.throw ..no-candidates [class-name method-name inputsJT (list.all hint! candidates)]) + (/////analysis.throw ..no_candidates [class_name method_name inputsJT (list.all hint! candidates)]) candidates - (/////analysis.throw ..too-many-candidates [class-name method-name inputsJT candidates])))) + (/////analysis.throw ..too_many_candidates [class_name method_name inputsJT candidates])))) -(def: constructor-method "<init>") +(def: constructor_method "<init>") -(def: (constructor-candidate actual-class-tvars class-name actual-method-tvars inputsJT) - (-> (List (Type Var)) External (List (Type Var)) (List (Type Value)) (Operation Method-Signature)) +(def: (constructor_candidate actual_class_tvars class_name actual_method_tvars inputsJT) + (-> (List (Type Var)) External (List (Type Var)) (List (Type Value)) (Operation Method_Signature)) (do {! phase.monad} - [class (phase.lift (reflection!.load class-name)) - #let [expected-class-tvars (class-type-variables class)] + [class (phase.lift (reflection!.load class_name)) + #let [expected_class_tvars (class_type_variables class)] candidates (|> class java/lang/Class::getConstructors - array.to-list + array.to_list (monad.map ! (function (_ constructor) (do ! - [#let [expected-method-tvars (constructor-type-variables constructor) - aliasing (dictionary.merge (..aliasing expected-class-tvars actual-class-tvars) - (..aliasing expected-method-tvars actual-method-tvars))] - passes? (check-constructor aliasing class inputsJT constructor)] + [#let [expected_method_tvars (constructor_type_variables constructor) + aliasing (dictionary.merge (..aliasing expected_class_tvars actual_class_tvars) + (..aliasing expected_method_tvars actual_method_tvars))] + passes? (check_constructor aliasing class inputsJT constructor)] (\ ! map (if passes? (|>> #Pass) (|>> #Hint)) - (constructor-signature constructor))))))] + (constructor_signature constructor))))))] (case (list.all pass! candidates) (#.Cons constructor #.Nil) (wrap constructor) #.Nil - (/////analysis.throw ..no-candidates [class-name ..constructor-method inputsJT (list.all hint! candidates)]) + (/////analysis.throw ..no_candidates [class_name ..constructor_method inputsJT (list.all hint! candidates)]) candidates - (/////analysis.throw ..too-many-candidates [class-name ..constructor-method inputsJT candidates])))) + (/////analysis.throw ..too_many_candidates [class_name ..constructor_method inputsJT candidates])))) (template [<name> <category> <parser>] [(def: #export <name> (Parser (Type <category>)) (<t>.embed <parser> <c>.text))] - [var Var jvm-parser.var] - [class Class jvm-parser.class] - [type Value jvm-parser.value] - [return Return jvm-parser.return] + [var Var jvm_parser.var] + [class Class jvm_parser.class] + [type Value jvm_parser.value] + [return Return jvm_parser.return] ) (def: input (Parser (Typed Code)) (<c>.tuple (<>.and ..type <c>.any))) -(def: (decorate-inputs typesT inputsA) +(def: (decorate_inputs typesT inputsA) (-> (List (Type Value)) (List Analysis) (List Analysis)) (|> inputsA (list.zip/2 (list\map (|>> ..signature /////analysis.text) typesT)) (list\map (function (_ [type value]) (/////analysis.tuple (list type value)))))) -(def: type-vars (<c>.tuple (<>.some ..var))) +(def: type_vars (<c>.tuple (<>.some ..var))) (def: invoke::static Handler (..custom - [($_ <>.and ..type-vars ..member ..type-vars (<>.some ..input)) - (function (_ extension-name analyse archive [class-tvars [class method] method-tvars argsTC]) + [($_ <>.and ..type_vars ..member ..type_vars (<>.some ..input)) + (function (_ extension_name analyse archive [class_tvars [class method] method_tvars argsTC]) (do phase.monad [#let [argsT (list\map product.left argsTC)] - [methodT exceptionsT] (method-candidate class-tvars class method-tvars method #Static argsT) + [methodT exceptionsT] (method_candidate class_tvars class method_tvars method #Static argsT) [outputT argsA] (inferenceA.general archive analyse methodT (list\map product.right argsTC)) - outputJT (check-return outputT)] - (wrap (#/////analysis.Extension extension-name (list& (/////analysis.text (..signature (jvm.class class (list)))) + outputJT (check_return outputT)] + (wrap (#/////analysis.Extension extension_name (list& (/////analysis.text (..signature (jvm.class class (list)))) (/////analysis.text method) (/////analysis.text (..signature outputJT)) - (decorate-inputs argsT argsA))))))])) + (decorate_inputs argsT argsA))))))])) (def: invoke::virtual Handler (..custom - [($_ <>.and ..type-vars ..member ..type-vars <c>.any (<>.some ..input)) - (function (_ extension-name analyse archive [class-tvars [class method] method-tvars objectC argsTC]) + [($_ <>.and ..type_vars ..member ..type_vars <c>.any (<>.some ..input)) + (function (_ extension_name analyse archive [class_tvars [class method] method_tvars objectC argsTC]) (do phase.monad [#let [argsT (list\map product.left argsTC)] - [methodT exceptionsT] (method-candidate class-tvars class method-tvars method #Virtual argsT) + [methodT exceptionsT] (method_candidate class_tvars class method_tvars method #Virtual argsT) [outputT allA] (inferenceA.general archive analyse methodT (list& objectC (list\map product.right argsTC))) #let [[objectA argsA] (case allA (#.Cons objectA argsA) @@ -1336,39 +1336,39 @@ _ (undefined))] - outputJT (check-return outputT)] - (wrap (#/////analysis.Extension extension-name (list& (/////analysis.text (..signature (jvm.class class (list)))) + outputJT (check_return outputT)] + (wrap (#/////analysis.Extension extension_name (list& (/////analysis.text (..signature (jvm.class class (list)))) (/////analysis.text method) (/////analysis.text (..signature outputJT)) objectA - (decorate-inputs argsT argsA))))))])) + (decorate_inputs argsT argsA))))))])) (def: invoke::special Handler (..custom - [($_ <>.and ..type-vars ..member ..type-vars <c>.any (<>.some ..input)) - (function (_ extension-name analyse archive [class-tvars [class method] method-tvars objectC argsTC]) + [($_ <>.and ..type_vars ..member ..type_vars <c>.any (<>.some ..input)) + (function (_ extension_name analyse archive [class_tvars [class method] method_tvars objectC argsTC]) (do phase.monad [#let [argsT (list\map product.left argsTC)] - [methodT exceptionsT] (method-candidate class-tvars class method-tvars method #Special argsT) + [methodT exceptionsT] (method_candidate class_tvars class method_tvars method #Special argsT) [outputT argsA] (inferenceA.general archive analyse methodT (list& objectC (list\map product.right argsTC))) - outputJT (check-return outputT)] - (wrap (#/////analysis.Extension extension-name (list& (/////analysis.text (..signature (jvm.class class (list)))) + outputJT (check_return outputT)] + (wrap (#/////analysis.Extension extension_name (list& (/////analysis.text (..signature (jvm.class class (list)))) (/////analysis.text method) (/////analysis.text (..signature outputJT)) - (decorate-inputs argsT argsA))))))])) + (decorate_inputs argsT argsA))))))])) (def: invoke::interface Handler (..custom - [($_ <>.and ..type-vars ..member ..type-vars <c>.any (<>.some ..input)) - (function (_ extension-name analyse archive [class-tvars [class-name method] method-tvars objectC argsTC]) + [($_ <>.and ..type_vars ..member ..type_vars <c>.any (<>.some ..input)) + (function (_ extension_name analyse archive [class_tvars [class_name method] method_tvars objectC argsTC]) (do phase.monad [#let [argsT (list\map product.left argsTC)] - class (phase.lift (reflection!.load class-name)) - _ (phase.assert non-interface class-name + class (phase.lift (reflection!.load class_name)) + _ (phase.assert non_interface class_name (java/lang/reflect/Modifier::isInterface (java/lang/Class::getModifiers class))) - [methodT exceptionsT] (method-candidate class-tvars class-name method-tvars method #Interface argsT) + [methodT exceptionsT] (method_candidate class_tvars class_name method_tvars method #Interface argsT) [outputT allA] (inferenceA.general archive analyse methodT (list& objectC (list\map product.right argsTC))) #let [[objectA argsA] (case allA (#.Cons objectA argsA) @@ -1376,24 +1376,24 @@ _ (undefined))] - outputJT (check-return outputT)] - (wrap (#/////analysis.Extension extension-name - (list& (/////analysis.text (..signature (jvm.class class-name (list)))) + outputJT (check_return outputT)] + (wrap (#/////analysis.Extension extension_name + (list& (/////analysis.text (..signature (jvm.class class_name (list)))) (/////analysis.text method) (/////analysis.text (..signature outputJT)) objectA - (decorate-inputs argsT argsA))))))])) + (decorate_inputs argsT argsA))))))])) (def: invoke::constructor (..custom - [($_ <>.and ..type-vars <c>.text ..type-vars (<>.some ..input)) - (function (_ extension-name analyse archive [class-tvars class method-tvars argsTC]) + [($_ <>.and ..type_vars <c>.text ..type_vars (<>.some ..input)) + (function (_ extension_name analyse archive [class_tvars class method_tvars argsTC]) (do phase.monad [#let [argsT (list\map product.left argsTC)] - [methodT exceptionsT] (constructor-candidate class-tvars class method-tvars argsT) + [methodT exceptionsT] (constructor_candidate class_tvars class method_tvars argsT) [outputT argsA] (inferenceA.general archive analyse methodT (list\map product.right argsTC))] - (wrap (#/////analysis.Extension extension-name (list& (/////analysis.text (..signature (jvm.class class (list)))) - (decorate-inputs argsT argsA))))))])) + (wrap (#/////analysis.Extension extension_name (list& (/////analysis.text (..signature (jvm.class class (list)))) + (decorate_inputs argsT argsA))))))])) (def: bundle::member Bundle @@ -1417,81 +1417,81 @@ ))) ))) -(type: #export (Annotation-Parameter a) +(type: #export (Annotation_Parameter a) [Text a]) -(def: annotation-parameter - (Parser (Annotation-Parameter Code)) +(def: annotation_parameter + (Parser (Annotation_Parameter Code)) (<c>.tuple (<>.and <c>.text <c>.any))) (type: #export (Annotation a) - [Text (List (Annotation-Parameter a))]) + [Text (List (Annotation_Parameter a))]) (def: #export annotation (Parser (Annotation Code)) - (<c>.form (<>.and <c>.text (<>.some ..annotation-parameter)))) + (<c>.form (<>.and <c>.text (<>.some ..annotation_parameter)))) (def: #export argument (Parser Argument) (<c>.tuple (<>.and <c>.text ..type))) -(def: (annotation-parameter-analysis [name value]) - (-> (Annotation-Parameter Analysis) Analysis) +(def: (annotation_parameter_analysis [name value]) + (-> (Annotation_Parameter Analysis) Analysis) (/////analysis.tuple (list (/////analysis.text name) value))) -(def: (annotation-analysis [name parameters]) +(def: (annotation_analysis [name parameters]) (-> (Annotation Analysis) Analysis) (/////analysis.tuple (list& (/////analysis.text name) - (list\map annotation-parameter-analysis parameters)))) + (list\map annotation_parameter_analysis parameters)))) (template [<name> <category>] [(def: <name> (-> (Type <category>) Analysis) (|>> ..signature /////analysis.text))] - [var-analysis Var] - [class-analysis Class] - [value-analysis Value] - [return-analysis Return] + [var_analysis Var] + [class_analysis Class] + [value_analysis Value] + [return_analysis Return] ) -(def: (typed-analysis [type term]) +(def: (typed_analysis [type term]) (-> (Typed Analysis) Analysis) - (/////analysis.tuple (list (value-analysis type) term))) + (/////analysis.tuple (list (value_analysis type) term))) -(def: (argument-analysis [argument argumentJT]) +(def: (argument_analysis [argument argumentJT]) (-> Argument Analysis) (/////analysis.tuple (list (/////analysis.text argument) - (value-analysis argumentJT)))) + (value_analysis argumentJT)))) (template [<name> <filter>] [(def: <name> (-> (java/lang/Class java/lang/Object) (Try (List [Text (Type Method)]))) (|>> java/lang/Class::getDeclaredMethods - array.to-list + array.to_list <filter> (monad.map try.monad (function (_ method) (do {! try.monad} [inputs (|> (java/lang/reflect/Method::getGenericParameterTypes method) - array.to-list + array.to_list (monad.map ! reflection!.type)) return (|> method java/lang/reflect/Method::getGenericReturnType reflection!.return) exceptions (|> (java/lang/reflect/Method::getGenericExceptionTypes method) - array.to-list + array.to_list (monad.map ! reflection!.class))] (wrap [(java/lang/reflect/Method::getName method) (jvm.method [inputs return exceptions])]))))))] - [abstract-methods (list.filter (|>> java/lang/reflect/Method::getModifiers java/lang/reflect/Modifier::isAbstract))] + [abstract_methods (list.filter (|>> java/lang/reflect/Method::getModifiers java/lang/reflect/Modifier::isAbstract))] [methods (<|)] ) -(def: jvm-package-separator ".") +(def: jvm_package_separator ".") (template [<name> <methods>] [(def: <name> @@ -1501,8 +1501,8 @@ try\join (try\map list\join)))] - [all-abstract-methods ..abstract-methods] - [all-methods ..methods] + [all_abstract_methods ..abstract_methods] + [all_methods ..methods] ) (template [<name>] @@ -1513,8 +1513,8 @@ (format (%.text name) " " (..signature type))) methods)]))] - [missing-abstract-methods] - [invalid-overriden-methods] + [missing_abstract_methods] + [invalid_overriden_methods] ) (type: #export Visibility @@ -1526,26 +1526,26 @@ (type: #export Finality Bit) (type: #export Strictness Bit) -(def: #export public-tag "public") -(def: #export private-tag "private") -(def: #export protected-tag "protected") -(def: #export default-tag "default") +(def: #export public_tag "public") +(def: #export private_tag "private") +(def: #export protected_tag "protected") +(def: #export default_tag "default") (def: #export visibility (Parser Visibility) ($_ <>.or - (<c>.text! ..public-tag) - (<c>.text! ..private-tag) - (<c>.text! ..protected-tag) - (<c>.text! ..default-tag))) + (<c>.text! ..public_tag) + (<c>.text! ..private_tag) + (<c>.text! ..protected_tag) + (<c>.text! ..default_tag))) -(def: #export (visibility-analysis visibility) +(def: #export (visibility_analysis visibility) (-> Visibility Analysis) (/////analysis.text (case visibility - #Public ..public-tag - #Private ..private-tag - #Protected ..protected-tag - #Default ..default-tag))) + #Public ..public_tag + #Private ..private_tag + #Protected ..protected_tag + #Default ..default_tag))) (type: #export (Constructor a) [Visibility @@ -1558,12 +1558,12 @@ (List (Typed a)) a]) -(def: #export constructor-tag "init") +(def: #export constructor_tag "init") -(def: #export constructor-definition +(def: #export constructor_definition (Parser (Constructor Code)) (<| <c>.form - (<>.after (<c>.text! ..constructor-tag)) + (<>.after (<c>.text! ..constructor_tag)) ($_ <>.and ..visibility <c>.bit @@ -1575,11 +1575,11 @@ (<c>.tuple (<>.some ..input)) <c>.any))) -(def: #export (analyse-constructor-method analyse archive selfT mapping method) +(def: #export (analyse_constructor_method analyse archive selfT mapping method) (-> Phase Archive .Type Mapping (Constructor Code) (Operation Analysis)) - (let [[visibility strict-fp? + (let [[visibility strict_fp? annotations vars exceptions - self-name arguments super-arguments body] method] + self_name arguments super_arguments body] method] (do {! phase.monad} [annotationsA (monad.map ! (function (_ [name parameters]) (do ! @@ -1590,41 +1590,41 @@ parameters)] (wrap [name parametersA]))) annotations) - super-arguments (monad.map ! (function (_ [jvmT super-argC]) + super_arguments (monad.map ! (function (_ [jvmT super_argC]) (do ! - [luxT (reflection-type mapping jvmT) - super-argA (typeA.with-type luxT - (analyse archive super-argC))] - (wrap [jvmT super-argA]))) - super-arguments) + [luxT (reflection_type mapping jvmT) + super_argA (typeA.with_type luxT + (analyse archive super_argC))] + (wrap [jvmT super_argA]))) + super_arguments) arguments' (monad.map ! (function (_ [name jvmT]) (do ! - [luxT (reflection-type mapping jvmT)] + [luxT (reflection_type mapping jvmT)] (wrap [name luxT]))) arguments) [scope bodyA] (|> arguments' - (#.Cons [self-name selfT]) + (#.Cons [self_name selfT]) list.reverse - (list\fold scope.with-local (analyse archive body)) - (typeA.with-type .Any) - /////analysis.with-scope)] - (wrap (/////analysis.tuple (list (/////analysis.text ..constructor-tag) - (visibility-analysis visibility) - (/////analysis.bit strict-fp?) - (/////analysis.tuple (list\map annotation-analysis annotationsA)) - (/////analysis.tuple (list\map var-analysis vars)) - (/////analysis.text self-name) - (/////analysis.tuple (list\map ..argument-analysis arguments)) - (/////analysis.tuple (list\map class-analysis exceptions)) - (/////analysis.tuple (list\map typed-analysis super-arguments)) + (list\fold scope.with_local (analyse archive body)) + (typeA.with_type .Any) + /////analysis.with_scope)] + (wrap (/////analysis.tuple (list (/////analysis.text ..constructor_tag) + (visibility_analysis visibility) + (/////analysis.bit strict_fp?) + (/////analysis.tuple (list\map annotation_analysis annotationsA)) + (/////analysis.tuple (list\map var_analysis vars)) + (/////analysis.text self_name) + (/////analysis.tuple (list\map ..argument_analysis arguments)) + (/////analysis.tuple (list\map class_analysis exceptions)) + (/////analysis.tuple (list\map typed_analysis super_arguments)) (#/////analysis.Function (list\map (|>> /////analysis.variable) (scope.environment scope)) (/////analysis.tuple (list bodyA))) )))))) -(type: #export (Virtual-Method a) +(type: #export (Virtual_Method a) [Text Visibility Finality @@ -1637,12 +1637,12 @@ (List (Type Class)) ## Exceptions a]) -(def: virtual-tag "virtual") +(def: virtual_tag "virtual") -(def: #export virtual-method-definition - (Parser (Virtual-Method Code)) +(def: #export virtual_method_definition + (Parser (Virtual_Method Code)) (<| <c>.form - (<>.after (<c>.text! ..virtual-tag)) + (<>.after (<c>.text! ..virtual_tag)) ($_ <>.and <c>.text ..visibility @@ -1656,11 +1656,11 @@ (<c>.tuple (<>.some ..class)) <c>.any))) -(def: #export (analyse-virtual-method analyse archive selfT mapping method) - (-> Phase Archive .Type Mapping (Virtual-Method Code) (Operation Analysis)) - (let [[method-name visibility - final? strict-fp? annotations vars - self-name arguments return exceptions +(def: #export (analyse_virtual_method analyse archive selfT mapping method) + (-> Phase Archive .Type Mapping (Virtual_Method Code) (Operation Analysis)) + (let [[method_name visibility + final? strict_fp? annotations vars + self_name arguments return exceptions body] method] (do {! phase.monad} [annotationsA (monad.map ! (function (_ [name parameters]) @@ -1672,37 +1672,37 @@ parameters)] (wrap [name parametersA]))) annotations) - returnT (reflection-return mapping return) + returnT (reflection_return mapping return) arguments' (monad.map ! (function (_ [name jvmT]) (do ! - [luxT (reflection-type mapping jvmT)] + [luxT (reflection_type mapping jvmT)] (wrap [name luxT]))) arguments) [scope bodyA] (|> arguments' - (#.Cons [self-name selfT]) + (#.Cons [self_name selfT]) list.reverse - (list\fold scope.with-local (analyse archive body)) - (typeA.with-type returnT) - /////analysis.with-scope)] - (wrap (/////analysis.tuple (list (/////analysis.text ..virtual-tag) - (/////analysis.text method-name) - (visibility-analysis visibility) + (list\fold scope.with_local (analyse archive body)) + (typeA.with_type returnT) + /////analysis.with_scope)] + (wrap (/////analysis.tuple (list (/////analysis.text ..virtual_tag) + (/////analysis.text method_name) + (visibility_analysis visibility) (/////analysis.bit final?) - (/////analysis.bit strict-fp?) - (/////analysis.tuple (list\map annotation-analysis annotationsA)) - (/////analysis.tuple (list\map var-analysis vars)) - (/////analysis.text self-name) - (/////analysis.tuple (list\map ..argument-analysis arguments)) - (return-analysis return) - (/////analysis.tuple (list\map class-analysis exceptions)) + (/////analysis.bit strict_fp?) + (/////analysis.tuple (list\map annotation_analysis annotationsA)) + (/////analysis.tuple (list\map var_analysis vars)) + (/////analysis.text self_name) + (/////analysis.tuple (list\map ..argument_analysis arguments)) + (return_analysis return) + (/////analysis.tuple (list\map class_analysis exceptions)) (#/////analysis.Function (list\map (|>> /////analysis.variable) (scope.environment scope)) (/////analysis.tuple (list bodyA))) )))))) -(type: #export (Static-Method a) +(type: #export (Static_Method a) [Text Visibility Strictness @@ -1713,12 +1713,12 @@ (Type Return) a]) -(def: #export static-tag "static") +(def: #export static_tag "static") -(def: #export static-method-definition - (Parser (Static-Method Code)) +(def: #export static_method_definition + (Parser (Static_Method Code)) (<| <c>.form - (<>.after (<c>.text! ..static-tag)) + (<>.after (<c>.text! ..static_tag)) ($_ <>.and <c>.text ..visibility @@ -1730,10 +1730,10 @@ ..return <c>.any))) -(def: #export (analyse-static-method analyse archive mapping method) - (-> Phase Archive Mapping (Static-Method Code) (Operation Analysis)) - (let [[method-name visibility - strict-fp? annotations vars exceptions +(def: #export (analyse_static_method analyse archive mapping method) + (-> Phase Archive Mapping (Static_Method Code) (Operation Analysis)) + (let [[method_name visibility + strict_fp? annotations vars exceptions arguments return body] method] (do {! phase.monad} @@ -1746,27 +1746,27 @@ parameters)] (wrap [name parametersA]))) annotations) - returnT (reflection-return mapping return) + returnT (reflection_return mapping return) arguments' (monad.map ! (function (_ [name jvmT]) (do ! - [luxT (reflection-type mapping jvmT)] + [luxT (reflection_type mapping jvmT)] (wrap [name luxT]))) arguments) [scope bodyA] (|> arguments' list.reverse - (list\fold scope.with-local (analyse archive body)) - (typeA.with-type returnT) - /////analysis.with-scope)] - (wrap (/////analysis.tuple (list (/////analysis.text ..static-tag) - (/////analysis.text method-name) - (visibility-analysis visibility) - (/////analysis.bit strict-fp?) - (/////analysis.tuple (list\map annotation-analysis annotationsA)) - (/////analysis.tuple (list\map var-analysis vars)) - (/////analysis.tuple (list\map ..argument-analysis arguments)) - (return-analysis return) - (/////analysis.tuple (list\map class-analysis + (list\fold scope.with_local (analyse archive body)) + (typeA.with_type returnT) + /////analysis.with_scope)] + (wrap (/////analysis.tuple (list (/////analysis.text ..static_tag) + (/////analysis.text method_name) + (visibility_analysis visibility) + (/////analysis.bit strict_fp?) + (/////analysis.tuple (list\map annotation_analysis annotationsA)) + (/////analysis.tuple (list\map var_analysis vars)) + (/////analysis.tuple (list\map ..argument_analysis arguments)) + (return_analysis return) + (/////analysis.tuple (list\map class_analysis exceptions)) (#/////analysis.Function (list\map (|>> /////analysis.variable) @@ -1774,7 +1774,7 @@ (/////analysis.tuple (list bodyA))) )))))) -(type: #export (Overriden-Method a) +(type: #export (Overriden_Method a) [(Type Class) Text Bit @@ -1786,12 +1786,12 @@ (List (Type Class)) a]) -(def: #export overriden-tag "override") +(def: #export overriden_tag "override") -(def: #export overriden-method-definition - (Parser (Overriden-Method Code)) +(def: #export overriden_method_definition + (Parser (Overriden_Method Code)) (<| <c>.form - (<>.after (<c>.text! ..overriden-tag)) + (<>.after (<c>.text! ..overriden_tag)) ($_ <>.and ..class <c>.text @@ -1805,11 +1805,11 @@ <c>.any ))) -(def: #export (analyse-overriden-method analyse archive selfT mapping method) - (-> Phase Archive .Type Mapping (Overriden-Method Code) (Operation Analysis)) - (let [[parent-type method-name - strict-fp? annotations vars - self-name arguments return exceptions +(def: #export (analyse_overriden_method analyse archive selfT mapping method) + (-> Phase Archive .Type Mapping (Overriden_Method Code) (Operation Analysis)) + (let [[parent_type method_name + strict_fp? annotations vars + self_name arguments return exceptions body] method] (do {! phase.monad} [annotationsA (monad.map ! (function (_ [name parameters]) @@ -1821,29 +1821,29 @@ parameters)] (wrap [name parametersA]))) annotations) - returnT (reflection-return mapping return) + returnT (reflection_return mapping return) arguments' (monad.map ! (function (_ [name jvmT]) (do ! - [luxT (reflection-type mapping jvmT)] + [luxT (reflection_type mapping jvmT)] (wrap [name luxT]))) arguments) [scope bodyA] (|> arguments' - (#.Cons [self-name selfT]) + (#.Cons [self_name selfT]) list.reverse - (list\fold scope.with-local (analyse archive body)) - (typeA.with-type returnT) - /////analysis.with-scope)] - (wrap (/////analysis.tuple (list (/////analysis.text ..overriden-tag) - (class-analysis parent-type) - (/////analysis.text method-name) - (/////analysis.bit strict-fp?) - (/////analysis.tuple (list\map annotation-analysis annotationsA)) - (/////analysis.tuple (list\map var-analysis vars)) - (/////analysis.text self-name) - (/////analysis.tuple (list\map ..argument-analysis arguments)) - (return-analysis return) - (/////analysis.tuple (list\map class-analysis + (list\fold scope.with_local (analyse archive body)) + (typeA.with_type returnT) + /////analysis.with_scope)] + (wrap (/////analysis.tuple (list (/////analysis.text ..overriden_tag) + (class_analysis parent_type) + (/////analysis.text method_name) + (/////analysis.bit strict_fp?) + (/////analysis.tuple (list\map annotation_analysis annotationsA)) + (/////analysis.tuple (list\map var_analysis vars)) + (/////analysis.text self_name) + (/////analysis.tuple (list\map ..argument_analysis arguments)) + (return_analysis return) + (/////analysis.tuple (list\map class_analysis exceptions)) (#/////analysis.Function (list\map (|>> /////analysis.variable) @@ -1851,10 +1851,10 @@ (/////analysis.tuple (list bodyA))) )))))) -(type: #export (Method-Definition a) - (#Overriden-Method (Overriden-Method a))) +(type: #export (Method_Definition a) + (#Overriden_Method (Overriden_Method a))) -(def: #export parameter-types +(def: #export parameter_types (-> (List (Type Var)) (Check (List [(Type Var) .Type]))) (monad.map check.monad (function (_ parameterJ) @@ -1862,21 +1862,21 @@ [[_ parameterT] check.existential] (wrap [parameterJ parameterT]))))) -(def: (mismatched-methods super-set sub-set) +(def: (mismatched_methods super_set sub_set) (-> (List [Text (Type Method)]) (List [Text (Type Method)]) (List [Text (Type Method)])) - (list.filter (function (_ [sub-name subJT]) - (|> super-set - (list.filter (function (_ [super-name superJT]) - (and (text\= super-name sub-name) + (list.filter (function (_ [sub_name subJT]) + (|> super_set + (list.filter (function (_ [super_name superJT]) + (and (text\= super_name sub_name) (jvm\= superJT subJT)))) list.size (n.= 1) not)) - sub-set)) + sub_set)) -(exception: #export (class-parameter-mismatch {expected (List Text)} +(exception: #export (class_parameter_mismatch {expected (List Text)} {actual (List (Type Parameter))}) (exception.report ["Expected (amount)" (%.nat (list.size expected))] @@ -1884,32 +1884,32 @@ ["Actual (amount)" (%.nat (list.size actual))] ["Actual (parameters)" (exception.enumerate ..signature actual)])) -(def: (super-aliasing class) +(def: (super_aliasing class) (-> (Type Class) (Operation Aliasing)) (do phase.monad - [#let [[name actual-parameters] (jvm-parser.read-class class)] + [#let [[name actual_parameters] (jvm_parser.read_class class)] class (phase.lift (reflection!.load name)) - #let [expected-parameters (|> (java/lang/Class::getTypeParameters class) - array.to-list + #let [expected_parameters (|> (java/lang/Class::getTypeParameters class) + array.to_list (list\map (|>> java/lang/reflect/TypeVariable::getName)))] - _ (phase.assert ..class-parameter-mismatch [expected-parameters actual-parameters] - (n.= (list.size expected-parameters) - (list.size actual-parameters)))] - (wrap (|> (list.zip/2 expected-parameters actual-parameters) + _ (phase.assert ..class_parameter_mismatch [expected_parameters actual_parameters] + (n.= (list.size expected_parameters) + (list.size actual_parameters)))] + (wrap (|> (list.zip/2 expected_parameters actual_parameters) (list\fold (function (_ [expected actual] mapping) - (case (jvm-parser.var? actual) + (case (jvm_parser.var? actual) (#.Some actual) (dictionary.put actual expected mapping) #.None mapping)) - jvm-alias.fresh))))) + jvm_alias.fresh))))) -(def: (anonymous-class-name module id) +(def: (anonymous_class_name module id) (-> Module Nat Text) - (let [global (text.replace-all .module-separator ..jvm-package-separator module) + (let [global (text.replace_all .module_separator ..jvm_package_separator module) local (format "anonymous-class" (%.nat id))] - (format global ..jvm-package-separator local))) + (format global ..jvm_package_separator local))) (def: class::anonymous Handler @@ -1919,65 +1919,65 @@ ..class (<c>.tuple (<>.some ..class)) (<c>.tuple (<>.some ..input)) - (<c>.tuple (<>.some ..overriden-method-definition))) - (function (_ extension-name analyse archive [parameters - super-class - super-interfaces - constructor-args + (<c>.tuple (<>.some ..overriden_method_definition))) + (function (_ extension_name analyse archive [parameters + super_class + super_interfaces + constructor_args methods]) (do {! phase.monad} - [parameters (typeA.with-env - (..parameter-types parameters)) + [parameters (typeA.with_env + (..parameter_types parameters)) #let [mapping (list\fold (function (_ [parameterJ parameterT] mapping) - (dictionary.put (jvm-parser.name parameterJ) + (dictionary.put (jvm_parser.name parameterJ) parameterT mapping)) luxT.fresh parameters)] - super-classT (typeA.with-env - (luxT.check (luxT.class mapping) (..signature super-class))) - super-interfaceT+ (typeA.with-env + super_classT (typeA.with_env + (luxT.check (luxT.class mapping) (..signature super_class))) + super_interfaceT+ (typeA.with_env (monad.map check.monad (|>> ..signature (luxT.check (luxT.class mapping))) - super-interfaces)) + super_interfaces)) selfT (///.lift (do meta.monad - [where meta.current-module-name + [where meta.current_module_name id meta.count] - (wrap (inheritance-relationship-type (#.Primitive (..anonymous-class-name where id) (list)) - super-classT - super-interfaceT+)))) + (wrap (inheritance_relationship_type (#.Primitive (..anonymous_class_name where id) (list)) + super_classT + super_interfaceT+)))) _ (typeA.infer selfT) - constructor-argsA+ (monad.map ! (function (_ [type term]) + constructor_argsA+ (monad.map ! (function (_ [type term]) (do ! - [argT (reflection-type mapping type) - termA (typeA.with-type argT + [argT (reflection_type mapping type) + termA (typeA.with_type argT (analyse archive term))] (wrap [type termA]))) - constructor-args) - methodsA (monad.map ! (analyse-overriden-method analyse archive selfT mapping) methods) - required-abstract-methods (phase.lift (all-abstract-methods (list& super-class super-interfaces))) - available-methods (phase.lift (all-methods (list& super-class super-interfaces))) - overriden-methods (monad.map ! (function (_ [parent-type method-name - strict-fp? annotations vars - self-name arguments return exceptions + constructor_args) + methodsA (monad.map ! (analyse_overriden_method analyse archive selfT mapping) methods) + required_abstract_methods (phase.lift (all_abstract_methods (list& super_class super_interfaces))) + available_methods (phase.lift (all_methods (list& super_class super_interfaces))) + overriden_methods (monad.map ! (function (_ [parent_type method_name + strict_fp? annotations vars + self_name arguments return exceptions body]) (do ! - [aliasing (super-aliasing parent-type)] - (wrap [method-name (|> (jvm.method [(list\map product.right arguments) + [aliasing (super_aliasing parent_type)] + (wrap [method_name (|> (jvm.method [(list\map product.right arguments) return exceptions]) - (jvm-alias.method aliasing))]))) + (jvm_alias.method aliasing))]))) methods) - #let [missing-abstract-methods (mismatched-methods overriden-methods required-abstract-methods) - invalid-overriden-methods (mismatched-methods available-methods overriden-methods)] - _ (phase.assert ..missing-abstract-methods missing-abstract-methods - (list.empty? missing-abstract-methods)) - _ (phase.assert ..invalid-overriden-methods invalid-overriden-methods - (list.empty? invalid-overriden-methods))] - (wrap (#/////analysis.Extension extension-name - (list (class-analysis super-class) - (/////analysis.tuple (list\map class-analysis super-interfaces)) - (/////analysis.tuple (list\map typed-analysis constructor-argsA+)) + #let [missing_abstract_methods (mismatched_methods overriden_methods required_abstract_methods) + invalid_overriden_methods (mismatched_methods available_methods overriden_methods)] + _ (phase.assert ..missing_abstract_methods missing_abstract_methods + (list.empty? missing_abstract_methods)) + _ (phase.assert ..invalid_overriden_methods invalid_overriden_methods + (list.empty? invalid_overriden_methods))] + (wrap (#/////analysis.Extension extension_name + (list (class_analysis super_class) + (/////analysis.tuple (list\map class_analysis super_interfaces)) + (/////analysis.tuple (list\map typed_analysis constructor_argsA+)) (/////analysis.tuple methodsA))))))])) (def: bundle::class diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux index 70a32ea7e..a76bfcc60 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux @@ -38,29 +38,29 @@ (-> [(Parser s) (-> Text Phase Archive s (Operation Analysis))] Handler)) - (function (_ extension-name analyse archive args) + (function (_ extension_name analyse archive args) (case (<c>.run syntax args) (#try.Success inputs) - (handler extension-name analyse archive inputs) + (handler extension_name analyse archive inputs) (#try.Failure _) - (////analysis.throw ///.invalid-syntax [extension-name %.code args])))) + (////analysis.throw ///.invalid_syntax [extension_name %.code args])))) (def: (simple inputsT+ outputT) (-> (List Type) Type Handler) - (let [num-expected (list.size inputsT+)] - (function (_ extension-name analyse archive args) - (let [num-actual (list.size args)] - (if (n.= num-expected num-actual) + (let [num_expected (list.size inputsT+)] + (function (_ extension_name analyse archive args) + (let [num_actual (list.size args)] + (if (n.= num_expected num_actual) (do {! ////.monad} [_ (typeA.infer outputT) argsA (monad.map ! (function (_ [argT argC]) - (typeA.with-type argT + (typeA.with_type argT (analyse archive argC))) (list.zip/2 inputsT+ args))] - (wrap (#////analysis.Extension extension-name argsA))) - (////analysis.throw ///.incorrect-arity [extension-name num-expected num-actual])))))) + (wrap (#////analysis.Extension extension_name argsA))) + (////analysis.throw ///.incorrect_arity [extension_name num_expected num_actual])))))) (def: #export (nullary valueT) (-> Type Handler) @@ -79,38 +79,38 @@ (simple (list subjectT param0T param1T) outputT)) ## TODO: Get rid of this ASAP -(as-is - (exception: #export (char-text-must-be-size-1 {text Text}) +(as_is + (exception: #export (char_text_must_be_size_1 {text Text}) (exception.report ["Text" (%.text text)])) - (def: text-char + (def: text_char (Parser text.Char) (do <>.monad [raw <c>.text] (case (text.size raw) 1 (wrap (|> raw (text.nth 0) maybe.assume)) - _ (<>.fail (exception.construct ..char-text-must-be-size-1 [raw]))))) + _ (<>.fail (exception.construct ..char_text_must_be_size_1 [raw]))))) - (def: lux::syntax-char-case! + (def: lux::syntax_char_case! (..custom [($_ <>.and <c>.any - (<c>.tuple (<>.some (<>.and (<c>.tuple (<>.many ..text-char)) + (<c>.tuple (<>.some (<>.and (<c>.tuple (<>.many ..text_char)) <c>.any))) <c>.any) - (function (_ extension-name phase archive [input conditionals else]) + (function (_ extension_name phase archive [input conditionals else]) (do {! ////.monad} - [input (typeA.with-type text.Char + [input (typeA.with_type text.Char (phase archive input)) - expectedT (///.lift meta.expected-type) + expectedT (///.lift meta.expected_type) conditionals (monad.map ! (function (_ [cases branch]) (do ! - [branch (typeA.with-type expectedT + [branch (typeA.with_type expectedT (phase archive branch))] (wrap [cases branch]))) conditionals) - else (typeA.with-type expectedT + else (typeA.with_type expectedT (phase archive else))] (wrap (|> conditionals (list\map (function (_ [cases branch]) @@ -118,48 +118,48 @@ (list (////analysis.tuple (list\map (|>> ////analysis.nat) cases)) branch)))) (list& input else) - (#////analysis.Extension extension-name)))))]))) + (#////analysis.Extension extension_name)))))]))) ## "lux is" represents reference/pointer equality. (def: lux::is Handler - (function (_ extension-name analyse archive args) + (function (_ extension_name analyse archive args) (do ////.monad - [[var-id varT] (typeA.with-env check.var)] - ((binary varT varT Bit extension-name) + [[var_id varT] (typeA.with_env check.var)] + ((binary varT varT Bit extension_name) analyse archive args)))) ## "lux try" provides a simple way to interact with the host platform's -## error-handling facilities. +## error_handling facilities. (def: lux::try Handler - (function (_ extension-name analyse archive args) + (function (_ extension_name analyse archive args) (case args (^ (list opC)) (do ////.monad - [[var-id varT] (typeA.with-env check.var) + [[var_id varT] (typeA.with_env check.var) _ (typeA.infer (type (Either Text varT))) - opA (typeA.with-type (type (IO varT)) + opA (typeA.with_type (type (IO varT)) (analyse archive opC))] - (wrap (#////analysis.Extension extension-name (list opA)))) + (wrap (#////analysis.Extension extension_name (list opA)))) _ - (////analysis.throw ///.incorrect-arity [extension-name 1 (list.size args)])))) + (////analysis.throw ///.incorrect_arity [extension_name 1 (list.size args)])))) -(def: lux::in-module +(def: lux::in_module Handler - (function (_ extension-name analyse archive argsC+) + (function (_ extension_name analyse archive argsC+) (case argsC+ - (^ (list [_ (#.Text module-name)] exprC)) - (////analysis.with-current-module module-name + (^ (list [_ (#.Text module_name)] exprC)) + (////analysis.with_current_module module_name (analyse archive exprC)) _ - (////analysis.throw ///.invalid-syntax [extension-name %.code argsC+])))) + (////analysis.throw ///.invalid_syntax [extension_name %.code argsC+])))) (def: (lux::check eval) (-> Eval Handler) - (function (_ extension-name analyse archive args) + (function (_ extension_name analyse archive args) (case args (^ (list typeC valueC)) (do {! ////.monad} @@ -167,15 +167,15 @@ actualT (\ ! map (|>> (:coerce Type)) (eval archive count Type typeC)) _ (typeA.infer actualT)] - (typeA.with-type actualT + (typeA.with_type actualT (analyse archive valueC))) _ - (////analysis.throw ///.incorrect-arity [extension-name 2 (list.size args)])))) + (////analysis.throw ///.incorrect_arity [extension_name 2 (list.size args)])))) (def: (lux::coerce eval) (-> Eval Handler) - (function (_ extension-name analyse archive args) + (function (_ extension_name analyse archive args) (case args (^ (list typeC valueC)) (do {! ////.monad} @@ -183,53 +183,53 @@ actualT (\ ! map (|>> (:coerce Type)) (eval archive count Type typeC)) _ (typeA.infer actualT) - [valueT valueA] (typeA.with-inference + [valueT valueA] (typeA.with_inference (analyse archive valueC))] (wrap valueA)) _ - (////analysis.throw ///.incorrect-arity [extension-name 2 (list.size args)])))) + (////analysis.throw ///.incorrect_arity [extension_name 2 (list.size args)])))) (def: (caster input output) (-> Type Type Handler) (..custom [<c>.any - (function (_ extension-name phase archive valueC) + (function (_ extension_name phase archive valueC) (do {! ////.monad} [_ (typeA.infer output)] - (typeA.with-type input + (typeA.with_type input (phase archive valueC))))])) (def: lux::macro Handler (..custom [<c>.any - (function (_ extension-name phase archive valueC) + (function (_ extension_name phase archive valueC) (do {! ////.monad} [_ (typeA.infer .Macro) - input-type (loop [input-name (name-of .Macro')] + input_type (loop [input_name (name_of .Macro')] (do ! - [input-type (///.lift (meta.find-def (name-of .Macro')))] - (case input-type - (#.Definition [exported? def-type def-data def-value]) - (wrap (:coerce Type def-value)) + [input_type (///.lift (meta.find_def (name_of .Macro')))] + (case input_type + (#.Definition [exported? def_type def_data def_value]) + (wrap (:coerce Type def_value)) - (#.Alias real-name) - (recur real-name))))] - (typeA.with-type input-type + (#.Alias real_name) + (recur real_name))))] + (typeA.with_type input_type (phase archive valueC))))])) (def: (bundle::lux eval) (-> Eval Bundle) (|> ///bundle.empty - (///bundle.install "syntax char case!" lux::syntax-char-case!) + (///bundle.install "syntax char case!" lux::syntax_char_case!) (///bundle.install "is" lux::is) (///bundle.install "try" lux::try) (///bundle.install "check" (lux::check eval)) (///bundle.install "coerce" (lux::coerce eval)) (///bundle.install "macro" ..lux::macro) (///bundle.install "check type" (..caster .Type .Type)) - (///bundle.install "in-module" lux::in-module))) + (///bundle.install "in-module" lux::in_module))) (def: bundle::io Bundle diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/bundle.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/bundle.lux index 1004c55f8..147904b62 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/bundle.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/bundle.lux @@ -25,4 +25,4 @@ (-> Text (-> (Bundle s i o) (Bundle s i o)))) (|>> dictionary.entries (list\map (function (_ [key val]) [(format prefix " " key) val])) - (dictionary.from-list text.hash))) + (dictionary.from_list text.hash))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux index a1adf0041..76c9554b7 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux @@ -51,18 +51,18 @@ s (Operation anchor expression directive Requirements))] (Handler anchor expression directive))) - (function (_ extension-name phase archive inputs) + (function (_ extension_name phase archive inputs) (case (s.run syntax inputs) (#try.Success inputs) - (handler extension-name phase archive inputs) + (handler extension_name phase archive inputs) (#try.Failure error) - (phase.throw ///.invalid-syntax [extension-name %.code inputs])))) + (phase.throw ///.invalid_syntax [extension_name %.code inputs])))) -(def: (context [module-id artifact-id]) +(def: (context [module_id artifact_id]) (-> Context Context) ## TODO: Find a better way that doesn't rely on clever tricks. - [module-id (n.- (inc artifact-id) 0)]) + [module_id (n.- (inc artifact_id) 0)]) ## TODO: Inline "evaluate!'" into "evaluate!" ASAP (def: (evaluate!' archive generate code//type codeS) @@ -72,29 +72,29 @@ Type Synthesis (Operation anchor expression directive [Type expression Any]))) - (/////directive.lift-generation + (/////directive.lift_generation (do phase.monad [module /////generation.module id /////generation.next codeG (generate archive codeS) - module-id (/////generation.module-id module archive) - codeV (/////generation.evaluate! (..context [module-id id]) codeG)] + module_id (/////generation.module_id module archive) + codeV (/////generation.evaluate! (..context [module_id id]) codeG)] (wrap [code//type codeG codeV])))) (def: #export (evaluate! archive type codeC) (All [anchor expression directive] (-> Archive Type Code (Operation anchor expression directive [Type expression Any]))) (do phase.monad - [state (///.lift phase.get-state) + [state (///.lift phase.get_state) #let [analyse (get@ [#/////directive.analysis #/////directive.phase] state) synthesize (get@ [#/////directive.synthesis #/////directive.phase] state) generate (get@ [#/////directive.generation #/////directive.phase] state)] - [_ codeA] (/////directive.lift-analysis - (/////analysis.with-scope - (typeA.with-fresh-env - (typeA.with-type type + [_ codeA] (/////directive.lift_analysis + (/////analysis.with_scope + (typeA.with_fresh_env + (typeA.with_type type (analyse archive codeC))))) - codeS (/////directive.lift-synthesis + codeS (/////directive.lift_synthesis (synthesize archive codeA))] (evaluate!' archive generate type codeS))) @@ -107,12 +107,12 @@ Type Synthesis (Operation anchor expression directive [Type expression Any]))) - (/////directive.lift-generation + (/////directive.lift_generation (do phase.monad [codeG (generate archive codeS) id (/////generation.learn name) - module-id (phase.lift (archive.id module archive)) - [target-name value directive] (/////generation.define! [module-id id] codeG) + module_id (phase.lift (archive.id module archive)) + [target_name value directive] (/////generation.define! [module_id id] codeG) _ (/////generation.save! (%.nat id) directive)] (wrap [code//type codeG value])))) @@ -121,28 +121,28 @@ (-> Archive Name (Maybe Type) Code (Operation anchor expression directive [Type expression Any]))) (do {! phase.monad} - [state (///.lift phase.get-state) + [state (///.lift phase.get_state) #let [analyse (get@ [#/////directive.analysis #/////directive.phase] state) synthesize (get@ [#/////directive.synthesis #/////directive.phase] state) generate (get@ [#/////directive.generation #/////directive.phase] state)] - [_ code//type codeA] (/////directive.lift-analysis - (/////analysis.with-scope - (typeA.with-fresh-env + [_ code//type codeA] (/////directive.lift_analysis + (/////analysis.with_scope + (typeA.with_fresh_env (case expected #.None (do ! - [[code//type codeA] (typeA.with-inference + [[code//type codeA] (typeA.with_inference (analyse archive codeC)) - code//type (typeA.with-env + code//type (typeA.with_env (check.clean code//type))] (wrap [code//type codeA])) (#.Some expected) (do ! - [codeA (typeA.with-type expected + [codeA (typeA.with_type expected (analyse archive codeC))] (wrap [expected codeA])))))) - codeS (/////directive.lift-synthesis + codeS (/////directive.lift_synthesis (synthesize archive codeA))] (definition' archive generate name code//type codeS))) @@ -157,14 +157,14 @@ Synthesis (Operation anchor expression directive [expression Any]))) (do phase.monad - [current-module (/////directive.lift-analysis - (///.lift meta.current-module-name))] - (/////directive.lift-generation + [current_module (/////directive.lift_analysis + (///.lift meta.current_module_name))] + (/////directive.lift_generation (do phase.monad [codeG (generate archive codeS) - module-id (phase.lift (archive.id current-module archive)) + module_id (phase.lift (archive.id current_module archive)) id (<learn> extension) - [target-name value directive] (/////generation.define! [module-id id] codeG) + [target_name value directive] (/////generation.define! [module_id id] codeG) _ (/////generation.save! (%.nat id) directive)] (wrap [codeG value]))))) @@ -173,86 +173,86 @@ (-> Archive Text Type Code (Operation anchor expression directive [expression Any]))) (do phase.monad - [state (///.lift phase.get-state) + [state (///.lift phase.get_state) #let [analyse (get@ [#/////directive.analysis #/////directive.phase] state) synthesize (get@ [#/////directive.synthesis #/////directive.phase] state) generate (get@ [#/////directive.generation #/////directive.phase] state)] - [_ codeA] (/////directive.lift-analysis - (/////analysis.with-scope - (typeA.with-fresh-env - (typeA.with-type codeT + [_ codeA] (/////directive.lift_analysis + (/////analysis.with_scope + (typeA.with_fresh_env + (typeA.with_type codeT (analyse archive codeC))))) - codeS (/////directive.lift-synthesis + codeS (/////directive.lift_synthesis (synthesize archive codeA))] (<partial> archive generate extension codeT codeS)))] - [analyser analyser' /////generation.learn-analyser] - [synthesizer synthesizer' /////generation.learn-synthesizer] - [generator generator' /////generation.learn-generator] - [directive directive' /////generation.learn-directive] + [analyser analyser' /////generation.learn_analyser] + [synthesizer synthesizer' /////generation.learn_synthesizer] + [generator generator' /////generation.learn_generator] + [directive directive' /////generation.learn_directive] ) -(def: (refresh expander host-analysis) +(def: (refresh expander host_analysis) (All [anchor expression directive] (-> Expander /////analysis.Bundle (Operation anchor expression directive Any))) (do phase.monad - [[bundle state] phase.get-state + [[bundle state] phase.get_state #let [eval (/////analysis/evaluation.evaluator expander (get@ [#/////directive.synthesis #/////directive.state] state) (get@ [#/////directive.generation #/////directive.state] state) (get@ [#/////directive.generation #/////directive.phase] state))]] - (phase.set-state [bundle + (phase.set_state [bundle (update@ [#/////directive.analysis #/////directive.state] (: (-> /////analysis.State+ /////analysis.State+) (|>> product.right - [(///analysis.bundle eval host-analysis)])) + [(///analysis.bundle eval host_analysis)])) state)]))) -(def: (announce-definition! name) +(def: (announce_definition! name) (All [anchor expression directive] (-> Name (Operation anchor expression directive Any))) - (/////directive.lift-generation + (/////directive.lift_generation (/////generation.log! (format "Definition " (%.name name))))) -(def: (lux::def expander host-analysis) +(def: (lux::def expander host_analysis) (-> Expander /////analysis.Bundle Handler) - (function (_ extension-name phase archive inputsC+) + (function (_ extension_name phase archive inputsC+) (case inputsC+ - (^ (list [_ (#.Identifier ["" short-name])] valueC annotationsC [_ (#.Bit exported?)])) + (^ (list [_ (#.Identifier ["" short_name])] valueC annotationsC [_ (#.Bit exported?)])) (do phase.monad - [current-module (/////directive.lift-analysis - (///.lift meta.current-module-name)) - #let [full-name [current-module short-name]] - [type valueT value] (..definition archive full-name #.None valueC) + [current_module (/////directive.lift_analysis + (///.lift meta.current_module_name)) + #let [full_name [current_module short_name]] + [type valueT value] (..definition archive full_name #.None valueC) [_ annotationsT annotations] (evaluate! archive Code annotationsC) - _ (/////directive.lift-analysis - (module.define short-name (#.Right [exported? type (:coerce Code annotations) value]))) - _ (..refresh expander host-analysis) - _ (..announce-definition! full-name)] - (wrap /////directive.no-requirements)) + _ (/////directive.lift_analysis + (module.define short_name (#.Right [exported? type (:coerce Code annotations) value]))) + _ (..refresh expander host_analysis) + _ (..announce_definition! full_name)] + (wrap /////directive.no_requirements)) _ - (phase.throw ///.invalid-syntax [extension-name %.code inputsC+])))) + (phase.throw ///.invalid_syntax [extension_name %.code inputsC+])))) -(def: (def::type-tagged expander host-analysis) +(def: (def::type_tagged expander host_analysis) (-> Expander /////analysis.Bundle Handler) (..custom - [($_ p.and s.local-identifier s.any s.any (s.tuple (p.some s.text)) s.bit) - (function (_ extension-name phase archive [short-name valueC annotationsC tags exported?]) + [($_ p.and s.local_identifier s.any s.any (s.tuple (p.some s.text)) s.bit) + (function (_ extension_name phase archive [short_name valueC annotationsC tags exported?]) (do phase.monad - [current-module (/////directive.lift-analysis - (///.lift meta.current-module-name)) - #let [full-name [current-module short-name]] + [current_module (/////directive.lift_analysis + (///.lift meta.current_module_name)) + #let [full_name [current_module short_name]] [_ annotationsT annotations] (evaluate! archive Code annotationsC) #let [annotations (:coerce Code annotations)] - [type valueT value] (..definition archive full-name (#.Some .Type) valueC) - _ (/////directive.lift-analysis + [type valueT value] (..definition archive full_name (#.Some .Type) valueC) + _ (/////directive.lift_analysis (do phase.monad - [_ (module.define short-name (#.Right [exported? type annotations value]))] - (module.declare-tags tags exported? (:coerce Type value)))) - _ (..refresh expander host-analysis) - _ (..announce-definition! full-name)] - (wrap /////directive.no-requirements)))])) + [_ (module.define short_name (#.Right [exported? type annotations value]))] + (module.declare_tags tags exported? (:coerce Type value)))) + _ (..refresh expander host_analysis) + _ (..announce_definition! full_name)] + (wrap /////directive.no_requirements)))])) (def: imports (Parser (List Import)) @@ -264,11 +264,11 @@ Handler (..custom [($_ p.and s.any ..imports) - (function (_ extension-name phase archive [annotationsC imports]) + (function (_ extension_name phase archive [annotationsC imports]) (do {! phase.monad} [[_ annotationsT annotationsV] (evaluate! archive Code annotationsC) #let [annotationsV (:coerce Code annotationsV)] - _ (/////directive.lift-analysis + _ (/////directive.lift_analysis (do ! [_ (monad.map ! (function (_ [module alias]) (do ! @@ -277,52 +277,52 @@ "" (wrap []) _ (module.alias alias module)))) imports)] - (module.set-annotations annotationsV)))] + (module.set_annotations annotationsV)))] (wrap {#/////directive.imports imports #/////directive.referrals (list)})))])) -(exception: #export (cannot-alias-an-alias {local Alias} {foreign Alias} {target Name}) +(exception: #export (cannot_alias_an_alias {local Alias} {foreign Alias} {target Name}) (exception.report ["Local alias" (%.name local)] ["Foreign alias" (%.name foreign)] ["Target definition" (%.name target)])) -(def: (define-alias alias original) +(def: (define_alias alias original) (-> Text Name (/////analysis.Operation Any)) (do phase.monad - [current-module (///.lift meta.current-module-name) - constant (///.lift (meta.find-def original))] + [current_module (///.lift meta.current_module_name) + constant (///.lift (meta.find_def original))] (case constant - (#.Left de-aliased) - (phase.throw ..cannot-alias-an-alias [[current-module alias] original de-aliased]) + (#.Left de_aliased) + (phase.throw ..cannot_alias_an_alias [[current_module alias] original de_aliased]) - (#.Right [exported? original-type original-annotations original-value]) + (#.Right [exported? original_type original_annotations original_value]) (module.define alias (#.Left original))))) (def: def::alias Handler (..custom - [($_ p.and s.local-identifier s.identifier) - (function (_ extension-name phase archive [alias def-name]) + [($_ p.and s.local_identifier s.identifier) + (function (_ extension_name phase archive [alias def_name]) (do phase.monad [_ (///.lift (phase.sub [(get@ [#/////directive.analysis #/////directive.state]) (set@ [#/////directive.analysis #/////directive.state])] - (define-alias alias def-name)))] - (wrap /////directive.no-requirements)))])) + (define_alias alias def_name)))] + (wrap /////directive.no_requirements)))])) -(template [<description> <mame> <def-type> <type> <scope> <definer>] +(template [<description> <mame> <def_type> <type> <scope> <definer>] [(def: (<mame> [anchorT expressionT directiveT] extender) (All [anchor expression directive] (-> [Type Type Type] Extender (Handler anchor expression directive))) - (function (handler extension-name phase archive inputsC+) + (function (handler extension_name phase archive inputsC+) (case inputsC+ (^ (list nameC valueC)) (do phase.monad [[_ _ name] (evaluate! archive Text nameC) [_ handlerV] (<definer> archive (:coerce Text name) - (type <def-type>) + (type <def_type>) valueC) _ (<| <scope> (///.install extender (:coerce Text name)) @@ -331,27 +331,27 @@ handler} {<type> (:assume handlerV)})) - _ (/////directive.lift-generation + _ (/////directive.lift_generation (/////generation.log! (format <description> " " (%.text (:coerce Text name)))))] - (wrap /////directive.no-requirements)) + (wrap /////directive.no_requirements)) _ - (phase.throw ///.invalid-syntax [extension-name %.code inputsC+]))))] + (phase.throw ///.invalid_syntax [extension_name %.code inputsC+]))))] ["Analysis" def::analysis /////analysis.Handler /////analysis.Handler - /////directive.lift-analysis + /////directive.lift_analysis ..analyser] ["Synthesis" def::synthesis /////synthesis.Handler /////synthesis.Handler - /////directive.lift-synthesis + /////directive.lift_synthesis ..synthesizer] ["Generation" def::generation (/////generation.Handler anchorT expressionT directiveT) (/////generation.Handler anchor expression directive) - /////directive.lift-generation + /////directive.lift_generation ..generator] ["Directive" def::directive @@ -363,7 +363,7 @@ ## TODO; Both "prepare-program" and "define-program" exist only ## because the old compiler couldn't handle a fully-inlined definition ## for "def::program". Inline them ASAP. -(def: (prepare-program archive analyse synthesize programC) +(def: (prepare_program archive analyse synthesize programC) (All [anchor expression directive output] (-> Archive /////analysis.Phase @@ -371,15 +371,15 @@ Code (Operation anchor expression directive Synthesis))) (do phase.monad - [[_ programA] (/////directive.lift-analysis - (/////analysis.with-scope - (typeA.with-fresh-env - (typeA.with-type (type (-> (List Text) (IO Any))) + [[_ programA] (/////directive.lift_analysis + (/////analysis.with_scope + (typeA.with_fresh_env + (typeA.with_type (type (-> (List Text) (IO Any))) (analyse archive programC)))))] - (/////directive.lift-synthesis + (/////directive.lift_synthesis (synthesize archive programA)))) -(def: (define-program archive module-id generate program programS) +(def: (define_program archive module_id generate program programS) (All [anchor expression directive output] (-> Archive archive.ID @@ -389,32 +389,32 @@ (/////generation.Operation anchor expression directive Any))) (do phase.monad [programG (generate archive programS) - artifact-id (/////generation.learn /////program.name)] - (/////generation.save! (%.nat artifact-id) (program [module-id artifact-id] programG)))) + artifact_id (/////generation.learn /////program.name)] + (/////generation.save! (%.nat artifact_id) (program [module_id artifact_id] programG)))) (def: (def::program program) (All [anchor expression directive] (-> (Program expression directive) (Handler anchor expression directive))) - (function (handler extension-name phase archive inputsC+) + (function (handler extension_name phase archive inputsC+) (case inputsC+ (^ (list programC)) (do phase.monad - [state (///.lift phase.get-state) + [state (///.lift phase.get_state) #let [analyse (get@ [#/////directive.analysis #/////directive.phase] state) synthesize (get@ [#/////directive.synthesis #/////directive.phase] state) generate (get@ [#/////directive.generation #/////directive.phase] state)] - programS (prepare-program archive analyse synthesize programC) - current-module (/////directive.lift-analysis - (///.lift meta.current-module-name)) - module-id (phase.lift (archive.id current-module archive)) - _ (/////directive.lift-generation - (define-program archive module-id generate program programS))] - (wrap /////directive.no-requirements)) + programS (prepare_program archive analyse synthesize programC) + current_module (/////directive.lift_analysis + (///.lift meta.current_module_name)) + module_id (phase.lift (archive.id current_module archive)) + _ (/////directive.lift_generation + (define_program archive module_id generate program programS))] + (wrap /////directive.no_requirements)) _ - (phase.throw ///.invalid-syntax [extension-name %.code inputsC+])))) + (phase.throw ///.invalid_syntax [extension_name %.code inputsC+])))) -(def: (bundle::def expander host-analysis program anchorT,expressionT,directiveT extender) +(def: (bundle::def expander host_analysis program anchorT,expressionT,directiveT extender) (All [anchor expression directive] (-> Expander /////analysis.Bundle @@ -426,7 +426,7 @@ (|> ///bundle.empty (dictionary.put "module" def::module) (dictionary.put "alias" def::alias) - (dictionary.put "type tagged" (def::type-tagged expander host-analysis)) + (dictionary.put "type tagged" (def::type_tagged expander host_analysis)) (dictionary.put "analysis" (def::analysis anchorT,expressionT,directiveT extender)) (dictionary.put "synthesis" (def::synthesis anchorT,expressionT,directiveT extender)) (dictionary.put "generation" (def::generation anchorT,expressionT,directiveT extender)) @@ -434,7 +434,7 @@ (dictionary.put "program" (def::program program)) ))) -(def: #export (bundle expander host-analysis program anchorT,expressionT,directiveT extender) +(def: #export (bundle expander host_analysis program anchorT,expressionT,directiveT extender) (All [anchor expression directive] (-> Expander /////analysis.Bundle @@ -444,5 +444,5 @@ (Bundle anchor expression directive))) (<| (///bundle.prefix "lux") (|> ///bundle.empty - (dictionary.put "def" (lux::def expander host-analysis)) - (dictionary.merge (..bundle::def expander host-analysis program anchorT,expressionT,directiveT extender))))) + (dictionary.put "def" (lux::def expander host_analysis)) + (dictionary.merge (..bundle::def expander host_analysis program anchorT,expressionT,directiveT extender))))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/extension.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/extension.lux index 9ec3d461c..7dbfcd3f9 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/extension.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/extension.lux @@ -8,7 +8,7 @@ [data [collection ["." list ("#\." functor)]]] - ["." meta (#+ with-gensyms)] + ["." meta (#+ with_gensyms)] [macro ["." code] [syntax (#+ syntax:)]]] @@ -29,11 +29,11 @@ (type: #export (Trinary of) (-> (Vector 3 of) of)) (type: #export (Variadic of) (-> (List of) of)) -(syntax: (arity: {arity s.nat} {name s.local-identifier} type) - (with-gensyms [g!_ g!extension g!name g!phase g!archive g!inputs g!of g!anchor g!expression g!directive] +(syntax: (arity: {arity s.nat} {name s.local_identifier} type) + (with_gensyms [g!_ g!extension g!name g!phase g!archive g!inputs g!of g!anchor g!expression g!directive] (do {! meta.monad} [g!input+ (monad.seq ! (list.repeat arity (meta.gensym "input")))] - (wrap (list (` (def: #export ((~ (code.local-identifier name)) (~ g!extension)) + (wrap (list (` (def: #export ((~ (code.local_identifier name)) (~ g!extension)) (All [(~ g!anchor) (~ g!expression) (~ g!directive)] (-> ((~ type) (~ g!expression)) (generation.Handler (~ g!anchor) (~ g!expression) (~ g!directive)))) @@ -48,7 +48,7 @@ ((~' wrap) ((~ g!extension) [(~+ g!input+)]))) (~' _) - (///.throw ///extension.incorrect-arity [(~ g!name) 1 (list.size (~ g!inputs))])))))))))) + (///.throw ///extension.incorrect_arity [(~ g!name) 1 (list.size (~ g!inputs))])))))))))) (arity: 0 nullary ..Nullary) (arity: 1 unary ..Unary) @@ -58,7 +58,7 @@ (def: #export (variadic extension) (All [anchor expression directive] (-> (Variadic expression) (generation.Handler anchor expression directive))) - (function (_ extension-name) + (function (_ extension_name) (function (_ phase archive inputsS) (do {! ///.monad} [inputsI (monad.map ! (phase archive) inputsS)] diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable/partial/count.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable/partial/count.lux index 2701862f1..dbafd7ee5 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable/partial/count.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable/partial/count.lux @@ -20,7 +20,7 @@ (|> +0 signed.s1 try.assume _.bipush)) (def: this - _.aload-0) + _.aload_0) (def: #export value (Bytecode Any) 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 22db73c91..51f647d94 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 @@ -55,12 +55,12 @@ [reference [variable (#+ Register)]] [meta - [io (#+ lux-context)] + [io (#+ lux_context)] [archive (#+ Archive)]]]]]]) -(type: #export Byte-Code Binary) +(type: #export Byte_Code Binary) -(type: #export Definition [Text Byte-Code]) +(type: #export Definition [Text Byte_Code]) (type: #export Anchor [Label Register]) @@ -80,9 +80,9 @@ (type: #export Host (generation.Host (Bytecode Any) Definition)) -(def: #export (class-name [module id]) +(def: #export (class_name [module id]) (-> generation.Context Text) - (format lux-context + (format lux_context "/" (%.nat version.version) "/" (%.nat module) "/" (%.nat id))) @@ -103,7 +103,7 @@ (def: this (Bytecode Any) - _.aload-0) + _.aload_0) (def: #export (get index) (-> (Bytecode Any) (Bytecode Any)) @@ -127,88 +127,88 @@ (def: variant::type (type.method [(list //type.tag //type.flag //type.value) //type.variant (list)])) (def: #export variant (..procedure ..variant::name ..variant::type)) -(def: variant-tag _.iconst-0) -(def: variant-last? _.iconst-1) -(def: variant-value _.iconst-2) +(def: variant_tag _.iconst_0) +(def: variant_last? _.iconst_1) +(def: variant_value _.iconst_2) (def: variant::method - (let [new-variant ($_ _.compose - _.iconst-3 + (let [new_variant ($_ _.compose + _.iconst_3 (_.anewarray //type.value)) $tag ($_ _.compose - _.iload-0 + _.iload_0 (//value.wrap type.int)) - $last? _.aload-1 - $value _.aload-2] + $last? _.aload_1 + $value _.aload_2] (method.method ..modifier ..variant::name ..variant::type (list) (#.Some ($_ _.compose - new-variant ## A[3] - (..set! ..variant-tag $tag) ## A[3] - (..set! ..variant-last? $last?) ## A[3] - (..set! ..variant-value $value) ## A[3] + new_variant ## A[3] + (..set! ..variant_tag $tag) ## A[3] + (..set! ..variant_last? $last?) ## A[3] + (..set! ..variant_value $value) ## A[3] _.areturn))))) -(def: #export left-flag _.aconst-null) -(def: #export right-flag ..unit) +(def: #export left_flag _.aconst_null) +(def: #export right_flag ..unit) -(def: #export left-injection +(def: #export left_injection (Bytecode Any) ($_ _.compose - _.iconst-0 - ..left-flag - _.dup2-x1 + _.iconst_0 + ..left_flag + _.dup2_x1 _.pop2 ..variant)) -(def: #export right-injection +(def: #export right_injection (Bytecode Any) ($_ _.compose - _.iconst-1 - ..right-flag - _.dup2-x1 + _.iconst_1 + ..right_flag + _.dup2_x1 _.pop2 ..variant)) -(def: #export some-injection ..right-injection) +(def: #export some_injection ..right_injection) -(def: #export none-injection +(def: #export none_injection (Bytecode Any) ($_ _.compose - _.iconst-0 - ..left-flag + _.iconst_0 + ..left_flag ..unit ..variant)) (def: (risky $unsafe) (-> (Bytecode Any) (Bytecode Any)) (do _.monad - [@try _.new-label - @handler _.new-label] + [@try _.new_label + @handler _.new_label] ($_ _.compose (_.try @try @handler @handler //type.error) - (_.set-label @try) + (_.set_label @try) $unsafe - ..some-injection + ..some_injection _.areturn - (_.set-label @handler) - ..none-injection + (_.set_label @handler) + ..none_injection _.areturn ))) -(def: decode-frac::name "decode_frac") -(def: decode-frac::type (type.method [(list //type.text) //type.variant (list)])) -(def: #export decode-frac (..procedure ..decode-frac::name ..decode-frac::type)) +(def: decode_frac::name "decode_frac") +(def: decode_frac::type (type.method [(list //type.text) //type.variant (list)])) +(def: #export decode_frac (..procedure ..decode_frac::name ..decode_frac::type)) -(def: decode-frac::method - (method.method ..modifier ..decode-frac::name - ..decode-frac::type +(def: decode_frac::method + (method.method ..modifier ..decode_frac::name + ..decode_frac::type (list) (#.Some (..risky ($_ _.compose - _.aload-0 + _.aload_0 (_.invokestatic //type.frac "parseDouble" (type.method [(list //type.text) type.double (list)])) (//value.wrap type.double) ))))) @@ -218,21 +218,21 @@ (let [^PrintStream (type.class "java.io.PrintStream" (list)) ^System (type.class "java.lang.System" (list)) out (_.getstatic ^System "out" ^PrintStream) - print-type (type.method [(list //type.value) type.void (list)]) - print! (function (_ method) (_.invokevirtual ^PrintStream method print-type))] + print_type (type.method [(list //type.value) type.void (list)]) + print! (function (_ method) (_.invokevirtual ^PrintStream method print_type))] ($_ _.compose out (_.string "LUX LOG: ") (print! "print") out _.swap (print! "println")))) -(def: exception-constructor (type.method [(list //type.text) type.void (list)])) -(def: (illegal-state-exception message) +(def: exception_constructor (type.method [(list //type.text) type.void (list)])) +(def: (illegal_state_exception message) (-> Text (Bytecode Any)) (let [^IllegalStateException (type.class "java.lang.IllegalStateException" (list))] ($_ _.compose (_.new ^IllegalStateException) _.dup (_.string message) - (_.invokespecial ^IllegalStateException "<init>" ..exception-constructor)))) + (_.invokespecial ^IllegalStateException "<init>" ..exception_constructor)))) (def: failure::type (type.method [(list) type.void (list)])) @@ -244,17 +244,17 @@ (list) (#.Some ($_ _.compose - (..illegal-state-exception message) + (..illegal_state_exception message) _.athrow)))) -(def: pm-failure::name "pm_failure") -(def: #export pm-failure (..procedure ..pm-failure::name ..failure::type)) +(def: pm_failure::name "pm_failure") +(def: #export pm_failure (..procedure ..pm_failure::name ..failure::type)) -(def: pm-failure::method - (..failure ..pm-failure::name "Invalid expression for pattern-matching.")) +(def: pm_failure::method + (..failure ..pm_failure::name "Invalid expression for pattern-matching.")) -(def: #export stack-head _.iconst-0) -(def: #export stack-tail _.iconst-1) +(def: #export stack_head _.iconst_0) +(def: #export stack_tail _.iconst_1) (def: push::name "push") (def: push::type (type.method [(list //type.stack //type.value) //type.stack (list)])) @@ -265,15 +265,15 @@ ..push::type (list) (#.Some - (let [new-stack-frame! ($_ _.compose - _.iconst-2 + (let [new_stack_frame! ($_ _.compose + _.iconst_2 (_.anewarray //type.value)) - $head _.aload-1 - $tail _.aload-0] + $head _.aload_1 + $tail _.aload_0] ($_ _.compose - new-stack-frame! - (..set! ..stack-head $head) - (..set! ..stack-tail $tail) + new_stack_frame! + (..set! ..stack_head $head) + (..set! ..stack_tail $tail) _.areturn))))) (def: case::name "case") @@ -285,159 +285,159 @@ (list) (#.Some (do _.monad - [@loop _.new-label - @perfect-match! _.new-label - @tags-match! _.new-label - @maybe-nested _.new-label - @mismatch! _.new-label + [@loop _.new_label + @perfect_match! _.new_label + @tags_match! _.new_label + @maybe_nested _.new_label + @mismatch! _.new_label #let [::tag ($_ _.compose - (..get ..variant-tag) + (..get ..variant_tag) (//value.unwrap type.int)) - ::last? (..get ..variant-last?) - ::value (..get ..variant-value) + ::last? (..get ..variant_last?) + ::value (..get ..variant_value) - $variant _.aload-0 - $tag _.iload-1 - $last? _.aload-2 + $variant _.aload_0 + $tag _.iload_1 + $last? _.aload_2 - not-found _.aconst-null + not_found _.aconst_null - update-$tag _.isub - update-$variant ($_ _.compose + update_$tag _.isub + update_$variant ($_ _.compose $variant ::value (_.checkcast //type.variant) - _.astore-0) + _.astore_0) recur (: (-> Label (Bytecode Any)) - (function (_ @loop-start) + (function (_ @loop_start) ($_ _.compose ## tag, sumT - update-$variant ## tag, sumT - update-$tag ## sub-tag - (_.goto @loop-start)))) + update_$variant ## tag, sumT + update_$tag ## sub_tag + (_.goto @loop_start)))) - super-nested-tag ($_ _.compose + super_nested_tag ($_ _.compose ## tag, sumT _.swap ## sumT, tag _.isub) - super-nested ($_ _.compose + super_nested ($_ _.compose ## tag, sumT - super-nested-tag ## super-tag - $variant ::last? ## super-tag, super-last - $variant ::value ## super-tag, super-last, super-value + super_nested_tag ## super_tag + $variant ::last? ## super_tag, super_last + $variant ::value ## super_tag, super_last, super_value ..variant)]] ($_ _.compose $tag - (_.set-label @loop) + (_.set_label @loop) $variant ::tag - _.dup2 (_.if-icmpeq @tags-match!) - _.dup2 (_.if-icmpgt @maybe-nested) + _.dup2 (_.if_icmpeq @tags_match!) + _.dup2 (_.if_icmpgt @maybe_nested) $last? (_.ifnull @mismatch!) ## tag, sumT - super-nested ## super-variant + super_nested ## super_variant _.areturn - (_.set-label @tags-match!) ## tag, sumT - $last? ## tag, sumT, wants-last? - $variant ::last? ## tag, sumT, wants-last?, is-last? - (_.if-acmpeq @perfect-match!) ## tag, sumT - (_.set-label @maybe-nested) ## tag, sumT + (_.set_label @tags_match!) ## tag, sumT + $last? ## tag, sumT, wants_last? + $variant ::last? ## tag, sumT, wants_last?, is_last? + (_.if_acmpeq @perfect_match!) ## tag, sumT + (_.set_label @maybe_nested) ## tag, sumT $variant ::last? ## tag, sumT, last? (_.ifnull @mismatch!) ## tag, sumT (recur @loop) - (_.set-label @perfect-match!) ## tag, sumT + (_.set_label @perfect_match!) ## tag, sumT ## _.pop2 $variant ::value _.areturn - (_.set-label @mismatch!) ## tag, sumT + (_.set_label @mismatch!) ## tag, sumT ## _.pop2 - not-found + not_found _.areturn ))))) -(def: projection-type (type.method [(list //type.tuple //type.offset) //type.value (list)])) +(def: projection_type (type.method [(list //type.tuple //type.offset) //type.value (list)])) -(def: left-projection::name "left") -(def: #export left-projection (..procedure ..left-projection::name ..projection-type)) +(def: left_projection::name "left") +(def: #export left_projection (..procedure ..left_projection::name ..projection_type)) -(def: right-projection::name "right") -(def: #export right-projection (..procedure ..right-projection::name ..projection-type)) +(def: right_projection::name "right") +(def: #export right_projection (..procedure ..right_projection::name ..projection_type)) (def: projection::method2 [(Resource Method) (Resource Method)] - (let [$tuple _.aload-0 + (let [$tuple _.aload_0 $tuple::size ($_ _.compose $tuple _.arraylength) - $lefts _.iload-1 + $lefts _.iload_1 - $last-right ($_ _.compose - $tuple::size _.iconst-1 _.isub) + $last_right ($_ _.compose + $tuple::size _.iconst_1 _.isub) - update-$lefts ($_ _.compose - $lefts $last-right _.isub - _.istore-1) - update-$tuple ($_ _.compose - $tuple $last-right _.aaload (_.checkcast //type.tuple) - _.astore-0) + update_$lefts ($_ _.compose + $lefts $last_right _.isub + _.istore_1) + update_$tuple ($_ _.compose + $tuple $last_right _.aaload (_.checkcast //type.tuple) + _.astore_0) recur (: (-> Label (Bytecode Any)) (function (_ @loop) ($_ _.compose - update-$lefts - update-$tuple + update_$lefts + update_$tuple (_.goto @loop)))) - left-projection::method - (method.method ..modifier ..left-projection::name ..projection-type + left_projection::method + (method.method ..modifier ..left_projection::name ..projection_type (list) (#.Some (do _.monad - [@loop _.new-label - @recursive _.new-label + [@loop _.new_label + @recursive _.new_label #let [::left ($_ _.compose $lefts _.aaload)]] ($_ _.compose - (_.set-label @loop) - $lefts $last-right (_.if-icmpge @recursive) + (_.set_label @loop) + $lefts $last_right (_.if_icmpge @recursive) $tuple ::left _.areturn - (_.set-label @recursive) + (_.set_label @recursive) ## Recursive (recur @loop))))) - right-projection::method - (method.method ..modifier ..right-projection::name ..projection-type + right_projection::method + (method.method ..modifier ..right_projection::name ..projection_type (list) (#.Some (do _.monad - [@loop _.new-label - @not-tail _.new-label - @slice _.new-label + [@loop _.new_label + @not_tail _.new_label + @slice _.new_label #let [$right ($_ _.compose $lefts - _.iconst-1 + _.iconst_1 _.iadd) $::nested ($_ _.compose $tuple _.swap _.aaload) - super-nested ($_ _.compose + super_nested ($_ _.compose $tuple $right $tuple::size (_.invokestatic (type.class "java.util.Arrays" (list)) "copyOfRange" (type.method [(list //type.tuple //type.index //type.index) //type.tuple (list)])))]] ($_ _.compose - (_.set-label @loop) - $last-right $right - _.dup2 (_.if-icmpne @not-tail) + (_.set_label @loop) + $last_right $right + _.dup2 (_.if_icmpne @not_tail) ## _.pop $::nested _.areturn - (_.set-label @not-tail) - (_.if-icmpgt @slice) + (_.set_label @not_tail) + (_.if_icmpgt @slice) ## Must recurse (recur @loop) - (_.set-label @slice) - super-nested + (_.set_label @slice) + super_nested _.areturn))))] - [left-projection::method - right-projection::method])) + [left_projection::method + right_projection::method])) (def: #export apply::name "apply") @@ -452,30 +452,30 @@ (def: try::type (type.method [(list //function.class) //type.variant (list)])) (def: #export try (..procedure ..try::name ..try::type)) -(def: false _.iconst-0) -(def: true _.iconst-1) +(def: false _.iconst_0) +(def: true _.iconst_1) (def: try::method (method.method ..modifier ..try::name ..try::type (list) (#.Some (do _.monad - [@try _.new-label - @handler _.new-label + [@try _.new_label + @handler _.new_label #let [$unsafe ..this - unit _.aconst-null + unit _.aconst_null ^StringWriter (type.class "java.io.StringWriter" (list)) - string-writer ($_ _.compose + string_writer ($_ _.compose (_.new ^StringWriter) _.dup (_.invokespecial ^StringWriter "<init>" (type.method [(list) type.void (list)]))) ^PrintWriter (type.class "java.io.PrintWriter" (list)) - print-writer ($_ _.compose + print_writer ($_ _.compose ## WTW (_.new ^PrintWriter) ## WTWP - _.dup-x1 ## WTPWP + _.dup_x1 ## WTPWP _.swap ## WTPPW ..true ## WTPPWZ (_.invokespecial ^PrintWriter "<init>" (type.method [(list (type.class "java.io.Writer" (list)) type.boolean) type.void (list)])) @@ -483,16 +483,16 @@ )]] ($_ _.compose (_.try @try @handler @handler //type.error) - (_.set-label @try) + (_.set_label @try) $unsafe unit ..apply - ..right-injection _.areturn - (_.set-label @handler) ## T - string-writer ## TW - _.dup-x1 ## WTW - print-writer ## WTP + ..right_injection _.areturn + (_.set_label @handler) ## T + string_writer ## TW + _.dup_x1 ## WTW + print_writer ## WTP (_.invokevirtual //type.error "printStackTrace" (type.method [(list ^PrintWriter) type.void (list)])) ## W (_.invokevirtual ^StringWriter "toString" (type.method [(list) //type.text (list)])) ## S - ..left-injection _.areturn + ..left_injection _.areturn ))))) (def: reflection @@ -502,7 +502,7 @@ (def: ^Object (type.class "java.lang.Object" (list))) -(def: generate-runtime +(def: generate_runtime (Operation Any) (let [class (..reflection ..class) modifier (: (Modifier Class) @@ -516,16 +516,16 @@ (name.internal class) (name.internal (..reflection ^Object)) (list) (list) - (let [[left-projection::method right-projection::method] projection::method2] - (list ..decode-frac::method + (let [[left_projection::method right_projection::method] projection::method2] + (list ..decode_frac::method ..variant::method - ..pm-failure::method + ..pm_failure::method ..push::method ..case::method - left-projection::method - right-projection::method + left_projection::method + right_projection::method ..try::method)) (row.row)))] @@ -533,7 +533,7 @@ [_ (generation.execute! [class bytecode])] (generation.save! class [class bytecode])))) -(def: generate-function +(def: generate_function (Operation Any) (let [apply::method+ (|> (enum.range n.enum (inc //function/arity.minimum) @@ -542,11 +542,11 @@ (method.method method.public ..apply::name (..apply::type arity) (list) (#.Some - (let [previous-inputs (|> arity + (let [previous_inputs (|> arity list.indices (monad.map _.monad _.aload))] ($_ _.compose - previous-inputs + previous_inputs (_.invokevirtual //function.class ..apply::name (..apply::type (dec arity))) (_.checkcast //function.class) (_.aload arity) @@ -559,7 +559,7 @@ <init>::method (method.method method.public "<init>" //function.init (list) (#.Some - (let [$partials _.iload-1] + (let [$partials _.iload_1] ($_ _.compose ..this (_.invokespecial ^Object "<init>" (type.method [(list) type.void (list)])) @@ -572,7 +572,7 @@ class.public class.abstract)) class (..reflection //function.class) - partial-count (: (Resource Field) + partial_count (: (Resource Field) (field.field (modifier\compose field.public field.final) //function/count.field //function/count.type @@ -583,7 +583,7 @@ modifier (name.internal class) (name.internal (..reflection ^Object)) (list) - (list partial-count) + (list partial_count) (list& <init>::method apply::method+) (row.row)))] (do ////.monad @@ -593,13 +593,13 @@ (def: #export generate (Operation Any) (do ////.monad - [_ ..generate-runtime] - ..generate-function)) + [_ ..generate_runtime] + ..generate_function)) -(def: #export forge-label +(def: #export forge_label (Operation Label) (let [shift (n./ 4 i64.width)] ## This shift is done to avoid the possibility of forged labels ## to be in the range of the labels that are generated automatically ## during the evaluation of Bytecode expressions. - (\ ////.monad map (i64.left-shift shift) generation.next))) + (\ ////.monad map (i64.left_shift shift) generation.next))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis.lux index 278f819ce..8bb16efeb 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis.lux @@ -50,7 +50,7 @@ (phase\wrap (#/.Primitive (..primitive analysis'))) (#///analysis.Structure structure) - (/.with-currying? false + (/.with_currying? false (case structure (#///analysis.Variant variant) (do phase.monad @@ -66,21 +66,21 @@ (phase\wrap (#/.Reference reference)) (#///analysis.Case inputA branchesAB+) - (/.with-currying? false + (/.with_currying? false (/case.synthesize optimization branchesAB+ archive inputA)) - (^ (///analysis.no-op value)) + (^ (///analysis.no_op value)) (optimization' value) (#///analysis.Apply _) - (/.with-currying? false + (/.with_currying? false (/function.apply optimization archive analysis)) (#///analysis.Function environmentA bodyA) (/function.abstraction optimization environmentA archive bodyA) (#///analysis.Extension name args) - (/.with-currying? false + (/.with_currying? false (function (_ state) (|> (//extension.apply archive optimization [name args]) (phase.run' state) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/case.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/case.lux index c9b1757ce..057302ef7 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/case.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/case.lux @@ -27,7 +27,7 @@ [meta [archive (#+ Archive)]]]]]) -(def: clean-up +(def: clean_up (-> Path Path) (|>> (#/.Seq #/.Pop))) @@ -41,7 +41,7 @@ (#///analysis.Bit when) (///\map (function (_ then) - (#/.Bit-Fork when then #.None)) + (#/.Bit_Fork when then #.None)) thenC) (^template [<from> <to> <conversion>] @@ -49,23 +49,23 @@ (///\map (function (_ then) (<to> [(<conversion> test) then] (list))) thenC)]) - ([#///analysis.Nat #/.I64-Fork .i64] - [#///analysis.Int #/.I64-Fork .i64] - [#///analysis.Rev #/.I64-Fork .i64] - [#///analysis.Frac #/.F64-Fork |>] - [#///analysis.Text #/.Text-Fork |>])) + ([#///analysis.Nat #/.I64_Fork .i64] + [#///analysis.Int #/.I64_Fork .i64] + [#///analysis.Rev #/.I64_Fork .i64] + [#///analysis.Frac #/.F64_Fork |>] + [#///analysis.Text #/.Text_Fork |>])) (#///analysis.Bind register) (<| (\ ///.monad map (|>> (#/.Seq (#/.Bind register)))) - /.with-new-local + /.with_new_local thenC) - (#///analysis.Complex (#///analysis.Variant [lefts right? value-pattern])) + (#///analysis.Complex (#///analysis.Variant [lefts right? value_pattern])) (<| (///\map (|>> (#/.Seq (#/.Access (#/.Side (if right? (#.Right lefts) (#.Left lefts))))))) - (path' value-pattern end?) - (when> [(new> (not end?) [])] [(///\map ..clean-up)]) + (path' value_pattern end?) + (when> [(new> (not end?) [])] [(///\map ..clean_up)]) thenC) (#///analysis.Complex (#///analysis.Tuple tuple)) @@ -82,7 +82,7 @@ (#.Right (dec tuple::lefts)) (#.Left tuple::lefts))))))) (path' tuple::member end?') - (when> [(new> (not end?') [])] [(///\map ..clean-up)]) + (when> [(new> (not end?') [])] [(///\map ..clean_up)]) nextC)))) thenC (list.reverse (list.enumeration tuple)))) @@ -92,32 +92,32 @@ (-> Archive Phase Pattern Analysis (Operation Path)) (path' pattern true (///\map (|>> #/.Then) (synthesize archive bodyA)))) -(def: (weave-branch weave equivalence [new-test new-then] [[old-test old-then] old-tail]) +(def: (weave_branch weave equivalence [new_test new_then] [[old_test old_then] old_tail]) (All [a] (-> (-> Path Path Path) (Equivalence a) [a Path] (/.Fork a Path) (/.Fork a Path))) - (if (\ equivalence = new-test old-test) - [[old-test (weave new-then old-then)] old-tail] - [[old-test old-then] - (case old-tail + (if (\ equivalence = new_test old_test) + [[old_test (weave new_then old_then)] old_tail] + [[old_test old_then] + (case old_tail #.Nil - (list [new-test new-then]) + (list [new_test new_then]) - (#.Cons old-cons) - (#.Cons (weave-branch weave equivalence [new-test new-then] old-cons)))])) + (#.Cons old_cons) + (#.Cons (weave_branch weave equivalence [new_test new_then] old_cons)))])) -(def: (weave-fork weave equivalence new-fork old-fork) +(def: (weave_fork weave equivalence new_fork old_fork) (All [a] (-> (-> Path Path Path) (Equivalence a) (/.Fork a Path) (/.Fork a Path) (/.Fork a Path))) - (list\fold (..weave-branch weave equivalence) old-fork (#.Cons new-fork))) + (list\fold (..weave_branch weave equivalence) old_fork (#.Cons new_fork))) (def: (weave new old) (-> Path Path Path) - (with-expansions [<default> (as-is (#/.Alt old new))] + (with_expansions [<default> (as_is (#/.Alt old new))] (case [new old] [_ - (#/.Alt old-left old-right)] - (#/.Alt old-left - (weave new old-right)) + (#/.Alt old_left old_right)] + (#/.Alt old_left + (weave new old_right)) [(#/.Seq preN postN) (#/.Seq preO postO)] @@ -131,41 +131,41 @@ [#/.Pop #/.Pop] old - [(#/.Bit-Fork new-when new-then new-else) - (#/.Bit-Fork old-when old-then old-else)] - (if (bit\= new-when old-when) - (#/.Bit-Fork old-when - (weave new-then old-then) - (case [new-else old-else] + [(#/.Bit_Fork new_when new_then new_else) + (#/.Bit_Fork old_when old_then old_else)] + (if (bit\= new_when old_when) + (#/.Bit_Fork old_when + (weave new_then old_then) + (case [new_else old_else] [#.None #.None] #.None - (^or [(#.Some woven-then) #.None] - [#.None (#.Some woven-then)]) - (#.Some woven-then) + (^or [(#.Some woven_then) #.None] + [#.None (#.Some woven_then)]) + (#.Some woven_then) - [(#.Some new-else) (#.Some old-else)] - (#.Some (weave new-else old-else)))) - (#/.Bit-Fork old-when - (case new-else + [(#.Some new_else) (#.Some old_else)] + (#.Some (weave new_else old_else)))) + (#/.Bit_Fork old_when + (case new_else #.None - old-then + old_then - (#.Some new-else) - (weave new-else old-then)) - (#.Some (case old-else + (#.Some new_else) + (weave new_else old_then)) + (#.Some (case old_else #.None - new-then + new_then - (#.Some old-else) - (weave new-then old-else))))) + (#.Some old_else) + (weave new_then old_else))))) (^template [<tag> <equivalence>] - [[(<tag> new-fork) (<tag> old-fork)] - (<tag> (..weave-fork weave <equivalence> new-fork old-fork))]) - ([#/.I64-Fork i64.equivalence] - [#/.F64-Fork frac.equivalence] - [#/.Text-Fork text.equivalence]) + [[(<tag> new_fork) (<tag> old_fork)] + (<tag> (..weave_fork weave <equivalence> new_fork old_fork))]) + ([#/.I64_Fork i64.equivalence] + [#/.F64_Fork frac.equivalence] + [#/.Text_Fork text.equivalence]) (^template [<access> <side>] [[(#/.Access (<access> (<side> newL))) @@ -190,10 +190,10 @@ (-> (///analysis.Tuple ///analysis.Pattern) Register (List /.Member)) (loop [lefts 0 patterns patterns] - (with-expansions [<failure> (as-is (list)) - <continue> (as-is (recur (inc lefts) + (with_expansions [<failure> (as_is (list)) + <continue> (as_is (recur (inc lefts) tail)) - <member> (as-is (if (list.empty? tail) + <member> (as_is (if (list.empty? tail) (#.Right (dec lefts)) (#.Left lefts)))] (case patterns @@ -210,18 +210,18 @@ (list <member>) <continue>) - (#///analysis.Complex (#///analysis.Tuple sub-patterns)) - (case (get sub-patterns @selection) + (#///analysis.Complex (#///analysis.Tuple sub_patterns)) + (case (get sub_patterns @selection) #.Nil <continue> - sub-members - (list& <member> sub-members)) + sub_members + (list& <member> sub_members)) _ <failure>))))) -(def: #export (synthesize-case synthesize archive input [[headP headA] tailPA+]) +(def: #export (synthesize_case synthesize archive input [[headP headA] tailPA+]) (-> Phase Archive Synthesis Match (Operation Synthesis)) (do {! ///.monad} [headSP (path archive synthesize headP headA) @@ -233,20 +233,20 @@ (#///analysis.Reference (///reference.local <output>))] (list)]) -(def: #export (synthesize-let synthesize archive input @variable body) +(def: #export (synthesize_let synthesize archive input @variable body) (-> Phase Archive Synthesis Register Analysis (Operation Synthesis)) (do ///.monad - [body (/.with-new-local + [body (/.with_new_local (synthesize archive body))] (wrap (/.branch/let [input @variable body])))) -(def: #export (synthesize-masking synthesize archive input @variable @output) +(def: #export (synthesize_masking synthesize archive input @variable @output) (-> Phase Archive Synthesis Register Register (Operation Synthesis)) (if (n.= @variable @output) (///\wrap input) - (..synthesize-let synthesize archive input @variable (#///analysis.Reference (///reference.local @output))))) + (..synthesize_let synthesize archive input @variable (#///analysis.Reference (///reference.local @output))))) -(def: #export (synthesize-if synthesize archive test then else) +(def: #export (synthesize_if synthesize archive test then else) (-> Phase Archive Synthesis Analysis Analysis (Operation Synthesis)) (do ///.monad [then (synthesize archive then) @@ -258,16 +258,16 @@ (#///analysis.Reference (///reference.local <output>))] (.list)]) -(def: #export (synthesize-get synthesize archive input patterns @member) +(def: #export (synthesize_get synthesize archive input patterns @member) (-> Phase Archive Synthesis (///analysis.Tuple ///analysis.Pattern) Register (Operation Synthesis)) (case (..get patterns @member) #.Nil - (..synthesize-case synthesize archive input (!get patterns @member)) + (..synthesize_case synthesize archive input (!get patterns @member)) path (case input - (^ (/.branch/get [sub-path sub-input])) - (///\wrap (/.branch/get [(list\compose path sub-path) sub-input])) + (^ (/.branch/get [sub_path sub_input])) + (///\wrap (/.branch/get [(list\compose path sub_path) sub_input])) _ (///\wrap (/.branch/get [path input]))))) @@ -278,11 +278,11 @@ [inputS (synthesize^ archive inputA)] (case [headB tailB+] (^ (!masking @variable @output)) - (..synthesize-masking synthesize^ archive inputS @variable @output) + (..synthesize_masking synthesize^ archive inputS @variable @output) [[(#///analysis.Bind @variable) body] #.Nil] - (..synthesize-let synthesize^ archive inputS @variable body) + (..synthesize_let synthesize^ archive inputS @variable body) (^or (^ [[(///analysis.pattern/bit #1) then] (list [(///analysis.pattern/bit #0) else])]) @@ -293,25 +293,25 @@ (list [(///analysis.pattern/bit #1) then])]) (^ [[(///analysis.pattern/bit #0) else] (list [(///analysis.pattern/unit) then])])) - (..synthesize-if synthesize^ archive inputS then else) + (..synthesize_if synthesize^ archive inputS then else) (^ (!get patterns @member)) - (..synthesize-get synthesize^ archive inputS patterns @member) + (..synthesize_get synthesize^ archive inputS patterns @member) match - (..synthesize-case synthesize^ archive inputS match)))) + (..synthesize_case synthesize^ archive inputS match)))) -(def: #export (count-pops path) +(def: #export (count_pops path) (-> Path [Nat Path]) (case path (^ (/.path/seq #/.Pop path')) - (let [[pops post-pops] (count-pops path')] - [(inc pops) post-pops]) + (let [[pops post_pops] (count_pops path')] + [(inc pops) post_pops]) _ [0 path])) -(def: #export pattern-matching-error +(def: #export pattern_matching_error "Invalid expression for pattern-matching.") (type: #export Storage @@ -331,64 +331,64 @@ ## Apply this trick to JS, Python et al. (def: #export (storage path) (-> Path Storage) - (loop for-path + (loop for_path [path path - path-storage ..empty] + path_storage ..empty] (case path (^ (/.path/bind register)) (update@ #bindings (set.add (#///reference/variable.Local register)) - path-storage) + path_storage) (^or (^ (/.path/seq left right)) (^ (/.path/alt left right))) - (list\fold for-path path-storage (list left right)) + (list\fold for_path path_storage (list left right)) (^ (/.path/then bodyS)) - (loop for-synthesis + (loop for_synthesis [bodyS bodyS - synthesis-storage path-storage] + synthesis_storage path_storage] (case bodyS (^ (/.variant [lefts right? valueS])) - (for-synthesis valueS synthesis-storage) + (for_synthesis valueS synthesis_storage) (^ (/.tuple members)) - (list\fold for-synthesis synthesis-storage members) + (list\fold for_synthesis synthesis_storage members) (#/.Reference (#///reference.Variable var)) - (if (set.member? (get@ #bindings synthesis-storage) var) - synthesis-storage - (update@ #dependencies (set.add var) synthesis-storage)) + (if (set.member? (get@ #bindings synthesis_storage) var) + synthesis_storage + (update@ #dependencies (set.add var) synthesis_storage)) (^ (/.function/apply [functionS argsS])) - (list\fold for-synthesis synthesis-storage (#.Cons functionS argsS)) + (list\fold for_synthesis synthesis_storage (#.Cons functionS argsS)) (^ (/.function/abstraction [environment arity bodyS])) - (list\fold for-synthesis synthesis-storage environment) + (list\fold for_synthesis synthesis_storage environment) (^ (/.branch/let [inputS register exprS])) - (list\fold for-synthesis + (list\fold for_synthesis (update@ #bindings (set.add (#///reference/variable.Local register)) - synthesis-storage) + synthesis_storage) (list inputS exprS)) (^ (/.branch/if [testS thenS elseS])) - (list\fold for-synthesis synthesis-storage (list testS thenS elseS)) + (list\fold for_synthesis synthesis_storage (list testS thenS elseS)) (^ (/.branch/case [inputS pathS])) - (|> synthesis-storage (for-synthesis inputS) (for-path pathS)) + (|> synthesis_storage (for_synthesis inputS) (for_path pathS)) (^ (/.loop/scope [start initsS+ iterationS])) - (list\fold for-synthesis synthesis-storage (#.Cons iterationS initsS+)) + (list\fold for_synthesis synthesis_storage (#.Cons iterationS initsS+)) (^ (/.loop/recur replacementsS+)) - (list\fold for-synthesis synthesis-storage replacementsS+) + (list\fold for_synthesis synthesis_storage replacementsS+) (#/.Extension [extension argsS]) - (list\fold for-synthesis synthesis-storage argsS) + (list\fold for_synthesis synthesis_storage argsS) _ - synthesis-storage)) + synthesis_storage)) _ - path-storage + path_storage ))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/function.lux index 2359e03b8..bc6aee080 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/function.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/function.lux @@ -25,23 +25,23 @@ ["#/." variable (#+ Register Variable)]] ["." phase ("#\." monad)]]]]) -(exception: #export (cannot-find-foreign-variable-in-environment {foreign Register} {environment (Environment Synthesis)}) +(exception: #export (cannot_find_foreign_variable_in_environment {foreign Register} {environment (Environment Synthesis)}) (exception.report ["Foreign" (%.nat foreign)] ["Environment" (exception.enumerate /.%synthesis environment)])) -(def: arity-arguments +(def: arity_arguments (-> Arity (List Synthesis)) (|>> dec (enum.range n.enum 1) (list\map (|>> /.variable/local)))) -(template: #export (self-reference) +(template: #export (self_reference) (/.variable/local 0)) -(def: (expanded-nested-self-reference arity) +(def: (expanded_nested_self_reference arity) (-> Arity Synthesis) - (/.function/apply [(..self-reference) (arity-arguments arity)])) + (/.function/apply [(..self_reference) (arity_arguments arity)])) (def: #export (apply phase) (-> Phase Phase) @@ -50,7 +50,7 @@ (do {! phase.monad} [funcS (phase archive funcA) argsS (monad.map ! (phase archive) argsA)] - (with-expansions [<apply> (as-is (/.function/apply [funcS argsS]))] + (with_expansions [<apply> (as_is (/.function/apply [funcS argsS]))] (case funcS (^ (/.function/abstraction functionS)) (if (n.= (get@ #/.arity functionS) @@ -79,16 +79,16 @@ _ (wrap <apply>))))))) -(def: (find-foreign environment register) +(def: (find_foreign environment register) (-> (Environment Synthesis) Register (Operation Synthesis)) (case (list.nth register environment) (#.Some aliased) (phase\wrap aliased) #.None - (phase.throw ..cannot-find-foreign-variable-in-environment [register environment]))) + (phase.throw ..cannot_find_foreign_variable_in_environment [register environment]))) -(def: (grow-path grow path) +(def: (grow_path grow path) (-> (-> Synthesis (Operation Synthesis)) Path (Operation Path)) (case path (#/.Bind register) @@ -97,35 +97,35 @@ (^template [<tag>] [(<tag> left right) (do phase.monad - [left' (grow-path grow left) - right' (grow-path grow right)] + [left' (grow_path grow left) + right' (grow_path grow right)] (wrap (<tag> left' right')))]) ([#/.Alt] [#/.Seq]) - (#/.Bit-Fork when then else) + (#/.Bit_Fork when then else) (do {! phase.monad} - [then (grow-path grow then) + [then (grow_path grow then) else (case else (#.Some else) - (\ ! map (|>> #.Some) (grow-path grow else)) + (\ ! map (|>> #.Some) (grow_path grow else)) #.None (wrap #.None))] - (wrap (#/.Bit-Fork when then else))) + (wrap (#/.Bit_Fork when then else))) (^template [<tag>] [(<tag> [[test then] elses]) (do {! phase.monad} - [then (grow-path grow then) - elses (monad.map ! (function (_ [else-test else-then]) + [then (grow_path grow then) + elses (monad.map ! (function (_ [else_test else_then]) (do ! - [else-then (grow-path grow else-then)] - (wrap [else-test else-then]))) + [else_then (grow_path grow else_then)] + (wrap [else_test else_then]))) elses)] (wrap (<tag> [[test then] elses])))]) - ([#/.I64-Fork] - [#/.F64-Fork] - [#/.Text-Fork]) + ([#/.I64_Fork] + [#/.F64_Fork] + [#/.Text_Fork]) (#/.Then thenS) (|> thenS @@ -150,7 +150,7 @@ (monad.map phase.monad (grow environment)) (phase\map (|>> /.tuple)))) - (^ (..self-reference)) + (^ (..self_reference)) (phase\wrap (/.function/apply [expression (list (/.variable/local 1))])) (#/.Reference reference) @@ -161,7 +161,7 @@ (phase\wrap (/.variable/local (inc register))) (#////reference/variable.Foreign register) - (..find-foreign environment register)) + (..find_foreign environment register)) (#////reference.Constant constant) (phase\wrap expression)) @@ -191,7 +191,7 @@ (#/.Case [inputS pathS]) (do phase.monad [inputS' (grow environment inputS) - pathS' (grow-path (grow environment) pathS)] + pathS' (grow_path (grow environment) pathS)] (wrap (/.branch/case [inputS' pathS'])))) (#/.Loop loop) @@ -213,7 +213,7 @@ (do {! phase.monad} [_env' (monad.map ! (|>> (case> (#/.Reference (#////reference.Variable (#////reference/variable.Foreign register))) - (..find-foreign environment register) + (..find_foreign environment register) captured (grow environment captured))) @@ -225,9 +225,9 @@ [funcS (grow environment funcS) argsS+ (monad.map ! (grow environment) argsS+)] (wrap (/.function/apply (case funcS - (^ (/.function/apply [(..self-reference) pre-argsS+])) - [(..self-reference) - (list\compose pre-argsS+ argsS+)] + (^ (/.function/apply [(..self_reference) pre_argsS+])) + [(..self_reference) + (list\compose pre_argsS+ argsS+)] _ [funcS @@ -246,17 +246,17 @@ (do {! phase.monad} [currying? /.currying? environment (monad.map ! (phase archive) environment) - bodyS (/.with-currying? true - (/.with-locals 2 + bodyS (/.with_currying? true + (/.with_locals 2 (phase archive bodyA))) abstraction (: (Operation Abstraction) (case bodyS - (^ (/.function/abstraction [env' down-arity' bodyS'])) + (^ (/.function/abstraction [env' down_arity' bodyS'])) (|> bodyS' (grow env') (\ ! map (function (_ body) {#/.environment environment - #/.arity (inc down-arity') + #/.arity (inc down_arity') #/.body body}))) _ diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/loop.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/loop.lux index 80ce194d6..0cd95f100 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/loop.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/loop.lux @@ -19,16 +19,16 @@ (type: #export (Transform a) (-> a (Maybe a))) -(def: #export (register-optimization offset) +(def: #export (register_optimization offset) (-> Register (-> Register Register)) (|>> dec (n.+ offset))) -(def: (path-optimization body-optimization offset) +(def: (path_optimization body_optimization offset) (-> (Transform Synthesis) Register (Transform Path)) (function (recur path) (case path (#/.Bind register) - (#.Some (#/.Bind (register-optimization offset register))) + (#.Some (#/.Bind (register_optimization offset register))) (^template [<tag>] [(<tag> left right) @@ -38,7 +38,7 @@ (wrap (<tag> left' right')))]) ([#/.Alt] [#/.Seq]) - (#/.Bit-Fork when then else) + (#/.Bit_Fork when then else) (do {! maybe.monad} [then (recur then) else (case else @@ -47,31 +47,31 @@ #.None (wrap #.None))] - (wrap (#/.Bit-Fork when then else))) + (wrap (#/.Bit_Fork when then else))) (^template [<tag>] [(<tag> [[test then] elses]) (do {! maybe.monad} [then (recur then) - elses (monad.map ! (function (_ [else-test else-then]) + elses (monad.map ! (function (_ [else_test else_then]) (do ! - [else-then (recur else-then)] - (wrap [else-test else-then]))) + [else_then (recur else_then)] + (wrap [else_test else_then]))) elses)] (wrap (<tag> [[test then] elses])))]) - ([#/.I64-Fork] - [#/.F64-Fork] - [#/.Text-Fork]) + ([#/.I64_Fork] + [#/.F64_Fork] + [#/.Text_Fork]) (#/.Then body) (|> body - body-optimization + body_optimization (maybe\map (|>> #/.Then))) _ (#.Some path)))) -(def: (body-optimization true-loop? offset scope-environment arity expr) +(def: (body_optimization true_loop? offset scope_environment arity expr) (-> Bit Register (Environment Synthesis) Arity (Transform Synthesis)) (loop [return? true expr expr] @@ -96,7 +96,7 @@ (#/.Reference reference) (case reference (^ (#reference.Variable (variable.self))) - (if true-loop? + (if true_loop? #.None (#.Some expr)) @@ -104,24 +104,24 @@ (#.Some expr) (^ (reference.local register)) - (#.Some (#/.Reference (reference.local (register-optimization offset register)))) + (#.Some (#/.Reference (reference.local (register_optimization offset register)))) (^ (reference.foreign register)) - (if true-loop? - (list.nth register scope-environment) + (if true_loop? + (list.nth register scope_environment) (#.Some expr))) (^ (/.branch/case [input path])) (do maybe.monad [input' (recur false input) - path' (path-optimization (recur return?) offset path)] + path' (path_optimization (recur return?) offset path)] (wrap (|> path' [input'] /.branch/case))) (^ (/.branch/let [input register body])) (do maybe.monad [input' (recur false input) body' (recur return? body)] - (wrap (/.branch/let [input' (register-optimization offset register) body']))) + (wrap (/.branch/let [input' (register_optimization offset register) body']))) (^ (/.branch/if [input then else])) (do maybe.monad @@ -141,7 +141,7 @@ (get@ #/.inits) (monad.map ! (recur false))) iteration' (recur return? (get@ #/.iteration scope))] - (wrap (/.loop/scope {#/.start (|> scope (get@ #/.start) (register-optimization offset)) + (wrap (/.loop/scope {#/.start (|> scope (get@ #/.start) (register_optimization offset)) #/.inits inits' #/.iteration iteration'}))) @@ -158,7 +158,7 @@ (^ (/.function/apply [abstraction arguments])) (do {! maybe.monad} [arguments' (monad.map maybe.monad (recur false) arguments)] - (with-expansions [<application> (as-is (do ! + (with_expansions [<application> (as_is (do ! [abstraction' (recur false abstraction)] (wrap (/.function/apply [abstraction' arguments']))))] (case abstraction @@ -166,7 +166,7 @@ (if (and return? (n.= arity (list.size arguments))) (wrap (/.loop/recur arguments')) - (if true-loop? + (if true_loop? #.None <application>)) @@ -178,8 +178,8 @@ (monad.map maybe.monad (recur false)) (maybe\map (|>> [name] #/.Extension)))))) -(def: #export (optimization true-loop? offset inits functionS) +(def: #export (optimization true_loop? offset inits functionS) (-> Bit Register (List Synthesis) Abstraction (Maybe [Register (List Synthesis) Synthesis])) (|> (get@ #/.body functionS) - (body-optimization true-loop? offset (get@ #/.environment functionS) (get@ #/.arity functionS)) + (body_optimization true_loop? offset (get@ #/.environment functionS) (get@ #/.arity functionS)) (maybe\map (|>> [offset inits])))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/variable.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/variable.lux index 1312f9ed7..31693f4a0 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/variable.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/variable.lux @@ -33,7 +33,7 @@ (type: (Remover a) (-> Register (-> a a))) -(def: (remove-local-from-path remove-local redundant) +(def: (remove_local_from_path remove_local redundant) (-> (Remover Synthesis) (Remover Path)) (function (recur path) (case path @@ -68,8 +68,8 @@ ([#/.Seq] [#/.Alt]) - (#/.Bit-Fork when then else) - (#/.Bit-Fork when (recur then) (maybe\map recur else)) + (#/.Bit_Fork when then else) + (#/.Bit_Fork when (recur then) (maybe\map recur else)) (^template [<tag>] [(<tag> [[test then] tail]) @@ -77,9 +77,9 @@ (list\map (function (_ [test' then']) [test' (recur then')]) tail)])]) - ([#/.I64-Fork] - [#/.F64-Fork] - [#/.Text-Fork]) + ([#/.I64_Fork] + [#/.F64_Fork] + [#/.Text_Fork]) (^or #/.Pop (#/.Access _)) @@ -89,10 +89,10 @@ (undefined) (#/.Then then) - (#/.Then (remove-local redundant then)) + (#/.Then (remove_local redundant then)) ))) -(def: (remove-local-from-variable redundant variable) +(def: (remove_local_from_variable redundant variable) (Remover Variable) (case variable (#variable.Local register) @@ -101,7 +101,7 @@ (#variable.Foreign register) variable)) -(def: (remove-local redundant) +(def: (remove_local redundant) (Remover Synthesis) (function (recur synthesis) (case synthesis @@ -119,7 +119,7 @@ (#/.Reference reference) (case reference (#reference.Variable variable) - (/.variable (..remove-local-from-variable redundant variable)) + (/.variable (..remove_local_from_variable redundant variable)) (#reference.Constant constant) synthesis) @@ -140,7 +140,7 @@ (#/.Get path (recur record)) (#/.Case input path) - (#/.Case (recur input) (remove-local-from-path remove-local redundant path)))) + (#/.Case (recur input) (remove_local_from_path remove_local redundant path)))) (#/.Loop loop) (#/.Loop (case loop @@ -191,7 +191,7 @@ (type: (Optimization a) (-> [Redundancy a] (Try [Redundancy a]))) -(def: (list-optimization optimization) +(def: (list_optimization optimization) (All [a] (-> (Optimization a) (Optimization (List a)))) (function (recur [redundancy values]) (case values @@ -211,8 +211,8 @@ (exception.report ["Register" (%.nat register)]))] - [redundant-declaration] - [unknown-register] + [redundant_declaration] + [unknown_register] ) (def: (declare register redundancy) @@ -222,13 +222,13 @@ (#try.Success (dictionary.put register ..redundant! redundancy)) (#.Some _) - (exception.throw ..redundant-declaration [register]))) + (exception.throw ..redundant_declaration [register]))) (def: (observe register redundancy) (-> Register Redundancy (Try Redundancy)) (case (dictionary.get register redundancy) #.None - (exception.throw ..unknown-register [register]) + (exception.throw ..unknown_register [register]) (#.Some _) (#try.Success (dictionary.put register ..necessary! redundancy)))) @@ -239,9 +239,9 @@ dictionary.entries (list\map (function (_ [register redundant?]) (%.format (%.nat register) ": " (%.bit redundant?)))) - (text.join-with ", "))) + (text.join_with ", "))) -(def: (path-optimization optimization) +(def: (path_optimization optimization) (-> (Optimization Synthesis) (Optimization Path)) (function (recur [redundancy path]) (case path @@ -250,7 +250,7 @@ (#try.Success [redundancy path]) - (#/.Bit-Fork when then else) + (#/.Bit_Fork when then else) (do {! try.monad} [[redundancy then] (recur [redundancy then]) [redundancy else] (case else @@ -262,22 +262,22 @@ #.None (wrap [redundancy #.None]))] - (wrap [redundancy (#/.Bit-Fork when then else)])) + (wrap [redundancy (#/.Bit_Fork when then else)])) (^template [<tag> <type>] [(<tag> [[test then] elses]) (do {! try.monad} [[redundancy then] (recur [redundancy then]) - [redundancy elses] (..list-optimization (: (Optimization [<type> Path]) - (function (_ [redundancy [else-test else-then]]) + [redundancy elses] (..list_optimization (: (Optimization [<type> Path]) + (function (_ [redundancy [else_test else_then]]) (do ! - [[redundancy else-then] (recur [redundancy else-then])] - (wrap [redundancy [else-test else-then]])))) + [[redundancy else_then] (recur [redundancy else_then])] + (wrap [redundancy [else_test else_then]])))) [redundancy elses])] (wrap [redundancy (<tag> [[test then] elses])]))]) - ([#/.I64-Fork (I64 Any)] - [#/.F64-Fork Frac] - [#/.Text-Fork Text]) + ([#/.I64_Fork (I64 Any)] + [#/.F64_Fork Frac] + [#/.Text_Fork Text]) (#/.Bind register) (do try.monad @@ -295,11 +295,11 @@ (do try.monad [#let [baseline (|> redundancy dictionary.keys - (set.from-list n.hash))] + (set.from_list n.hash))] [redundancy pre] (recur [redundancy pre]) #let [bindings (|> redundancy dictionary.keys - (set.from-list n.hash) + (set.from_list n.hash) (set.difference baseline))] [redundancy post] (recur [redundancy post]) #let [redundants (|> redundancy @@ -308,10 +308,10 @@ (and (set.member? bindings register) redundant?))) (list\map product.left))]] - (wrap [(list\fold dictionary.remove redundancy (set.to-list bindings)) + (wrap [(list\fold dictionary.remove redundancy (set.to_list bindings)) (|> redundants (list.sort n.>) - (list\fold (..remove-local-from-path ..remove-local) (#/.Seq pre post)))])) + (list\fold (..remove_local_from_path ..remove_local) (#/.Seq pre post)))])) (#/.Then then) (do try.monad @@ -321,11 +321,11 @@ (def: (optimization' [redundancy synthesis]) (Optimization Synthesis) - (with-expansions [<no-op> (as-is (#try.Success [redundancy + (with_expansions [<no_op> (as_is (#try.Success [redundancy synthesis]))] (case synthesis (#/.Primitive _) - <no-op> + <no_op> (#/.Structure structure) (case structure @@ -337,7 +337,7 @@ (#analysis.Tuple tuple) (do try.monad - [[redundancy tuple] (..list-optimization optimization' [redundancy tuple])] + [[redundancy tuple] (..list_optimization optimization' [redundancy tuple])] (wrap [redundancy (#/.Structure (#analysis.Tuple tuple))]))) @@ -348,13 +348,13 @@ (#variable.Local register) (do try.monad [redundancy (..observe register redundancy)] - <no-op>) + <no_op>) (#variable.Foreign register) - <no-op>) + <no_op>) (#reference.Constant constant) - <no-op>) + <no_op>) (#/.Control control) (case control @@ -372,7 +372,7 @@ (#/.Control (if redundant? (#/.Branch (#/.Case input (#/.Seq #/.Pop - (#/.Then (..remove-local register output))))) + (#/.Then (..remove_local register output))))) (#/.Branch (#/.Let input register output))))])) (#/.If test then else) @@ -392,7 +392,7 @@ (#/.Case input path) (do try.monad [[redundancy input] (optimization' [redundancy input]) - [redundancy path] (..path-optimization optimization' [redundancy path])] + [redundancy path] (..path_optimization optimization' [redundancy path])] (wrap [redundancy (#/.Control (#/.Branch (#/.Case input path)))]))) @@ -400,7 +400,7 @@ (case loop (#/.Scope [start inits iteration]) (do try.monad - [[redundancy inits] (..list-optimization optimization' [redundancy inits]) + [[redundancy inits] (..list_optimization optimization' [redundancy inits]) #let [[extension redundancy] (..extended start (list.size inits) redundancy)] [redundancy iteration] (optimization' [redundancy iteration])] (wrap [(list\fold dictionary.remove redundancy extension) @@ -408,7 +408,7 @@ (#/.Recur resets) (do try.monad - [[redundancy resets] (..list-optimization optimization' [redundancy resets])] + [[redundancy resets] (..list_optimization optimization' [redundancy resets])] (wrap [redundancy (#/.Control (#/.Loop (#/.Recur resets)))]))) @@ -416,7 +416,7 @@ (case function (#/.Abstraction [environment arity body]) (do {! try.monad} - [[redundancy environment] (..list-optimization optimization' [redundancy environment]) + [[redundancy environment] (..list_optimization optimization' [redundancy environment]) [_ body] (optimization' [(..default arity) body])] (wrap [redundancy (#/.Control (#/.Function (#/.Abstraction [environment arity body])))])) @@ -424,13 +424,13 @@ (#/.Apply abstraction inputs) (do try.monad [[redundancy abstraction] (optimization' [redundancy abstraction]) - [redundancy inputs] (..list-optimization optimization' [redundancy inputs])] + [redundancy inputs] (..list_optimization optimization' [redundancy inputs])] (wrap [redundancy (#/.Control (#/.Function (#/.Apply abstraction inputs)))])))) (#/.Extension name inputs) (do try.monad - [[redundancy inputs] (..list-optimization optimization' [redundancy inputs])] + [[redundancy inputs] (..list_optimization optimization' [redundancy inputs])] (wrap [redundancy (#/.Extension name inputs)]))))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/syntax.lux b/stdlib/source/lux/tool/compiler/language/lux/syntax.lux index bdbba5134..4bd39b8a9 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/syntax.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/syntax.lux @@ -34,18 +34,19 @@ [text (#+ Offset)]]] [data ["." maybe] - [number - ["n" nat] - ["." int] - ["." rev] - ["." frac]] ["." text ["%" format (#+ format)]] [collection ["." list] ["." dictionary (#+ Dictionary)]]] [macro - ["." template]]]) + ["." template]] + [math + [number + ["n" nat] + ["." int] + ["." rev] + ["." frac]]]]) ## TODO: Implement "lux syntax char case!" as a custom extension. ## That way, it should be possible to obtain the char without wrapping diff --git a/stdlib/source/lux/tool/compiler/language/lux/synthesis.lux b/stdlib/source/lux/tool/compiler/language/lux/synthesis.lux index a421d1ba9..5b79a72a8 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/synthesis.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/synthesis.lux @@ -14,14 +14,15 @@ ["." bit ("#\." equivalence)] ["." text ("#\." equivalence) ["%" format (#+ Format format)]] + [collection + ["." list ("#\." functor)] + ["." dictionary (#+ Dictionary)]]] + [math [number ["." i64] ["n" nat] ["i" int] - ["f" frac]] - [collection - ["." list ("#\." functor)] - ["." dictionary (#+ Dictionary)]]]] + ["f" frac]]]] [// ["." analysis (#+ Environment Composite Analysis)] [phase diff --git a/stdlib/source/lux/tool/compiler/meta/archive.lux b/stdlib/source/lux/tool/compiler/meta/archive.lux index 7abacd4fc..3b12dc37a 100644 --- a/stdlib/source/lux/tool/compiler/meta/archive.lux +++ b/stdlib/source/lux/tool/compiler/meta/archive.lux @@ -17,12 +17,13 @@ ["%" format (#+ format)]] [format ["." binary (#+ Writer)]] - [number - ["n" nat ("#\." equivalence)]] [collection ["." list ("#\." functor fold)] ["." dictionary (#+ Dictionary)] ["." set]]] + [math + [number + ["n" nat ("#\." equivalence)]]] [type abstract]] [/ diff --git a/stdlib/source/lux/tool/compiler/meta/archive/signature.lux b/stdlib/source/lux/tool/compiler/meta/archive/signature.lux index e4e1be377..8956f99ec 100644 --- a/stdlib/source/lux/tool/compiler/meta/archive/signature.lux +++ b/stdlib/source/lux/tool/compiler/meta/archive/signature.lux @@ -11,7 +11,8 @@ ["." text ["%" format (#+ format)]] [format - ["." binary (#+ Writer)]] + ["." binary (#+ Writer)]]] + [math [number ["." nat]]]] [//// diff --git a/stdlib/source/lux/tool/compiler/meta/cache/dependency.lux b/stdlib/source/lux/tool/compiler/meta/cache/dependency.lux index 345b46c14..05d75c129 100644 --- a/stdlib/source/lux/tool/compiler/meta/cache/dependency.lux +++ b/stdlib/source/lux/tool/compiler/meta/cache/dependency.lux @@ -60,7 +60,7 @@ (#try.Failure error) ..fresh)] - ancestors (monad.map ! recur (set.to-list parents))] + ancestors (monad.map ! recur (set.to_list parents))] (wrap (list\fold set.union parents ancestors))))) ancestry (memo.open memo)] (list\fold (function (_ module memory) @@ -73,15 +73,15 @@ (def: (dependency? ancestry target source) (-> Graph Module Module Bit) - (let [target-ancestry (|> ancestry + (let [target_ancestry (|> ancestry (dictionary.get target) (maybe.default ..fresh))] - (set.member? target-ancestry source))) + (set.member? target_ancestry source))) (type: #export Order (List [Module [archive.ID [Descriptor (Document .Module)]]])) -(def: #export (load-order key archive) +(def: #export (load_order key archive) (-> (Key .Module) Archive (Try Order)) (let [ancestry (..ancestry archive)] (|> ancestry @@ -90,7 +90,7 @@ (monad.map try.monad (function (_ module) (do try.monad - [module-id (archive.id module archive) + [module_id (archive.id module archive) [descriptor document] (archive.find module archive) document (document.check key document)] - (wrap [module [module-id [descriptor document]]]))))))) + (wrap [module [module_id [descriptor document]]]))))))) diff --git a/stdlib/source/lux/tool/compiler/meta/io/archive.lux b/stdlib/source/lux/tool/compiler/meta/io/archive.lux index 91fbe9cb4..0b2db4346 100644 --- a/stdlib/source/lux/tool/compiler/meta/io/archive.lux +++ b/stdlib/source/lux/tool/compiler/meta/io/archive.lux @@ -50,12 +50,12 @@ ["." directive] ["#/." program]]]]]]) -(exception: #export (cannot-prepare {archive Path} - {module-id archive.ID} +(exception: #export (cannot_prepare {archive Path} + {module_id archive.ID} {error Text}) (exception.report ["Archive" archive] - ["Module ID" (%.nat module-id)] + ["Module ID" (%.nat module_id)] ["Error" error])) (def: (archive system static) @@ -64,104 +64,104 @@ (\ system separator) (get@ #static.host static))) -(def: (unversioned-lux-archive system static) +(def: (unversioned_lux_archive system static) (All [!] (-> (file.System !) Static Path)) (format (..archive system static) (\ system separator) - //.lux-context)) + //.lux_context)) -(def: (versioned-lux-archive system static) +(def: (versioned_lux_archive system static) (All [!] (-> (file.System !) Static Path)) - (format (..unversioned-lux-archive system static) + (format (..unversioned_lux_archive system static) (\ system separator) (%.nat version.version))) -(def: (module system static module-id) +(def: (module system static module_id) (All [!] (-> (file.System !) Static archive.ID Path)) - (format (..versioned-lux-archive system static) + (format (..versioned_lux_archive system static) (\ system separator) - (%.nat module-id))) + (%.nat module_id))) -(def: #export (artifact system static module-id name) +(def: #export (artifact system static module_id name) (All [!] (-> (file.System !) Static archive.ID Text Path)) - (format (..module system static module-id) + (format (..module system static module_id) (\ system separator) name - (get@ #static.artifact-extension static))) + (get@ #static.artifact_extension static))) -(def: #export (prepare system static module-id) +(def: #export (prepare system static module_id) (-> (file.System Promise) Static archive.ID (Promise (Try Any))) (do {! promise.monad} - [#let [module (..module system static module-id)] - module-exists? (file.exists? promise.monad system module)] - (if module-exists? + [#let [module (..module system static module_id)] + module_exists? (file.exists? promise.monad system module)] + (if module_exists? (wrap (#try.Success [])) (do ! - [_ (file.get-directory ! system (..unversioned-lux-archive system static)) - _ (file.get-directory ! system (..versioned-lux-archive system static)) - outcome (!.use (\ system create-directory) module)] + [_ (file.get_directory ! system (..unversioned_lux_archive system static)) + _ (file.get_directory ! system (..versioned_lux_archive system static)) + outcome (!.use (\ system create_directory) module)] (case outcome (#try.Success output) (wrap (#try.Success [])) (#try.Failure error) - (wrap (exception.throw ..cannot-prepare [(..archive system static) - module-id + (wrap (exception.throw ..cannot_prepare [(..archive system static) + module_id error]))))))) -(def: #export (write system static module-id name content) +(def: #export (write system static module_id name content) (-> (file.System Promise) Static archive.ID Text Binary (Promise (Try Any))) (do (try.with promise.monad) [artifact (: (Promise (Try (File Promise))) - (file.get-file promise.monad system - (..artifact system static module-id name)))] - (!.use (\ artifact over-write) content))) + (file.get_file promise.monad system + (..artifact system static module_id name)))] + (!.use (\ artifact over_write) content))) (def: #export (enable system static) (-> (file.System Promise) Static (Promise (Try Any))) (do (try.with promise.monad) [_ (: (Promise (Try (Directory Promise))) - (file.get-directory promise.monad system (get@ #static.target static))) + (file.get_directory promise.monad system (get@ #static.target static))) _ (: (Promise (Try (Directory Promise))) - (file.get-directory promise.monad system (..archive system static)))] + (file.get_directory promise.monad system (..archive system static)))] (wrap []))) -(def: (general-descriptor system static) +(def: (general_descriptor system static) (-> (file.System Promise) Static Path) (format (..archive system static) (\ system separator) - "general-descriptor")) + "general_descriptor")) (def: #export (freeze system static archive) (-> (file.System Promise) Static Archive (Promise (Try Any))) (do (try.with promise.monad) [file (: (Promise (Try (File Promise))) - (file.get-file promise.monad system (..general-descriptor system static)))] - (!.use (\ file over-write) (archive.export ///.version archive)))) + (file.get_file promise.monad system (..general_descriptor system static)))] + (!.use (\ file over_write) (archive.export ///.version archive)))) -(def: module-descriptor-file - "module-descriptor") +(def: module_descriptor_file + "module_descriptor") -(def: (module-descriptor system static module-id) +(def: (module_descriptor system static module_id) (-> (file.System Promise) Static archive.ID Path) - (format (..module system static module-id) + (format (..module system static module_id) (\ system separator) - ..module-descriptor-file)) + ..module_descriptor_file)) -(def: #export (cache system static module-id content) +(def: #export (cache system static module_id content) (-> (file.System Promise) Static archive.ID Binary (Promise (Try Any))) (do (try.with promise.monad) [file (: (Promise (Try (File Promise))) - (file.get-file promise.monad system - (..module-descriptor system static module-id)))] - (!.use (\ file over-write) content))) + (file.get_file promise.monad system + (..module_descriptor system static module_id)))] + (!.use (\ file over_write) content))) -(def: (read-module-descriptor system static module-id) +(def: (read_module_descriptor system static module_id) (-> (file.System Promise) Static archive.ID (Promise (Try Binary))) (do (try.with promise.monad) [file (: (Promise (Try (File Promise))) - (file.get-file promise.monad system - (..module-descriptor system static module-id)))] + (file.get_file promise.monad system + (..module_descriptor system static module_id)))] (!.use (\ file content) []))) (def: parser @@ -169,11 +169,11 @@ (<>.and descriptor.parser (document.parser $.parser))) -(def: (fresh-analysis-state host) +(def: (fresh_analysis_state host) (-> Host .Lux) (analysis.state (analysis.info version.version host))) -(def: (analysis-state host archive) +(def: (analysis_state host archive) (-> Host Archive (Try .Lux)) (do {! try.monad} [modules (: (Try (List [Module .Module])) @@ -183,18 +183,18 @@ content (document.read $.key document)] (wrap [module content]))) (archive.archived archive)))] - (wrap (set@ #.modules modules (fresh-analysis-state host))))) + (wrap (set@ #.modules modules (fresh_analysis_state host))))) -(def: (cached-artifacts system static module-id) +(def: (cached_artifacts system static module_id) (-> (file.System Promise) Static archive.ID (Promise (Try (Dictionary Text Binary)))) (do {! (try.with promise.monad)} - [module-dir (!.use (\ system directory) (..module system static module-id)) - cached-files (!.use (\ module-dir files) [])] - (|> cached-files + [module_dir (!.use (\ system directory) (..module system static module_id)) + cached_files (!.use (\ module_dir files) [])] + (|> cached_files (list\map (function (_ file) [(!.use (\ file name) []) (!.use (\ file path) [])])) - (list.filter (|>> product.left (text\= ..module-descriptor-file) not)) + (list.filter (|>> product.left (text\= ..module_descriptor_file) not)) (monad.map ! (function (_ [name path]) (do ! [file (: (Promise (Try (File Promise))) @@ -202,7 +202,7 @@ data (: (Promise (Try Binary)) (!.use (\ file content) []))] (wrap [name data])))) - (\ ! map (dictionary.from-list text.hash))))) + (\ ! map (dictionary.from_list text.hash))))) (type: Definitions (Dictionary Text Any)) (type: Analysers (Dictionary Text analysis.Handler)) @@ -216,34 +216,34 @@ Generators Directives]) -(def: empty-bundles +(def: empty_bundles Bundles [(dictionary.new text.hash) (dictionary.new text.hash) (dictionary.new text.hash) (dictionary.new text.hash)]) -(def: (loaded-document extension host module-id expected actual document) +(def: (loaded_document extension host module_id expected actual document) (All [expression directive] (-> Text (generation.Host expression directive) archive.ID (Row Artifact) (Dictionary Text Binary) (Document .Module) (Try [(Document .Module) Bundles]))) (do {! try.monad} [[definitions bundles] (: (Try [Definitions Bundles]) - (loop [input (row.to-list expected) + (loop [input (row.to_list expected) definitions (: Definitions (dictionary.new text.hash)) - bundles ..empty-bundles] + bundles ..empty_bundles] (let [[analysers synthesizers generators directives] bundles] (case input - (#.Cons [[artifact-id artifact-category] input']) + (#.Cons [[artifact_id artifact_category] input']) (case (do ! - [data (try.from-maybe (dictionary.get (format (%.nat artifact-id) extension) actual)) - #let [context [module-id artifact-id] + [data (try.from_maybe (dictionary.get (format (%.nat artifact_id) extension) actual)) + #let [context [module_id artifact_id] directive (\ host ingest context data)]] - (case artifact-category + (case artifact_category #artifact.Anonymous (do ! - [_ (\ host re-learn context directive)] + [_ (\ host re_learn context directive)] (wrap [definitions [analysers synthesizers @@ -258,7 +258,7 @@ generators directives]]) (do ! - [value (\ host re-load context directive)] + [value (\ host re_load context directive)] (wrap [(dictionary.put name value definitions) [analysers synthesizers @@ -267,7 +267,7 @@ (#artifact.Analyser extension) (do ! - [value (\ host re-load context directive)] + [value (\ host re_load context directive)] (wrap [definitions [(dictionary.put extension (:coerce analysis.Handler value) analysers) synthesizers @@ -276,7 +276,7 @@ (#artifact.Synthesizer extension) (do ! - [value (\ host re-load context directive)] + [value (\ host re_load context directive)] (wrap [definitions [analysers (dictionary.put extension (:coerce synthesis.Handler value) synthesizers) @@ -285,7 +285,7 @@ (#artifact.Generator extension) (do ! - [value (\ host re-load context directive)] + [value (\ host re_load context directive)] (wrap [definitions [analysers synthesizers @@ -294,7 +294,7 @@ (#artifact.Directive extension) (do ! - [value (\ host re-load context directive)] + [value (\ host re_load context directive)] (wrap [definitions [analysers synthesizers @@ -309,42 +309,42 @@ #.None (#try.Success [definitions bundles]))))) content (document.read $.key document) - definitions (monad.map ! (function (_ [def-name def-global]) - (case def-global + definitions (monad.map ! (function (_ [def_name def_global]) + (case def_global (#.Alias alias) - (wrap [def-name (#.Alias alias)]) + (wrap [def_name (#.Alias alias)]) (#.Definition [exported? type annotations _]) (do ! - [value (try.from-maybe (dictionary.get def-name definitions))] - (wrap [def-name (#.Definition [exported? type annotations value])])))) + [value (try.from_maybe (dictionary.get def_name definitions))] + (wrap [def_name (#.Definition [exported? type annotations value])])))) (get@ #.definitions content))] (wrap [(document.write $.key (set@ #.definitions definitions content)) bundles]))) -(def: (load-definitions system static module-id host-environment [descriptor document]) +(def: (load_definitions system static module_id host_environment [descriptor document]) (All [expression directive] (-> (file.System Promise) Static archive.ID (generation.Host expression directive) [Descriptor (Document .Module)] (Promise (Try [[Descriptor (Document .Module)] Bundles])))) (do (try.with promise.monad) - [actual (cached-artifacts system static module-id) + [actual (cached_artifacts system static module_id) #let [expected (|> descriptor (get@ #descriptor.registry) artifact.artifacts)] - [document bundles] (promise\wrap (loaded-document (get@ #static.artifact-extension static) host-environment module-id expected actual document))] + [document bundles] (promise\wrap (loaded_document (get@ #static.artifact_extension static) host_environment module_id expected actual document))] (wrap [[descriptor document] bundles]))) -(def: (purge! system static [module-name module-id]) +(def: (purge! system static [module_name module_id]) (-> (file.System Promise) Static [Module archive.ID] (Promise (Try Any))) (do {! (try.with promise.monad)} - [cache (!.use (\ system directory) [(..module system static module-id)]) + [cache (!.use (\ system directory) [(..module system static module_id)]) artifacts (!.use (\ cache files) []) _ (monad.map ! (function (_ artifact) (!.use (\ artifact delete) [])) artifacts)] (!.use (\ cache discard) []))) -(def: (valid-cache? expected actual) +(def: (valid_cache? expected actual) (-> Descriptor Input Bit) (and (text\= (get@ #descriptor.name expected) (get@ #////.module actual)) @@ -356,71 +356,71 @@ (type: Purge (Dictionary Module archive.ID)) -(def: initial-purge +(def: initial_purge (-> (List [Bit [Module [archive.ID [Descriptor (Document .Module)]]]]) Purge) - (|>> (list.all (function (_ [valid-cache? [module-name [module-id _]]]) - (if valid-cache? + (|>> (list.all (function (_ [valid_cache? [module_name [module_id _]]]) + (if valid_cache? #.None - (#.Some [module-name module-id])))) - (dictionary.from-list text.hash))) + (#.Some [module_name module_id])))) + (dictionary.from_list text.hash))) -(def: (full-purge caches load-order) +(def: (full_purge caches load_order) (-> (List [Bit [Module [archive.ID [Descriptor (Document .Module)]]]]) dependency.Order Purge) - (list\fold (function (_ [module-name [module-id [descriptor document]]] purge) + (list\fold (function (_ [module_name [module_id [descriptor document]]] purge) (let [purged? (: (Predicate Module) (dictionary.key? purge))] - (if (purged? module-name) + (if (purged? module_name) purge (if (|> descriptor (get@ #descriptor.references) - set.to-list + set.to_list (list.any? purged?)) - (dictionary.put module-name module-id purge) + (dictionary.put module_name module_id purge) purge)))) - (..initial-purge caches) - load-order)) + (..initial_purge caches) + load_order)) -(def: (load-every-reserved-module host-environment system static import contexts archive) +(def: (load_every_reserved_module host_environment system static import contexts archive) (All [expression directive] (-> (generation.Host expression directive) (file.System Promise) Static Import (List Context) Archive (Promise (Try [Archive .Lux Bundles])))) (do {! (try.with promise.monad)} - [pre-loaded-caches (|> archive + [pre_loaded_caches (|> archive archive.reservations - (monad.map ! (function (_ [module-name module-id]) + (monad.map ! (function (_ [module_name module_id]) (do ! - [data (..read-module-descriptor system static module-id) + [data (..read_module_descriptor system static module_id) [descriptor document] (promise\wrap (<b>.run ..parser data))] - (if (text\= archive.runtime-module module-name) + (if (text\= archive.runtime_module module_name) (wrap [true - [module-name [module-id [descriptor document]]]]) + [module_name [module_id [descriptor document]]]]) (do ! - [input (//context.read system import contexts (get@ #static.host-module-extension static) module-name)] - (wrap [(..valid-cache? descriptor input) - [module-name [module-id [descriptor document]]]]))))))) - load-order (|> pre-loaded-caches + [input (//context.read system import contexts (get@ #static.host_module_extension static) module_name)] + (wrap [(..valid_cache? descriptor input) + [module_name [module_id [descriptor document]]]]))))))) + load_order (|> pre_loaded_caches (list\map product.right) (monad.fold try.monad - (function (_ [module [module-id descriptor,document]] archive) + (function (_ [module [module_id descriptor,document]] archive) (archive.add module descriptor,document archive)) archive) - (\ try.monad map (dependency.load-order $.key)) + (\ try.monad map (dependency.load_order $.key)) (\ try.monad join) promise\wrap) - #let [purge (..full-purge pre-loaded-caches load-order)] + #let [purge (..full_purge pre_loaded_caches load_order)] _ (|> purge dictionary.entries (monad.map ! (..purge! system static))) - loaded-caches (|> load-order - (list.filter (function (_ [module-name [module-id [descriptor document]]]) - (not (dictionary.key? purge module-name)))) - (monad.map ! (function (_ [module-name [module-id descriptor,document]]) + loaded_caches (|> load_order + (list.filter (function (_ [module_name [module_id [descriptor document]]]) + (not (dictionary.key? purge module_name)))) + (monad.map ! (function (_ [module_name [module_id descriptor,document]]) (do ! - [[descriptor,document bundles] (..load-definitions system static module-id host-environment descriptor,document)] - (wrap [[module-name descriptor,document] + [[descriptor,document bundles] (..load_definitions system static module_id host_environment descriptor,document)] + (wrap [[module_name descriptor,document] bundles])))))] (promise\wrap (do {! try.monad} @@ -428,33 +428,33 @@ (function (_ [[module descriptor,document] _bundle] archive) (archive.add module descriptor,document archive)) archive - loaded-caches) - analysis-state (..analysis-state (get@ #static.host static) archive)] + loaded_caches) + analysis_state (..analysis_state (get@ #static.host static) archive)] (wrap [archive - analysis-state + analysis_state (list\fold (function (_ [_ [+analysers +synthesizers +generators +directives]] [analysers synthesizers generators directives]) [(dictionary.merge +analysers analysers) (dictionary.merge +synthesizers synthesizers) (dictionary.merge +generators generators) (dictionary.merge +directives directives)]) - ..empty-bundles - loaded-caches)]))))) + ..empty_bundles + loaded_caches)]))))) -(def: #export (thaw host-environment system static import contexts) +(def: #export (thaw host_environment system static import contexts) (All [expression directive] (-> (generation.Host expression directive) (file.System Promise) Static Import (List Context) (Promise (Try [Archive .Lux Bundles])))) (do promise.monad - [file (!.use (\ system file) (..general-descriptor system static))] + [file (!.use (\ system file) (..general_descriptor system static))] (case file (#try.Success file) (do (try.with promise.monad) [binary (!.use (\ file content) []) archive (promise\wrap (archive.import ///.version binary))] - (..load-every-reserved-module host-environment system static import contexts archive)) + (..load_every_reserved_module host_environment system static import contexts archive)) (#try.Failure error) (wrap (#try.Success [archive.empty - (fresh-analysis-state (get@ #static.host static)) - ..empty-bundles]))))) + (fresh_analysis_state (get@ #static.host static)) + ..empty_bundles]))))) diff --git a/stdlib/source/lux/tool/compiler/meta/packager.lux b/stdlib/source/lux/tool/compiler/meta/packager.lux index f2737e168..c29d0d9ed 100644 --- a/stdlib/source/lux/tool/compiler/meta/packager.lux +++ b/stdlib/source/lux/tool/compiler/meta/packager.lux @@ -33,10 +33,10 @@ (def: #export order (-> dependency.Order Order) - (list\map (function (_ [module [module-id [descriptor document]]]) + (list\map (function (_ [module [module_id [descriptor document]]]) (|> descriptor (get@ #descriptor.registry) artifact.artifacts - row.to-list + row.to_list (list\map (|>> (get@ #artifact.id))) - [module-id])))) + [module_id])))) diff --git a/stdlib/source/lux/tool/compiler/meta/packager/jvm.lux b/stdlib/source/lux/tool/compiler/meta/packager/jvm.lux index fa63bedab..61fb97ddf 100644 --- a/stdlib/source/lux/tool/compiler/meta/packager/jvm.lux +++ b/stdlib/source/lux/tool/compiler/meta/packager/jvm.lux @@ -1,7 +1,7 @@ (.module: [lux (#- Module Definition) [type (#+ :share)] - ["." host (#+ import: do-to)] + ["." host (#+ import: do_to)] [abstract ["." monad (#+ Monad do)]] [control @@ -95,74 +95,74 @@ (def: byte 1) ## https://en.wikipedia.org/wiki/Kibibyte -(def: kibi-byte (n.* 1,024 byte)) +(def: kibi_byte (n.* 1,024 byte)) ## https://en.wikipedia.org/wiki/Mebibyte -(def: mebi-byte (n.* 1,024 kibi-byte)) +(def: mebi_byte (n.* 1,024 kibi_byte)) -(def: manifest-version "1.0") +(def: manifest_version "1.0") (def: (manifest program) (-> 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)) + (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)) manifest))) ## TODO: Delete ASAP (type: (Action ! a) (! (Try a))) -(def: (write-class monad file-system static context sink) +(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))])) + (!.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)) + #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))) (java/io/Flushable::flush) (java/util/zip/ZipOutputStream::closeEntry))))) -(def: (write-module monad file-system static [module artifacts] sink) +(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)) + (..write_class monad file_system static [module artifact] sink)) sink artifacts)) -(def: #export (package monad file-system static archive program) +(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)]))}) + (: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)] + module_id (archive.id module archive)] (wrap (|> descriptor (get@ #descriptor.registry) artifact.artifacts - row.to-list + row.to_list (list\map (|>> (get@ #artifact.id))) - [module-id]))))) + [module_id]))))) (\ monad wrap)) - #let [buffer (java/io/ByteArrayOutputStream::new (.int ..mebi-byte)) + #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 + 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)))) diff --git a/stdlib/source/lux/tool/compiler/reference.lux b/stdlib/source/lux/tool/compiler/reference.lux index 62ec9e3ca..96cefe81a 100644 --- a/stdlib/source/lux/tool/compiler/reference.lux +++ b/stdlib/source/lux/tool/compiler/reference.lux @@ -7,10 +7,11 @@ [pipe (#+ case>)]] [data ["." name] - [number - ["n" nat]] [text - ["%" format (#+ Format)]]]] + ["%" format (#+ Format)]]] + [math + [number + ["n" nat]]]] ["." / #_ ["#." variable (#+ Variable)]]) diff --git a/stdlib/source/lux/tool/compiler/reference/variable.lux b/stdlib/source/lux/tool/compiler/reference/variable.lux index 2a4d1424d..8106d9257 100644 --- a/stdlib/source/lux/tool/compiler/reference/variable.lux +++ b/stdlib/source/lux/tool/compiler/reference/variable.lux @@ -6,11 +6,12 @@ [control [pipe (#+ case>)]] [data + [text + ["%" format (#+ Format)]]] + [math [number ["n" nat] - ["i" int]] - [text - ["%" format (#+ Format)]]]]) + ["i" int]]]]) (type: #export Register Nat) diff --git a/stdlib/source/lux/tool/compiler/version.lux b/stdlib/source/lux/tool/compiler/version.lux index df405e75d..d29428636 100644 --- a/stdlib/source/lux/tool/compiler/version.lux +++ b/stdlib/source/lux/tool/compiler/version.lux @@ -1,10 +1,11 @@ (.module: [lux #* [data - [number - ["n" nat]] [text - ["%" format]]]]) + ["%" format]]] + [math + [number + ["n" nat]]]]) (type: #export Version Nat) diff --git a/stdlib/source/lux/type.lux b/stdlib/source/lux/type.lux index bfdfd94f9..d0c0dfe0c 100644 --- a/stdlib/source/lux/type.lux +++ b/stdlib/source/lux/type.lux @@ -12,14 +12,15 @@ ["." maybe] ["." text ("#\." monoid equivalence)] ["." name ("#\." equivalence codec)] - [number - ["n" nat ("#\." decimal)]] [collection ["." array] ["." list ("#\." functor monoid fold)]]] [macro [syntax (#+ syntax:)] ["." code]] + [math + [number + ["n" nat ("#\." decimal)]]] ["." meta ["." location]]]) diff --git a/stdlib/source/lux/type/abstract.lux b/stdlib/source/lux/type/abstract.lux index 1aa673f41..ca2382eab 100644 --- a/stdlib/source/lux/type/abstract.lux +++ b/stdlib/source/lux/type/abstract.lux @@ -1,5 +1,7 @@ (.module: [lux #* + [type (#+ :cast)] + ["." meta] [abstract [monad (#+ Monad do)]] [control @@ -11,15 +13,13 @@ ["." text ("#\." equivalence monoid)] [collection ["." list ("#\." functor monoid)]]] - ["." meta] [macro ["." code] [syntax (#+ syntax:) ["cs" common ["csr" reader] ["csw" writer] - ["|.|" export]]]] - [type (#+ :cast)]]) + ["|.|" export]]]]]) (type: Stack List) diff --git a/stdlib/source/lux/type/check.lux b/stdlib/source/lux/type/check.lux index d8d358010..e87b1802a 100644 --- a/stdlib/source/lux/type/check.lux +++ b/stdlib/source/lux/type/check.lux @@ -10,12 +10,13 @@ [data ["." maybe] ["." product] - [number - ["n" nat ("#\." decimal)]] ["." text ("#\." monoid equivalence)] [collection ["." list] - ["." set (#+ Set)]]]] + ["." set (#+ Set)]]] + [math + [number + ["n" nat ("#\." decimal)]]]] ["." // ("#\." equivalence)]) (template: (!n/= reference subject) diff --git a/stdlib/source/lux/type/implicit.lux b/stdlib/source/lux/type/implicit.lux index f24a80599..bf7e88a01 100644 --- a/stdlib/source/lux/type/implicit.lux +++ b/stdlib/source/lux/type/implicit.lux @@ -10,18 +10,18 @@ [data ["." product] ["." maybe] - ["." number - ["n" nat]] ["." text ("#\." equivalence) ["%" format (#+ format)]] [collection ["." list ("#\." monad fold)] ["dict" dictionary (#+ Dictionary)]]] - ["." meta] [macro ["." code] [syntax (#+ syntax:)]] - [meta + [math + ["." number + ["n" nat]]] + ["." meta ["." annotation]] ["." type ["." check (#+ Check)]]]) diff --git a/stdlib/source/lux/type/refinement.lux b/stdlib/source/lux/type/refinement.lux index 3429d28af..c38f6afef 100644 --- a/stdlib/source/lux/type/refinement.lux +++ b/stdlib/source/lux/type/refinement.lux @@ -1,8 +1,8 @@ (.module: [lux (#- type) + ["." meta] [abstract [predicate (#+ Predicate)]] - ["." meta] [macro [syntax (#+ syntax:)]] [type (#+ :by_example) diff --git a/stdlib/source/lux/type/resource.lux b/stdlib/source/lux/type/resource.lux index 26407ba39..d45d7b4f5 100644 --- a/stdlib/source/lux/type/resource.lux +++ b/stdlib/source/lux/type/resource.lux @@ -1,30 +1,31 @@ (.module: [lux #* + ["." meta] [abstract ["." monad (#+ Monad do) [indexed (#+ IxMonad)]]] [control - ["p" parser - ["s" code (#+ Parser)]] ["." exception (#+ exception:)] ["." io (#+ IO)] [concurrency - ["." promise (#+ Promise)]]] + ["." promise (#+ Promise)]] + ["p" parser + ["s" code (#+ Parser)]]] [data ["." identity (#+ Identity)] ["." maybe] ["." product] - [number - ["n" nat]] [text ["%" format (#+ format)]] [collection ["." set] ["." row (#+ Row)] ["." list ("#\." functor fold)]]] - ["." meta] [macro [syntax (#+ syntax:)]] + [math + [number + ["n" nat]]] [type abstract]]) diff --git a/stdlib/source/lux/type/unit.lux b/stdlib/source/lux/type/unit.lux index c00b0eae4..584a90604 100644 --- a/stdlib/source/lux/type/unit.lux +++ b/stdlib/source/lux/type/unit.lux @@ -10,9 +10,6 @@ ["p" parser ["s" code (#+ Parser)]]] [data - [number - ["i" int] - ["." ratio (#+ Ratio)]] [text ["%" format (#+ format)]]] [macro @@ -22,6 +19,10 @@ ["csr" reader] ["csw" writer] ["|.|" export]]]] + [math + [number + ["i" int] + ["." ratio (#+ Ratio)]]] [type abstract]]) diff --git a/stdlib/source/lux/world/file.lux b/stdlib/source/lux/world/file.lux index db973ece4..699730028 100644 --- a/stdlib/source/lux/world/file.lux +++ b/stdlib/source/lux/world/file.lux @@ -20,18 +20,19 @@ ["." binary (#+ Binary)] ["." text ["%" format (#+ format)]] - [number - ["i" int] - ["f" frac]] [collection ["." array (#+ Array)] ["." list ("#\." functor)] ["." dictionary (#+ Dictionary)]]] + [macro + ["." template]] + [math + [number + ["i" int] + ["f" frac]]] [time ["." instant (#+ Instant)] - ["." duration]] - [macro - ["." template]]]) + ["." duration]]]) (type: #export Path Text) @@ -1177,12 +1178,17 @@ (format (\ system separator) head) head) next tail] - (do (try.with monad) - [_ (..get_directory monad system current)] - (case next - #.Nil - (wrap current) + (do monad + [? (..get_directory monad system current)] + (case ? + (#try.Success _) + (case next + #.Nil + (wrap (#try.Success current)) + + (#.Cons head tail) + (recur (format current (\ system separator) head) + tail)) - (#.Cons head tail) - (recur (format current (\ system separator) head) - tail))))))) + (#try.Failure error) + (wrap (#try.Failure error)))))))) diff --git a/stdlib/source/lux/world/file/watch.lux b/stdlib/source/lux/world/file/watch.lux index 1a59721d4..c978be703 100644 --- a/stdlib/source/lux/world/file/watch.lux +++ b/stdlib/source/lux/world/file/watch.lux @@ -19,13 +19,14 @@ ["." maybe] ["." text ["%" format (#+ format)]] - [number - ["n" nat]] [collection ["." dictionary (#+ Dictionary)] ["." list ("#\." functor monoid fold)] ["." set] ["." array]]] + [math + [number + ["n" nat]]] [time ["." instant (#+ Instant) ("#\." equivalence)]] [type @@ -448,5 +449,5 @@ (promise.future (..default\\poll watcher))) ))))) )] - (for {@.old (as_is <jvm>) - @.jvm (as_is <jvm>)})) + (for {@.old (as_is <jvm>) + @.jvm (as_is <jvm>)})) diff --git a/stdlib/source/lux/world/shell.lux b/stdlib/source/lux/world/shell.lux index 273d64039..d64e70b9a 100644 --- a/stdlib/source/lux/world/shell.lux +++ b/stdlib/source/lux/world/shell.lux @@ -18,15 +18,16 @@ [environment (#+ Environment)]]] [data ["." product] - [number (#+ hex) - ["n" nat]] ["." text ["%" format (#+ format)] ["." encoding]] [collection ["." array (#+ Array)] ["." list ("#\." fold functor)] - ["." dictionary]]]] + ["." dictionary]]] + [math + [number (#+ hex) + ["n" nat]]]] [// [file (#+ Path)]]) @@ -189,7 +190,9 @@ (-> (List Argument) (Array java/lang/String)) (product.right (list\fold (function (_ argument [idx output]) - [(inc idx) (jvm.array_write idx argument output)]) + [(inc idx) (jvm.array_write idx + (:coerce java/lang/String argument) + output)]) [0 (jvm.array java/lang/String (list.size arguments))] arguments))) @@ -202,7 +205,9 @@ (java/util/Map java/lang/String java/lang/String) (java/util/Map java/lang/String java/lang/String)) (list\fold (function (_ [key value] target') - (exec (java/util/Map::put key value target') + (exec (java/util/Map::put (:coerce java/lang/String key) + (:coerce java/lang/String value) + target') target')) target (dictionary.entries input))) diff --git a/stdlib/source/poly/lux/abstract/equivalence.lux b/stdlib/source/poly/lux/abstract/equivalence.lux index b6cfa2c2c..fabd4b335 100644 --- a/stdlib/source/poly/lux/abstract/equivalence.lux +++ b/stdlib/source/poly/lux/abstract/equivalence.lux @@ -10,11 +10,6 @@ ["." product] ["." bit] ["." maybe] - [number - ["." nat ("#\." decimal)] - ["." int] - ["." rev] - ["." frac]] ["." text ("#\." monoid) ["%" format (#+ format)]] [collection @@ -25,17 +20,23 @@ ["." set] ["." dictionary (#+ Dictionary)] ["." tree]]] + [macro + ["." code] + ["." poly (#+ poly:)] + [syntax (#+ syntax:) + ["." common]]] + [math + [number + ["." nat ("#\." decimal)] + ["." int] + ["." rev] + ["." frac]]] [time ["." duration] ["." date] ["." instant] ["." day] ["." month]] - [macro - ["." code] - ["." poly (#+ poly:)] - [syntax (#+ syntax:) - ["." common]]] ["." type ["." unit]]] {1 diff --git a/stdlib/source/poly/lux/abstract/functor.lux b/stdlib/source/poly/lux/abstract/functor.lux index 70f4f9b64..741a1b851 100644 --- a/stdlib/source/poly/lux/abstract/functor.lux +++ b/stdlib/source/poly/lux/abstract/functor.lux @@ -1,5 +1,6 @@ (.module: [lux #* + ["." type] [abstract [monad (#+ Monad do)]] [control @@ -8,8 +9,6 @@ ["s" code (#+ Parser)]]] [data ["." product] - [number - ["n" nat]] ["." text ["%" format (#+ format)]] [collection @@ -19,7 +18,9 @@ [syntax (#+ syntax:) ["." common]] ["." poly (#+ poly:)]] - ["." type]] + [math + [number + ["n" nat]]]] {1 ["." /]}) diff --git a/stdlib/source/poly/lux/data/format/json.lux b/stdlib/source/poly/lux/data/format/json.lux index 58784dccd..b6c14eb14 100644 --- a/stdlib/source/poly/lux/data/format/json.lux +++ b/stdlib/source/poly/lux/data/format/json.lux @@ -14,27 +14,28 @@ maybe ["." sum] ["." product] - [number - ["." i64] - ["n" nat ("#\." decimal)] - ["." int] - ["." frac ("#\." decimal)]] ["." text ("#\." equivalence) ["%" format (#+ format)]] [collection ["." list ("#\." fold monad)] ["." row (#+ Row row) ("#\." monad)] ["d" dictionary]]] + [macro + [syntax (#+ syntax:)] + ["." code] + ["." poly (#+ poly:)]] + [math + [number + ["." i64] + ["n" nat ("#\." decimal)] + ["." int] + ["." frac ("#\." decimal)]]] [time ## ["." instant] ## ["." duration] ["." date] ["." day] ["." month]] - [macro - [syntax (#+ syntax:)] - ["." code] - ["." poly (#+ poly:)]] ["." type ["." unit]]] {1 diff --git a/stdlib/source/program/aedifex.lux b/stdlib/source/program/aedifex.lux index 67c4e89f3..6a4deb3c3 100644 --- a/stdlib/source/program/aedifex.lux +++ b/stdlib/source/program/aedifex.lux @@ -44,10 +44,10 @@ ["#." parser] ["#." pom] ["#." cli] - ["#." cache] - ["#." repository (#+ Address Repository)] ["#." dependency #_ ["#" resolution (#+ Resolution)]] + ["#." repository (#+ Repository) + ["#/." remote (#+ Address)]] ["#." command (#+ Command) ["#/." version] ["#/." clean] @@ -63,7 +63,7 @@ (-> /.Profile (List (Repository Promise))) (|>> (get@ #/.repositories) set.to_list - (list\map (|>> (/repository.remote #.None) /repository.async)))) + (list\map (|>> (/repository/remote.repository #.None) /repository.async)))) (def: (with_dependencies program console command profile) (All [a] @@ -149,7 +149,7 @@ (dictionary.get repository (get@ #/.deploy_repositories profile))] [(#.Some artifact) (#.Some repository)] (/command/deploy.do! console - (/repository.async (/repository.remote (#.Some identity) repository)) + (/repository.async (/repository/remote.repository (#.Some identity) repository)) (file.async file.default) artifact profile) diff --git a/stdlib/source/program/aedifex/command/build.lux b/stdlib/source/program/aedifex/command/build.lux index cb4465edd..a05d7ad85 100644 --- a/stdlib/source/program/aedifex/command/build.lux +++ b/stdlib/source/program/aedifex/command/build.lux @@ -18,7 +18,8 @@ [collection ["." list ("#\." functor)] ["." dictionary] - ["." set]] + ["." set]]] + [math [number ["i" int]]] [world diff --git a/stdlib/source/program/aedifex/command/deploy.lux b/stdlib/source/program/aedifex/command/deploy.lux index 1f84567f0..b00f964d7 100644 --- a/stdlib/source/program/aedifex/command/deploy.lux +++ b/stdlib/source/program/aedifex/command/deploy.lux @@ -37,7 +37,8 @@ ["#." pom] ["#." hash] ["#." repository (#+ Repository) - [identity (#+ Identity)]] + [identity (#+ Identity)] + ["#/." remote]] ["#." metadata ["#/." artifact] ["#/." snapshot]] @@ -93,7 +94,7 @@ (def: #export (do! console repository fs artifact profile) (-> (Console Promise) (Repository Promise) (file.System Promise) Artifact (Command Any)) (let [deploy! (: (-> Extension Binary (Action Any)) - (|>> (///repository.uri artifact) + (|>> (///repository/remote.uri artifact) (\ repository upload))) fully_deploy! (: (-> Extension Binary (Action Any)) (function (_ extension payload) diff --git a/stdlib/source/program/aedifex/command/test.lux b/stdlib/source/program/aedifex/command/test.lux index 2727fc461..dff9b14ee 100644 --- a/stdlib/source/program/aedifex/command/test.lux +++ b/stdlib/source/program/aedifex/command/test.lux @@ -9,7 +9,8 @@ ["!" capability]]] [data [text - ["%" format (#+ format)]] + ["%" format (#+ format)]]] + [math [number ["i" int]]] [world diff --git a/stdlib/source/program/aedifex/dependency/resolution.lux b/stdlib/source/program/aedifex/dependency/resolution.lux index e9d457ac9..1b40a3004 100644 --- a/stdlib/source/program/aedifex/dependency/resolution.lux +++ b/stdlib/source/program/aedifex/dependency/resolution.lux @@ -19,14 +19,15 @@ [text ["%" format (#+ format)] ["." encoding]] - [number - ["." i64] - ["n" nat]] [format ["." xml (#+ Tag XML)]] [collection ["." dictionary (#+ Dictionary)] ["." set]]] + [math + [number + ["n" nat] + ["." i64]]] [world [net (#+ URL) ["." uri]]]] @@ -39,7 +40,8 @@ ["#." package (#+ Package)] ["#." artifact (#+ Artifact) ["#/." extension (#+ Extension)]] - ["#." repository (#+ Address Repository) + ["#." repository (#+ Repository) + ["#/." remote (#+ Address)] ["#/." origin (#+ Origin)]]]]) (template [<name>] @@ -60,7 +62,7 @@ (Exception [Artifact Extension Text]) (Promise (Try (Hash h))))) (do (try.with promise.monad) - [actual (\ repository download (///repository.uri artifact extension))] + [actual (\ repository download (///repository/remote.uri artifact extension))] (\ promise.monad wrap (do try.monad [output (\ encoding.utf8 decode actual) @@ -72,7 +74,7 @@ (def: (hashed repository artifact extension) (-> (Repository Promise) Artifact Extension (Promise (Try [Binary Status]))) (do (try.with promise.monad) - [data (\ repository download (///repository.uri artifact extension)) + [data (\ repository download (///repository/remote.uri artifact extension)) sha-1 (..verified_hash data repository artifact (format extension ///artifact/extension.sha-1) ///hash.sha-1 ///hash.sha-1_codec ..sha-1_does_not_match) diff --git a/stdlib/source/program/aedifex/hash.lux b/stdlib/source/program/aedifex/hash.lux index 2c0c6df25..336d9bc96 100644 --- a/stdlib/source/program/aedifex/hash.lux +++ b/stdlib/source/program/aedifex/hash.lux @@ -12,10 +12,11 @@ ["." binary (#+ Binary)] ["." text ["%" format (#+ Format format)] - ["." encoding]] + ["." encoding]]] + [math [number - ["." i64] - ["n" nat]]] + ["n" nat] + ["." i64]]] [type abstract]]) diff --git a/stdlib/source/program/aedifex/metadata/artifact.lux b/stdlib/source/program/aedifex/metadata/artifact.lux index cf9a34b58..5762bf49d 100644 --- a/stdlib/source/program/aedifex/metadata/artifact.lux +++ b/stdlib/source/program/aedifex/metadata/artifact.lux @@ -11,12 +11,13 @@ ["." product] ["." text ["%" format (#+ format)]] - [number - ["n" nat]] [format ["." xml (#+ XML)]] [collection ["." list ("#\." functor)]]] + [math + [number + ["n" nat]]] ["." time (#+ Time) ["." instant (#+ Instant)] ["." date (#+ Date)] diff --git a/stdlib/source/program/aedifex/metadata/snapshot.lux b/stdlib/source/program/aedifex/metadata/snapshot.lux index ea6ce4719..38af9a729 100644 --- a/stdlib/source/program/aedifex/metadata/snapshot.lux +++ b/stdlib/source/program/aedifex/metadata/snapshot.lux @@ -12,12 +12,13 @@ ["." product] ["." text ["%" format (#+ format)]] - [number - ["n" nat]] [format ["." xml (#+ XML)]] [collection ["." list ("#\." functor)]]] + [math + [number + ["n" nat]]] ["." time (#+ Time) ["." instant (#+ Instant)] ["." date (#+ Date)] diff --git a/stdlib/source/program/aedifex/parser.lux b/stdlib/source/program/aedifex/parser.lux index 8f95cc6a4..4a21b341a 100644 --- a/stdlib/source/program/aedifex/parser.lux +++ b/stdlib/source/program/aedifex/parser.lux @@ -21,7 +21,8 @@ ["/" profile] ["#." project (#+ Project)] ["#." dependency] - ["#." repository] + ["#." repository #_ + ["#" remote]] ["#." artifact (#+ Artifact) ["#/." type]]]) diff --git a/stdlib/source/program/aedifex/pom.lux b/stdlib/source/program/aedifex/pom.lux index d1787d07c..f085e2808 100644 --- a/stdlib/source/program/aedifex/pom.lux +++ b/stdlib/source/program/aedifex/pom.lux @@ -19,8 +19,9 @@ ["." dictionary]]]] ["." // #_ ["/" profile] - ["#." repository (#+ Address)] ["#." dependency (#+ Dependency)] + [repository + [remote (#+ Address)]] ["#." artifact (#+ Artifact) ["#/." type]]]) diff --git a/stdlib/source/program/aedifex/profile.lux b/stdlib/source/program/aedifex/profile.lux index adf1b049e..fa49e41cd 100644 --- a/stdlib/source/program/aedifex/profile.lux +++ b/stdlib/source/program/aedifex/profile.lux @@ -24,7 +24,8 @@ [// ["." artifact (#+ Artifact)] ["." dependency] - ["." repository]]) + ["." repository #_ + ["#" remote (#+ Address)]]]) (type: #export Distribution #Repo diff --git a/stdlib/source/program/aedifex/repository.lux b/stdlib/source/program/aedifex/repository.lux index 582144ad4..230888cef 100644 --- a/stdlib/source/program/aedifex/repository.lux +++ b/stdlib/source/program/aedifex/repository.lux @@ -1,38 +1,18 @@ (.module: [lux #* - ["." host (#+ import:)] [abstract [monad (#+ do)]] [control - ["." io (#+ IO)] + [io (#+ IO)] ["." try (#+ Try)] - ["." exception (#+ exception:)] [concurrency ["." promise (#+ Promise)] ["." stm]]] [data - ["." binary (#+ Binary)] - ["." text - ["%" format (#+ format)]] - [number - ["n" nat]]] - [tool - [compiler - ["." version] - ["." language #_ - ["#/." lux #_ - ["#" version]]]]] + [binary (#+ Binary)]] [world - [net (#+ URL) - ["." uri (#+ URI)]]]] - ["." / #_ - ["#." identity (#+ Identity)] - ["/#" // #_ - ["#." artifact (#+ Artifact) - ["#/." extension (#+ Extension)]]]]) - -(type: #export Address - URL) + [net + [uri (#+ URI)]]]]) (signature: #export (Repository !) (: (-> URI (! (Try Binary))) @@ -86,108 +66,3 @@ (#try.Failure error) (wrap (#try.Failure error)))))) ))) - -(import: java/lang/String) - -(import: java/lang/AutoCloseable - ["#::." - (close [] #io #try void)]) - -(import: java/io/InputStream) - -(import: java/io/OutputStream - ["#::." - (flush [] #io #try void) - (write [[byte]] #io #try void)]) - -(import: java/net/URLConnection - ["#::." - (setDoOutput [boolean] #io #try void) - (setRequestProperty [java/lang/String java/lang/String] #io #try void) - (getInputStream [] #io #try java/io/InputStream) - (getOutputStream [] #io #try java/io/OutputStream)]) - -(import: java/net/HttpURLConnection - ["#::." - (setRequestMethod [java/lang/String] #io #try void) - (getResponseCode [] #io #try int)]) - -(import: java/net/URL - ["#::." - (new [java/lang/String]) - (openConnection [] #io #try java/net/URLConnection)]) - -(import: java/io/BufferedInputStream - ["#::." - (new [java/io/InputStream]) - (read [[byte] int int] #io #try int)]) - -(exception: #export (no_credentials {address Address}) - (exception.report - ["Address" (%.text address)])) - -(exception: #export (deployment_failure {code Int}) - (exception.report - ["Code" (%.int code)])) - -(def: #export (uri artifact extension) - (-> Artifact Extension URI) - (format (//artifact.uri artifact) extension)) - -(def: buffer_size - (n.* 512 1,024)) - -(def: user_agent - (format "LuxAedifex/" (version.format language/lux.version))) - -(structure: #export (remote identity address) - (All [s] (-> (Maybe Identity) Address (Repository IO))) - - (def: (download uri) - (do {! (try.with io.monad)} - [connection (|> (format address uri) - java/net/URL::new - java/net/URL::openConnection) - #let [connection (:coerce java/net/HttpURLConnection connection)] - _ (java/net/HttpURLConnection::setRequestMethod "GET" connection) - _ (java/net/URLConnection::setRequestProperty "User-Agent" ..user_agent connection) - input (|> connection - java/net/URLConnection::getInputStream - (\ ! map (|>> java/io/BufferedInputStream::new))) - #let [buffer (binary.create ..buffer_size)]] - (loop [output (\ binary.monoid identity)] - (do ! - [bytes_read (java/io/BufferedInputStream::read buffer +0 (.int ..buffer_size) input)] - (case bytes_read - -1 (do ! - [_ (java/lang/AutoCloseable::close input)] - (wrap output)) - _ (if (n.= ..buffer_size bytes_read) - (recur (\ binary.monoid compose output buffer)) - (do ! - [chunk (\ io.monad wrap (binary.slice 0 (.nat bytes_read) buffer))] - (recur (\ binary.monoid compose output chunk))))))))) - - (def: (upload uri content) - (case identity - #.None - (\ io.monad wrap (exception.throw ..no_credentials [address])) - - (#.Some [user password]) - (do (try.with io.monad) - [connection (|> (format address uri) - java/net/URL::new - java/net/URL::openConnection) - #let [connection (:coerce java/net/HttpURLConnection connection)] - _ (java/net/HttpURLConnection::setRequestMethod "PUT" connection) - _ (java/net/URLConnection::setDoOutput true connection) - _ (java/net/URLConnection::setRequestProperty "Authorization" (/identity.basic_auth user password) connection) - stream (java/net/URLConnection::getOutputStream connection) - _ (java/io/OutputStream::write content stream) - _ (java/io/OutputStream::flush stream) - _ (java/lang/AutoCloseable::close stream) - code (java/net/HttpURLConnection::getResponseCode connection)] - (case code - +201 (wrap []) - _ (\ io.monad wrap (exception.throw ..deployment_failure [code])))))) - ) diff --git a/stdlib/source/program/aedifex/repository/remote.lux b/stdlib/source/program/aedifex/repository/remote.lux new file mode 100644 index 000000000..4979e5429 --- /dev/null +++ b/stdlib/source/program/aedifex/repository/remote.lux @@ -0,0 +1,138 @@ +(.module: + [lux #* + [host (#+ import:)] + [abstract + [monad (#+ do)]] + [control + ["." io (#+ IO)] + ["." try] + ["." exception (#+ exception:)]] + [data + ["." binary] + ["." text + ["%" format (#+ format)]]] + [math + [number + ["n" nat]]] + [tool + [compiler + ["." version] + ["." language #_ + ["#/." lux #_ + ["#" version]]]]] + [world + [net (#+ URL) + [uri (#+ URI)]]]] + ["." // + ["#." identity (#+ Identity)] + ["/#" // #_ + ["#." artifact (#+ Artifact) + [extension (#+ Extension)]]]]) + +(type: #export Address + URL) + +(import: java/lang/String) + +(import: java/lang/AutoCloseable + ["#::." + (close [] #io #try void)]) + +(import: java/io/InputStream) + +(import: java/io/OutputStream + ["#::." + (flush [] #io #try void) + (write [[byte]] #io #try void)]) + +(import: java/net/URLConnection + ["#::." + (setDoOutput [boolean] #io #try void) + (setRequestProperty [java/lang/String java/lang/String] #io #try void) + (getInputStream [] #io #try java/io/InputStream) + (getOutputStream [] #io #try java/io/OutputStream)]) + +(import: java/net/HttpURLConnection + ["#::." + (setRequestMethod [java/lang/String] #io #try void) + (getResponseCode [] #io #try int)]) + +(import: java/net/URL + ["#::." + (new [java/lang/String]) + (openConnection [] #io #try java/net/URLConnection)]) + +(import: java/io/BufferedInputStream + ["#::." + (new [java/io/InputStream]) + (read [[byte] int int] #io #try int)]) + +(exception: #export (no_credentials {address Address}) + (exception.report + ["Address" (%.text address)])) + +(exception: #export (deployment_failure {code Int}) + (exception.report + ["Code" (%.int code)])) + +(def: #export (uri artifact extension) + (-> Artifact Extension URI) + (format (///artifact.uri artifact) extension)) + +(def: buffer_size + (n.* 512 1,024)) + +(def: user_agent + (format "LuxAedifex/" (version.format language/lux.version))) + +(structure: #export (repository identity address) + (All [s] (-> (Maybe Identity) Address (//.Repository IO))) + + (def: (download uri) + (do {! (try.with io.monad)} + [connection (|> (format address uri) + java/net/URL::new + java/net/URL::openConnection) + #let [connection (:coerce java/net/HttpURLConnection connection)] + _ (java/net/HttpURLConnection::setRequestMethod "GET" connection) + _ (java/net/URLConnection::setRequestProperty "User-Agent" ..user_agent connection) + input (|> connection + java/net/URLConnection::getInputStream + (\ ! map (|>> java/io/BufferedInputStream::new))) + #let [buffer (binary.create ..buffer_size)]] + (loop [output (\ binary.monoid identity)] + (do ! + [bytes_read (java/io/BufferedInputStream::read buffer +0 (.int ..buffer_size) input)] + (case bytes_read + -1 (do ! + [_ (java/lang/AutoCloseable::close input)] + (wrap output)) + _ (if (n.= ..buffer_size bytes_read) + (recur (\ binary.monoid compose output buffer)) + (do ! + [chunk (\ io.monad wrap (binary.slice 0 (.nat bytes_read) buffer))] + (recur (\ binary.monoid compose output chunk))))))))) + + (def: (upload uri content) + (case identity + #.None + (\ io.monad wrap (exception.throw ..no_credentials [address])) + + (#.Some [user password]) + (do (try.with io.monad) + [connection (|> (format address uri) + java/net/URL::new + java/net/URL::openConnection) + #let [connection (:coerce java/net/HttpURLConnection connection)] + _ (java/net/HttpURLConnection::setRequestMethod "PUT" connection) + _ (java/net/URLConnection::setDoOutput true connection) + _ (java/net/URLConnection::setRequestProperty "Authorization" (//identity.basic_auth user password) connection) + stream (java/net/URLConnection::getOutputStream connection) + _ (java/io/OutputStream::write content stream) + _ (java/io/OutputStream::flush stream) + _ (java/lang/AutoCloseable::close stream) + code (java/net/HttpURLConnection::getResponseCode connection)] + (case code + +201 (wrap []) + _ (\ io.monad wrap (exception.throw ..deployment_failure [code])))))) + ) diff --git a/stdlib/source/program/compositor.lux b/stdlib/source/program/compositor.lux index fdd985f2a..6c1a9202c 100644 --- a/stdlib/source/program/compositor.lux +++ b/stdlib/source/program/compositor.lux @@ -57,54 +57,54 @@ ["#." export] ["#." import]]) -(def: (or-crash! failure-description action) +(def: (or_crash! failure_description action) (All [a] (-> Text (Promise (Try a)) (Promise a))) (do promise.monad [?output action] (case ?output (#try.Failure error) - (exec (log! (format text.new-line - failure-description text.new-line - error text.new-line)) + (exec (log! (format text.new_line + failure_description text.new_line + error text.new_line)) (io.run (\ world/program.default exit +1))) (#try.Success output) (wrap output)))) -(def: (package! monad file-system [packager package] static archive context) +(def: (package! monad file_system [packager package] static archive context) (All [!] (-> (Monad !) (file.System !) [Packager Path] Static Archive Context (! (Try Any)))) (for {@.old (do (try.with monad) [#let [packager (:share [!] {(Monad !) monad} {(Packager !) packager})] - content (packager monad file-system static archive context) + content (packager monad file_system static archive context) package (:share [!] {(Monad !) monad} {(! (Try (File !))) - (:assume (file.get-file monad file-system package))})] + (:assume (file.get_file monad file_system package))})] (!.use (\ (:share [!] {(Monad !) monad} {(File !) (:assume package)}) - over-write) + over_write) [content]))} - ## TODO: Fix whatever type-checker bug is forcing me into this compromise... + ## TODO: Fix whatever type_checker bug is forcing me into this compromise... (:assume (: (Promise (Try Any)) (let [monad (:coerce (Monad Promise) monad) - file-system (:coerce (file.System Promise) file-system) + file_system (:coerce (file.System Promise) file_system) packager (:coerce (Packager Promise) packager)] (do (try.with monad) - [content (packager monad file-system static archive context) + [content (packager monad file_system static archive context) package (: (Promise (Try (File Promise))) - (file.get-file monad file-system package))] - (!.use (\ (: (File Promise) package) over-write) [content]))))))) + (file.get_file monad file_system package))] + (!.use (\ (: (File Promise) package) over_write) [content]))))))) -(with-expansions [<parameters> (as-is anchor expression artifact)] +(with_expansions [<parameters> (as_is anchor expression artifact)] (def: #export (compiler static - expander host-analysis platform generation-bundle host-directive-bundle program anchorT,expressionT,directiveT extender + expander host_analysis platform generation_bundle host_directive_bundle program anchorT,expressionT,directiveT extender service packager,package) (All [<parameters>] @@ -124,41 +124,41 @@ [platform (promise.future platform)] (case service (#/cli.Compilation compilation) - (<| (or-crash! "Compilation failed:") + (<| (or_crash! "Compilation failed:") (do (try.with promise.monad) - [#let [[compilation-sources compilation-libraries compilation-target compilation-module] compilation] - import (/import.import (get@ #platform.&file-system platform) compilation-libraries) + [#let [[compilation_sources compilation_libraries compilation_target compilation_module] compilation] + import (/import.import (get@ #platform.&file_system platform) compilation_libraries) [state archive] (:share [<parameters>] {(Platform <parameters>) platform} {(Promise (Try [(directive.State+ <parameters>) Archive])) - (:assume (platform.initialize static compilation-module expander host-analysis platform generation-bundle host-directive-bundle program anchorT,expressionT,directiveT extender - import compilation-sources))}) + (:assume (platform.initialize static compilation_module expander host_analysis platform generation_bundle host_directive_bundle program anchorT,expressionT,directiveT extender + import compilation_sources))}) [archive state] (:share [<parameters>] {(Platform <parameters>) platform} {(Promise (Try [Archive (directive.State+ <parameters>)])) (:assume (platform.compile import static expander platform compilation [archive state]))}) - _ (ioW.freeze (get@ #platform.&file-system platform) static archive) - program-context (promise\wrap ($/program.context archive)) - _ (promise.future (..package! io.monad file.default packager,package static archive program-context))] + _ (ioW.freeze (get@ #platform.&file_system platform) static archive) + program_context (promise\wrap ($/program.context archive)) + _ (promise.future (..package! io.monad file.default packager,package static archive program_context))] (wrap (log! "Compilation complete!")))) (#/cli.Export export) - (<| (or-crash! "Export failed:") + (<| (or_crash! "Export failed:") (do (try.with promise.monad) - [_ (/export.export (get@ #platform.&file-system platform) + [_ (/export.export (get@ #platform.&file_system platform) export)] (wrap (log! "Export complete!")))) (#/cli.Interpretation interpretation) ## TODO: Fix the interpreter... (undefined) - ## (<| (or-crash! "Interpretation failed:") + ## (<| (or_crash! "Interpretation failed:") ## (do {! promise.monad} ## [console (|> console.default ## promise.future ## (\ ! map (|>> try.assume console.async)))] - ## (interpreter.run (try.with promise.monad) console platform interpretation generation-bundle))) + ## (interpreter.run (try.with promise.monad) console platform interpretation generation_bundle))) )))) diff --git a/stdlib/source/program/compositor/static.lux b/stdlib/source/program/compositor/static.lux index 3fdd8727e..51bbef0e9 100644 --- a/stdlib/source/program/compositor/static.lux +++ b/stdlib/source/program/compositor/static.lux @@ -6,6 +6,6 @@ (type: #export Static {#host Host - #host-module-extension Text + #host_module_extension Text #target Path - #artifact-extension Text}) + #artifact_extension Text}) diff --git a/stdlib/source/spec/aedifex/repository.lux b/stdlib/source/spec/aedifex/repository.lux index 35f26eabc..250bd3d01 100644 --- a/stdlib/source/spec/aedifex/repository.lux +++ b/stdlib/source/spec/aedifex/repository.lux @@ -15,6 +15,7 @@ ["." random]]] {#program ["." / + ["#." remote] ["/#" // #_ ["#." artifact (#+ Artifact) ["#/." extension]]]]} @@ -28,11 +29,11 @@ [expected (_binary.random 100)] (wrap ($_ _.and' (do promise.monad - [#let [uri/good (/.uri valid_artifact //artifact/extension.lux_library)] + [#let [uri/good (/remote.uri valid_artifact //artifact/extension.lux_library)] upload!/good (\ subject upload uri/good expected) download!/good (\ subject download uri/good) - #let [uri/bad (/.uri invalid_artifact //artifact/extension.lux_library)] + #let [uri/bad (/remote.uri invalid_artifact //artifact/extension.lux_library)] upload!/bad (\ subject upload uri/bad expected) download!/bad (\ subject download uri/bad)] (_.cover' [/.Repository] diff --git a/stdlib/source/spec/lux/abstract/apply.lux b/stdlib/source/spec/lux/abstract/apply.lux index 8b9884b26..a3218ae0c 100644 --- a/stdlib/source/spec/lux/abstract/apply.lux +++ b/stdlib/source/spec/lux/abstract/apply.lux @@ -1,50 +1,49 @@ (.module: [lux #* + ["_" test (#+ Test)] [abstract [monad (#+ do)]] - [data - [number - ["n" nat]]] [control ["." function]] [math - ["." random]] - ["_" test (#+ Test)]] + ["." random] + [number + ["n" nat]]]] {1 ["." / (#+ Apply)]} [// [functor (#+ Injection Comparison)]]) -(def: (identity injection comparison (^open "_//.")) +(def: (identity injection comparison (^open "\.")) (All [f] (-> (Injection f) (Comparison f) (Apply f) Test)) (do {! random.monad} [sample (\ ! map injection random.nat)] (_.test "Identity." ((comparison n.=) - (_//apply (injection function.identity) sample) + (\apply (injection function.identity) sample) sample)))) -(def: (homomorphism injection comparison (^open "_//.")) +(def: (homomorphism injection comparison (^open "\.")) (All [f] (-> (Injection f) (Comparison f) (Apply f) Test)) (do {! random.monad} [sample random.nat increase (\ ! map n.+ random.nat)] (_.test "Homomorphism." ((comparison n.=) - (_//apply (injection increase) (injection sample)) + (\apply (injection increase) (injection sample)) (injection (increase sample)))))) -(def: (interchange injection comparison (^open "_//.")) +(def: (interchange injection comparison (^open "\.")) (All [f] (-> (Injection f) (Comparison f) (Apply f) Test)) (do {! random.monad} [sample random.nat increase (\ ! map n.+ random.nat)] (_.test "Interchange." ((comparison n.=) - (_//apply (injection increase) (injection sample)) - (_//apply (injection (function (_ f) (f sample))) (injection increase)))))) + (\apply (injection increase) (injection sample)) + (\apply (injection (function (_ f) (f sample))) (injection increase)))))) -(def: (composition injection comparison (^open "_//.")) +(def: (composition injection comparison (^open "\.")) (All [f] (-> (Injection f) (Comparison f) (Apply f) Test)) (do {! random.monad} [sample random.nat @@ -52,12 +51,12 @@ decrease (\ ! map n.- random.nat)] (_.test "Composition." ((comparison n.=) - (_$ _//apply + (_$ \apply (injection function.compose) (injection increase) (injection decrease) (injection sample)) - ($_ _//apply + ($_ \apply (injection increase) (injection decrease) (injection sample)))))) diff --git a/stdlib/source/spec/lux/abstract/comonad.lux b/stdlib/source/spec/lux/abstract/comonad.lux index 5865381d2..42933a9e3 100644 --- a/stdlib/source/spec/lux/abstract/comonad.lux +++ b/stdlib/source/spec/lux/abstract/comonad.lux @@ -1,13 +1,12 @@ (.module: [lux #* + ["_" test (#+ Test)] [abstract [monad (#+ do)]] - [data - [number - ["n" nat]]] [math - ["." random]] - ["_" test (#+ Test)]] + ["." random] + [number + ["n" nat]]]] {1 ["." / (#+ CoMonad)]} [// diff --git a/stdlib/source/spec/lux/abstract/fold.lux b/stdlib/source/spec/lux/abstract/fold.lux index c1d87dba1..03421803f 100644 --- a/stdlib/source/spec/lux/abstract/fold.lux +++ b/stdlib/source/spec/lux/abstract/fold.lux @@ -3,11 +3,10 @@ ["_" test (#+ Test)] [abstract [monad (#+ do)]] - [data - [number - ["n" nat]]] [math - ["." random]]] + ["." random] + [number + ["n" nat]]]] [// [functor (#+ Injection Comparison)]] {1 ["." /]}) diff --git a/stdlib/source/spec/lux/abstract/functor.lux b/stdlib/source/spec/lux/abstract/functor.lux index f29e34554..88fc113ee 100644 --- a/stdlib/source/spec/lux/abstract/functor.lux +++ b/stdlib/source/spec/lux/abstract/functor.lux @@ -6,11 +6,10 @@ [monad (#+ do)]] [control ["." function]] - [data - [number - ["n" nat]]] [math - ["." random]]] + ["." random] + [number + ["n" nat]]]] {1 ["." / (#+ Functor)]}) diff --git a/stdlib/source/spec/lux/abstract/functor/contravariant.lux b/stdlib/source/spec/lux/abstract/functor/contravariant.lux index 8a2e237b6..f713b5c9e 100644 --- a/stdlib/source/spec/lux/abstract/functor/contravariant.lux +++ b/stdlib/source/spec/lux/abstract/functor/contravariant.lux @@ -1,16 +1,15 @@ (.module: [lux #* + ["_" test (#+ Test)] [abstract [equivalence (#+ Equivalence)] [monad (#+ do)]] - [data - [number - ["n" nat]]] [control ["." function]] [math - ["." random]] - ["_" test (#+ Test)]] + ["." random] + [number + ["n" nat]]]] {1 ["." / (#+ Functor)]}) diff --git a/stdlib/source/spec/lux/abstract/hash.lux b/stdlib/source/spec/lux/abstract/hash.lux index a87846d1c..17f8d12f2 100644 --- a/stdlib/source/spec/lux/abstract/hash.lux +++ b/stdlib/source/spec/lux/abstract/hash.lux @@ -4,11 +4,11 @@ [abstract [monad (#+ do)]] [data - ["." bit ("#\." equivalence)] - [number - ["n" nat]]] + ["." bit ("#\." equivalence)]] [math - ["." random (#+ Random)]]] + ["." random (#+ Random)] + [number + ["n" nat]]]] {1 ["." /]}) diff --git a/stdlib/source/spec/lux/abstract/monad.lux b/stdlib/source/spec/lux/abstract/monad.lux index 322de7b7b..a1e5a41e4 100644 --- a/stdlib/source/spec/lux/abstract/monad.lux +++ b/stdlib/source/spec/lux/abstract/monad.lux @@ -1,18 +1,17 @@ (.module: [lux #* - [data - [number - ["n" nat]]] + ["_" test (#+ Test)] [math - ["." random]] - ["_" test (#+ Test)]] + ["." random] + [number + ["n" nat]]]] {1 - ["." / (#+ Monad do)]} + ["." / (#+ do)]} [// [functor (#+ Injection Comparison)]]) (def: (left-identity injection comparison (^open "_//.")) - (All [f] (-> (Injection f) (Comparison f) (Monad f) Test)) + (All [f] (-> (Injection f) (Comparison f) (/.Monad f) Test)) (do {! random.monad} [sample random.nat morphism (\ ! map (function (_ diff) @@ -24,7 +23,7 @@ (morphism sample))))) (def: (right-identity injection comparison (^open "_//.")) - (All [f] (-> (Injection f) (Comparison f) (Monad f) Test)) + (All [f] (-> (Injection f) (Comparison f) (/.Monad f) Test)) (do random.monad [sample random.nat] (_.test "Right identity." @@ -33,7 +32,7 @@ (injection sample))))) (def: (associativity injection comparison (^open "_//.")) - (All [f] (-> (Injection f) (Comparison f) (Monad f) Test)) + (All [f] (-> (Injection f) (Comparison f) (/.Monad f) Test)) (do {! random.monad} [sample random.nat increase (\ ! map (function (_ diff) @@ -48,7 +47,7 @@ (|> (injection sample) (_//map (|>> increase (_//map decrease) _//join)) _//join))))) (def: #export (spec injection comparison monad) - (All [f] (-> (Injection f) (Comparison f) (Monad f) Test)) + (All [f] (-> (Injection f) (Comparison f) (/.Monad f) Test)) (<| (_.for [/.Monad]) ($_ _.and (..left-identity injection comparison monad) diff --git a/stdlib/source/spec/lux/world/shell.lux b/stdlib/source/spec/lux/world/shell.lux index 1a9d649b8..15e3012d0 100644 --- a/stdlib/source/spec/lux/world/shell.lux +++ b/stdlib/source/spec/lux/world/shell.lux @@ -14,12 +14,12 @@ [data ["." product] ["." text ("#\." equivalence) - ["%" format (#+ format)]] + ["%" format (#+ format)]]] + [math + ["." random] [number ["n" nat] - ["i" int]]] - [math - ["." random]]] + ["i" int]]]] {1 ["." / [// diff --git a/stdlib/source/test/aedifex/artifact/extension.lux b/stdlib/source/test/aedifex/artifact/extension.lux index 2a3f3f564..5d2491d28 100644 --- a/stdlib/source/test/aedifex/artifact/extension.lux +++ b/stdlib/source/test/aedifex/artifact/extension.lux @@ -5,13 +5,13 @@ [monad (#+ do)]] [data ["." text ("#\." equivalence)] - [number - ["n" nat]] [collection ["." set] ["." list]]] [math - ["." random (#+ Random)]]] + ["." random (#+ Random)] + [number + ["n" nat]]]] {#program ["." / ["/#" // #_ diff --git a/stdlib/source/test/aedifex/artifact/type.lux b/stdlib/source/test/aedifex/artifact/type.lux index 7f153b2a9..01b581eb3 100644 --- a/stdlib/source/test/aedifex/artifact/type.lux +++ b/stdlib/source/test/aedifex/artifact/type.lux @@ -5,13 +5,13 @@ [monad (#+ do)]] [data ["." text] - [number - ["n" nat]] [collection ["." set] ["." list]]] [math - ["." random (#+ Random) ("#\." monad)]]] + ["." random (#+ Random) ("#\." monad)] + [number + ["n" nat]]]] {#program ["." /]}) diff --git a/stdlib/source/test/aedifex/cache.lux b/stdlib/source/test/aedifex/cache.lux index bc436733b..22a32e43f 100644 --- a/stdlib/source/test/aedifex/cache.lux +++ b/stdlib/source/test/aedifex/cache.lux @@ -12,15 +12,15 @@ [data [binary (#+ Binary)] ["." text] - [number - ["n" nat]] [format [xml (#+ XML)]] [collection ["." set] ["." dictionary]]] [math - ["." random (#+ Random) ("#\." monad)]] + ["." random (#+ Random) ("#\." monad)] + [number + ["n" nat]]] [world ["." file] ["." program]]] diff --git a/stdlib/source/test/aedifex/command/auto.lux b/stdlib/source/test/aedifex/command/auto.lux index 817b4db5f..7bac6eb5d 100644 --- a/stdlib/source/test/aedifex/command/auto.lux +++ b/stdlib/source/test/aedifex/command/auto.lux @@ -15,14 +15,14 @@ [data ["." text ["%" format (#+ format)]] - [number - ["n" nat]] [collection ["." dictionary] ["." set] ["." list ("#\." functor)]]] [math - ["." random]] + ["." random] + [number + ["n" nat]]] [world [console (#+ Console)] ["." shell (#+ Shell)] diff --git a/stdlib/source/test/aedifex/command/clean.lux b/stdlib/source/test/aedifex/command/clean.lux index c429f34fb..d98473259 100644 --- a/stdlib/source/test/aedifex/command/clean.lux +++ b/stdlib/source/test/aedifex/command/clean.lux @@ -14,13 +14,13 @@ ["." product] ["." text ("#\." equivalence) ["%" format (#+ format)]] - [number - ["n" nat]] [collection ["." list ("#\." functor)] ["." set]]] [math - ["." random (#+ Random)]] + ["." random (#+ Random)] + [number + ["n" nat]]] [world ["." file (#+ Path File)]]] [// diff --git a/stdlib/source/test/aedifex/command/deploy.lux b/stdlib/source/test/aedifex/command/deploy.lux index b6cd89469..45d39cffc 100644 --- a/stdlib/source/test/aedifex/command/deploy.lux +++ b/stdlib/source/test/aedifex/command/deploy.lux @@ -49,7 +49,8 @@ ["#." local] ["#." hash] ["#." repository (#+ Repository) - [identity (#+ Identity)]] + [identity (#+ Identity)] + ["#/." remote]] ["#." artifact (#+ Artifact) ["#/." extension]]]]]}) @@ -111,10 +112,10 @@ (export.library fs) (\ ! map (format.run tar.writer))) - actual_pom (\ repository download (///repository.uri artifact ///artifact/extension.pom)) - actual_library (\ repository download (///repository.uri artifact ///artifact/extension.lux_library)) - actual_sha-1 (\ repository download (///repository.uri artifact (format ///artifact/extension.lux_library ///artifact/extension.sha-1))) - actual_md5 (\ repository download (///repository.uri artifact (format ///artifact/extension.lux_library ///artifact/extension.md5))) + actual_pom (\ repository download (///repository/remote.uri artifact ///artifact/extension.pom)) + actual_library (\ repository download (///repository/remote.uri artifact ///artifact/extension.lux_library)) + actual_sha-1 (\ repository download (///repository/remote.uri artifact (format ///artifact/extension.lux_library ///artifact/extension.sha-1))) + actual_md5 (\ repository download (///repository/remote.uri artifact (format ///artifact/extension.lux_library ///artifact/extension.md5))) #let [deployed_library! (\ binary.equivalence = diff --git a/stdlib/source/test/aedifex/hash.lux b/stdlib/source/test/aedifex/hash.lux index 502130970..4c057be60 100644 --- a/stdlib/source/test/aedifex/hash.lux +++ b/stdlib/source/test/aedifex/hash.lux @@ -12,12 +12,12 @@ ["." exception]] [data ["." binary (#+ Binary)] - [number - ["n" nat]] [text ["%" format (#+ format)]]] [math - ["." random (#+ Random)]]] + ["." random (#+ Random)] + [number + ["n" nat]]]] {#program ["." /]} [test diff --git a/stdlib/source/test/aedifex/metadata/artifact.lux b/stdlib/source/test/aedifex/metadata/artifact.lux index 3177c6ff2..6c39546b4 100644 --- a/stdlib/source/test/aedifex/metadata/artifact.lux +++ b/stdlib/source/test/aedifex/metadata/artifact.lux @@ -10,7 +10,7 @@ ["." try ("#\." functor)] [parser ["<.>" xml]]] - [data + [math [number ["n" nat]]] ["." time diff --git a/stdlib/source/test/aedifex/metadata/snapshot.lux b/stdlib/source/test/aedifex/metadata/snapshot.lux index e9e42be9a..c1725f55a 100644 --- a/stdlib/source/test/aedifex/metadata/snapshot.lux +++ b/stdlib/source/test/aedifex/metadata/snapshot.lux @@ -10,7 +10,7 @@ ["." try ("#\." functor)] [parser ["<.>" xml]]] - [data + [math [number ["n" nat]]] ["." time diff --git a/stdlib/source/test/aedifex/package.lux b/stdlib/source/test/aedifex/package.lux index 7562547df..960a75f21 100644 --- a/stdlib/source/test/aedifex/package.lux +++ b/stdlib/source/test/aedifex/package.lux @@ -10,11 +10,11 @@ [data ["." text] [collection - ["." set (#+ Set)]] + ["." set (#+ Set)]]] + [math + ["." random (#+ Random)] [number ["n" nat]]] - [math - ["." random (#+ Random)]] [world ["." file]]] [// diff --git a/stdlib/source/test/aedifex/parser.lux b/stdlib/source/test/aedifex/parser.lux index 1eb62b75d..0a13acb32 100644 --- a/stdlib/source/test/aedifex/parser.lux +++ b/stdlib/source/test/aedifex/parser.lux @@ -11,14 +11,14 @@ ["<c>" code]]] [data ["." text] - [number - ["n" nat]] [collection ["." set (#+ Set)] ["." dictionary (#+ Dictionary)] ["." list ("#\." functor)]]] [math - ["." random (#+ Random)]] + ["." random (#+ Random)] + [number + ["n" nat]]] [macro ["." code]]] [// diff --git a/stdlib/source/test/aedifex/profile.lux b/stdlib/source/test/aedifex/profile.lux index 9316fae66..ea03a1e92 100644 --- a/stdlib/source/test/aedifex/profile.lux +++ b/stdlib/source/test/aedifex/profile.lux @@ -15,22 +15,23 @@ ["." cli]]] [data ["." text] - [number - ["n" nat]] [collection ["." set (#+ Set)] ["." dictionary (#+ Dictionary)]]] [math - ["." random (#+ Random) ("#\." monad)]]] + ["." random (#+ Random) ("#\." monad)] + [number + ["n" nat]]]] [// ["@." artifact] ["@." dependency]] {#program ["." / ["/#" // #_ - [repository (#+ Address)] ["#." dependency (#+ Dependency)] - ["#." format]]]}) + ["#." format] + [repository + [remote (#+ Address)]]]]}) (def: distribution (Random /.Distribution) diff --git a/stdlib/source/test/aedifex/project.lux b/stdlib/source/test/aedifex/project.lux index cec9c0cae..5e26b63de 100644 --- a/stdlib/source/test/aedifex/project.lux +++ b/stdlib/source/test/aedifex/project.lux @@ -12,11 +12,11 @@ ["." exception]] [data ["." product] - ["." text ("#\." equivalence)] - [number - ["n" nat]]] + ["." text ("#\." equivalence)]] [math - ["." random (#+ Random) ("#\." monad)]]] + ["." random (#+ Random) ("#\." monad)] + [number + ["n" nat]]]] [// ["@." profile]] {#program diff --git a/stdlib/source/test/lux/abstract/apply.lux b/stdlib/source/test/lux/abstract/apply.lux index d56860291..fc67f9830 100644 --- a/stdlib/source/test/lux/abstract/apply.lux +++ b/stdlib/source/test/lux/abstract/apply.lux @@ -4,12 +4,12 @@ [monad (#+ do)]] [data ["." maybe] - [number - ["n" nat]] [collection ["." list]]] [math - ["." random]] + ["." random] + [number + ["n" nat]]] ["_" test (#+ Test)]] {1 ["." / (#+ Apply)]}) diff --git a/stdlib/source/test/lux/abstract/comonad.lux b/stdlib/source/test/lux/abstract/comonad.lux index 2e63b4eb8..7e59dfc42 100644 --- a/stdlib/source/test/lux/abstract/comonad.lux +++ b/stdlib/source/test/lux/abstract/comonad.lux @@ -3,11 +3,11 @@ [abstract [monad (#+ do)]] [data - ["." identity (#+ Identity)] + ["." identity (#+ Identity)]] + [math + ["." random] [number ["n" nat]]] - [math - ["." random]] ["_" test (#+ Test)]] {1 ["." /]}) diff --git a/stdlib/source/test/lux/abstract/enum.lux b/stdlib/source/test/lux/abstract/enum.lux index 4446d958c..1cee8a211 100644 --- a/stdlib/source/test/lux/abstract/enum.lux +++ b/stdlib/source/test/lux/abstract/enum.lux @@ -6,12 +6,12 @@ [data ["." product] ["." maybe ("#\." functor)] - [number - ["n" nat]] [collection ["." list ("#\." fold)]]] [math - ["." random (#+ Random)]]] + ["." random (#+ Random)] + [number + ["n" nat]]]] {1 ["." /]}) diff --git a/stdlib/source/test/lux/abstract/equivalence.lux b/stdlib/source/test/lux/abstract/equivalence.lux index 3009c289f..cceb75c42 100644 --- a/stdlib/source/test/lux/abstract/equivalence.lux +++ b/stdlib/source/test/lux/abstract/equivalence.lux @@ -8,12 +8,12 @@ [functor ["$." contravariant]]]}] [data - ["." bit ("#\." equivalence)] + ["." bit ("#\." equivalence)]] + [math + ["." random (#+ Random)] [number ["n" nat] - ["i" int]]] - [math - ["." random (#+ Random)]]] + ["i" int]]]] {1 ["." / (#+ Equivalence)]}) diff --git a/stdlib/source/test/lux/abstract/fold.lux b/stdlib/source/test/lux/abstract/fold.lux index 66f7a6e48..f4a61fa95 100644 --- a/stdlib/source/test/lux/abstract/fold.lux +++ b/stdlib/source/test/lux/abstract/fold.lux @@ -4,12 +4,12 @@ [abstract [monad (#+ do)]] [data - [number - ["n" nat]] [collection ["." list]]] [math - ["." random]]] + ["." random] + [number + ["n" nat]]]] {1 ["." / (#+ Fold)]}) diff --git a/stdlib/source/test/lux/abstract/functor.lux b/stdlib/source/test/lux/abstract/functor.lux index 593400eb5..cd56a2aba 100644 --- a/stdlib/source/test/lux/abstract/functor.lux +++ b/stdlib/source/test/lux/abstract/functor.lux @@ -5,12 +5,12 @@ [monad (#+ do)]] [data ["." maybe] - [number - ["n" nat]] [collection ["." list]]] [math - ["." random]]] + ["." random] + [number + ["n" nat]]]] {1 ["." / (#+ Functor)]}) diff --git a/stdlib/source/test/lux/abstract/interval.lux b/stdlib/source/test/lux/abstract/interval.lux index 66d607ab8..ccd5562c8 100644 --- a/stdlib/source/test/lux/abstract/interval.lux +++ b/stdlib/source/test/lux/abstract/interval.lux @@ -10,13 +10,13 @@ [control [pipe (#+ case>)]] [data - [number - ["n" nat]] [collection ["." set] ["." list]]] [math - ["." random (#+ Random)]]] + ["." random (#+ Random)] + [number + ["n" nat]]]] {1 ["." / (#+ Interval) ("\." equivalence)]}) diff --git a/stdlib/source/test/lux/abstract/monad.lux b/stdlib/source/test/lux/abstract/monad.lux index 19e5bb342..805e6478f 100644 --- a/stdlib/source/test/lux/abstract/monad.lux +++ b/stdlib/source/test/lux/abstract/monad.lux @@ -1,14 +1,14 @@ (.module: [lux #* + ["_" test (#+ Test)] [data ["." identity (#+ Identity)] - [number - ["n" nat]] [collection ["." list ("#\." functor fold)]]] [math - ["." random]] - ["_" test (#+ Test)]] + ["." random] + [number + ["n" nat]]]] {1 ["." / (#+ Monad do)]}) diff --git a/stdlib/source/test/lux/abstract/monoid.lux b/stdlib/source/test/lux/abstract/monoid.lux index 2037adeea..81835537b 100644 --- a/stdlib/source/test/lux/abstract/monoid.lux +++ b/stdlib/source/test/lux/abstract/monoid.lux @@ -3,12 +3,11 @@ ["_" test (#+ Test)] [abstract [monad (#+ do)]] - [data + [math + ["." random (#+ Random)] [number ["." nat] - ["." int]]] - [math - ["." random (#+ Random)]]] + ["." int]]]] {1 ["." / [// diff --git a/stdlib/source/test/lux/abstract/order.lux b/stdlib/source/test/lux/abstract/order.lux index f45076a0c..e9121353a 100644 --- a/stdlib/source/test/lux/abstract/order.lux +++ b/stdlib/source/test/lux/abstract/order.lux @@ -8,11 +8,11 @@ [functor ["$." contravariant]]]}] [data - ["." bit ("#\." equivalence)] - [number - ["n" nat]]] + ["." bit ("#\." equivalence)]] [math - ["." random (#+ Random)]]] + ["." random (#+ Random)] + [number + ["n" nat]]]] {1 ["." / [// diff --git a/stdlib/source/test/lux/abstract/predicate.lux b/stdlib/source/test/lux/abstract/predicate.lux index 47875a6c4..be2953aba 100644 --- a/stdlib/source/test/lux/abstract/predicate.lux +++ b/stdlib/source/test/lux/abstract/predicate.lux @@ -13,12 +13,12 @@ ["." function]] [data ["." bit ("#\." equivalence)] - [number - ["n" nat]] [collection ["." list]]] [math - ["." random (#+ Random)]]] + ["." random (#+ Random)] + [number + ["n" nat]]]] {1 ["." /]}) diff --git a/stdlib/source/test/lux/control/concatenative.lux b/stdlib/source/test/lux/control/concatenative.lux index b01981730..090fd799f 100644 --- a/stdlib/source/test/lux/control/concatenative.lux +++ b/stdlib/source/test/lux/control/concatenative.lux @@ -6,18 +6,16 @@ [data ["." sum] ["." name] - ["." bit ("#\." equivalence)] + ["." bit ("#\." equivalence)]] + [macro + ["." template]] + [math + ["." random] [number ["n" nat] ["i" int] ["r" rev] - ["f" frac]] - [text - ["%" format (#+ format)]]] - [math - ["." random]] - [macro - ["." template]]] + ["f" frac]]]] {1 ["." / (#+ word: => ||>)]}) diff --git a/stdlib/source/test/lux/control/concurrency/actor.lux b/stdlib/source/test/lux/control/concurrency/actor.lux index 7a94c72aa..d983ab382 100644 --- a/stdlib/source/test/lux/control/concurrency/actor.lux +++ b/stdlib/source/test/lux/control/concurrency/actor.lux @@ -8,15 +8,15 @@ ["." exception (#+ exception:)] ["." io (#+ IO io)]] [data - [number - ["n" nat]] [text ["%" format (#+ format)]] [collection ["." list] ["." row (#+ Row)]]] [math - ["." random]]] + ["." random] + [number + ["n" nat]]]] {1 ["." / (#+ actor: message:) [// diff --git a/stdlib/source/test/lux/control/concurrency/atom.lux b/stdlib/source/test/lux/control/concurrency/atom.lux index bdc56521a..c8496c210 100644 --- a/stdlib/source/test/lux/control/concurrency/atom.lux +++ b/stdlib/source/test/lux/control/concurrency/atom.lux @@ -5,11 +5,10 @@ [monad (#+ do)]] [control ["." io]] - [data - [number - ["n" nat]]] [math - ["." random]]] + ["." random] + [number + ["n" nat]]]] {1 ["." /]}) diff --git a/stdlib/source/test/lux/control/concurrency/frp.lux b/stdlib/source/test/lux/control/concurrency/frp.lux index d48e1b1ae..2c724fa2a 100644 --- a/stdlib/source/test/lux/control/concurrency/frp.lux +++ b/stdlib/source/test/lux/control/concurrency/frp.lux @@ -13,15 +13,13 @@ ["." exception] ["." io (#+ IO io)]] [data - [text - ["%" format (#+ format)]] - [number - ["n" nat]] [collection ["." list ("#\." fold monoid)] ["." row (#+ Row)]]] [math - ["." random]]] + ["." random] + [number + ["n" nat]]]] {1 ["." / [// diff --git a/stdlib/source/test/lux/control/concurrency/promise.lux b/stdlib/source/test/lux/control/concurrency/promise.lux index 18b040acf..7fc3196cd 100644 --- a/stdlib/source/test/lux/control/concurrency/promise.lux +++ b/stdlib/source/test/lux/control/concurrency/promise.lux @@ -11,15 +11,14 @@ [control [pipe (#+ case>)] ["." io]] - [data - [number - ["n" nat] - ["i" int]]] [time ["." instant] ["." duration]] [math - ["." random]]] + ["." random] + [number + ["n" nat] + ["i" int]]]] {1 ["." / [// diff --git a/stdlib/source/test/lux/control/concurrency/semaphore.lux b/stdlib/source/test/lux/control/concurrency/semaphore.lux index e30a930ac..472e21c7d 100644 --- a/stdlib/source/test/lux/control/concurrency/semaphore.lux +++ b/stdlib/source/test/lux/control/concurrency/semaphore.lux @@ -13,16 +13,16 @@ ["." atom (#+ Atom)]]] [data ["." maybe] - [number - ["n" nat]] ["." text ("#\." equivalence) ["%" format (#+ format)]] [collection ["." list ("#\." functor)]]] - [type - ["." refinement]] [math - ["." random]]] + ["." random] + [number + ["n" nat]]] + [type + ["." refinement]]] {1 ["." /]}) diff --git a/stdlib/source/test/lux/control/concurrency/stm.lux b/stdlib/source/test/lux/control/concurrency/stm.lux index ade5dd70d..2eec0d207 100644 --- a/stdlib/source/test/lux/control/concurrency/stm.lux +++ b/stdlib/source/test/lux/control/concurrency/stm.lux @@ -12,12 +12,12 @@ ["." io (#+ IO)]] [data ["." product] - [number - ["n" nat]] [collection ["." list ("#\." functor)]]] [math - ["." random]]] + ["." random] + [number + ["n" nat]]]] {1 ["." / [// diff --git a/stdlib/source/test/lux/control/concurrency/thread.lux b/stdlib/source/test/lux/control/concurrency/thread.lux index 04da97f17..f1ea184f0 100644 --- a/stdlib/source/test/lux/control/concurrency/thread.lux +++ b/stdlib/source/test/lux/control/concurrency/thread.lux @@ -5,15 +5,14 @@ [monad (#+ do)]] [control ["." io]] - [data - [number - ["n" nat] - ["i" int]]] [time ["." instant (#+ Instant)] ["." duration]] [math - ["." random]]] + ["." random] + [number + ["n" nat] + ["i" int]]]] {1 ["." / [// diff --git a/stdlib/source/test/lux/control/continuation.lux b/stdlib/source/test/lux/control/continuation.lux index b22705489..24aadf440 100644 --- a/stdlib/source/test/lux/control/continuation.lux +++ b/stdlib/source/test/lux/control/continuation.lux @@ -9,12 +9,12 @@ ["$." apply] ["$." monad]]}] [data - [number - ["n" nat]] [collection ["." list]]] [math - ["." random]]] + ["." random] + [number + ["n" nat]]]] {1 ["." /]}) diff --git a/stdlib/source/test/lux/control/exception.lux b/stdlib/source/test/lux/control/exception.lux index 8f890018c..c65a88fbf 100644 --- a/stdlib/source/test/lux/control/exception.lux +++ b/stdlib/source/test/lux/control/exception.lux @@ -1,15 +1,15 @@ (.module: [lux #* + ["_" test (#+ Test)] [abstract [monad (#+ do)]] [data - [number - ["n" nat]] ["." text ("#\." equivalence) ["%" format (#+ format)]]] [math - ["." random]] - ["_" test (#+ Test)]] + ["." random] + [number + ["n" nat]]]] {1 ["." / (#+ exception:) [// diff --git a/stdlib/source/test/lux/control/function.lux b/stdlib/source/test/lux/control/function.lux index c78d4f2e5..f816075f5 100644 --- a/stdlib/source/test/lux/control/function.lux +++ b/stdlib/source/test/lux/control/function.lux @@ -1,5 +1,6 @@ (.module: [lux #* + ["_" test (#+ Test)] [abstract [equivalence (#+ Equivalence)] [monad (#+ do)] @@ -7,12 +8,11 @@ [/ ["$." monoid]]}] [data - [number - ["n" nat]] ["." text ("#!." equivalence)]] [math - ["." random (#+ Random)]] - ["_" test (#+ Test)]] + ["." random (#+ Random)] + [number + ["n" nat]]]] {1 ["." /]} ["." / #_ diff --git a/stdlib/source/test/lux/control/function/contract.lux b/stdlib/source/test/lux/control/function/contract.lux index 422c98618..47962d04a 100644 --- a/stdlib/source/test/lux/control/function/contract.lux +++ b/stdlib/source/test/lux/control/function/contract.lux @@ -7,8 +7,7 @@ [control ["." try]] [math - ["." random]] - [data + ["." random] [number ["n" nat]]]] {1 diff --git a/stdlib/source/test/lux/control/function/memo.lux b/stdlib/source/test/lux/control/function/memo.lux index 8fad40d86..fdf9119f6 100644 --- a/stdlib/source/test/lux/control/function/memo.lux +++ b/stdlib/source/test/lux/control/function/memo.lux @@ -6,18 +6,16 @@ [control ["." io (#+ IO)] ["." state (#+ State) ("#\." monad)]] - [math - ["." random]] [data ["." product] - [text - ["%" format (#+ format)]] - [number - ["n" nat] - ["." i64]] [collection ["." dictionary (#+ Dictionary)] ["." list ("#\." functor fold)]]] + [math + ["." random] + [number + ["n" nat] + ["." i64]]] [time ["." instant] ["." duration (#+ Duration)]]] diff --git a/stdlib/source/test/lux/control/function/mixin.lux b/stdlib/source/test/lux/control/function/mixin.lux index 0c343a685..8ca196ba5 100644 --- a/stdlib/source/test/lux/control/function/mixin.lux +++ b/stdlib/source/test/lux/control/function/mixin.lux @@ -12,12 +12,12 @@ ["." state (#+ State)]] [data ["." product] - [number - ["n" nat]] [collection ["." list ("#\." functor fold)]]] [math - ["." random (#+ Random)]]] + ["." random (#+ Random)] + [number + ["n" nat]]]] {1 ["." /]}) diff --git a/stdlib/source/test/lux/control/io.lux b/stdlib/source/test/lux/control/io.lux index 937d73870..30e4656c8 100644 --- a/stdlib/source/test/lux/control/io.lux +++ b/stdlib/source/test/lux/control/io.lux @@ -1,8 +1,6 @@ (.module: [lux #* ["_" test (#+ Test)] - [math - ["." random]] [abstract [monad (#+ do)] {[0 #spec] @@ -10,7 +8,8 @@ ["$." functor (#+ Injection Comparison)] ["$." apply] ["$." monad]]}] - [data + [math + ["." random] [number ["n" nat]]]] {1 diff --git a/stdlib/source/test/lux/control/parser.lux b/stdlib/source/test/lux/control/parser.lux index 6c2f739bb..bf69c8330 100644 --- a/stdlib/source/test/lux/control/parser.lux +++ b/stdlib/source/test/lux/control/parser.lux @@ -14,17 +14,17 @@ [parser ["s" code]]] [data - [number - ["n" nat]] ["." text ("#\." equivalence) ["%" format (#+ format)]] [collection ["." list ("#\." functor)]]] [math - ["." random]] + ["." random] + [number + ["n" nat]]] [macro - ["." code] - [syntax (#+ syntax:)]]] + [syntax (#+ syntax:)] + ["." code]]] {1 ["." / (#+ Parser)]} ["." / #_ diff --git a/stdlib/source/test/lux/control/parser/analysis.lux b/stdlib/source/test/lux/control/parser/analysis.lux index daf3632d6..8ffc75025 100644 --- a/stdlib/source/test/lux/control/parser/analysis.lux +++ b/stdlib/source/test/lux/control/parser/analysis.lux @@ -12,15 +12,15 @@ ["." name ("#\." equivalence)] ["." bit ("#\." equivalence)] ["." text ("#\." equivalence)] + [collection + ["." list]]] + [math + ["." random (#+ Random)] [number ["n" nat] ["i" int] ["f" frac] - ["r" rev]] - [collection - ["." list]]] - [math - ["." random (#+ Random)]] + ["r" rev]]] [tool [compiler [reference (#+ Constant)] diff --git a/stdlib/source/test/lux/control/parser/binary.lux b/stdlib/source/test/lux/control/parser/binary.lux index 2a29ba367..bc54ceada 100644 --- a/stdlib/source/test/lux/control/parser/binary.lux +++ b/stdlib/source/test/lux/control/parser/binary.lux @@ -1,6 +1,7 @@ (.module: [lux (#- primitive) ["_" test (#+ Test)] + ["." type] [abstract [equivalence (#+ Equivalence)] [predicate (#+ Predicate)] @@ -21,21 +22,20 @@ ["%" format (#+ format)]] ["." format #_ ["#" binary]] - [number - ["." i64] - ["n" nat] - ["." int] - ["." rev] - ["." frac]] [collection ["." list] ["." row] ["." set]]] [macro ["." code]] - ["." type] [math - ["." random (#+ Random)]]] + ["." random (#+ Random)] + [number + ["n" nat] + ["." i64] + ["." int] + ["." rev] + ["." frac]]]] {1 ["." /]}) diff --git a/stdlib/source/test/lux/control/parser/cli.lux b/stdlib/source/test/lux/control/parser/cli.lux index 60bd3f9fe..41ffb4e23 100644 --- a/stdlib/source/test/lux/control/parser/cli.lux +++ b/stdlib/source/test/lux/control/parser/cli.lux @@ -7,13 +7,13 @@ ["." try] ["<>" parser]] [data - [number - ["n" nat ("#\." decimal)]] ["." text ("#\." equivalence)] [collection ["." list]]] [math - ["." random]]] + ["." random] + [number + ["n" nat ("#\." decimal)]]]] {1 ["." /]}) diff --git a/stdlib/source/test/lux/control/parser/code.lux b/stdlib/source/test/lux/control/parser/code.lux index 71aa8f39d..0a8311fb3 100644 --- a/stdlib/source/test/lux/control/parser/code.lux +++ b/stdlib/source/test/lux/control/parser/code.lux @@ -11,17 +11,17 @@ ["." bit] ["." name] ["." text] - [number - ["." nat] - ["." int] - ["." rev] - ["." frac]] [collection ["." list]]] [macro ["." code]] [math - ["." random (#+ Random)]]] + ["." random (#+ Random)] + [number + ["." nat] + ["." int] + ["." rev] + ["." frac]]]] {1 ["." /]}) diff --git a/stdlib/source/test/lux/control/parser/environment.lux b/stdlib/source/test/lux/control/parser/environment.lux index 117693fe9..6a210f2a0 100644 --- a/stdlib/source/test/lux/control/parser/environment.lux +++ b/stdlib/source/test/lux/control/parser/environment.lux @@ -8,12 +8,12 @@ ["." exception]] [data ["." text ("#\." equivalence)] - [number - ["n" nat]] [collection ["." dictionary]]] [math - ["." random]]] + ["." random] + [number + ["n" nat]]]] {1 ["." / ["/#" // ("#\." monad)]]}) diff --git a/stdlib/source/test/lux/control/parser/json.lux b/stdlib/source/test/lux/control/parser/json.lux index b9d111eff..4d8dc0b8e 100644 --- a/stdlib/source/test/lux/control/parser/json.lux +++ b/stdlib/source/test/lux/control/parser/json.lux @@ -12,9 +12,6 @@ ["." maybe] ["." bit] ["." text] - [number - ["n" nat] - ["." frac]] [collection ["." list ("#\." functor)] ["." set] @@ -23,7 +20,10 @@ [format ["." json]]] [math - ["." random (#+ Random)]]] + ["." random (#+ Random)] + [number + ["n" nat] + ["." frac]]]] {1 ["." /]}) diff --git a/stdlib/source/test/lux/control/parser/synthesis.lux b/stdlib/source/test/lux/control/parser/synthesis.lux index b47f8338c..7916f7217 100644 --- a/stdlib/source/test/lux/control/parser/synthesis.lux +++ b/stdlib/source/test/lux/control/parser/synthesis.lux @@ -3,23 +3,23 @@ ["_" test (#+ Test)] [abstract ["." monad (#+ do)]] - [math - ["." random (#+ Random)]] [control [pipe (#+ case>)] + ["<>" parser] ["." try] - ["." exception] - ["<>" parser]] + ["." exception]] [data ["." bit] ["." name] ["." text] - [number - ["." i64] - ["n" nat] - ["." frac]] [collection ["." list ("#\." functor)]]] + [math + ["." random (#+ Random)] + [number + ["n" nat] + ["." i64] + ["." frac]]] [tool [compiler [reference (#+) diff --git a/stdlib/source/test/lux/control/parser/text.lux b/stdlib/source/test/lux/control/parser/text.lux index 8465393de..dd8ce8ceb 100644 --- a/stdlib/source/test/lux/control/parser/text.lux +++ b/stdlib/source/test/lux/control/parser/text.lux @@ -14,15 +14,15 @@ ["." unicode #_ ["#" set] ["#/." block]]] - [number (#+ hex) - ["n" nat]] [collection ["." set] ["." list ("#\." functor)] [tree ["." finger]]]] [math - ["." random]] + ["." random] + [number (#+ hex) + ["n" nat]]] [macro ["." code]]] {1 diff --git a/stdlib/source/test/lux/control/parser/tree.lux b/stdlib/source/test/lux/control/parser/tree.lux index f4f3da769..5dbe726ea 100644 --- a/stdlib/source/test/lux/control/parser/tree.lux +++ b/stdlib/source/test/lux/control/parser/tree.lux @@ -7,13 +7,13 @@ ["." try] ["." exception]] [data - [number - ["n" nat]] [collection ["." tree ["." zipper]]]] [math - ["." random]]] + ["." random] + [number + ["n" nat]]]] {1 ["." / ["/#" //]]}) diff --git a/stdlib/source/test/lux/control/parser/type.lux b/stdlib/source/test/lux/control/parser/type.lux index 47cdac08f..5390498c7 100644 --- a/stdlib/source/test/lux/control/parser/type.lux +++ b/stdlib/source/test/lux/control/parser/type.lux @@ -8,12 +8,12 @@ ["." exception]] [data ["." name ("#\." equivalence)] - [number - ["n" nat]] [collection ["." list]]] [math - ["." random (#+ Random)]] + ["." random (#+ Random)] + [number + ["n" nat]]] ["." type ("#\." equivalence)]] {1 ["." / diff --git a/stdlib/source/test/lux/control/parser/xml.lux b/stdlib/source/test/lux/control/parser/xml.lux index 6d6126e8f..a9f71af71 100644 --- a/stdlib/source/test/lux/control/parser/xml.lux +++ b/stdlib/source/test/lux/control/parser/xml.lux @@ -1,6 +1,7 @@ (.module: [lux #* ["_" test (#+ Test)] + ["." type ("#\." equivalence)] [abstract [monad (#+ do)]] [control @@ -11,16 +12,15 @@ ["." name ("#\." equivalence)] [format ["." xml]] - [number - ["n" nat]] [collection ["." dictionary] ["." list]]] - [math - ["." random (#+ Random)]] [macro ["." template]] - ["." type ("#\." equivalence)]] + [math + ["." random (#+ Random)] + [number + ["n" nat]]]] {1 ["." / ["/#" // ("#\." monad)]]}) diff --git a/stdlib/source/test/lux/control/pipe.lux b/stdlib/source/test/lux/control/pipe.lux index 6a9809c8b..cd57863b7 100644 --- a/stdlib/source/test/lux/control/pipe.lux +++ b/stdlib/source/test/lux/control/pipe.lux @@ -5,12 +5,12 @@ [monad (#+ do)]] [data ["." identity] - [number - ["n" nat]] ["." text ("#\." equivalence) ["%" format (#+ format)]]] [math - ["." random]]] + ["." random] + [number + ["n" nat]]]] {1 ["." /]}) diff --git a/stdlib/source/test/lux/control/reader.lux b/stdlib/source/test/lux/control/reader.lux index cd8204b0c..11c8b8855 100644 --- a/stdlib/source/test/lux/control/reader.lux +++ b/stdlib/source/test/lux/control/reader.lux @@ -8,11 +8,10 @@ ["$." functor (#+ Injection Comparison)] ["$." apply] ["$." monad]]}] - [data - [number - ["n" nat]]] [math - ["." random]]] + ["." random] + [number + ["n" nat]]]] {1 ["." / (#+ Reader) [// diff --git a/stdlib/source/test/lux/control/region.lux b/stdlib/source/test/lux/control/region.lux index b9389dbdf..1023822ea 100644 --- a/stdlib/source/test/lux/control/region.lux +++ b/stdlib/source/test/lux/control/region.lux @@ -1,5 +1,6 @@ (.module: [lux #* + [type (#+ :share)] ["_" test (#+ Test)] [abstract [equivalence (#+ Equivalence)] @@ -15,13 +16,12 @@ [control ["." try (#+ Try)]] [data - [number - ["n" nat]] [collection ["." list]]] [math - ["." random]] - [type (#+ :share)]] + ["." random] + [number + ["n" nat]]]] {1 ["." / (#+ Region) [// diff --git a/stdlib/source/test/lux/control/remember.lux b/stdlib/source/test/lux/control/remember.lux index 6f1e53122..fb7517237 100644 --- a/stdlib/source/test/lux/control/remember.lux +++ b/stdlib/source/test/lux/control/remember.lux @@ -10,11 +10,11 @@ [parser ["<c>" code]]] [data - [number (#+ hex)] ["." product] ["." text ["%" format (#+ format)]]] [math + [number (#+ hex)] ["." random (#+ Random) ("#\." monad)]] [time ["." date (#+ Date)] diff --git a/stdlib/source/test/lux/control/security/capability.lux b/stdlib/source/test/lux/control/security/capability.lux index 50a2d04d8..7804cda68 100644 --- a/stdlib/source/test/lux/control/security/capability.lux +++ b/stdlib/source/test/lux/control/security/capability.lux @@ -7,11 +7,10 @@ ["." io (#+ IO)] [concurrency ["." promise]]] - [data - [number - ["n" nat]]] [math - ["." random]]] + ["." random] + [number + ["n" nat]]]] {1 ["." /]}) diff --git a/stdlib/source/test/lux/control/security/policy.lux b/stdlib/source/test/lux/control/security/policy.lux index 55e928d52..9c72304d9 100644 --- a/stdlib/source/test/lux/control/security/policy.lux +++ b/stdlib/source/test/lux/control/security/policy.lux @@ -13,11 +13,11 @@ [security ["!" capability]]] [data - ["." text ("#\." equivalence)] - [number - ["n" nat]]] + ["." text ("#\." equivalence)]] [math - ["." random]]] + ["." random] + [number + ["n" nat]]]] {1 ["." / (#+ Context Privacy Can_Conceal Can_Reveal Privilege Private)]}) diff --git a/stdlib/source/test/lux/control/state.lux b/stdlib/source/test/lux/control/state.lux index 4d6772069..a79bfc84c 100644 --- a/stdlib/source/test/lux/control/state.lux +++ b/stdlib/source/test/lux/control/state.lux @@ -12,13 +12,11 @@ [pipe (#+ let>)] ["." io]] [data - ["." product] - [number - ["n" nat]] - [text - ["%" format (#+ format)]]] + ["." product]] [math - ["." random]]] + ["." random] + [number + ["n" nat]]]] {1 ["." / (#+ State)]}) diff --git a/stdlib/source/test/lux/control/thread.lux b/stdlib/source/test/lux/control/thread.lux index cedd55530..5fac55739 100644 --- a/stdlib/source/test/lux/control/thread.lux +++ b/stdlib/source/test/lux/control/thread.lux @@ -8,11 +8,10 @@ ["$." functor (#+ Injection Comparison)] ["$." apply] ["$." monad]]}] - [data - [number - ["n" nat]]] [math - ["." random]]] + ["." random] + [number + ["n" nat]]]] {1 ["." / (#+ Thread) [// diff --git a/stdlib/source/test/lux/control/try.lux b/stdlib/source/test/lux/control/try.lux index 9993a3f70..b89246b26 100644 --- a/stdlib/source/test/lux/control/try.lux +++ b/stdlib/source/test/lux/control/try.lux @@ -2,7 +2,7 @@ [lux #* ["_" test (#+ Test)] [abstract - [monad (#+ do Monad)] + [monad (#+ do)] {[0 #spec] [/ ["$." functor (#+ Injection Comparison)] @@ -13,11 +13,11 @@ pipe ["." io]] [data - ["." text ("#\." equivalence)] - [number - ["n" nat]]] + ["." text ("#\." equivalence)]] [math - ["." random (#+ Random)]]] + ["." random (#+ Random)] + [number + ["n" nat]]]] {1 ["." / (#+ Try)]}) diff --git a/stdlib/source/test/lux/control/writer.lux b/stdlib/source/test/lux/control/writer.lux index d9544def1..843bab32b 100644 --- a/stdlib/source/test/lux/control/writer.lux +++ b/stdlib/source/test/lux/control/writer.lux @@ -14,12 +14,11 @@ ["." io]] [data ["." product] - [number - ["n" nat]] - ["." text ("#\." equivalence) - ["%" format (#+ format)]]] + ["." text ("#\." equivalence)]] [math - ["." random]]] + ["." random] + [number + ["n" nat]]]] {1 ["." / (#+ Writer)]}) diff --git a/stdlib/source/test/lux/data.lux b/stdlib/source/test/lux/data.lux index 78cae485a..376a7cd3e 100644 --- a/stdlib/source/test/lux/data.lux +++ b/stdlib/source/test/lux/data.lux @@ -12,7 +12,6 @@ ["#." lazy] ["#." maybe] ["#." name] - ["#." number] ["#." product] ["#." sum] ["#." color @@ -53,7 +52,6 @@ /lazy.test /maybe.test /name.test - /number.test /product.test) test2 ($_ _.and /sum.test diff --git a/stdlib/source/test/lux/data/binary.lux b/stdlib/source/test/lux/data/binary.lux index 3d828dbb2..07c02ea09 100644 --- a/stdlib/source/test/lux/data/binary.lux +++ b/stdlib/source/test/lux/data/binary.lux @@ -1,8 +1,6 @@ (.module: [lux #* ["_" test (#+ Test)] - [math - ["." random (#+ Random)]] [abstract ["." monad (#+ do)] ["." enum] @@ -14,11 +12,13 @@ ["." try (#+ Try)] ["." exception (#+ Exception)]] [data + [collection + ["." list]]] + [math + ["." random (#+ Random)] [number ["." i64] - ["n" nat]] - [collection - ["." list]]]] + ["n" nat]]]] {1 ["." / (#+ Binary)]}) diff --git a/stdlib/source/test/lux/data/collection/array.lux b/stdlib/source/test/lux/data/collection/array.lux index ab1b1f04c..5cfbe4a7d 100644 --- a/stdlib/source/test/lux/data/collection/array.lux +++ b/stdlib/source/test/lux/data/collection/array.lux @@ -12,15 +12,14 @@ [data ["." bit] ["." maybe] - ["." text ("#\." equivalence) - ["%" format (#+ format)]] - [number - ["n" nat]] + ["." text ("#\." equivalence)] [collection ["." list] ["." set]]] [math - ["." random (#+ Random)]]] + ["." random (#+ Random)] + [number + ["n" nat]]]] {1 ["." / (#+ Array)]}) diff --git a/stdlib/source/test/lux/data/collection/bits.lux b/stdlib/source/test/lux/data/collection/bits.lux index 6e07dc2e6..f4b780864 100644 --- a/stdlib/source/test/lux/data/collection/bits.lux +++ b/stdlib/source/test/lux/data/collection/bits.lux @@ -7,11 +7,10 @@ {[0 #spec] [/ ["$." equivalence]]}] - [data - [number - ["n" nat]]] [math - ["." random (#+ Random)]]] + ["." random (#+ Random)] + [number + ["n" nat]]]] {1 ["." / (#+ Bits)]}) diff --git a/stdlib/source/test/lux/data/collection/dictionary.lux b/stdlib/source/test/lux/data/collection/dictionary.lux index 0de661e64..92705210b 100644 --- a/stdlib/source/test/lux/data/collection/dictionary.lux +++ b/stdlib/source/test/lux/data/collection/dictionary.lux @@ -14,12 +14,12 @@ [data ["." product] ["." maybe] - [number - ["n" nat]] [collection ["." list ("#\." functor)]]] [math - ["." random]]] + ["." random] + [number + ["n" nat]]]] {1 ["." /]}) diff --git a/stdlib/source/test/lux/data/collection/dictionary/ordered.lux b/stdlib/source/test/lux/data/collection/dictionary/ordered.lux index a44b5c295..778726329 100644 --- a/stdlib/source/test/lux/data/collection/dictionary/ordered.lux +++ b/stdlib/source/test/lux/data/collection/dictionary/ordered.lux @@ -12,13 +12,13 @@ ["." product] ["." bit ("#\." equivalence)] ["." maybe ("#\." monad)] - [number - ["n" nat]] [collection ["." set] ["." list ("#\." functor)]]] [math - ["." random (#+ Random) ("#\." monad)]]] + ["." random (#+ Random) ("#\." monad)] + [number + ["n" nat]]]] {1 ["." /]}) diff --git a/stdlib/source/test/lux/data/collection/dictionary/plist.lux b/stdlib/source/test/lux/data/collection/dictionary/plist.lux index 753b8db8a..7473aec04 100644 --- a/stdlib/source/test/lux/data/collection/dictionary/plist.lux +++ b/stdlib/source/test/lux/data/collection/dictionary/plist.lux @@ -10,13 +10,13 @@ ["." bit ("#\." equivalence)] ["." maybe ("#\." monad)] ["." text] - [number - ["n" nat]] [collection ["." set] ["." list]]] [math - ["." random (#+ Random)]]] + ["." random (#+ Random)] + [number + ["n" nat]]]] {1 ["." /]}) diff --git a/stdlib/source/test/lux/data/collection/list.lux b/stdlib/source/test/lux/data/collection/list.lux index b2d35b1f4..6306f62fc 100644 --- a/stdlib/source/test/lux/data/collection/list.lux +++ b/stdlib/source/test/lux/data/collection/list.lux @@ -21,13 +21,13 @@ ["." product] ["." maybe] ["." text ("#\." equivalence)] - [number - ["n" nat] - ["." int]] [collection ["." set]]] [math - ["." random (#+ Random)]]] + ["." random (#+ Random)] + [number + ["n" nat] + ["." int]]]] {1 ["." / ("#\." monad)]}) diff --git a/stdlib/source/test/lux/data/collection/queue.lux b/stdlib/source/test/lux/data/collection/queue.lux index 3e532a66e..b246f8187 100644 --- a/stdlib/source/test/lux/data/collection/queue.lux +++ b/stdlib/source/test/lux/data/collection/queue.lux @@ -9,14 +9,13 @@ ["$." functor (#+ Injection)]]}] [data ["." bit ("#\." equivalence)] - ["%" text/format (#+ format)] - [number - ["n" nat]] [collection ["." set] ["." list ("#\." monoid)]]] [math - ["." random]]] + ["." random] + [number + ["n" nat]]]] {1 ["." /]}) diff --git a/stdlib/source/test/lux/data/collection/queue/priority.lux b/stdlib/source/test/lux/data/collection/queue/priority.lux index 19f219378..4e99d2a3a 100644 --- a/stdlib/source/test/lux/data/collection/queue/priority.lux +++ b/stdlib/source/test/lux/data/collection/queue/priority.lux @@ -5,11 +5,11 @@ ["." monad (#+ do)]] [data ["." maybe ("#\." functor)] - ["." bit ("#\." equivalence)] - [number - ["n" nat]]] + ["." bit ("#\." equivalence)]] [math - ["." random (#+ Random)]]] + ["." random (#+ Random)] + [number + ["n" nat]]]] {1 ["." / (#+ Queue)]}) diff --git a/stdlib/source/test/lux/data/collection/row.lux b/stdlib/source/test/lux/data/collection/row.lux index 13ed9af28..55d9492ff 100644 --- a/stdlib/source/test/lux/data/collection/row.lux +++ b/stdlib/source/test/lux/data/collection/row.lux @@ -16,13 +16,13 @@ ["." exception]] [data ["." bit ("#\." equivalence)] - [number - ["n" nat]] [collection ["." list ("#\." fold)] ["." set]]] [math - ["." random]]] + ["." random] + [number + ["n" nat]]]] {1 ["." / ("#\." monad)]}) diff --git a/stdlib/source/test/lux/data/collection/sequence.lux b/stdlib/source/test/lux/data/collection/sequence.lux index b97e1f7d2..013936731 100644 --- a/stdlib/source/test/lux/data/collection/sequence.lux +++ b/stdlib/source/test/lux/data/collection/sequence.lux @@ -10,14 +10,14 @@ ["$." functor] ["$." comonad]]}] [data - [number - ["n" nat]] ["." text ["%" format (#+ format)]] [collection ["." list ("#\." functor)]]] [math - ["." random]]] + ["." random] + [number + ["n" nat]]]] {1 ["." /]}) diff --git a/stdlib/source/test/lux/data/collection/set.lux b/stdlib/source/test/lux/data/collection/set.lux index a58627cde..6f981af91 100644 --- a/stdlib/source/test/lux/data/collection/set.lux +++ b/stdlib/source/test/lux/data/collection/set.lux @@ -10,12 +10,12 @@ ["$." monoid]]}] [data ["." bit ("#\." equivalence)] - [number - ["n" nat]] [collection ["." list]]] [math - ["." random (#+ Random)]]] + ["." random (#+ Random)] + [number + ["n" nat]]]] {1 ["." / ("\." equivalence)]}) diff --git a/stdlib/source/test/lux/data/collection/set/multi.lux b/stdlib/source/test/lux/data/collection/set/multi.lux index 8d6d5aa22..9d9572795 100644 --- a/stdlib/source/test/lux/data/collection/set/multi.lux +++ b/stdlib/source/test/lux/data/collection/set/multi.lux @@ -10,13 +10,13 @@ ["$." equivalence]]}] [data ["." bit ("#\." equivalence)] - [number - ["n" nat]] [collection ["." set] ["." list ("#\." fold)]]] [math - ["." random (#+ Random)]]] + ["." random (#+ Random)] + [number + ["n" nat]]]] {1 ["." /]}) diff --git a/stdlib/source/test/lux/data/collection/set/ordered.lux b/stdlib/source/test/lux/data/collection/set/ordered.lux index 6c0e75b3d..daf924012 100644 --- a/stdlib/source/test/lux/data/collection/set/ordered.lux +++ b/stdlib/source/test/lux/data/collection/set/ordered.lux @@ -9,12 +9,12 @@ ["$." equivalence]]}] [data ["." bit ("#\." equivalence)] - [number - ["n" nat]] [collection ["." list]]] [math - ["." random (#+ Random) ("#\." monad)]]] + ["." random (#+ Random) ("#\." monad)] + [number + ["n" nat]]]] {1 ["." / (#+ Set) ["." //]]}) diff --git a/stdlib/source/test/lux/data/collection/stack.lux b/stdlib/source/test/lux/data/collection/stack.lux index 8a12c4fab..ae6fbabf6 100644 --- a/stdlib/source/test/lux/data/collection/stack.lux +++ b/stdlib/source/test/lux/data/collection/stack.lux @@ -9,11 +9,11 @@ ["$." functor (#+ Injection)]]}] [data ["." maybe] - ["." bit ("#\." equivalence)] - [number - ["n" nat]]] + ["." bit ("#\." equivalence)]] [math - ["." random]]] + ["." random] + [number + ["n" nat]]]] {1 ["." /]}) diff --git a/stdlib/source/test/lux/data/collection/tree.lux b/stdlib/source/test/lux/data/collection/tree.lux index 0b7dbbdf8..b7fea5e4f 100644 --- a/stdlib/source/test/lux/data/collection/tree.lux +++ b/stdlib/source/test/lux/data/collection/tree.lux @@ -10,12 +10,12 @@ ["$." functor]]}] [data ["." product] - [number - ["n" nat]] [collection ["." list ("#\." functor fold)]]] [math - ["." random (#+ Random)]]] + ["." random (#+ Random)] + [number + ["n" nat]]]] {1 ["." / (#+ Tree)]}) diff --git a/stdlib/source/test/lux/data/collection/tree/finger.lux b/stdlib/source/test/lux/data/collection/tree/finger.lux index f169d8a5d..33b333396 100644 --- a/stdlib/source/test/lux/data/collection/tree/finger.lux +++ b/stdlib/source/test/lux/data/collection/tree/finger.lux @@ -6,12 +6,12 @@ [data ["." maybe ("#\." functor)] ["." text ("#\." equivalence monoid)] - [number - ["n" nat]] [collection ["." list ("#\." fold)]]] [math - ["." random]] + ["." random] + [number + ["n" nat]]] [type (#+ :by_example)]] {1 ["." /]}) diff --git a/stdlib/source/test/lux/data/collection/tree/zipper.lux b/stdlib/source/test/lux/data/collection/tree/zipper.lux index 419935101..929572a37 100644 --- a/stdlib/source/test/lux/data/collection/tree/zipper.lux +++ b/stdlib/source/test/lux/data/collection/tree/zipper.lux @@ -14,12 +14,12 @@ ["." product] ["." maybe ("#\." functor)] ["." text] - [number - ["n" nat]] [collection ["." list]]] [math - ["." random]]] + ["." random] + [number + ["n" nat]]]] ["." //] {1 ["." / (#+ Zipper) diff --git a/stdlib/source/test/lux/data/color.lux b/stdlib/source/test/lux/data/color.lux index c0ea5e699..a8119145b 100644 --- a/stdlib/source/test/lux/data/color.lux +++ b/stdlib/source/test/lux/data/color.lux @@ -9,17 +9,17 @@ ["$." hash] ["$." monoid]]}] [data - [number - ["n" nat] - ["." int] - ["f" frac] - ["r" rev]] [collection ["." list]]] [macro ["." template]] ["." math - ["." random (#+ Random)]]] + ["." random (#+ Random)] + [number + ["n" nat] + ["." int] + ["f" frac] + ["r" rev]]]] {1 ["." / (#+ Color)]}) diff --git a/stdlib/source/test/lux/data/color/named.lux b/stdlib/source/test/lux/data/color/named.lux index 062ba560b..9a3fddcaf 100644 --- a/stdlib/source/test/lux/data/color/named.lux +++ b/stdlib/source/test/lux/data/color/named.lux @@ -4,15 +4,15 @@ [abstract [monad (#+ do)]] [data - [number - ["n" nat]] [collection ["." list] ["." set]]] [macro ["." template]] [math - ["." random (#+ Random)]]] + ["." random (#+ Random)] + [number + ["n" nat]]]] {1 ["." / ["/#" //]]}) diff --git a/stdlib/source/test/lux/data/format/json.lux b/stdlib/source/test/lux/data/format/json.lux index 2d38b8988..4f14375d9 100644 --- a/stdlib/source/test/lux/data/format/json.lux +++ b/stdlib/source/test/lux/data/format/json.lux @@ -15,16 +15,16 @@ ["." bit] ["." text ["%" format (#+ format)]] - [number - ["n" nat] - ["." frac]] [collection ["." row] ["." dictionary] ["." set] ["." list ("#\." functor)]]] [math - ["." random (#+ Random)]] + ["." random (#+ Random)] + [number + ["n" nat] + ["." frac]]] [macro ["." syntax (#+ syntax:)] ["." code]]] diff --git a/stdlib/source/test/lux/data/format/tar.lux b/stdlib/source/test/lux/data/format/tar.lux index 72024ba29..9d576b93a 100644 --- a/stdlib/source/test/lux/data/format/tar.lux +++ b/stdlib/source/test/lux/data/format/tar.lux @@ -18,9 +18,6 @@ ["." unicode #_ ["#" set] ["#/." block]]] - [number - ["n" nat] - ["i" int]] [collection ["." row] ["." list ("#\." fold)]] @@ -30,7 +27,10 @@ ["." instant (#+ Instant)] ["." duration]] [math - ["." random (#+ Random)]]] + ["." random (#+ Random)] + [number + ["n" nat] + ["i" int]]]] {1 ["." /]}) diff --git a/stdlib/source/test/lux/data/format/xml.lux b/stdlib/source/test/lux/data/format/xml.lux index 57958281c..bd3b45216 100644 --- a/stdlib/source/test/lux/data/format/xml.lux +++ b/stdlib/source/test/lux/data/format/xml.lux @@ -17,13 +17,13 @@ ["." maybe] ["." text ("#\." equivalence) ["%" format (#+ format)]] - [number - ["n" nat]] [collection ["." dictionary] ["." list ("#\." functor)]]] [math - ["." random (#+ Random) ("#\." monad)]]] + ["." random (#+ Random) ("#\." monad)] + [number + ["n" nat]]]] {1 ["." / (#+ XML)]}) diff --git a/stdlib/source/test/lux/data/lazy.lux b/stdlib/source/test/lux/data/lazy.lux index ddb24aee8..5900817e4 100644 --- a/stdlib/source/test/lux/data/lazy.lux +++ b/stdlib/source/test/lux/data/lazy.lux @@ -9,11 +9,10 @@ ["$." apply] ["$." monad] ["$." equivalence]]}] - [data - [number - ["n" nat]]] [math - ["." random (#+ Random)]]] + ["." random (#+ Random)] + [number + ["n" nat]]]] {1 ["." / (#+ Lazy)]}) diff --git a/stdlib/source/test/lux/data/maybe.lux b/stdlib/source/test/lux/data/maybe.lux index f5e965614..64f9b5ff5 100644 --- a/stdlib/source/test/lux/data/maybe.lux +++ b/stdlib/source/test/lux/data/maybe.lux @@ -15,63 +15,63 @@ pipe] [data ["." text] - [number - ["n" nat]] [collection ["." list]]] [math - ["." random (#+ Random)]]] + ["." random (#+ Random)] + [number + ["n" nat]]]] {1 ["." / ("#\." monoid monad)]}) (def: #export test Test (<| (_.covering /._) - (_.for [.Maybe] - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec (/.equivalence n.equivalence) (random.maybe random.nat))) - (_.for [/.monoid] - ($monoid.spec (/.equivalence n.equivalence) /.monoid (random.maybe random.nat))) - (_.for [/.functor] - ($functor.spec /\wrap /.equivalence /.functor)) - (_.for [/.apply] - ($apply.spec /\wrap /.equivalence /.apply)) - (_.for [/.monad] - ($monad.spec /\wrap /.equivalence /.monad)) - - (do random.monad - [left random.nat - right random.nat - #let [expected (n.+ left right)]] - (let [lift (/.lift io.monad)] - (_.cover [/.with /.lift] - (|> (io.run (do (/.with io.monad) - [a (lift (io\wrap left)) - b (wrap right)] - (wrap (n.+ a b)))) - (case> (#.Some actual) - (n.= expected actual) + (_.for [.Maybe]) + ($_ _.and + (_.for [/.equivalence] + ($equivalence.spec (/.equivalence n.equivalence) (random.maybe random.nat))) + (_.for [/.monoid] + ($monoid.spec (/.equivalence n.equivalence) /.monoid (random.maybe random.nat))) + (_.for [/.functor] + ($functor.spec /\wrap /.equivalence /.functor)) + (_.for [/.apply] + ($apply.spec /\wrap /.equivalence /.apply)) + (_.for [/.monad] + ($monad.spec /\wrap /.equivalence /.monad)) + + (do random.monad + [left random.nat + right random.nat + #let [expected (n.+ left right)]] + (let [lift (/.lift io.monad)] + (_.cover [/.with /.lift] + (|> (io.run (do (/.with io.monad) + [a (lift (io\wrap left)) + b (wrap right)] + (wrap (n.+ a b)))) + (case> (#.Some actual) + (n.= expected actual) - _ - false))))) - (do random.monad - [default random.nat - value random.nat] - (_.cover [/.default] - (and (is? default (/.default default - #.None)) + _ + false))))) + (do random.monad + [default random.nat + value random.nat] + (_.cover [/.default] + (and (is? default (/.default default + #.None)) - (is? value (/.default default - (#.Some value)))))) - (do random.monad - [value random.nat] - (_.cover [/.assume] - (is? value (/.assume (#.Some value))))) - (do random.monad - [value random.nat] - (_.cover [/.to-list] - (\ (list.equivalence n.equivalence) = - (list value) - (/.to-list (#.Some value))))) - )))) + (is? value (/.default default + (#.Some value)))))) + (do random.monad + [value random.nat] + (_.cover [/.assume] + (is? value (/.assume (#.Some value))))) + (do random.monad + [value random.nat] + (_.cover [/.to-list] + (\ (list.equivalence n.equivalence) = + (list value) + (/.to-list (#.Some value))))) + ))) diff --git a/stdlib/source/test/lux/data/name.lux b/stdlib/source/test/lux/data/name.lux index 08fd3065e..7912994c3 100644 --- a/stdlib/source/test/lux/data/name.lux +++ b/stdlib/source/test/lux/data/name.lux @@ -11,11 +11,11 @@ [control pipe] [data - [number - ["n" nat]] ["." text ("#\." equivalence)]] [math - ["." random (#+ Random)]]] + ["." random (#+ Random)] + [number + ["n" nat]]]] {1 ["." /]}) diff --git a/stdlib/source/test/lux/data/product.lux b/stdlib/source/test/lux/data/product.lux index 3c61091bb..c33e60dd1 100644 --- a/stdlib/source/test/lux/data/product.lux +++ b/stdlib/source/test/lux/data/product.lux @@ -6,12 +6,11 @@ {[0 #spec] [/ ["$." equivalence]]}] - [data + [math + ["." random] [number ["n" nat] - ["i" int]]] - [math - ["." random]]] + ["i" int]]]] {1 ["." /]}) diff --git a/stdlib/source/test/lux/data/sum.lux b/stdlib/source/test/lux/data/sum.lux index 7fbf816a1..da108ede8 100644 --- a/stdlib/source/test/lux/data/sum.lux +++ b/stdlib/source/test/lux/data/sum.lux @@ -10,13 +10,13 @@ pipe] [data ["." text] - [number - ["n" nat] - ["i" int]] [collection ["." list ("#\." functor)]]] [math - ["." random]]] + ["." random] + [number + ["n" nat] + ["i" int]]]] {1 ["." /]}) diff --git a/stdlib/source/test/lux/data/text.lux b/stdlib/source/test/lux/data/text.lux index 4100d5f0d..4308f8e95 100644 --- a/stdlib/source/test/lux/data/text.lux +++ b/stdlib/source/test/lux/data/text.lux @@ -12,13 +12,13 @@ pipe] [data ["." maybe] - [number - ["n" nat]] [collection ["." list] ["." set]]] [math - ["." random]]] + ["." random] + [number + ["n" nat]]]] ["." / #_ ["#." buffer] ["#." encoding] diff --git a/stdlib/source/test/lux/data/text/buffer.lux b/stdlib/source/test/lux/data/text/buffer.lux index a12d57fc5..852a3c951 100644 --- a/stdlib/source/test/lux/data/text/buffer.lux +++ b/stdlib/source/test/lux/data/text/buffer.lux @@ -5,11 +5,11 @@ [monad (#+ do)]] [data ["." text ("#\." equivalence) - ["%" format (#+ format)]] - [number - ["n" nat]]] + ["%" format (#+ format)]]] [math - ["." random (#+ Random)]]] + ["." random (#+ Random)] + [number + ["n" nat]]]] {1 ["." /]}) diff --git a/stdlib/source/test/lux/data/text/encoding.lux b/stdlib/source/test/lux/data/text/encoding.lux index 2e61159dc..c5b985f50 100644 --- a/stdlib/source/test/lux/data/text/encoding.lux +++ b/stdlib/source/test/lux/data/text/encoding.lux @@ -11,15 +11,15 @@ [data ["." maybe] ["." text ("#\." equivalence)] - [number - ["n" nat]] [collection ["." list ("#\." functor)] ["." set]]] [macro ["." template]] [math - ["." random (#+ Random)]]] + ["." random (#+ Random)] + [number + ["n" nat]]]] {1 ["." /]}) diff --git a/stdlib/source/test/lux/data/text/format.lux b/stdlib/source/test/lux/data/text/format.lux index 00df7058a..2aa33d2d4 100644 --- a/stdlib/source/test/lux/data/text/format.lux +++ b/stdlib/source/test/lux/data/text/format.lux @@ -14,12 +14,6 @@ ["." text ("#\." equivalence)] ["." bit] ["." name] - [number - ["." nat] - ["." int] - ["." rev] - ["." frac] - ["." ratio]] [format ["." xml] ["." json]] @@ -32,7 +26,13 @@ [math ["." random (#+ Random) ("#\." monad)] ["." modulus] - ["." modular]] + ["." modular] + [number + ["." nat] + ["." int] + ["." rev] + ["." frac] + ["." ratio]]] [macro ["." code]] [meta diff --git a/stdlib/source/test/lux/data/text/regex.lux b/stdlib/source/test/lux/data/text/regex.lux index 3998f78f7..2cdead181 100644 --- a/stdlib/source/test/lux/data/text/regex.lux +++ b/stdlib/source/test/lux/data/text/regex.lux @@ -10,10 +10,10 @@ ["<.>" text (#+ Parser)] ["s" code]]] [data - [number (#+ hex)] ["." text ("#\." equivalence) ["%" format (#+ format)]]] [math + [number (#+ hex)] ["." random]] ["." meta] [macro @@ -53,13 +53,13 @@ (syntax: (should_check pattern regex input) (meta.with_gensyms [g!message g!_] - (wrap (list (` (|> (~ input) - (<text>.run (~ regex)) - (case> (^ (#try.Success (~ pattern))) - true + (wrap (list (` (|> (~ input) + (<text>.run (~ regex)) + (case> (^ (#try.Success (~ pattern))) + true - (~ g!_) - false))))))) + (~ g!_) + false))))))) (def: basics Test diff --git a/stdlib/source/test/lux/data/text/unicode/block.lux b/stdlib/source/test/lux/data/text/unicode/block.lux index a575b4fc6..316bbe516 100644 --- a/stdlib/source/test/lux/data/text/unicode/block.lux +++ b/stdlib/source/test/lux/data/text/unicode/block.lux @@ -10,15 +10,15 @@ ["$." monoid]]}] [data ["." text] - [number (#+ hex) - ["n" nat]] [collection ["." set] ["." list]]] [macro ["." template]] [math - ["." random (#+ Random)]]] + ["." random (#+ Random)] + [number (#+ hex) + ["n" nat]]]] {1 ["." /]}) diff --git a/stdlib/source/test/lux/data/text/unicode/set.lux b/stdlib/source/test/lux/data/text/unicode/set.lux index e32c08bfd..a219bff51 100644 --- a/stdlib/source/test/lux/data/text/unicode/set.lux +++ b/stdlib/source/test/lux/data/text/unicode/set.lux @@ -9,12 +9,12 @@ [data ["." product] ["." bit ("#\." equivalence)] - [number - ["n" nat]] [collection ["." set ("#\." equivalence)]]] [math - ["." random (#+ Random)]]] + ["." random (#+ Random)] + [number + ["n" nat]]]] ["." / #_ ["/#" // #_ ["#." block]]] diff --git a/stdlib/source/test/lux/host.js.lux b/stdlib/source/test/lux/host.js.lux index f27b9554c..6147ef9b9 100644 --- a/stdlib/source/test/lux/host.js.lux +++ b/stdlib/source/test/lux/host.js.lux @@ -1,14 +1,14 @@ (.module: [lux #* ["_" test (#+ Test)] - [math - ["." random (#+ Random)]] [abstract [monad (#+ do)]] [control ["." try]] [data - ["." text ("#\." equivalence)] + ["." text ("#\." equivalence)]] + [math + ["." random (#+ Random)] [number ["." nat] ["." frac]]]] diff --git a/stdlib/source/test/lux/host.jvm.lux b/stdlib/source/test/lux/host.jvm.lux index 3a55a232d..2532b3075 100644 --- a/stdlib/source/test/lux/host.jvm.lux +++ b/stdlib/source/test/lux/host.jvm.lux @@ -4,12 +4,12 @@ [control pipe] [data - ["." text ("#\." equivalence)] + ["." text ("#\." equivalence)]] + [math + ["r" random] [number ["n" nat] ["i" int]]] - [math - ["r" random]] ["_" test (#+ Test)]] {1 ["." / (#+ import: class: interface: object)]}) diff --git a/stdlib/source/test/lux/host.old.lux b/stdlib/source/test/lux/host.old.lux index c18ef1f1e..b14dac30d 100644 --- a/stdlib/source/test/lux/host.old.lux +++ b/stdlib/source/test/lux/host.old.lux @@ -4,12 +4,12 @@ [control pipe] [data - ["." text ("#\." equivalence)] + ["." text ("#\." equivalence)]] + [math + ["r" random] [number ["n" nat] ["i" int]]] - [math - ["r" random]] ["_" test (#+ Test)]] {1 ["." / (#+ import: class: interface: object)]}) diff --git a/stdlib/source/test/lux/locale/language.lux b/stdlib/source/test/lux/locale/language.lux index 6423b7627..b3bfffc4e 100644 --- a/stdlib/source/test/lux/locale/language.lux +++ b/stdlib/source/test/lux/locale/language.lux @@ -10,15 +10,15 @@ [data ["." maybe] ["." text] - [number - ["n" nat]] [collection ["." set (#+ Set)] ["." list ("#\." functor fold)]]] [macro ["." template]] [math - ["." random (#+ Random)]]] + ["." random (#+ Random)] + [number + ["n" nat]]]] {1 ["." /]}) diff --git a/stdlib/source/test/lux/locale/territory.lux b/stdlib/source/test/lux/locale/territory.lux index 86a44cf3a..909b5b68f 100644 --- a/stdlib/source/test/lux/locale/territory.lux +++ b/stdlib/source/test/lux/locale/territory.lux @@ -10,15 +10,15 @@ [data ["." maybe] ["." text] - [number - ["n" nat]] [collection ["." set (#+ Set)] ["." list ("#\." functor fold)]]] [macro ["." template]] [math - ["." random (#+ Random)]]] + ["." random (#+ Random)] + [number + ["n" nat]]]] {1 ["." /]}) diff --git a/stdlib/source/test/lux/macro/code.lux b/stdlib/source/test/lux/macro/code.lux index cbaa5aee7..1244b84e4 100644 --- a/stdlib/source/test/lux/macro/code.lux +++ b/stdlib/source/test/lux/macro/code.lux @@ -1,8 +1,6 @@ (.module: [lux #* ["_" test (#+ Test)] - [math - ["." random (#+ Random) ("#\." monad)]] [abstract [monad (#+ do)] {[0 #spec] @@ -13,10 +11,12 @@ [data ["." product] ["." text] - [number - ["n" nat]] [collection ["." list ("#\." functor)]]] + [math + ["." random (#+ Random) ("#\." monad)] + [number + ["n" nat]]] [meta ["." location]] [tool diff --git a/stdlib/source/test/lux/macro/poly/equivalence.lux b/stdlib/source/test/lux/macro/poly/equivalence.lux index 51315ec1e..c1edf6022 100644 --- a/stdlib/source/test/lux/macro/poly/equivalence.lux +++ b/stdlib/source/test/lux/macro/poly/equivalence.lux @@ -2,8 +2,6 @@ [lux #* ["%" data/text/format (#+ format)] ["_" test (#+ Test)] - [math - ["." random (#+ Random)]] [abstract [monad (#+ do)] [equivalence (#+ Equivalence) @@ -12,14 +10,16 @@ [data ["." bit] ["." maybe] - [number - ["n" nat] - ["i" int]] ["." text] [collection ["." list]]] [macro - [poly (#+ derived:)]]]) + [poly (#+ derived:)]] + [math + ["." random (#+ Random)] + [number + ["n" nat] + ["i" int]]]]) (type: Variant (#Case0 Bit) diff --git a/stdlib/source/test/lux/macro/poly/json.lux b/stdlib/source/test/lux/macro/poly/json.lux index b6b3a29e2..98b955af8 100644 --- a/stdlib/source/test/lux/macro/poly/json.lux +++ b/stdlib/source/test/lux/macro/poly/json.lux @@ -4,9 +4,9 @@ [abstract codec [monad (#+ do)] - [equivalence (#+ Equivalence) + ["." equivalence (#+ Equivalence) {[0 #poly] - ["poly/equivalence" /]}] + ["poly/#" /]}] {[0 #spec] [/ ["$." equivalence] @@ -22,9 +22,6 @@ ["." maybe] ["." text ["%" format (#+ format)]] - [number - ["n" nat] - ["." frac]] [format [json (#+) {[0 #poly] @@ -38,7 +35,10 @@ [type ["." unit]] [math - ["." random (#+ Random)]] + ["." random (#+ Random)] + [number + ["n" nat] + ["." frac]]] [time ["ti" instant] ["tda" date] diff --git a/stdlib/source/test/lux/macro/syntax.lux b/stdlib/source/test/lux/macro/syntax.lux index 316734d36..c2a1e63a5 100644 --- a/stdlib/source/test/lux/macro/syntax.lux +++ b/stdlib/source/test/lux/macro/syntax.lux @@ -2,7 +2,6 @@ [lux #* ["%" data/text/format (#+ format)] [abstract/monad (#+ do)] - ["r" math/random (#+ Random)] ["_" test (#+ Test)] [abstract [equivalence (#+ Equivalence)]] @@ -13,14 +12,16 @@ [data ["." bit] ["." name] - ["." text] + ["." text]] + [macro + ["." code]] + [math + [random (#+ Random)] [number ["." nat] ["." int] ["." rev] - ["." frac]]] - [macro - ["." code]]] + ["." frac]]]] {1 ["." / (#+ syntax:)]}) diff --git a/stdlib/source/test/lux/macro/syntax/common.lux b/stdlib/source/test/lux/macro/syntax/common.lux index 769a28439..90a72ca26 100644 --- a/stdlib/source/test/lux/macro/syntax/common.lux +++ b/stdlib/source/test/lux/macro/syntax/common.lux @@ -1,8 +1,6 @@ (.module: [lux #* ["_" test (#+ Test)] - [math - ["." random (#+ Random)]] [abstract [monad (#+ do)] [equivalence (#+ Equivalence)]] @@ -16,12 +14,14 @@ ["." bit ("#\." equivalence)] ["." name] ["." text] - [number - ["n" nat]] [collection ["." list]]] [macro - ["." code]]] + ["." code]] + [math + ["." random (#+ Random)] + [number + ["n" nat]]]] {1 ["." / ["#." reader] @@ -31,7 +31,8 @@ ["." / #_ ["#." check] ["#." definition] - ["#." export]]) + ["#." export] + ["#." declaration]]) (def: annotations_equivalence (Equivalence /.Annotations) @@ -96,22 +97,6 @@ (#try.Failure error) false)))) (do {! random.monad} - [size (\ ! map (|>> (n.% 3)) random.nat) - expected (: (Random /.Declaration) - (random.and ..random_text - (random.list size ..random_text)))] - (_.cover [/.Declaration /reader.declaration /writer.declaration] - (|> expected - /writer.declaration list - (<c>.run /reader.declaration) - (case> (#try.Success actual) - (let [equivalence (product.equivalence text.equivalence - (list.equivalence text.equivalence))] - (\ equivalence = expected actual)) - - (#try.Failure error) - false)))) - (do {! random.monad} [expected (: (Random /.Typed_Input) (random.and ///code.random ///code.random))] @@ -129,4 +114,5 @@ /check.test /definition.test /export.test + /declaration.test ))) diff --git a/stdlib/source/test/lux/macro/syntax/common/declaration.lux b/stdlib/source/test/lux/macro/syntax/common/declaration.lux new file mode 100644 index 000000000..a9bc23296 --- /dev/null +++ b/stdlib/source/test/lux/macro/syntax/common/declaration.lux @@ -0,0 +1,47 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)] + {[0 #spec] + [/ + ["$." equivalence]]}] + [control + ["." try] + [parser + ["<.>" code]]] + [math + ["." random (#+ Random)] + [number + ["n" nat]]]] + {1 + ["." /]}) + +(def: #export random + (Random /.Declaration) + (let [word (random.ascii/alpha 10)] + ($_ random.and + word + (do {! random.monad} + [size (\ ! map (n.% 10) random.nat)] + (random.list size word)) + ))) + +(def: #export test + Test + (<| (_.covering /._) + (_.for [/.Declaration]) + ($_ _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + + (do random.monad + [expected ..random] + (_.cover [/.write /.parser] + (case (<code>.run /.parser + (list (/.write expected))) + (#try.Failure _) + false + + (#try.Success actual) + (\ /.equivalence = expected actual))))))) diff --git a/stdlib/source/test/lux/macro/template.lux b/stdlib/source/test/lux/macro/template.lux index 902e84255..5733f40ad 100644 --- a/stdlib/source/test/lux/macro/template.lux +++ b/stdlib/source/test/lux/macro/template.lux @@ -1,13 +1,13 @@ (.module: [lux #* ["_" test (#+ Test)] - [math - ["." random (#+ Random)]] [abstract [monad (#+ do)]] [data [collection - ["." list]] + ["." list]]] + [math + ["." random (#+ Random)] [number ["." nat]]]] {1 diff --git a/stdlib/source/test/lux/math.lux b/stdlib/source/test/lux/math.lux index d9741e6ad..a8c7c121e 100644 --- a/stdlib/source/test/lux/math.lux +++ b/stdlib/source/test/lux/math.lux @@ -2,19 +2,21 @@ [lux #* ["%" data/text/format (#+ format)] ["_" test (#+ Test)] - ["r" math/random (#+ Random)] - [abstract/monad (#+ Monad do)] - [data + [abstract + [monad (#+ do)]] + [math + ["." random (#+ Random)] [number ["n" nat] - ["." int] - ["f" frac]]]] + ["f" frac] + ["." int]]]] {1 ["." /]} ["." / #_ ["#." infix] ["#." modulus] ["#." modular] + ["#." number] ["#." logic #_ ["#/." continuous] ["#/." fuzzy]]]) @@ -36,8 +38,8 @@ (<| (_.context (%.name (name_of /._))) ($_ _.and (<| (_.context "Trigonometry") - (do {! r.monad} - [angle (|> r.safe_frac (\ ! map (f.* /.tau)))] + (do {! random.monad} + [angle (|> random.safe_frac (\ ! map (f.* /.tau)))] ($_ _.and (_.test "Sine and arc-sine are inverse functions." (trigonometric_symmetry /.sin /.asin angle)) @@ -47,8 +49,8 @@ (trigonometric_symmetry /.tan /.atan angle)) ))) (<| (_.context "Rounding") - (do {! r.monad} - [sample (|> r.safe_frac (\ ! map (f.* +1000.0)))] + (do {! random.monad} + [sample (|> random.safe_frac (\ ! map (f.* +1000.0)))] ($_ _.and (_.test "The ceiling will be an integer value, and will be >= the original." (let [ceil'd (/.ceil sample)] @@ -66,13 +68,13 @@ (f.<= +1.0 (f.abs (f.- sample round'd)))))) ))) (<| (_.context "Exponentials and logarithms") - (do {! r.monad} - [sample (|> r.safe_frac (\ ! map (f.* +10.0)))] + (do {! random.monad} + [sample (|> random.safe_frac (\ ! map (f.* +10.0)))] (_.test "Logarithm is the inverse of exponential." (|> sample /.exp /.log (within? +0.000000000000001 sample))))) (<| (_.context "Greatest-Common-Divisor and Least-Common-Multiple") - (do {! r.monad} - [#let [gen_nat (|> r.nat (\ ! map (|>> (n.% 1000) (n.max 1))))] + (do {! random.monad} + [#let [gen_nat (|> random.nat (\ ! map (|>> (n.% 1000) (n.max 1))))] x gen_nat y gen_nat] ($_ _.and @@ -90,7 +92,9 @@ ))) /infix.test + /modulus.test /modular.test + /number.test /logic/continuous.test /logic/fuzzy.test ))) diff --git a/stdlib/source/test/lux/math/infix.lux b/stdlib/source/test/lux/math/infix.lux index f4a3552e9..785285f2d 100644 --- a/stdlib/source/test/lux/math/infix.lux +++ b/stdlib/source/test/lux/math/infix.lux @@ -4,12 +4,12 @@ [abstract [monad (#+ do)]] [data - ["." bit ("#\." equivalence)] + ["." bit ("#\." equivalence)]] + [math + ["." random] [number ["n" nat] - ["f" frac]]] - [math - ["." random]]] + ["f" frac]]]] {1 ["." / ["." //]]}) diff --git a/stdlib/source/test/lux/math/logic/continuous.lux b/stdlib/source/test/lux/math/logic/continuous.lux index dd18ad2d1..e54eccc2e 100644 --- a/stdlib/source/test/lux/math/logic/continuous.lux +++ b/stdlib/source/test/lux/math/logic/continuous.lux @@ -1,11 +1,13 @@ (.module: [lux #* - ["%" data/text/format (#+ format)] - [abstract/monad (#+ do)] ["_" test (#+ Test)] + [abstract + [monad (#+ do)] + {[0 #spec] + [/ + ["$." monoid]]}] [math - ["." random]] - [data + ["." random] [number ["r" rev]]]] {1 @@ -13,24 +15,101 @@ (def: #export test Test - (<| (_.context (%.name (name_of /._))) + (<| (_.covering /._) (do random.monad [left random.rev + mid random.rev right random.rev] - ($_ _.and - (_.test "AND is the minimum." - (let [result (/.and left right)] - (and (r.<= left result) - (r.<= right result)))) - (_.test "OR is the maximum." - (let [result (/.or left right)] - (and (r.>= left result) - (r.>= right result)))) - (_.test "Double negation results in the original value." - (r.= left (/.not (/.not left)))) - (_.test "Every value is equivalent to itself." - (and (r.>= left - (/.= left left)) - (r.>= right - (/.= right right)))) - )))) + (`` ($_ _.and + (~~ (template [<monoid>] + [(_.for [<monoid>] + ($monoid.spec r.= <monoid> random.rev))] + + [/.disjunction] + [/.conjunction] + )) + + (_.cover [/.true /.false] + (let [true=max! + (r.= /.false (inc /.true)) + + false=min! + (r.= /.true (dec /.false))] + (and true=max! + false=min!))) + (_.cover [/.or] + (let [identity! + (r.= left (/.or /.false left)) + + annihilation! + (r.= /.true (/.or /.true left)) + + idempotence! + (r.= left (/.or left left)) + + associativity! + (r.= ($_ /.or left mid right) + (_$ /.or left mid right))] + (and identity! + annihilation! + idempotence! + associativity! + (let [l|r (/.or left right)] + (and (r.>= left l|r) + (r.>= right l|r)))))) + (_.cover [/.and] + (let [identity! + (r.= left (/.and /.true left)) + + annihilation! + (r.= /.false (/.and /.false left)) + + idempotence! + (r.= left (/.and left left)) + + associativity! + (r.= ($_ /.and left mid right) + (_$ /.and left mid right))] + (and identity! + annihilation! + idempotence! + associativity! + (let [l&r (/.and left right)] + (and (r.<= left l&r) + (r.<= right l&r)))))) + (_.cover [/.not] + (let [inverses! + (and (r.= /.false (/.not /.true)) + (r.= /.true (/.not /.false))) + + double_negation! + (r.= left (/.not (/.not left))) + + de_morgan! + (and (r.= (/.not (/.or left right)) + (/.and (/.not left) (/.not right))) + (r.= (/.not (/.and left right)) + (/.or (/.not left) (/.not right))))] + (and inverses! + double_negation! + de_morgan!))) + (_.cover [/.implies] + (let [modus_tollens! + (r.= (/.implies right left) + (/.implies (/.not left) (/.not right)))] + (and modus_tollens!))) + (_.cover [/.=] + (let [trivial! + (and (r.= /.true (/.= /.true /.true)) + (r.= /.true (/.= /.false /.false)) + + (r.= /.false (/.= /.true /.false))) + + common! + (and (r.>= left + (/.= left left)) + (r.>= right + (/.= right right)))] + (and trivial! + common!))) + ))))) diff --git a/stdlib/source/test/lux/math/logic/fuzzy.lux b/stdlib/source/test/lux/math/logic/fuzzy.lux index 476a40964..6289dd64d 100644 --- a/stdlib/source/test/lux/math/logic/fuzzy.lux +++ b/stdlib/source/test/lux/math/logic/fuzzy.lux @@ -1,20 +1,20 @@ (.module: [lux #* ["%" data/text/format (#+ format)] + ["_" test (#+ Test)] [abstract [monad (#+ do)] ["." enum]] - [math - ["." random (#+ Random)]] - ["_" test (#+ Test)] [data ["." bit ("#\." equivalence)] - [number - ["n" nat] - ["r" rev]] [collection ["." list] - ["." set]]]] + ["." set]]] + [math + ["." random (#+ Random)] + [number + ["n" nat] + ["r" rev]]]] {1 ["." / (#+ Fuzzy) [// diff --git a/stdlib/source/test/lux/math/modular.lux b/stdlib/source/test/lux/math/modular.lux index 849159da2..b0c69b814 100644 --- a/stdlib/source/test/lux/math/modular.lux +++ b/stdlib/source/test/lux/math/modular.lux @@ -15,11 +15,11 @@ ["." exception]] [data ["." product] - ["." bit ("#\." equivalence)] - [number - ["i" int]]] + ["." bit ("#\." equivalence)]] [math - ["." random (#+ Random)]]] + ["." random (#+ Random)] + [number + ["i" int]]]] ["$." // #_ ["#" modulus]] {1 diff --git a/stdlib/source/test/lux/math/modulus.lux b/stdlib/source/test/lux/math/modulus.lux index 7fec2db0d..4f3b4a2fb 100644 --- a/stdlib/source/test/lux/math/modulus.lux +++ b/stdlib/source/test/lux/math/modulus.lux @@ -1,17 +1,16 @@ (.module: [lux #* ["_" test (#+ Test)] + ["." meta] [abstract [monad (#+ do)]] [control ["." try] ["." exception]] - [data + [math + ["." random (#+ Random)] [number ["i" int]]] - [math - ["." random (#+ Random)]] - ["." meta] [macro [syntax (#+ syntax:)] ["." code]]] diff --git a/stdlib/source/test/lux/data/number.lux b/stdlib/source/test/lux/math/number.lux index d8e769369..5a897db71 100644 --- a/stdlib/source/test/lux/data/number.lux +++ b/stdlib/source/test/lux/math/number.lux @@ -4,15 +4,13 @@ [control ["." try]] [data - ["." text - ["%" format (#+ format)]] - [number - ["n" nat] - ["i" int] - ["r" rev] - ["f" frac]]]] + ["." text]]] {1 - ["." /]} + ["." / + ["n" nat] + ["i" int] + ["r" rev] + ["f" frac]]} ["." / #_ ["#." i8] ["#." i16] diff --git a/stdlib/source/test/lux/data/number/complex.lux b/stdlib/source/test/lux/math/number/complex.lux index fc83ddb51..751ec9022 100644 --- a/stdlib/source/test/lux/data/number/complex.lux +++ b/stdlib/source/test/lux/math/number/complex.lux @@ -10,17 +10,18 @@ ["$." order] ["$." codec]]}] [data - [number - ["n" nat] - ["." int] - ["f" frac]] [collection ["." list ("#\." functor)]]] ["." math ["." random (#+ Random)]]] {1 - ["." /]}) + ["." / + [// + ["n" nat] + ["f" frac] + ["." int]]]}) +## This margin of error is necessary because floating-point arithmetic is not exact. (def: margin_of_error +0.000000001) diff --git a/stdlib/source/test/lux/data/number/frac.lux b/stdlib/source/test/lux/math/number/frac.lux index dcaa417ed..dcaa417ed 100644 --- a/stdlib/source/test/lux/data/number/frac.lux +++ b/stdlib/source/test/lux/math/number/frac.lux diff --git a/stdlib/source/test/lux/data/number/i16.lux b/stdlib/source/test/lux/math/number/i16.lux index 1a5009a03..6cf457989 100644 --- a/stdlib/source/test/lux/data/number/i16.lux +++ b/stdlib/source/test/lux/math/number/i16.lux @@ -6,14 +6,12 @@ {[0 #spec] [/ ["$." equivalence]]}] - [data - [number - ["i" int]]] [math ["." random (#+ Random)]]] {1 ["." / ["/#" // #_ + ["i" int] ["#." i64]]]}) (def: #export random diff --git a/stdlib/source/test/lux/data/number/i32.lux b/stdlib/source/test/lux/math/number/i32.lux index fd48509ea..1061cdc1b 100644 --- a/stdlib/source/test/lux/data/number/i32.lux +++ b/stdlib/source/test/lux/math/number/i32.lux @@ -6,14 +6,12 @@ {[0 #spec] [/ ["$." equivalence]]}] - [data - [number - ["i" int]]] [math ["." random (#+ Random)]]] {1 ["." / ["/#" // #_ + ["i" int] ["#." i64]]]}) (def: #export random diff --git a/stdlib/source/test/lux/data/number/i64.lux b/stdlib/source/test/lux/math/number/i64.lux index 45e644ab2..43e240675 100644 --- a/stdlib/source/test/lux/data/number/i64.lux +++ b/stdlib/source/test/lux/math/number/i64.lux @@ -2,10 +2,7 @@ [lux #* ["_" test (#+ Test)] [data - ["." bit ("#\." equivalence)] - [number (#+ hex) - ["n" nat] - ["i" int]]] + ["." bit ("#\." equivalence)]] [abstract [monad (#+ do)] {[0 #spec] @@ -16,7 +13,10 @@ [math ["." random (#+ Random)]]] {1 - ["." / ("\." equivalence)]}) + ["." / ("\." equivalence) + [// (#+ hex) + ["n" nat] + ["i" int]]]}) (def: bit Test diff --git a/stdlib/source/test/lux/data/number/i8.lux b/stdlib/source/test/lux/math/number/i8.lux index 49b6995e8..b0903a903 100644 --- a/stdlib/source/test/lux/data/number/i8.lux +++ b/stdlib/source/test/lux/math/number/i8.lux @@ -6,14 +6,12 @@ {[0 #spec] [/ ["$." equivalence]]}] - [data - [number - ["i" int]]] [math ["." random (#+ Random)]]] {1 ["." / ["/#" // #_ + ["i" int] ["#." i64]]]}) (def: #export random diff --git a/stdlib/source/test/lux/data/number/int.lux b/stdlib/source/test/lux/math/number/int.lux index 24155602b..3d9931ad1 100644 --- a/stdlib/source/test/lux/data/number/int.lux +++ b/stdlib/source/test/lux/math/number/int.lux @@ -13,13 +13,13 @@ ["$." monoid] ["$." codec]]}] [data - ["." bit ("#\." equivalence)] - [number - ["f" frac]]] + ["." bit ("#\." equivalence)]] [math ["." random (#+ Random)]]] {1 - ["." /]}) + ["." / + [// + ["f" frac]]]}) (def: signature Test diff --git a/stdlib/source/test/lux/data/number/nat.lux b/stdlib/source/test/lux/math/number/nat.lux index a2d0fd655..3de2970cc 100644 --- a/stdlib/source/test/lux/data/number/nat.lux +++ b/stdlib/source/test/lux/math/number/nat.lux @@ -13,13 +13,13 @@ ["$." monoid] ["$." codec]]}] [data - ["." bit ("#\." equivalence)] - [number - ["f" frac]]] + ["." bit ("#\." equivalence)]] [math ["." random]]] {1 - ["." /]}) + ["." / + [// + ["f" frac]]]}) (def: signature Test diff --git a/stdlib/source/test/lux/data/number/ratio.lux b/stdlib/source/test/lux/math/number/ratio.lux index 1e8da2e78..199096dab 100644 --- a/stdlib/source/test/lux/data/number/ratio.lux +++ b/stdlib/source/test/lux/math/number/ratio.lux @@ -11,13 +11,13 @@ ["$." codec]]}] [data ["." bit ("#\." equivalence)] - ["." maybe ("#\." functor)] - [number - ["n" nat ("#\." equivalence)]]] + ["." maybe ("#\." functor)]] [math ["." random (#+ Random)]]] {1 - ["." /]}) + ["." / + [// + ["n" nat ("#\." equivalence)]]]}) (def: part (Random Nat) diff --git a/stdlib/source/test/lux/data/number/rev.lux b/stdlib/source/test/lux/math/number/rev.lux index 2e75eb874..5b30741df 100644 --- a/stdlib/source/test/lux/data/number/rev.lux +++ b/stdlib/source/test/lux/math/number/rev.lux @@ -13,15 +13,15 @@ ["$." monoid] ["$." codec]]}] [data - ["." bit ("#\." equivalence)] - [number (#+ hex) - ["n" nat] - ["f" frac] - ["." i64 ("#\." hash)]]] + ["." bit ("#\." equivalence)]] [math ["." random]]] {1 - ["." /]}) + ["." / + [// (#+ hex) + ["n" nat] + ["f" frac] + ["." i64 ("#\." hash)]]]}) (def: signature Test diff --git a/stdlib/source/test/lux/meta.lux b/stdlib/source/test/lux/meta.lux index 7428cae69..6997d55e3 100644 --- a/stdlib/source/test/lux/meta.lux +++ b/stdlib/source/test/lux/meta.lux @@ -12,13 +12,13 @@ ["." try]] [data ["." text ("#\." equivalence) - ["%" format (#+ format)]] - [number - ["n" nat]]] + ["%" format (#+ format)]]] [meta ["." location]] [math - ["." random (#+ Random)]]] + ["." random (#+ Random)] + [number + ["n" nat]]]] {1 ["." /]} ["." / #_ diff --git a/stdlib/source/test/lux/meta/annotation.lux b/stdlib/source/test/lux/meta/annotation.lux index 3718b8797..51b33a70b 100644 --- a/stdlib/source/test/lux/meta/annotation.lux +++ b/stdlib/source/test/lux/meta/annotation.lux @@ -1,8 +1,6 @@ (.module: [lux #* ["_" test (#+ Test)] - [math - ["." random (#+ Random)]] [abstract [monad (#+ do)]] [control @@ -11,17 +9,18 @@ ["." product] ["." bit] ["." name ("#\." equivalence)] - ["." text - ["%" format (#+ format)]] + ["." text] + [collection + ["." list ("#\." functor)]]] + [macro + ["." code ("#\." equivalence)]] + [math + ["." random (#+ Random)] [number ["." nat] ["." int] ["." rev] - ["." frac]] - [collection - ["." list ("#\." functor)]]] - [macro - ["." code ("#\." equivalence)]]] + ["." frac]]]] {1 ["." /]} [/// diff --git a/stdlib/source/test/lux/target/jvm.lux b/stdlib/source/test/lux/target/jvm.lux index 42d4eba11..3a5a79711 100644 --- a/stdlib/source/test/lux/target/jvm.lux +++ b/stdlib/source/test/lux/target/jvm.lux @@ -13,12 +13,6 @@ [data ["." maybe] ["." bit ("#\." equivalence)] - [number - ["." i32 (#+ I32)] - ["." i64] - ["n" nat] - ["i" int] - ["f" frac]] ["." text ("#\." equivalence) ["%" format (#+ format)]] ["." format #_ @@ -30,7 +24,13 @@ ["." set] ["." list ("#\." functor)]]] [math - ["." random (#+ Random) ("#\." monad)]] + ["." random (#+ Random) ("#\." monad)] + [number + ["n" nat] + ["i" int] + ["f" frac] + ["." i32 (#+ I32)] + ["." i64]]] ["_" test (#+ Test)]] {1 ["." / #_ diff --git a/stdlib/source/test/lux/time/duration.lux b/stdlib/source/test/lux/time/duration.lux index 272532324..af9d46014 100644 --- a/stdlib/source/test/lux/time/duration.lux +++ b/stdlib/source/test/lux/time/duration.lux @@ -10,12 +10,11 @@ ["$." order] ["$." monoid] ["$." codec]]}] - [data + [math + ["." random (#+ Random)] [number ["n" nat] - ["i" int]]] - [math - ["." random (#+ Random)]]] + ["i" int]]]] {1 ["." / (#+ Duration)]}) diff --git a/stdlib/source/test/lux/time/instant.lux b/stdlib/source/test/lux/time/instant.lux index cc2c0a742..65fed1248 100644 --- a/stdlib/source/test/lux/time/instant.lux +++ b/stdlib/source/test/lux/time/instant.lux @@ -13,14 +13,14 @@ [control ["." try]] [data - ["." text] + ["." text]] + [math + ["." random (#+ Random)] [number ["i" int]]] - [math - ["." random (#+ Random)]] [time ["@d" duration] - ["@date" date]]] + ["@." date]]] [// ["_." duration]] {1 diff --git a/stdlib/source/test/lux/type.lux b/stdlib/source/test/lux/type.lux index c06b89478..168ed29d1 100644 --- a/stdlib/source/test/lux/type.lux +++ b/stdlib/source/test/lux/type.lux @@ -1,17 +1,19 @@ (.module: [lux (#- type) ["%" data/text/format (#+ format)] - ["M" abstract/monad (#+ do)] - ["r" math/random (#+ Random)] ["_" test (#+ Test)] + [abstract + ["." monad (#+ do)]] [control pipe] [data ["." maybe] - [number - ["n" nat]] [collection - ["." list]]]] + ["." list]]] + [math + ["." random (#+ Random)] + [number + ["n" nat]]]] {1 ["." / ("#\." equivalence)]} ["." / #_ @@ -21,41 +23,41 @@ ["#." resource]]) (def: short - (r.Random Text) - (do {! r.monad} - [size (|> r.nat (\ ! map (n.% 10)))] - (r.unicode size))) + (Random Text) + (do {! random.monad} + [size (|> random.nat (\ ! map (n.% 10)))] + (random.unicode size))) (def: name - (r.Random Name) - (r.and ..short ..short)) + (Random Name) + (random.and ..short ..short)) (def: #export random - (r.Random Type) - (let [(^open "R\.") r.monad] - (r.rec (function (_ recur) - (let [pairG (r.and recur recur) - idG r.nat - quantifiedG (r.and (R\wrap (list)) recur)] - ($_ r.or - (r.and ..short (R\wrap (list))) - pairG - pairG - pairG - idG - idG - idG - quantifiedG - quantifiedG - pairG - (r.and ..name recur) - )))))) + (Random Type) + (let [(^open "R\.") random.monad] + (random.rec (function (_ recur) + (let [pairG (random.and recur recur) + idG random.nat + quantifiedG (random.and (R\wrap (list)) recur)] + ($_ random.or + (random.and ..short (R\wrap (list))) + pairG + pairG + pairG + idG + idG + idG + quantifiedG + quantifiedG + pairG + (random.and ..name recur) + )))))) (def: #export test Test (<| (_.context (%.name (name_of /._))) ($_ _.and - (do r.monad + (do random.monad [sample ..random] (_.test "Every type is equal to itself." (\ /.equivalence = sample sample))) @@ -83,18 +85,18 @@ (\ /.equivalence = (/.un_name base) (/.un_name aliased)))))) - (do {! r.monad} - [size (|> r.nat (\ ! map (n.% 3))) + (do {! random.monad} + [size (|> random.nat (\ ! map (n.% 3))) members (|> ..random - (r.filter (function (_ type) - (case type - (^or (#.Sum _) (#.Product _)) - #0 + (random.filter (function (_ type) + (case type + (^or (#.Sum _) (#.Product _)) + #0 - _ - #1))) + _ + #1))) (list.repeat size) - (M.seq !)) + (monad.seq !)) #let [(^open "/\.") /.equivalence (^open "list\.") (list.equivalence /.equivalence)]] (`` ($_ _.and @@ -109,17 +111,17 @@ ["tuple" /.tuple /.flatten_tuple Any] )) ))) - (do {! r.monad} - [size (|> r.nat (\ ! map (n.% 3))) - members (M.seq ! (list.repeat size ..random)) + (do {! random.monad} + [size (|> random.nat (\ ! map (n.% 3))) + members (monad.seq ! (list.repeat size ..random)) extra (|> ..random - (r.filter (function (_ type) - (case type - (^or (#.Function _) (#.Apply _)) - #0 + (random.filter (function (_ type) + (case type + (^or (#.Function _) (#.Apply _)) + #0 - _ - #1)))) + _ + #1)))) #let [(^open "/\.") /.equivalence (^open "list\.") (list.equivalence /.equivalence)]] ($_ _.and @@ -132,16 +134,16 @@ (let [[tfunc tparams] (|> extra (/.application members) /.flatten_application)] (n.= (list.size members) (list.size tparams)))) )) - (do {! r.monad} - [size (|> r.nat (\ ! map (n.% 3))) + (do {! random.monad} + [size (|> random.nat (\ ! map (n.% 3))) extra (|> ..random - (r.filter (function (_ type) - (case type - (^or (#.UnivQ _) (#.ExQ _)) - #0 + (random.filter (function (_ type) + (case type + (^or (#.UnivQ _) (#.ExQ _)) + #0 - _ - #1)))) + _ + #1)))) #let [(^open "/\.") /.equivalence]] (`` ($_ _.and (~~ (template [<desc> <ctor> <dtor>] diff --git a/stdlib/source/test/lux/type/check.lux b/stdlib/source/test/lux/type/check.lux index c41f610dc..45e648b9c 100644 --- a/stdlib/source/test/lux/type/check.lux +++ b/stdlib/source/test/lux/type/check.lux @@ -1,7 +1,6 @@ (.module: [lux (#- type) ["%" data/text/format (#+ format)] - ["r" math/random (#+ Random)] ["_" test (#+ Test)] [abstract ["." monad (#+ do)]] @@ -11,53 +10,55 @@ ["." product] ["." maybe] ["." text ("#\." equivalence)] - [number - ["n" nat]] [collection ["." list ("#\." functor)] ["." set]]] + [math + ["." random (#+ Random)] + [number + ["n" nat]]] ["." type ("#\." equivalence)]] {1 ["." /]}) ## TODO: Remove the following 3 definitions ASAP. //.type already exists... (def: short - (r.Random Text) - (r.unicode 10)) + (Random Text) + (random.unicode 10)) (def: name - (r.Random Name) - (r.and ..short ..short)) + (Random Name) + (random.and ..short ..short)) (def: (type' num_vars) - (-> Nat (r.Random Type)) - (r.rec + (-> Nat (Random Type)) + (random.rec (function (_ recur) - (let [(^open "R\.") r.monad - pairG (r.and recur recur) - quantifiedG (r.and (R\wrap (list)) (type' (inc num_vars))) - random_pair (r.either (r.either (R\map (|>> #.Sum) pairG) - (R\map (|>> #.Product) pairG)) - (r.either (R\map (|>> #.Function) pairG) - (R\map (|>> #.Apply) pairG))) - random_id (let [random_id (r.either (R\map (|>> #.Var) r.nat) - (R\map (|>> #.Ex) r.nat))] + (let [(^open "R\.") random.monad + pairG (random.and recur recur) + quantifiedG (random.and (R\wrap (list)) (type' (inc num_vars))) + random_pair (random.either (random.either (R\map (|>> #.Sum) pairG) + (R\map (|>> #.Product) pairG)) + (random.either (R\map (|>> #.Function) pairG) + (R\map (|>> #.Apply) pairG))) + random_id (let [random_id (random.either (R\map (|>> #.Var) random.nat) + (R\map (|>> #.Ex) random.nat))] (case num_vars 0 random_id - _ (r.either (R\map (|>> (n.% num_vars) (n.* 2) inc #.Parameter) r.nat) - random_id))) - random_quantified (r.either (R\map (|>> #.UnivQ) quantifiedG) - (R\map (|>> #.ExQ) quantifiedG))] - ($_ r.either - (R\map (|>> #.Primitive) (r.and ..short (R\wrap (list)))) + _ (random.either (R\map (|>> (n.% num_vars) (n.* 2) inc #.Parameter) random.nat) + random_id))) + random_quantified (random.either (R\map (|>> #.UnivQ) quantifiedG) + (R\map (|>> #.ExQ) quantifiedG))] + ($_ random.either + (R\map (|>> #.Primitive) (random.and ..short (R\wrap (list)))) random_pair random_id random_quantified - (R\map (|>> #.Named) (r.and ..name (type' 0))) + (R\map (|>> #.Named) (random.and ..name (type' 0))) ))))) (def: type - (r.Random Type) + (Random Type) (..type' 0)) (def: (valid_type? type) @@ -106,8 +107,8 @@ Test (<| (_.context (%.name (name_of /._))) ($_ _.and - (do r.monad - [sample (r.filter ..valid_type? ..type)] + (do random.monad + [sample (random.filter ..valid_type? ..type)] ($_ _.and (_.test "Any is the super-type of everything." (/.checks? Any sample)) @@ -145,7 +146,7 @@ (not (/.checks? (#.Function Any Nothing) (#.Function Nothing Any))))) ) - (do r.monad + (do random.monad [meta ..type data ..type] (_.test "Can type-check type application." @@ -153,12 +154,12 @@ (type.tuple (list meta data))) (/.checks? (type.tuple (list meta data)) (|> Ann (#.Apply meta) (#.Apply data)))))) - (do r.monad - [#let [gen_short (r.ascii 10)] + (do random.monad + [#let [gen_short (random.ascii 10)] nameL gen_short - nameR (|> gen_short (r.filter (|>> (text\= nameL) not))) + nameR (|> gen_short (random.filter (|>> (text\= nameL) not))) paramL ..type - paramR (r.filter (|>> (/.checks? paramL) not) ..type)] + paramR (random.filter (|>> (/.checks? paramL) not) ..type)] ($_ _.and (_.test "Primitive types match when they have the same name and the same parameters." (/.checks? (#.Primitive nameL (list paramL)) @@ -198,10 +199,10 @@ _ (/.check var Nothing)] (/.check .Bit var)))) ) - (do {! r.monad} - [num_connections (|> r.nat (\ ! map (n.% 100))) - boundT (|> ..type (r.filter (|>> (case> (#.Var _) #0 _ #1)))) - pick_pcg (r.and r.nat r.nat)] + (do {! random.monad} + [num_connections (|> random.nat (\ ! map (n.% 100))) + boundT (|> ..type (random.filter (|>> (case> (#.Var _) #0 _ #1)))) + pick_pcg (random.and random.nat random.nat)] ($_ _.and (_.test "Can create rings of variables." (type_checks? (do /.monad diff --git a/stdlib/source/test/lux/type/dynamic.lux b/stdlib/source/test/lux/type/dynamic.lux index 4cb4e5093..fadc98ca7 100644 --- a/stdlib/source/test/lux/type/dynamic.lux +++ b/stdlib/source/test/lux/type/dynamic.lux @@ -2,11 +2,11 @@ [lux #* ["%" data/text/format (#+ format)] [abstract/monad (#+ do)] - ["r" math/random (#+ Random)] ["_" test (#+ Test)] [control ["." try]] - [data + [math + ["." random (#+ Random)] [number ["n" nat]]]] {1 @@ -15,8 +15,8 @@ (def: #export test Test (<| (_.context (%.name (name_of /._))) - (do r.monad - [expected r.nat + (do random.monad + [expected random.nat #let [value (:dynamic expected)]] ($_ _.and (_.test "Can check dynamic values." diff --git a/stdlib/source/test/lux/type/implicit.lux b/stdlib/source/test/lux/type/implicit.lux index f78637b1b..4978a9b3a 100644 --- a/stdlib/source/test/lux/type/implicit.lux +++ b/stdlib/source/test/lux/type/implicit.lux @@ -9,12 +9,12 @@ ["." enum]] [data ["." bit ("#\." equivalence)] - [number - ["n" nat]] [collection ["." list]]] [math - ["." random (#+ Random)]]] + ["." random (#+ Random)] + [number + ["n" nat]]]] {1 ["." /]}) diff --git a/stdlib/source/test/lux/type/resource.lux b/stdlib/source/test/lux/type/resource.lux index 7f84dcd2b..54150772e 100644 --- a/stdlib/source/test/lux/type/resource.lux +++ b/stdlib/source/test/lux/type/resource.lux @@ -1,14 +1,13 @@ (.module: [lux #* ["%" data/text/format (#+ format)] - ["r" math/random (#+ Random)] ["_" test (#+ Test)] [abstract [monad [indexed (#+ do)]]] [control ["." io]] - [data + [math [number ["n" nat]]]] {1 diff --git a/stdlib/source/test/lux/world/file.lux b/stdlib/source/test/lux/world/file.lux index 173bd7586..b59202972 100644 --- a/stdlib/source/test/lux/world/file.lux +++ b/stdlib/source/test/lux/world/file.lux @@ -1,7 +1,6 @@ (.module: [lux #* ["%" data/text/format (#+ format)] - ["r" math/random (#+ Random) ("#\." monad)] ["_" test (#+ Test)] [abstract/monad (#+ do)] [control @@ -14,11 +13,13 @@ [data ["." binary (#+ Binary)] ["." text] - [number - ["n" nat] - ["i" int]] [collection ["." list]]] + [math + ["." random (#+ Random) ("#\." monad)] + [number + ["n" nat] + ["i" int]]] [time ["." instant] ["." duration]]] @@ -36,49 +37,51 @@ (def: (creation_and_deletion number) (-> Nat Test) - (r\wrap (do promise.monad - [#let [path (format "temp_file_" (%.nat number))] - result (promise.future - (do (try.with io.monad) - [#let [check_existence! (: (IO (Try Bit)) - (try.lift io.monad (/.exists? io.monad /.default path)))] - pre! check_existence! - file (!.use (\ /.default create_file) path) - post! check_existence! - _ (!.use (\ file delete) []) - remains? check_existence!] - (wrap (and (not pre!) - post! - (not remains?)))))] - (_.assert "Can create/delete files." - (try.default #0 result))))) + (random\wrap + (do promise.monad + [#let [path (format "temp_file_" (%.nat number))] + result (promise.future + (do (try.with io.monad) + [#let [check_existence! (: (IO (Try Bit)) + (try.lift io.monad (/.exists? io.monad /.default path)))] + pre! check_existence! + file (!.use (\ /.default create_file) path) + post! check_existence! + _ (!.use (\ file delete) []) + remains? check_existence!] + (wrap (and (not pre!) + post! + (not remains?)))))] + (_.assert "Can create/delete files." + (try.default #0 result))))) (def: (read_and_write number data) (-> Nat Binary Test) - (r\wrap (do promise.monad - [#let [path (format "temp_file_" (%.nat number))] - result (promise.future - (do (try.with io.monad) - [file (!.use (\ /.default create_file) path) - _ (!.use (\ file over_write) data) - content (!.use (\ file content) []) - _ (!.use (\ file delete) [])] - (wrap (\ binary.equivalence = data content))))] - (_.assert "Can write/read files." - (try.default #0 result))))) + (random\wrap + (do promise.monad + [#let [path (format "temp_file_" (%.nat number))] + result (promise.future + (do (try.with io.monad) + [file (!.use (\ /.default create_file) path) + _ (!.use (\ file over_write) data) + content (!.use (\ file content) []) + _ (!.use (\ file delete) [])] + (wrap (\ binary.equivalence = data content))))] + (_.assert "Can write/read files." + (try.default #0 result))))) (def: #export test Test (<| (_.context (%.name (name_of /._))) - (do {! r.monad} - [file_size (|> r.nat (\ ! map (|>> (n.% 100) (n.max 10)))) + (do {! random.monad} + [file_size (|> random.nat (\ ! map (|>> (n.% 100) (n.max 10)))) dataL (_binary.random file_size) dataR (_binary.random file_size) - new_modified (|> r.int (\ ! map (|>> i.abs - (i.% +10,000,000,000,000) - truncate_millis - duration.from_millis - instant.absolute)))] + new_modified (|> random.int (\ ! map (|>> i.abs + (i.% +10,000,000,000,000) + truncate_millis + duration.from_millis + instant.absolute)))] ($_ _.and ## (..creation_and_deletion 0) ## (..read_and_write 1 dataL) @@ -152,12 +155,12 @@ ## [dir (!.use (\ /.default create_directory) dir_path) ## pre_files (!.use (\ dir files) []) ## pre_directories (!.use (\ dir directories) []) - + ## file (!.use (\ /.default create_file) (format dir_path "/" file_path)) ## inner_dir (!.use (\ /.default create_directory) (format dir_path "/" inner_dir_path)) ## post_files (!.use (\ dir files) []) ## post_directories (!.use (\ dir directories) []) - + ## _ (!.use (\ file delete) []) ## _ (!.use (\ inner_dir discard) []) ## _ (!.use (\ dir discard) [])] diff --git a/stdlib/source/test/lux/world/shell.lux b/stdlib/source/test/lux/world/shell.lux index 1dbe5dcd5..a336de350 100644 --- a/stdlib/source/test/lux/world/shell.lux +++ b/stdlib/source/test/lux/world/shell.lux @@ -16,13 +16,13 @@ ["." environment (#+ Environment)]]] [data ["." text ("#\." equivalence)] - [number - ["n" nat] - ["i" int]] [collection ["." list]]] [math - ["." random]]] + ["." random] + [number + ["n" nat] + ["i" int]]]] {1 ["." / [// |