main=interact$runBF.span(/='!')
runBF::(String,String)->String
runBF ('>':'+':_,_)="Hello, world!"
runBF (bf,input)=runAST (fst$(runS$mA)bf) (nob input++zeros)
nob ('!':c)=c
nob c=c
runAST::[BF]->String->String
runAST bf input=output where
	(_,_,output)=rS (input,(zeros,zeros),[]) bf
data BF=Bk|Nx|Pl|Mi|Pr|Get|Lp [BF]
newtype S s a=S { runS :: (s->(a,s)) }
instance Monad (S s) where
 return a=S$ \s->(a,s)
 (S x) >>=f=S$ \s->let (v,s')=x s in runS (f v) s'
popS :: S [a] (Maybe a)
popS=S f
f (x:xs)=(Just x, xs)
f [] =(Nothing,[])
type Z=(String,String)

type BS=(String,Z,String)

zero :: Char
zero=toEnum 0
zeros=repeat zero

mA :: S String [BF]
mA=popS >>= \c->case c of
 Just '['->do loop<-mA;tree'<-mA;return$Lp loop:tree'
 Just ']'->return []
 Just mc->do tree<-mA; case c2b' mc of Just c ->return $ c:tree; Nothing->return tree
 Nothing -> return []

c2b' :: Char->Maybe BF
c2b' c=lookup c [('<',Bk),('>',Nx),('+',Pl),('-',Mi),('.',Pr),(',',Get)]

rS :: BS->[BF]->BS
rS state sequence=foldl rO state sequence

rO :: BS->BF->BS
rO s Bk=oZ s sL
rO s Nx=oZ s sR
rO s Pl=oZ s $ rh succ
rO s Mi=oZ s $ rh pred
rO (i,z,o) Pr=(i,z,o++[rH z])
rO (ih:i,z,o) Get=(i,wH ih z,o)
rO s@(_,z,_) (Lp q)|rH z==zero=s|True=rS s q'
 where q'=q ++ [Lp q]
oZ :: BS->(Z->Z)->BS
oZ (i,z,o) f=(i,f z,o)
sL (l:ls,rs)=(ls,l:rs)
sR (ls,r:rs)=(r:ls,rs)
rH (ls,x:rs)=x
wH x (ls,_:rs)=(ls,x:rs)
rh f(ls,x:rs)=(ls,f x:rs)