Make SortDefinitions aware of ADT constructors, gave incorrect sorts before
This commit is contained in:
parent
46cb850570
commit
0f3910d59e
1 changed files with 14 additions and 1 deletions
|
@ -21,6 +21,16 @@ boundVars pattern =
|
||||||
PAnything -> Set.empty
|
PAnything -> Set.empty
|
||||||
PLiteral _ -> Set.empty
|
PLiteral _ -> Set.empty
|
||||||
|
|
||||||
|
ctors :: Pattern -> [String]
|
||||||
|
ctors pattern =
|
||||||
|
case pattern of
|
||||||
|
PVar x -> []
|
||||||
|
PAlias x p -> ctors p
|
||||||
|
PData ctor ps -> ctor : concatMap ctors ps
|
||||||
|
PRecord fields -> []
|
||||||
|
PAnything -> []
|
||||||
|
PLiteral _ -> []
|
||||||
|
|
||||||
free :: String -> State (Set.Set String) ()
|
free :: String -> State (Set.Set String) ()
|
||||||
free x = modify (Set.insert x)
|
free x = modify (Set.insert x)
|
||||||
|
|
||||||
|
@ -105,7 +115,9 @@ reorder lexpr@(L a b expr) =
|
||||||
case def of
|
case def of
|
||||||
Def pattern _ -> pattern
|
Def pattern _ -> pattern
|
||||||
TypeAnnotation name _ -> PVar name
|
TypeAnnotation name _ -> PVar name
|
||||||
mapM (bound . boundVars . getPatterns) defs
|
forM (map getPatterns defs) $ \pattern -> do
|
||||||
|
bound (boundVars pattern)
|
||||||
|
mapM free (ctors pattern)
|
||||||
|
|
||||||
let addDefs ds bod = L a b (Let (concatMap toDefs ds) bod)
|
let addDefs ds bod = L a b (Let (concatMap toDefs ds) bod)
|
||||||
where
|
where
|
||||||
|
@ -128,6 +140,7 @@ bindingReorder :: (Pattern, LExpr t v) -> State (Set.Set String) (Pattern, LExpr
|
||||||
bindingReorder (pattern,expr) =
|
bindingReorder (pattern,expr) =
|
||||||
do expr' <- reorder expr
|
do expr' <- reorder expr
|
||||||
bound (boundVars pattern)
|
bound (boundVars pattern)
|
||||||
|
mapM free (ctors pattern)
|
||||||
return (pattern, expr')
|
return (pattern, expr')
|
||||||
|
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue