Commit f136795b authored by Finn Teegen's avatar Finn Teegen

Improve normalization of type variables in FlatCurry

parent 1e0f7066
......@@ -457,6 +457,9 @@ type NormState a = S.State (Int, Map.Map Int Int) a
class Normalize a where
normalize :: a -> NormState a
instance Normalize a => Normalize [a] where
normalize = mapM normalize
instance Normalize Int where
normalize i = do
(n, m) <- S.get
......@@ -468,47 +471,40 @@ instance Normalize Int where
instance Normalize TypeExpr where
normalize (TVar i) = TVar <$> normalize i
normalize (TCons q tys) = TCons q <$> mapM normalize tys
normalize (TCons q tys) = TCons q <$> normalize tys
normalize (FuncType ty1 ty2) = FuncType <$> normalize ty1 <*> normalize ty2
normalize (ForallType is ty) =
ForallType <$> mapM normalize is <*> normalize ty
instance (Normalize a, Normalize b) => Normalize (a, b) where
normalize (x, y) = (,) <$> normalize x <*> normalize y
instance Normalize a => Normalize [a] where
normalize = mapM normalize
instance Normalize Char where
normalize = return
instance Normalize Kind where
normalize = return
normalize (ForallType is ty) = ForallType <$> mapM normalizeTypeVar is
<*> normalize ty
where normalizeTypeVar (tv, k) = (,) <$> normalize tv <*> pure k
instance Normalize a => Normalize (AFuncDecl a) where
normalize (AFunc f a v ty r) = AFunc f a v <$> normalize ty <*> normalize r
instance Normalize a => Normalize (ARule a) where
normalize (ARule ty vs e) = ARule <$> normalize ty
<*> mapM normalize vs
<*> mapM normalizeTuple vs
<*> normalize e
normalize (AExternal ty s) = flip AExternal s <$> normalize ty
normalizeTuple :: Normalize b => (a, b) -> NormState (a, b)
normalizeTuple (a, b) = (,) <$> pure a <*> normalize b
instance Normalize a => Normalize (AExpr a) where
normalize (AVar ty v) = flip AVar v <$> normalize ty
normalize (ALit ty l) = flip ALit l <$> normalize ty
normalize (AComb ty ct f es) = flip AComb ct <$> normalize ty
<*> normalize f
<*> mapM normalize es
<*> normalizeTuple f
<*> normalize es
normalize (ALet ty ds e) = ALet <$> normalize ty
<*> mapM normalizeBinding ds
<*> normalize e
where normalizeBinding (v, b) = (,) <$> normalize v <*> normalize b
where normalizeBinding (v, b) = (,) <$> normalizeTuple v <*> normalize b
normalize (AOr ty a b) = AOr <$> normalize ty <*> normalize a
<*> normalize b
normalize (ACase ty ct e bs) = flip ACase ct <$> normalize ty <*> normalize e
<*> mapM normalize bs
normalize (AFree ty vs e) = AFree <$> normalize ty <*> mapM normalize vs
<*> normalize bs
normalize (AFree ty vs e) = AFree <$> normalize ty
<*> mapM normalizeTuple vs
<*> normalize e
normalize (ATyped ty e ty') = ATyped <$> normalize ty <*> normalize e
<*> normalize ty'
......@@ -517,8 +513,9 @@ instance Normalize a => Normalize (ABranchExpr a) where
normalize (ABranch p e) = ABranch <$> normalize p <*> normalize e
instance Normalize a => Normalize (APattern a) where
normalize (APattern ty c vs) = APattern <$> normalize ty <*> normalize c
<*> mapM normalize vs
normalize (APattern ty c vs) = APattern <$> normalize ty
<*> normalizeTuple c
<*> mapM normalizeTuple vs
normalize (ALPattern ty l) = flip ALPattern l <$> normalize ty
-- -----------------------------------------------------------------------------
......
......@@ -453,6 +453,9 @@ type NormState a = S.State (Int, Map.Map Int Int) a
class Normalize a where
normalize :: a -> NormState a
instance Normalize a => Normalize [a] where
normalize = mapM normalize
instance Normalize Int where
normalize i = do
(n, m) <- S.get
......@@ -464,45 +467,37 @@ instance Normalize Int where
instance Normalize TypeExpr where
normalize (TVar i) = TVar <$> normalize i
normalize (TCons q tys) = TCons q <$> mapM normalize tys
normalize (TCons q tys) = TCons q <$> normalize tys
normalize (FuncType ty1 ty2) = FuncType <$> normalize ty1 <*> normalize ty2
normalize (ForallType is ty) =
ForallType <$> mapM normalize is <*> normalize ty
instance (Normalize a, Normalize b) => Normalize (a, b) where
normalize (x, y) = (,) <$> normalize x <*> normalize y
instance Normalize a => Normalize [a] where
normalize = mapM normalize
instance Normalize Char where
normalize = return
instance Normalize Kind where
normalize = return
normalize (ForallType is ty) = ForallType <$> mapM normalizeTypeVar is
<*> normalize ty
where normalizeTypeVar (tv, k) = (,) <$> normalize tv <*> pure k
instance Normalize TFuncDecl where
normalize (TFunc f a v ty r) = TFunc f a v <$> normalize ty <*> normalize r
instance Normalize TRule where
normalize (TRule vs e) = TRule <$> mapM normalize vs
normalize (TRule vs e) = TRule <$> mapM normalizeVar vs
<*> normalize e
normalize (TExternal ty s) = flip TExternal s <$> normalize ty
normalizeVar :: (VarIndex, TypeExpr) -> NormState (VarIndex, TypeExpr)
normalizeVar (v, ty) = (,) <$> pure v <*> normalize ty
instance Normalize TExpr where
normalize (TVarE ty v) = flip TVarE v <$> normalize ty
normalize (TLit ty l) = flip TLit l <$> normalize ty
normalize (TComb ty ct f es) = flip TComb ct <$> normalize ty
<*> pure f
<*> mapM normalize es
<*> normalize es
normalize (TLet ds e) = TLet <$> mapM normalizeBinding ds
<*> normalize e
where normalizeBinding (v, b) = (,) <$> normalize v <*> normalize b
where normalizeBinding (v, b) = (,) <$> normalizeVar v <*> normalize b
normalize (TOr a b) = TOr <$> normalize a
<*> normalize b
normalize (TCase ct e bs) = TCase ct <$> normalize e
<*> mapM normalize bs
normalize (TFree vs e) = TFree <$> mapM normalize vs
<*> normalize bs
normalize (TFree vs e) = TFree <$> mapM normalizeVar vs
<*> normalize e
normalize (TTyped e ty') = TTyped <$> normalize e
<*> normalize ty'
......@@ -513,7 +508,7 @@ instance Normalize TBranchExpr where
instance Normalize TPattern where
normalize (TPattern ty c vs) = TPattern <$> normalize ty
<*> pure c
<*> mapM normalize vs
<*> mapM normalizeVar vs
normalize (TLPattern ty l) = flip TLPattern l <$> normalize ty
-- -----------------------------------------------------------------------------
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment