Commit 2d1247a3 authored by Björn Peemöller 's avatar Björn Peemöller
Browse files

Normalize the type of lifted local functions

Local functions get negative type variables that are suject to the
normalization of types, resulting in awkward FlatCurry types. Thus,
they are now normalized to improve readability.
parent cd9ac42a
......@@ -197,10 +197,21 @@ absFunTypes m pre fvs fs tyEnv = foldr abstractFunType tyEnv fs
abstractFunType f tyEnv' =
qualBindFun m (liftIdent pre f)
(length fvs + varArity tyEnv' f) -- (arrowArity ty)
(polyType ty)
(polyType (normType ty))
(unbindFun f tyEnv')
where ty = foldr TypeArrow (varType tyEnv' f) tys
normType :: Type -> Type
normType ty = norm (zip (nub $ typeVars ty) [0..]) ty
where
norm vs (TypeVariable n) = case lookup n vs of
Just m -> TypeVariable m
Nothing -> error "Lift.normType"
norm vs (TypeConstructor tc tys) = TypeConstructor tc (map (norm vs) tys)
norm vs (TypeArrow ty1 ty2) = TypeArrow (norm vs ty1) (norm vs ty2)
norm _ tc@(TypeConstrained _ _) = tc
norm _ tsk@(TypeSkolem _) = tsk
absFunDecl :: String -> [Ident] -> [Ident] -> Decl -> LiftM Decl
absFunDecl pre fvs lvs (FunctionDecl p f eqs) =
absDecl pre lvs (FunctionDecl p f' (map (addVars f') eqs))
......
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