Executable BNF parser in Prolog

% <digit> ::= 0 | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9
% <sign> ::= + | -
% <number> ::= [ <sign> ] <digit> { <digit> }


:- op(1120, xfx, ::=).
:- op(11, fx, <), op(13, xf, >).


<digit>  ::= 0 ; 1 ; 2 ; 3 ; 4 ; 5 ; 6 ; 7 ; 8 ; 9 .
<sign>   ::= (+) ; (-)                             .
<number> ::= [ <sign> ], <digit>, { <digit> }      .

<expr>   ::= <factor>, { ((+) ; (-)), <factor> }   .
<factor> ::= <term>,   { ((*) ; (/)), <term> }     .
<term>   ::= '(', <expr>, ')' ; <number>           .


parse(Rule)    --> { Rule ::= Body }, parse(Body).
parse(Atom)    --> { atomic(Atom), atom_codes(Atom, Codes) }, Codes.

parse((X , Y)) --> parse(X), parse(Y).

parse((X ; _)) --> parse(X).
parse((_;Y;Z)) --> parse(Y ; Z).
parse((_ ; Z)) --> { Z \= (_ ; _) }, parse(Z).

parse([X])     --> parse(X).
parse([_])     --> {}.

parse({X})     --> parse(X), parse({X}).
parse({_})     --> [].


% phrase(parse(<expr>), "-5*(73+7)").

Compare with a C implementation -- http://cvs.savannah.gnu.org/viewvc/bnf/bnf/src/grio.c?view=markup

An Embedded ALGOL-like language in Prolog

%% Embedded ALGOL-like language in Prolog

change_member(_, N, [], [N]).
change_member(O, N, [O|XS], [N|XS]).
change_member(O, N, [X|XS], [X|YS]) :- change_member(O, N, XS, YS).


:- op(900, xfy, :=).
:- op(100, fx, [if, then, else]).
:- op(125, fx, [while,  return]).
:- op(125, yfx, do).


run({Block},                          EnvI, O, Ret) :-
  run(Block, EnvI, O, Ret).

run((First; Second),                  EnvI, O, Ret) :-
  run(First, EnvI, M, _), run(Second, M, O, Ret).

run(Place := Expr,                    EnvI, O, void) :-
  eval(Expr, Value, EnvI), change_member(Place = _, Place = Value, EnvI, O), !.

run(if(Cond) then {This} else {That}, EnvI, O, Ret) :-
  eval(Cond, Value, EnvI),
  ( Value = true -> Body = This ; Body = That ),
  run(Body, EnvI, O, Ret).

run(while(Cond) do {Body},            EnvI, O, Ret) :-
  eval(Cond, Value, EnvI),
  ( Value = true -> run(Body, EnvI, M, _),
                    run(while(Cond) do {Body}, M, O, Ret)
  ; O = EnvI, Ret = void
  ).

run(return Value,                     EnvI, O, Ret) :-
  eval(Value, Ret, EnvI), O = EnvI.


eval(Var,   Val,   Env) :- member(Var = Val, Env), !.
eval(Num,   Num,   _  ) :- number(Num), !.
eval(true,  true,  _  ).
eval(false, false, _  ).

eval(X + Y, Z, Env) :- eval(X, XV, Env), eval(Y, YV, Env), Z is XV + YV.
eval(X - Y, Z, Env) :- eval(X, XV, Env), eval(Y, YV, Env), Z is XV - YV.
eval(X * Y, Z, Env) :- eval(X, XV, Env), eval(Y, YV, Env), Z is XV * YV.
eval(X / Y, Z, Env) :- eval(X, XV, Env), eval(Y, YV, Env), Z is truncate(XV / YV).

eval(X = Y, B, Env) :- eval(X, XV, Env), eval(Y, YV, Env),
  ( XV = YV -> B = true ; B = false ).
eval(X < Y, B, Env) :- eval(X, XV, Env), eval(Y, YV, Env),
  ( XV < YV -> B = true ; B = false ).
eval(X > Y, B, Env) :- eval(X, XV, Env), eval(Y, YV, Env),
  ( XV > YV -> B = true ; B = false ).
eval(not(P), B, Env) :- eval(P, PV, Env),
  ( PV = true -> B = false ; B = true ).





factorial(N, {i := 1;
              n := N;
              while(n > 0) do {
                i := i * n;
                n := n - 1
              };
              return i}).

%% ?- factorial(5, P), run(P, [], _, X).

%% X = 120



fibonacci(F, {i := 1; a := 1; b := 1;
              while(not(i = F)) do {
                a := a + b;
                b := a - b;
                i := i + 1
              };
              return b}).

%% ?- fibonacci(7, P), run(P, [], _, X).

%% X = 13



pow2(N, {i := N;
         n := 1;
         while(not(i = 0)) do {
           i := i - 1;
           n := n * 2
         };
         return n}).

%% ?- pow2(8, P), run(P, [], _, X).

%% X = 256



gcd(X, Y,
    {x := X;
     y := Y;
     while(not(x = 0)) do {
       if(x < y) then {
         y := y - x
       }
       else {
         x := x - y
       }
     };
     return y}).

%% ?- A is 2*2*5*7*13, B is 5*13*7*7, gcd(A, B, P), run(P, [], _, X).

%% A = 1820,
%% B = 3185,
%% X = 455



isqrt(N, {q := N; p := (q + N / q) / 2;
          while(q > p) do {
            q := p;
            p := (q + N / q) / 2
          };
          return p}).

%% ?- isqrt(81, P), run(P, [], _, X).

%% X = 9