※ 各抽象データ型について、Eq, Ord ... などの属性をすべてテストすること。 たとえば、タプルに対する Eq, Ord など未試験。
Standard Prelude (9.1 PreludeList の直前まで）を実装する。
(^) が signature too genenal となってエラーしていたのは、 typo で引数の順番がいれかわったりしていたことだった。
それをクリアして、その後、sequence, sequence_ の二つを定義。
Maybe は、instance ... はことごとく signature too general となる。 これは、instance methods にコンパイラがつけているシグネチャがなんか変なのかな。 これをクリアしたら、sequence の疎通に Maybe monad をつかおうかと思う。
Maybe を例にしつつ、deriving Show などを実装していこう。 これから先、Prelude を追加定義していくのに、deriving がないと不便なので。
まずは、Maybe についていま手で書いている以下の instance 宣言を自動生成するのを目標に実装する：
instance (Show a) => Show (Maybe a) where show Nothing = "Nothing" show (Just x) = "Just " ++ show x
上記に対応する Absyn は以下：
IDecl (InstDecl (Just (ParTy (AppTy (Tycon (Name {origName = "Show", namePos = (226,11), isConName = True})) (Tyvar (Name {origName = "a", namePos = (226,16), isConName = False}))))) (AppTy (Tycon (Name {origName = "Show", namePos = (226,22), isConName = True})) (ParTy (AppTy (Tycon (Name {origName = "Maybe", namePos = (226,28), isConName = True})) (Tyvar (Name {origName = "a", namePos = (226,34), isConName = False}))))) [VDecl (ValDecl (FunAppExp (VarExp (Name {origName = "show", namePos = (227,3), isConName = False})) (VarExp (Name {origName = "Nothing", namePos = (227,8), isConName = True}))) (UnguardedRhs (LitExp (LitString "Nothing" (227,19))) [])),VDecl (ValDecl (FunAppExp (VarExp (Name {origName = "show", namePos = (228,3), isConName = False})) (ParExp (FunAppExp (VarExp (Name {origName = "Just", namePos = (228,9), isConName = True})) (VarExp (Name {origName = "x", namePos = (228,14), isConName = False}))))) (UnguardedRhs (InfixExp (LitExp (LitString "Just " (228,19))) (Name {origName = "++", namePos = (228,27), isConName = False}) (FunAppExp (VarExp (Name {origName = "show", namePos = (228,30), isConName = False})) (VarExp (Name {origName = "x", namePos = (228,35), isConName = False})))) []))])
scandecl にやってくる A.DataDecl は以下のようなもの：
DataDecl (Nothing,AppTy (Tycon (Name {origName = "Maybe", namePos = (211,6), isConName = True})) (Tyvar (Name {origName = "a", namePos = (211,12), isConName = False}))) [Con (AppTy (Tycon (Name {origName = "Just", namePos = (211,26), isConName = True})) (Tyvar (Name {origName = "a", namePos = (211,31), isConName = False}))),Con (Tycon (Name {origName = "Nothing", namePos = (211,16), isConName = True}))] (Just [Tycon (Name {origName = "Show", namePos = (211,42), isConName = True})])
ひとまず、現状の Bool, Ordering, Maybe に適応できる程度の deriving Show を実装。 つぎは、Eq, Ord の順で。
最後に、ちゃんと Chapter 11 を確認すべし。
つぎは、deriving Eq を。
いま lib/Prelude.hs に記述している Eq (Maybe a) の instance 宣言は次の通り。 これにあたるものを scandecl 中で生成することになる：
instance (Eq a) => Eq (Maybe a) where Nothing == Nothing = True Just x == Just y = x == y _ == _ = False
これに対応する Absyn は以下：
IDecl (InstDecl (Just (ParTy (AppTy (Tycon (Name {origName = "Eq", namePos = (217,11), isConName = True})) (Tyvar (Name {origName = "a", namePos = (217,14), isConName = False}))))) (AppTy (Tycon (Name {origName = "Eq", namePos = (217,20), isConName = True})) (ParTy (AppTy (Tycon (Name {origName = "Maybe", namePos = (217,24), isConName = True})) (Tyvar (Name {origName = "a", namePos = (217,30), isConName = False}))))) [VDecl (ValDecl (InfixExp (VarExp (Name {origName = "Nothing", namePos = (218,3), isConName = True})) (Name {origName = "==", namePos = (218,11), isConName = False}) (VarExp (Name {origName = "Nothing", namePos = (218,14), isConName = True}))) (UnguardedRhs (VarExp (Name {origName = "True", namePos = (218,24), isConName = True})) [])),VDecl (ValDecl (InfixExp (FunAppExp (VarExp (Name {origName = "Just", namePos = (219,3), isConName = True})) (VarExp (Name {origName = "x", namePos = (219,8), isConName = False}))) (Name {origName = "==", namePos = (219,11), isConName = False}) (FunAppExp (VarExp (Name {origName = "Just", namePos = (219,14), isConName = True})) (VarExp (Name {origName = "y", namePos = (219,19), isConName = False})))) (UnguardedRhs (InfixExp (VarExp (Name {origName = "x", namePos = (219,24), isConName = False})) (Name {origName = "==", namePos = (219,26), isConName = False}) (VarExp (Name {origName = "y", namePos = (219,29), isConName = False}))) [])),VDecl (ValDecl (InfixExp WildcardPat (Name {origName = "==", namePos = (220,11), isConName = False}) WildcardPat) (UnguardedRhs (VarExp (Name {origName = "False", namePos = (220,24), isConName = True})) []))])
deriving Eq を実装、lib/Prelude.hs にあった Eq Ordering, Eq Maybe のインスタンス宣言は削除し、deriving Eq を用いるようにした。
つづいて Ord, Bounded ... と実装するまえに、lib/Prelude.hs の実装をすすめる。 Ord, Bounded の実例が増えてきてから、deriving Ord などをつくった方が、テストもしやすいと思われるため。
⇒ Either を追加していったら、さっそく型変数が２つ以上で deriving Eq, Show がこけるケースにあたった。ひとまず deriving せずに手で書いておく。 のちに、deriving でおきかえ。
⇒ deriving Eq, Show ともに type value が２つ以上のケースに対応。てで書いた instance 宣言を lib/Prelude.hs から削除した。
追加内容は こちら
これらのテストを書く必要がある。
以下 todo などに関するメモ：
Data.Ratio (Rational) ← Prelude ← Data.Ratio というように（ファイル単位でみると）相互依存しているのだが、Rational の定義だけ Prelude 中に書いてしまうことにした。
diff --git a/compiler/lib/Prelude.hs b/compiler/lib/Prelude.hs
index 6464dc6..1f22b36 100644
--- a/compiler/lib/Prelude.hs
+++ b/compiler/lib/Prelude.hs
@@ -128,6 +128,28 @@ class (Num a, Ord a, Enum a) => Integral a where
divMod n d = if signum r == - signum d then (q-1, r+d) else qr
where qr@(q,r) = quotRem n d
+-- (from here) todo: should be separated into Data.Ratio
+
+-- todo: (Integral a) =>
+-- :%, infix constructor
+-- deriving Eq
+data (Integral a) => Ratio a = a :% a
+
+type Rational = Ratio Integer
+
+instance (Eq a) => Eq (Ratio a) where
+ a :% b == c :% d = a == c && b == d
+
+-- todo: Integral is a instance of Show?
+-- showParen
+instance (Show a) => Show (Ratio a) where
+ show (x :% y) = show x ++ " % " ++ show y
+
+-- (to here) todo: should be separated into Data.Ratio
+
+class (Num a, Ord a) => Real a where
+ toRational :: a -> Rational
+
class (Num a) => Fractional a where
(/) :: a -> a -> a
recip :: a -> a
これで、Prelude は（import 機能を追加しなくても）全部書いてしまえるのではないか。
なお、testcases/myratio.hs から該当部分を抜いたら、エラーするようになってしまった。要調査。
Prim.mkdoubleToRational, mkfloatToRational を実装し、Double, Float を Real のインスタンスにした。
show が、負の数のときに括弧をつけられるようになっていないため、testcases/torational.hs は結果が不一致（新規 issue: 109)、正の場合のみにした torational2.hs を test/samples に加える (sample284.hs)。
fromRational 実装
testcases/fromrational.hs -> test/samples/sample285.hs
Prelude （PreludeList, PreludeText, PreludeIO は除く）の残項目をカウント。 残りは以下の１２項目：
(^^) と realToFrac に対応した。残り 10 項目。
PreludeList (081) を終わらせるためにも、３つ組 (triple) を実装することにした。
ごく単純なケースは通った (test/sample295.hs) が、let bind しようとしたものは失敗。 これは新規 issue (112) とする。
instance Functor [], instance Monad [] に対応。
まず、renSigdoc の以下の部分でエラーになることに対する対処が必要だった：
renSigdoc t@(A.Tycon n) kdict = do
issyn <- isSynonym t
if issyn
then do t' <- actualTy t
renSigdoc t' kdict
else do let n' = origName n
t <- lookupTConst n'
return $ fromMaybe (error $ "renSigDoc $ A.Tycon " ++ n') t
これには、PreDefined.hs における、initialTypeConsts に "[]" のエントリーを追加：
initialTypeConsts :: [(Id, Type)]
initialTypeConsts =
[ ("()", tUnit)
, ("Bool", tBool)
, ("Char", tChar)
, ("Int", tInt)
, ("Integer", tInteger)
, ("IO", tIO)
, ("Double", tDouble)
, ("Float", tFloat)
, ("[]", tList)
]
だが、これでは、以下のテストで Dictionary not found となった。
primes = sieve [2..] sieve (p:ps) = p : sieve [q | q <- ps, q `mod` p /= 0] main = print $ take 100 $ primes
[2..] が Integral t => [t] と型推論されて、defaulting モドキが働いていないのが原因だったので、仮対処（酷い）：
diff --git a/compiler/src/DictPass.hs b/compiler/src/DictPass.hs
index c528e2c..0215d8e 100644
--- a/compiler/src/DictPass.hs
+++ b/compiler/src/DictPass.hs
@@ -115,10 +115,11 @@ getTy (Var (TermVar n qt@(ps :=> _))) =
where checkPreds :: [Pred] -> TC ()
checkPreds [] = return ()
checkPreds (IsIn n v:ps)
- | n == "Prelude.Num" = do st <- get
- let tvars = tcIntegerTVars st
- put st{tcIntegerTVars = (v:tvars)}
- checkPreds ps
+ | n == "Prelude.Num" || n == "Prelude.Integral"
+ = do st <- get
+ let tvars = tcIntegerTVars st
+ put st{tcIntegerTVars = (v:tvars)}
+ checkPreds ps
| otherwise = checkPreds ps
samples298 から samples302 を追加。
2 つ消化したことで、残項目は 8/12 (67%) となった。
RealFrac の件を調査。
lib/Prelude.hs に以下を追加：
properfrac :: (Real a, Fractional a, Integral b) => a -> (b, a)
properfrac x = let (n :% d) = toRational x
(q, r) = quotRem n d
b = fromInteger q
a = fromInteger r / fromInteger d
in (b, a)
instance RealFrac Float where
properFraction = properfrac
すると、bunnyc: signature too general となってエラーする。
Debug.Trace をいれて確認すると、推測したとおり、Float むけの properFraction 関数の型注釈において、context が抜け落ちている：
("Prelude.Float%I.properFraction",Just ([] :=> TAp (TAp (TCon (Tycon "(->)" (Kfun Star (Kfun Star Star)))) (TCon (Tycon "Prelude.Float" Star))) (TAp (TAp (TCon (Tycon "Prelude.(,)" (Kfun Star (Kfun Star Star)))) (TVar (Tyvar "b" Star))) (TCon (Tycon "Prelude.Float" Star))))
Prelude.Float%I.properFraction :: b -> (b, a) となっている。 renInstDecl における、インスタンスメンバーの型注釈生成に問題あり。
インスタンスメンバーの型注釈生成に問題があったのは事実だった。
Rename の以下の箇所において、各メンバー関数の型注釈（Class 定義中にあるもの）は、 A.TypeSigDecl ns (sigvar,sigdoc) なのだが、ここの sigvar （sigdoc に対するコンテキスト）が使われずに捨てられている。
renTDecl :: Id -> A.Type -> Maybe A.Type -> A.ValueDecl -> RN [A.ValueDecl]
renTDecl pfx (A.AppTy _ tc) osv (A.TypeSigDecl ns (sigvar,sigdoc)) =
do ns' <- mapM (ren' pfx) ns
let Just (A.AppTy _ (A.Tyvar tv)) = sigvar
a = origName tv
subst' t@(A.Tyvar name) | origName name == a = tc
| otherwise = t
subst' t@(A.Tycon _) = t
subst' (A.FunTy t1 t2) = A.FunTy (subst' t1) (subst' t2)
subst' (A.AppTy t1 t2) = A.AppTy (subst' t1) (subst' t2)
subst' (A.BangTy t) = A.BangTy (subst' t)
subst' (A.TupleTy ts) = A.TupleTy $ map subst' ts
subst' (A.ListTy t) = A.ListTy (subst' t)
subst' (A.ParTy t) = subst' t
subst' t@(A.RecTy _) = t
sigdoc' = subst' sigdoc
d' = A.TypeSigDecl ns' (osv, sigdoc')
return [d']
これを直すまえに、この関数における型変数の置き換えが混乱している。
もとのクラス定義 class [context =>] tycls tyvar where... の tyvar を置き換えなくてはいけないのだが、なぜか、sigvar にあるものを置き換えている。
まずこの混乱を修正することにした。class 定義における tyvar を記録するようにし、 これと一致する型変数を置き換えるように。 （修正内容)
前回の修正意図通り、インスタンスメソッドの型注釈においては、クラスについていた context とメソッド定義の型注釈にあった context をマージしたものを使うようにしてみる。
--- a/compiler/src/Rename.hs
+++ b/compiler/src/Rename.hs
@@ -491,7 +491,7 @@ renInstDecls dcls' = do
| otherwise = Just (A.TupleTy ts)
in sigv
- d' = A.TypeSigDecl ns' ({-mergedsv-} osv, sigdoc')
+ d' = A.TypeSigDecl ns' (mergedsv, sigdoc')
return [d']
renTDecl pfx _ _ _ d = return [] -- not implemented yet.
すると、以下のように kind 推論でこけたらしいエラーとなる。
$ ./tcompile.sh lib/Prelude.hs --xno-implicit-prelude
source file: lib/Prelude.hs
dst dir: /Prelude
doCompile ... bunnyc: Kind not infered ("a",[])
CallStack (from HasCallStack):
error, called at src/Rename.hs:701:14 in main:Rename
どのようにこけているのか、というのもあるが、出力された型注釈が期待通りのものとなっているのか、まず確認したほうがいいだろう。
出力されるシグネチャや、それがどこでつくられるのかを見ていたら、原因はわかったように思う。
まず、以下のようなコンテキストをもつクラス定義があったときには、 compare の型としては、compare :: a -> a -> Ordering ではなく、 compare :: (Eq a) => a -> a -> Ordering が出力される。 (addvar というrenClassDecls ローカル関数をみよ）
そうしないと、a の種がわからず、compare の種も推定できないから、ということのよう。
class (Eq a) => Ord a where compare :: a -> a -> Ordering
のちに、インスタンスメソッドの型注釈をつくるときには、 型変数 a はインスタンスの型で置き換えられるので、コンテキストも不要というわけで、古い版の renTDecl では、メソッドの型注釈を端に捨てていた。
なお、メソッドの型注釈にユーザが書いたコンテキストがあった場合には、 addvar の時点で捨てられていた！
そこで、addvar の方でも、メソッドの型注釈を捨てないようにし、 のちの renTDecl では、これをまるごと捨てるのではなく、 ntyvar (クラス定義における型変数、型注釈においてはインスタンス型に置き換えられるもの) に関するコンテキストのみ取り除くようにした。
----
さらに見ていくと、上記はまちがっていた。メソッドの型注釈の処理は二か所にわかれていた。 クラス辞書に登録する（のちにインスタンス定義の際に用いられる）ための 型注釈は、extrTSygDecl のほうだった。こちらには、クラスの型変数注釈はいらくて（のちに置き換えられるのて）、書かれているものをそのまま渡せばよかった。
- extrTSygDecl (A.VDecl (A.TypeSigDecl ns (_, sigdoc))) =
- [A.TypeSigDecl ns (Just sigvar, sigdoc)]
+ extrTSygDecl (A.VDecl (A.TypeSigDecl ns (sigvar', sigdoc))) =
+ [A.TypeSigDecl ns ({-Just sigvar-} sigvar', sigdoc)]
extrTSygDecl _ = []
tdcls = concatMap extrTSygDecl ds
これで、いま理解している限りではまともになったような気がするのだが、 instance RealFrac Float を lib/Prelude に追加すると、signature too general となる。
けいぞく。
testcases/properfrac001.hs を追加これは OK。インスタンスメソッドもこれと同様になると思うのだが、何が違うのか。比較しながら追いかけてみよう。
properFraction の型注釈は期待通りになったはずなので、 被疑個所は properFraction ではなくデフォルトの実装が生成される他の関数なのではないかと疑ってみた。
そこで、以下のように、他の関数を undefined にして、コメントアウトして (コメントアウトすると、デフォルトの実装が有効になる)エラー個所を絞る。
instance RealFrac Float where properFraction = properfrac truncate = undefined round = undefined ceiling = undefined floor = undefined
その結果、round のデフォルト実装に問題があるらしいことがわかった。そこを書き換えることで、通るようになった。（変更箇所)
2つのテストケースは、test/samples に追加する：
RealFrac ができたので、それに依存していた instance Enum (Float|Double) の定義を lib/Prelude.hs についか。問題なし。
sample306, sample307 をテストに加えた。
残り二つは、どちらからやってもよさそう：
だが、Bounded Char だけでなく、いくつか作り忘れがあるので、落穂ひろいが必要。
instance Enum, Bool, Ordering に対応（Int, Integer, Float, Double は対応済だった）
残りは、Bounded と RealFloat で、互いに依存していないので、どちらを先にやってもよい。
Bounded を済ませた。sample313, sample314 を追加。
残りは RealFloat だが、結構面倒な上に、他のものがこれに依存しているわけではないので、後回しにしたい。（気が向いたときに片付けよう）