aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--new-luxc/source/luxc/analyser/case.lux57
-rw-r--r--new-luxc/source/luxc/analyser/structure.lux21
-rw-r--r--new-luxc/source/luxc/lang/analysis.lux18
-rw-r--r--new-luxc/source/luxc/lang/pattern.lux14
4 files changed, 52 insertions, 58 deletions
diff --git a/new-luxc/source/luxc/analyser/case.lux b/new-luxc/source/luxc/analyser/case.lux
index d5c84b7bf..f3eec6b6b 100644
--- a/new-luxc/source/luxc/analyser/case.lux
+++ b/new-luxc/source/luxc/analyser/case.lux
@@ -16,8 +16,7 @@
[type]
(type ["TC" check]))
(luxc ["&" base]
- (lang ["la" analysis #+ Analysis]
- ["lp" pattern #+ Pattern])
+ (lang ["la" analysis])
["&;" env]
(analyser ["&;" common]
["&;" structure])))
@@ -62,7 +61,7 @@
(:: Monad<Lux> wrap type)))
(def: (analyse-pattern num-tags inputT pattern next)
- (All [a] (-> (Maybe Nat) Type Code (Lux a) (Lux [Pattern a])))
+ (All [a] (-> (Maybe Nat) Type Code (Lux a) (Lux [la;Pattern a])))
(case pattern
[cursor (#;Symbol ["" name])]
(&;with-cursor cursor
@@ -70,7 +69,7 @@
[outputA (&env;with-local [name inputT]
next)
idx &env;next-local]
- (wrap [(#lp;Bind idx) outputA])))
+ (wrap [(#la;BindP idx) outputA])))
[cursor (#;Symbol ident)]
(&;with-cursor cursor
@@ -84,13 +83,13 @@
(TC;check inputT <type>))
outputA next]
(wrap [(<pattern-tag> test) outputA]))))
- ([Bool #;Bool #lp;Bool]
- [Nat #;Nat #lp;Nat]
- [Int #;Int #lp;Int]
- [Deg #;Deg #lp;Deg]
- [Real #;Real #lp;Real]
- [Char #;Char #lp;Char]
- [Text #;Text #lp;Text])
+ ([Bool #;Bool #la;BoolP]
+ [Nat #;Nat #la;NatP]
+ [Int #;Int #la;IntP]
+ [Deg #;Deg #la;DegP]
+ [Real #;Real #la;RealP]
+ [Char #;Char #la;CharP]
+ [Text #;Text #la;TextP])
(^ [cursor (#;Tuple (list))])
(&;with-cursor cursor
@@ -98,7 +97,7 @@
[_ (&;within-type-env
(TC;check inputT Unit))
outputA next]
- (wrap [(#lp;Tuple (list)) outputA])))
+ (wrap [(#la;TupleP (list)) outputA])))
(^ [cursor (#;Tuple (list singleton))])
(analyse-pattern #;None inputT singleton next)
@@ -126,11 +125,11 @@
)]
(do @
[[memberP+ thenA] (L/fold (: (All [a]
- (-> [Type Code] (Lux [(List Pattern) a])
- (Lux [(List Pattern) a])))
+ (-> [Type Code] (Lux [(List la;Pattern) a])
+ (Lux [(List la;Pattern) a])))
(function [[memberT memberC] then]
(do @
- [[memberP [memberP+ thenA]] ((:! (All [a] (-> (Maybe Nat) Type Code (Lux a) (Lux [Pattern a])))
+ [[memberP [memberP+ thenA]] ((:! (All [a] (-> (Maybe Nat) Type Code (Lux a) (Lux [la;Pattern a])))
analyse-pattern)
#;None memberT memberC then)]
(wrap [(list& memberP memberP+) thenA]))))
@@ -138,7 +137,7 @@
[nextA next]
(wrap [(list) nextA]))
matches)]
- (wrap [(#lp;Tuple memberP+) thenA])))
+ (wrap [(#la;TupleP memberP+) thenA])))
_
(&;fail (pattern-error inputT pattern))
@@ -175,11 +174,11 @@
(type;variant (list;drop (n.dec num-cases) flat-sum))
(` [(~@ values)])
next)]
- (wrap [(#lp;Variant idx num-cases testP)
+ (wrap [(#la;VariantP idx num-cases testP)
nextA]))
(do Monad<Lux>
[[testP nextA] (analyse-pattern #;None case-type (` [(~@ values)]) next)]
- (wrap [(#lp;Variant idx num-cases testP)
+ (wrap [(#la;VariantP idx num-cases testP)
nextA])))
_
@@ -202,7 +201,7 @@
))
(def: (analyse-branch analyse inputT pattern body)
- (-> &;Analyser Type Code Code (Lux [Pattern Analysis]))
+ (-> &;Analyser Type Code Code (Lux [la;Pattern la;Analysis]))
(analyse-pattern #;None inputT pattern (analyse body)))
(do-template [<name> <tag>]
@@ -220,22 +219,22 @@
)
(def: (determine-coverage pattern)
- (-> Pattern Coverage)
+ (-> la;Pattern Coverage)
(case pattern
- (^or (#lp;Bind _) (^ (#lp;Tuple (list))))
+ (^or (#la;BindP _) (^ (#la;TupleP (list))))
#TotalC
- (^ (#lp;Tuple (list singleton)))
+ (^ (#la;TupleP (list singleton)))
(determine-coverage singleton)
- (#lp;Bool value)
+ (#la;BoolP value)
(#BoolC value)
- (^or (#lp;Nat _) (#lp;Int _) (#lp;Deg _)
- (#lp;Real _) (#lp;Char _) (#lp;Text _))
+ (^or (#la;NatP _) (#la;IntP _) (#la;DegP _)
+ (#la;RealP _) (#la;CharP _) (#la;TextP _))
#PartialC
- (#lp;Tuple subs)
+ (#la;TupleP subs)
(loop [subs subs]
(case subs
#;Nil
@@ -248,7 +247,7 @@
(#SeqC (determine-coverage sub)
post)))))
- (#lp;Variant tag-id num-tags sub)
+ (#la;VariantP tag-id num-tags sub)
(#VariantC num-tags
(|> (D;new number;Hash<Nat>)
(D;put tag-id (determine-coverage sub))))))
@@ -432,11 +431,11 @@
(R/wrap (#AltC so-far addition)))))
(def: get-coverage
- (-> [Pattern Analysis] Coverage)
+ (-> [la;Pattern la;Analysis] Coverage)
(|>. product;left determine-coverage))
(def: #export (analyse-case analyse input branches)
- (-> &;Analyser Code (List [Code Code]) (Lux Analysis))
+ (-> &;Analyser Code (List [Code Code]) (Lux la;Analysis))
(case branches
#;Nil
(&;fail "Cannot have empty branches in pattern-matching expression.")
diff --git a/new-luxc/source/luxc/analyser/structure.lux b/new-luxc/source/luxc/analyser/structure.lux
index ab6f6adae..9447ea059 100644
--- a/new-luxc/source/luxc/analyser/structure.lux
+++ b/new-luxc/source/luxc/analyser/structure.lux
@@ -18,8 +18,7 @@
[type]
(type ["TC" check]))
(luxc ["&" base]
- (lang ["la" analysis #+ Analysis]
- ["lp" pattern])
+ (lang ["la" analysis])
["&;" module]
["&;" env]
(analyser ["&;" common]
@@ -27,7 +26,7 @@
## [Analysers]
(def: (analyse-typed-product analyse members)
- (-> &;Analyser (List Code) (Lux Analysis))
+ (-> &;Analyser (List Code) (Lux la;Analysis))
(do Monad<Lux>
[expected macro;expected-type]
(loop [expected expected
@@ -109,7 +108,7 @@
(:: Monad<Lux> wrap [(list) Unit])))
(def: (tuple members)
- (-> (List Analysis) Analysis)
+ (-> (List la;Analysis) la;Analysis)
(case members
#;Nil
#la;Unit
@@ -121,7 +120,7 @@
(#la;Product left (tuple right))))
(def: #export (analyse-product analyse membersC)
- (-> &;Analyser (List Code) (Lux Analysis))
+ (-> &;Analyser (List Code) (Lux la;Analysis))
(do Monad<Lux>
[expected macro;expected-type]
(&;with-stacked-errors
@@ -244,7 +243,7 @@
(&;fail (format "Not a variant type: " (%type type)))))
(def: #export (analyse-record analyse members)
- (-> &;Analyser (List [Code Code]) (Lux Analysis))
+ (-> &;Analyser (List [Code Code]) (Lux la;Analysis))
(do Monad<Lux>
[members (normalize-record members)
[members recordT] (order-record members)
@@ -257,14 +256,14 @@
(do-template [<name> <side>]
[(def: (<name> inner)
- (-> Analysis Analysis)
+ (-> la;Analysis la;Analysis)
(#la;Sum (<side> inner)))]
[sum-left #;Left]
[sum-right #;Right])
(def: (variant tag size temp value)
- (-> Nat Nat Nat Analysis Analysis)
+ (-> Nat Nat Nat la;Analysis la;Analysis)
(if (n.= (n.dec size) tag)
(if (n.= +1 tag)
(sum-right value)
@@ -274,7 +273,7 @@
(L/fold (function;const sum-left)
(case value
(#la;Sum _)
- (#la;Case value (list [(#lp;Bind temp)
+ (#la;Case value (list [(#la;BindP temp)
(#la;Relative (#;Local temp))]))
_
@@ -282,7 +281,7 @@
(list;n.range +0 tag))))
(def: #export (analyse-tagged-sum analyse tag value)
- (-> &;Analyser Ident Code (Lux Analysis))
+ (-> &;Analyser Ident Code (Lux la;Analysis))
(do Monad<Lux>
[tag (macro;normalize tag)
[idx group variantT] (macro;resolve-tag tag)
@@ -296,7 +295,7 @@
(wrap (variant idx case-size temp (|> valueA+ list;head assume)))))
(def: #export (analyse-sum analyse tag valueC)
- (-> &;Analyser Nat Code (Lux Analysis))
+ (-> &;Analyser Nat Code (Lux la;Analysis))
(do Monad<Lux>
[expected macro;expected-type]
(&;with-stacked-errors
diff --git a/new-luxc/source/luxc/lang/analysis.lux b/new-luxc/source/luxc/lang/analysis.lux
index 3cd63b65f..b96bd9ba2 100644
--- a/new-luxc/source/luxc/lang/analysis.lux
+++ b/new-luxc/source/luxc/lang/analysis.lux
@@ -1,7 +1,17 @@
(;module:
- lux
- (lux (data [product]))
- (.. ["lp" pattern]))
+ lux)
+
+(type: #export #rec Pattern
+ (#BindP Nat)
+ (#BoolP Bool)
+ (#NatP Nat)
+ (#IntP Int)
+ (#DegP Deg)
+ (#RealP Real)
+ (#CharP Char)
+ (#TextP Text)
+ (#TupleP (List Pattern))
+ (#VariantP Nat Nat Pattern))
(type: #export #rec Analysis
#Unit
@@ -14,7 +24,7 @@
(#Text Text)
(#Sum (Either Analysis Analysis))
(#Product Analysis Analysis)
- (#Case Analysis (List [lp;Pattern Analysis]))
+ (#Case Analysis (List [Pattern Analysis]))
(#Function Scope Analysis)
(#Apply Analysis Analysis)
(#Procedure Text (List Analysis))
diff --git a/new-luxc/source/luxc/lang/pattern.lux b/new-luxc/source/luxc/lang/pattern.lux
deleted file mode 100644
index 0b51e6284..000000000
--- a/new-luxc/source/luxc/lang/pattern.lux
+++ /dev/null
@@ -1,14 +0,0 @@
-(;module:
- lux)
-
-(type: #export #rec Pattern
- (#Bind Nat)
- (#Bool Bool)
- (#Nat Nat)
- (#Int Int)
- (#Deg Deg)
- (#Real Real)
- (#Char Char)
- (#Text Text)
- (#Tuple (List Pattern))
- (#Variant Nat Nat Pattern))
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-06 02:23:19 +0000