Volodymyr Gubarkov

Stand With Ukraine

Implementing Brainfuck interpreter in Mercury

February 2011

(This is an ancient article revived from my Blogspot. In those old times I was interested in the Mercury programming language)

As part of the study of the functional/logic programming language Mercury (wiki), I wrote my own version of the interpreter of the famous esoteric programming language Brainfuck. This is an optimizing interpreter, the following brainfuck templates are optimized:

Program:

:- module bf.

:- interface.

:- import_module io.

:- pred main(io::di, io::uo) is det.

:- implementation.

:- import_module list, string, char, solutions, require, int, bool, getopt.

:- type side ---> to_left; to_right.

:- type bf_cmd ---> plus; minus; step; back; print; read; cycle(list(bf_cmd));
    % optimized commands
    plus(int); zero;
     
    step(int); % may be less then 0
    
    % [<++++++>-] => move(left, 1, 5)
    % [>>>>+<<<<-] => move(right, 4, 1)
    move(side :: side, steps :: int, multiplier :: int);
    
    % [<<<<+>>>>>>+<<-]
    move2(steps1 :: bf_cmd, mul1 :: int, 
     steps2 :: bf_cmd, mul2 :: int, 
     steps3 :: bf_cmd). 

:- type bf_ast == list(bf_cmd).

:- type bf_state ---> bf_state(
 left :: list(int),
 cell :: int,
 right :: list(int)
).

description = "Brainfuck interpreter written in Mercury programming language \
(http://www.mercury.csse.unimelb.edu.au/) by Volodymyr Gubarkov (xonixx@gmail.com)".

one_solution(Pred, Solution) :-
 solutions(Pred, [Solution|_]).

chars_to_ast(Chars) = Ast :-
 CharsClean = clean_chars(Chars),
 ( one_solution(pred(Ast_::out) is nondet :- ast(Ast_, CharsClean, []:list(char)), Ast0) ->
  Ast = Ast0
 ;
  error("Program invalid (parse error)!")
 ).
 
bf('+'). bf('-').
bf('>'). bf('<').
bf('['). bf(']').
bf('.'). bf(',').

clean_chars([]) = [].
clean_chars([H|T]) = R :-
 ( bf(H) ->
  R = [H|clean_chars(T)]
 ; 
  R = clean_chars(T)
 ).

:- mode ast(out, in, out) is multi.
ast([plus|Cmds]) --> ['+'], ast(Cmds).
ast([minus|Cmds]) --> ['-'], ast(Cmds).
ast([step|Cmds]) --> ['>'], ast(Cmds).
ast([back|Cmds]) --> ['<'], ast(Cmds).
ast([print|Cmds]) --> ['.'], ast(Cmds).
ast([read|Cmds]) --> [','], ast(Cmds).
ast([cycle(Cycle)|Cmds]) --> ['['], ast(Cycle), [']'], ast(Cmds).
ast([]) --> [].

execute_ast([], !State) --> [].
execute_ast([Cmd|Cmds], !State) --> execute_cmd(Cmd, !State), execute_ast(Cmds, !State).

:- mode execute_cmd(in, in, out, di, uo) is det.
execute_cmd(plus, bf_state(L,C,R), bf_state(L, C+1, R)) --> [].
execute_cmd(minus, bf_state(L,C,R), bf_state(L, C-1, R)) --> [].
execute_cmd(plus(N), bf_state(L,C,R), bf_state(L, C+N, R)) --> [].
execute_cmd(zero, bf_state(L,_,R), bf_state(L, 0, R)) --> [].
execute_cmd(step, bf_state(L,C,R), bf_state([C|L], H, T)) --> {R = [], H=0, T=[]; R = [H|T]}.
execute_cmd(back, bf_state(L,C,R), bf_state(T, H, [C|R])) --> {L = [], H=0, T=[]; L = [H|T]}.
execute_cmd(print, S @ bf_state(_,C,_), S) --> print(char.det_from_int(C):char).
execute_cmd(read, bf_state(L,_,R), bf_state(L, C, R)) --> 
 read_char(Res),
 { Res = ok(Char),
  C = char.to_int(Char)
 ; 
  Res = eof,
  C = 0 % see http://en.wikipedia.org/wiki/Brainfuck#End-of-file_behavior
  %error("eof")
 ;
  Res = error(Error),
  error(error_message(Error)) 
 }.
