プログラミングHaskell 第2版

第1章導入

第2章はじめの一歩

第3章型と型クラス

第4章関数定義

第5章リスト内包表記

Q: すべての答えがないのはなぜだろう
- A: 多分大学の課題で出してるから

第6章再帰関数

第7章高階関数

第8章型と型クラスの定義

恒真式検査器

type Bit = Int

int2bin :: Int -> [Bit]
int2bin 0 = []
int2bin n = n `mod` 2 : int2bin (n `div` 2)

rmdups :: (Eq a) => [a] -> [a]
rmdups [] = []
rmdups (x : xs) = x : rmdups (filter (/= x) xs)

type Assoc k v = [(k, v)]

find :: (Eq a) => a -> Assoc a b -> b
find a ((a', b) : xs)
  | a == a' = b
  | otherwise = find a xs

data Prop
  = Const Bool
  | Var Char
  | Not Prop
  | And Prop Prop
  | Imply Prop Prop

p1 :: Prop
p1 = And (Var 'A') (Not (Var 'A'))

p2 :: Prop
p2 = Imply (And (Var 'A') (Var 'B')) (Var 'B')

p3 :: Prop
p3 = Imply (Var 'A') (And (Var 'A') (Var 'B'))

p4 :: Prop
p4 = Imply (And (Var 'A') (Imply (Var 'A') (Var 'B'))) (Var 'B')

type Subst = Assoc Char Bool

eval :: Subst -> Prop -> Bool
eval _ (Const b) = b
eval s (Var x) = find x s
eval s (Not p) = not $ eval s p
eval s (And p q) = eval s p && eval s q
eval s (Imply p q) = not (eval s p) || eval s q

vars :: Prop -> [Char]
vars (Const _) = []
vars (Var x) = [x]
vars (Not p) = vars p
vars (And p q) = vars p ++ vars q
vars (Imply p q) = vars p ++ vars q

bools :: Int -> [[Bool]]
bools 0 = [[]]
bools n = map (False :) bss ++ map (True :) bss
  where
    bss = bools (n - 1)

substs :: Prop -> [Subst]
substs p = map (zip vs) $ bools $ length vs
  where
    vs = rmdups $ vars p

isTaut :: Prop -> Bool
isTaut p = and [eval s p | s <- substs p]

抽象機械

data Expr = Val Int | Add Expr Expr

data Op = EVAL Expr | ADD Int

type Cont = [Op]

eval :: Expr -> Cont -> Int
eval (Val n) c = exec c n
eval (Add x y) c = eval x $ EVAL y : c

exec :: Cont -> Int -> Int
exec [] n = n
exec (EVAL y : c) n = eval y (ADD n : c)
exec (ADD n : c) m = exec c (n + m)

value :: Expr -> Int
value e = eval e []

第9章カウントダウン問題

ちょっと駆け足な感じが

第10章対話プログラム

副作用があるプログラムを「ある状態の世界」を引数に取り、「別の状態の世界」を結果として返す純粋な関数とみなす
- World -> World ということ
- 良いｺﾄﾊﾞﾁｶﾗだ（小並感）
「いったに汚れたら永遠に汚れたままであり、純粋さを取り戻せる可能性はありません！」
- もうちょっとマイルドな表現なかったんか；；

ハングマン

import System.IO (hSetEcho, stdin)

hangman :: IO ()
hangman = do
  putStrLn "Think of a word:"
  word <- sgetLine
  putStrLn "Try to guess it:"
  play word

sgetLine :: IO String
sgetLine = do
  x <- getCh
  if x == '\n'
    then do
      putChar x
      return []
    else do
      putChar '-'
      xs <- sgetLine
      return (x : xs)

getCh :: IO Char
getCh = do
  hSetEcho stdin False
  x <- getChar
  hSetEcho stdin True
  return x

play :: String -> IO ()
play word = do
  putStr "? "
  guess <- getLine
  if guess == word
    then putStrLn "You got it!!"
    else do
      putStrLn (match word guess)
      play word

match :: String -> String -> String
match xs ys = do
  x <- xs
  if x `elem` ys
    then [x]
    else "-"

ニム

import Data.Char (digitToInt, isDigit)

next :: Int -> Int
next 1 = 2
next 2 = 1

type Board = [Int]

initial :: Board
initial = [5, 4, 3, 2, 1]

finished :: Board -> Bool
finished = all (== 0)

valid :: Board -> Int -> Int -> Bool
valid board row num = (board !! (row - 1)) >= num

move :: Board -> Int -> Int -> Board
move board row num = take (row - 1) board ++ [board !! (row - 1) - num] ++ drop row board

putRow :: Int -> Int -> IO ()
putRow row num = do
  putStr $ show row
  putStr ":"
  putStrLn $ concat $ replicate num " *"

putBoard :: Board -> IO ()
putBoard [a, b, c, d, e] = do
  putRow 1 a
  putRow 2 b
  putRow 3 c
  putRow 4 d
  putRow 5 e

getDigit :: String -> IO Int
getDigit prompt = do
  putStr prompt
  x <- getChar
  newline
  if isDigit x
    then return (digitToInt x)
    else do
      putStrLn "ERROR: Invalid digit"
      getDigit prompt

newline :: IO ()
newline = putStrLn ""

play :: Board -> Int -> IO ()
play board player = do
  newline
  putBoard board
  if finished board
    then do
      newline
      putStr "Player "
      putStr $ show $ next player
      putStr " wins!!"
    else do
      newline
      putStr "Player "
      print player
      row <- getDigit "Enter a row number: "
      num <- getDigit "Stars to remove : "
      if valid board row num
        then
          play (move board row num) (next player)
        else do
          newline
          putStrLn "ERROR: Invalid move"
          play board player
  newline

nim :: IO ()
nim = play initial 1

ライフゲーム

cls :: IO ()
cls = putStr "\ESC[2J"

wait :: Int -> IO ()
wait n = sequence_ [return () | _ <- [1 .. n]]

type Pos = (Int, Int)

writeAt :: Pos -> String -> IO ()
writeAt p s = do
  goto p
  putStr s

goto :: Pos -> IO ()
goto (x, y) = putStr ("\ESC[" ++ show y ++ ";" ++ show x ++ "H")

width :: Int
width = 10

height :: Int
height = 10

type Board = [Pos]

showCells :: Board -> IO ()
showCells b = sequence_ [writeAt p "0" | p <- b]

isAlive :: Board -> Pos -> Bool
isAlive b p = p `elem` b

isEmpty :: Board -> Pos -> Bool
isEmpty b p = not (isAlive b p)

neighbs :: Pos -> [Pos]
neighbs (x, y) =
  map
    wrap
    [ (x - 1, y - 1),
      (x, y - 1),
      (x + 1, y - 1),
      (x - 1, y),
      (x + 1, y),
      (x - 1, y + 1),
      (x, y + 1),
      (x + 1, y + 1)
    ]

wrap :: Pos -> Pos
wrap (x, y) = ((x - 1 `mod` width) + 1, (y - 1 `mod` height) + 1)

liveNeighbs :: Board -> Pos -> Int
liveNeighbs b = length . filter (isAlive b) . neighbs

survivors :: Board -> [Pos]
survivors b = [p | p <- b, liveNeighbs b p `elem` [2, 3]]

births :: Board -> [Pos]
births b = [p | p <- rmdups $ concatMap neighbs b, isEmpty b p, liveNeighbs b p == 3]

rmdups :: (Eq a) => [a] -> [a]
rmdups [] = []
rmdups (x : xs) = x : rmdups (filter (/= x) xs)

nextgen :: Board -> Board
nextgen b = survivors b ++ births b

life :: Board -> IO ()
life b = do
  cls
  showCells b
  wait 500000
  life $ nextgen b

initial :: Board
initial = [(4, 2), (2, 3), (4, 3), (3, 4), (4, 4)]

第11章負けない三目並べ

三目並べ

import Data.Char (isDigit)
import Data.List (transpose)
import GHC.IO.Handle (BufferMode (NoBuffering), hSetBuffering)
import System.IO (stdout)

cls :: IO ()
cls = putStr "\ESC[2J"

goto :: (Int, Int) -> IO ()
goto (x, y) = putStr $ "\ESC[" ++ show x ++ ";" ++ show y ++ "H"

size :: Int
size = 3

data Player = O | B | X deriving (Eq, Ord, Show)

type Grid = [[Player]]

next :: Player -> Player
next O = X
next B = B
next X = O

empty :: Grid
empty = replicate size (replicate size B)

full :: Grid -> Bool
full = notElem B . concat

turn :: Grid -> Player
turn g = if os <= xs then O else X
  where
    ps = concat g
    os = length $ filter (== O) ps
    xs = length $ filter (== X) ps

wins :: Player -> Grid -> Bool
wins p g = any line (rows ++ cols ++ dias)
  where
    line = all (== p)
    rows = g
    cols = transpose g
    dias = [diag g, diag (map reverse g)]

diag :: Grid -> [Player]
diag g = [g !! n !! n | n <- [0 .. size - 1]]

won :: Grid -> Bool
won g = wins O g || wins X g

putGrid :: Grid -> IO ()
putGrid = putStrLn . unlines . concat . interleave bar . map showRow
  where
    bar = [replicate ((size * 4) - 1) '-']

showRow :: [Player] -> [String]
showRow = beside . interleave bar . map showPlayer
  where
    beside = foldr1 $ zipWith (++)
    bar = replicate 3 "|"

showPlayer :: Player -> [String]
showPlayer O = ["   ", " O ", "   "]
showPlayer B = ["   ", "   ", "   "]
showPlayer X = ["   ", " X ", "   "]

interleave :: a -> [a] -> [a]
interleave _ [] = []
interleave x [y] = [y]
interleave x (y : ys) = y : x : interleave x ys

valid :: Grid -> Int -> Bool
valid g i = 0 <= i && i < size ^ 2 && concat g !! i == B

move :: Grid -> Int -> Player -> [Grid]
move g i p = let (xs, B : ys) = splitAt i $ concat g in ([chop size (xs ++ [p] ++ ys) | valid g i])

chop :: Int -> [a] -> [[a]]
chop n [] = []
chop n xs = take n xs : chop n (drop n xs)

getNat :: String -> IO Int
getNat prompt = do
  putStr prompt
  xs <- getLine
  if xs /= [] && all isDigit xs
    then return (read xs)
    else do
      putStrLn "ERROR: Invalid number"
      getNat prompt

run :: Grid -> Player -> IO ()
run g p = do
  cls
  goto (1, 1)
  putGrid g
  run' g p

run' :: Grid -> Player -> IO ()
run' g p
  | wins O g = putStrLn "Player O wins!"
  | wins X g = putStrLn "Player X wins!"
  | full g = putStrLn "It's a draw!"
  | otherwise = do
      i <- getNat (prompt p)
      case move g i p of
        [] -> do
          putStrLn "ERROR: Invalid move"
          run' g p
        [g'] -> run g' $ next p

prompt :: Player -> String
prompt p = "Player " ++ show p ++ ", enter your move: "

tictactoe :: IO ()
tictactoe = run empty O

depth :: Int
depth = 9

data Tree a = Node a [Tree a] deriving (Show)

gameTree :: Grid -> Player -> Tree Grid
gameTree g p = Node g [gameTree g' (next p) | g' <- moves g p]

moves :: Grid -> Player -> [Grid]
moves g p
  | won g = []
  | full g = []
  | otherwise = concat [move g i p | i <- [0 .. ((size ^ 2) - 1)]]

prune :: Int -> Tree a -> Tree a
prune 0 (Node x _) = Node x []
prune n (Node x ts) = Node x [prune (n - 1) t | t <- ts]

minMax :: Tree Grid -> Tree (Grid, Player)
minMax (Node g [])
  | wins O g = Node (g, O) []
  | wins X g = Node (g, X) []
  | otherwise = Node (g, B) []
minMax (Node g ts)
  | turn g == O = Node (g, minimum ps) ts'
  | turn g == X = Node (g, maximum ps) ts'
  where
    ts' = map minMax ts
    ps = [p | Node (_, p) _ <- ts']

bestMove :: Grid -> Player -> Grid
bestMove g p = head [g' | Node (g', p') _ <- ts, p' == best]
  where
    tree = prune depth (gameTree g p)
    Node (_, best) ts = minMax tree

play :: Grid -> Player -> IO ()
play g p = do
  cls
  goto (1, 1)
  putGrid g
  play' g p

play' :: Grid -> Player -> IO ()
play' g p
  | wins O g = putStrLn "Player O wins!\n"
  | wins X g = putStrLn "Player X wins!\n"
  | full g = putStrLn "It's a draw!\n"
  | p == O = do
      i <- getNat (prompt p)
      case move g i p of
        [] -> do
          putStrLn "ERROR: Invalid move"
          play' g p
        [g'] -> play g' (next p)
  | p == X = do
      putStr "Player X is thinking... "
      (play $! bestMove g p) (next p)

main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
  play empty O

第12章モナドなど

第13章モナドパーサー

「まず、パーサーとは何か」の一文めちゃくちゃ石破さんっぽい
- ﾈｯﾄﾘしてそう
選択肢（alternative）
- 2つの選択肢から選ぶという操作はアプリカティブな型に対して一般化できる
  - Alternative 型クラス
```
  ```haskell
      class (Applicative f) => Alternative f where
       empty :: f a
       (<|>) :: f a -> f a -> f a
  ```
```
- 規則
  - empty <|> x = x
  - x <|> empty = x
  - x <|> (y <|> z) = (x <|> y) <|> z

モナドレキサー

{-# LANGUAGE LambdaCase #-}

import Control.Applicative
import Data.Bifunctor (first)
import Data.Char

newtype Parser a = P (String -> [(a, String)])

parse :: Parser a -> String -> [(a, String)]
parse (P p) = p

item :: Parser Char
item = P $ \case
  [] -> []
  (x : xs) -> [(x, xs)]

instance Functor Parser where
  fmap :: (a -> b) -> Parser a -> Parser b
  fmap f (P p) = P $ \s -> map (first f) (p s)

instance Applicative Parser where
  pure :: a -> Parser a
  pure a = P $ \s -> [(a, s)]
  (<*>) :: Parser (a -> b) -> Parser a -> Parser b
  (<*>) pf px = P $ \s -> case parse pf s of
    [] -> []
    [(f, ss)] -> parse (fmap f px) ss

instance Alternative Parser where
  empty :: Parser a
  empty = P $ const []
  (<|>) :: Parser a -> Parser a -> Parser a
  (<|>) a b = P $ \s -> case parse a s of
    [] -> parse b s
    ar -> ar

instance Monad Parser where
  (>>=) :: Parser a -> (a -> Parser b) -> Parser b
  (>>=) px mf = P $ \s -> case parse px s of
    [] -> []
    [(a, ss)] -> parse (mf a) ss

sat :: (Char -> Bool) -> Parser Char
sat p = do
  c <- item
  if p c
    then return c
    else empty

digit :: Parser Char
digit = sat isDigit

lower :: Parser Char
lower = sat isLower

upper :: Parser Char
upper = sat isUpper

letter :: Parser Char
letter = sat isAlpha

alphanum :: Parser Char
alphanum = sat isAlphaNum

char :: Char -> Parser Char
char c = sat (== c)

string :: String -> Parser String
string "" = return []
string (x : xs) = do
  char x
  string xs
  return (x : xs)

ident :: Parser String
ident = do
  l <- lower
  s <- many alphanum
  return (l : s)

nat :: Parser Int
nat = do
  i <- some digit
  return $ read i

space :: Parser ()
space = do
  many $ sat isSpace
  return ()

int :: Parser Int
int =
  do
    char '-'
    n <- nat
    return (-n)
    <|> nat

token :: Parser a -> Parser a
token p = do
  space
  t <- p
  space
  return t

identifier :: Parser String
identifier = token ident

natural :: Parser Int
natural = token nat

integer :: Parser Int
integer = token int

symbol :: String -> Parser String
symbol xs = token (string xs)

モナドパーサー

{-# LANGUAGE LambdaCase #-}

import Control.Applicative
import Data.Bifunctor (first)
import Data.Char
import System.IO (hSetEcho, stdin)

newtype Parser a = P (String -> [(a, String)])

parse :: Parser a -> String -> [(a, String)]
parse (P p) = p

item :: Parser Char
item = P $ \case
  [] -> []
  (x : xs) -> [(x, xs)]

instance Functor Parser where
  fmap :: (a -> b) -> Parser a -> Parser b
  fmap f (P p) = P $ \s -> map (first f) (p s)

instance Applicative Parser where
  pure :: a -> Parser a
  pure a = P $ \s -> [(a, s)]
  (<*>) :: Parser (a -> b) -> Parser a -> Parser b
  (<*>) pf px = P $ \s -> case parse pf s of
    [] -> []
    [(f, ss)] -> parse (fmap f px) ss

instance Alternative Parser where
  empty :: Parser a
  empty = P $ const []
  (<|>) :: Parser a -> Parser a -> Parser a
  (<|>) a b = P $ \s -> case parse a s of
    [] -> parse b s
    ar -> ar

instance Monad Parser where
  (>>=) :: Parser a -> (a -> Parser b) -> Parser b
  (>>=) px mf = P $ \s -> case parse px s of
    [] -> []
    [(a, ss)] -> parse (mf a) ss

sat :: (Char -> Bool) -> Parser Char
sat p = do
  c <- item
  if p c
    then return c
    else empty

digit :: Parser Char
digit = sat isDigit

lower :: Parser Char
lower = sat isLower

upper :: Parser Char
upper = sat isUpper

letter :: Parser Char
letter = sat isAlpha

alphanum :: Parser Char
alphanum = sat isAlphaNum

char :: Char -> Parser Char
char c = sat (== c)

string :: String -> Parser String
string "" = return []
string (x : xs) = do
  char x
  string xs
  return (x : xs)

ident :: Parser String
ident = do
  l <- lower
  s <- many alphanum
  return (l : s)

nat :: Parser Int
nat = do
  i <- some digit
  return $ read i

space :: Parser ()
space = do
  many $ sat isSpace
  return ()

comment :: Parser ()
comment = do
  string "--"
  many $ sat (/= '\n')
  return ()

int :: Parser Int
int =
  do
    char '-'
    n <- nat
    return (-n)
    <|> nat

token :: Parser a -> Parser a
token p = do
  space
  many comment
  t <- p
  space
  return t

identifier :: Parser String
identifier = token ident

natural :: Parser Int
natural = token nat

integer :: Parser Int
integer = token int

symbol :: String -> Parser String
symbol xs = token (string xs)

-- 文法規則

expr :: Parser Int
expr = do
  t <- term
  do
    symbol "+"
    e <- expr
    return (t + e)
    <|> do
      symbol "-"
      e <- expr
      return (t - e)
    <|> return t

term :: Parser Int
term = do
  e <- expo
  do
    symbol "*"
    t <- term
    return (e * t)
    <|> do
      symbol "/"
      t <- term
      return (e `div` t)
    <|> return e

expo :: Parser Int
expo = do
  f <- factor
  do
    symbol "^"
    e <- expo
    return (f ^ e)
    <|> return f

factor :: Parser Int
factor =
  do
    symbol "("
    e <- expr
    symbol ")"
    return e
    <|> integer

-- 表示
cls :: IO ()
cls = putStr "\ESC[2J"

beep :: IO ()
beep = putStr "\BEL"

goto :: (Int, Int) -> IO ()
goto (x, y) = putStr $ "\ESC[" ++ show y ++ ";" ++ show x ++ "H"

writeAt :: (Int, Int) -> String -> IO ()
writeAt p s = do
  goto p
  putStr s

getCh :: IO Char
getCh = do
  hSetEcho stdin False
  x <- getChar
  hSetEcho stdin True
  return x

box :: [String]
box =
  [ "+---------------+",
    "|               |",
    "+---+---+---+---+",
    "| q | c | d | = |",
    "+---+---+---+---+",
    "| 1 | 2 | 3 | + |",
    "+---+---+---+---+",
    "| 4 | 5 | 6 | - |",
    "+---+---+---+---+",
    "| 7 | 8 | 9 | * |",
    "+---+---+---+---+",
    "| 0 | ( | ) | / |",
    "+---+---+---+---+"
  ]

buttons :: String
buttons = standard ++ extra
  where
    standard = "qcd=123+456-789*0()/^"
    extra = "QCD \ESC\BS\DEL\n"

showBox :: IO ()
showBox = sequence_ [writeAt (1, y) b | (y, b) <- zip [1 ..] box]

display :: String -> IO ()
display xs = do
  writeAt (3, 2) (replicate 13 ' ')
  writeAt (3, 2) (reverse (take 13 (reverse xs)))

calc :: String -> IO ()
calc xs = do
  display xs
  c <- getCh
  if c `elem` buttons
    then process c xs
    else do
      beep
      calc xs

process :: Char -> String -> IO ()
process c xs
  | c `elem` "qQ\ESC" = quit
  | c `elem` "dD\BS\DEL" = delete xs
  | c `elem` "=\n" = eval xs
  | c `elem` "cC" = clear
  | otherwise = press c xs

quit :: IO ()
quit = goto (1, 14)

delete :: String -> IO ()
delete "" = calc []
delete xs = calc (init xs)

eval :: String -> IO ()
eval xs = case parse expr xs of
  [(n, [])] -> calc (show n)
  [(_, ss)] -> calc ("ERROR: " ++ ss)
  _ -> do
    beep
    calc xs

clear :: IO ()
clear = calc []

press :: Char -> String -> IO ()
press c xs = calc (xs ++ [c])

run :: IO ()
run = do
  cls
  showBox
  clear

第14章 FoldableとTraversable

Foldable

データ構造をモノイドを用いて畳み込むことが可能であることを示す

```haskell
class Foldable t where
 fold :: (Monoid a) => t a -> a -- デフォルト実装有
 foldMap :: (Monoid b) => (a -> b) -> t a -> b
 foldr :: (a -> b -> b) -> b -> t a -> b
 foldl :: (a -> b -> a) -> a -> t b -> a -- デフォルト実装有

instance Foldable MyMaybe where
  fold :: (Monoid m) => MyMaybe m -> m
  fold MyNothing = mempty
  fold (MyJust a) = a

  foldMap :: (Monoid m) => (a -> m) -> MyMaybe a -> m
  foldMap _ MyNothing = mempty
  foldMap f (MyJust a) = f a

  foldr :: (a -> b -> b) -> b -> MyMaybe a -> b
  foldr _ b MyNothing = b
  foldr f b (MyJust a) = f a b

  foldl :: (b -> a -> b) -> b -> MyMaybe a -> b
  foldl _ b MyNothing = b
  foldl f b (MyJust a) = f b a
```

最低限foldMap もしくはfoldr を実装すれば良い
foldr 、foldl にモノイドの型制約ないんやね

toList
- そりゃappend していったらリストにできるわな

Traversable

各要素に関数を適用していくような状況の中で、その関数が文脈を持った値を返すようなときでも適用できるように一般化したやつ

```haskell
class (Functor t, Foldable t) => Traversable t where
 traverse :: (Applicative f) -> (a -> f b) -> t a -> f (t b)

instance Traversable MyMaybe where
  traverse :: (Applicative f) => (a -> f b) -> MyMaybe a -> f (MyMaybe b)
  traverse f MyNothing = pure MyNothing
  traverse f (MyJust a) = MyJust <$> f a
```

Functor があって、Foldable な値にApplicative な値を返す関数であれば適用できるように抽象化したと捉えられる

例えば

sequenceA

  ```haskell
  sequenceA :: (Applicative f) -> (a -> f b) -> t (f a) -> f (t b)
  sequenceA = traverse id
  ```

「失敗するかもしれない値を要素に持つリスト」を、「全体が失敗するかもしれない値」に変換できる
```
    ```haskell
    sequenceA [Just 1, Just 2, Just 3]
    -> Just [1, 2, 3]
    ```
```

第15章遅延評価

簡約可能式（リデックス）
- 1つ以上の引数に対して適用されている関数があって、それを適用することで簡約できる式
- 簡約したとしても式の大きさが小さくなるとは限らない
最内簡約
- 最も内側の簡約可能式を選択する手法
  - 他の簡約可能式を含まないという意味
  - もし複数あるなら左側から簡約する
- 引数が関数に渡される前に評価済であることが保証されている
  - 常に値として渡される
最外簡約
- 最も外側の簡約可能式を選択する手法
  - 他の簡約可能式に含まれていないという意味
  - もし複数あるなら左側から簡約する
- 引数が評価前に渡されている
  - 名前で渡されていると言える
Haskellでは関数内（ラムダ式含む）の簡約が禁止されている
- 中を覗けないから
- 関数を引数に適用することしか許されていない
- 中は完全の評価済みであるとしている
ある式に対し停止する評価の手法が存在するなら、名前渡しはその式の評価を必ず停止させ、同じ結果を返す
- 評価をなるべく多く停止させたいなら、値渡しより名前渡しの方が良い
  - なお簡約の回数は増える模様
    - 引数をポインタで共有すれば解決できるぞ
      - 遅延評価という
なぜ遅延評価（名前渡し）では無限のデータ構造が扱えるか
- 以下の関数について考える
```
```haskell
  -- ones = 1 : ones
  head ones -- head (x : _) -> x
```
```
- 値渡しだと引数の評価を先に行う
```
```haskell
  head (1 : ones
  head (1 : (1 : ones ...
```
```
  - 停止しない
- 名前渡しは関数の適用を先に行う
```
```haskell
  head (1 : ones) -> 1
```
```
  - 停止する
  - 引数は必要な分だけ評価される
$!
- 正格評価演算子

第16章

Haskellの等式推論

Haskellでは組み込み関数のほか、ユーザー定義関数も等式推論に利用している
- double x = x + x において、double x をx + x に置換しても良いし、x + x をdouble x に置換しても良い
  - だから関数定義時は= で結んでるのか
- 複数の等式を用いて定義された場合の関数は、定義順序に意味があるので、置き換えできるかどうか判定するのに他の定義の確認が必要
  - 重複のない定義をすることによって対策可能
```
  ```haskell
      isZero 0 = True
      isZero n | n /= 0 = False
  ```
```
    - 重複なし！

第17章

なるほど

第1章 導入#

第2章 はじめの一歩#

第3章 型と型クラス#

第4章 関数定義#

第5章 リスト内包表記#

第6章 再帰関数#

第7章 高階関数#

第8章 型と型クラスの定義#

第9章 カウントダウン問題#

第10章 対話プログラム#

第11章 負けない三目並べ#

第12章 モナドなど#

第13章 モナドパーサー#

第14章 FoldableとTraversable#

第15章 遅延評価#

第16章#

Haskellの等式推論#

第17章#

第1章導入

第2章はじめの一歩

第3章型と型クラス

第4章関数定義

第5章リスト内包表記

第6章再帰関数

第7章高階関数

第8章型と型クラスの定義

第9章カウントダウン問題

第10章対話プログラム

第11章負けない三目並べ

第12章モナドなど

第13章モナドパーサー

第14章 FoldableとTraversable

第15章遅延評価

第16章

Haskellの等式推論

第17章