git.iko.soy/elk
on master help sign in
Fix bug in `concretize` in which a fold uses the base for every step instead of accumulating the result (i.e. `t` becomes `t'`). One character mistakes are the worst! Let-polymorphism should be working for everything now! FINALLY! Mabye...
dea401bevancz
elm/src/Types/Constrain.hs+1−1
compare with master
unifiedsplit
@@ -14,7 +14,7 @@ import Types.Substitutions
14
14
15--import System.IO.Unsafe
15--import System.IO.Unsafe
16
16
17−prints xs v = v --unsafePerformIO (putStrLn "~~~~~~~~~~" >> mapM print xs) `seq` v
17+prints xs v = v --} unsafePerformIO (putStrLn "~~~~~~~~~~" >> mapM print xs) `seq` v
18
18
19beta = VarT `liftM` guid
19beta = VarT `liftM` guid
20unionA = Map.unionWith (++)
20unionA = Map.unionWith (++)
elm/src/Types/Substitutions.hs+4−4
@@ -69,15 +69,15 @@ cSubNoContext k v (x :<<: poly@(Forall vs cs tipe)) = force $ x :<<: poly'
69
69
70concretize (Forall xs cs t) = do
70concretize (Forall xs cs t) = do
71 pairs <- mapM (\x -> liftM ((,) x) guid) xs
71 pairs <- mapM (\x -> liftM ((,) x) guid) xs
72− return ( foldl' (\t' (k,v) -> tSub k (VarT v) t) t pairs
72+ return ( foldl' (\t' (k,v) -> tSub k (VarT v) t') t pairs
73 , foldl' (\cs' (k,v) -> map (cSub k $ VarT v) cs') cs pairs )
73 , foldl' (\cs' (k,v) -> map (cSub k $ VarT v) cs') cs pairs )
74
74
75rescheme :: Scheme -> GuidCounter Scheme
75rescheme :: Scheme -> GuidCounter Scheme
76rescheme (Forall xs cs t) = do
76rescheme (Forall xs cs t) = do
77 pairs <- mapM (\x -> liftM ((,) x) guid) xs
77 pairs <- mapM (\x -> liftM ((,) x) guid) xs
78− let t' = foldl' (\t' (k,v) -> tSub k (VarT v) t') t pairs
78+ let tipe = foldl' (\t' (k,v) -> tSub k (VarT v) t') t pairs
79− let cs' = foldl' (\cs' (k,v) -> map (cSub k $ VarT v) cs') cs pairs
79+ let cs' = foldl' (\cs' (k,v) -> map (cSub k $ VarT v) cs') cs pairs
80− return $ Forall (map snd pairs) cs' t'
80+ return $ Forall (map snd pairs) cs' tipe
81
81
82freeVars (VarT v) = [v]
82freeVars (VarT v) = [v]
83freeVars (LambdaT t1 t2) = freeVars t1 ++ freeVars t2
83freeVars (LambdaT t1 t2) = freeVars t1 ++ freeVars t2
elm/src/Types/Unify.hs+4−4
@@ -13,8 +13,7 @@ import Types.Substitutions
13
13
14--import System.IO.Unsafe
14--import System.IO.Unsafe
15
15
16−prints xs v = v --unsafePerformIO (putStrLn "----------" >> mapM print xs) `seq` v
16+prints xs v = v --} unsafePerformIO (putStrLn "----------" >> mapM print xs) `seq` v
17−prints' xs v = v --prints (Map.toList xs) v
18
17
19unify hints modul = run $ do
18unify hints modul = run $ do
20 cs <- constrain hints modul
19 cs <- constrain hints modul
@@ -91,10 +90,11 @@ solver (Context ctx (t :<: Super ts) : cs) subs
91solver (Context ctx (x :<<: s) : cs) subs
90solver (Context ctx (x :<<: s) : cs) subs
92 | any (\(Context _ c) -> x `elem` cFreeVars c) cs =
91 | any (\(Context _ c) -> x `elem` cFreeVars c) cs =
93 do cs' <- concat `liftM` mapM (schemeSub x s) cs
92 do cs' <- concat `liftM` mapM (schemeSub x s) cs
94− solver cs' subs
93+ prints cs' $ solver cs' subs
95 | otherwise =
94 | otherwise =
96 do (t,cs') <- concretize s
95 do (t,cs') <- concretize s
97− solver (Context ctx (VarT x :=: t) : map (extendCtx ctx) cs' ++ cs) subs
96+ let cs'' = (cs ++ Context ctx (VarT x :=: t) : map (extendCtx ctx) cs')
97+ prints cs'' $ solver cs'' subs
98
98
99
99
100uniError ctx t1 t2 =
100uniError ctx t1 t2 =