git.iko.soy/elk
on dfaef18 help sign in
elk/src/Canonicalize/Pattern.hs
221 lines 6.8 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2module Canonicalize.Pattern
3 ( canonicalizeArgs
4 , canonicalizeMatch
5 , canonicalizeBindings
6 , Binding(..)
7 )
8 where
11import Control.Monad (zipWithM)
12import qualified Data.Map.Strict as Map
14import qualified AST.Expression.Canonical as Can
15import qualified AST.Expression.Source as Src
16import qualified AST.Expression.Valid as Valid
17import qualified AST.Type as Type
18import qualified Canonicalize.Environment as Env
19import qualified Canonicalize.Environment.Dups as Dups
20import qualified Data.Bag as Bag
21import qualified Elm.Name as N
22import qualified Reporting.Annotation as A
23import qualified Reporting.Error.Canonicalize as Error
24import qualified Reporting.Region as R
25import qualified Reporting.Result as Result
26import qualified Reporting.Warning as Warning
30-- RESULTS
33type Result i =
34 Result.Result i Warning.Warning Error.Error
38-- CANONICALIZE ARGS
41canonicalizeArgs :: Env.Env -> [Src.Pattern] -> Result () Can.Args
42canonicalizeArgs env patterns =
43 case zipWithM (canonicalizeArg env) patterns [ 0 .. length patterns ] of
44 Result.Result bag warnings (Result.Ok args) ->
45 do let toError name () () = Error.DuplicateArg name
46 destructors <- Dups.detect toError (Bag.toList bag)
47 Result.Result () warnings $ Result.Ok $
48 Can.Args args destructors
50 Result.Result _ warnings (Result.Err err) ->
51 Result.Result () warnings (Result.Err err)
54canonicalizeArg :: Env.Env -> Src.Pattern -> Int -> Result Bag Can.Arg
55canonicalizeArg env pattern index =
56 Can.Arg index <$> canonicalize env (Can.DRoot index) pattern
60-- CANONICALIZE MATCH
63canonicalizeMatch :: Env.Env -> Src.Pattern -> Result () Can.Match
64canonicalizeMatch env pattern =
65 case canonicalize env (Can.DRoot 0) pattern of
66 Result.Result bag warnings (Result.Ok cpattern) ->
67 do let toError name () () = Error.DuplicateArg name
68 destructors <- Dups.detect toError (Bag.toList bag)
69 Result.Result () warnings $ Result.Ok $
70 Can.Match cpattern destructors
72 Result.Result _ warnings (Result.Err err) ->
73 Result.Result () warnings (Result.Err err)
77-- CANONICALIZE BINDINGS
80data Binding
81 = Define R.Region Int (A.Located N.Name) [Src.Pattern] Valid.Expr (Maybe Type.Raw)
82 | Destruct R.Region Int Can.Match Valid.Expr
85canonicalizeBindings :: Env.Env -> [Valid.Def] -> Result () ( [Binding], Map.Map N.Name (A.Located Int) )
86canonicalizeBindings env defs =
87 case zipWithM (canonicalizeBinding env) defs [ 0 .. length defs ] of
88 Result.Result bag warnings (Result.Ok cdefs) ->
89 do let toError name () () = Error.DuplicateBindingName name
90 nodes <- Dups.detect toError (Bag.toList bag)
91 Result.Result () warnings (Result.Ok (cdefs, nodes))
93 Result.Result _ warnings (Result.Err err) ->
94 Result.Result () warnings (Result.Err err)
97type KeyBag =
98 Bag.Bag ( N.Name, [Dups.Info () (A.Located Int)] )
101canonicalizeBinding :: Env.Env -> Valid.Def -> Int -> Result KeyBag Binding
102canonicalizeBinding env def index =
103 case def of
104 Valid.Define region aname@(A.A reg name) args body maybeType ->
105 let info = Dups.info name reg () (A.A region index) in
106 Result.accumulate (Bag.one info) $
107 Define region index aname args body maybeType
109 Valid.Destruct region pattern body ->
110 case canonicalize env (Can.DRoot 0) pattern of
111 Result.Result bag warnings (Result.Ok cpattern) ->
112 do let toError name () () = Error.DuplicateBindingName name
113 destructors <- Result.untracked (Dups.detect toError (Bag.toList bag))
114 Result.Result (toKeyBag index bag) warnings $ Result.Ok $
115 Destruct region index (Can.Match cpattern destructors) body
117 Result.Result bag warnings (Result.Err err) ->
118 Result.Result (toKeyBag index bag) warnings (Result.Err err)
121toKeyBag :: Int -> Bag -> KeyBag
122toKeyBag index bag =
123 let
124 redoInfo (Dups.Info region () _) =
125 Dups.Info region () (A.A region index)
127 replaceWithIndex ( name, infos ) =
128 ( name, map redoInfo infos )
129 in
130 Bag.map replaceWithIndex bag
134-- CANONICALIZE
137type Bag =
138 Bag.Bag (N.Name, [Dups.Info () (A.Located Can.Destructor)])
141canonicalize :: Env.Env -> Can.Destructor -> Src.Pattern -> Result Bag Can.Pattern
142canonicalize env destructor (A.A region pattern) =
143 A.A region <$>
144 case pattern of
145 Src.PAnything ->
146 Result.ok Can.PAnything
148 Src.PVar name ->
149 Result.accumulate
150 (Bag.one (Dups.info name region () (A.A region destructor)))
151 (Can.PVar name)
153 Src.PRecord fields ->
154 let
155 fieldToInfo (A.A reg name) =
156 Dups.info name reg () (A.A reg (Can.DField name destructor))
157 in
158 Result.accumulate
159 (Bag.fromList fieldToInfo fields)
160 (Can.PRecord (map A.drop fields))
162 Src.PUnit ->
163 Result.ok Can.PUnit
165 Src.PTuple a b cs ->
166 Can.PTuple
167 <$> canonicalize env (Can.DIndex 0 destructor) a
168 <*> canonicalize env (Can.DIndex 1 destructor) b
169 <*> canonicalizeTuple region env destructor cs
171 Src.PCtor nameRegion maybePrefix name patterns ->
172 let
173 ctorArg ptrn index =
174 canonicalize env (Can.DIndex index destructor) ptrn
175 in
176 Can.PCtor
177 <$> Env.findPattern nameRegion env maybePrefix name (length patterns)
178 <*> pure name
179 <*> zipWithM ctorArg patterns [ 0 .. length patterns ]
181 Src.PList patterns ->
182 Can.PList <$> canonicalizeList env destructor patterns
184 Src.PCons first rest ->
185 Can.PCons
186 <$> canonicalize env (Can.DIndex 0 destructor) first
187 <*> canonicalize env (Can.DIndex 1 destructor) rest
189 Src.PAlias ptrn (A.A reg name) ->
190 do cpattern <- canonicalize env destructor ptrn
191 let info = Dups.info name reg () (A.A reg destructor)
192 Result.accumulate (Bag.one info) (Can.PAlias cpattern name)
194 Src.PLiteral lit ->
195 Result.ok (Can.PLiteral lit)
198canonicalizeTuple :: R.Region -> Env.Env -> Can.Destructor -> [Src.Pattern] -> Result Bag (Maybe Can.Pattern)
199canonicalizeTuple tupleRegion env destructor extras =
200 case extras of
201 [] ->
202 Result.ok Nothing
204 [three] ->
205 Just <$> canonicalize env (Can.DIndex 2 destructor) three
207 _ : others ->
208 let (A.A r1 _, A.A r2 _) = (head others, last others) in
209 Result.throw tupleRegion (Error.TupleLargerThanThree (R.merge r1 r2))
212canonicalizeList :: Env.Env -> Can.Destructor -> [Src.Pattern] -> Result Bag [Can.Pattern]
213canonicalizeList env destructor list =
214 case list of
215 [] ->
216 Result.ok []
218 pattern : otherPatterns ->
219 (:)
220 <$> canonicalize env (Can.DIndex 0 destructor) pattern
221 <*> canonicalizeList env (Can.DIndex 1 destructor) otherPatterns