list や pair, triple などの Show クラス処理に取り掛かるまえに、 複数の辞書をうけとる関数のコンパイル状況をためそうとして、不具合に遭遇。
showpair0.hs:
f (a, b) = "(" ++ show a ++ "," ++ show b ++ ")"
main = putStrLn $ f (1, 'a')
これの core があやしい：
(Main.main :: (Prelude.IO ())) =
((Prim.putStrLn :: ([Prelude.Char] -> (Prelude.IO ()))) $
((((Main.f :: ([Prelude.Show t2,Prelude.Show t3] :=> ((((,) t3) t2) -> [Prelude.Char])))
${Prelude.Integer Prelude.Show})
${Prelude.Char Prelude.Show})
(((Prelude.(,) :: (t4 -> (t5 -> (((,) t4) t5))))
(1 :: ([Prelude.Num t6] :=> t6)))
'a')))
(Main.f :: ([Prelude.Show t21,Prelude.Show t22] :=> ((((,) t22) t21) -> [Prelude.Char]))) =
\(Main.f.DARG0 :: Ä) (Main.f.DARG1 :: Ä) ->
\(_Main.f.U1 :: ([Prelude.Show t7,Prelude.Show t8] :=> (((,) t8) t7))) ->
case (_Main.f.U1 :: ([Prelude.Show t7,Prelude.Show t8] :=> (((,) t8) t7))) (_Main.f.U1b :: ([Prelude.Show t7,Prelude.Show t8] :=> (((,) t8) t7))) of
Prelude.(,) (_Main.f.U2 :: t9) (_Main.f.U3 :: t10) :: (t9 -> (t10 -> (((,) t9) t10))) ->
(((Prelude.++ :: ([t11] -> ([t11] -> [t11])))
"(")
(((Prelude.++ :: ([t12] -> ([t12] -> [t12])))
(((Prelude.show :: ([Prelude.Show t13] :=> (t13 -> [Prelude.Char])))
(Main.f.DARG0 :: Å))
(_Main.f.U2 :: t9)))
(((Prelude.++ :: ([t16] -> ([t16] -> [t16])))
",")
(((Prelude.++ :: ([t17] -> ([t17] -> [t17])))
(((Prelude.show :: ([Prelude.Show t18] :=> (t18 -> [Prelude.Char])))
(Main.f.DARG0 :: Å))
(_Main.f.U3 :: t10))) ")"))))
lookupDict (k, tv) (((c, tv'), i):d')
- | k == c || k `elem` super ce c = Just i
- | otherwise = Nothing
- lookupDict _ _ = Nothing
+ | tv == tv' && (k == c || k `elem` super ce c) = Just i
+ | otherwise = lookupDict (k, tv) d'
+ lookupDict _ [] = Nothing
いままで、同じクラスの述語に対応していなかったので、k ==c (たとえば "Prelude.Show" == "Prelude.Show" のみ成立で対応付けていても偶々OKだった。 これを、ただしく型変数の一致、かつ、クラス名が一致またはスーパークラスに一致すればOKと変えた。
いままでは、型変数 y は用いられていなかったわけで、正しく用いるようにしたおかげで、 let (TVar y) = case apply s (TVar x) of ... のパターンが [a] に未対処だったのが露見。 ひとまず、lib/Prelude から Show [a] に関する部分をコメントアウトした。
bunnyc: Irrefutable pattern failed (TAp (TCon (Tycon "Prelude.[]" (Kfun Star Star))) (TVar (Tyvar "t215" Star))
これでも、まだ showpair0.hs はエラーする。今度は、二つの辞書を Main.f に渡す呼び出し側における順序があやしい。
つぎに呼び出し側の不具合調査と修正が必要だが、いったん master branch にマージする（make check は通っている状態）。
findApplyDict の内部関数 mkdicts は、結果を逆順に返していたので、それを利用するときに逆順にすべきだった。当初 foldl App e dicts だったのを foldl App e (reverse dicts) でもよかったのだが、foldr を使う形に修正：
--- a/compiler/src/DictPass.hs
+++ b/compiler/src/DictPass.hs
@@ -235,8 +235,8 @@ tcExpr e@(Var (TermVar n (qv :=> t'))) qt -- why ignore qs?
++ n ++ ", " ++ show (x,n2,y,itvars))
Just v' -> mkdicts qs (Var v' : ds)
mkdicts _ _ = error "mkdicts: must not occur"
- dicts <- mkdicts qv []
- return (foldl App e dicts)
+ dicts <- mkdicts qv [] -- mkdicts returns dictionaries in reverse order
+ return (foldr (flip App) e dicts)
{-
where
appliedQv :: [Expr] -> TC (Maybe (Qual Type))
showpair0.hsは sample161 とする。
クローズ。