diff options
22 files changed, 159 insertions, 392 deletions
diff --git a/lux-jvm/source/luxc/lang/directive/jvm.lux b/lux-jvm/source/luxc/lang/directive/jvm.lux index 7b1b35b52..6063d0df0 100644 --- a/lux-jvm/source/luxc/lang/directive/jvm.lux +++ b/lux-jvm/source/luxc/lang/directive/jvm.lux @@ -1464,9 +1464,9 @@ (list#each ..constraint type_variables) supers (|> method_declarations - (list#each (function (_ (^slots [#name #annotations #type_variables #exceptions #arguments #return])) - (def.abstract_method {jvm.#Public} jvm.noneM name - (/type.method [type_variables arguments return exceptions])))) + (list#each (function (_ (^open "_[0]")) + (def.abstract_method {jvm.#Public} jvm.noneM _#name + (/type.method [_#type_variables _#arguments _#return _#exceptions])))) def.fuse))]]] (directive.lifted_generation (do ! diff --git a/lux-jvm/source/luxc/lang/host/jvm.lux b/lux-jvm/source/luxc/lang/host/jvm.lux index 600f26dd7..dc4a3b351 100644 --- a/lux-jvm/source/luxc/lang/host/jvm.lux +++ b/lux-jvm/source/luxc/lang/host/jvm.lux @@ -9,6 +9,8 @@ ["<[0]>" code]]] [data [binary {"+" Binary}] + [text + ["%" format {"+" format}]] [collection ["[0]" list ("[1]#[0]" monad)]]] [macro @@ -96,14 +98,14 @@ options (<code>.tuple (<>.many <code>.local_identifier))]) (let [g!type (code.local_identifier type) g!none (code.local_identifier none) - g!tags+ (list#each code.local_tag options) + g!tags+ (list#each (|>> (format "#") code.local_identifier) options) g!_left (code.local_identifier "_left") g!_right (code.local_identifier "_right") g!options+ (list#each (function (_ option) (` (def: .public (~ (code.local_identifier option)) (~ g!type) (|> (~ g!none) - (with@ (~ (code.local_tag option)) #1))))) + (with@ (~ (code.local_identifier (format "#" option))) #1))))) options)] (in (list& (` (type: .public (~ g!type) (.Record diff --git a/lux-jvm/source/luxc/lang/translation/jvm.lux b/lux-jvm/source/luxc/lang/translation/jvm.lux index b3ae09176..5fee195d4 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm.lux @@ -164,14 +164,14 @@ [loader (: Host (implementation - (def: (evaluate! context valueI) + (def: (evaluate context valueI) (# try.monad each product.left (..evaluate! library loader context valueI))) - (def: execute! + (def: execute (..execute! library loader)) - (def: define! + (def: define (..define! library loader)) (def: (ingest context bytecode) diff --git a/lux-jvm/source/luxc/lang/translation/jvm/common.lux b/lux-jvm/source/luxc/lang/translation/jvm/common.lux deleted file mode 100644 index 57f3ee822..000000000 --- a/lux-jvm/source/luxc/lang/translation/jvm/common.lux +++ /dev/null @@ -1,74 +0,0 @@ -(.module: - [library - ... [lux "*" - ... [abstract - ... [monad {"+" do}]] - ... [control - ... ["[0]" try {"+" Try}] - ... ["ex" exception {"+" exception:}] - ... ["[0]" io]] - ... [data - ... [binary {"+" Binary}] - ... ["[0]" text {"+" \n} ("[1]#[0]" hash) - ... format] - ... [collection - ... ["[0]" dictionary {"+" Dictionary}]]] - ... ["[0]" macro] - ... [host {"+" import:}] - ... [tool - ... [compiler - ... [reference {"+" Register}] - ... ["[0]" name] - ... ["[0]" phase]]] - ... ] - ] - ... [luxc - ... [lang - ... [host - ... ["[0]" jvm - ... [type]]]]] - ) - -... (def: .public (with-artifacts action) -... (All (_ a) (-> (Meta a) (Meta [Artifacts a]))) -... (function (_ state) -... (case (action (revised@ .#host -... (|>> (:coerce Host) -... (with@ #artifacts (dictionary.new text.hash)) -... (:coerce Nothing)) -... state)) -... {try.#Success [state' output]} -... {try.#Success [(revised@ .#host -... (|>> (:coerce Host) -... (with@ #artifacts (|> (value@ .#host state) (:coerce Host) (value@ #artifacts))) -... (:coerce Nothing)) -... state') -... [(|> state' (value@ .#host) (:coerce Host) (value@ #artifacts)) -... output]]} - -... {try.#Failure error} -... {try.#Failure error}))) - -... (def: .public (load-definition state) -... (-> Lux (-> Name Binary (Try Any))) -... (function (_ (^@ def-name [def-module def-name]) def-bytecode) -... (let [normal-name (format (name.normalize def-name) (%n (text#hash def-name))) -... class-name (format (text.replace-all "/" "." def-module) "." normal-name)] -... (<| (macro.result state) -... (do macro.monad -... [_ (..store-class class-name def-bytecode) -... class (..load-class class-name)] -... (case (do try.monad -... [field (Class::getField [..value-field] class)] -... (Field::get [{.#None}] field)) -... {try.#Success {.#Some def-value}} -... (wrap def-value) - -... {try.#Success {.#None}} -... (phase.throw invalid-definition-value (%name def-name)) - -... {try.#Failure error} -... (phase.throw cannot-load-definition -... (format "Definition: " (%name def-name) \n -... "Error:" \n -... error)))))))) diff --git a/lux-jvm/source/luxc/lang/translation/jvm/expression.lux b/lux-jvm/source/luxc/lang/translation/jvm/expression.lux index c2dfe0ace..de8ac3c12 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/expression.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/expression.lux @@ -13,7 +13,6 @@ [host [jvm {"+" Phase}]]]] [// - ["[0]" common] ["[0]" primitive] ["[0]" structure] ["[0]" reference] 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 137633847..e32e35869 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux @@ -980,7 +980,7 @@ (_.ALOAD (++ register)) (_.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#each product.right inputsTI))) (_.INVOKESPECIAL super_class "<init>" (type.method [(list) (list#each product.left inputsTI) type.void (list)])) @@ -1132,7 +1132,7 @@ [bodyG (generation.with_context artifact_id (generate archive bodyS)) .let [argumentsT (list#each product.right arguments)]] - (in (_def.method #$.Public + (in (_def.method {$.#Public} (if strict_fp? ($_ $.++M $.finalM $.strictM) $.finalM) @@ -1143,7 +1143,7 @@ (returnI returnT))))))) (# ! each _def.fuse)) .let [directive [anonymous_class_name - (_def.class #$.V1_6 #$.Public $.finalC + (_def.class {$.#V1_6} {$.#Public} $.finalC anonymous_class_name (list) super_class super_interfaces (|>> (///function.with_environment total_environment) diff --git a/lux-jvm/source/luxc/lang/translation/jvm/function.lux b/lux-jvm/source/luxc/lang/translation/jvm/function.lux index fc8670946..17a246833 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/function.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/function.lux @@ -127,7 +127,7 @@ (def: (with_reset class arity env) (-> (Type Class) Arity (Environment Synthesis) Def) - (def.method #$.Public $.noneM "reset" (reset_method class) + (def.method {$.#Public} $.noneM "reset" (reset_method class) (if (poly_arg? arity) (let [env_size (list.size env) captureI (|> (case env_size @@ -151,7 +151,7 @@ (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))) @@ -189,7 +189,7 @@ (_.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 @@ -253,7 +253,7 @@ _.ARETURN)) )))) _.fuse)] - (def.method #$.Public $.noneM //runtime.apply_method (//runtime.apply_signature apply_arity) + (def.method {$.#Public} $.noneM //runtime.apply_method (//runtime.apply_signature apply_arity) (|>> get_amount_of_partialsI (_.TABLESWITCH +0 (|> num_partials -- .int) @default @labels) @@ -264,7 +264,7 @@ (-> (Environment Synthesis) Def) (|>> list.enumeration (list@each (.function (_ [env_idx env_source]) - (def.field #$.Private $.finalF (reference.foreign_name env_idx) //.$Value))) + (def.field {$.#Private} $.finalF (reference.foreign_name env_idx) //.$Value))) def.fuse)) (def: (with_partial arity) @@ -272,7 +272,7 @@ (if (poly_arg? arity) (|> (enum.range n.enum 0 (n.- 2 arity)) (list@each (.function (_ idx) - (def.field #$.Private $.finalF (reference.partial_name idx) //.$Value))) + (def.field {$.#Private} $.finalF (reference.partial_name idx) //.$Value))) def.fuse) function.identity)) @@ -287,12 +287,12 @@ (list@each (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)) + (|>> (def.int_field {$.#Public} ($_ $.++F $.staticF $.finalF) arity_field (.int arity)) (with_environment env) (with_partial arity) (with_init classD env arity) @@ -322,7 +322,7 @@ .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 + (def.class {$.#V1_6} {$.#Public} $.finalC function_class (list) //.$Function (list) functionD)]] diff --git a/lux-jvm/source/luxc/lang/translation/jvm/runtime.lux b/lux-jvm/source/luxc/lang/translation/jvm/runtime.lux index cb62ddb4b..ae14639f0 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/runtime.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/runtime.lux @@ -122,7 +122,7 @@ (let [store_leftsI (|>> _.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" + (|>> ($d.method {$.#Public} $.staticM "variant_make" (type.method [(list) (list $Lefts $Right? $Value) //.$Variant (list)]) (|>> _.ICONST_3 (_.ANEWARRAY $Value) @@ -133,7 +133,7 @@ (def: frac_methods Def - (|>> ($d.method #$.Public $.staticM "decode_frac" (type.method [(list) (list $Text) //.$Variant (list)]) + (|>> ($d.method {$.#Public} $.staticM "decode_frac" (type.method [(list) (list $Text) //.$Variant (list)]) (tryI (|>> (_.ALOAD 0) (_.INVOKESTATIC (type.class "java.lang.Double" (list)) "parseDouble" (type.method [(list) (list $Text) type.double (list)])) @@ -169,13 +169,13 @@ (|>> sub_leftsI (_.ISTORE 1) sub_tupleI (_.ASTORE 0) (_.GOTO @loop))))] - (|>> ($d.method #$.Public $.staticM "pm_fail" throw_methodT + (|>> ($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 + ($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) (list $Stack $Value) $Stack (list)]) + ($d.method {$.#Public} $.staticM "pm_push" (type.method [(list) (list $Stack $Value) $Stack (list)]) (|>> _.ICONST_2 (_.ANEWARRAY $Value) _.DUP @@ -187,7 +187,7 @@ (_.ALOAD 1) _.AASTORE _.ARETURN)) - ($d.method #$.Public $.staticM "pm_variant" (type.method [(list) (list //.$Variant $Lefts $Right?) $Value (list)]) + ($d.method {$.#Public} $.staticM "pm_variant" (type.method [(list) (list //.$Variant $Lefts $Right?) $Value (list)]) (<| _.with_label (function (_ @loop)) _.with_label (function (_ @perfect_match!)) _.with_label (function (_ @lefts_match!)) @@ -261,7 +261,7 @@ ... _.POP2 $variant ::value _.ARETURN))) - ($d.method #$.Public $.staticM "tuple_left" (type.method [(list) (list //.$Tuple $Index) $Value (list)]) + ($d.method {$.#Public} $.staticM "tuple_left" (type.method [(list) (list //.$Tuple $Index) $Value (list)]) (<| _.with_label (function (_ @loop)) _.with_label (function (_ @recursive)) (let [left_accessI (|>> (_.ALOAD 0) left_indexI _.AALOAD)]) @@ -272,7 +272,7 @@ (_.label @recursive) ... Recursive (recurI @loop)))) - ($d.method #$.Public $.staticM "tuple_right" (type.method [(list) (list //.$Tuple $Index) $Value (list)]) + ($d.method {$.#Public} $.staticM "tuple_right" (type.method [(list) (list //.$Tuple $Index) $Value (list)]) (<| _.with_label (function (_ @loop)) _.with_label (function (_ @not_tail)) _.with_label (function (_ @slice)) @@ -323,7 +323,7 @@ (_.boolean true) (_.INVOKESPECIAL PrintWriter "<init>" (type.method [(list) (list (type.class "java.io.Writer" (list)) type.boolean) type.void (list)])) )] - (|>> ($d.method #$.Public $.staticM "try" ..try + (|>> ($d.method {$.#Public} $.staticM "try" ..try (<| _.with_label (function (_ @from)) _.with_label (function (_ @to)) _.with_label (function (_ @handler)) @@ -356,7 +356,7 @@ (def: translate_runtime (Operation [artifact.ID (Maybe Text) Binary]) (let [runtime_class (..reflection //.$Runtime) - bytecode ($d.class #$.V1_6 #$.Public $.finalC runtime_class (list) (type.class "java.lang.Object" (list)) (list) + bytecode ($d.class {$.#V1_6} {$.#Public} $.finalC runtime_class (list) (type.class "java.lang.Object" (list)) (list) (|>> adt_methods frac_methods pm_methods @@ -374,7 +374,7 @@ (Operation [artifact.ID (Maybe Text) Binary]) (let [applyI (|> (enum.range n.enum 2 num_apply_variants) (list@each (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 (-- arity)) (list@each _.ALOAD) _.fuse)] @@ -384,13 +384,13 @@ (_.ALOAD arity) (_.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) - ($d.method #$.Public $.noneM "<init>" (type.method [(list) (list type.int) type.void (list)]) + 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) (list type.int) type.void (list)]) (|>> (_.ALOAD 0) (_.INVOKESPECIAL $Object "<init>" nullary_init_methodT) (_.ALOAD 0) diff --git a/lux-jvm/source/program.lux b/lux-jvm/source/program.lux index 4484db653..79205fd84 100644 --- a/lux-jvm/source/program.lux +++ b/lux-jvm/source/program.lux @@ -144,27 +144,27 @@ unwrap_long (: (-> Synthesis Synthesis) (|>> (list ($.text jvm/type/box.long) ($.text "long")) - {#$.Extension "jvm object cast"})) + {$.#Extension "jvm object cast"})) long_to_int (: (-> Synthesis Synthesis) (|>> (list) - {#$.Extension "jvm conversion long-to-int"})) + {$.#Extension "jvm conversion long-to-int"})) literal_nat (: (-> Nat Synthesis) (|>> .i64 $.i64 unwrap_long long_to_int)) write! (: (-> Text Nat Synthesis Synthesis Synthesis) (function (_ element_class index value array) - {#$.Extension "jvm array write object" + {$.#Extension "jvm array write object" (list (jvm_type (jvm/type.array (jvm/type.class element_class (list)))) (literal_nat index) value array)})) object_array (: (-> Text Nat Synthesis) (function (_ class_name size) - {#$.Extension "jvm array new object" + {$.#Extension "jvm array new object" (list (class_type class_name) (literal_nat size))})) class_of (: (-> Synthesis Synthesis) (function (_ object) - {#$.Extension "jvm member invoke virtual" + {$.#Extension "jvm member invoke virtual" (list& (class_type "java.lang.Object") ($.text "getClass") (class_type "java.lang.Class") @@ -174,7 +174,7 @@ (function (_ value_type value) ($.tuple (list (jvm_type value_type) value)))) - example_object {#$.Extension "jvm member invoke constructor" + example_object {$.#Extension "jvm member invoke constructor" (list& (class_type "java.lang.Object") (list))} phase_arity 3 @@ -182,7 +182,7 @@ $archive ($.variable/local 2) $input ($.variable/local 3) $state ($.variable/local 4) - apply_method {#$.Extension "jvm member invoke virtual" + apply_method {$.#Extension "jvm member invoke virtual" (list& (class_type "java.lang.Class") ($.text "getMethod") (class_type "java.lang.reflect.Method") @@ -194,7 +194,7 @@ (write! "java.lang.Class" 0 (class_of example_object)) (write! "java.lang.Class" 1 (class_of example_object)) (write! "java.lang.Class" 2 (class_of example_object))))))}] - {#$.Extension "jvm member invoke virtual" + {$.#Extension "jvm member invoke virtual" (list& (class_type "java.lang.reflect.Method") ($.text "invoke") (class_type "java.lang.Object") diff --git a/stdlib/source/library/lux.lux b/stdlib/source/library/lux.lux index c912c6bb1..6eb000a79 100644 --- a/stdlib/source/library/lux.lux +++ b/stdlib/source/library/lux.lux @@ -4051,7 +4051,8 @@ (macro: .public (# tokens) (case tokens (^ (list struct [_ {#Identifier member}])) - (in_meta (list (` (let [(^open (~ (text$ (alias_stand_in 0)))) (~ struct)] (~ (identifier$ member)))))) + (in_meta (list (` (let [(^open (~ (text$ (alias_stand_in 0)))) (~ struct)] + (~ (identifier$ member)))))) (^ (list& struct member args)) (in_meta (list (` ((..# (~ struct) (~ member)) (~+ args))))) diff --git a/stdlib/source/library/lux/ffi.jvm.lux b/stdlib/source/library/lux/ffi.jvm.lux index 2d753a3cd..4b7d33f51 100644 --- a/stdlib/source/library/lux/ffi.jvm.lux +++ b/stdlib/source/library/lux/ffi.jvm.lux @@ -445,7 +445,7 @@ (def: (parser->replacer p ast) (-> (Parser Code) (-> Code Code)) (case (<>.result p (list ast)) - {.#Right [.#End ast']} + {.#Right [{.#End} ast']} ast' _ @@ -1585,42 +1585,42 @@ {#FieldAccessDecl fad} (do meta.monad - [.let [(^open "[0]") fad - 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 "!"))])] + [.let [(^open "_[0]") fad + 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_identifiers [g!obj] - (let [getter_call (if import_field_static? + (let [getter_call (if _#import_field_static? (` ((~ getter_name) [])) (` ((~ getter_name) [(~ g!obj) (~! <code>.any)]))) - getter_body (<| (with_automatic_output_conversion 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_quoted g!obj)))]) - getter_body (if import_field_maybe? + getter_body (<| (with_automatic_output_conversion _#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_quoted g!obj)))]) + getter_body (if _#import_field_maybe? (` ((~! ???) (~ getter_body))) getter_body) - getter_body (if import_field_setter? + getter_body (if _#import_field_setter? (` ((~! io.io) (~ getter_body))) getter_body)] (in (` ((~! syntax:) (~ getter_call) ((~' in) (.list (.` (~ getter_body))))))))) setter_interop (: (Meta (List Code)) - (if import_field_setter? + (if _#import_field_setter? (with_identifiers [g!obj g!value] - (let [setter_call (if import_field_static? + (let [setter_call (if _#import_field_static? (` ((~ setter_name) [(~ g!value) (~! <code>.any)])) (` ((~ setter_name) [(~ g!value) (~! <code>.any) (~ g!obj) (~! <code>.any)]))) - setter_value (|> [import_field_type (..un_quoted g!value)] - (with_automatic_input_conversion import_field_mode)) - setter_value (if import_field_maybe? + setter_value (|> [_#import_field_type (..un_quoted g!value)] + (with_automatic_input_conversion _#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) + setter_command (format (if _#import_field_static? "jvm putstatic" "jvm putfield") + ":" full_name ":" _#import_field_name) g!obj+ (: (List Code) - (if import_field_static? + (if _#import_field_static? (list) (list (..un_quoted g!obj))))] (in (list (` ((~! syntax:) (~ setter_call) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis.lux index 22840635e..ace3fcee8 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis.lux @@ -68,7 +68,7 @@ (^ {.#Variant (list& [_ {.#Nat lefts}] [_ {.#Bit right?}] values)}) (case values - {.#Item value .#End} + {.#Item value {.#End}} (/structure.sum compile lefts right? archive value) _ diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/case.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/case.lux index 95fdfdc45..146ea09cf 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/case.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/case.lux @@ -153,6 +153,56 @@ outputA next] (in [output outputA])))) +(def: (analyse_tuple_pattern analyse_pattern inputT sub_patterns next) + (All (_ a) + (-> (-> (Maybe Nat) Type Code (Operation a) (Operation [Pattern a])) + Type (List Code) (Operation a) (Operation [Pattern a]))) + (do [! ///.monad] + [inputT' (simplify_case inputT)] + (.case inputT' + {.#Product _} + (let [matches (loop [types (type.flat_tuple inputT') + patterns sub_patterns + output (: (List [Type Code]) + {.#End})] + (.case [types patterns] + [{.#End} {.#End}] + output + + [{.#Item headT {.#End}} {.#Item headP {.#End}}] + {.#Item [headT headP] output} + + [remainingT {.#Item headP {.#End}}] + {.#Item [(type.tuple remainingT) headP] output} + + [{.#Item headT {.#End}} remainingP] + {.#Item [headT (code.tuple remainingP)] output} + + [{.#Item headT tailT} {.#Item headP tailP}] + (recur tailT tailP {.#Item [headT headP] output}) + + _ + (undefined)))] + (do ! + [[memberP+ thenA] (list#mix (: (All (_ a) + (-> [Type Code] (Operation [(List Pattern) a]) + (Operation [(List Pattern) a]))) + (function (_ [memberT memberC] then) + (do ! + [[memberP [memberP+ thenA]] ((:as (All (_ a) (-> (Maybe Nat) Type Code (Operation a) (Operation [Pattern a]))) + analyse_pattern) + {.#None} memberT memberC then)] + (in [(list& memberP memberP+) thenA])))) + (do ! + [nextA next] + (in [(list) nextA])) + matches)] + (in [(/.pattern/tuple memberP+) + thenA]))) + + _ + (/.except ..cannot_match_with_pattern [inputT' (code.tuple sub_patterns)])))) + ... This function handles several concerns at once, but it must be that ... way because those concerns are interleaved when doing ... pattern-matching and they cannot be separated. @@ -195,78 +245,35 @@ (analyse_pattern {.#None} inputT singleton next) [location {.#Tuple sub_patterns}] - (do [! ///.monad] - [record (//structure.normal sub_patterns) - record_size,members,recordT (: (Operation (Maybe [Nat (List Code) Type])) - (.case record - {.#Some record} - (//structure.order record) - - {.#None} - (in {.#None})))] - (.case record_size,members,recordT - {.#Some [record_size members recordT]} - (do ! - [_ (.case inputT - {.#Var _id} - (//type.with_env - (check.check inputT recordT)) - - _ - (in []))] - (analyse_pattern {.#Some record_size} inputT [location {.#Tuple members}] next)) - - {.#None} - (/.with_location location - (do [! ///.monad] - [inputT' (simplify_case inputT)] - (.case inputT' - {.#Product _} - (let [matches (loop [types (type.flat_tuple inputT') - patterns sub_patterns - output (: (List [Type Code]) - {.#End})] - (.case [types patterns] - [{.#End} {.#End}] - output - - [{.#Item headT {.#End}} {.#Item headP {.#End}}] - {.#Item [headT headP] output} - - [remainingT {.#Item headP {.#End}}] - {.#Item [(type.tuple remainingT) headP] output} - - [{.#Item headT {.#End}} remainingP] - {.#Item [headT (code.tuple remainingP)] output} - - [{.#Item headT tailT} {.#Item headP tailP}] - (recur tailT tailP {.#Item [headT headP] output}) - - _ - (undefined)))] - (do ! - [[memberP+ thenA] (list#mix (: (All (_ a) - (-> [Type Code] (Operation [(List Pattern) a]) - (Operation [(List Pattern) a]))) - (function (_ [memberT memberC] then) - (do ! - [[memberP [memberP+ thenA]] ((:as (All (_ a) (-> (Maybe Nat) Type Code (Operation a) (Operation [Pattern a]))) - analyse_pattern) - {.#None} memberT memberC then)] - (in [(list& memberP memberP+) thenA])))) - (do ! - [nextA next] - (in [(list) nextA])) - matches)] - (in [(/.pattern/tuple memberP+) - thenA]))) + (/.with_location location + (do [! ///.monad] + [record (//structure.normal sub_patterns) + record_size,members,recordT (: (Operation (Maybe [Nat (List Code) Type])) + (.case record + {.#Some record} + (//structure.order record) + + {.#None} + (in {.#None})))] + (.case record_size,members,recordT + {.#Some [record_size members recordT]} + (do ! + [_ (.case inputT + {.#Var _id} + (//type.with_env + (check.check inputT recordT)) + + _ + (in []))] + (.case members + (^ (list singleton)) + (analyse_pattern {.#None} inputT singleton next) _ - (/.except ..cannot_match_with_pattern [inputT' pattern])))))) - - [location {.#Tag tag}] - (/.with_location location - (analyse_pattern {.#None} inputT (` {(~ pattern)}) next)) + (analyse_tuple_pattern analyse_pattern inputT members next))) + + {.#None} + (analyse_tuple_pattern analyse_pattern inputT sub_patterns next)))) (^ [location {.#Variant (list& [_ {.#Nat lefts}] [_ {.#Bit right?}] values)}]) (/.with_location location @@ -307,7 +314,7 @@ _ (/.except ..cannot_match_with_pattern [inputT' pattern])))) - (^ [location {.#Variant (list& [_ {.#Tag tag}] values)}]) + (^ [location {.#Variant (list& [_ {.#Identifier tag}] values)}]) (/.with_location location (do ///.monad [tag (///extension.lifted (meta.normal tag)) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/module.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/module.lux index 877566e72..cd0004d31 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/module.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/module.lux @@ -181,8 +181,8 @@ {.#Some module} {try.#Success [state (case (value@ .#module_state module) - <tag> #1 - _ #0)]} + {<tag>} #1 + _ #0)]} {.#None} ((/.except' unknown_module module_name) state)))))] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/structure.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/structure.lux index c01f6970b..dc96cfd4d 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/structure.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/structure.lux @@ -76,19 +76,19 @@ [(exception: .public (<name> [key Name record (List [Name Code])]) (exception.report - ["Tag" (%.code (code.tag key))] + ["Tag" (%.code (code.identifier key))] ["Record" (%.code (code.tuple (|> record (list#each (function (_ [keyI valC]) - (list (code.tag keyI) valC))) + (list (code.identifier keyI) valC))) list#conjoint)))]))] - [cannot_repeat_tag] + [cannot_repeat_slot] ) (exception: .public (slot_does_not_belong_to_record [key Name type Type]) (exception.report - ["Tag" (%.code (code.tag key))] + ["Tag" (%.code (code.identifier key))] ["Type" (%.type type)])) (exception: .public (record_size_mismatch [expected Nat @@ -101,7 +101,7 @@ ["Type" (%.type type)] ["Expression" (%.code (|> record (list#each (function (_ [keyI valueC]) - (list (code.tag keyI) valueC))) + (list (code.identifier keyI) valueC))) list#conjoint code.tuple))])) @@ -310,7 +310,7 @@ output (: (List [Name Code]) {.#End})] (case input - (^ (list& [_ {.#Tag slotH}] valueH tail)) + (^ (list& [_ {.#Identifier slotH}] valueH tail)) (do ///.monad [slotH (///extension.lifted (meta.normal slotH))] (recur tail {.#Item [slotH valueH] output})) @@ -354,7 +354,7 @@ (case (dictionary.value key tag->idx) {.#Some idx} (if (dictionary.key? idx->val idx) - (/.except ..cannot_repeat_tag [key record]) + (/.except ..cannot_repeat_slot [key record]) (in (dictionary.has idx val idx->val))) {.#None} @@ -380,7 +380,7 @@ (^ (list singletonC)) (analyse archive singletonC) - (^ (list [_ {.#Tag pseudo_slot}] singletonC)) + (^ (list [_ {.#Identifier pseudo_slot}] singletonC)) (do [! ///.monad] [head_k (///extension.lifted (meta.normal pseudo_slot)) slot (///extension.lifted (meta.try (meta.slot head_k)))] diff --git a/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux b/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux index 8c8df0a6f..5328ecf74 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux @@ -231,7 +231,7 @@ (case artifact_category {artifact.#Anonymous} (do ! - [.let [output (row.suffix [artifact_id .#None data] output)] + [.let [output (row.suffix [artifact_id {.#None} data] output)] _ (# host re_learn context {.#None} directive)] (in [definitions [analysers diff --git a/stdlib/source/library/lux/world/service/authentication.lux b/stdlib/source/library/lux/world/service/authentication.lux deleted file mode 100644 index 069eac560..000000000 --- a/stdlib/source/library/lux/world/service/authentication.lux +++ /dev/null @@ -1,26 +0,0 @@ -(.module: - [library - [lux "*" - [control - [try {"+" Try}] - [security - [capability {"+" Capability}]]]]]) - -(type: .public (Can_Register ! account secret value) - (Capability [account secret value] (! (Try Any)))) - -(type: .public (Can_Authenticate ! account secret value) - (Capability [account secret] (! (Try value)))) - -(type: .public (Can_Reset ! account secret) - (Capability [account secret] (! (Try Any)))) - -(type: .public (Can_Forget ! account) - (Capability [account] (! (Try Any)))) - -(type: .public (Service ! account secret value) - (Record - [#can_register (Can_Register ! account secret value) - #can_authenticate (Can_Authenticate ! account secret value) - #can_reset (Can_Reset ! account secret) - #can_forget (Can_Forget ! account)])) diff --git a/stdlib/source/library/lux/world/service/crud.lux b/stdlib/source/library/lux/world/service/crud.lux deleted file mode 100644 index db6145c55..000000000 --- a/stdlib/source/library/lux/world/service/crud.lux +++ /dev/null @@ -1,35 +0,0 @@ -(.module: - [library - [lux "*" - [control - ["[0]" try {"+" Try}] - [security - ["!" capability {"+" capability:}]]] - [time - ["[0]" instant {"+" Instant}]]]]) - -(type: .public ID Nat) - -(type: .public Time - (Record - [#created Instant - #updated Instant])) - -(capability: .public (Can_Create ! entity) - (can_create [Instant entity] (! (Try ID)))) - -(capability: .public (Can_Retrieve ! entity) - (can_retrieve ID (! (Try [Time entity])))) - -(capability: .public (Can_Update ! entity) - (can_update [ID Instant entity] (! (Try Any)))) - -(capability: .public (Can_Delete ! entity) - (can_delete ID (! (Try Any)))) - -(type: .public (CRUD ! entity) - (Record - [#can_create (Can_Create ! entity) - #can_retrieve (Can_Retrieve ! entity) - #can_update (Can_Update ! entity) - #can_delete (Can_Delete ! entity)])) diff --git a/stdlib/source/library/lux/world/service/inventory.lux b/stdlib/source/library/lux/world/service/inventory.lux deleted file mode 100644 index 114227887..000000000 --- a/stdlib/source/library/lux/world/service/inventory.lux +++ /dev/null @@ -1,34 +0,0 @@ -(.module: - [library - [lux "*" - [control - [try {"+" Try}] - [security - ["!" capability {"+" capability:}]]]]]) - -(type: .public ID - Nat) - -(type: .public Ownership - (Record - [#owner ID - #property ID])) - -(capability: .public (Can_Own !) - (can_own Ownership (! (Try Any)))) - -(capability: .public (Can_Disown !) - (can_disown Ownership (! (Try Any)))) - -(capability: .public (Can_Check !) - (can_check Ownership (! (Try Bit)))) - -(capability: .public (Can_List_Property !) - (can_list_property ID (! (Try (List ID))))) - -(type: .public (Inventory !) - (Record - [#can_own (Can_Own !) - #can_disown (Can_Disown !) - #can_check (Can_Check !) - #can_list_property (Can_List_Property !)])) diff --git a/stdlib/source/library/lux/world/service/journal.lux b/stdlib/source/library/lux/world/service/journal.lux deleted file mode 100644 index 49ac101ba..000000000 --- a/stdlib/source/library/lux/world/service/journal.lux +++ /dev/null @@ -1,53 +0,0 @@ -(.module: - [library - [lux "*" - [control - [equivalence {"+" Equivalence}] - [interval {"+" Interval}] - [try {"+" Try}] - [security - ["!" capability {"+" capability:}]]] - [data - ["[0]" text ("[1]#[0]" equivalence)]] - [time - ["[0]" instant {"+" Instant} ("[1]#[0]" equivalence)]]]]) - -(type: .public (Entry a) - (Record - [#what a - #why Text - #how Text - #who Text - #where Text - #when Instant])) - -(type: .public Range - (Interval Instant)) - -(def: .public (range start end) - (-> Instant Instant Range) - (implementation - (def: &enum instant.enum) - (def: bottom start) - (def: top end))) - -(implementation: .public (equivalence (^open "_#[0]")) - (All (_ a) (-> (Equivalence a) (Equivalence (Entry a)))) - (def: (= reference sample) - (and (_#= (value@ #what reference) (value@ #what sample)) - (text#= (value@ #why reference) (value@ #why sample)) - (text#= (value@ #how reference) (value@ #how sample)) - (text#= (value@ #who reference) (value@ #who sample)) - (text#= (value@ #where reference) (value@ #where sample)) - (instant#= (value@ #when reference) (value@ #when sample))))) - -(capability: .public (Can_Write ! a) - (can_write (Entry a) (! (Try Any)))) - -(capability: .public (Can_Read ! a) - (can_read Range (! (Try (List (Entry a)))))) - -(type: .public (Journal ! a) - (Record - [#can_write (Can_Write ! a) - #can_read (Can_Read ! a)])) diff --git a/stdlib/source/library/lux/world/service/mail.lux b/stdlib/source/library/lux/world/service/mail.lux deleted file mode 100644 index 6f189d485..000000000 --- a/stdlib/source/library/lux/world/service/mail.lux +++ /dev/null @@ -1,20 +0,0 @@ -(.module: - [library - [lux "*" - [control - [try {"+" Try}] - [concurrency - [frp {"+" Channel}]] - [security - ["!" capability {"+" capability:}]]]]]) - -(capability: .public (Can_Send ! address message) - (can_send [address message] (! (Try Any)))) - -(capability: .public (Can_Subscribe ! address message) - (can_subscribe [address] (! (Try (Channel message))))) - -(type: .public (Service ! address message) - (Record - [#can_send (Can_Send ! address message) - #can_subscribe (Can_Subscribe ! address message)])) diff --git a/stdlib/source/library/lux/world/shell.lux b/stdlib/source/library/lux/world/shell.lux index c5f626e09..83cf1aeda 100644 --- a/stdlib/source/library/lux/world/shell.lux +++ b/stdlib/source/library/lux/world/shell.lux @@ -293,9 +293,9 @@ (implementation: .public default (Shell IO) - (def: (execute [environment working_directory command arguments]) + (def: (execute [environment working_directory the_command arguments]) (do [! (try.with io.monad)] - [.let [builder (|> (list& command arguments) + [.let [builder (|> (list& the_command arguments) ..jvm::arguments_array java/lang/ProcessBuilder::new (java/lang/ProcessBuilder::directory (java/io/File::new working_directory)))] |