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. --- lux-bootstrapper/src/lux/analyser/case.clj | 2 +- lux-bootstrapper/src/lux/analyser/lux.clj | 44 ++++++++++++---------------- lux-bootstrapper/src/lux/analyser/module.clj | 16 ++++++++++ lux-bootstrapper/src/lux/analyser/record.clj | 44 +++++++++++++++++++--------- 4 files changed, 65 insertions(+), 41 deletions(-) (limited to 'lux-bootstrapper') 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))] -- cgit v1.2.3