diff options
20 files changed, 243 insertions, 182 deletions
diff --git a/lux-bootstrapper/src/lux/analyser/case.clj b/lux-bootstrapper/src/lux/analyser/case.clj index 0f892a5ca..39adc09f5 100644 --- a/lux-bootstrapper/src/lux/analyser/case.clj +++ b/lux-bootstrapper/src/lux/analyser/case.clj @@ -336,7 +336,7 @@ (analyse-pattern var?? value-type ?member kont) (&/$Tuple ?members) - (|do [rec-members&rec-type (&&record/order-record ?members)] + (|do [rec-members&rec-type (&&record/order-record true ?members)] (|case rec-members&rec-type (&/$Some [rec-members rec-type]) (|do [must-infer? (&type/unknown? value-type) diff --git a/lux-bootstrapper/src/lux/analyser/lux.clj b/lux-bootstrapper/src/lux/analyser/lux.clj index 6b90dc31e..842ad22ef 100644 --- a/lux-bootstrapper/src/lux/analyser/lux.clj +++ b/lux-bootstrapper/src/lux/analyser/lux.clj @@ -265,7 +265,7 @@ (analyse-variant analyse (&/$Right exo-type) idx is-last? values))))) (defn analyse-record [analyse exo-type ?elems] - (|do [rec-members&rec-type (&&record/order-record ?elems)] + (|do [rec-members&rec-type (&&record/order-record false ?elems)] (|case rec-members&rec-type (&/$Some [rec-members rec-type]) (|case exo-type @@ -296,38 +296,30 @@ (&&/$def (&/T [r-module r-name]))))))) (defn ^:private analyse-local [analyse exo-type name] - (fn [state] - (|let [stack (&/get$ &/$scopes state) - no-binding? #(and (->> % (&/get$ &/$locals) (&/get$ &/$mappings) (&/|contains? name) not) - (->> % (&/get$ &/$captured) (&/get$ &/$mappings) (&/|contains? name) not)) - [inner outer] (&/|split-with no-binding? stack)] - (|case outer - (&/$End) - (&/run-state (|do [module-name &/get-module-name] - (analyse-global analyse exo-type module-name name)) - state) - - (&/$Item bottom-outer _) - (|let [scopes (&/|map #(&/get$ &/$name %) (&/|reverse inner)) - [=local inner*] (&/fold2 (fn [register+new-inner frame in-scope] - (|let [[register new-inner] register+new-inner - [register* frame*] (&&function/close-over in-scope name register frame)] - (&/T [register* (&/$Item frame* new-inner)]))) - (&/T [(&/|second (or (->> bottom-outer (&/get$ &/$locals) (&/get$ &/$mappings) (&/|get name)) - (->> bottom-outer (&/get$ &/$captured) (&/get$ &/$mappings) (&/|get name)))) - &/$End]) - (&/|reverse inner) scopes)] + (|do [local? (&&module/find_local name)] + (|case local? + (&/$None) + (|do [module-name &/get-module-name] + (analyse-global analyse exo-type module-name name)) + + (&/$Some [local inner outer]) + (|let [scopes (&/|map #(&/get$ &/$name %) inner) + [=local inner*] (&/fold2 (fn [register+new-inner frame in-scope] + (|let [[register new-inner] register+new-inner + [register* frame*] (&&function/close-over in-scope name register frame)] + (&/T [register* (&/$Item frame* new-inner)]))) + (&/T [local &/$End]) + inner scopes)] + (fn [state] ((|do [_ (&type/check exo-type (&&/expr-type* =local))] (return (&/|list =local))) - (&/set$ &/$scopes (&/|++ inner* outer) state))) - )))) + (&/set$ &/$scopes (&/|++ inner* outer) state))))))) (defn analyse-identifier [analyse exo-type ident] (|do [:let [[?module ?name] ident]] (if (= "" ?module) (analyse-local analyse exo-type ?name) - (analyse-global analyse exo-type ?module ?name)) - )) + (analyse-global analyse exo-type ?module ?name)))) (defn ^:private analyse-apply* [analyse exo-type fun-type ?args] (|case ?args diff --git a/lux-bootstrapper/src/lux/analyser/module.clj b/lux-bootstrapper/src/lux/analyser/module.clj index 8c3a83440..1cf3f6f4f 100644 --- a/lux-bootstrapper/src/lux/analyser/module.clj +++ b/lux-bootstrapper/src/lux/analyser/module.clj @@ -520,3 +520,19 @@ _ (&/fail-with-loc "[Analyser Error] Incorrect import syntax."))) + +(defn find_local [name] + (fn [state] + (|let [stack (&/get$ &/$scopes state) + no-binding? #(and (->> % (&/get$ &/$locals) (&/get$ &/$mappings) (&/|contains? name) not) + (->> % (&/get$ &/$captured) (&/get$ &/$mappings) (&/|contains? name) not)) + [inner outer] (&/|split-with no-binding? stack)] + (|case outer + (&/$End) + (return* state &/$None) + + (&/$Item bottom-outer _) + (let [local (&/|second (or (->> bottom-outer (&/get$ &/$locals) (&/get$ &/$mappings) (&/|get name)) + (->> bottom-outer (&/get$ &/$captured) (&/get$ &/$mappings) (&/|get name))))] + (return* state (&/$Some (&/T [local (&/|reverse inner) outer])))) + )))) diff --git a/lux-bootstrapper/src/lux/analyser/record.clj b/lux-bootstrapper/src/lux/analyser/record.clj index ecdee63f6..913de4a64 100644 --- a/lux-bootstrapper/src/lux/analyser/record.clj +++ b/lux-bootstrapper/src/lux/analyser/record.clj @@ -6,10 +6,26 @@ (lux.analyser [base :as &&] [module :as &&module]))) +(defn head_slot [slot0] + (|do [[module name] (&&/resolved-ident slot0) + _exported?&type&slots&_index (fn [lux] + (|case ((&&module/find-slot module name) lux) + (&/$Left error) + (&/$Right (&/T [lux &/$None])) + + (&/$Right [lux* output]) + (&/$Right (&/T [lux* (&/$Some output)]))))] + (return (|case _exported?&type&slots&_index + (&/$Some [_exported? type slots _index]) + (&/$Some (&/T [module slots type])) + + (&/$None) + &/$None)))) + ;; [Exports] (defn order-record "(-> (List Syntax) (Lux (Maybe (List Syntax))))" - [pairs] + [pattern_matching? pairs] (if (even? (&/|length pairs)) (let [pairs (&/|as-pairs pairs)] (|do [module&slot-group&slot-type (|case pairs @@ -18,20 +34,20 @@ (return (&/$Some (&/T [module &/$End &type/Any])))) (&/$Item [[_ (&/$Identifier slot0)] _] _) - (|do [[module name] (&&/resolved-ident slot0) - _exported?&type&slots&_index (fn [lux] - (|case ((&&module/find-slot module name) lux) - (&/$Left error) - (&/$Right (&/T [lux &/$None])) - - (&/$Right [lux* output]) - (&/$Right (&/T [lux* (&/$Some output)]))))] - (|case _exported?&type&slots&_index - (&/$Some [_exported? type slots _index]) - (return (&/$Some (&/T [module slots type]))) + (|case slot0 + ["" short0] + (if pattern_matching? + (return &/$None) + (|do [local? (&&module/find_local short0)] + (|case local? + (&/$None) + (head_slot slot0) - (&/$None) - (return &/$None))) + (&/$Some [local _inner _outer]) + (return &/$None)))) + + [module0 short0] + (head_slot slot0)) _ (return &/$None))] diff --git a/lux-jvm/source/luxc/lang/directive/jvm.lux b/lux-jvm/source/luxc/lang/directive/jvm.lux index 1d1c4c278..e22d9c427 100644 --- a/lux-jvm/source/luxc/lang/directive/jvm.lux +++ b/lux-jvm/source/luxc/lang/directive/jvm.lux @@ -1,6 +1,6 @@ (.module: [library - [lux {"-" Type static local} + [lux {"-" Type Primitive static local} ["[0]" ffi {"+" Inheritance Privacy State import:}] [abstract ["[0]" monad {"+" do}]] @@ -540,7 +540,7 @@ <type_vars> (as_is <anchor> <expression> <directive>)] (type: Handler' ... (generation.Handler jvm.Anchor (/.Bytecode Inst /.Label) jvm.Definition) - (-> extension.Symbol + (-> extension.Name (phase.Phase [(extension.Bundle <type_vars>) (generation.State <type_vars>)] Synthesis diff --git a/lux-jvm/source/luxc/lang/host/jvm/inst.lux b/lux-jvm/source/luxc/lang/host/jvm/inst.lux index 1384d1a73..597426143 100644 --- a/lux-jvm/source/luxc/lang/host/jvm/inst.lux +++ b/lux-jvm/source/luxc/lang/host/jvm/inst.lux @@ -1,6 +1,6 @@ (.module: [library - [lux {"-" Type int char try} + [lux {"-" Type Primitive int char try} ["[0]" ffi {"+" import: do_to}] [abstract [monad {"+" do}]] diff --git a/lux-jvm/source/luxc/lang/translation/jvm/case.lux b/lux-jvm/source/luxc/lang/translation/jvm/case.lux index 032b058df..1cded57dd 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/case.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/case.lux @@ -1,6 +1,6 @@ (.module: [library - [lux {"-" Type Label if let case} + [lux {"-" Type Label Primitive if let case} [abstract ["[0]" monad {"+" do}]] [control 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 a8becd813..c31d9b90b 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux @@ -1,6 +1,6 @@ (.module: [library - [lux {"-" Type Label primitive int char type} + [lux {"-" Type Label Primitive int char type} [ffi {"+" import:}] [abstract ["[0]" monad {"+" do}]] diff --git a/lux-jvm/source/luxc/lang/translation/jvm/function.lux b/lux-jvm/source/luxc/lang/translation/jvm/function.lux index 17a246833..441eac0f6 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/function.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/function.lux @@ -1,6 +1,6 @@ (.module: [library - [lux {"-" Type Label function} + [lux {"-" Type Label Primitive function} [abstract ["[0]" monad {"+" do}] ["[0]" enum]] diff --git a/lux-jvm/source/luxc/lang/translation/jvm/runtime.lux b/lux-jvm/source/luxc/lang/translation/jvm/runtime.lux index ae14639f0..58d07e663 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/runtime.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/runtime.lux @@ -1,6 +1,6 @@ (.module: [library - [lux {"-" Type Label try} + [lux {"-" Type Label Primitive try} [abstract [monad {"+" do}] ["[0]" enum]] diff --git a/lux-jvm/source/luxc/lang/translation/jvm/structure.lux b/lux-jvm/source/luxc/lang/translation/jvm/structure.lux index bccdf5ec0..81f3faaa8 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/structure.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/structure.lux @@ -1,6 +1,6 @@ (.module: [library - [lux {"-" Type} + [lux {"-" Type Primitive} ["[0]" ffi {"+" import:}] [abstract ["[0]" monad {"+" do}]] 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) diff --git a/stdlib/source/library/lux/target/jvm/reflection.lux b/stdlib/source/library/lux/target/jvm/reflection.lux index 0a40c6cee..a62754a24 100644 --- a/stdlib/source/library/lux/target/jvm/reflection.lux +++ b/stdlib/source/library/lux/target/jvm/reflection.lux @@ -1,6 +1,6 @@ (.module: [library - [lux {"-" type} + [lux {"-" Primitive type} ["[0]" ffi {"+" import:}] ["[0]" type] [abstract diff --git a/stdlib/source/library/lux/target/jvm/type/alias.lux b/stdlib/source/library/lux/target/jvm/type/alias.lux index 022315da8..8ab181c6c 100644 --- a/stdlib/source/library/lux/target/jvm/type/alias.lux +++ b/stdlib/source/library/lux/target/jvm/type/alias.lux @@ -1,6 +1,6 @@ (.module: [library - [lux {"-" Type int char type primitive} + [lux {"-" Type Primitive int char type} [abstract ["[0]" monad {"+" do}]] [control diff --git a/stdlib/source/library/lux/target/jvm/type/lux.lux b/stdlib/source/library/lux/target/jvm/type/lux.lux index d6ffa3fbd..a219d9ef2 100644 --- a/stdlib/source/library/lux/target/jvm/type/lux.lux +++ b/stdlib/source/library/lux/target/jvm/type/lux.lux @@ -1,6 +1,6 @@ (.module: [library - [lux {"-" int char type primitive} + [lux {"-" Primitive int char type} [abstract ["[0]" monad {"+" do}]] [control 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 c7339a509..03e7f2105 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 @@ -251,7 +251,7 @@ record_size,members,recordT (: (Operation (Maybe [Nat (List Code) Type])) (.case record {.#Some record} - (//structure.order record) + (//structure.order true record) {.#None} (in {.#None})))] 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 ae20d2c6f..0273dd26c 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 @@ -11,7 +11,7 @@ ["[0]" state]] [data ["[0]" product] - [text + ["[0]" text ("[1]#[0]" equivalence) ["%" format {"+" format}]] [collection ["[0]" list ("[1]#[0]" monad)] @@ -322,55 +322,76 @@ _ (# ///.monad in {.#None})))) +(def: (local_binding? name) + (-> Text (Meta Bit)) + (# meta.monad each + (list.any? (list.any? (|>> product.left (text#= name)))) + meta.locals)) + ... Lux already possesses the means to analyse tuples, so ... re-implementing the same functionality for records makes no sense. ... Records, thus, get transformed into tuples by ordering the elements. -(def: .public (order record) - (-> (List [Symbol Code]) (Operation (Maybe [Nat (List Code) Type]))) +(def: (order' head_k record) + (-> Symbol (List [Symbol Code]) (Operation (Maybe [Nat (List Code) Type]))) + (do [! ///.monad] + [slotH' (///extension.lifted + (do meta.monad + [head_k (meta.normal head_k)] + (meta.try (meta.slot head_k))))] + (case slotH' + {try.#Success [_ slot_set recordT]} + (do ! + [.let [size_record (list.size record) + size_ts (list.size slot_set)] + _ (if (n.= size_ts size_record) + (in []) + (/.except ..record_size_mismatch [size_ts size_record recordT record])) + .let [tuple_range (list.indices size_ts) + tag->idx (dictionary.of_list symbol.hash (list.zipped/2 slot_set tuple_range))] + idx->val (monad.mix ! + (function (_ [key val] idx->val) + (do ! + [key (///extension.lifted (meta.normal key))] + (case (dictionary.value key tag->idx) + {.#Some idx} + (if (dictionary.key? idx->val idx) + (/.except ..cannot_repeat_slot [key record]) + (in (dictionary.has idx val idx->val))) + + {.#None} + (/.except ..slot_does_not_belong_to_record [key recordT])))) + (: (Dictionary Nat Code) + (dictionary.empty n.hash)) + record) + .let [ordered_tuple (list#each (function (_ idx) + (maybe.trusted (dictionary.value idx idx->val))) + tuple_range)]] + (in {.#Some [size_ts ordered_tuple recordT]})) + + {try.#Failure error} + (in {.#None})))) + +(def: .public (order pattern_matching? record) + (-> Bit (List [Symbol Code]) (Operation (Maybe [Nat (List Code) Type]))) (case record ... empty_record = empty_tuple = unit/any = [] {.#End} (# ///.monad in {.#Some [0 (list) Any]}) {.#Item [head_k head_v] _} - (do [! ///.monad] - [slotH' (///extension.lifted - (do meta.monad - [head_k (meta.normal head_k)] - (meta.try (meta.slot head_k))))] - (case slotH' - {try.#Success [_ slot_set recordT]} - (do ! - [.let [size_record (list.size record) - size_ts (list.size slot_set)] - _ (if (n.= size_ts size_record) - (in []) - (/.except ..record_size_mismatch [size_ts size_record recordT record])) - .let [tuple_range (list.indices size_ts) - tag->idx (dictionary.of_list symbol.hash (list.zipped/2 slot_set tuple_range))] - idx->val (monad.mix ! - (function (_ [key val] idx->val) - (do ! - [key (///extension.lifted (meta.normal key))] - (case (dictionary.value key tag->idx) - {.#Some idx} - (if (dictionary.key? idx->val idx) - (/.except ..cannot_repeat_slot [key record]) - (in (dictionary.has idx val idx->val))) - - {.#None} - (/.except ..slot_does_not_belong_to_record [key recordT])))) - (: (Dictionary Nat Code) - (dictionary.empty n.hash)) - record) - .let [ordered_tuple (list#each (function (_ idx) - (maybe.trusted (dictionary.value idx idx->val))) - tuple_range)]] - (in {.#Some [size_ts ordered_tuple recordT]})) - - {try.#Failure error} - (in {.#None}))) - )) + (case head_k + ["" head_k'] + (if pattern_matching? + (# ///.monad in {.#None}) + (do ///.monad + [local_binding? (///extension.lifted + (local_binding? head_k'))] + (if local_binding? + (order' head_k record) + (in {.#None})))) + + _ + (order' head_k record)))) (def: .public (record archive analyse members) (-> Archive Phase (List Code) (Operation Analysis)) @@ -403,7 +424,7 @@ {.#Some slots} (do ! - [record_size,membersC,recordT (..order slots)] + [record_size,membersC,recordT (..order false slots)] (case record_size,membersC,recordT {.#None} (..product archive analyse members) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux index 2b2290cb3..9a1a9763d 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux @@ -1,6 +1,6 @@ (.module: [library - [lux {"-" Type Module primitive type char int} + [lux {"-" Type Module Primitive type char int} ["[0]" ffi {"+" import:}] ["[0]" meta] [abstract diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/value.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/value.lux index bdad01192..1f4d88c99 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/value.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/value.lux @@ -1,6 +1,6 @@ (.module: [library - [lux {"-" Type type} + [lux {"-" Type Primitive type} [target [jvm ["_" bytecode {"+" Bytecode}] diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux index 867fe04ed..932611eed 100644 --- a/stdlib/source/test/lux.lux +++ b/stdlib/source/test/lux.lux @@ -892,8 +892,8 @@ #right r])) (template: (!pair <left> <right>) - [[#left <left> - #right <right>]]) + [[..#left <left> + ..#right <right>]]) (def: for_case Test @@ -929,8 +929,8 @@ (/.case [expected_nat expected_int] [0 +0] true _ false) - (/.case [#left expected_nat #right expected_int] - [#left 0 #right +0] true + (/.case [..#left expected_nat ..#right expected_int] + [..#left 0 ..#right +0] true _ false) (/.case (: (Either Nat Int) {.#Left expected_nat}) {.#Left 0} true @@ -950,12 +950,12 @@ (/.^or "+0.5" "+1.25") true _ false))) (_.cover [/.^] - (/.case [#left expected_nat #right expected_int] + (/.case [..#left expected_nat ..#right expected_int] (/.^ (!pair 0 +0)) true _ false)) (_.cover [/.^@] (let [expected_pair (: (Pair Nat Int) - [#left expected_nat #right expected_int])] + [..#left expected_nat ..#right expected_int])] (/.case expected_pair (/.^@ actual_pair (/.^ (!pair actual_left actual_right))) (and (/.same? expected_pair actual_pair) @@ -963,7 +963,7 @@ (/.same? expected_int actual_right))))) (_.cover [/.^multi] (let [expected_pair (: (Pair Nat Int) - [#left expected_nat #right expected_int])] + [..#left expected_nat ..#right expected_int])] (and (/.case expected_pair (/.^multi (/.^ (!pair 0 actual_right)) [actual_right @@ -992,7 +992,7 @@ (_.cover [/.let] (and (/.let [actual_nat expected_nat] (/.same? expected_nat actual_nat)) - (/.let [[actual_left actual_right] [#left expected_nat #right expected_int]] + (/.let [[actual_left actual_right] [..#left expected_nat ..#right expected_int]] (and (/.same? expected_nat actual_left) (/.same? expected_int actual_right))))) ))) |