View source with raw comments or as raw
    1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (c)  2013-2015, VU University Amsterdam
    7    All rights reserved.
    8
    9    Redistribution and use in source and binary forms, with or without
   10    modification, are permitted provided that the following conditions
   11    are met:
   12
   13    1. Redistributions of source code must retain the above copyright
   14       notice, this list of conditions and the following disclaimer.
   15
   16    2. Redistributions in binary form must reproduce the above copyright
   17       notice, this list of conditions and the following disclaimer in
   18       the documentation and/or other materials provided with the
   19       distribution.
   20
   21    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   22    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   23    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   24    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   25    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   26    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   27    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   28    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   29    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   30    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   31    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   32    POSSIBILITY OF SUCH DAMAGE.
   33*/
   34
   35:- module(quasi_quotations,
   36          [ with_quasi_quotation_input/3,       % +Content, -Stream, :Goal
   37            phrase_from_quasi_quotation/2,      % :Grammar, +Content
   38            quasi_quotation_syntax_error/1,     % +Error
   39            quasi_quotation_syntax/1            % :Syntax
   40          ]).   41:- autoload(library(error),[must_be/2]).   42:- autoload(library(pure_input),[stream_to_lazy_list/2]).

Define Quasi Quotation syntax

Inspired by Haskell, SWI-Prolog support quasi quotation. Quasi quotation allows for embedding (long) strings using the syntax of an external language (e.g., HTML, SQL) in Prolog text and syntax-aware embedding of Prolog variables in this syntax. At the same time, quasi quotation provides an alternative to represent long strings and atoms in Prolog.

