git.iko.soy/elk
on master help sign in
Update canonicalizer for Reporting.Annotation simplification
2e0bedaEvan Czaplicki
src/Canonicalize/Effects.hs+3−3
compare with master
unifiedsplit
@@ -77,7 +77,7 @@ canonicalize env decls unions effects =
77
77
78
78
79canonicalizePort :: Env.Env -> Valid.Port -> Result (N.Name, Can.Port)
79canonicalizePort :: Env.Env -> Valid.Port -> Result (N.Name, Can.Port)
80−canonicalizePort env (Valid.Port (A.A region portName) tipe) =
80+canonicalizePort env (Valid.Port (A.At region portName) tipe) =
81 do ctipe <- Type.canonicalize env tipe
81 do ctipe <- Type.canonicalize env tipe
82 case Type.deepDealias ctipe of
82 case Type.deepDealias ctipe of
83 Can.TLambda outgoingType (Can.TType home name [Can.TVar _])
83 Can.TLambda outgoingType (Can.TType home name [Can.TVar _])
@@ -107,7 +107,7 @@ canonicalizePort env (Valid.Port (A.A region portName) tipe) =
107
107
108
108
109verifyEffectType :: A.Located N.Name -> Map.Map N.Name a -> Result N.Name
109verifyEffectType :: A.Located N.Name -> Map.Map N.Name a -> Result N.Name
110−verifyEffectType (A.A region name) unions =
110+verifyEffectType (A.At region name) unions =
111 if Map.member name unions then
111 if Map.member name unions then
112 Result.ok name
112 Result.ok name
113 else
113 else
@@ -115,7 +115,7 @@ verifyEffectType (A.A region name) unions =
115
115
116
116
117toNameRegion :: A.Located Valid.Decl -> (N.Name, R.Region)
117toNameRegion :: A.Located Valid.Decl -> (N.Name, R.Region)
118−toNameRegion (A.A _ (Valid.Decl (A.A region name) _ _ _)) =
118+toNameRegion (A.At _ (Valid.Decl (A.At region name) _ _ _)) =
119 (name, region)
119 (name, region)
120
120
121
121
src/Canonicalize/Environment/Dups.hs+1−1
@@ -99,7 +99,7 @@ detectHelp toError name values =
99checkFields :: [(A.Located N.Name, a)] -> Result () (Map.Map N.Name a)
99checkFields :: [(A.Located N.Name, a)] -> Result () (Map.Map N.Name a)
100checkFields fields =
100checkFields fields =
101 let
101 let
102− toInfo (A.A region name, value) =
102+ toInfo (A.At region name, value) =
103 Map.singleton name (OneOrMore.one (Info region () value))
103 Map.singleton name (OneOrMore.one (Info region () value))
104
104
105 toError name () () =
105 toError name () () =
src/Canonicalize/Environment/Foreign.hs+2−2
@@ -267,7 +267,7 @@ data Exposed
267
267
268
268
269verifyImport :: ImportDict -> I.Interfaces -> Src.Import -> Result Import
269verifyImport :: ImportDict -> I.Interfaces -> Src.Import -> Result Import
270−verifyImport importDict interfaces (Src.Import (A.A region name) alias exposing) =
270+verifyImport importDict interfaces (Src.Import (A.At region name) alias exposing) =
271 case Map.lookup name importDict of
271 case Map.lookup name importDict of
272 Nothing ->
272 Nothing ->
273 throwImportNotFound region name (Map.elems importDict)
273 throwImportNotFound region name (Map.elems importDict)
@@ -296,7 +296,7 @@ throwImportNotFound region name knownModules =
296
296
297
297
298verifyExposed :: N.Name -> I.Interface -> A.Located Src.Exposed -> Result [(N.Name, Exposed)]
298verifyExposed :: N.Name -> I.Interface -> A.Located Src.Exposed -> Result [(N.Name, Exposed)]
299−verifyExposed moduleName interface@(I.Interface _ unions aliases _) (A.A region exposed) =
299+verifyExposed moduleName interface@(I.Interface _ unions aliases _) (A.At region exposed) =
300 case exposed of
300 case exposed of
301 Src.Operator name ->
301 Src.Operator name ->
302 verifyValue moduleName region name interface
302 verifyValue moduleName region name interface
src/Canonicalize/Environment/Internals.hs+1−1
@@ -146,7 +146,7 @@ localVarHomes =
146
146
147
147
148addLocalBoth :: N.Name -> A.Located a -> VarHomes -> Result () VarHomes
148addLocalBoth :: N.Name -> A.Located a -> VarHomes -> Result () VarHomes
149−addLocalBoth name (A.A region _) (VarHomes unqualified qualified) =
149+addLocalBoth name (A.At region _) (VarHomes unqualified qualified) =
150 case unqualified of
150 case unqualified of
151 Foreign _ ->
151 Foreign _ ->
152 Result.ok (VarHomes Local qualified)
152 Result.ok (VarHomes Local qualified)
src/Canonicalize/Environment/Local.hs+18−18
@@ -135,10 +135,10 @@ addVarsHelp localVars vars =
135collectLowerVars :: Valid.Module -> Result (Map.Map N.Name ())
135collectLowerVars :: Valid.Module -> Result (Map.Map N.Name ())
136collectLowerVars (Valid.Module _ _ _ _ _ decls _ _ _ effects) =
136collectLowerVars (Valid.Module _ _ _ _ _ decls _ _ _ effects) =
137 let
137 let
138− addDecl (A.A _ (Valid.Decl (A.A region name) _ _ _)) dict =
138+ addDecl (A.At _ (Valid.Decl (A.At region name) _ _ _)) dict =
139 Dups.insert name region () () dict
139 Dups.insert name region () () dict
140
140
141− addPort (Valid.Port (A.A region name) _) dict =
141+ addPort (Valid.Port (A.At region name) _) dict =
142 Dups.insert name region () () dict
142 Dups.insert name region () () dict
143
143
144 effectDict =
144 effectDict =
@@ -151,13 +151,13 @@ collectLowerVars (Valid.Module _ _ _ _ _ decls _ _ _ effects) =
151
151
152 Valid.Manager _ manager ->
152 Valid.Manager _ manager ->
153 case manager of
153 case manager of
154− Valid.Cmd (A.A region _) ->
154+ Valid.Cmd (A.At region _) ->
155 Dups.one "command" region () ()
155 Dups.one "command" region () ()
156
156
157− Valid.Sub (A.A region _) ->
157+ Valid.Sub (A.At region _) ->
158 Dups.one "subscription" region () ()
158 Dups.one "subscription" region () ()
159
159
160− Valid.Fx (A.A regionCmd _) (A.A regionSub _) ->
160+ Valid.Fx (A.At regionCmd _) (A.At regionSub _) ->
161 Dups.union
161 Dups.union
162 (Dups.one "command" regionCmd () ())
162 (Dups.one "command" regionCmd () ())
163 (Dups.one "subscription" regionSub () ())
163 (Dups.one "subscription" regionSub () ())
@@ -171,13 +171,13 @@ collectLowerVars (Valid.Module _ _ _ _ _ decls _ _ _ effects) =
171collectUpperVars :: Valid.Module -> Result (Map.Map N.Name ())
171collectUpperVars :: Valid.Module -> Result (Map.Map N.Name ())
172collectUpperVars (Valid.Module _ _ _ _ _ _ unions aliases _ _) =
172collectUpperVars (Valid.Module _ _ _ _ _ _ unions aliases _ _) =
173 let
173 let
174− addUnion (Valid.Union (A.A _ name) _ ctors) dict =
174+ addUnion (Valid.Union (A.At _ name) _ ctors) dict =
175 foldr (addCtor name) dict ctors
175 foldr (addCtor name) dict ctors
176
176
177− addCtor tipe (A.A region name, _args) dict =
177+ addCtor tipe (A.At region name, _args) dict =
178 Dups.insert name region (Error.UnionCtor tipe) () dict
178 Dups.insert name region (Error.UnionCtor tipe) () dict
179
179
180− addAlias (Valid.Alias (A.A region name) _ (A.A _ tipe)) dict =
180+ addAlias (Valid.Alias (A.At region name) _ (A.At _ tipe)) dict =
181 case tipe of
181 case tipe of
182 Src.TRecord _ Nothing ->
182 Src.TRecord _ Nothing ->
183 Dups.insert name region Error.RecordCtor () dict
183 Dups.insert name region Error.RecordCtor () dict
@@ -196,11 +196,11 @@ collectUpperVars (Valid.Module _ _ _ _ _ _ unions aliases _ _) =
196addTypes :: Valid.Module -> Env.Env -> Result Env.Env
196addTypes :: Valid.Module -> Env.Env -> Result Env.Env
197addTypes (Valid.Module _ _ _ _ _ _ unions aliases _ _) env =
197addTypes (Valid.Module _ _ _ _ _ _ unions aliases _ _) env =
198 let
198 let
199− aliasToDict alias@(Valid.Alias (A.A region name) _ tipe) =
199+ aliasToDict alias@(Valid.Alias (A.At region name) _ tipe) =
200 do args <- checkAliasFreeVars alias
200 do args <- checkAliasFreeVars alias
201 return $ Dups.one name region () (Left (Alias region name args tipe))
201 return $ Dups.one name region () (Left (Alias region name args tipe))
202
202
203− unionToDict union@(Valid.Union (A.A region name) _ _) =
203+ unionToDict union@(Valid.Union (A.At region name) _ _) =
204 do arity <- checkUnionFreeVars union
204 do arity <- checkUnionFreeVars union
205 return $ Dups.one name region () (Right arity)
205 return $ Dups.one name region () (Right arity)
206
206
@@ -292,7 +292,7 @@ toNode alias@(Alias _ name _ tipe) =
292
292
293
293
294getEdges :: Src.Type -> Bag.Bag N.Name
294getEdges :: Src.Type -> Bag.Bag N.Name
295−getEdges (A.A _ tipe) =
295+getEdges (A.At _ tipe) =
296 case tipe of
296 case tipe of
297 Src.TLambda arg result ->
297 Src.TLambda arg result ->
298 Bag.append (getEdges arg) (getEdges result)
298 Bag.append (getEdges arg) (getEdges result)
@@ -325,9 +325,9 @@ getEdges (A.A _ tipe) =
325
325
326
326
327checkUnionFreeVars :: Valid.Union -> Result Int
327checkUnionFreeVars :: Valid.Union -> Result Int
328−checkUnionFreeVars (Valid.Union (A.A unionRegion name) args ctors) =
328+checkUnionFreeVars (Valid.Union (A.At unionRegion name) args ctors) =
329 let
329 let
330− addUnion (A.A region arg) dict =
330+ addUnion (A.At region arg) dict =
331 Dups.insert arg region () region dict
331 Dups.insert arg region () region dict
332
332
333 toError badArg () () =
333 toError badArg () () =
@@ -343,16 +343,16 @@ checkUnionFreeVars (Valid.Union (A.A unionRegion name) args ctors) =
343 Result.ok (length args)
343 Result.ok (length args)
344
344
345 unbound ->
345 unbound ->
346− let toLoc (arg, region) = A.A region arg in
346+ let toLoc (arg, region) = A.At region arg in
347 Result.throw unionRegion $
347 Result.throw unionRegion $
348 Error.TypeVarsUnboundInUnion name (map A.drop args) (map toLoc unbound)
348 Error.TypeVarsUnboundInUnion name (map A.drop args) (map toLoc unbound)
349
349
350
350
351
351
352checkAliasFreeVars :: Valid.Alias -> Result [N.Name]
352checkAliasFreeVars :: Valid.Alias -> Result [N.Name]
353−checkAliasFreeVars (Valid.Alias (A.A aliasRegion name) args tipe) =
353+checkAliasFreeVars (Valid.Alias (A.At aliasRegion name) args tipe) =
354 let
354 let
355− addAlias (A.A region arg) dict =
355+ addAlias (A.At region arg) dict =
356 Dups.insert arg region () region dict
356 Dups.insert arg region () region dict
357
357
358 toError badArg () () =
358 toError badArg () () =
@@ -364,7 +364,7 @@ checkAliasFreeVars (Valid.Alias (A.A aliasRegion name) args tipe) =
364 if Map.size boundVars == overlap && Map.size freeVars == overlap
364 if Map.size boundVars == overlap && Map.size freeVars == overlap
365 then Result.ok (map A.drop args)
365 then Result.ok (map A.drop args)
366 else
366 else
367− let toLoc (arg, region) = A.A region arg in
367+ let toLoc (arg, region) = A.At region arg in
368 Result.throw aliasRegion $
368 Result.throw aliasRegion $
369 Error.TypeVarsMessedUpInAlias name
369 Error.TypeVarsMessedUpInAlias name
370 (map A.drop args)
370 (map A.drop args)
@@ -373,7 +373,7 @@ checkAliasFreeVars (Valid.Alias (A.A aliasRegion name) args tipe) =
373
373
374
374
375addFreeVars :: Src.Type -> Map.Map N.Name R.Region -> Map.Map N.Name R.Region
375addFreeVars :: Src.Type -> Map.Map N.Name R.Region -> Map.Map N.Name R.Region
376−addFreeVars (A.A region tipe) freeVars =
376+addFreeVars (A.At region tipe) freeVars =
377 case tipe of
377 case tipe of
378 Src.TLambda arg result ->
378 Src.TLambda arg result ->
379 addFreeVars arg (addFreeVars result freeVars)
379 addFreeVars arg (addFreeVars result freeVars)
src/Canonicalize/Expression.hs+18−18
@@ -47,8 +47,8 @@ type FreeLocals =
47
47
48
48
49canonicalize :: Env.Env -> Valid.Expr -> Result FreeLocals Can.Expr
49canonicalize :: Env.Env -> Valid.Expr -> Result FreeLocals Can.Expr
50−canonicalize env (A.A region expression) =
50+canonicalize env (A.At region expression) =
51− A.A region <$>
51+ A.At region <$>
52 case expression of
52 case expression of
53 Valid.Str string ->
53 Valid.Str string ->
54 Result.ok (Can.Str string)
54 Result.ok (Can.Str string)
@@ -113,10 +113,10 @@ canonicalize env (A.A region expression) =
113 <$> canonicalize env record
113 <$> canonicalize env record
114 <*> Result.ok field
114 <*> Result.ok field
115
115
116− Valid.Update (A.A reg name) fields ->
116+ Valid.Update (A.At reg name) fields ->
117 do fieldDict <- Result.untracked $ Dups.checkFields fields
117 do fieldDict <- Result.untracked $ Dups.checkFields fields
118 name_ <- Env.findVar reg env Nothing name
118 name_ <- Env.findVar reg env Nothing name
119− Can.Update (A.A reg name_)
119+ Can.Update (A.At reg name_)
120 <$> traverse (canonicalize env) fieldDict
120 <$> traverse (canonicalize env) fieldDict
121
121
122 Valid.Record fields ->
122 Valid.Record fields ->
@@ -150,7 +150,7 @@ canonicalizeTupleExtras region env extras =
150 Just <$> canonicalize env three
150 Just <$> canonicalize env three
151
151
152 _ : others ->
152 _ : others ->
153− let (A.A r1 _, A.A r2 _) = (head others, last others) in
153+ let (A.At r1 _, A.At r2 _) = (head others, last others) in
154 Result.throw region (Error.TupleLargerThanThree (R.merge r1 r2))
154 Result.throw region (Error.TupleLargerThanThree (R.merge r1 r2))
155
155
156
156
@@ -187,7 +187,7 @@ canonicalizeCaseBranch env (pattern, expr) =
187canonicalizeBinops :: R.Region -> Env.Env -> [(Valid.Expr, A.Located N.Name)] -> Valid.Expr -> Result FreeLocals Can.Expr
187canonicalizeBinops :: R.Region -> Env.Env -> [(Valid.Expr, A.Located N.Name)] -> Valid.Expr -> Result FreeLocals Can.Expr
188canonicalizeBinops overallRegion env ops final =
188canonicalizeBinops overallRegion env ops final =
189 let
189 let
190− canonicalizeHelp (expr, A.A region op) =
190+ canonicalizeHelp (expr, A.At region op) =
191 (,)
191 (,)
192 <$> canonicalize env expr
192 <$> canonicalize env expr
193 <*> Env.findBinop region env op
193 <*> Env.findBinop region env op
@@ -316,8 +316,8 @@ removeLocals unused boundNames (Result.Result freeLocals warnings answer) =
316
316
317
317
318toUnusedWarning :: Warning.Unused -> (N.Name, A.Located a) -> A.Located Warning.Warning
318toUnusedWarning :: Warning.Unused -> (N.Name, A.Located a) -> A.Located Warning.Warning
319−toUnusedWarning unused (name, A.A region _) =
319+toUnusedWarning unused (name, A.At region _) =
320− A.A region (Warning.UnusedVariable unused name)
320+ A.At region (Warning.UnusedVariable unused name)
321
321
322
322
323
323
@@ -331,15 +331,15 @@ type Bindings =
331addBindings :: (Valid.Def, Int) -> Bindings -> Bindings
331addBindings :: (Valid.Def, Int) -> Bindings -> Bindings
332addBindings (def, key) bindings =
332addBindings (def, key) bindings =
333 case def of
333 case def of
334− Valid.Define defRegion (A.A region name) _ _ _ ->
334+ Valid.Define defRegion (A.At region name) _ _ _ ->
335− Dups.insert name region () (A.A defRegion key) bindings
335+ Dups.insert name region () (A.At defRegion key) bindings
336
336
337 Valid.Destruct defRegion pattern _ ->
337 Valid.Destruct defRegion pattern _ ->
338− addBindingsHelp (A.A defRegion key) pattern bindings
338+ addBindingsHelp (A.At defRegion key) pattern bindings
339
339
340
340
341addBindingsHelp :: A.Located Int -> Src.Pattern -> Bindings -> Bindings
341addBindingsHelp :: A.Located Int -> Src.Pattern -> Bindings -> Bindings
342−addBindingsHelp key (A.A region pattern) bindings =
342+addBindingsHelp key (A.At region pattern) bindings =
343 case pattern of
343 case pattern of
344 Src.PAnything ->
344 Src.PAnything ->
345 bindings
345 bindings
@@ -349,7 +349,7 @@ addBindingsHelp key (A.A region pattern) bindings =
349
349
350 Src.PRecord fields ->
350 Src.PRecord fields ->
351 let
351 let
352− addField (A.A fieldRegion name) dict =
352+ addField (A.At fieldRegion name) dict =
353 Dups.insert name fieldRegion () key dict
353 Dups.insert name fieldRegion () key dict
354 in
354 in
355 foldr addField bindings fields
355 foldr addField bindings fields
@@ -369,7 +369,7 @@ addBindingsHelp key (A.A region pattern) bindings =
369 Src.PCons first rest ->
369 Src.PCons first rest ->
370 addBindingsHelp key rest (addBindingsHelp key first bindings)
370 addBindingsHelp key rest (addBindingsHelp key first bindings)
371
371
372− Src.PAlias ptrn (A.A reg name) ->
372+ Src.PAlias ptrn (A.At reg name) ->
373 addBindingsHelp key ptrn (Dups.insert name reg () key bindings)
373 addBindingsHelp key ptrn (Dups.insert name reg () key bindings)
374
374
375 Src.PChr _ ->
375 Src.PChr _ ->
@@ -397,7 +397,7 @@ data Binding
397defToNode :: Map.Map N.Name Int -> Env.Env -> (Valid.Def, Int) -> Result () (Node, Int, [Int])
397defToNode :: Map.Map N.Name Int -> Env.Env -> (Valid.Def, Int) -> Result () (Node, Int, [Int])
398defToNode defKeys env (def, key) =
398defToNode defKeys env (def, key) =
399 case def of
399 case def of
400− Valid.Define region aname@(A.A _ name) srcArgs body Nothing ->
400+ Valid.Define region aname@(A.At _ name) srcArgs body Nothing ->
401 do (args, destructors) <-
401 do (args, destructors) <-
402 Pattern.verify (Error.DPFuncArgs name) $
402 Pattern.verify (Error.DPFuncArgs name) $
403 Index.indexedTraverse (Pattern.canonicalizeArg env) srcArgs
403 Index.indexedTraverse (Pattern.canonicalizeArg env) srcArgs
@@ -415,7 +415,7 @@ defToNode defKeys env (def, key) =
415 toNode defKeys key destructors $
415 toNode defKeys key destructors $
416 Destruct region cpattern destructors <$> canonicalize env body
416 Destruct region cpattern destructors <$> canonicalize env body
417
417
418− Valid.Define region aname@(A.A _ name) srcArgs body (Just tipe) ->
418+ Valid.Define region aname@(A.At _ name) srcArgs body (Just tipe) ->
419 do (Can.Forall freeVars ctipe) <- Type.toAnnotation env tipe
419 do (Can.Forall freeVars ctipe) <- Type.toAnnotation env tipe
420 ((args, resultType), destructors) <-
420 ((args, resultType), destructors) <-
421 Pattern.verify (Error.DPFuncArgs name) $
421 Pattern.verify (Error.DPFuncArgs name) $
@@ -465,7 +465,7 @@ gatherTypedArgs env name srcArgs tipe index revTypedArgs =
465 typedArg : revTypedArgs
465 typedArg : revTypedArgs
466
466
467 _ ->
467 _ ->
468− let (A.A start _, A.A end _) = (head srcArgs, last srcArgs) in
468+ let (A.At start _, A.At end _) = (head srcArgs, last srcArgs) in
469 Result.throw (R.merge start end) $
469 Result.throw (R.merge start end) $
470 Error.AnnotationTooShort name index (length srcArgs)
470 Error.AnnotationTooShort name index (length srcArgs)
471
471
@@ -481,7 +481,7 @@ detectCycles letRegion sccs body =
481 Result.ok body
481 Result.ok body
482
482
483 scc : subSccs ->
483 scc : subSccs ->
484− A.A letRegion <$>
484+ A.At letRegion <$>
485 case scc of
485 case scc of
486 Graph.AcyclicSCC (Node binding freeLocals) ->
486 Graph.AcyclicSCC (Node binding freeLocals) ->
487 case binding of
487 case binding of
src/Canonicalize/Module.hs+13−13
@@ -79,13 +79,13 @@ canonicalize pkg importDict interfaces module_@(Valid.Module name _ _ exports im
79
79
80
80
81toDocs :: Valid.Module -> A.Located (Maybe Can.Docs)
81toDocs :: Valid.Module -> A.Located (Maybe Can.Docs)
82−toDocs (Valid.Module _ (A.A region maybeOverview) comments _ _ _ _ _ _ _) =
82+toDocs (Valid.Module _ (A.At region maybeOverview) comments _ _ _ _ _ _ _) =
83 case maybeOverview of
83 case maybeOverview of
84 Nothing ->
84 Nothing ->
85− A.A region Nothing
85+ A.At region Nothing
86
86
87 Just overview ->
87 Just overview ->
88− A.A region (Just (Can.Docs overview comments))
88+ A.At region (Just (Can.Docs overview comments))
89
89
90
90
91
91
@@ -93,13 +93,13 @@ toDocs (Valid.Module _ (A.A region maybeOverview) comments _ _ _ _ _ _ _) =
93
93
94
94
95canonicalizeAlias :: Env.Env -> Valid.Alias -> Result ( N.Name, Can.Alias )
95canonicalizeAlias :: Env.Env -> Valid.Alias -> Result ( N.Name, Can.Alias )
96−canonicalizeAlias env (Valid.Alias (A.A _ name) args tipe) =
96+canonicalizeAlias env (Valid.Alias (A.At _ name) args tipe) =
97 do ctipe <- Type.canonicalize env tipe
97 do ctipe <- Type.canonicalize env tipe
98 return (name, Can.Alias (map A.drop args) ctipe (toRecordCtorInfo tipe))
98 return (name, Can.Alias (map A.drop args) ctipe (toRecordCtorInfo tipe))
99
99
100
100
101toRecordCtorInfo :: Src.Type -> Maybe [N.Name]
101toRecordCtorInfo :: Src.Type -> Maybe [N.Name]
102−toRecordCtorInfo (A.A _ tipe) =
102+toRecordCtorInfo (A.At _ tipe) =
103 case tipe of
103 case tipe of
104 Src.TRecord fields Nothing ->
104 Src.TRecord fields Nothing ->
105 Just (map (A.drop . fst) fields)
105 Just (map (A.drop . fst) fields)
@@ -113,9 +113,9 @@ toRecordCtorInfo (A.A _ tipe) =
113
113
114
114
115canonicalizeUnion :: Env.Env -> Valid.Union -> Result ( N.Name, Can.Union )
115canonicalizeUnion :: Env.Env -> Valid.Union -> Result ( N.Name, Can.Union )
116−canonicalizeUnion env (Valid.Union (A.A _ name) args ctors) =
116+canonicalizeUnion env (Valid.Union (A.At _ name) args ctors) =
117 let
117 let
118− canonicalizeCtor (A.A _ ctor, tipes) =
118+ canonicalizeCtor (A.At _ ctor, tipes) =
119 do ctipes <- traverse (Type.canonicalize env) tipes
119 do ctipes <- traverse (Type.canonicalize env) tipes
120 return (ctor, ctipes)
120 return (ctor, ctipes)
121 in
121 in
@@ -128,7 +128,7 @@ canonicalizeUnion env (Valid.Union (A.A _ name) args ctors) =
128
128
129
129
130canonicalizeBinop :: Valid.Binop -> ( N.Name, Can.Binop )
130canonicalizeBinop :: Valid.Binop -> ( N.Name, Can.Binop )
131−canonicalizeBinop (Valid.Binop (A.A _ op) associativity precedence func) =
131+canonicalizeBinop (Valid.Binop (A.At _ op) associativity precedence func) =
132 ( op, Can.Binop_ associativity precedence func )
132 ( op, Can.Binop_ associativity precedence func )
133
133
134
134
@@ -162,7 +162,7 @@ detectCycles sccs =
162
162
163
163
164toNode :: Env.Env -> A.Located Valid.Decl -> Result (Can.Def, N.Name, [N.Name])
164toNode :: Env.Env -> A.Located Valid.Decl -> Result (Can.Def, N.Name, [N.Name])
165−toNode env (A.A _ (Valid.Decl aname@(A.A _ name) srcArgs body maybeType)) =
165+toNode env (A.At _ (Valid.Decl aname@(A.At _ name) srcArgs body maybeType)) =
166 case maybeType of
166 case maybeType of
167 Nothing ->
167 Nothing ->
168 do (args, destructors) <-
168 do (args, destructors) <-
@@ -206,10 +206,10 @@ detectBadCycles def defs =
206detectBadCyclesHelp :: Can.Def -> Maybe N.Name
206detectBadCyclesHelp :: Can.Def -> Maybe N.Name
207detectBadCyclesHelp def =
207detectBadCyclesHelp def =
208 case def of
208 case def of
209− Can.Def (A.A _ name) [] _ _ ->
209+ Can.Def (A.At _ name) [] _ _ ->
210 Just name
210 Just name
211
211
212− Can.TypedDef (A.A _ name) _ [] _ _ _ ->
212+ Can.TypedDef (A.At _ name) _ [] _ _ _ ->
213 Just name
213 Just name
214
214
215 _ ->
215 _ ->
@@ -241,7 +241,7 @@ canonicalizeExports decls unions aliases binops effects exposing =
241
241
242
242
243declToName :: A.Located Valid.Decl -> ( N.Name, () )
243declToName :: A.Located Valid.Decl -> ( N.Name, () )
244−declToName (A.A _ (Valid.Decl (A.A _ name) _ _ _)) =
244+declToName (A.At _ (Valid.Decl (A.At _ name) _ _ _)) =
245 ( name, () )
245 ( name, () )
246
246
247
247
@@ -253,7 +253,7 @@ checkExposed
253 -> Can.Effects
253 -> Can.Effects
254 -> A.Located Src.Exposed
254 -> A.Located Src.Exposed
255 -> Result (Dups.Dict () Can.Export)
255 -> Result (Dups.Dict () Can.Export)
256−checkExposed decls unions aliases binops effects (A.A region exposed) =
256+checkExposed decls unions aliases binops effects (A.At region exposed) =
257 case exposed of
257 case exposed of
258 Src.Lower name ->
258 Src.Lower name ->
259 if Map.member name decls then
259 if Map.member name decls then
src/Canonicalize/Pattern.hs+8−8
@@ -67,21 +67,21 @@ canonicalize env index pattern =
67
67
68
68
69process :: Env.Env -> Can.Destructor -> Src.Pattern -> Result Bindings Can.Pattern
69process :: Env.Env -> Can.Destructor -> Src.Pattern -> Result Bindings Can.Pattern
70−process env destructor (A.A region pattern) =
70+process env destructor (A.At region pattern) =
71− A.A region <$>
71+ A.At region <$>
72 case pattern of
72 case pattern of
73 Src.PAnything ->
73 Src.PAnything ->
74 Result.ok Can.PAnything
74 Result.ok Can.PAnything
75
75
76 Src.PVar name ->
76 Src.PVar name ->
77 Result.accumulate
77 Result.accumulate
78− (Dups.one name region () (A.A region destructor))
78+ (Dups.one name region () (A.At region destructor))
79 (Can.PVar name)
79 (Can.PVar name)
80
80
81 Src.PRecord fields ->
81 Src.PRecord fields ->
82 let
82 let
83− addField (A.A reg name) dict =
83+ addField (A.At reg name) dict =
84− Dups.insert name reg () (A.A reg (Can.DField name destructor)) dict
84+ Dups.insert name reg () (A.At reg (Can.DField name destructor)) dict
85 in
85 in
86 Result.accumulate
86 Result.accumulate
87 (foldr addField Dups.none fields)
87 (foldr addField Dups.none fields)
@@ -119,10 +119,10 @@ process env destructor (A.A region pattern) =
119 <$> process env (Can.DIndex Index.first destructor) first
119 <$> process env (Can.DIndex Index.first destructor) first
120 <*> process env (Can.DIndex Index.second destructor) rest
120 <*> process env (Can.DIndex Index.second destructor) rest
121
121
122− Src.PAlias ptrn (A.A reg name) ->
122+ Src.PAlias ptrn (A.At reg name) ->
123 do cpattern <- process env destructor ptrn
123 do cpattern <- process env destructor ptrn
124 Result.accumulate
124 Result.accumulate
125− (Dups.one name reg () (A.A reg destructor))
125+ (Dups.one name reg () (A.At reg destructor))
126 (Can.PAlias cpattern name)
126 (Can.PAlias cpattern name)
127
127
128 Src.PChr chr ->
128 Src.PChr chr ->
@@ -145,7 +145,7 @@ processTuple tupleRegion env destructor extras =
145 Just <$> process env (Can.DIndex Index.third destructor) three
145 Just <$> process env (Can.DIndex Index.third destructor) three
146
146
147 _ : others ->
147 _ : others ->
148− let (A.A r1 _, A.A r2 _) = (head others, last others) in
148+ let (A.At r1 _, A.At r2 _) = (head others, last others) in
149 Result.throw tupleRegion (Error.TupleLargerThanThree (R.merge r1 r2))
149 Result.throw tupleRegion (Error.TupleLargerThanThree (R.merge r1 r2))
150
150
151
151
src/Canonicalize/Type.hs+3−3
@@ -45,7 +45,7 @@ toAnnotation env srcType =
45
45
46
46
47canonicalize :: Env.Env -> Src.Type -> Result () Can.Type
47canonicalize :: Env.Env -> Src.Type -> Result () Can.Type
48−canonicalize env (A.A typeRegion tipe) =
48+canonicalize env (A.At typeRegion tipe) =
49 case tipe of
49 case tipe of
50 Src.TVar x ->
50 Src.TVar x ->
51 Result.ok (Can.TVar x)
51 Result.ok (Can.TVar x)
@@ -89,7 +89,7 @@ canonicalize env (A.A typeRegion tipe) =
89 Just <$> canonicalize env c
89 Just <$> canonicalize env c
90
90
91 _ ->
91 _ ->
92− let (A.A start _, A.A end _) = (head cs, last cs) in
92+ let (A.At start _, A.At end _) = (head cs, last cs) in
93 Result.throw typeRegion $
93 Result.throw typeRegion $
94 Error.TupleLargerThanThree (R.merge start end)
94 Error.TupleLargerThanThree (R.merge start end)
95
95
@@ -110,7 +110,7 @@ checkArgs argsType expected region name args answer =
110 else
110 else
111 let
111 let
112 extras = drop expected args
112 extras = drop expected args
113− (A.A start _, A.A end _) = (head extras, last extras)
113+ (A.At start _, A.At end _) = (head extras, last extras)
114 in
114 in
115 Error.TooMany argsType name expected actual (R.merge start end)
115 Error.TooMany argsType name expected actual (R.merge start end)
116
116