execute_cmd(Cmd @ cycle(Cmds), !.S @ bf_state(_,C,_), !:S) --> 
 ( {C \= 0} -> 
  execute_ast(Cmds, !S), 
  execute_cmd(Cmd, !S)
 ;
  []
 ).
execute_cmd(step(N), !S) --> 
 ( { N \= 0 } ->
  { GreaterThenZero = (N > 0) },
  execute_cmd((GreaterThenZero -> step; back),!S),
  execute_cmd(step(GreaterThenZero -> N-1; N+1),!S)
 ;
  []
 ).
execute_cmd(move(Side, Steps, Multiplier), !.S @ bf_state(_,C,_), !:S) -->
 { Side = to_left,
  A = step(-Steps),
  B = step(Steps)
 ;
  Side = to_right,
  A = step(Steps),
  B = step(-Steps)
 },
 execute_ast([A, plus(C * Multiplier), B, zero], !S).
execute_cmd(move2(Steps1, Mul1, Steps2, Mul2, Steps3), !.S @ bf_state(_,C,_), !:S) -->
 execute_ast([Steps1, plus(C * Mul1), 
   Steps2, plus(C * Mul2),
   Steps3, zero], !S).
 
optimize_cycle(CycleAst) = Res :-
 ( (CycleAst = [bf.plus]; CycleAst = [bf.minus]) ->
  Res = zero
 ;
  one_solution(pred(P_::out) is nondet :- move_pattern(P_, CycleAst, []:bf_ast), MoveCmd) ->
  Res = MoveCmd
 ;
  one_solution(pred(P_::out) is nondet :- move2_pattern(P_, CycleAst, []:bf_ast), Move2Cmd) ->
  Res = Move2Cmd
 ;
  Res = cycle(optimize_ast(CycleAst))
 ).  
  
optimize_ast(InAst) = OutAst :-
 ( InAst = [cycle(CycleAst)|T] ->
  OutAst = [optimize_cycle(CycleAst)|optimize_ast(T)]
 ;
  InAst = [plus,plus|T] ->
  OutAst = optimize_ast([plus(2)|T])
 ; 
  InAst = [minus,minus|T] ->
  OutAst = optimize_ast([plus(-2)|T])
 ;
  InAst = [plus(N),plus|T] ->
  OutAst = optimize_ast([plus(N+1)|T])
 ;
  InAst = [plus(N),minus|T] ->
  OutAst = optimize_ast([plus(N-1)|T])
 ; 
  InAst = [H|T] ->
  OutAst = [H|optimize_ast(T)]
 ;
  OutAst = InAst
 ).


take(E, N) --> take(E, 0, N), {N > 0}.

take(E, N0, N1) --> 
 ( [E] -> 
  take(E, N0+1, N1)
 ;
  {N0 = N1}
 ).

% [-<++++++>]
% [<++++++>-]
% [->>>>+<<<<]
% [>>>>+<<<<-]
one_minus --> [bf.minus].

move_to_left(Steps, Multiplier) --> take(back, Steps), take(bf.plus, Multiplier), take(step, Steps).
move_to_right(Steps, Multiplier) --> take(step, Steps), take(bf.plus, Multiplier), take(back, Steps).

move_pattern(move(to_left, Steps, Multiplier)) --> one_minus, move_to_left(Steps, Multiplier).
move_pattern(move(to_left, Steps, Multiplier)) --> move_to_left(Steps, Multiplier), one_minus.
move_pattern(move(to_right, Steps, Multiplier)) --> one_minus, move_to_right(Steps, Multiplier).
move_pattern(move(to_right, Steps, Multiplier)) --> move_to_right(Steps, Multiplier), one_minus.

% [<<<<+>>>>>>+<<-]
steps(step(-N)) --> take(back, N).
steps(step(N)) --> take(step, N).

move2(Steps1, Mul1, Steps2, Mul2, Steps3) -->
 steps(Steps1), take(bf.plus, Mul1), steps(Steps2), take(bf.plus, Mul2), steps(Steps3),
 { steps_add([Steps1, Steps2, Steps3], 0) }. 

move2_pattern(move2(Steps1, Mul1, Steps2, Mul2, Steps3):bf_cmd) --> 
 one_minus, move2(Steps1, Mul1, Steps2, Mul2, Steps3).
