From 1360cbaee41b18be5eecf8fa053bb2354ebea7ec Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Oskar=20Wickstr=C3=B6m?= Date: Mon, 14 Dec 2015 20:46:47 +0100 Subject: [PATCH 1/3] Accept base 4.9 --- chapter7/poly_constraints/poly.cabal | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/chapter7/poly_constraints/poly.cabal b/chapter7/poly_constraints/poly.cabal index 167d4c9..d0fc1f6 100644 --- a/chapter7/poly_constraints/poly.cabal +++ b/chapter7/poly_constraints/poly.cabal @@ -9,14 +9,14 @@ extra-source-files: README.md cabal-version: >=1.10 executable poly - build-depends: - base >= 4.6 && <4.7 - , pretty >= 1.1 && <1.2 - , parsec >= 3.1 && <3.2 - , text >= 1.2 && <1.3 - , containers >= 0.5 && <0.6 - , mtl >= 2.2 && <2.3 - , transformers >= 0.4.2 && <0.5 + build-depends: + base >= 4.6 && <= 4.9 + , pretty >= 1.1 && < 1.2 + , parsec >= 3.1 && < 3.2 + , text >= 1.2 && < 1.3 + , containers >= 0.5 && < 0.6 + , mtl >= 2.2 && < 2.3 + , transformers >= 0.4.2 && < 0.5 , repline >= 0.1.2.0 default-language: Haskell2010 main-is: Main.hs From 4c95369fb03e8c91ffb789cb5f516934af584603 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Oskar=20Wickstr=C3=B6m?= Date: Mon, 14 Dec 2015 20:47:10 +0100 Subject: [PATCH 2/3] Replace case of with do blocks for Either --- 006_hindley_milner.md | 6 +++--- chapter7/poly/Infer.hs | 12 ++++++------ chapter7/poly_constraints/Infer.hs | 27 ++++++++++++--------------- 3 files changed, 21 insertions(+), 24 deletions(-) diff --git a/006_hindley_milner.md b/006_hindley_milner.md index b4f548e..cea9717 100644 --- a/006_hindley_milner.md +++ b/006_hindley_milner.md @@ -250,9 +250,9 @@ type scheme. ```haskell runInfer :: Infer (Subst, Type) -> Either TypeError Scheme -runInfer m = case evalState (runExceptT m) initUnique of - Left err -> Left err - Right res -> Right $ closeOver res +runInfer m = do + res <- evalState (runExceptT m) initUnique + return (closeOver res) ``` Substitution diff --git a/chapter7/poly/Infer.hs b/chapter7/poly/Infer.hs index d1a905c..a2c5ee5 100644 --- a/chapter7/poly/Infer.hs +++ b/chapter7/poly/Infer.hs @@ -31,9 +31,9 @@ data TypeError | GenericTypeError runInfer :: Infer (Subst, Type) -> Either TypeError Scheme -runInfer m = case evalState (runExceptT m) initUnique of - Left err -> Left err - Right res -> Right $ closeOver res +runInfer m = do + res <- evalState (runExceptT m) initUnique + return (closeOver res) closeOver :: (Map.Map TVar Type, Type) -> Scheme closeOver (sub, ty) = normalize sc @@ -190,9 +190,9 @@ inferExpr env = runInfer . infer env inferTop :: TypeEnv -> [(String, Expr)] -> Either TypeError TypeEnv inferTop env [] = Right env -inferTop env ((name, ex):xs) = case (inferExpr env ex) of - Left err -> Left err - Right ty -> inferTop (extend env (name, ty)) xs +inferTop env ((name, ex):xs) = do + ty <- (inferExpr env ex) + inferTop (extend env (name, ty)) xs normalize :: Scheme -> Scheme normalize (Forall ts body) = Forall (fmap snd ord) (normtype body) diff --git a/chapter7/poly_constraints/Infer.hs b/chapter7/poly_constraints/Infer.hs index 30e1673..2774562 100644 --- a/chapter7/poly_constraints/Infer.hs +++ b/chapter7/poly_constraints/Infer.hs @@ -100,21 +100,18 @@ runInfer env m = runExcept $ evalRWST m env initInfer -- | Solve for the toplevel type of an expression in a given environment inferExpr :: Env -> Expr -> Either TypeError Scheme -inferExpr env ex = case runInfer env (infer ex) of - Left err -> Left err - Right (ty, cs) -> case runSolve cs of - Left err -> Left err - Right subst -> Right $ closeOver $ apply subst ty +inferExpr env ex = do + (ty, cs) <- runInfer env (infer ex) + subst <- runSolve cs + return (closeOver (apply subst ty)) -- | Return the internal constraints used in solving for the type of an expression constraintsExpr :: Env -> Expr -> Either TypeError ([Constraint], Subst, Type, Scheme) -constraintsExpr env ex = case runInfer env (infer ex) of - Left err -> Left err - Right (ty, cs) -> case runSolve cs of - Left err -> Left err - Right subst -> Right $ (cs, subst, ty, sc) - where - sc = closeOver $ apply subst ty +constraintsExpr env ex = do + (ty, cs) <- runInfer env (infer ex) + subst <- runSolve cs + let sc = closeOver $ apply subst ty + return (cs, subst, ty, sc) -- | Canonicalize and return the polymorphic toplevel type. closeOver :: Type -> Scheme @@ -217,9 +214,9 @@ infer expr = case expr of inferTop :: Env -> [(String, Expr)] -> Either TypeError Env inferTop env [] = Right env -inferTop env ((name, ex):xs) = case (inferExpr env ex) of - Left err -> Left err - Right ty -> inferTop (extend env (name, ty)) xs +inferTop env ((name, ex):xs) = do + ty <- (inferExpr env ex) + inferTop (extend env (name, ty)) xs normalize :: Scheme -> Scheme normalize (Forall _ body) = Forall (map snd ord) (normtype body) From a4ccca1040aa67f6d32411754266070bb7b1cf83 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Oskar=20Wickstr=C3=B6m?= Date: Mon, 14 Dec 2015 20:53:34 +0100 Subject: [PATCH 3/3] Add to contributors --- CONTRIBUTORS.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CONTRIBUTORS.md b/CONTRIBUTORS.md index 0501c08..25ab145 100644 --- a/CONTRIBUTORS.md +++ b/CONTRIBUTORS.md @@ -15,3 +15,4 @@ Contributors * Christian Sievers * Franklin Chen * Jake Taylor +* Oskar Wickström