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)  2019-2020, VU University Amsterdam
    7                              CWI, Amsterdam
    8    All rights reserved.
    9
   10    Redistribution and use in source and binary forms, with or without
   11    modification, are permitted provided that the following conditions
   12    are met:
   13
   14    1. Redistributions of source code must retain the above copyright
   15       notice, this list of conditions and the following disclaimer.
   16
   17    2. Redistributions in binary form must reproduce the above copyright
   18       notice, this list of conditions and the following disclaimer in
   19       the documentation and/or other materials provided with the
   20       distribution.
   21
   22    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   23    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   24    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   25    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   26    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   27    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   28    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   29    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   30    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   31    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   32    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   33    POSSIBILITY OF SUCH DAMAGE.
   34*/
   35
   36:- module(xsb_source, []).   37:- use_module(library(debug),  [debug/3]).   38:- autoload(library(apply),  [convlist/3,partition/4]).   39:- autoload(library(error),  [instantiation_error/1]).   40:- autoload(library(occurs), [sub_term/2]).

Support XSB source .P files

This module is a lightweight module that allows loading .P files as XSB source files. This module is intended to be loaded from <config>/init.pl, providing transparent usage of XSB files with neglectable impact impact if no XSB sources are used. */

   50% xsb_max_file_size is used for buffering  the   source  in  memory when
   51% reading a source file through the   gpp preprocessor. Eventually, this
   52% should probably create an intermediate file.
   53
   54:- create_prolog_flag(xsb_max_file_size, 100 000 000,
   55                      [ keep(true)
   56                      ]).   57
   58:- multifile
   59    user:prolog_file_type/2,
   60    user:term_expansion/2.   61
   62user:prolog_file_type('P', prolog).
   63
   64user:term_expansion(begin_of_file, Out) :-
   65    prolog_load_context(file, File),
   66    file_name_extension(Path, 'P', File),
   67    include_options(File, Include),
   68    compiler_options(COptions),
   69    '$append'(Include, COptions, Extra),
   70    xsb_directives(File, Directives),
   71    directive_exports(Directives, Public, Directives1),
   72    (   Public == []
   73    ->  Out = Out1
   74    ;   file_base_name(Path, Module),
   75        Out = [ (:- module(Module, Public))
   76              | Out1
   77              ]
   78    ),
   79    Out1 = [ (:- expects_dialect(xsb)),
   80             (:- use_module(library(tables)))
   81           | Out2
   82           ],
   83    '$append'(Extra, More, Out2),
   84    (   nonvar(Module)
   85    ->  setup_call_cleanup(
   86            '$set_source_module'(OldM, Module),
   87            phrase(head_directives(Directives1, File), More),
   88            '$set_source_module'(OldM))
   89    ;   phrase(head_directives(Directives1, File), More)
   90    ),
   91    debug(xsb(header), '~p: directives: ~p', [File, More]).
   92
   93include_options(File, Option) :-
   94    (   xsb_header_file(File, FileH)
   95    ->  Option = [(:- include(FileH))]
   96    ;   Option = []
   97    ).
   98
   99:- multifile xsb:xsb_compiler_option/1.  100:- dynamic   xsb:xsb_compiler_option/1.  101
  102compiler_options(Directives) :-
  103    findall(D, mapped_xsb_option(D), Directives).
  104
  105mapped_xsb_option((:- D)) :-
  106    xsb:xsb_compiler_option(O),
  107    map_compiler_option(O, D).
  108
  109map_compiler_option(singleton_warnings_off, style_check(-singleton)).
  110map_compiler_option(optimize,               set_prolog_flag(optimise, true)).
  111
  112xsb_header_file(File, FileH) :-
  113    file_name_extension(Base, _, File),
  114    file_name_extension(Base, 'H', FileH),
  115    exists_file(FileH).
 directive_exports(+AllDirectives, -Public, -OtherDirectives)
  119directive_exports(AllDirectives, Exports, RestDirectives) :-
  120    partition(is_export, AllDirectives, ExportDirectives, RestDirectives),
  121    phrase(exports(ExportDirectives), Exports).
  122
  123is_export(export(_)).
  124
  125exports([]) -->
  126    [].
  127exports([export(H)|T]) -->
  128    export_decl(H),
  129    exports(T).
  130
  131export_decl(Var) -->
  132    { var(Var),
  133      !,
  134      instantiation_error(Var)
  135    }.
  136export_decl((A,B)) -->
  137    !,
  138    export_decl(A),
  139    export_decl(B).
  140export_decl(PI) -->
  141    [PI].
 head_directives(+Directives, +File)// is det
 head_directives_s(+Directives, +State)// is det
  146head_directives(Directives, File) -->
  147    { current_prolog_flag(max_table_subgoal_size_action, Action),
  148      (   current_prolog_flag(max_table_subgoal_size, Size)
  149      ->  true
  150      ;   Size = -1
  151      )
  152    },
  153    head_directives_s(Directives,
  154                      #{file: File,
  155                        max_table_subgoal_size_action: Action,
  156                        max_table_subgoal_size:Size
  157                       }).
  158
  159
  160head_directives_s([], _) --> [].
  161head_directives_s([H|T], State0) -->
  162    { update_state(H, State0, State) },
  163    !,
  164    head_directives_s(T, State).
  165head_directives_s([H|T], State) -->
  166    head_directive(H, State),
  167    head_directives_s(T, State).
  168
  169update_state(set_prolog_flag(max_table_subgoal_size_action, Action),
  170             State0, State) :-
  171    State = State0.put(max_table_subgoal_size_action, Action).
  172update_state(set_prolog_flag(max_table_subgoal_size, Size),
  173             State0, State) :-
  174    State = State0.put(max_table_subgoal_size, Size).
 head_directive(+Directive, +State)// is det
  178head_directive(import(from(Preds, From)), State) -->
  179    !,
  180    { assertz(xsb:moved_directive(State.file, import(from(Preds, From))))
  181    },
  182    [ (:- xsb_import(Preds, From)) ].
  183head_directive(table(Preds as XSBOptions), State) -->
  184    !,
  185    { ignored_table_options(XSBOptions, Options),
  186      table_clauses(Preds, Options, Clauses, State),
  187      assertz(xsb:moved_directive(State.file, table(Preds as XSBOptions)))
  188    },
  189    seq(Clauses).
  190head_directive(table(Preds), State) -->
  191    !,
  192    { table_clauses(Preds, true, Clauses, State),
  193      assertz(xsb:moved_directive(State.file, table(Preds)))
  194    },
  195    seq(Clauses).
  196head_directive(_, _) -->
  197    [].
  198
  199seq([]) --> [].
  200seq([H|T]) --> [H], seq(T).
  201
  202ignored_table_options((A0,B0), Conj) :-
  203    !,
  204    ignored_table_options(A0, A),
  205    ignored_table_options(B0, B),
  206    mkconj(A, B, Conj).
  207ignored_table_options(Option, Option) :-
  208    supported_table_option(Option),
  209    !.
  210ignored_table_options(opaque, true) :-
  211    !.
  212ignored_table_options(Option, true) :-
  213    print_message(warning, xsb(table_option_ignored(Option))).
  214
  215supported_table_option(variant).
  216supported_table_option(subsumptive).
  217supported_table_option(incremental).
  218supported_table_option(shared).
  219supported_table_option(private).
  220supported_table_option(max_answers(_)).
  221supported_table_option(subgoal_abstract(_)).
  222supported_table_option(answer_abstract(_)).
  223
  224mkconj(true, X, X) :- !.
  225mkconj(X, true, X) :- !.
  226mkconj(X, Y, (X,Y)) :- !.
  227
  228table_clauses(Preds, Options0, Clauses, State) :-
  229    add_defaults(Options0, Options, State),
  230    (   Options == true
  231    ->  expand_term((:- table(Preds)), Clauses)
  232    ;   expand_term((:- table(Preds as Options)), Clauses)
  233    ).
  234
  235add_defaults(Opts, Opts, _) :-
  236    sub_term(subgoal_abstract(_), Opts),
  237    !.
  238add_defaults(Opts0, Opts, State) :-
  239    #{max_table_subgoal_size_action:abstract,
  240      max_table_subgoal_size:Size} :< State,
  241    Size >= 0,
  242    !,
  243    mkconj(Opts0, subgoal_abstract(Size), Opts).
  244add_defaults(Opts, Opts, _).
 xsb_directives(+File, -Directives) is semidet
