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(dcg_codes, [
   20		writedcg/1
   21   ,  phrase_string/2
   22   ,  phrase_atom/2
   23
   24   % Types
   25   ,  ctype//1
   26
   27   % Constants
   28	,	null//0
   29   ,	cr//0
   30   ,  sp//0
   31   ,  fs//0
   32	,	fssp/2
   33   ,	tb/2
   34   ,	comma/2
   35   ,  commasp/2
   36
   37   % Writing Prolog data
   38	,	at//1
   39   ,	wr//1
   40   ,	str//1
   41   ,  fmt//2
   42	,	padint/5
   43
   44   % Brackets
   45	,	brace//1
   46   ,	paren//1
   47   ,	sqbr//1
   48
   49   % Quoting and escaping
   50	,	q//1
   51   ,	qq//1
   52	,	escape//2 % escape Char by doubling up 
   53   ,  escape_with//3 % escape Char1 with Char2
   54   ,  esc//2  % predicate based, most flexible
   55]).

DCG utilities for list of character codes representation.

This module contains predicates for working with DCGs defined over sequences of character codes. Some of the predicates can only be used to generate sequences, not parse them.

*/

   65:- meta_predicate 
   66		writedcg(2)
   67   ,  phrase_string(//,-)
   68   ,  phrase_atom(//,-)
   69	,	brace(//,?,?)
   70	,	paren(//,?,?)
   71	,	sqbr(//,?,?)
   72	,	qq(//,?,?)
   73	,	q(//,?,?)
   74   ,  esc(4,?,?,?)
	.   76
   77:- set_prolog_flag(double_quotes, codes).
 writedcg(+P:phrase) is nondet
Run the phrase P, which must be a standard list-of-codes DCG, and print the output.
   84writedcg(Phrase) :-
   85	phrase(Phrase,Codes),
   86	format('~s',[Codes]).
 phrase_string(+P:phrase, -S:string) is nondet
phrase_string(+P:phrase, +S:string) is nondet
Use list-of-codes DCG phrase P to parse or generate a string S.
   93phrase_string(Phrase,String) :-
   94   (  var(String)
   95   -> phrase(Phrase,Codes), string_codes(String,Codes)
   96   ;  string_codes(String,Codes), phrase(Phrase,Codes)
   97   ).
 phrase_atom(+P:phrase, -A:atom) is nondet
phrase_atom(+P:phrase, +A:atom) is nondet
Use list-of-codes DCG phrase P to parse or generate a atom A.
  103phrase_atom(Phrase,Atom) :-
  104   (  var(Atom)
  105   -> phrase(Phrase,Codes), atom_codes(Atom,Codes)
  106   ;  atom_codes(Atom,Codes), phrase(Phrase,Codes)
  107   ).
 ctype(Type)// is nondet
Matches a code C that satisfies code_type(C,Type). See char_type/2 for listing of types.
  112ctype(T) --> [X], {code_type(X,T)}.
 null// is det
Empty string.
  116null  --> "".
 cr// is det
Carriage return "\n".
  120cr    --> "\n".
 sp// is det
Space " ".
  124sp    --> " ".
 fs// is det
Full stop (period) ".".
  128fs    --> ".".
 fssp// is det
Full stop (period) followed by space.
  132fssp  --> ". ".
 tb// is det
Tab "\t".
  136tb    --> "\t".
 comma// is det
Comma ",".
  140comma   --> ",".
 commasp// is det
Comma and space ", ".
  144commasp --> ", ".
 at(+X:atom)// is det
Generate code list for textual representation of atom X.
  148at(A,C,T) :- atomic(A), with_output_to(codes(C,T),write(A)).
 wr(+X:term)// is det
Generate the list of codes for term X, as produced by write/1.
  152wr(X,C,T) :- ground(X), with_output_to(codes(C,T),write(X)).
 wq(+X:term)// is det
Generate the list of codes for term X, as produced by writeq/1.
  156wq(X,C,T) :- ground(X), with_output_to(codes(C,T),writeq(X)).
 str(+X:term)// is det
Generate the list of codes for string X, as produced by writeq/1.
  160str(X,C,T):- string(X), with_output_to(codes(C,T),write(X)).
 fmt(+F:atom, +Args:list)// is det
Generate list of codes using format/3.
  164fmt(F,A,C,T) :- format(codes(C,T),F,A).
 padint(+N:integer, +Range, +X:integer)// is det
padint(+N:integer, +Range, -X:integer)// is nondet
Write integer X padded with zeros ("0") to width N.
  170padint(N,..(L,H),X,C,T) :- 
  171	between(L,H,X), 
  172	format(codes(C,T),'~`0t~d~*|',[X,N]).
 brace(+P:phrase)// is nondet
Generate "{" before and "}" after the phrase P.
  176brace(A) --> "{", phrase(A), "}".
 paren(+P:phrase)// is nondet
Generate "(" before and ")" after the phrase P.
  180paren(A) --> "(", phrase(A), ")".
 sqbr(+P:phrase)// is nondet
Generate "[" before and "]" after the phrase P.
  184sqbr(A)  --> "[", phrase(A), "]".
 q(+P:phrase)// is nondet
Generate list of codes from phrase P, surrounds it with single quotes, and escapes (by doubling up) any internal quotes so that the generated string is a valid quoted string. Must be list of codes DCG.
  190q(X,[0''|C],T)  :- T1=[0''|T], escape_with(0'',0'',X,C,T1). 
 qq(+P:phrase)// is nondet
Generate list of codes from phrase P, surrounds it with double quotes, and escapes (by doubling up) any double quotes so that the generated string is a valid double quoted string.
  196qq(X,[0'"|C],T) :- T1=[0'"|T], escape_with(0'",0'",X,C,T1). 
 escape(+Q:C, +P:phrase)// is nondet
Runs phrase P to generate a list of elements of type C and then escapes any occurrences of Q by doubling them up, e.g., escape(39,"some 'text' here") doubles up the single quotes yielding "some ''text'' here".
  204:- meta_predicate escape(+,//,?,?).  205escape(Q,A) --> escape_with(Q,Q,A).
 escape_with(+E:C, +Q:C, +P:phrase)// is nondet
Runs phrase P to generate a list of elements of type C and then escapes any occurrences of Q by prefixing them with E, e.g., escape_with(92,39,"some 'text' here") escapes the single quotes with backslashes, yielding "some \'text\' here".
  213:- meta_predicate escape_with(+,+,//,?,?).  214escape_with(E,Q,Phrase,L1,L2) :-
  215	phrase(Phrase,L0,L2),
  216	escape_codes(E,Q,L0,L1,L2).
  217
  218% escape difference list of codes with given escape character
  219escape_codes(_,_,A,A,A).
  220escape_codes(E,Q,[Q|X],[E,Q|Y],T) :-escape_codes(E,Q,X,Y,T).
  221escape_codes(E,Q,[A|X],[A|Y],T)   :- Q\=A, escape_codes(E,Q,X,Y,T).
 esc(+Esc:esc, +Codes:list(code))// is det
esc(+Esc:esc, -Codes:list(code))// is nondet
Parser for a sequence of characters involving escape sequences. These are recognised by the predicate Esc, whose type is
esc == pred(list(codes),list(codes))//.

The DCG goal esc(H,T) matches an escaped sequence in the string and unifies H-T with a difference list representing it's internal or semantic form. Esc must not place any constraints on the difference list tail T.

Starts with the longest possible match and retrieves shorter matches on backtracking.

  239esc(Esc,C1) --> call(Esc,C1,C2), !, esc(Esc,C2). 
  240esc(_,[]) --> [].
  241
  242% Not used, apparently.
  243% difflength(A-B,N) :- unify_with_occurs_check(A,B) -> N=0; A=[_|T], difflength(T-B,M), succ(M,N).
  244
  245% % tail recursive version
  246% difflength_x(A-B,M)       :- difflength_x(A-B,0,M).
  247% difflength_x(A-B,M,M)     :- unify_with_occurs_check(A,B).
  248% difflength_x([_|T]-A,M,N) :- succ(M,L), difflength_x(T-A,L,N).
  249
  250% These are some more escape/quoting mechanisms, disabled for now.
  251% escape_codes_with(Special,E,C) --> [E,C], {member(C,Special)}.
  252% escape_codes_with(Special,_,C) --> [C], {\+member(C,Special)}.