move2_pattern(move2(Steps1, Mul1, Steps2, Mul2, Steps3)) --> 
 move2(Steps1, Mul1, Steps2, Mul2, Steps3), one_minus.

steps_add([], 0).
steps_add([step(N)], N).
steps_add([step(N), step(N1)|T], R) :- steps_add([step(N+N1)|T], R).

execute_chars(Chars, Options, !IO) :- 
 Ast = chars_to_ast(Chars),
 AstOpt = optimize_ast(Ast),
 lookup_bool_option(Options, print_ast, PrintAst),
 ( PrintAst = yes,
  write_string("AST:\n", !IO),
  print(Ast, !IO),
  write_string("\n\nOptimized AST:\n", !IO),
  print(AstOpt, !IO)
 ;
  PrintAst = no,
  lookup_bool_option(Options, do_not_optimize, NoOpt),
  ( NoOpt = yes,
   UseAst = Ast
  ;
   NoOpt = no,
   UseAst = AstOpt
  ),
  execute_ast(UseAst, bf_state([], 0, []), _, !IO)
 ).

get_chars_from_current_stream(Chars) -->
 read_file(Result),
 { Result = ok(Chars)
 ; 
  Result = error(_,Error),
  error(error_message(Error))
 }.

launch(Filename, Options, !IO) :-
 see(Filename, Result, !IO),
 ( Result = ok,
  get_chars_from_current_stream(Chars, !IO),
  seen(!IO),
  execute_chars(Chars, Options, !IO) 
 ; 
  Result = error(Error),
  write_string(Filename ++ " : ", !IO), 
  write_string(error_message(Error), !IO) 
 ).
 
usage -->
 write_strings([description,
 "\n\nUsage: bf [options] ",
 "\n\nOptions:",
 "\n\t-a, --ast", 
  "\n\t\tPrint AST & optimized AST of bf program.",
 "\n\t-n, --do-not-optimize", 
  "\n\t\tTurn off optimization.",
 "\n\t-h, --help",
  "\n\t\tPring this help."
 ]).
 
:- type bf_option ---> print_ast; help; do_not_optimize.

:- mode opt_short(in, out) is semidet.
:- mode opt_long(in, out) is semidet.
:- mode opt_defaults(out, out) is nondet.

opt_short('a', print_ast).
opt_short('h', help).
opt_short('n', do_not_optimize).

opt_long("ast", print_ast).
opt_long("help", help).
opt_long("do-not-optimize", do_not_optimize).

opt_defaults(print_ast, bool(bool.no):option_data).
opt_defaults(help, bool(bool.no)).
opt_defaults(do_not_optimize, bool(bool.no)).

main(!IO) :-
 command_line_arguments(Args0, !IO),
 
 process_options(
  option_ops(opt_short,opt_long,opt_defaults),
  Args0, Args,
  MaybeOptions),
  
 ( MaybeOptions = error(String),
  write_string(String, !IO)
 ; 
  MaybeOptions = ok(Options),
  lookup_bool_option(Options, help, Help),
  ( Help = yes,
   usage(!IO)
  ;
   Help = no,
   ( Args = [],
    usage(!IO)
   ; 
    Args = [Filename|_], 
    launch(Filename, Options, !IO)
   )
  )
 ).

To compile this code:

$ mmc --make --infer-all -s hlc.gc -O6 bf

A couple of examples of work:

$ bf
Brainfuck interpreter written in Mercury programming language (http://www.mercur
y.csse.unimelb.edu.au/) by Volodymyr Gubarkov (xonixx@gmail.com)

Usage: bf [options] 

Options:
        -a, --ast
                Print AST & optimized AST of bf program.
        -n, --do-not-optimize
                Turn off optimization.
        -h, --help
                Pring this help.

$ bf jabh.b
Just another brainfuck hacker.

$ cat jabh.b | bf kbfi.b
Just another brainfuck hacker.

$ bf PRIME.BF
Primes up to: 100
2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97

$ bf gameoflife.b
 abcdefghij
a----------
b----------
c----------
d----------
e----------
f----------
g----------
h----------
i----------
j----------
>ff
 abcdefghij
a----------
b----------
c----------
d----------
e----------
f-----*----
g----------
h----------
i----------
j----------
>ef
 abcdefghij
a----------
b----------
c----------
d----------
e-----*----
f-----*----
g----------
h----------
i----------
j----------
>df
 abcdefghij
