@@ -4,10 +4,23 @@ module Unify where
44import Constrain
55import Control.Arrow (second)
66import Control.Monad (liftM)
7+import Data.List (foldl')
78import qualified Data.Set as Set
9+import Guid
810import Types
911
10−import Guid
12+import Control.DeepSeq
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` ()
1124
1225unify hints expr = run $ do
1326 cs <- constrain hints expr
@@ -36,16 +49,16 @@ solver ((t1 :=: t2) : cs) subs =
3649
3750solver ((t1 :<: t2) : cs) subs = do
3851 let f x = do y <- guid ; return (x,VarT y)
39− t2' <- foldr (uncurry tSub) t2 `liftM` (mapM f . Set.toList $ getVars t2)
52+ t2' <- foldl' (uncurry . flip tSub) t2 `liftM` (mapM f . Set.toList $ getVars t2)
4053 solver ((t1 :=: t2') : cs) subs
4154
4255
43−cSub k v (t1 :=: t2) = tSub k v t1 :=: tSub k v t2
44−cSub k v (t1 :<: t2) = tSub k v t1 :<: tSub k v t2
56+cSub k v (t1 :=: t2) = force $ tSub k v t1 :=: tSub k v t2
57+cSub k v (t1 :<: t2) = force $ tSub k v t1 :<: tSub k v t2
4558
46−tSub k v (VarT x) = if k == x then v else (VarT x)
47−tSub k v (LambdaT t1 t2) = LambdaT (tSub k v t1) (tSub k v t2)
48−tSub k v (ADT name ts) = ADT name (map (tSub k v) ts)
59+tSub k v t@(VarT x) = if k == x then v else t
60+tSub k v (LambdaT t1 t2) = force $ LambdaT (tSub k v t1) (tSub k v t2)
61+tSub k v (ADT name ts) = ADT name (map (force . tSub k v) ts)
4962tSub _ _ t = t
5063
5164getVars (VarT x) = Set.singleton x