git.iko.soy/elk
on master help sign in
Correct error with type inference.
54edea7evancz
src/Types/Unify.hs+14−13
compare with master
unifiedsplit
@@ -11,17 +11,6 @@ import Types
11
11
12import Control.DeepSeq
12import Control.DeepSeq
13
13
14−force x = x `deepseq` x
15−
16−instance NFData Constraint where
17− rnf (t1 :=: t2) = t1 `deepseq` t2 `deepseq` ()
18− rnf (t1 :<: t2) = t1 `deepseq` t2 `deepseq` ()
19−
20−instance NFData Type where
21− rnf (LambdaT t1 t2) = t1 `deepseq` t2 `deepseq` ()
22− rnf (ADT _ ts) = foldl' (\acc x -> x `deepseq` acc) () ts
23− rnf t = t `seq` ()
24−
25unify hints expr = run $ do
14unify hints expr = run $ do
26 cs <- constrain hints expr
15 cs <- constrain hints expr
27 solver cs []
16 solver cs []
@@ -49,7 +38,8 @@ solver ((t1 :=: t2) : cs) subs =
49
38
50solver ((t1 :<: t2) : cs) subs = do
39solver ((t1 :<: t2) : cs) subs = do
51 let f x = do y <- guid ; return (x,VarT y)
40 let f x = do y <- guid ; return (x,VarT y)
52− t2' <- foldl' (uncurry . flip tSub) t2 `liftM` (mapM f . Set.toList $ getVars t2)
41+ pairs <- mapM f . Set.toList $ getVars t2
42+ let t2' = foldr (uncurry tSub) t2 pairs
53 solver ((t1 :=: t2') : cs) subs
43 solver ((t1 :=: t2') : cs) subs
54
44
55
45
@@ -67,4 +57,15 @@ getVars (ADT name ts) = Set.unions $ map getVars ts
67getVars _ = Set.empty
57getVars _ = Set.empty
68
58
69uniError t1 t2 =
59uniError t1 t2 =
70− return . Left $ "Type error: " ++ show t1 ++ " is not equal to " ++ show t2
60+ return . Left $ "Type error: " ++ show t1 ++ " is not equal to " ++ show t2
61+
62+force x = x `deepseq` x
63+
64+instance NFData Constraint where
65+ rnf (t1 :=: t2) = t1 `deepseq` t2 `deepseq` ()
66+ rnf (t1 :<: t2) = t1 `deepseq` t2 `deepseq` ()
67+
68+instance NFData Type where
69+ rnf (LambdaT t1 t2) = t1 `deepseq` t2 `deepseq` ()
70+ rnf (ADT _ ts) = foldl' (\acc x -> x `deepseq` acc) () ts
71+ rnf t = t `seq` ()