aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/lux/analyser/case.clj40
-rw-r--r--src/lux/analyser/env.clj27
-rw-r--r--src/lux/analyser/lux.clj8
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))
generated by cgit v1.2.3 (git 2.25.1) at 2024-09-17 23:54:48 +0000