1% Common utility predicates
    2:- module(tidylog_common, [ codes//1
    3                          , end_of_line//0
    4                          , eos//0
    5                          , format//2
    6                          , parsing//0
    7                          , prefer_none//1
    8                          , prefer_one//1
    9                          , rest_of_line//1
   10                          , when_generating//1
   11                          , when_parsing//1
   12                          ]).   13
   14:- use_module(library(tidylog/char), [horizontal//0]).
 parsing// is semidet
True if DCG is operating as a parser. Specifically, the DCG list is not a variable.
   21parsing(H,H) :-
   22    nonvar(H).
 eos//
True if DCG list is at its end.
   28eos([],[]).
 greedy(:Rule)//
True if Rule matches as many times as possible.
   34:- meta_predicate greedy(//,?,?).   35greedy(Rule) -->
   36    call(Rule),
   37    greedy(Rule).
   38greedy(_) -->
   39    [].
 end_of_line//
True if list is at the end of a line. This could be either a newline character or the end of input. It prefers a newline character.
   46end_of_line -->
   47    "\n".
   48end_of_line -->
   49    eos.
 codes(?Codes:list)//
Take as few characters as possible, more on backtracking.
   55codes([]) -->
   56    [].
   57codes([Code|Codes]) -->
   58    [Code],
   59    codes(Codes).
 rest_of_line(?Line:list)//
Line is all characters before a newline or end of stream. Newline character is left on the stream.
   66rest_of_line([]) -->
   67    prefer_none(horizontal),
   68    ( \+ \+ "\n" ; eos ).
   69rest_of_line([Code|Codes]) -->
   70    [Code],
   71    { Code \== 0'\n },
   72    rest_of_line(Codes).
 prefer_none(:Rule)//
True if DCG Rule matches. When parsing, Rule may matches as many times as possible. When generating, Rule matches 0 times.
   79:- meta_predicate prefer_none(//,?,?).   80prefer_none(Rule) -->
   81    ( parsing -> greedy(Rule); [] ).
 prefer_one(:Rule)//
True if DCG Rule matches. When parsing, Rule may matches as many times as possible. When generating, Rule matches 1 time.
   88:- meta_predicate prefer_one(//,?,?).   89prefer_one(Rule) -->
   90    ( parsing -> greedy(Rule); call(Rule) ).
 when_generating(:Goal)//
Call Goal when DCG operates in generator mode.
   96:- meta_predicate when_generating(0,?,?).   97when_generating(Goal) -->
   98    ( parsing -> []; { call(Goal) } ).
 when_parsing(:Goal)//
Call Goal when DCG operates in parsing mode.
  104:- meta_predicate when_parsing(0,?,?).  105when_parsing(Goal) -->
  106    ( parsing -> { call(Goal) }; [] ).
 format(+Pattern, +Args)//
Generate format/2 output onto DCG list.
  112format(Pattern,Args,H,T) :-
  113    format(codes(H,T),Pattern,Args)