[Haskell-cafe] state and exception or types again...

[Andrea Rossato]

Il Wed, Aug 30, 2006 at 11:24:45AM +0100, Brian Hulley ebbe a scrivere:
> Thanks, glad to be of help.

I met Haskell a couple of months ago, when I switched my window
manager to Ion. Tuomo Valkonen, its developer, uses darcs. Moreover he
develops a small PIM, riot, written in Haskell. I wanted to play
around with it but the source code was literally unreadable, for me. I
could not understand a single line.

I do some php. Lately I discovered Javascript and Lua, and I fell in
love with their object-oriented capabilities. I'm not a real coder
(though I develop a wiki in php), but I like getting to know new
programming practices. I've been intrigue with functional programming
for quite sometime but I just knew a bit of Scheme, because it's used
as a scripting language in LilyPond (a package for writing music
sheets).

So I decided to spend my August holidays to study Haskell. I started
reading some tutorial but could not understand what was going on. I
then thought to take the long way: I watched the Abelson and Sussman's
lectures and used ghci to (sort of) follow what they were doing.

Coming from dynamic typed languages (I know very little C) the type
system was horrible. Monads seemed mysterious objects.

I've read in the "Yet Another..." that the Haskell community is very
supportive.

With your help I have now a different perspective. Playing with
Haskell is like completing a puzzle, whose pieces' shapes are made up
with rules that, at first, you seem not be able to grasp.
You keep pushing the last piece, and it just doesn't fit in.
Then you realize that shapes are actually types. And when you start
understanding the rules of type construction and type matching, now
you can recognize the shapes of the pieces you are playing with. And
start making rational guesses on where they should go.

Now, when I see "Compiling ... Ok, modules loaded: " I feel like I
ended up solving the puzzle.
It's an amazing  pleasure... Haskell and functional programming.

Without you I couldn't do it. Thank you so much!

The tutorial will have this outline: first we build a monad adding
output, exception, and state. Then we use monad transformer to take
out state and output and add debug, doing lifting, put(ing) and
get(ing) by hand, to understand the central role of type
matching/construction.

We end up with the following code, that should clearly show all the
previous (hand made) steps should lead. No lambda calculus inhere!

Once again, thanks!
Andrea


-----The Final Evaluator----

module MyStateT where
import Control.Monad.State hiding (State)

data Term = Con Int
          | Add Term Term
            deriving (Show)

type IOStack = [Output]
type Output = String
type Debug = [String]
data EvalST = State {getIOS :: IOStack, getDebug :: Debug, getCount:: Int}
    deriving(Show)


type Exception = String
data MT a = Fail Exception
          | Done {unpackDone :: a }
            deriving (Show)

type Eval s a = StateT s MT a

instance Monad MT where
    return a = Done a
    m >>= f = case m of
                Fail e -> Fail e
                Done a -> f a

instance Functor MT where
    fmap _ (Fail a) = Fail a
    fmap f (Done a) = Done (f a)

emptyState = State [] [] 0

stopExecT exc = lift $ Fail exc

catchT e = do st <- get
              let s = getCount st
              let es = getDebug st
              let o = getIOS st
              let exc = "Debug msg at Iteration " ++ show s ++ ": " ++ e
              put $ State o (exc:es) s

printT :: Output -> Eval EvalST ()
printT o = do st <- get
              let s = getCount st
              let e = getDebug st
              let os = getIOS st
              let out = show s ++ " - " ++ o
              put $ State (out:os) e s

incTcounter :: Eval EvalST ()
incTcounter = do st <- get
                 let s = getCount st
                 let e = getDebug st
                 let o = getIOS st
                 put $ State o e (s+1)

evalT :: Term -> Eval EvalST Int
evalT (Con a) = do incTcounter
                   printT (formatLine (Con a) a)
                   return a
evalT (Add t u) = do a <- evalT t
                     b <- evalT u
                     incTcounter
                     let out = formatLine (Add t u) (a + b)
                     printT out
                     case (a+b) of 
                       42 -> do catchT "The Ultimate Answer Has Been Computed!! Now I'm tired!"
                                return (a+b)
                       11 -> stopExecT "11.... I do not like this number!"
                       otherwise ->  return (a + b)


formatLine :: Term -> Int -> Output
formatLine t a = "eval (" ++ show t ++ ") <= " ++ show a                                                       

printAll :: [String] -> IO ()
printAll [] = return ()
printAll (a:xs) = do print a
                     printAll xs

eval :: Term -> IO ()
eval exp = case execStateT (evalT exp) emptyState of
             Fail e -> print e
             Done (State a b c )
                 -> do printAll $ reverse a
                       print $ show $ unpackDone $ 
                             evalStateT (evalT exp) emptyState
                       case b of
                         [] -> print $ "Iterations: " ++ show c
                         _ -> do printAll $ reverse b
                                 print $ "Iterations: " ++ show c

{-
Some runs:

*MyStateT> eval (Add (Add (Add (Add (Con 40) (Con 2)) (Add (Con 12) (Con 3))) (Con 3)) (Con 10))
"1 - eval (Con 40) <= 40"
"2 - eval (Con 2) <= 2"
"3 - eval (Add (Con 40) (Con 2)) <= 42"
"4 - eval (Con 12) <= 12"
"5 - eval (Con 3) <= 3"
"6 - eval (Add (Con 12) (Con 3)) <= 15"
"7 - eval (Add (Add (Con 40) (Con 2)) (Add (Con 12) (Con 3))) <= 57"
"8 - eval (Con 3) <= 3"
"9 - eval (Add (Add (Add (Con 40) (Con 2)) (Add (Con 12) (Con 3))) (Con 3)) <= 60"
"10 - eval (Con 10) <= 10"
"11 - eval (Add (Add (Add (Add (Con 40) (Con 2)) (Add (Con 12) (Con 3))) (Con 3)) (Con 10)) <= 70"
"70"
"Debug msg at Iteration 3: The Ultimate Answer Has Been Computed!! Now I'm tired!"
"Iterations: 11"
*MyStateT> 

*MyStateT> eval (Add (Add (Add (Add (Con 10) (Con 2)) (Add (Con 12) (Con 3))) (Add (Con 5) (Con 2))) (Con 2))
"1 - eval (Con 10) <= 10"
"2 - eval (Con 2) <= 2"
"3 - eval (Add (Con 10) (Con 2)) <= 12"
"4 - eval (Con 12) <= 12"
"5 - eval (Con 3) <= 3"
"6 - eval (Add (Con 12) (Con 3)) <= 15"
"7 - eval (Add (Add (Con 10) (Con 2)) (Add (Con 12) (Con 3))) <= 27"
"8 - eval (Con 5) <= 5"
"9 - eval (Con 2) <= 2"
"10 - eval (Add (Con 5) (Con 2)) <= 7"
"11 - eval (Add (Add (Add (Con 10) (Con 2)) (Add (Con 12) (Con 3))) (Add (Con 5) (Con 2))) <= 34"
"12 - eval (Con 2) <= 2"
"13 - eval (Add (Add (Add (Add (Con 10) (Con 2)) (Add (Con 12) (Con 3))) (Add (Con 5) (Con 2))) (Con 2)) <= 36"
"36"
"Iterations: 13"
*MyStateT> 

*MyStateT> eval (Add (Con 5) (Con 6))
"11.... I do not like this number!"
*MyStateT> 

-}