git.iko.soy/elk
on master help sign in
Add info on alternate ctors to every pattern in canonicalization
bac53deEvan Czaplicki
src/AST/Canonical.hs+47−1
compare with master
unifiedsplit
@@ -8,6 +8,10 @@ module AST.Canonical
8 , TypedArg(..)
8 , TypedArg(..)
9 -- patterns
9 -- patterns
10 , Pattern, Pattern_(..)
10 , Pattern, Pattern_(..)
11+ , CtorAlts(..)
12+ , CtorAlt(..)
13+ , toAlts
14+ , ctorsToAlts
11 , PatternCtorArg(..)
15 , PatternCtorArg(..)
12 , Destructors
16 , Destructors
13 , Destructor(..)
17 , Destructor(..)
@@ -126,11 +130,47 @@ data Pattern_
126 { _p_home :: ModuleName.Canonical
130 { _p_home :: ModuleName.Canonical
127 , _p_type :: N.Name
131 , _p_type :: N.Name
128 , _p_vars :: [N.Name]
132 , _p_vars :: [N.Name]
133+ , _p_alts :: CtorAlts
129 , _p_name :: N.Name
134 , _p_name :: N.Name
130 , _p_args :: [PatternCtorArg]
135 , _p_args :: [PatternCtorArg]
131 }
136 }
132
137
133
138
139+
140+-- PATTERN CTORS
141+
142+
143+data CtorAlts =
144+ CtorAlts
145+ { _num :: Int -- result of (length _alts) to amortize O(n) cost
146+ , _alts :: [CtorAlt]
147+ }
148+ deriving (Eq)
149+
150+
151+data CtorAlt =
152+ CtorAlt
153+ { _ctor :: N.Name
154+ , _arity :: Int
155+ }
156+ deriving (Eq)
157+
158+
159+toAlts :: [CtorAlt] -> CtorAlts
160+toAlts alts =
161+ CtorAlts (length alts) alts
162+
163+
164+ctorsToAlts :: [(N.Name, [Type])] -> CtorAlts
165+ctorsToAlts ctors =
166+ CtorAlts (length ctors) (map toAlt ctors)
167+
168+
169+toAlt :: (N.Name, [Type]) -> CtorAlt
170+toAlt (ctor, argTypes) =
171+ CtorAlt ctor (length argTypes)
172+
173+
134data PatternCtorArg =
174data PatternCtorArg =
135 PatternCtorArg
175 PatternCtorArg
136 { _index :: Index.ZeroBased
176 { _index :: Index.ZeroBased
@@ -139,7 +179,13 @@ data PatternCtorArg =
139 }
179 }
140
180
141
181
182+
183+-- DESTRUCTORS
184+
185+
186+type Destructors =
142−type Destructors = Map.Map N.Name (A.Located Destructor)
187+ Map.Map N.Name (A.Located Destructor)
188+
143
189
144data Destructor
190data Destructor
145 = DIndex Index.ZeroBased Destructor
191 = DIndex Index.ZeroBased Destructor
src/Canonicalize/Environment/Foreign.hs+4−1
@@ -177,8 +177,11 @@ toPatternInfo _ pattern =
177toPatterns :: ModuleName.Canonical -> (N.Name, Can.Union) -> [(N.Name, Env.Pattern)]
177toPatterns :: ModuleName.Canonical -> (N.Name, Can.Union) -> [(N.Name, Env.Pattern)]
178toPatterns home (tipe, Can.Union vars ctors) =
178toPatterns home (tipe, Can.Union vars ctors) =
179 let
179 let
180+ alts =
181+ Can.ctorsToAlts ctors
182+
180 fromCtor (name, args) =
183 fromCtor (name, args) =
181− (name, Env.Pattern home tipe vars args)
184+ (name, Env.Pattern home tipe vars alts args)
182 in
185 in
183 map fromCtor ctors
186 map fromCtor ctors
184
187
src/Canonicalize/Environment/Internals.hs+1
@@ -104,6 +104,7 @@ data Pattern =
104 { _p_home :: ModuleName.Canonical
104 { _p_home :: ModuleName.Canonical
105 , _p_type :: N.Name
105 , _p_type :: N.Name
106 , _p_vars :: [N.Name]
106 , _p_vars :: [N.Name]
107+ , _p_alts :: Can.CtorAlts
107 , _p_args :: [Can.Type]
108 , _p_args :: [Can.Type]
108 }
109 }
109
110
src/Canonicalize/Environment/Local.hs+3−3
@@ -86,10 +86,10 @@ addPatterns unions (Env.Env home vars types patterns binops) =
86 Map.fromList $ concatMap toPatterns (Map.toList unions)
86 Map.fromList $ concatMap toPatterns (Map.toList unions)
87
87
88 toPatterns (tipe, Can.Union tvars ctors) =
88 toPatterns (tipe, Can.Union tvars ctors) =
89− map (ctorToPattern tipe tvars) ctors
89+ map (ctorToPattern tipe tvars (Can.ctorsToAlts ctors)) ctors
90
90
91− ctorToPattern tipe tvars (name, args) =
91+ ctorToPattern tipe tvars alts (name, args) =
92− ( name, Env.Pattern home tipe tvars args )
92+ ( name, Env.Pattern home tipe tvars alts args )
93 in
93 in
94 let
94 let
95 newPatterns =
95 newPatterns =
src/Canonicalize/Pattern.hs+2−2
@@ -102,11 +102,11 @@ process env destructor (A.At region pattern) =
102 Can.PatternCtorArg index tipe
102 Can.PatternCtorArg index tipe
103 <$> process env (Can.DIndex index destructor) ptrn
103 <$> process env (Can.DIndex index destructor) ptrn
104 in
104 in
105− do (Env.Pattern home tipe vars args) <- Env.findPattern nameRegion env maybePrefix name
105+ do (Env.Pattern home tipe vars alts args) <- Env.findPattern nameRegion env maybePrefix name
106 verifiedList <- Index.indexedZipWithA toCanonicalArg patterns args
106 verifiedList <- Index.indexedZipWithA toCanonicalArg patterns args
107 case verifiedList of
107 case verifiedList of
108 Index.LengthMatch cargs ->
108 Index.LengthMatch cargs ->
109− Result.ok $ Can.PCtor home tipe vars name cargs
109+ Result.ok $ Can.PCtor home tipe vars alts name cargs
110
110
111 Index.LengthMismatch actualLength expectedLength ->
111 Index.LengthMismatch actualLength expectedLength ->
112 Result.throw region (error "TODO" actualLength expectedLength)
112 Result.throw region (error "TODO" actualLength expectedLength)
src/Type/Constrain/Pattern.hs+1−1
@@ -61,7 +61,7 @@ add (A.At region pattern) expectation state =
61 Can.PTuple a b maybeC ->
61 Can.PTuple a b maybeC ->
62 addTuple region a b maybeC expectation state
62 addTuple region a b maybeC expectation state
63
63
64− Can.PCtor home typeName typeVars ctorName args ->
64+ Can.PCtor home typeName typeVars _ ctorName args ->
65 addCtor region home typeName typeVars ctorName args expectation state
65 addCtor region home typeName typeVars ctorName args expectation state
66
66
67 Can.PList patterns ->
67 Can.PList patterns ->