aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/analyser
diff options
context:
space:
mode:
authorEduardo Julian2017-05-30 19:42:20 -0400
committerEduardo Julian2017-05-30 19:42:20 -0400
commitbbf78668e9ae2fb3deb78217ae97791df89ada56 (patch)
treeb6767b688d87c820d80fc8c54b0a352142d0fcbe /new-luxc/source/luxc/analyser
parent953f49d5a46209f2d75e67b50edea378261108cd (diff)
- Some refactoring.
Diffstat (limited to 'new-luxc/source/luxc/analyser')
-rw-r--r--new-luxc/source/luxc/analyser/case.lux57
-rw-r--r--new-luxc/source/luxc/analyser/structure.lux21
2 files changed, 38 insertions, 40 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