kibi-swipl-linux-x64-gnu 1.0.0

package/lib/swipl/library/dcg/basics.pl

@@ -0,0 +1,514 @@
+/*  Part of SWI-Prolog
+
+    Author:        Jan Wielemaker
+    E-mail:        J.Wielemaker@vu.nl
+    WWW:           http://www.swi-prolog.org
+    Copyright (c)  2012-2023, University of Amsterdam
+                              VU University Amsterdam
+                              SWI-Prolog Solutions b.v.
+    All rights reserved.
+
+    Redistribution and use in source and binary forms, with or without
+    modification, are permitted provided that the following conditions
+    are met:
+
+    1. Redistributions of source code must retain the above copyright
+       notice, this list of conditions and the following disclaimer.
+
+    2. Redistributions in binary form must reproduce the above copyright
+       notice, this list of conditions and the following disclaimer in
+       the documentation and/or other materials provided with the
+       distribution.
+
+    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
+    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+    POSSIBILITY OF SUCH DAMAGE.
+*/
+
+:- module(dcg_basics,
+          [ white//0,                   % <white inside line>
+            whites//0,                  % <white inside line>*
+            blank//0,                   % <blank>
+            blanks//0,                  % <blank>*
+            nonblank//1,                % <nonblank>
+            nonblanks//1,               % <nonblank>* --> chars         (long)
+            blanks_to_nl//0,            % [space,tab,ret]*nl
+            string//1,                  % <any>* -->chars               (short)
+            string_without//2,          % Exclude, -->chars             (long)
+                                        % Characters
+            alpha_to_lower//1,          % Get lower|upper, return lower
+                                        % Decimal numbers
+            digits//1,                  % [0-9]* -->chars
+            digit//1,                   % [0-9] --> char
+            integer//1,                 % [+-][0-9]+ --> integer
+            float//1,                   % [+-]?[0-9]+(.[0-9]*)?(e[+-]?[0-9]+)? --> float
+            number//1,                  % integer | float
+                                        % Hexadecimal numbers
+            xdigits//1,                 % [0-9A-Fa-f]* --> 0-15*
+            xdigit//1,                  % [0-9A-Fa-f] --> 0-15
+            xinteger//1,                % [0-9A-Fa-f]+ --> integer
+
+            prolog_var_name//1,         % Read a Prolog variable name
+            csym//1,                    % Read a C symbol
+
+            eol//0,                     % End of line
+            eos//0,                     % Test end of input.
+            remainder//1,               % -List
+
+                                        % generation (TBD)
+            atom//1                     % generate atom
+          ]).
+:- use_module(library(lists)).
+:- use_module(library(error)).
+
+
+/** <module> Various general DCG utilities
+
+This library provides various commonly  used   DCG  primitives acting on
+list  of  character  *codes*.  Character   classification  is  based  on
+code_type/2.
+
+This module started its life as  library(http/dcg_basics) to support the
+HTTP protocol. Since then, it was increasingly  used in code that has no
+relation to HTTP and therefore  this  library   was  moved  to  the core
+library.
+
+@tbd    This is just a starting point. We need a comprehensive set of
+        generally useful DCG primitives.
+*/
+
+%!  string_without(+EndCodes, -Codes)// is det.
+%
+%   Take as many codes from the input  until the next character code
+%   appears in the list EndCodes.  The   terminating  code itself is
+%   left on the input.  Typical  use  is   to  read  upto  a defined
+%   delimiter such as a newline  or   other  reserved character. For
+%   example:
+%
+%       ==
+%           ...,
+%           string_without("\n", RestOfLine)
+%       ==
+%
+%   @arg EndCodes is a list of character codes.
+%   @see string//1.
+
+string_without(End, Codes) -->
+    { string(End),
+      !,
+      string_codes(End, EndCodes)
+    },
+    list_string_without(EndCodes, Codes).
+string_without(End, Codes) -->
+    list_string_without(End, Codes).
+
+list_string_without(Not, [C|T]) -->
+    [C],
+    { \+ memberchk(C, Not)
+    },
+    !,
+    list_string_without(Not, T).
+list_string_without(_, []) -->
+    [].
+
+%!  string(-Codes)// is nondet.
+%
+%   Take as few as possible tokens from the input, taking one more
+%   each time on backtracking. This code is normally followed by a
+%   test for a delimiter.  For example:
+%
+%   ==
+%   upto_colon(Atom) -->
+%           string(Codes), ":", !,
+%           { atom_codes(Atom, Codes) }.
+%   ==
+%
+%   @see string_without//2.
+
+string([]) -->
+    [].
+string([H|T]) -->
+    [H],
+    string(T).
+
+%!  blanks// is det.
+%
+%   Skip zero or more white-space characters.
+
+blanks -->
+    blank,
+    !,
+    blanks.
+blanks -->
+    [].
+
+%!  blank// is semidet.
+%
+%   Take next =space= character from input. Space characters include
+%   newline.
+%
+%   @see white//0
+
+blank -->
+    [C],
+    { nonvar(C),
+      code_type(C, space)
+    }.
+
+%!  nonblanks(-Codes)// is det.
+%
+%   Take all =graph= characters
+
+nonblanks([H|T]) -->
+    [H],
+    { code_type(H, graph)
+    },
+    !,
+    nonblanks(T).
+nonblanks([]) -->
+    [].
+
+%!  nonblank(-Code)// is semidet.
+%
+%   Code is the next non-blank (=graph=) character.
+
+nonblank(H) -->
+    [H],
+    { code_type(H, graph)
+    }.
+
+%!  blanks_to_nl// is semidet.
+%
+%   Take a sequence of blank//0 codes if blanks are followed by a
+%   newline or end of the input.
+
+blanks_to_nl -->
+    "\n",
+    !.
+blanks_to_nl -->
+    blank,
+    !,
+    blanks_to_nl.
+blanks_to_nl -->
+    eos.
+
+%!  whites// is det.
+%
+%   Skip white space _inside_ a line.
+%
+%   @see blanks//0 also skips newlines.
+
+whites -->
+    white,
+    !,
+    whites.
+whites -->
+    [].
+
+%!  white// is semidet.
+%
+%   Take next =white= character from input. White characters do
+%   _not_ include newline.
+
+white -->
+    [C],
+    { nonvar(C),
+      code_type(C, white)
+    }.
+
+
+                 /*******************************
+                 *       CHARACTER STUFF        *
+                 *******************************/
+
+%!  alpha_to_lower(?C)// is semidet.
+%
+%   Read a letter (class  =alpha=)  and   return  it  as a lowercase
+%   letter. If C is instantiated and the  DCG list is already bound,
+%   C must be =lower= and matches both a lower and uppercase letter.
+%   If the output list is unbound, its first element is bound to C.
+%   For example:
+%
+%     ==
+%     ?- alpha_to_lower(0'a, `AB`, R).
+%     R = [66].
+%     ?- alpha_to_lower(C, `AB`, R).
+%     C = 97, R = [66].
+%     ?- alpha_to_lower(0'a, L, R).
+%     L = [97|R].
+%     ==
+
+alpha_to_lower(L) -->
+    [C],
+    {   nonvar(C)
+    ->  code_type(C, alpha),
+        code_type(C, to_upper(L))
+    ;   L = C
+    }.
+
+
+                 /*******************************
+                 *            NUMBERS           *
+                 *******************************/
+
+%!  digits(?Chars)// is det.
+%!  digit(?Char)// is det.
+%!  integer(?Integer)// is det.
+%
+%   Number processing. The predicate  digits//1   matches a possibly
+%   empty set of digits,  digit//1  processes   a  single  digit and
+%   integer processes an  optional  sign   followed  by  a non-empty
+%   sequence of digits into an integer.
+
+digits([H|T]) -->
+    digit(H),
+    !,
+    digits(T).
+digits([]) -->
+    [].
+
+digit(C) -->
+    [C],
+    { code_type(C, digit)
+    }.
+
+integer(I, Head, Tail) :-
+    nonvar(I),
+    !,
+    format(codes(Head, Tail), '~d', [I]).
+integer(I) -->
+    int_codes(Codes),
+    { number_codes(I, Codes)
+    }.
+
+int_codes([C,D0|D]) -->
+    sign(C),
+    !,
+    digit(D0),
+    digits(D).
+int_codes([D0|D]) -->
+    digit(D0),
+    digits(D).
+
+
+%!  float(?Float)// is det.
+%
+%   Process a floating  point  number.   The  actual  conversion  is
+%   controlled by number_codes/2.
+
+float(F, Head, Tail) :-
+    float(F),
+    !,
+    with_output_to(codes(Head, Tail), write(F)).
+float(F) -->
+    number(F),
+    { float(F) }.
+
+%!  number(+Number)// is det.
+%!  number(-Number)// is semidet.
+%
+%   Generate extract a number. Handles   both  integers and floating
+%   point numbers.
+
+number(N, Head, Tail) :-
+    number(N),
+    !,
+    format(codes(Head, Tail), '~w', N).
+number(N) -->
+    { var(N)
+    },
+    !,
+    int_codes(I),
+    (   dot,
+        digit(DF0),
+        digits(DF)
+    ->  {F = [0'., DF0|DF]}
+    ;   {F = []}
+    ),
+    (   exp
+    ->  int_codes(DI),
+        {E=[0'e|DI]}
+    ;   {E = []}
+    ),
+    { append([I, F, E], Codes),
+      number_codes(N, Codes)
+    }.
+number(N) -->
+    { type_error(number, N) }.
+
+sign(0'-) --> "-".
+sign(0'+) --> "+".
+
+dot --> ".".
+
+exp --> "e".
+exp --> "E".
+
+                 /*******************************
+                 *          HEX NUMBERS         *
+                 *******************************/
+
+%!  xinteger(+Integer)// is det.
+%!  xinteger(-Integer)// is semidet.
+%
+%   Generate or extract an integer from   a  sequence of hexadecimal
+%   digits. Hexadecimal characters include both  uppercase (A-F) and
+%   lowercase (a-f) letters. The value may   be  preceded by  a sign
+%   (+/-)
+
+xinteger(Val, Head, Tail) :-
+    integer(Val),
+    !,
+    format(codes(Head, Tail), '~16r', [Val]).
+xinteger(Val) -->
+    sign(C),
+    !,
+    xdigit(D0),
+    xdigits(D),
+    { mkval([D0|D], 16, Val0),
+      (   C == 0'-
+      ->  Val is -Val0
+      ;   Val = Val0
+      )
+    }.
+xinteger(Val) -->
+    xdigit(D0),
+    xdigits(D),
+    { mkval([D0|D], 16, Val)
+    }.
+
+%!  xdigit(-Weight)// is semidet.
+%
+%   True if the next code is a  hexdecimal digit with Weight. Weight
+%   is  between  0  and  15.  Hexadecimal  characters  include  both
+%   uppercase (A-F) and lowercase (a-f) letters.
+
+xdigit(D) -->
+    [C],
+    { code_type(C, xdigit(D))
+    }.
+
+%!  xdigits(-WeightList)// is det.
+%
+%   List of weights of a sequence   of hexadecimal codes. WeightList
+%   may be empty. Hexadecimal  characters   include  both  uppercase
+%   (A-F) and lowercase (a-f) letters.
+
+xdigits([D0|D]) -->
+    xdigit(D0),
+    !,
+    xdigits(D).
+xdigits([]) -->
+    [].
+
+mkval([W0|Weights], Base, Val) :-
+    mkval(Weights, Base, W0, Val).
+
+mkval([], _, W, W).
+mkval([H|T], Base, W0, W) :-
+    W1 is W0*Base+H,
+    mkval(T, Base, W1, W).
+
+
+                 /*******************************
+                 *         END-OF-STRING        *
+                 *******************************/
+
+%!  eol//
+%
+%   Matches end-of-line. Matching \r\n, \n or end of input (eos//0).
+
+eol --> "\n", !.
+eol --> "\r\n", !.
+eol --> eos.
+
+%!  eos//
+%
+%   Matches  end-of-input.  The  implementation    behaves   as  the
+%   following portable implementation:
+%
+%     ==
+%     eos --> call(eos_).
+%     eos_([], []).
+%     ==
+%
+%   @tbd    This is a difficult concept and violates the _context free_
+%           property of DCGs.  Explain the exact problems.
+
+eos([], []).
+
+%!  remainder(-List)//
+%
+%   Unify List with the remainder of the input.
+
+remainder(List, List, []).
+
+
+                 /*******************************
+                 *         PROLOG SYNTAX                *
+                 *******************************/
+
+%!  prolog_var_name(-Name:atom)// is semidet.
+%
+%   Matches a Prolog variable name. Primarily  intended to deal with
+%   quasi quotations that embed Prolog variables.
+
+prolog_var_name(Name) -->
+    [C0], { code_type(C0, prolog_var_start) },
+    !,
+    prolog_id_cont(CL),
+    { atom_codes(Name, [C0|CL]) }.
+
+prolog_id_cont([H|T]) -->
+    [H], { code_type(H, prolog_identifier_continue) },
+    !,
+    prolog_id_cont(T).
+prolog_id_cont([]) --> "".
+
+
+                 /*******************************
+                 *          IDENTIFIERS         *
+                 *******************************/
+
+%!  csym(?Symbol:atom)// is semidet.
+%
+%   Recognise a C symbol according to   the  `csymf` and `csym` code
+%   type classification provided by the C library.
+
+csym(Name, Head, Tail) :-
+    nonvar(Name),
+    format(codes(Head, Tail), '~w', [Name]).
+csym(Name) -->
+    [F], {code_type(F, csymf)},
+    csyms(Rest),
+    { atom_codes(Name, [F|Rest]) }.
+
+csyms([H|T]) -->
+    [H], {code_type(H, csym)},
+    !,
+    csyms(T).
+csyms([]) -->
+    "".
+
+
+                 /*******************************
+                 *           GENERATION         *
+                 *******************************/
+
+%!  atom(++Atom)// is det.
+%
+%   Generate codes of Atom.  Current implementation uses write/1,
+%   dealing with any Prolog term.  Atom must be ground though.
+
+atom(Atom, Head, Tail) :-
+    must_be(ground, Atom),
+    format(codes(Head, Tail), '~w', [Atom]).