[Hat] How to use Control.Monad.State?

Larry Evans cppljevans at suddenlink.net
Mon Nov 10 08:37:17 EST 2008


My OS is ubuntu.  I've used synaptic to install:
   hat 2.05 rerolled-5ubuntu1.

The installed files include several in /usr/include/hat-2.05, including
Control/Monad/State.hx.  I would like to use hat to trace what
happens with the code:

  plus n x

shown here:


http://hackage.haskell.org/packages/archive/mtl/latest/doc/html/Control-Monad-State.html#4

However, I've tried several variations of the Makefile:

{--cut here--
MAIN=tickSimple

INCS=

GHC.FLAGS=-i$(INCS)
GHC.FLAGS=-XMultiParamTypeClasses -XFunctionalDependencies
-XFlexibleInstances
GHC.PKGS= -package Hat.Control.Monad.State
GHC.PKGS=
GHC.OPTS=$(GHC.FLAGS) $(GHC.PKGS)


hat:
    hmake -hat $(GHC.OPTS) $(MAIN)
    hat-trans  $(GHC.OPTS) $(MAIN).hs
    ghc -package hat $(GHC.OPTS) -c Hat/$(MAIN).o Hat/$(MAIN).hs
    ghc -package hat $(GHC.OPTS) -o Hat/$(MAIN) Hat/$(MAIN).o

{--cut here--
On the source file:
{--tickSimple.hs--
module Main where

-- newtype State
-- class MonadState
-- instance MonadState (State s)
--   cp'ed from:
--
http://www.haskell.org/all_about_monads/html/statemonad.html#definition

newtype State s a = State { runState :: (s -> (a,s)) }

instance Monad (State s) where
    return a        = State $ \s -> (a,s)
    (State x) >>= f = State $ \s -> let (v,s') = x s in runState (f v) s'

class MonadState m s | m -> s where
    get :: m s
    put :: s -> m ()

instance MonadState (State s) s where
    get   = State $ \s -> (s,s)
    put s = State $ \_ -> ((),s)

-- execState:
--   just guesses based on:
--
http://hackage.haskell.org/packages/archive/mtl/latest/doc/html/Control-Monad-State.html#2

execState :: State s a -> s -> a
execState s = snd(runState(s))

tick :: State Int Int
tick = do n <- get
          put (n+1)
          return n

plusOne :: Int -> Int
plusOne n = execState tick n

plus :: Int -> Int -> Int
plus n x = execState (sequence $ replicate n tick) x

main = do
  print (plusOne 2)
  print (plus 2 3)
}--tickSimple.hs--
However, I always get some error.

I have tried just using:

  import Control.Monad.State

But the compiler then says it can't find the library.

What should I do to debug this code with hat?
TIA

-regards,
Larry




More information about the Hat mailing list