flugel428
@flugel428 has joined the channel
factMemo :: Int -> Integer factMemo = (map fact' [0..] !!) where fact' 0 = 1 fact' n = fromIntegral n * factMemo (n - 1) fact :: Int -> Integer fact x = map fact' [0..] !! x where fact' 0 = 1 fact' n = fromIntegral n * fact (n - 1)
fact'
は外に出されます.このため, map fact' [0..]
も CAF として扱われます. GHCi のバイトコード出すパスでは, core 2 core のパスが少し簡略化されてるので, full laziness が真面目に入ってないだけだと思いますね.真面目に入ってないただ後者のfact’がxを巻き込まずに外に出せるとすると意味論的に変わっちゃわないのかなという疑問が湧いてきたんだけど…
map fact' [0..]
の部分を切り出して, fact
の引数を受け取るようにして NOINLINE
すればいいと思いますね.と,思ったんですが,fact2 :: Int -> Integer fact2 x = factMemo2 x fact' !! x where fact' 0 = 1 fact' n = fromIntegral n * fact' (n - 1) factMemo2 :: Int -> (Int -> Integer) -> [Integer] factMemo2 _ f = map f [0..] {-# NOINLINE factMemo2 #-}
factMemo2
の参照が worker の方に書き換えられてしまいますね… 一応次の形式にすると -O
ならいい感じに CAF 化を妨害できるみたいです:fact2 :: Int -> Integer fact2 x = factMemo2 (x < 0) fact' !! x where fact' 0 = 1 fact' n = fromIntegral n * fact' (n - 1) factMemo2 :: Bool -> (Int -> Integer) -> [Integer] factMemo2 !_ f = map f [0..] {-# NOINLINE factMemo2 #-}
[1, 2, 3]
が build (\c n -> c 1 (c 2 (c 3 n)))
に変換されるというルールはどこに載っているでしょうか?System.Mem.Weak.Weak
のファイナライザーは別スレッドから(例えば main スレッドしか使っていなかったとして main 以外のスレッドから)呼ばれることを考慮すべきなのかと思いまして。ThreadID
見ろよという話type family Foo :: Type -> Type type instance Foo Bar = Baz
Foo Bar
はあるけど Foo Qux
はないことをテストに書きたい。type instance Foo Qux = Quux
があって、 Quux
でないことが確認できればよかったので次のように書けたdo let target :: Foo Qux ~ Quxx => () target = () shouldNotTypecheck target
Foo Qux
が本当になかった場合はどう書けるんだろうa + b = b + a a + 0 = a (a + b) + c = a + (b + c)
-1
がどのように導入されるかという話になりますが、-1
を考え、N に添加 (代数拡大) する-1
も含まれているだけ、ということです-
の実装を見て n - m = n + negate m
と書けるのは確認してましたが、数学的にはそう考えるのですね…Storable
のインスタンスを Handle
から一個読み込むのに、なにか良い感じの書き方はあるでしょうか。liftIO $ BS.hGet h (sizeOf @Int32 undefined) >>= BS.useAsCString `flip` (peek @Int32 . castPtr)
>=
, >
, <
, <=
をパースする関数がどうも不格好で冗長な見た目をしています。-- relational ::= add | add ("<" add | "<=" add | ">" add | ">=" add) relational :: Parser Expr relational = do a <- spaces *> add (do spaces *> char '<' (Lt a <$> (spaces *> relational)) <|> (Lte a <$> (char '=' *> spaces *> relational)) ) <|> (do spaces *> char '>' (Gt a <$> (spaces *> relational)) <|> (Gte a <$> (char '=' *> spaces *> relational)) ) <|> pure a
token p = do space v <- p space return v nat = do xs <- many1 digit return (read xs) -- natの「前後の空白をスキップするバージョン」を作っておく natural = token nat
spaces *> ...
という部分を抽象化するだけで結構すっきりするのではないかと思います。-- factor ::= '(' expr ')' | nat factor :: Parser Expr factor = (spaces *> char '(' *> spaces *> expr <* spaces <* char ')' <* spaces) <|> spaces *> nat <* spaces -- nat ::= '0' | '1' | '2' | ... nat :: Parser Expr nat = Nat . read <$> many1 digit
-- factor ::= '(' expr ')' | nat factor :: Parser Expr factor = (spaces *> char '(' *> spaces *> expr <* spaces <* char ')' <* spaces) <|> h -- nat ::= '0' | '1' | '2' | ... nat :: Parser Expr nat = Nat . read <$> many1 digit h :: Parser Expr h = space *> nat <* space
<|>
と <*
, *>
の演算子の結合が、変更前後で意図しない形に変わってしまっているのではないかと。> :i (<|>) class Applicative f => Alternative (f :: * -> *) where ... (<|>) :: f a -> f a -> f a ... -- Defined in ‘GHC.Base’ infixl 3 <|> > :i (<*) class Functor f => Applicative (f :: * -> *) where ... (<*) :: f a -> f b -> f a -- Defined in ‘GHC.Base’ infixl 4 <* > :i (*>) class Functor f => Applicative (f :: * -> *) where ... (*>) :: f a -> f b -> f b ... -- Defined in ‘GHC.Base’ infixl 4 *>
h
に切り出したときに spaces
から space
に変わってしまっているから?space
と spaces
のように、言葉遣いが違います... :bow:relOp ::= "<" | "<=" | ">" | ">=" relational ::= add | add relOp add
relOp :: Parser (Expr -> Expr -> Expr) relOp = l <|> g where l = do char '<' (char '=' *> pure Lte) <|> pure Lt g = do char '>' (char '=' *> pure Gte) <|> pure Gt
try
を使って素直に書いてしまいます。好みですが^^ (検証していないので、優先度ミスなどで期待通りに動かないかも。 あと、where節はほぼ同じパターンの繰り返しなので、さらにまとめられます。)relational :: Parser Expr relational = do a <- add try (lte a) <|> (lt a) <|> try (gte a) <|> (gt a) <|> pure a where lte t = Lte t <$> (string "<=" *> relational) lt t = Lt t <$> (char '<' *> relational) gte t = Gte t <$> (string ">=" *> relational) gt t = Gt t <$> (char '>' *> relational)
<|>
の替わりに choice
を使って、まとめてしまうことも。relational :: Parser Expr relational = do a <- add choice $ map try [ Lte a <$> (string "<=" *> relational) , Lt a <$> (char '<' *> relational) , Gte a <$> (string ">=" *> relational) , Gt a <$> (char '>' *> relational) , pure a ]
chainl1
を使って、全体をコンパクトに書く原典が以下にあります。 (as_capablさんスタイルですね。)-- relational ::= add (relop add | e) relational :: Parser Expr relational = add `chainl1` relop relop :: Parser (Expr -> Expr -> Expr) relop = choice $ map try [ Lte <$ string "<=" , Lt <$ string "<" , Gte <$ string ">=" , Gt <$ string ">" ] -- add ::= term (addop term | e) add :: Parser Expr add = term `chainl1` addop addop :: Parser (Expr -> Expr -> Expr) addop = Add <$ char '+' <|> Sub <$ char '-'