まだ Prelude.hs 以外の import 機能がないため、testcases/myratio.hs 上で Ratio クラスのインプリを進める。
いろいろ未実装機能がでてくると思われる。
現在の myratio.hs は以下のとおり：
infixl 7 %
ratPrec = 7 :: Int
-- todo: (Integral a) =>
-- :%, infix constructor
-- deriving Eq
data Ratio a = Rat a a
type Rational = Ratio Integer
instance (Eq a) => Eq (Ratio a) where
Rat a b == Rat c d = a == c && b == d
reduce _ 0 = error "Ratio.% : zero denominator"
reduce x y = Rat (x `quot` d) (y `quot` d)
where d = gcd x y
x % y = reduce (x * signum y) (abs y)
numerator (Rat x _) = x
denominator (Rat _ y) = y
instance (Integral a) => Ord (Ratio a) where
Rat x y <= Rat x' y' = x * y' <= x' * y
Rat x y < Rat x' y' = x * y' < x' * y
instance (Integral a) => Num (Ratio a) where
Rat x y + Rat x' y' = reduce (x*y' + x'*y) (y*y')
Rat x y * Rat x' y' = reduce (x*x') (y*y')
negate (Rat x y) = Rat (-x) y
abs (Rat x y) = Rat (abs x) y
signum (Rat x y) = Rat (signum x) 1
fromInteger x = Rat (fromInteger x) 1
-- todo: Integral is a instance of Show?
-- showParen
instance (Show a) => Show (Ratio a) where
show (Rat x y) = show x ++ " % " ++ show y
main = do print a
print b
print (a < b)
-- print $ a + b
-- print $ a * b
-- print (- a)
-- print (fromInteger 8 :: Ratio Int)
where a, b :: (Ratio Integer)
a = 5 % 10
b = 1 % 2
コメントにも書いてあるような work-aroud をほどこしつつ仮実装をすすめているが、 上記のコードでランタイムエラーが発生する。
原因は、CompositDict の作成に不具合があるため。 print (a < b) のところで、< に渡す辞書を生成しているのだが、 以下のように、(CompositDict ${Main.Ratio Prelude.Ord [${Prelude.Integer Prelude.Ord}])} を渡している。
((((Prelude.< :: ([Prelude.Ord t21] :=> (t21 -> (t21 -> Prelude.Bool))))
(CompositDict ${Main.Ratio Prelude.Ord} [${Prelude.Integer Prelude.Ord}]))
(Main.l27.l0.a :: (Main.Ratio Prelude.Integer)))
(Main.l27.l0.b :: (Main.Ratio Prelude.Integer))))))
だが、instance (Integer a) => Ord (Ratio a) ... であるから、 CompositDict の引数は ${Prelude.Integer Prelude.Ord } ではなく、${Prelude.Integer Prelude.Integral } でなくてはならない。 CompositDict 全体が Ord クラスの辞書だからといって、その引数も Ord とは限らず、インスタンス宣言によって適切な辞書を選ぶ必要があった。
DictPass の以下の部分（findApplyDict の一部）で、(ty2dict n2) の n2 の部分が、 ここでいう Ord にあたるのだが、これが n2 とイコールとは限らず、instance n2 n1 宣言の context によって適切なものを指定しなければならない。
ty2dict n2 ty@(TAp _ _) = do
let (n1, ts) = extr' ty []
cdd = Var (DictVar n1 n2)
-- todo: the order of cdds shold be reordered
cdds <- mapM (ty2dict n2) ts
return $ Var (CompositDict cdd cdds)
where extr' (TCon (Tycon n1 _)) ts = (n1, ts)
extr' (TAp t1 t2) ts = extr' t1 (t2:ts)
ってことは、辞書定義情報を DictPass にひきわたしておかないといけないわけだが、 現状どうだったかな。
なさそう↓
data TcState = TcState { tcCe :: !ClassEnv
, tcPss :: ![(Pred, Id)]
, tcSubst :: !Subst
, tcNum :: !Int
, tcIntegerTVars :: ![Type]
}
deriving Show
instance 宣言の context をそのままというわけにはいかないはずなので、 すこし考える必要がある。たとえば、instance (Ord a, Num a) => Ord (Hoge a) とかで、 あるメソッドは Num がいるが、ほかのメソッドでは Ord だけでいいということも ありうるのでは…。ないか、保留しておいて、あとで考えよう（まずは単純に作ろう）。
単純なところから。data (Integral a) => a :% a と書けるようにしよう。
まず、右辺に infix operator を許すようにした。後者はまだ。
次は後者。'a' :% 'b' が現状ではコンパイルエラーにならないのだが、 これが弾かれるようにすべき。
どうも、調子がでないので、ちいさなステップにわけて乗り越えよう。
instance (Integral a) => Ord (Ratio a) を対応するのに、
最初のステップ、決め打ちで Ord (Ratio a) の a への制約を Integral にする：
--- a/compiler/src/DictPass.hs
+++ b/compiler/src/DictPass.hs
@@ -231,7 +231,10 @@ findApplyDict e (qv :=> t') (_ :=> t) = do
ty2dict n2 (TAp (TCon (Tycon n1 _)) ty) = do
let cdd = Var (DictVar n1 n2)
- cdds <- mapM (ty2dict n2) [ty]
+ n3 | n1 == "Main.Ratio" && n2 == "Prelude.Ord" = "Prelude.Integral"
+ | otherwise = n2
+ trace (show (n1, n2, n3)) $ return ()
+ cdds <- mapM (ty2dict n3) [ty]
return $ Var (CompositDict cdd cdds)
ty2dict n2 ty@(TAp _ _) = do
ここで n3 は (n1, n2) の関数であることに注意。 instance (Integral a) => Ord (Ratio a) の Ratio, Ord, Integral がそれぞれ n1, n2, n3 に対応する。
つぎは、この情報を Rename で獲得し、DictPass に受け渡すところの実装。
ひとまず、branch : instanceContext108 でコミットしておく。
いいかげんでもいいから実装をすすめよう、といいつつ、あまりにいい加減すぎるのもあれなので、少し調べる。
instance 宣言の例として、「すごいH~」、「Haskell 入門」にでてくるものは、いずれも単純なもの（コンテキストのない instance Eq Hoge where.. 様のもの）のみ。
Standard Prelude には、以下の形が出現する：
instance (Show a) => Show [a] where ... instance (Show a, Show b) => Show (a,b) where ...
これしかでてこなかったので、複合辞書のクラスを決め打ちできた（Show [a] から Show a を勝手に推定していた）のが、Ratio で崩れた格好。
Control.Monad には以下の形が出現する：
instance Ix i => Functor (Array i)
Data.Array にも、結構複雑な形がでてくるなぁ。
まぁ、ひとまず Ratio の例のみカバーできる実装でお茶を濁しつつ先にすすむか（いま不調だし。まじめにやるのは力が満ちているときに）。
割り切って、( "Main.Ratio", "Prelude.Ord") \(\mapsto\) "Prelude.Integral" となるような辞書をつくって使う。
件の情報は、ひとまず [((Id, Id), Id)] 型にする。instance context ということで、 IContext という名前で。
Rename でこの情報を収集、DictPass でこれを使うように変更：
findApplyDict e (qv :=> t') (_ :=> t) = do
unify' t' t
@@ -230,10 +231,11 @@ findApplyDict e (qv :=> t') (_ :=> t) = do
mkdicts qs (d:ds)
ty2dict n2 (TAp (TCon (Tycon n1 _)) ty) = do
+ iconst <- tcIContext <$> get
let cdd = Var (DictVar n1 n2)
- n3 | n1 == "Main.Ratio" && n2 == "Prelude.Ord" = "Prelude.Integral"
- | otherwise = n2
- trace (show (n1, n2, n3)) $ return ()
+ n3 = case lookup (n1, n2) iconst of
+ Just s -> s
+ Nothing -> n2
cdds <- mapM (ty2dict n3) [ty]
return $ Var (CompositDict cdd cdds)
やっつけ実装ではあるが、test をクリアした状態のまま半歩すすめたのでよしとする。
master ブランチにマージすることにする。
Num の Instance の方もうごくようになったので、myratio でコメントアウトしてあったのをはずす（ついでに、値も少し変更）：
main = do print a
print b
-- print c
print (a < b)
print $ a + b
print $ a * b
print (- a)
print (fromInteger 8 :: Ratio Int)
where a, b :: (Ratio Integer)
a = 2 % 6
b = 768 % (768 * 2)
-- c = 'a' :% 'c' -- should be an error
実行結果：
1 % 3 1 % 2 True 5 % 6 1 % 6 -1 % 3 8 % 1
つぎ、つまづくところまで進めよう。…と思ったが、Real や Fractional をこのまま（Prelude.hs にインポートできないまま）つづけても面白くはなさそう。
Prelude 側で Fractional とかつくってみるかな。