- Added local var aliasing.

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))