addfile ./bird.hs
addfile ./spin.sh
hunk ./bird.hs 1
+infixl 1 `chain`
+
+main = do
+  print "plus3 10 ->"
+  print $ plus3 10
+  print "squareRoot 81 ->"
+  print $ squareRoot 81
+  print "runPutAndGet \"key\" 888"
+  print $ runPutAndGet "key" 888
+  print "runHypotenuse 3 4"
+  print $ runHypotenuse 3 4
+  print "250 OKAY."
+
+--------------------------------------------
+plus3 :: Int -> Int
+plus3 x = run incrThrice x
+  where
+    incrThrice =
+      incr `chain` \_ -> 
+      incr `chain` \_ -> 
+      incr `chain` \_ -> 
+      get
+
+    incr =
+      get `chain` \i ->
+      put (1 + i) `chain` \_ ->
+      inject i
+
+-------------------------------------------
+
+runPutAndGet k v = run (putAndGet k v) emptyEnv
+
+putAndGet k v =
+  putEnv k v `chain` \_ ->
+  getEnv k `chain` \z ->
+  inject z
+
+-------------------------------------------
+
+runHypotenuse x y = run (hypotenuse' x y) emptyEnv 
+  where
+    hypotenuse' x y =
+      setXandY'' x y `chain` \_ ->
+      hypotenuse''
+
+    setXandY'' x y =
+      putEnv "X" x `chain` \_ ->
+      putEnv "Y" y
+
+    hypotenuse'' =
+      getEnv "X" `chain` \x ->
+      getEnv "Y" `chain` \y ->
+      inject $ squareRoot (x*x + y*y)
+
+
+squareRoot x = findIndex squares x
+  where 
+    squares = [x*x | x <- [1..]]
+
+    findIndex [] item = 0
+    findIndex (x:xs) item | x == item  =  1
+    findIndex (x:xs) item              =  1 + (findIndex xs item)
+
+-------------------------------------------
+-- Instead of class Monad, I call it class Bird.
+-- Instead of return & (>>=), I call them inject & chain.
+
+class Bird m where
+  inject :: a -> m a
+  chain :: m a -> (a -> m b) -> m b
+
+-------------------------------------------
+-- My own Steak Bird (compare with State Monad (TM)).
+
+newtype Steak s a = STEAK (s -> (s, a))
+
+instance Bird (Steak s) where
+  
+  inject x = STEAK $ \steak -> (steak, x)
+
+  chain (STEAK p) q = STEAK $ \steak0 ->
+      let (steak1, x1) = p steak0
+          (STEAK f2) = q x1
+      in f2 steak1
+
+get :: Steak s s
+get = STEAK $ \s -> (s, s)
+
+put :: s -> Steak s ()
+put s = STEAK $ \_ -> (s, ())
+
+run :: Steak s a -> s -> a
+run (STEAK f) steak  =
+    let (steak2, x) = f steak
+    in x
+
+run' :: Steak s a -> s -> (s, a)
+run' (STEAK f) steak  = f steak
+-------------------------------------------
+
+type Env  = [(String, Int)]
+
+getEnv :: String -> Steak Env Int
+getEnv key = STEAK $ \s -> (s, lookup key s)
+  where
+    lookup :: String -> Env -> Int
+    lookup k [] = 0
+    lookup k ((k',v'):kvs) | k == k'  = v'
+    lookup k ((k',v'):kvs)            = lookup k kvs
+
+putEnv :: String -> Int -> Steak Env ()
+putEnv k v = STEAK $ \s -> ((k, v):s, ())
+
+putEnv2 :: String -> Int -> String -> Int -> Steak Env ()
+putEnv2 k1 v1 k2 v2 =
+    putEnv k1 v1 `chain` \_ ->
+    putEnv k2 v2
+
+emptyEnv :: Env
+emptyEnv = []
+
hunk ./spin.sh 1
+while true; do ( ghc bird.hs && ./a.out ) >_ 2>&1 ; clear ; cat _ ; done