a----------
b----------
c----------
d-----*----
e-----*----
f-----*----
g----------
h----------
i----------
j----------
>gf
 abcdefghij
a----------
b----------
c----------
d-----*----
e-----*----
f-----*----
g-----*----
h----------
i----------
j----------
>cf
 abcdefghij
a----------
b----------
c-----*----
d-----*----
e-----*----
f-----*----
g-----*----
h----------
i----------
j----------
>hf
 abcdefghij
a----------
b----------
c-----*----
d-----*----
e-----*----
f-----*----
g-----*----
h-----*----
i----------
j----------
>
 abcdefghij
a----------
b----------
c----------
d----***---
e----***---
f----***---
g----***---
h----------
i----------
j----------
>
 abcdefghij
a----------
b----------
c-----*----
d----*-*---
e---*---*--
f---*---*--
g----*-*---
h-----*----
i----------
j----------
>
 abcdefghij
a----------
b----------
c-----*----
d----***---
e---**-**--
f---**-**--
g----***---
h-----*----
i----------
j----------
>
 abcdefghij
a----------
b----------
c----***---
d---*---*--
e----------
f----------
g---*---*--
h----***---
i----------
j----------
>
 abcdefghij
a----------
b-----*----
c----***---
d----***---
e----------
f----------
g----***---
h----***---
i-----*----
j----------
>
 abcdefghij
a----------
b----***---
c----------
d----*-*---
e-----*----
f-----*----
g----*-*---
h----------
i----***---
j----------
>
 abcdefghij
a-----*----
b-----*----
c----*-*---
d-----*----
e----***---
f----***---
g-----*----
h----*-*---
i-----*----
j-----*----
>
 abcdefghij
a----------
b----***---
c----*-*---
d----------
e----------
f----------
g----------
h----*-*---
i----***---
j----------
>
 abcdefghij
a-----*----
b----*-*---
c----*-*---
d----------
e----------
f----------
g----------
h----*-*---
i----*-*---
j-----*----
>
 abcdefghij
a-----*----
b----*-*---
c----------
d----------
e----------
f----------
g----------
h----------
i----*-*---
j-----*----
>
 abcdefghij
a-----*----
b-----*----
c----------
d----------
e----------
f----------
g----------
h----------
i-----*----
j-----*----
>
 abcdefghij
a----------
b----------
c----------
d----------
e----------
f----------
g----------
h----------
i----------
j----------
>q

$ bf dquine.b
>+++++>+++>+++>+++++>+++>+++>+++++>++++++>+>++>+++>++++>++++>+++>+++>+++++>+>+>+
+++>+++++++>+>+++++>+>+>+++++>++++++>+++>+++>++>+>+>++++>++++++>++++>++++>+++>++
+++>+++>+++>++++>++>+>+>+>+>++>++>++>+>+>++>+>+>++++++>++++++>+>+>++++++>++++++>
+>+>+>+++++>++++++>+>+++++>+++>+++>++++>++>+>+>++>+>+>++>++>+>+>++>++>+>+>+>+>++
>+>+>+>++++>++>++>+>+++++>++++++>+++>+++>+++>+++>+++>+++>++>+>+>+>+>++>+>+>++++>
+++>+++>+++>+++++>+>+++++>++++++>+>+>+>++>+++>+++>+++++++>+++>++++>+>++>+>++++++
+>++++++>+>+++++>++++++>+++>+++>++>++>++>++>++>++>+>++>++>++>++>++>++>++>++>++>+
>++++>++>++>++>++>++>++>++>+++++>++++++>++++>+++>+++++>++++++>++++>+++>+++>++++>
+>+>+>+>+++++>+++>+++++>++++++>+++>+++>+++>++>+>+>+>++++>++++[[>>>+<<<-]<]>>>>[<
<[-]<[-]+++++++[>+++++++++>++++++<<-]>-.>+>[<.<<+>>>-]>]<<<[>>+>>>>+<<<<<<-]>++[
>>>+>>>>++>>++>>+>>+[<<]>-]>>>-->>-->>+>>+++>>>>+[<<]<[[-[>>+<<-]>>]>.[>>]<<[[<+
>-]<<]<<]

Brainfuck-programs:

These and other programs in brainfuck can be found at the links:


If you noticed a typo or have other feedback, please email me at xonixx@gmail.com