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

Andrea Rossato mailing_list at istitutocolli.org
Mon Aug 28 14:23:15 EDT 2006


Hello!

Sorry if I keep bothering, but I'm still trying to understand types and
monads.

Now I'm trying to create a statefull evaluator, with output and
exception, but I'm facing a problem I seem not to be able to
conceptually solve.

Take the code below.
Now, in order to get it run (and try to debug) the Eval_SOI type has a
Raise constructor that produces the same type of SOIE. Suppose instead it
should be constructing something like Raise "something". 
Moreover, I wrote a second version of >>=, commented out.
This is just to help me illustrate to problem I'm facing.

Now, >>= is suppose to return Raise if "m" is matched against Raise
(second version commented out).
If "m" matches SOIE it must return a SOIE only if "f a" does not
returns a Raise (output must be concatenated).

I seem not to be able to find a way out. Moreover, I cannot understand
if a way out can be possibly found. Something suggests me it could be
related to that Raise "something".
But my feeling is that functional programming could be something out
of the reach of my mind... by the way, I teach Law, so perhaps you'll
forgive me...;-)

If you can help me to understand this problem all I can promise is
that I'll mention your help in the tutorial I'm trying to write on
"the monadic way"... that seems to lead me nowhere.

Thanks for your kind attention.

Andrea

the code:

data Eval_SOI a = Raise { unPackMSOIandRun :: State -> (a, State, Output) }
                | SOIE { unPackMSOIandRun :: State -> (a, State, Output) }

instance Monad Eval_SOI where
    return a = SOIE (\s -> (a, s, ""))
    m >>= f =  SOIE (\x ->
                       let (a, y, s1) = unPackMSOIandRun m x in
                       case f a of
                         SOIE nextRun -> let (b, z, s2) = nextRun y in  
                                         (b, z, s1 ++ s2)
                         Raise e1 -> e1 y  --Is it right?

                      )
--     (>>=) m f =  case m of
--                    Raise e -> error "ciao" -- why this is not going to happen?
--                    SOIE a -> SOIE (\x ->
--                                    let (a, y, s1) = unPackMSOIandRun m x in
--                                    let (b, z, s2) = unPackMSOIandRun (f a) y in 
--                                    (b, z, s1 ++ s2))	   


incSOIstate :: Eval_SOI ()
incSOIstate = SOIE (\s -> ((), s + 1, ""))

print_SOI :: Output -> Eval_SOI ()
print_SOI x = SOIE (\s -> ((),s, x))

raise x e = Raise (\s -> (x,s,e))

eval_SOI :: Term -> Eval_SOI Int
eval_SOI (Con a) = do incSOIstate
                      print_SOI (formatLine (Con a) a)
                      return a
eval_SOI (Add t u) = do a <- eval_SOI t
                        b <- eval_SOI u
                        incSOIstate
                        print_SOI (formatLine (Add t u) (a + b))
                        if (a + b)  ==  42 
                          then raise (a+b) " = The Ultimate Answer!!"
                          else return (a + b)

runEval exp =  case eval_SOI exp of
                 Raise a -> a 0
                 SOIE p -> let (result, state, output) = p 0 in
                             (result,state,output) --"Result = " ++ show result ++ " Recursions = " ++ show state ++ " Output = " ++ output



--runEval (Add (Con 10) (Add (Con 28) (Add (Con 40) (Con 2))))

 


More information about the Haskell-Cafe mailing list