Directives is a list of all directives in File and its header.
bug
- : track :- op/3 declarations to update the syntax.
  252xsb_directives(File, Directives) :-
  253    setup_call_cleanup(
  254        '$push_input_context'(xsb_directives),
  255        xsb_directives_aux(File, Directives),
  256        '$pop_input_context').
  257
  258xsb_directives_aux(File, Directives) :-
  259    xsb_header_file(File, FileH),
  260    !,
  261    setup_call_cleanup(
  262        open(FileH, read, In),
  263        findall(D, stream_directive(In, D), Directives, PDirectives),
  264        close(In)),
  265    xsb_P_directives(PDirectives).
  266xsb_directives_aux(_File, Directives) :-
  267    xsb_P_directives(Directives).
  268
  269xsb_P_directives(Directives) :-
  270    prolog_load_context(stream, In),
  271    stream_property(In, reposition(true)),
  272    !,
  273    setup_call_cleanup(
  274        stream_property(In, position(Pos)),
  275        findall(PI, stream_directive(In, PI), Directives),
  276        set_stream_position(In, Pos)).
  277xsb_P_directives(Directives) :-
  278    prolog_load_context(stream, In),
  279    current_prolog_flag(xsb_max_file_size, MaxSize),
  280    peek_string(In, MaxSize, String),
  281    setup_call_cleanup(
  282        open_string(String, In2),
  283        findall(PI, stream_directive(In2, PI), Directives),
  284        close(In2)).
  285
  286stream_directive(In, Directive) :-
  287    repeat,
  288        read_term(In, Term,
  289                  [ syntax_errors(quiet),
  290                    module(xsb_source)
  291                  ]),
  292        (   Term == end_of_file
  293        ->  !, fail
  294        ;   Term = (:- Directive),
  295            nonvar(Directive)
  296        ;   fail
  297        ).
  298
  299% define the typical XSB operators to limit syntax errors while
  300% scanning for :- export(_).
  301:- op(1050,  fy, import).  302:- op(1100,  fx, export).  303:- op(1100,  fx, mode).  304:- op(1040, xfx, from).  305:- op(1100,  fy, index).  306:- op(1100,  fy, ti).  307:- op(1045, xfx, as).  308:- op(900,   fy, tnot).