Volodymyr Gubarkov

Stand With Ukraine

Implementing Brainfuck interpreter in Mercury

February 2011 No LLM was used to write this article

(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