From c19b19a2d48c3937bae72982cbb88b78d21b3891 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 13 Sep 2021 01:35:52 -0400 Subject: Updated new compilers w.r.t. removal of tags/labels. --- stdlib/source/library/lux.lux | 3 +- stdlib/source/library/lux/ffi.jvm.lux | 40 +++--- .../tool/compiler/language/lux/phase/analysis.lux | 2 +- .../compiler/language/lux/phase/analysis/case.lux | 149 +++++++++++---------- .../language/lux/phase/analysis/module.lux | 4 +- .../language/lux/phase/analysis/structure.lux | 16 +-- .../library/lux/tool/compiler/meta/io/archive.lux | 2 +- .../library/lux/world/service/authentication.lux | 26 ---- stdlib/source/library/lux/world/service/crud.lux | 35 ----- .../source/library/lux/world/service/inventory.lux | 34 ----- .../source/library/lux/world/service/journal.lux | 53 -------- stdlib/source/library/lux/world/service/mail.lux | 20 --- stdlib/source/library/lux/world/shell.lux | 4 +- 13 files changed, 114 insertions(+), 274 deletions(-) delete mode 100644 stdlib/source/library/lux/world/service/authentication.lux delete mode 100644 stdlib/source/library/lux/world/service/crud.lux delete mode 100644 stdlib/source/library/lux/world/service/inventory.lux delete mode 100644 stdlib/source/library/lux/world/service/journal.lux delete mode 100644 stdlib/source/library/lux/world/service/mail.lux (limited to 'stdlib/source') 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) (~! .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) (~! .any)])) (` ((~ setter_name) [(~ g!value) (~! .any) (~ g!obj) (~! .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) - #1 - _ #0)]} + {} #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 ( [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)))] -- cgit v1.2.3