Source

ml-brainfuck / bf.ml

Full commit

module Env = Zip.Make (struct type t = int let zero = 0 end)

type t =
    | Plus
    | Minus
    | Right
    | Left
    | Print
    | Read
    | Loop of t list

let new_env () = Env.empty

let rec eval env = function
    | Plus :: tl ->
            let v = Env.pop env in
            let v = if v + 1 = 256 then 0 else v in
            eval (Env.push (v + 1) env) tl
    | Minus :: tl ->
            let v = Env.pop env in
            let v = if v - 1 = (-1) then 255 else v in
            eval (Env.push (v - 1) env) tl
    | Right :: tl ->
            eval (Env.right env) tl
    | Left :: tl ->
            eval (Env.left env) tl
    | Print :: tl ->
            let () = Printf.printf "%c%!" (Char.chr (Env.pop env)) in
                eval env tl
    | Read :: tl ->
            let push c = eval (Env.push (Char.code c) env) tl in
            let () = Printf.printf "Enter ascii character: %!" in
                push (read_line ()).[0]
    | Loop loop :: tl ->
            let env = eval env loop in
                if Env.pop env = 0 then
                    eval env tl
                else
                    eval env (Loop loop :: tl)
    | [] -> env

let to_list str =
    let stop = String.length str in
    let rec to_list = function
        | i when i = stop -> []
        | i -> str.[i] :: to_list (i + 1)
    in
        to_list 0

let parse exp =
    let (||) exp (l1, l2) = (exp :: l1, l2) in
    let rec sub = function
        | '+' :: tl -> (||) Plus (sub tl)
        | '-' :: tl -> (||) Minus (sub tl)
        | '>' :: tl -> (||) Right (sub tl)
        | '<' :: tl -> (||) Left (sub tl)
        | '.' :: tl -> (||) Print (sub tl)
        | ',' :: tl -> (||) Read (sub tl)
        | '[' :: tl -> let loop, tl = (sub tl) in
                           (||) (Loop loop) (sub tl)
        | ']' :: tl -> ([], tl)
        | _ :: tl -> sub tl
        | [] -> ([], [])
    in
        fst (sub exp)