
Andrea Rossato wrote:
this is what I'm trying to do, sort of: turn the code at the button into the do-notation.[1]
module StateOutputMonad where
-- do notation only works with instances of Monad import Control.Monad
data Term = Con Int | Add Term Term deriving (Show)
type MSO a = State -> (a, State, Output)
-- Use a newtype so you can declare it as a Monad newtype MSO a = MSO (State -> (a, State, Output))
type State = Int type Output = String
formatLine :: Term -> Int -> Output formatLine t a = "eval (" ++ show t ++ ") <= " ++ show a ++ " - "
mkMSO :: a -> MSO a mkMSO a = \s -> (a, s, "")
bindMSO :: MSO a -> (a -> MSO b) -> MSO b bindMSO m f = \x -> let (a, y, s1) = m x in let (b, z, s2) = f a y in (b, z, s1 ++ s2)
combineMSO :: MSO a -> MSO b -> MSO b combineMSO m f = m `bindMSO` \_ -> f
--The above 3 functions are replaced by an instance decl -- combineMSO (ie >>) is the same as the default method instance Monad MSO where return a = MSO (\s -> (a, s, "")) (MSO m) >>= f = MSO $ \x -> let (a, y, s1) = m x in let MSO y_bz = f a in let (b, z, s2) = y_bz y in (b, z, s1 ++ s2) -- Note the second let is needed to unwrap the newtype -- Also note you don't need 3 separate let constructs - you could -- just use one if you like
incMSOstate :: MSO () incMSOstate = \s -> ((), s + 1, "")
incMSOstate :: MSO () incMSOstate = MSO (\s -> ((), s + 1, ""))
outMSO :: Output -> MSO () outMSO = \x s -> ((),s, x)
-- We need to wrap the function returned by (outMSO x) as -- a value of (new)type MSO hence: outMSO :: Output -> MSO () outMSO x = MSO (\s -> ((),s, x)) -- You could also have written outMSO = \x -> MSO ... but it's -- preferable to put the x on the lhs to avoid the dreaded -- monomorphism restriction
evalMSO :: Term -> MSO Int evalMSO (Con a) = incMSOstate `combineMSO` outMSO (formatLine (Con a) a) `combineMSO` mkMSO a evalMSO (Add t u) = evalMSO t `bindMSO` \a -> evalMSO u `bindMSO` \b -> incMSOstate `combineMSO` outMSO (formatLine (Add t u) (a + b)) `combineMSO` mkMSO (a + b)
evalMSO :: Term -> MSO Int evalMSO (Con a) = do incMSOstate outMSO (formatLine (Con a) a) return a evalMSO (Add t u) = do a <- evalMSO t b <- evalMSO u incMSOstate outMSO (formatLine (Add t u) (a + b)) return (a + b)
-- To be tested with: -- evalMSO (Add (Con 6) (Add (Con 16) (Add (Con 20) (Con 12)))) 0
-- We need one more thing: a function to run the monad that's wrapped up -- inside the MSO newtype: runMSO :: MSO a -> State -> (a, State, Output) runMSO (MSO f) s = f s -- Tested with: -- runMSO (evalMSO (Add (Con 6) (Add (Con 16) (Add (Con 20) (Con 12))))) 0 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