1/* Part of dcgutils
    2	Copyright 2012-2015 Samer Abdallah (Queen Mary University of London; UCL)
    3
    4	This program is free software; you can redistribute it and/or
    5	modify it under the terms of the GNU Lesser General Public License
    6	as published by the Free Software Foundation; either version 2
    7	of the License, or (at your option) any later version.
    8
    9	This program is distributed in the hope that it will be useful,
   10	but WITHOUT ANY WARRANTY; without even the implied warranty of
   11	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   12	GNU Lesser General Public License for more details.
   13
   14	You should have received a copy of the GNU Lesser General Public
   15	License along with this library; if not, write to the Free Software
   16	Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
   17*/
   18
   19:- module(snobol, [
   20		any//1
   21   ,  notany//1
   22   ,  arb//0
   23   ,  arbno//1
   24   ,  bal//1
   25	,	span//1
   26   ,  break//1
   27   ,  len//1
   28   ,  rem//0
   29   ,  ($)//2
   30   ,  op(400,yfx,$)
   31   ]).

SNOBOL-inspired DCG operators

NB. FAIL is just {fail} or dcg_core:fail SUCCEED is {repeat} or dcg_core:repeat. FENCE is ! (cut).

Sequence capture in SNOBOL ($) is also $ here: use Phrase $ List to capture the sequence matched by Phrase in the List.

ABORT cannot be implemented in plain Prolog because there is no ancestral cut operator. Instead abort//0 just throws an exception which you must arrange to catch yourself.

POS, RPOS, TAB and RTAB are not context-free rules and can only be implemented in paired-state DCG which counts the current position in the string. */

   53:- meta_predicate arbno(//,?,?), $(//,?,?,?).   54
   55% SNOBOL4ish rules
   56%
   57%	Others:
   58%		maxarb
   59%		pos rpos
   60%		tab rtab
True when Phrase is true and List is the sequence of terminals matched by it.
   66$(P,L,S1,S2) :- phrase(P,S1,S2), dlist(L,S1,S2).
   67
   68% need to be careful with difference lists...
   69dlist(Cs,L1,L2) :- is_list(Cs), !, append(Cs,L2,L1).
   70dlist([],L1,L2) :- L1==L2, !.
   71dlist([C|Cs],L1,L3) :- must_be(nonvar,L1), L1=[C|L2], dlist(Cs,L2,L3).
 rem// is det
   74rem(_,[]).
 abort// is det
   77abort(_,_) :- throw(abort).
 any(+L:list(_))// is nondet
Matches any element of L.
   81any(L)    --> [X], {member(X,L)}.
 notany(+L:list(_))// is nondet
Matches anything not in L.
   85notany(L) --> [X], {maplist(dif(X),L)}.
 arb// is nondet
Matches an arbitrary sequence. Proceeds cautiously.
   89arb       --> []; [_], arb.
 arbno(+P:phrase)// is nondet
Matches an arbitrary number of P. Proceeds cautiously. Any variables in P are shared across calls.
   94arbno(P)  --> []; call_dcg(P), arbno(P).
 span(+L:list(_))// is nondet
Matches the longest possible sequence of symbols from L.
   98span(L) --> any(L), span_tail(L).
   99span_tail(_, [], []).
  100span_tail(L) --> span(L).
  101span_tail(L, [X|T], [X|T]) :- maplist(dif(X), L).
 break(+L:list(_))// is nondet
Matches the longest possible sequence of symbols not in L.
  105break(_, [], []).
  106break(L) --> notany(L), break(L).
  107break(L, [X|T], [X|T]) :- member(X, L).
 len(+N:natural)// is det
len(-N:natural)// is nondet
Matches any N symbols.
  112len(N, L1, L2) :- length(L, N), append(L, L2, L1).
 bal(+Delims:list(C))// is nondet
Matches any expression with balanced generalised parentheses. The opening and closing parenthesis must be supplied as a list of terminals [Open,Close].
  118bal(Delims) --> bal_one(Delims), arbno(bal_one(Delims)).
  119bal_one(Delims) --> {Delims=[O,C]}, [O], bal(Delims), [C].
  120bal_one(Delims) --> notany(Delims)