diff options
| -rw-r--r-- | src/lux/analyser/case.clj | 40 | ||||
| -rw-r--r-- | src/lux/analyser/env.clj | 27 | ||||
| -rw-r--r-- | src/lux/analyser/lux.clj | 8 |
3 files changed, 56 insertions, 19 deletions
diff --git a/src/lux/analyser/case.clj b/src/lux/analyser/case.clj index f19a33acc..9fc10231f 100644 --- a/src/lux/analyser/case.clj +++ b/src/lux/analyser/case.clj @@ -119,15 +119,23 @@ "(-> Type (Lux Type))" (adjust-type* &/Nil$ type)) -(defn ^:private analyse-pattern [value-type pattern kont] +(defn ^:private analyse-pattern [var?? value-type pattern kont] (|let [[meta pattern*] pattern] (|case pattern* (&/$SymbolS "" name) - (|do [=kont (&env/with-local name value-type - kont) - idx &env/next-local-idx] - (return (&/T (&/V $StoreTestAC idx) =kont))) - + (|case var?? + (&/$Some var-analysis) + (|do [=kont (&env/with-alias name var-analysis + kont) + idx &env/next-local-idx] + (return (&/T (&/V $StoreTestAC idx) =kont))) + + _ + (|do [=kont (&env/with-local name value-type + kont) + idx &env/next-local-idx] + (return (&/T (&/V $StoreTestAC idx) =kont)))) + (&/$SymbolS ident) (fail (str "[Pattern-matching Error] Symbols must be unqualified: " (&/ident->text ident))) @@ -164,7 +172,7 @@ (fail (str "[Pattern-matching Error] Pattern-matching mismatch. Require tuple[" (&/|length ?member-types) "]. Given tuple [" (&/|length ?members) "]" " -- " (&/show-ast pattern))) (|do [[=tests =kont] (&/fold (fn [kont* vm] (|let [[v m] vm] - (|do [[=test [=tests =kont]] (analyse-pattern v m kont*)] + (|do [[=test [=tests =kont]] (analyse-pattern &/None$ v m kont*)] (return (&/T (&/Cons$ =test =tests) =kont))))) (|do [=kont kont] (return (&/T &/Nil$ =kont))) @@ -176,7 +184,7 @@ (&/$RecordS pairs) (|do [[rec-members rec-type] (&&record/order-record pairs)] - (analyse-pattern value-type (&/T meta (&/V &/$TupleS rec-members)) kont)) + (analyse-pattern &/None$ value-type (&/T meta (&/V &/$TupleS rec-members)) kont)) (&/$TagS ?ident) (|do [[=module =name] (&&/resolved-ident ?ident) @@ -184,7 +192,7 @@ idx (&module/tag-index =module =name) group (&module/tag-group =module =name) case-type (&type/variant-case idx value-type*) - [=test =kont] (analyse-pattern case-type unit kont)] + [=test =kont] (analyse-pattern &/None$ case-type unit kont)] (return (&/T (&/V $VariantTestAC (&/T idx (&/|length group) =test)) =kont))) (&/$FormS (&/$Cons [_ (&/$TagS ?ident)] @@ -195,18 +203,18 @@ group (&module/tag-group =module =name) case-type (&type/variant-case idx value-type*) [=test =kont] (case (int (&/|length ?values)) - 0 (analyse-pattern case-type unit kont) - 1 (analyse-pattern case-type (&/|head ?values) kont) + 0 (analyse-pattern &/None$ case-type unit kont) + 1 (analyse-pattern &/None$ case-type (&/|head ?values) kont) ;; 1+ - (analyse-pattern case-type (&/T (&/T "" -1 -1) (&/V &/$TupleS ?values)) kont))] + (analyse-pattern &/None$ case-type (&/T (&/T "" -1 -1) (&/V &/$TupleS ?values)) kont))] (return (&/T (&/V $VariantTestAC (&/T idx (&/|length group) =test)) =kont))) _ (fail (str "[Pattern-matching Error] Unrecognized pattern syntax: " (&/show-ast pattern))) ))) -(defn ^:private analyse-branch [analyse exo-type value-type pattern body patterns] - (|do [pattern+body (analyse-pattern value-type pattern +(defn ^:private analyse-branch [analyse exo-type var?? value-type pattern body patterns] + (|do [pattern+body (analyse-pattern var?? value-type pattern (&&/analyse-1 analyse exo-type body))] (return (&/Cons$ pattern+body patterns)))) @@ -361,10 +369,10 @@ )) ;; [Exports] -(defn analyse-branches [analyse exo-type value-type branches] +(defn analyse-branches [analyse exo-type var?? value-type branches] (|do [patterns (&/fold% (fn [patterns branch] (|let [[pattern body] branch] - (analyse-branch analyse exo-type value-type pattern body patterns))) + (analyse-branch analyse exo-type var?? value-type pattern body patterns))) &/Nil$ branches) struct (&/fold% merge-total (&/V $DefaultTotal false) patterns) diff --git a/src/lux/analyser/env.clj b/src/lux/analyser/env.clj index 81397a3f6..04dce90db 100644 --- a/src/lux/analyser/env.clj +++ b/src/lux/analyser/env.clj @@ -19,10 +19,10 @@ (let [old-mappings (->> state (&/get$ &/$envs) &/|head (&/get$ &/$locals) (&/get$ &/$mappings)) =return (body (&/update$ &/$envs (fn [stack] - (let [bound-unit (&/V &&/$var (&/V &/$Local (->> (&/|head stack) (&/get$ &/$locals) (&/get$ &/$counter))))] + (let [var-analysis (&&/|meta type &/empty-cursor (&/V &&/$var (&/V &/$Local (->> (&/|head stack) (&/get$ &/$locals) (&/get$ &/$counter)))))] (&/Cons$ (&/update$ &/$locals #(->> % (&/update$ &/$counter inc) - (&/update$ &/$mappings (fn [m] (&/|put name (&&/|meta type &/empty-cursor bound-unit) m)))) + (&/update$ &/$mappings (fn [m] (&/|put name var-analysis m)))) (&/|head stack)) (&/|tail stack)))) state))] @@ -40,6 +40,29 @@ _ =return)))) +(defn with-alias [name var-analysis body] + (fn [state] + (let [old-mappings (->> state (&/get$ &/$envs) &/|head (&/get$ &/$locals) (&/get$ &/$mappings)) + =return (body (&/update$ &/$envs + (fn [stack] + (&/Cons$ (&/update$ &/$locals #(->> % + (&/update$ &/$mappings (fn [m] (&/|put name var-analysis m)))) + (&/|head stack)) + (&/|tail stack))) + state))] + (|case =return + (&/$Right ?state ?value) + (return* (&/update$ &/$envs (fn [stack*] + (&/Cons$ (&/update$ &/$locals #(->> % + (&/set$ &/$mappings old-mappings)) + (&/|head stack*)) + (&/|tail stack*))) + ?state) + ?value) + + _ + =return)))) + (def captured-vars (fn [state] (return* state (->> state (&/get$ &/$envs) &/|head (&/get$ &/$closure) (&/get$ &/$mappings))))) diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj index 6d7551ac0..0c76998c6 100644 --- a/src/lux/analyser/lux.clj +++ b/src/lux/analyser/lux.clj @@ -372,7 +372,13 @@ _ (&/assert! (> num-branches 0) "[Analyser Error] Can't have empty branches in \"case'\" expression.") _ (&/assert! (even? num-branches) "[Analyser Error] Unbalanced branches in \"case'\" expression.") =value (&&/analyse-1+ analyse ?value) - =match (&&case/analyse-branches analyse exo-type (&&/expr-type* =value) (&/|as-pairs ?branches)) + :let [var?? (|case =value + [_ (&&/$var =var-kind)] + (&/Some$ =value) + + _ + &/None$)] + =match (&&case/analyse-branches analyse exo-type var?? (&&/expr-type* =value) (&/|as-pairs ?branches)) _cursor &/cursor] (return (&/|list (&&/|meta exo-type _cursor (&/V &&/$case (&/T =value =match)) |