From 565fe5a2e60ff3c6b612031d1c3bb89f330751da Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Thu, 30 Jun 2022 18:15:20 -0400 Subject: Moved ".../dictionary/plist" to ".../list/property". --- stdlib/source/library/lux.lux | 130 ++++++++++++++++----- .../source/library/lux/control/function/mutual.lux | 4 +- .../lux/data/collection/dictionary/plist.lux | 122 ------------------- .../library/lux/data/collection/list/property.lux | 122 +++++++++++++++++++ stdlib/source/library/lux/macro/context.lux | 11 +- stdlib/source/library/lux/macro/local.lux | 21 ++-- stdlib/source/library/lux/meta.lux | 25 ++-- stdlib/source/library/lux/meta/configuration.lux | 7 +- .../tool/compiler/language/lux/analysis/module.lux | 41 ++++--- .../tool/compiler/language/lux/analysis/scope.lux | 15 ++- stdlib/source/library/lux/type/check.lux | 22 ++-- 11 files changed, 291 insertions(+), 229 deletions(-) delete mode 100644 stdlib/source/library/lux/data/collection/dictionary/plist.lux create mode 100644 stdlib/source/library/lux/data/collection/list/property.lux (limited to 'stdlib/source/library') diff --git a/stdlib/source/library/lux.lux b/stdlib/source/library/lux.lux index 9b479ce35..439fb69e3 100644 --- a/stdlib/source/library/lux.lux +++ b/stdlib/source/library/lux.lux @@ -1526,33 +1526,33 @@ (failure "Wrong syntax for if")} tokens))) -(def' .private PList +(def' .private Property_List Type (All (_ a) ($' List (Tuple Text a)))) -(def' .private (plist#value k plist) +(def' .private (property#value k property_list) (All (_ a) - (-> Text ($' PList a) ($' Maybe a))) - ({{#Item [[k' v] plist']} + (-> Text ($' Property_List a) ($' Maybe a))) + ({{#Item [[k' v] property_list']} (if (text#= k k') {#Some v} - (plist#value k plist')) + (property#value k property_list')) {#End} {#None}} - plist)) + property_list)) -(def' .private (plist#with k v plist) +(def' .private (property#with k v property_list) (All (_ a) - (-> Text a ($' PList a) ($' PList a))) - ({{#Item [k' v'] plist'} + (-> Text a ($' Property_List a) ($' Property_List a))) + ({{#Item [k' v'] property_list'} (if (text#= k k') - (partial_list [k v] plist') - (partial_list [k' v'] (plist#with k v plist'))) + (partial_list [k v] property_list') + (partial_list [k' v'] (property#with k v property_list'))) {#End} (list [k v])} - plist)) + property_list)) (def' .private (global_symbol full_name state) (-> Symbol ($' Meta Symbol)) @@ -1574,11 +1574,11 @@ {#None} {#Left (all text#composite "Unknown definition: " (symbol#encoded full_name))}} - (plist#value name definitions)) + (property#value name definitions)) {#None} {#Left (all text#composite "Unknown module: " module " @ " (symbol#encoded full_name))}} - (plist#value module modules)))) + (property#value module modules)))) (def' .private (|List| expression) (-> Code Code) @@ -1711,8 +1711,8 @@ {#Slot _} {#Left (text#composite "Unknown definition: " (symbol#encoded name))}} definition)} - (plist#value expected_short definitions))} - (plist#value expected_module modules)))) + (property#value expected_short definitions))} + (property#value expected_module modules)))) (def' .private (global_value global lux) (-> Symbol ($' Meta ($' Maybe (Tuple Type Any)))) @@ -2354,9 +2354,9 @@ Text Text Text ($' Maybe Macro)) (do maybe#monad - [$module (plist#value module modules) + [$module (property#value module modules) gdef (let' [[..#module_hash _ ..#module_aliases _ ..#definitions bindings ..#imports _ ..#module_state _] ("lux type check" Module $module)] - (plist#value name bindings))] + (property#value name bindings))] ({{#Alias [r_module r_name]} (named_macro' modules current_module r_module r_name) @@ -2652,9 +2652,75 @@ (meta#in type)} type)) +(def' .private (with_quantification' body lux) + (-> ($' Meta Code) ($' Meta Code)) + (let' [[..#info info/pre + ..#source source/pre + ..#current_module current_module/pre + ..#modules modules/pre + ..#scopes scopes/pre + ..#type_context type_context/pre + ..#host host/pre + ..#seed seed/pre + ..#expected expected/pre + ..#location location/pre + ..#extensions extensions/pre + ..#scope_type_vars scope_type_vars/pre + ..#eval eval/pre] lux] + ({{..#Right [lux/post output]} + (let' [[..#info info/post + ..#source source/post + ..#current_module current_module/post + ..#modules modules/post + ..#scopes scopes/post + ..#type_context type_context/post + ..#host host/post + ..#seed seed/post + ..#expected expected/post + ..#location location/post + ..#extensions extensions/post + ..#scope_type_vars scope_type_vars/post + ..#eval eval/post] lux/post] + {..#Right [[..#info info/post + ..#source source/post + ..#current_module current_module/post + ..#modules modules/post + ..#scopes scopes/pre + ..#type_context type_context/post + ..#host host/post + ..#seed seed/post + ..#expected expected/post + ..#location location/post + ..#extensions extensions/post + ..#scope_type_vars scope_type_vars/post + ..#eval eval/post] + output]}) + + failure + failure} + (body [..#info info/pre + ..#source source/pre + ..#current_module current_module/pre + ..#modules modules/pre + ..#scopes (partial_list [#name (list) + #inner 0 + #locals [#counter 0 + #mappings (list [..quantification_level [.Nat ("lux type as" Nat -1)]])] + #captured [#counter 0 + #mappings (list)]] + scopes/pre) + ..#type_context type_context/pre + ..#host host/pre + ..#seed seed/pre + ..#expected expected/pre + ..#location location/pre + ..#extensions extensions/pre + ..#scope_type_vars scope_type_vars/pre + ..#eval eval/pre])))) + (def' .public type_literal Macro - (macro (_ tokens) + (macro (type_literal tokens) ({{#Item type {#End}} (do meta#monad [initialized_quantification? (function' [lux] {#Right [lux (initialized_quantification? lux)]})] @@ -2669,10 +2735,14 @@ _ (failure "The expansion of the type-syntax had to yield a single element.")} type+)) - (in (list (..quantified (` (..type_literal (~ type)))))))) + (do meta#monad + [it (with_quantification' + (one_expansion + (type_literal tokens)))] + (in (list (..quantified it)))))) _ - (failure (wrong_syntax_error [..prelude "type"]))} + (failure (wrong_syntax_error [..prelude "type_literal"]))} tokens))) (def' .public is @@ -3394,7 +3464,7 @@ ..#scopes scopes ..#type_context types ..#host host ..#seed seed ..#expected expected ..#location location ..#extensions extensions ..#scope_type_vars scope_type_vars ..#eval _eval] state] - (case (plist#value name modules) + (case (property#value name modules) {#Some module} {#Right state module} @@ -3410,7 +3480,7 @@ ..#definitions definitions ..#imports _ ..#module_state _] =module]] - (case (plist#value name definitions) + (case (property#value name definitions) {#Some {#Slot [exported type group index]}} (meta#in [index (list#each (function (_ slot) @@ -3442,7 +3512,7 @@ ..#definitions definitions ..#imports _ ..#module_state _] =module]] - (case (plist#value name definitions) + (case (property#value name definitions) {#Some {#Type [exported? {#Named _ _type} {#Right slots}]}} (case (interface_methods _type) {#Some members} @@ -3544,7 +3614,7 @@ (function (_ token) (case token (pattern [_ {#Form (list [_ {#Text "lux def"}] [_ {#Symbol ["" slot_name]}] value export_policy)}]) - (case (plist#value slot_name tag_mappings) + (case (property#value slot_name tag_mappings) {#Some tag} (in (list tag value)) @@ -3955,7 +4025,7 @@ ..#seed seed ..#expected expected ..#location location ..#extensions extensions ..#scope_type_vars scope_type_vars ..#eval _eval] [current_module modules])] - (case (plist#value module modules) + (case (property#value module modules) {#Some =module} (let [to_alias (list#each (is (-> [Text Global] (List Text)) @@ -4091,7 +4161,7 @@ ..#scopes scopes ..#type_context types ..#host host ..#seed seed ..#expected expected ..#location location ..#extensions extensions ..#scope_type_vars scope_type_vars ..#eval _eval] state] - (case (plist#value expected_module modules) + (case (property#value expected_module modules) {#None} {#None} @@ -4100,7 +4170,7 @@ ..#module_aliases _ ..#imports _ ..#module_state _]} - (case (plist#value expected_short definitions) + (case (property#value expected_short definitions) {#None} {#None} @@ -4801,7 +4871,7 @@ (case (parsed (andP (tupleP (someP bindingP)) (someP anyP)) tokens) {#Some [bindings bodies]} (loop (again [bindings bindings - map (is (PList (List Code)) + map (is (Property_List (List Code)) (list))]) (let [normal (is (-> Code (List Code)) (function (_ it) @@ -4821,7 +4891,7 @@ "Incorrect expansion in with_expansions" " | Binding: " (text#encoded var_name) " | Expression: " (code#encoded expr))))] - (again &rest (plist#with var_name expansion map))) + (again &rest (property#with var_name expansion map))) {#End} (at meta#monad #in (list#conjoint (list#each normal bodies)))))) diff --git a/stdlib/source/library/lux/control/function/mutual.lux b/stdlib/source/library/lux/control/function/mutual.lux index c6107b1a9..fb74ef01e 100644 --- a/stdlib/source/library/lux/control/function/mutual.lux +++ b/stdlib/source/library/lux/control/function/mutual.lux @@ -12,9 +12,7 @@ [text ["%" \\format (.only format)]] [collection - ["[0]" list (.use "[1]#[0]" functor)] - [dictionary - ["[0]" plist (.only PList)]]]] + ["[0]" list (.use "[1]#[0]" functor)]]] ["[0]" macro (.only) ["[0]" local] ["[0]" code (.only) diff --git a/stdlib/source/library/lux/data/collection/dictionary/plist.lux b/stdlib/source/library/lux/data/collection/dictionary/plist.lux deleted file mode 100644 index 2e6abd831..000000000 --- a/stdlib/source/library/lux/data/collection/dictionary/plist.lux +++ /dev/null @@ -1,122 +0,0 @@ -(.require - [library - [lux (.except has revised) - [abstract - [equivalence (.only Equivalence)] - [monoid (.only Monoid)]] - [control - ["[0]" maybe (.use "[1]#[0]" functor)]] - [data - ["[0]" product] - ["[0]" text (.use "[1]#[0]" equivalence)] - [collection - ["[0]" list (.use "[1]#[0]" functor mix)]]] - [math - [number - ["n" nat]]]]]) - -... https://en.wikipedia.org/wiki/Property_list -(type .public (PList a) - (List [Text a])) - -(def .public empty - PList - {.#End}) - -(def .public size - (All (_ a) (-> (PList a) Nat)) - list.size) - -(def .public empty? - (All (_ a) (-> (PList a) Bit)) - (|>> ..size (n.= 0))) - -(def .public (value key properties) - (All (_ a) (-> Text (PList a) (Maybe a))) - (case properties - {.#End} - {.#None} - - {.#Item [k' v'] properties'} - (if (text#= key k') - {.#Some v'} - (value key properties')))) - -(with_template [ ] - [(def .public - (All (_ a) (-> (PList a) (List ))) - (list#each ))] - - [keys Text product.left] - [values a product.right] - ) - -(def .public (contains? key properties) - (All (_ a) (-> Text (PList a) Bit)) - (case (..value key properties) - {.#Some _} - true - - {.#None} - false)) - -(def .public (has key val properties) - (All (_ a) (-> Text a (PList a) (PList a))) - (case properties - {.#End} - (list [key val]) - - {.#Item [k' v'] properties'} - (if (text#= key k') - {.#Item [key val] - properties'} - {.#Item [k' v'] - (has key val properties')}))) - -(def .public (revised key f properties) - (All (_ a) (-> Text (-> a a) (PList a) (PList a))) - (case properties - {.#End} - {.#End} - - {.#Item [k' v'] properties'} - (if (text#= key k') - {.#Item [k' (f v')] properties'} - {.#Item [k' v'] (revised key f properties')}))) - -(def .public (lacks key properties) - (All (_ a) (-> Text (PList a) (PList a))) - (case properties - {.#End} - properties - - {.#Item [k' v'] properties'} - (if (text#= key k') - properties' - {.#Item [k' v'] - (lacks key properties')}))) - -(def .public (equivalence (open "/#[0]")) - (All (_ a) (-> (Equivalence a) (Equivalence (PList a)))) - (implementation - (def (= reference subject) - (and (n.= (list.size reference) - (list.size subject)) - (list.every? (function (_ [key val]) - (|> reference - (..value key) - (maybe#each (/#= val)) - (maybe.else false))) - subject))))) - -(def .public monoid - (All (_ a) (Monoid (PList a))) - (implementation - (def identity - ..empty) - - (def (composite left right) - (list#mix (function (_ [key val] it) - (..has key val it)) - right - left)))) diff --git a/stdlib/source/library/lux/data/collection/list/property.lux b/stdlib/source/library/lux/data/collection/list/property.lux new file mode 100644 index 000000000..a4480dabb --- /dev/null +++ b/stdlib/source/library/lux/data/collection/list/property.lux @@ -0,0 +1,122 @@ +(.require + [library + [lux (.except List has revised) + [abstract + [equivalence (.only Equivalence)] + [monoid (.only Monoid)]] + [control + ["[0]" maybe (.use "[1]#[0]" functor)]] + [data + ["[0]" product] + ["[0]" text (.use "[1]#[0]" equivalence)] + [collection + ["[0]" list (.use "[1]#[0]" functor mix)]]] + [math + [number + ["n" nat]]]]]) + +... https://en.wikipedia.org/wiki/Property_list +(type .public (List a) + (.List [Text a])) + +(def .public empty + List + {.#End}) + +(def .public size + (All (_ a) (-> (List a) Nat)) + list.size) + +(def .public empty? + (All (_ a) (-> (List a) Bit)) + (|>> ..size (n.= 0))) + +(def .public (value key properties) + (All (_ a) (-> Text (List a) (Maybe a))) + (case properties + {.#End} + {.#None} + + {.#Item [k' v'] properties'} + (if (text#= key k') + {.#Some v'} + (value key properties')))) + +(with_template [ ] + [(def .public + (All (_ a) (-> (List a) (.List ))) + (list#each ))] + + [keys Text product.left] + [values a product.right] + ) + +(def .public (contains? key properties) + (All (_ a) (-> Text (List a) Bit)) + (case (..value key properties) + {.#Some _} + true + + {.#None} + false)) + +(def .public (has key val properties) + (All (_ a) (-> Text a (List a) (List a))) + (case properties + {.#End} + (list [key val]) + + {.#Item [k' v'] properties'} + (if (text#= key k') + {.#Item [key val] + properties'} + {.#Item [k' v'] + (has key val properties')}))) + +(def .public (revised key f properties) + (All (_ a) (-> Text (-> a a) (List a) (List a))) + (case properties + {.#End} + {.#End} + + {.#Item [k' v'] properties'} + (if (text#= key k') + {.#Item [k' (f v')] properties'} + {.#Item [k' v'] (revised key f properties')}))) + +(def .public (lacks key properties) + (All (_ a) (-> Text (List a) (List a))) + (case properties + {.#End} + properties + + {.#Item [k' v'] properties'} + (if (text#= key k') + properties' + {.#Item [k' v'] + (lacks key properties')}))) + +(def .public (equivalence (open "/#[0]")) + (All (_ a) (-> (Equivalence a) (Equivalence (List a)))) + (implementation + (def (= reference subject) + (and (n.= (list.size reference) + (list.size subject)) + (list.every? (function (_ [key val]) + (|> reference + (..value key) + (maybe#each (/#= val)) + (maybe.else false))) + subject))))) + +(def .public monoid + (All (_ a) (Monoid (List a))) + (implementation + (def identity + ..empty) + + (def (composite left right) + (list#mix (function (_ [key val] it) + (..has key val it)) + right + left)))) diff --git a/stdlib/source/library/lux/macro/context.lux b/stdlib/source/library/lux/macro/context.lux index 4b243e53a..b85f94af8 100644 --- a/stdlib/source/library/lux/macro/context.lux +++ b/stdlib/source/library/lux/macro/context.lux @@ -12,9 +12,8 @@ [data ["[0]" text (.use "[1]#[0]" equivalence monoid)] [collection - ["[0]" list] - [dictionary - ["[0]" plist (.only PList)]]]] + ["[0]" list (.only) + ["[0]" property]]]] [macro ["[0]" code ["?[1]" \\parser]]] @@ -98,11 +97,11 @@ _ it))) - on_globals (is (-> (PList Global) (PList Global)) - (plist.revised context on_global)) + on_globals (is (-> (property.List Global) (property.List Global)) + (property.revised context on_global)) on_module (is (-> Module Module) (revised .#definitions on_globals))] - {.#Right [(revised .#modules (plist.revised @ on_module) lux) + {.#Right [(revised .#modules (property.revised @ on_module) lux) []]}))) (.def (push' _ top) diff --git a/stdlib/source/library/lux/macro/local.lux b/stdlib/source/library/lux/macro/local.lux index ef15fbe10..29fa9820c 100644 --- a/stdlib/source/library/lux/macro/local.lux +++ b/stdlib/source/library/lux/macro/local.lux @@ -12,9 +12,8 @@ ["[0]" product] ["[0]" text] [collection - ["[0]" list (.use "[1]#[0]" functor)] - [dictionary - ["[0]" plist (.only PList)]]]]]] + ["[0]" list (.use "[1]#[0]" functor) + ["[0]" property]]]]]] ["[0]" // (.only) [syntax (.only syntax)] ["[0]" code (.only) @@ -38,11 +37,11 @@ (def (with_module name body) (All (_ a) (-> Text (-> Module (Try [Module a])) (Meta a))) (function (_ compiler) - (case (|> compiler (the .#modules) (plist.value name)) + (case (|> compiler (the .#modules) (property.value name)) {.#Some module} (case (body module) {try.#Success [module' output]} - {try.#Success [(revised .#modules (plist.has name module') compiler) + {try.#Success [(revised .#modules (property.has name module') compiler) output]} {try.#Failure error} @@ -56,11 +55,11 @@ (do meta.monad [[module_name definition_name] (meta.normal name) .let [definition (is Global {.#Definition [false .Macro macro]}) - add_macro! (is (-> (PList Global) (PList Global)) - (plist.has definition_name definition))]] + add_macro! (is (-> (property.List Global) (property.List Global)) + (property.has definition_name definition))]] (..with_module module_name (function (_ module) - (case (|> module (the .#definitions) (plist.value definition_name)) + (case (|> module (the .#definitions) (property.value definition_name)) {.#None} {try.#Success [(revised .#definitions add_macro! module) []]} @@ -72,11 +71,11 @@ (-> Symbol (Meta Any)) (do meta.monad [[module_name definition_name] (meta.normal name) - .let [lacks_macro! (is (-> (PList Global) (PList Global)) - (plist.lacks definition_name))]] + .let [lacks_macro! (is (-> (property.List Global) (property.List Global)) + (property.lacks definition_name))]] (..with_module module_name (function (_ module) - (case (|> module (the .#definitions) (plist.value definition_name)) + (case (|> module (the .#definitions) (property.value definition_name)) {.#Some _} {try.#Success [(revised .#definitions lacks_macro! module) []]} diff --git a/stdlib/source/library/lux/meta.lux b/stdlib/source/library/lux/meta.lux index 7d778190c..64d84a933 100644 --- a/stdlib/source/library/lux/meta.lux +++ b/stdlib/source/library/lux/meta.lux @@ -12,9 +12,8 @@ ["[0]" product] ["[0]" text (.use "[1]#[0]" monoid order)] [collection - ["[0]" list (.use "[1]#[0]" monoid monad)] - [dictionary - ["[0]" plist]]]] + ["[0]" list (.use "[1]#[0]" monoid monad) + ["[0]" property]]]] [macro ["^" pattern] ["[0]" code]] @@ -118,7 +117,7 @@ (def .public (module name) (-> Text (Meta Module)) (function (_ lux) - (case (plist.value name (the .#modules lux)) + (case (property.value name (the .#modules lux)) {.#Some module} {try.#Success [lux module]} @@ -175,12 +174,12 @@ (loop (again [module module name name]) (do maybe.monad - [$module (plist.value module modules) + [$module (property.value module modules) definition (is (Maybe Global) (|> $module (is Module) (the .#definitions) - (plist.value name)))] + (property.value name)))] (case definition {.#Alias [r_module r_name]} (again r_module r_name) @@ -211,7 +210,7 @@ (def .public (module_exists? module) (-> Text (Meta Bit)) (function (_ lux) - {try.#Success [lux (case (plist.value module (the .#modules lux)) + {try.#Success [lux (case (property.value module (the .#modules lux)) {.#Some _} #1 @@ -303,8 +302,8 @@ (do maybe.monad [(open "[0]") (|> lux (the .#modules) - (plist.value normal_module))] - (plist.value normal_short #definitions))) + (property.value normal_module))] + (property.value normal_short #definitions))) {.#Some definition} {try.#Success [lux definition]} @@ -317,7 +316,7 @@ {try.#Failure (all text#composite "Unknown definition: " (symbol#encoded name) text.new_line " Current module: " current_module text.new_line - (case (plist.value current_module (the .#modules lux)) + (case (property.value current_module (the .#modules lux)) {.#Some this_module} (let [candidates (|> lux (the .#modules) @@ -455,7 +454,7 @@ (def .public (globals module) (-> Text (Meta (List [Text Global]))) (function (_ lux) - (case (plist.value module (the .#modules lux)) + (case (property.value module (the .#modules lux)) {.#Some module} {try.#Success [lux (the .#definitions module)]} @@ -506,7 +505,7 @@ (do ..monad [.let [[module_name name] type_name] module (..module module_name)] - (case (plist.value name (the .#definitions module)) + (case (property.value name (the .#definitions module)) {.#Some {.#Type [exported? type labels]}} (case labels (^.or {.#Left labels} @@ -557,7 +556,7 @@ [.let [[module name] label_name] =module (..module module) this_module_name ..current_module_name] - (case (plist.value name (the .#definitions =module)) + (case (property.value name (the .#definitions =module)) {.#Some { [exported? type group idx]}} (if (or (text#= this_module_name module) exported?) diff --git a/stdlib/source/library/lux/meta/configuration.lux b/stdlib/source/library/lux/meta/configuration.lux index d0dea1e76..d1858ca56 100644 --- a/stdlib/source/library/lux/meta/configuration.lux +++ b/stdlib/source/library/lux/meta/configuration.lux @@ -15,9 +15,8 @@ ["%" \\format] ["<[1]>" \\parser (.only Parser)]] [collection - ["[0]" list (.use "[1]#[0]" functor mix)] - [dictionary - ["/" plist]]]] + ["[0]" list (.use "[1]#[0]" functor mix) + ["/" property]]]] [macro [syntax (.only syntax)] ["[0]" code (.only) @@ -26,7 +25,7 @@ [number (.only hex)]]]]) (type .public Configuration - (/.PList Text)) + (/.List Text)) (def .public equivalence (Equivalence Configuration) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/module.lux b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/module.lux index c86bdc9b5..d9ab4f4a1 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/module.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/module.lux @@ -11,9 +11,8 @@ ["[0]" text (.use "[1]#[0]" equivalence) ["%" \\format (.only format)]] [collection - ["[0]" list (.use "[1]#[0]" mix functor)] - [dictionary - ["[0]" plist]]]] + ["[0]" list (.use "[1]#[0]" mix functor) + ["[0]" property]]]] ["[0]" meta]]] ["/" // (.only Operation) ["//[1]" // @@ -84,11 +83,11 @@ [self_name meta.current_module_name] (function (_ state) {try.#Success [(revised .#modules - (plist.revised self_name (revised .#imports (function (_ current) - (if (list.any? (text#= module) - current) - current - {.#Item module current})))) + (property.revised self_name (revised .#imports (function (_ current) + (if (list.any? (text#= module) + current) + current + {.#Item module current})))) state) []]})))) @@ -99,8 +98,8 @@ [self_name meta.current_module_name] (function (_ state) {try.#Success [(revised .#modules - (plist.revised self_name (revised .#module_aliases (is (-> (List [Text Text]) (List [Text Text])) - (|>> {.#Item [alias module]})))) + (property.revised self_name (revised .#module_aliases (is (-> (List [Text Text]) (List [Text Text])) + (|>> {.#Item [alias module]})))) state) []]})))) @@ -110,7 +109,7 @@ (function (_ state) (|> state (the .#modules) - (plist.value module) + (property.value module) (pipe.case {.#Some _} #1 {.#None} #0) [state] {try.#Success})))) @@ -122,14 +121,14 @@ [self_name meta.current_module_name self meta.current_module] (function (_ state) - (case (plist.value name (the .#definitions self)) + (case (property.value name (the .#definitions self)) {.#None} {try.#Success [(revised .#modules - (plist.has self_name - (revised .#definitions - (is (-> (List [Text Global]) (List [Text Global])) - (|>> {.#Item [name definition]})) - self)) + (property.has self_name + (revised .#definitions + (is (-> (List [Text Global]) (List [Text Global])) + (|>> {.#Item [name definition]})) + self)) state) []]} @@ -142,7 +141,7 @@ (///extension.lifted (function (_ state) {try.#Success [(revised .#modules - (plist.has name (..empty hash)) + (property.has name (..empty hash)) state) []]}))) @@ -160,14 +159,14 @@ (-> Text (Operation Any)) (///extension.lifted (function (_ state) - (case (|> state (the .#modules) (plist.value module_name)) + (case (|> state (the .#modules) (property.value module_name)) {.#Some module} (let [active? (case (the .#module_state module) {.#Active} #1 _ #0)] (if active? {try.#Success [(revised .#modules - (plist.has module_name (has .#module_state {} module)) + (property.has module_name (has .#module_state {} module)) state) []]} ((///extension.up (/.except ..can_only_change_state_of_active_module [module_name {}])) @@ -181,7 +180,7 @@ (-> Text (Operation Bit)) (///extension.lifted (function (_ state) - (case (|> state (the .#modules) (plist.value module_name)) + (case (|> state (the .#modules) (property.value module_name)) {.#Some module} {try.#Success [state (case (the .#module_state module) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/scope.lux b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/scope.lux index 8832c4b7e..538874881 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/scope.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/scope.lux @@ -11,9 +11,8 @@ ["[0]" text (.use "[1]#[0]" equivalence)] ["[0]" product] [collection - ["[0]" list (.use "[1]#[0]" functor mix monoid)] - [dictionary - ["[0]" plist]]]]]] + ["[0]" list (.use "[1]#[0]" functor mix monoid) + ["[0]" property]]]]]] ["/" // (.only Environment Operation Phase) [// [phase @@ -33,13 +32,13 @@ (-> Text Scope Bit) (|> scope (the [.#locals .#mappings]) - (plist.contains? name))) + (property.contains? name))) (def (local name scope) (-> Text Scope (Maybe [Type Variable])) (|> scope (the [.#locals .#mappings]) - (plist.value name) + (property.value name) (maybe#each (function (_ [type value]) [type {variable.#Local value}])))) @@ -47,7 +46,7 @@ (-> Text Scope Bit) (|> scope (the [.#captured .#mappings]) - (plist.contains? name))) + (property.contains? name))) (def (captured name scope) (-> Text Scope (Maybe [Type Variable])) @@ -96,7 +95,7 @@ {.#Item (revised .#captured (is (-> Foreign Foreign) (|>> (revised .#counter ++) - (revised .#mappings (plist.has name [ref_type (product.left ref+inner)])))) + (revised .#mappings (property.has name [ref_type (product.left ref+inner)])))) scope) (product.right ref+inner)}])) [init_ref {.#End}] @@ -119,7 +118,7 @@ new_head (revised .#locals (is (-> Local Local) (|>> (revised .#counter ++) - (revised .#mappings (plist.has name [type new_var_id])))) + (revised .#mappings (property.has name [type new_var_id])))) head)] (case (phase.result' [bundle (has .#scopes {.#Item new_head tail} state)] action) diff --git a/stdlib/source/library/lux/type/check.lux b/stdlib/source/library/lux/type/check.lux index 527292c47..cb49cc6e4 100644 --- a/stdlib/source/library/lux/type/check.lux +++ b/stdlib/source/library/lux/type/check.lux @@ -134,35 +134,35 @@ (use "check#[0]" ..monad) -(def (var::new id plist) +(def (var::new id property_list) (-> Var Type_Vars Type_Vars) - {.#Item [id {.#None}] plist}) + {.#Item [id {.#None}] property_list}) -(def (var::get id plist) +(def (var::get id property_list) (-> Var Type_Vars (Maybe (Maybe Type))) - (case plist + (case property_list {.#Item [var_id var_type] - plist'} + property_list'} (if (!n#= id var_id) {.#Some var_type} - (var::get id plist')) + (var::get id property_list')) {.#End} {.#None})) -(def (var::put id value plist) +(def (var::put id value property_list) (-> Var (Maybe Type) Type_Vars Type_Vars) - (case plist + (case property_list {.#End} (list [id value]) {.#Item [var_id var_type] - plist'} + property_list'} (if (!n#= id var_id) {.#Item [var_id value] - plist'} + property_list'} {.#Item [var_id var_type] - (var::put id value plist')}))) + (var::put id value property_list')}))) (def .public (result context proc) (All (_ a) (-> Type_Context (Check a) (Try a))) -- cgit v1.2.3