Brainf*ck in Egison

bf2.egi

--
-- Brainf*ck
--
-- $ egison                                       4.1.3
-- > loadFile "bf2.egi"


--
-- Pattern Function
--
def bfLoopPatt := \pat1 => #'[' :: $x :: ~pat1 ++ #(pack [']', x])


--
-- Codes
--
def parse code := parse' code 1 [] where
  parse' code mark acc := match code as string with
  | []          -> pack $ reverse acc
  | #'[' :: $xs -> parse' xs (mark + 1) ((itoc (mark + 48    )) :: '[' :: acc)
  | #']' :: $xs -> parse' xs (mark - 1) ((itoc (mark + 48 - 1)) :: ']' :: acc)
  | $x   :: $xs -> parse' xs mark       (x :: acc) 

def bf code := do{ run code (take 10 $ repeat1 0, 0, take 10 $ repeat1 0); write "" } where
  run code d := match (code, d) as (string, (list integer, integer, list integer)) with
  | ([],                     _                     ) -> return d
  | ((bfLoopPatt _)  ++ $xs, (_, #0, _)            ) -> run xs d
  | ((bfLoopPatt $x) ++ $xs, _                     ) -> run code $ io $ run x d -- loop
  | (#'>'            :: $xs, ($ls, $c, $rx :: $rs2)) -> run xs (c :: ls, rx, rs2)
  | (#'<'            :: $xs, ($lx :: $ls2, $c, $rs)) -> run xs (ls2, lx, c :: rs)
  | (#'+'            :: $xs, ($ls, $c, $rs)        ) -> run xs (ls, (c + 1), rs)
  | (#'-'            :: $xs, ($ls, $c, $rs)        ) -> run xs (ls, (c - 1), rs)
  | (#'.'            :: $xs, (_, $c, _)            ) -> do{ write $ pack [itoc c]; run xs d }
  | (#','            :: $xs, _                     ) -> run xs d -- omitted
  | (_               :: $xs, _                     ) -> run xs d


--
-- Data
--
-- 1m35s
def hello :=
  "++++++++[>++++[>++>+++>+++>+<<<<-]>+>+>->>+[<]<-]>>.>---.+++++++..+++.>>.<-.<.+++.------.--------.>>+.>++."


--
-- Tests
--
-- $ egison -t bf2.egi
io $ bf $ parse hello

def test5 := matchAll "[1ii[2abc]2xxx[2y[3]3]2df]1ggg" as string with
  | (bfLoopPatt $x) ++ $xs -> (x, xs)