The basic form of a quasi quotation is defined below. Here, Syntax is an arbitrary Prolog term that must parse into a callable (atom or compound) term and Quotation is an arbitrary sequence of characters, not including the sequence |}. If this sequence needs to be embedded, it must be escaped according to the rules of the target language or the `quoter' must provide an escaping mechanism.

{|Syntax||Quotation|}

While reading a Prolog term, and if the Prolog flag quasi_quotes is set to true (which is the case if this library is loaded), the parser collects quasi quotations. After reading the final full stop, the parser makes the call below. Here, SyntaxName is the functor name of Syntax above and SyntaxArgs is a list holding the arguments, i.e., Syntax =.. [SyntaxName|SyntaxArgs]. Splitting the syntax into its name and arguments is done to make the quasi quotation parser a predicate with a consistent arity 4, regardless of the number of additional arguments.

call(+SyntaxName, +Content, +SyntaxArgs, +VariableNames, -Result)

The arguments are defined as

The file library(http/html_quasiquotations) provides the, suprisingly simple, quasi quotation parser for HTML.

author
- Jan Wielemaker. Introduction of Quasi Quotation was suggested by Michael Hendricks.
See also
- Why it's nice to be quoted: quasiquoting for haskell */
  124:- meta_predicate
  125    with_quasi_quotation_input(+, -, 0),
  126    quasi_quotation_syntax(4),
  127    phrase_from_quasi_quotation(//, +).  128
  129:- set_prolog_flag(quasi_quotations, true).
 with_quasi_quotation_input(+Content, -Stream, :Goal) is det
Process the quasi-quoted Content using Stream parsed by Goal. Stream is a temporary stream with the following properties:
Arguments:
Goal- is executed as once(Goal). Goal must succeed. Failure or exceptions from Goal are interpreted as syntax errors.
See also
- phrase_from_quasi_quotation/2 can be used to process a quotation using a grammar.
  148with_quasi_quotation_input(Content, Stream, Goal) :-
  149    functor(Content, '$quasi_quotation', 3),
  150    !,
  151    setup_call_cleanup(
  152        '$qq_open'(Content, Stream),
  153        (   call(Goal)
  154        ->  true
  155        ;   quasi_quotation_syntax_error(
  156                quasi_quotation_parser_failed,
  157                Stream)
  158        ),
  159        close(Stream)).
 phrase_from_quasi_quotation(:Grammar, +Content) is det
Process the quasi quotation using the DCG Grammar. Failure of the grammar is interpreted as a syntax error.
See also
- with_quasi_quotation_input/3 for processing quotations from stream.
  169phrase_from_quasi_quotation(Grammar, Content) :-
  170    functor(Content, '$quasi_quotation', 3),
  171    !,
  172    setup_call_cleanup(
  173        '$qq_open'(Content, Stream),
  174        phrase_quasi_quotation(Grammar, Stream),
  175        close(Stream)).
  176
  177phrase_quasi_quotation(Grammar, Stream) :-
  178    set_stream(Stream, buffer_size(512)),
  179    stream_to_lazy_list(Stream, List),
  180    phrase(Grammar, List),
  181    !.
  182phrase_quasi_quotation(_, Stream) :-
  183    quasi_quotation_syntax_error(
  184        quasi_quotation_parser_failed,
  185        Stream).
 quasi_quotation_syntax(:SyntaxName) is det
Declare the predicate SyntaxName/4 to implement the the quasi quote syntax SyntaxName. Normally used as a directive.
  192quasi_quotation_syntax(M:Syntax) :-
  193    must_be(atom, Syntax),
  194    '$set_predicate_attribute'(M:Syntax/4, quasi_quotation_syntax, true).
 quasi_quotation_syntax_error(+Error)
Report syntax_error(Error) using the current location in the quasi quoted input parser.
throws
- error(syntax_error(Error), Position)
  203quasi_quotation_syntax_error(Error) :-
  204    quasi_quotation_input(Stream),
  205    quasi_quotation_syntax_error(Error, Stream).
  206
  207quasi_quotation_syntax_error(Error, Stream) :-
  208    stream_syntax_error_context(Stream, Context),
  209    throw(error(syntax_error(Error), Context)).
  210
  211quasi_quotation_input(Stream) :-
  212    '$input_context'(Stack),
  213    memberchk(input(quasi_quoted, _File, _Line, StreamVar), Stack),
  214    Stream = StreamVar.
 stream_syntax_error_context(+Stream, -Position) is det
Provide syntax error location for the current position of Stream.
  222stream_syntax_error_context(Stream, file(File, LineNo, LinePos, CharNo)) :-
  223    stream_property(Stream, file_name(File)),
  224    position_context(Stream, LineNo, LinePos, CharNo),
  225    !.
  226stream_syntax_error_context(Stream, stream(Stream, LineNo, LinePos, CharNo)) :-
  227    position_context(Stream, LineNo, LinePos, CharNo),
  228    !.
  229stream_syntax_error_context(_, _).
  230
  231position_context(Stream, LineNo, LinePos, CharNo) :-
  232    stream_property(Stream, position(Pos)),
  233    !,
  234    stream_position_data(line_count,    Pos, LineNo),
  235    stream_position_data(line_position, Pos, LinePos),
  236    stream_position_data(char_count,    Pos, CharNo).
  237
  238
  239                 /*******************************
  240                 *         SYSTEM HOOK          *
  241                 *******************************/
  242
  243%       system:'$parse_quasi_quotations'(+Quotations:list, +Module) is
  244%       det.
  245%
  246%       @arg    Quotations is a list of terms
  247%
  248%                   quasi_quotation(Syntax, Quotation, VarNames, Result)
  249
  250:- public
  251    system:'$parse_quasi_quotations'/2.  252
  253system:'$parse_quasi_quotations'([], _).
  254system:'$parse_quasi_quotations'([H|T], M) :-
  255    qq_call(H, M),
  256    system:'$parse_quasi_quotations'(T, M).
  257
  258qq_call(quasi_quotation(Syntax, Content, VariableNames, Result), M) :-
  259    current_prolog_flag(sandboxed_load, false),
  260    Syntax =.. [SyntaxName|SyntaxArgs],
  261    setup_call_cleanup(
  262        '$push_input_context'(quasi_quoted),
  263        call(M:SyntaxName, Content, SyntaxArgs, VariableNames, Result),
  264        '$pop_input_context'),
  265    !.
  266qq_call(quasi_quotation(Syntax, Content, VariableNames, Result), M) :-
  267    current_prolog_flag(sandboxed_load, true),
  268    Syntax =.. [SyntaxName|SyntaxArgs],
  269    Expand =.. [SyntaxName, Content, SyntaxArgs, VariableNames, Result],
  270    QExpand = M:Expand,
  271    '$expand':allowed_expansion(QExpand),
  272    setup_call_cleanup(
  273        '$push_input_context'(quasi_quoted),
  274        call(QExpand),
  275        '$pop_input_context'),
  276    !.
  277qq_call(quasi_quotation(_Syntax, Content, _VariableNames, _Result), _M) :-
  278    setup_call_cleanup(
  279        '$push_input_context'(quasi_quoted),
  280        with_quasi_quotation_input(
  281            Content, Stream,
  282            quasi_quotation_syntax_error(quasi_quote_parser_failed, Stream)),
  283        '$pop_input_context'),
  284    !.
  285
  286
  287                 /*******************************
  288                 *             MESSAGES         *
  289                 *******************************/
  290
  291:- multifile
  292    prolog:error_message//1.  293
  294prolog:error_message(syntax_error(unknown_quasi_quotation_syntax(Syntax, M))) -->
  295    { functor(Syntax, Name, _) },
  296    [ 'Quasi quotation syntax ~q:~q is not defined'-[M, Name] ].
  297prolog:error_message(syntax_error(invalid_quasi_quotation_syntax(Syntax))) -->
  298    [ 'Quasi quotation syntax must be a callable term.  Found ~q'-[Syntax] ]