:- module(peg, [
    op(1150, xfy, $),
    op(1100, xfy, /),
    op(900, xf, *),
    op(900, xf, +),
    op(900, xf, ?),
    op(900, fx, &),
    op(900, fx, !),
    op(900, yfx, **),
    op(200, xfy, ^),
    op(1, fx, $),
    (/)/4, (*)/3, (+)/3, (?)/3, (!)/3, (&)/3, (**)/4, (^)/4,
    span/4, eof/2, any/2, char/3, char/4,
    either/6, list0/5, list1/5,
    maybe/4, maybe/5, exactly/5,
    ($)/4, ($)/3, clear_errors/0, error/1, try/5,
    location/4
]).

:- op(1150, xfy, $).
:- op(1100, xfy, /).
:- op(900, xf, *).
:- op(900, xf, +).
:- op(900, xf, ?).
:- op(900, fx, &).
:- op(900, fx, !).
:- op(900, yfx, **).
:- op(200, xfy, ^).
:- op(1, fx, $).

:- meta_predicate '$'(+, //, ?, ?).
:- meta_predicate '/'(//, //, ?, ?).
:- meta_predicate '*'(//, ?, ?).
:- meta_predicate '+'(//, ?, ?).
:- meta_predicate '?'(//, ?, ?).
:- meta_predicate '!'(//, ?, ?).
:- meta_predicate '&'(//, ?, ?).
:- meta_predicate '**'(//, +, ?, ?).
:- meta_predicate '^'(?, //, ?, ?).

:- meta_predicate span(//, ?, ?, ?).
:- meta_predicate either(?, //, //, ?, ?, ?).
:- meta_predicate list0(?, //, ?, ?, ?).
:- meta_predicate list1(?, //, ?, ?, ?).
:- meta_predicate maybe(//, ?, ?, ?).
:- meta_predicate maybe(?, //, ?, ?, ?).
:- meta_predicate exactly(?, //, ?, ?, ?).
:- meta_predicate try(//, ?, //, ?, ?).

E1 / E2 --> E1 -> []; E2.
E* --> (E+)? .
E+ --> E, E* .
E? --> E / [].
!E --> \+E.
&(E, L, L) :- phrase(E, L, _).
E**N --> {succ(N0, N)}, E, E**N0.
_E**0 --> [].

remove_vars(_, [], []).
remove_vars(RVs, [V0|V0s], Vs) :-
  (member(V, RVs), V == V0 -> Vs = V1s; Vs = [V0|V1s]),
  remove_vars(RVs, V0s, V1s).

V^E -->
  {term_variables(E, V0s),
   term_variables(V, RVs),
   remove_vars(RVs, V0s, Vs),
   copy_term({Vs, E}, {Vs, Ec})},
  Ec.

span(P, L, L0, L1) :-
  phrase(P, L0, L1),
  append(L, L1, L0).

eof([], []).

any --> [_].

char(Type) --> char(Type, _).

char(Type, C) -->
    [C], {char_type(C, Type)}.

either(X, E1, E2, LR) -->
  X^({LR = left(X)}, E1) /
  X^({LR = right(X)}, !E1, E2).

list0(X, E, L) -->
  ({L = [_|_]}, list1(X, E, L)) / {L = []}.

list1(X, E, [Xp|L]) -->
  X^({Xp = X}, E), list0(X, E, L).

maybe(E, M) -->
  {M = yes}, E / {M = no}.

maybe(X, E, M) -->
  X^({M = yes(X)}, E) / {M = no}.

exactly(X, E, (Xp, Tp)) -->
  X^({Xp = X}, E),
  ({nonvar(Tp), Tp = (_,_)} -> exactly(X, E, Tp);
   X^({Tp = X}, E)).

exactly(X, E, [Xp|L]) -->
  X^({Xp = X}, E), exactly(X, E, L).

exactly(_X, _E, []) --> [].

$(W, S, S) :-
  nb_setval(peg_error, []);
  nb_getval(peg_error, Es), nb_setval(peg_error, [expected(W, S) | Es]), fail.

W $ E -->
  nb_setval(peg_error, []), E *-> [];
  nb_getval(peg_error, Es), nb_setval(peg_error, [expected(W, S) | Es]), fail.

clear_errors :-
  b_setval(peg_error, []).

error(Err) :-
  nb_current(peg_error, Err) -> true; Err = [].

:- use_module(library(apply)).

state(S, S, S).

try(E, Err, Recover) -->
  {clear_errors}, (E -> []; Err^(state(S), {error(Err0), maplist(add_location(S), Err0, Err)}, Recover)).

location(S, S, 1, 1) :- !.
location([10|S], S0, Line, Column) :- !,
  location(S, S0, Line0, Column),
  Line is Line0 + 1 .
location([_|S], S0, Line, Column) :-
  location(S, S0, Line, Column0),
  (Line = 1 -> Column is Column0 + 1; Column = Column0).

add_location(S, expected(W, SE), expected(W, SE, Line, Column)) :-
  location(S, SE, Line, Column).
