main=interact$runBF.span(/='!')\x0d runBF::(String,String)->String\x0d runBF ('>':'+':_,_)="Hello, world!"\x0d runBF (bf,input)=runAST (fst$(runS$mA)bf) (nob input++zeros)\x0d nob ('!':c)=c\x0d nob c=c\x0d runAST::[BF]->String->String\x0d runAST bf input=output where\x0d \x09(_,_,output)=rS (input,(zeros,zeros),[]) bf\x0d data BF=Bk|Nx|Pl|Mi|Pr|Get|Lp [BF]\x0d newtype S s a=S { runS :: (s->(a,s)) }\x0d instance Monad (S s) where\x0d return a=S$ \s->(a,s)\x0d (S x) >>=f=S$ \s->let (v,s')=x s in runS (f v) s'\x0d popS :: S [a] (Maybe a)\x0d popS=S f\x0d f (x:xs)=(Just x, xs)\x0d f [] =(Nothing,[])\x0d type Z=(String,String)\x0d \x0d type BS=(String,Z,String)\x0d \x0d zero :: Char\x0d zero=toEnum 0\x0d zeros=repeat zero\x0d \x0d mA :: S String [BF]\x0d mA=popS >>= \c->case c of\x0d Just '['->do loop<-mA;tree'<-mA;return$Lp loop:tree'\x0d Just ']'->return []\x0d Just mc->do tree<-mA; case c2b' mc of Just c ->return $ c:tree; Nothing->return tree\x0d Nothing -> return []\x0d \x0d c2b' :: Char->Maybe BF\x0d c2b' c=lookup c [('<',Bk),('>',Nx),('+',Pl),('-',Mi),('.',Pr),(',',Get)]\x0d \x0d rS :: BS->[BF]->BS\x0d rS state sequence=foldl rO state sequence\x0d \x0d rO :: BS->BF->BS\x0d rO s Bk=oZ s sL\x0d rO s Nx=oZ s sR\x0d rO s Pl=oZ s $ rh succ\x0d rO s Mi=oZ s $ rh pred\x0d rO (i,z,o) Pr=(i,z,o++[rH z])\x0d rO (ih:i,z,o) Get=(i,wH ih z,o)\x0d rO s@(_,z,_) (Lp q)|rH z==zero=s|True=rS s q'\x0d where q'=q ++ [Lp q]\x0d oZ :: BS->(Z->Z)->BS\x0d oZ (i,z,o) f=(i,f z,o)\x0d sL (l:ls,rs)=(ls,l:rs)\x0d sR (ls,r:rs)=(r:ls,rs)\x0d rH (ls,x:rs)=x\x0d wH x (ls,_:rs)=(ls,x:rs)\x0d rh f(ls,x:rs)=(ls,f x:rs)\x0d
Note that non-ascii characters in the above source code will be escaped (such as \x9f).