From 86c04a4ce3be995edf14ae7f3bf1e137d478c40e Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 15 Sep 2021 01:52:03 -0400 Subject: Correctly analyzing records in the presence of local bindings. --- stdlib/source/library/lux.lux | 170 +++++++++++++++++++++++------------------- 1 file changed, 93 insertions(+), 77 deletions(-) (limited to 'stdlib/source/library/lux.lux') diff --git a/stdlib/source/library/lux.lux b/stdlib/source/library/lux.lux index ad9fcc8d8..d154f0826 100644 --- a/stdlib/source/library/lux.lux +++ b/stdlib/source/library/lux.lux @@ -1046,15 +1046,15 @@ (def:'' .private (initialized_quantification? lux) {#Function Lux Bit} - ({[#info _ #source _ #current_module _ #modules _ - #scopes scopes #type_context _ #host _ - #seed _ #expected _ #location _ #extensions _ - #scope_type_vars _ #eval _] + ({[..#info _ ..#source _ ..#current_module _ ..#modules _ + ..#scopes scopes ..#type_context _ ..#host _ + ..#seed _ ..#expected _ ..#location _ ..#extensions _ + ..#scope_type_vars _ ..#eval _] (list#mix (function'' [scope verdict] ({#1 #1 - _ ({[#name _ #inner _ #captured _ - #locals [#counter _ - #mappings locals]] + _ ({[..#name _ ..#inner _ ..#captured _ + ..#locals [..#counter _ + ..#mappings locals]] (list#mix (function'' [local verdict] ({[local _] ({#1 #1 _ ("lux text =" ..quantification_level local)} @@ -1449,7 +1449,7 @@ (-> a ($' m b)) ($' List a) ($' m ($' List b)))) - (let' [[#in in #then _] m] + (let' [[..#in in ..#then _] m] ({{#End} (in {#End}) @@ -1467,7 +1467,7 @@ b ($' List a) ($' m b))) - (let' [[#in in #then _] m] + (let' [[..#in in ..#then _] m] ({{#End} (in y) @@ -1517,11 +1517,11 @@ (def:''' .private (global_symbol full_name state) (-> Symbol ($' Meta Symbol)) (let' [[module name] full_name - [#info info #source source #current_module _ #modules modules - #scopes scopes #type_context types #host host - #seed seed #expected expected #location location #extensions extensions - #scope_type_vars scope_type_vars #eval _eval] state] - ({{#Some [#module_hash _ #module_aliases _ #definitions definitions #imports _ #module_state _]} + [..#info info ..#source source ..#current_module _ ..#modules modules + ..#scopes scopes ..#type_context types ..#host host + ..#seed seed ..#expected expected ..#location location ..#extensions extensions + ..#scope_type_vars scope_type_vars ..#eval _eval] state] + ({{#Some [..#module_hash _ ..#module_aliases _ ..#definitions definitions ..#imports _ ..#module_state _]} ({{#Some constant} ({{#Definition _} {#Right [state full_name]} {#Tag _} {#Right [state full_name]} @@ -1673,10 +1673,10 @@ (def:'' .private (current_module_name state) ($' Meta Text) - ({[#info info #source source #current_module current_module #modules modules - #scopes scopes #type_context types #host host - #seed seed #expected expected #location location #extensions extensions - #scope_type_vars scope_type_vars #eval _eval] + ({[..#info info ..#source source ..#current_module current_module ..#modules modules + ..#scopes scopes ..#type_context types ..#host host + ..#seed seed ..#expected expected ..#location location ..#extensions extensions + ..#scope_type_vars scope_type_vars ..#eval _eval] ({{#Some module_name} {#Right [state module_name]} @@ -1982,7 +1982,7 @@ ($' Maybe Macro)) (do maybe_monad [$module (plist#value module modules) - gdef (let' [[#module_hash _ #module_aliases _ #definitions bindings #imports _ #module_state _] ("lux type check" Module $module)] + gdef (let' [[..#module_hash _ ..#module_aliases _ ..#definitions bindings ..#imports _ ..#module_state _] ("lux type check" Module $module)] (plist#value name bindings))] ({{#Alias [r_module r_name]} (macro'' modules current_module r_module r_name) @@ -2023,11 +2023,11 @@ [current_module current_module_name] (let' [[module name] full_name] (function' [state] - ({[#info info #source source #current_module _ #modules modules - #scopes scopes #type_context types #host host - #seed seed #expected expected - #location location #extensions extensions - #scope_type_vars scope_type_vars #eval _eval] + ({[..#info info ..#source source ..#current_module _ ..#modules modules + ..#scopes scopes ..#type_context types ..#host host + ..#seed seed ..#expected expected + ..#location location ..#extensions extensions + ..#scope_type_vars scope_type_vars ..#eval _eval] {#Right state (macro'' modules current_module module name)}} state))))) @@ -2281,16 +2281,16 @@ (def:''' .private (generated_symbol prefix state) (-> Text ($' Meta Code)) - ({[#info info #source source #current_module _ #modules modules - #scopes scopes #type_context types #host host - #seed seed #expected expected - #location location #extensions extensions - #scope_type_vars scope_type_vars #eval _eval] - {#Right [#info info #source source #current_module _ #modules modules - #scopes scopes #type_context types #host host - #seed ("lux i64 +" 1 seed) #expected expected - #location location #extensions extensions - #scope_type_vars scope_type_vars #eval _eval] + ({[..#info info ..#source source ..#current_module _ ..#modules modules + ..#scopes scopes ..#type_context types ..#host host + ..#seed seed ..#expected expected + ..#location location ..#extensions extensions + ..#scope_type_vars scope_type_vars ..#eval _eval] + {#Right [..#info info ..#source source ..#current_module _ ..#modules modules + ..#scopes scopes ..#type_context types ..#host host + ..#seed ("lux i64 +" 1 seed) ..#expected expected + ..#location location ..#extensions extensions + ..#scope_type_vars scope_type_vars ..#eval _eval] (local_symbol$ ($_ text#composite "__gensym__" prefix (nat#encoded seed)))}} state)) @@ -2849,10 +2849,10 @@ (def: (module name) (-> Text (Meta Module)) (function (_ state) - (let [[#info info #source source #current_module _ #modules modules - #scopes scopes #type_context types #host host - #seed seed #expected expected #location location #extensions extensions - #scope_type_vars scope_type_vars #eval _eval] state] + (let [[..#info info ..#source source ..#current_module _ ..#modules modules + ..#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) {#Some module} {#Right state module} @@ -2864,7 +2864,11 @@ (-> Symbol (Meta [Nat (List Symbol) Bit Type])) (do meta_monad [=module (..module module) - .let [[#module_hash _ #module_aliases _ #definitions definitions #imports _ #module_state _] =module]] + .let [[..#module_hash _ + ..#module_aliases _ + ..#definitions definitions + ..#imports _ + ..#module_state _] =module]] (case (plist#value name definitions) {#Some {#Slot [exported type group index]}} (in_meta [index @@ -2892,7 +2896,11 @@ {#Named [module name] unnamed} (do meta_monad [=module (..module module) - .let [[#module_hash _ #module_aliases _ #definitions definitions #imports _ #module_state _] =module]] + .let [[..#module_hash _ + ..#module_aliases _ + ..#definitions definitions + ..#imports _ + ..#module_state _] =module]] (case (plist#value name definitions) {#Some {#Type [exported? {#Named _ _type} {#Right slots}]}} (case (interface_methods _type) @@ -2913,10 +2921,10 @@ (def: expected_type (Meta Type) (function (_ state) - (let [[#info info #source source #current_module _ #modules modules - #scopes scopes #type_context types #host host - #seed seed #expected expected #location location #extensions extensions - #scope_type_vars scope_type_vars #eval _eval] state] + (let [[..#info info ..#source source ..#current_module _ ..#modules modules + ..#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 expected {#Some type} {#Right state type} @@ -3512,10 +3520,10 @@ (def: (exported_definitions module state) (-> Text (Meta (List Text))) (let [[current_module modules] (case state - [#info info #source source #current_module current_module #modules modules - #scopes scopes #type_context types #host host - #seed seed #expected expected #location location #extensions extensions - #scope_type_vars scope_type_vars #eval _eval] + [..#info info ..#source source ..#current_module current_module ..#modules modules + ..#scopes scopes ..#type_context types ..#host host + ..#seed seed ..#expected expected ..#location location ..#extensions extensions + ..#scope_type_vars scope_type_vars ..#eval _eval] [current_module modules])] (case (plist#value module modules) {#Some =module} @@ -3541,7 +3549,7 @@ {#Slot _} (list)))) - (let [[#module_hash _ #module_aliases _ #definitions definitions #imports _ #module_state _] =module] + (let [[..#module_hash _ ..#module_aliases _ ..#definitions definitions ..#imports _ ..#module_state _] =module] definitions))] {#Right state (list#conjoint to_alias)}) @@ -3592,17 +3600,17 @@ (def: (in_env name state) (-> Text Lux (Maybe Type)) (case state - [#info info #source source #current_module _ #modules modules - #scopes scopes #type_context types #host host - #seed seed #expected expected #location location #extensions extensions - #scope_type_vars scope_type_vars #eval _eval] + [..#info info ..#source source ..#current_module _ ..#modules modules + ..#scopes scopes ..#type_context types ..#host host + ..#seed seed ..#expected expected ..#location location ..#extensions extensions + ..#scope_type_vars scope_type_vars ..#eval _eval] (list#one (: (-> Scope (Maybe Type)) (function (_ env) (case env - [#name _ - #inner _ - #locals [#counter _ #mappings locals] - #captured [#counter _ #mappings closure]] + [..#name _ + ..#inner _ + ..#locals [..#counter _ ..#mappings locals] + ..#captured [..#counter _ ..#mappings closure]] (on_either (list#one (: (-> [Text [Type Any]] (Maybe Type)) (function (_ [bname [type _]]) (if (text#= name bname) @@ -3615,15 +3623,19 @@ (def: (definition_type name state) (-> Symbol Lux (Maybe Type)) (let [[v_module v_name] name - [#info info #source source #current_module _ #modules modules - #scopes scopes #type_context types #host host - #seed seed #expected expected #location location #extensions extensions - #scope_type_vars scope_type_vars #eval _eval] state] + [..#info info ..#source source ..#current_module _ ..#modules modules + ..#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 v_module modules) {#None} {#None} - {#Some [#definitions definitions #module_hash _ #module_aliases _ #imports _ #module_state _]} + {#Some [..#definitions definitions + ..#module_hash _ + ..#module_aliases _ + ..#imports _ + ..#module_state _]} (case (plist#value v_name definitions) {#None} {#None} @@ -3648,15 +3660,19 @@ (def: (definition_value name state) (-> Symbol (Meta [Type Any])) (let [[v_module v_name] name - [#info info #source source #current_module _ #modules modules - #scopes scopes #type_context types #host host - #seed seed #expected expected #location location #extensions extensions - #scope_type_vars scope_type_vars #eval _eval] state] + [..#info info ..#source source ..#current_module _ ..#modules modules + ..#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 v_module modules) {#None} {#Left (text#composite "Unknown definition: " (symbol#encoded name))} - {#Some [#definitions definitions #module_hash _ #module_aliases _ #imports _ #module_state _]} + {#Some [..#definitions definitions + ..#module_hash _ + ..#module_aliases _ + ..#imports _ + ..#module_state _]} (case (plist#value v_name definitions) {#None} {#Left (text#composite "Unknown definition: " (symbol#encoded name))} @@ -3715,11 +3731,11 @@ {#Left ($_ text#composite "Unknown var: " (symbol#encoded full_name))}))] (case temp {#Right [compiler {#Var type_id}]} - (let [[#info _ #source _ #current_module _ #modules _ - #scopes _ #type_context type_context #host _ - #seed _ #expected _ #location _ #extensions extensions - #scope_type_vars _ #eval _eval] compiler - [#ex_counter _ #var_counter _ #var_bindings var_bindings] type_context] + (let [[..#info _ ..#source _ ..#current_module _ ..#modules _ + ..#scopes _ ..#type_context type_context ..#host _ + ..#seed _ ..#expected _ ..#location _ ..#extensions extensions + ..#scope_type_vars _ ..#eval _eval] compiler + [..#ex_counter _ ..#var_counter _ ..#var_bindings var_bindings] type_context] (case (type_variable type_id var_bindings) {#None} temp @@ -3946,7 +3962,7 @@ (-> Text Text (Meta Bit)) (do meta_monad [module (module module_name) - .let [[#module_hash _ #module_aliases _ #definitions _ #imports imports #module_state _] module]] + .let [[..#module_hash _ ..#module_aliases _ ..#definitions _ ..#imports imports ..#module_state _] module]] (in (is_member? imports import_name)))) (def: (referrals module_name options) @@ -4572,10 +4588,10 @@ (def: (scope_type_vars state) (Meta (List Nat)) (case state - [#info info #source source #current_module _ #modules modules - #scopes scopes #type_context types #host host - #seed seed #expected expected #location location #extensions extensions - #scope_type_vars scope_type_vars #eval _eval] + [..#info info ..#source source ..#current_module _ ..#modules modules + ..#scopes scopes ..#type_context types ..#host host + ..#seed seed ..#expected expected ..#location location ..#extensions extensions + ..#scope_type_vars scope_type_vars ..#eval _eval] {#Right [state scope_type_vars]})) (macro: .public (:parameter tokens) -- cgit v1.2.3