diff --git a/CHANGELOG.md b/CHANGELOG.md index dd35b2844cdd12995b8865d43176639de299a98e..426fbf961a7a39956744b45adf8d2cfb7477cbf0 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,11 @@ 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 ============= diff --git a/curry-frontend.cabal b/curry-frontend.cabal index bedef36c42e94a707ae721b14cdfc69b593f9003..a33c8af5c60312903ede013358aca0f30b7b8114 100644 --- a/curry-frontend.cabal +++ b/curry-frontend.cabal @@ -1,5 +1,5 @@ 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 diff --git a/src/Generators/GenTypedFlatCurry.hs b/src/Generators/GenTypedFlatCurry.hs index 53269ececef8aab67871a4c4d014fb60ff7016c9..3c27e97120fb87131e9777996cebe5ab87bc0dfd 100644 --- a/src/Generators/GenTypedFlatCurry.hs +++ b/src/Generators/GenTypedFlatCurry.hs @@ -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'' diff --git a/src/IL/Pretty.hs b/src/IL/Pretty.hs index 3f19b792a93be6a1a149a18c117c1d13ad3af573..f004a9550850486eaf5e6d62fa2059761a84bf07 100644 --- a/src/IL/Pretty.hs +++ b/src/IL/Pretty.hs @@ -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] diff --git a/src/IL/ShowModule.hs b/src/IL/ShowModule.hs index 5c7df4fd681ede1f74cc04102258f96347ea8db1..16ae05cf8c0e7a8e2e3eaf8c2a4dcf7453367ad7 100644 --- a/src/IL/ShowModule.hs +++ b/src/IL/ShowModule.hs @@ -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) diff --git a/src/IL/Type.hs b/src/IL/Type.hs index b171c2fcf31a0aebb3b2d5aeb3348c9cb529224f..79cd06e29a6d4e5dbce041f94cfaf91397f30258 100644 --- a/src/IL/Type.hs +++ b/src/IL/Type.hs @@ -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] diff --git a/src/IL/Typing.hs b/src/IL/Typing.hs index 829a1b66334e44db72bca1a85674c48e103accd1..727f86dce439b45303c21969ca5c83556631ae6e 100644 --- a/src/IL/Typing.hs +++ b/src/IL/Typing.hs @@ -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 diff --git a/src/Transformations/CaseCompletion.hs b/src/Transformations/CaseCompletion.hs index 2ba66346d76bf948b77e6692e407cafa57871967..3d81a5af7e2c60e772c8322b30cc85c088c1da1e 100644 --- a/src/Transformations/CaseCompletion.hs +++ b/src/Transformations/CaseCompletion.hs @@ -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) diff --git a/src/Transformations/CurryToIL.hs b/src/Transformations/CurryToIL.hs index a0667fdc5840f879c0fe75d94b5bdcbc3b1f747e..ebe670851ed2c2f4514cd478fb818639be7b1bed 100644 --- a/src/Transformations/CurryToIL.hs +++ b/src/Transformations/CurryToIL.hs @@ -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