git.iko.soy/elk
on master help sign in
Make SortDefinitions aware of ADT constructors, gave incorrect sorts before
0f3910dEvan Czaplicki
compiler/Transform/SortDefinitions.hs+14−1
compare with master
unifiedsplit
@@ -21,6 +21,16 @@ boundVars pattern =
21 PAnything -> Set.empty
21 PAnything -> Set.empty
22 PLiteral _ -> Set.empty
22 PLiteral _ -> Set.empty
23
23
24+ctors :: Pattern -> [String]
25+ctors pattern =
26+ case pattern of
27+ PVar x -> []
28+ PAlias x p -> ctors p
29+ PData ctor ps -> ctor : concatMap ctors ps
30+ PRecord fields -> []
31+ PAnything -> []
32+ PLiteral _ -> []
33+
24free :: String -> State (Set.Set String) ()
34free :: String -> State (Set.Set String) ()
25free x = modify (Set.insert x)
35free x = modify (Set.insert x)
26
36
@@ -105,7 +115,9 @@ reorder lexpr@(L a b expr) =
105 case def of
115 case def of
106 Def pattern _ -> pattern
116 Def pattern _ -> pattern
107 TypeAnnotation name _ -> PVar name
117 TypeAnnotation name _ -> PVar name
118+ forM (map getPatterns defs) $ \pattern -> do
108− mapM (bound . boundVars . getPatterns) defs
119+ bound (boundVars pattern)
120+ mapM free (ctors pattern)
109
121
110 let addDefs ds bod = L a b (Let (concatMap toDefs ds) bod)
122 let addDefs ds bod = L a b (Let (concatMap toDefs ds) bod)
111 where
123 where
@@ -128,6 +140,7 @@ bindingReorder :: (Pattern, LExpr t v) -> State (Set.Set String) (Pattern, LExpr
128bindingReorder (pattern,expr) =
140bindingReorder (pattern,expr) =
129 do expr' <- reorder expr
141 do expr' <- reorder expr
130 bound (boundVars pattern)
142 bound (boundVars pattern)
143+ mapM free (ctors pattern)
131 return (pattern, expr')
144 return (pattern, expr')
132
145
133
146