Commit 65bfd25c authored by Finn Teegen's avatar Finn Teegen

Fix type of free variables in intermediate language

parent ac2384e7
Change log for curry-frontend
=============================
Version 1.0.2 (under development)
=============
* Fixed bug with wrong type of free variables in the intermediate language.
Version 1.0.1
=============
......
Name: curry-frontend
Version: 1.0.1
Version: 1.0.2
Cabal-Version: >= 1.10
Synopsis: Compile the functional logic language Curry to several
intermediate formats
......
......@@ -330,8 +330,8 @@ trAExpr (IL.Apply e1 e2) = trApply e1 e2
trAExpr c@(IL.Case t e bs) = flip ACase (cvEval t) <$> trType (IL.typeOf c) <*> trAExpr e
<*> mapM (inNestedEnv . trAlt) bs
trAExpr (IL.Or e1 e2) = AOr <$> trType (IL.typeOf e1) <*> trAExpr e1 <*> trAExpr e2
trAExpr (IL.Exist v e) = inNestedEnv $ do
v' <- newVar (IL.typeOf e) v
trAExpr (IL.Exist v ty e) = inNestedEnv $ do
v' <- newVar ty v
e' <- trAExpr e
ty' <- trType (IL.typeOf e)
return $ case e' of AFree ty'' vs e'' -> AFree ty'' (v' : vs) e''
......
......@@ -139,7 +139,7 @@ ppExpr p (Case ev e alts) = parenIf (p > 0) $
ppEval Flex = text "flex"
ppExpr p (Or e1 e2) = parenIf (p > 0) $ sep
[nest orIndent (ppExpr 0 e1), char '|', nest orIndent (ppExpr 0 e2)]
ppExpr p (Exist v e) = parenIf (p > 0) $ sep
ppExpr p (Exist v _ e) = parenIf (p > 0) $ sep
[text "let" <+> ppIdent v <+> text "free" <+> text "in", ppExpr 0 e]
ppExpr p (Let b e) = parenIf (p > 0) $ sep
[text "let" <+> ppBinding b <+> text "in",ppExpr 0 e]
......
......@@ -156,9 +156,10 @@ showsExpression (Or exp1 exp2)
. showsExpression exp1 . space
. showsExpression exp2
. showsString ")"
showsExpression (Exist ident expr)
showsExpression (Exist ident ty expr)
= showsString "(Exist "
. showsIdent ident . space
. showsType ty . space
. showsExpression expr
. showsString ")"
showsExpression (Let bind expr)
......
......@@ -102,7 +102,7 @@ data Expression
-- |non-deterministic or
| Or Expression Expression
-- |exist binding (introduction of a free variable)
| Exist Ident Expression
| Exist Ident Type Expression
-- |let binding
| Let Binding Expression
-- |letrec binding
......@@ -127,7 +127,7 @@ instance Expr Expression where
fv (Apply e1 e2) = fv e1 ++ fv e2
fv (Case _ e alts) = fv e ++ fv alts
fv (Or e1 e2) = fv e1 ++ fv e2
fv (Exist v e) = filter (/= v) (fv e)
fv (Exist v _ e) = filter (/= v) (fv e)
fv (Let (Binding v e1) e2) = fv e1 ++ filter (/= v) (fv e2)
fv (Letrec bds e) = filter (`notElem` vs) (fv es ++ fv e)
where (vs, es) = unzip [(v, e') | Binding v e' <- bds]
......
......@@ -35,7 +35,7 @@ instance Typeable Expression where
_ -> internalError "IL.Typing.typeOf: application"
typeOf (Case _ _ as) = typeOf $ head as
typeOf (Or e _) = typeOf e
typeOf (Exist _ e) = typeOf e
typeOf (Exist _ _ e) = typeOf e
typeOf (Let _ e) = typeOf e
typeOf (Letrec _ e) = typeOf e
typeOf (Typed e _) = typeOf e
......
......@@ -109,7 +109,7 @@ ccExpr (Case ea e bs) = do
bs' <- mapM ccAlt bs
ccCase ea e' bs'
ccExpr (Or e1 e2) = Or <$> ccExpr e1 <*> ccExpr e2
ccExpr (Exist v e) = Exist v <$> ccExpr e
ccExpr (Exist v ty e) = Exist v ty <$> ccExpr e
ccExpr (Let b e) = Let <$> ccBinding b <*> ccExpr e
ccExpr (Letrec bs e) = Letrec <$> mapM ccBinding bs <*> ccExpr e
ccExpr (Typed e ty) = flip Typed ty <$> ccExpr e
......@@ -278,9 +278,9 @@ replaceVar v e (Case ev e' bs)
= Case ev (replaceVar v e e') (map (replaceVarInAlt v e) bs)
replaceVar v e (Or e1 e2)
= Or (replaceVar v e e1) (replaceVar v e e2)
replaceVar v e (Exist w e')
| v == w = Exist w e'
| otherwise = Exist w (replaceVar v e e')
replaceVar v e (Exist w ty e')
| v == w = Exist w ty e'
| otherwise = Exist w ty (replaceVar v e e')
replaceVar v e (Let b e')
| v `occursInBinding` b = Let b e'
| otherwise = Let (replaceVarInBinding v e b)
......
......@@ -85,7 +85,7 @@ mdlsExpr (IL.Case _ e as) ms = mdlsExpr e (foldr mdlsAlt ms as)
mdlsPattern (IL.ConstructorPattern _ c _) = modules c
mdlsPattern _ = id
mdlsExpr (IL.Or e1 e2) ms = mdlsExpr e1 (mdlsExpr e2 ms)
mdlsExpr (IL.Exist _ e) ms = mdlsExpr e ms
mdlsExpr (IL.Exist _ _ e) ms = mdlsExpr e ms
mdlsExpr (IL.Let b e) ms = mdlsBinding b (mdlsExpr e ms)
mdlsExpr (IL.Letrec bs e) ms = foldr mdlsBinding (mdlsExpr e ms) bs
mdlsExpr _ ms = ms
......@@ -286,7 +286,7 @@ trExpr vs env (Let ds e) = do
e' <- trExpr vs env' e
case ds of
[FreeDecl _ vs']
-> return $ foldr IL.Exist e' $ map varIdent vs'
-> return $ foldr (\ (Var ty v) -> IL.Exist v (transType ty)) e' vs'
[d] | all (`notElem` bv d) (qfv emptyMIdent d)
-> flip IL.Let e' <$> trBinding d
_ -> flip IL.Letrec e' <$> mapM trBinding ds
......
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