import Data.Word
import Control.Monad.ST

data Machine = Mn { tape :: [Word8]
                  , ptr :: Word16
                  }

data Mode = Inc | Dec

newMachine = Mn (take 30000 (repeat 0)) 0

modify :: Mode -> Machine -> Machine
modify mode m = do { let p = splitAt (fromIntegral $ ptr m) $ tape m
                   ; let s = snd p
                   ; let n = (case mode of Inc -> \x -> x + 1
                                           Dec -> \x -> x - 1) (head s)
                   ; Mn ((fst p) ++ n : (tail s)) $ ptr m
                   }

sel :: Mode -> Machine -> Machine
sel mode m = Mn (tape m) $ (case mode of Inc -> (+1)
                                         Dec -> flip (-) 1) (ptr m)

loop :: (Machine -> Machine) -> Machine -> Machine
loop f m = do { let mem = (tape m) !! (fromIntegral $ ptr m)
              ; case mem == 0 of True  -> m
                                 False -> loop f (f m)
              }

applyN :: (Num n, Ord n) => n -> (a -> a) -> a -> a
applyN 1 f x = f x
applyN n f x = f (applyN (n-1) f x)

seli m = sel    Inc m
seld m = sel    Dec m
modi m = modify Inc m
modd m = modify Dec m

-- +++++[>+++++<-]
main = print $ take 10 $ tape $ ( (loop $ modd
                                        . seld
                                        . applyN 1000 modi
                                        . seli)
                                . applyN 1000 modi) newMachine
--main = print $ take 10 $ tape $ ((loop seld) . modi) newMachine