[Haskell-cafe] state and exception or types again...
Brian Hulley
brianh at metamilk.com
Tue Aug 29 02:45:46 EDT 2006
Andrea Rossato wrote:
> Il Mon, Aug 28, 2006 at 09:28:02PM +0100, Brian Hulley ebbe a
> scrivere:
>> where the 4th element of the tuple is True iff we can continue or
>> False iff an exception occurred.
>
> I'm starting to believe that the best method is just take the way
> StateT takes... without reinventing the wheel...
The solution I gave was very close to being correct. I enclose a tested
example below - you'll need to adapt it to do evaluation but it shows an
exception being raised.
module Test where
import Control.Monad
-- When we raise an exception we use (undefined) so that
-- the result type is the same as whatever the result type
-- would be for the other computation. But this means we
-- need to tell Haskell how to print out the tuple so that it
-- doesn't give an exception when trying to print out
-- undefined (!), hence we replace the tuple with a data type
-- so we can define our own Show instance
data Result a = Result a State Output Bool
instance Show a => Show (Result a) where
show (Result a s o True) =
"Good " ++ show a ++ " " ++ show s ++ " " ++ show o
show (Result _ s o _) =
"Bad " ++ show s ++ " " ++ show o
-- We only have one constructor so can use a newtype for
-- efficiency
newtype Eval_SOI a = SOIE {runSOIE :: State -> Result a}
type State = Int
type Output = String
-- I used braces instead of parens in my previous post
-- Note that we return undefined as the "result" because this
-- is the only value which belongs to all types in Haskell
raise e = SOIE (\s -> Result undefined s e False)
instance Monad Eval_SOI where
return a = SOIE (\s -> Result a s "" True)
m >>= f = SOIE $ \x ->
let
Result a y o1 ok1 = runSOIE m x
in if ok1
then
let
Result b z o2 ok2 = runSOIE (f a) y
in Result b z (o1 ++ o2) ok2
else Result undefined y o1 False
display t = SOIE(\s -> Result () s t True)
test = runSOIE (do
display "hello"
raise "Exception"
display "Foo"
) 0
In the definition of (>>=), we need to explicitly return (undefined) when
the first computation has raised an exception, so that the result type
unifies with the result type when no exception occurs.
Regards, Brian.
--
Logic empowers us and Love gives us purpose.
Yet still phantoms restless for eras long past,
congealed in the present in unthought forms,
strive mightily unseen to destroy us.
http://www.metamilk.com
More information about the Haskell-Cafe
mailing list