Friday 21 March 2008

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

Monday 17 March 2008

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