1/*  Part of sCASP
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        jan@swi-prolog.org
    5    Copyright (c)  2021, SWI-Prolog Solutions b.v.
    6    All rights reserved.
    7
    8    Redistribution and use in source and binary forms, with or without
    9    modification, are permitted provided that the following conditions
   10    are met:
   11
   12    1. Redistributions of source code must retain the above copyright
   13       notice, this list of conditions and the following disclaimer.
   14
   15    2. Redistributions in binary form must reproduce the above copyright
   16       notice, this list of conditions and the following disclaimer in
   17       the documentation and/or other materials provided with the
   18       distribution.
   19
   20    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   21    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   22    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   23    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   24    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   25    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   26    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   27    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   28    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   29    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   30    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   31    POSSIBILITY OF SUCH DAMAGE.
   32*/
   33
   34:- module(scasp_input,
   35          [ load_source_files/1,        % +Files
   36            sasp_read/2,                % +File, -Statements
   37            scasp_load_terms/2          % +Terms,+Options
   38          ]).   39:- use_module(library(apply)).   40:- use_module(library(lists)).   41:- use_module(library(option)).   42:- use_module(library(prolog_code)).   43
   44:- use_module(common).   45:- use_module(program).   46:- use_module(source_ref).   47
   48/** <module> Read SASP source code
   49
   50This module defines reading sCASP input based on the Prolog parser.
   51*/
   52
   53% operator that may be used in sCASP   source. They are used through the
   54% `module` option of read_term/3.
   55% TBD: Do we need both sets of comparison operators?
   56
   57:- op(700, xfx, [#= , #<>, #< , #> , #=<, #>= ]).   58:- op(900, fy,  not).   59:- op(1200, fx,  #).   60:- op(950, xfx, ::).   61:- op(350, fx,  [include, compute, abducible]).   62:- op(1150, fx, [table, show, pred]).   63
   64		 /*******************************
   65		 *            COMPAT		*
   66		 *******************************/
   67
   68%!  load_source_files(+Files:list) is det
   69%
   70%   Given a list of source files, read, tokenize and parse them, merging
   71%   their  output  into  a  single  list    of  statements.  Next,  call
   72%   program:assert_program/1 to process the statements.
   73%
   74%   @arg Files The list of files to load.
   75
   76load_source_files(Fs) :-
   77    maplist(sasp_read, Fs, StmtsList),
   78    append(StmtsList, Statements),
   79    assert_program(Statements).
   80
   81%!  scasp_load_terms(+Terms, +Options)
   82%
   83%   Perform the load_source_files/1 preparation  step   from  a  list of
   84%   Prolog terms.
   85
   86scasp_load_terms(Terms, Options) :-
   87    term_statements(Terms, Statements, Options),
   88    assert_program(Statements).
   89
   90term_statements([], [], _).
   91term_statements([H|T], Statements, Options) :-
   92    sasp_statement(H, [], New, _Pos, Options),
   93    add_statements(New, Tail, Statements),
   94    term_statements(T, Tail, Options).
   95
   96
   97		 /*******************************
   98		 *            READER		*
   99		 *******************************/
  100
  101
  102%!  sasp_read(+File, -Statements) is det.
  103%
  104%   Read File into a list of ASP  statements. To facilitate using a file
  105%   both as dynamic and stand-alone  file, statements (:- use_module(_))
  106%   are ignored.
  107
  108sasp_read(File, Statements) :-
  109    sasp_read(File, Statements, []).
  110
  111sasp_read(File, Statements, Options) :-
  112    absolute_file_name(File, Path,
  113                       [ access(read),
  114                         extensions([asp,pl,''])
  115                       ]),
  116    setup_call_cleanup(
  117        open(Path, read, In),
  118        sasp_read_stream_raw(Path, In, Statements,
  119                             [ base(Path),
  120                               stream(In)
  121                             | Options
  122                             ]),
  123        close(In)).
  124
  125sasp_read_stream_raw(Path, In, Statements, Options) :-
  126    setup_call_cleanup(
  127        prep_read(Undo),
  128        sasp_read_stream(Path, In, Statements, Options),
  129        call(Undo)).
  130
  131%!  prep_read(-Undo)
  132%
  133%   Setup the Prolog syntax for reading   sCASP. This currently sets the
  134%   `allow_variable_name_as_functor` flag, such that  e.g. _female(jane)
  135%   is valid syntax.
  136
  137prep_read(Undo) :-
  138    convlist(update_flag,
  139             [ allow_variable_name_as_functor-true
  140             ], UndoList),
  141    (   UndoList == []
  142    ->  Undo = true
  143    ;   comma_list(Undo, UndoList)
  144    ).
  145
  146update_flag(Flag-Value, true) :-
  147    current_prolog_flag(Flag, Value).
  148update_flag(Flag-Value, set_prolog_flag(Flag, Old)) :-
  149    current_prolog_flag(Flag, Old),
  150    set_prolog_flag(Flag, Value).
  151
  152%!  sasp_read_stream(+In, -Statements, +Options) is det.
  153%
  154%   Read the content of the stream In into a list of sCASP statements.
  155
  156sasp_read_stream(Path, In, Statements, Options) :-
  157    context_module(M),
  158    read_term(In, Term,
  159              [ module(M),
  160                variable_names(VarNames),
  161                subterm_positions(Pos),
  162                term_position(Start)
  163              ]),
  164    b_setval('$term_position', Start),
  165    (   Term == end_of_file
  166    ->  Statements = []
  167    ;   Term = (:- use_module(library(File))),
  168        nonvar(File)
  169    ->  sasp_read_stream(Path, In, Statements, Options)
  170    ;   sasp_statement(source(Path-Start, Term), VarNames, New, Pos, Options),
  171        add_statements(New, Tail, Statements),
  172        sasp_read_stream(Path, In, Tail, Options)
  173    ).
  174
  175add_statements(source(_, New), Tail, Statements) :-
  176    is_list(New),
  177    !,
  178    append(New, Tail, Statements).
  179add_statements(New, Tail, [New|Tail]).
  180
  181%!  sasp_statement(+Term, +VarNames, -SASP, +Pos, +Options) is det.
  182%
  183%   Convert a raw Prolog term into  its sCASP equivalent. Currently does
  184%   these transformations:
  185%
  186%     - Clauses get the shape Head-ListOfBodyAtoms
  187%     - -Name(Args) is translated into c_Name(Args)
  188%     - Atoms that need a prefix are prefixed using `d_`
  189%
  190%   This also processes directives, terms of the shape #Directive.
  191%
  192%   @arg VarNames is  a  list  Name=Var   as  produced  by  read_term/3.
  193%   Remaining variables are bound to ``_V<N>``.
  194
  195:- det(sasp_statement/5).  196
  197sasp_statement(source(Ref, Term), VarNames, SSASP, Pos, Options),
  198    blob(Ref, clause) =>
  199    SSASP = source(Ref, SASP),
  200    sasp_statement_(Term, VarNames, SASP, Pos, [source(Ref)|Options]).
  201sasp_statement(source(Path-Start, Term), VarNames, SSASP, Pos, Options) =>
  202    SSASP = source(Ref, SASP),
  203    assert_scasp_source_reference(Path, Start, Ref),
  204    sasp_statement_(Term, VarNames, SASP, Pos, [source(Ref)|Options]).
  205sasp_statement(Term, VarNames, SSASP, Pos, Options) =>
  206    SSASP = source(Ref, SASP),
  207    assert_scasp_source_reference(-, 0, Ref),
  208    sasp_statement_(Term, VarNames, SASP, Pos, [source(Ref)|Options]).
  209
  210sasp_statement_(Term, VarNames, SASP, Pos, Options) :-
  211    maplist(bind_var,VarNames),
  212    term_variables(Term, Vars),
  213    bind_anon(Vars, 0),
  214    sasp_statement(Term, SASP, Pos, Options).
  215
  216bind_var(Name=Var) :-
  217    Var = $Name.
  218
  219bind_anon([], _).
  220bind_anon([$Name|T], I) :-
  221    atom_concat('_V', I, Name),
  222    I2 is I+1,
  223    bind_anon(T, I2).
  224
  225%!  sasp_statement(+Term, -SASPTerm, +TermPos, +Options) is det.
  226%
  227%   Translate a single term.
  228
  229sasp_statement(Head :- Body, SASP, Pos, Options) =>
  230    tpos(Pos, HP, BP),
  231    sasp_predicate(Head, SASPHead, HP, Options),
  232    comma_list(Body, BP, BodyList, BodyPos),
  233    maplist(sasp_predicate_m(Options), BodyList, SASPBody, BodyPos),
  234    SASP = (SASPHead-SASPBody).
  235sasp_statement(?-(Query), SASP, Pos, Options) =>
  236    tpos(Pos, QP),
  237    comma_list(Query, QP, BodyList, BodyPos),
  238    maplist(sasp_predicate_m(Options), BodyList, SASPBody, BodyPos),
  239    SASP = c(1, SASPBody).
  240sasp_statement(:-(Constraint), SASP, Pos, Options) =>
  241    tpos(Pos, QP),
  242    comma_list(Constraint, QP, BodyList, BodyPos),
  243    maplist(sasp_predicate_m(Options), BodyList, SASPBody, BodyPos),
  244    SASP = '_false_0'-SASPBody.
  245sasp_statement(#Directive, SASP, Pos, Options) =>
  246    tpos(Pos, DP),
  247    directive(Directive, SASP, DP, Options).
  248sasp_statement(Head,  SASP, Pos, Options), callable(Head) =>
  249    sasp_predicate(Head, SASPHead, Pos, Options),
  250    SASP = (SASPHead-[]).
  251
  252tpos(parentheses_term_position(_,_,Pos), HP, BP) :-
  253    nonvar(Pos),
  254    !,
  255    tpos(Pos, HP, BP).
  256tpos(term_position(_,_,_,_,[HP,BP]), HP, BP).
  257
  258tpos(parentheses_term_position(_,_,Pos), P) :-
  259    nonvar(Pos),
  260    !,
  261    tpos(Pos, P).
  262tpos(term_position(_,_,_,_,[P]), P).
  263
  264
  265%!  sasp_predicate(+Pred, -ASPPred, +Pos, +Options) is det.
  266%!  sasp_predicate_m(+Options, +Pred, -ASPPred, +Pos) is det.
  267%
  268%   Handle an ASP atom. Renames  the   functor  when needed. Knows about
  269%   -Pred (classical negation) and not(Pred).
  270
  271sasp_predicate_m(Options, Term, ASPTerm, Pos) :-
  272    sasp_predicate(Term, ASPTerm, Pos, Options).
  273
  274sasp_predicate(Pred, ASPPred, PPos, Options) :-
  275    nonvar(PPos),
  276    PPos = parentheses_term_position(_,_,Pos),
  277    !,
  278    sasp_predicate(Pred, ASPPred, Pos, Options).
  279sasp_predicate(not(Pred), not(ASPPred),
  280               term_position(_,_,_,_,[Pos]), Options) :-
  281    !,
  282    sasp_predicate(Pred, ASPPred, Pos, Options).
  283sasp_predicate(-(Pred), ASPPred,
  284               term_position(_,_,_,_,[_Pos]), _Options) :-
  285    !,
  286    Pred =.. [Name|Args0],
  287    functor(Pred, Name, Arity),
  288    asp_prefix(Name, Arity, ASPName),
  289    atom_concat(c_, ASPName, ASPNameNeg),
  290    maplist(asp_term, Args0, Args),
  291    ASPPred =.. [ASPNameNeg|Args].
  292sasp_predicate(Pred, error, Pos, Options) :-
  293    illegal_pred(Pred),
  294    !,
  295    sasp_syntax_error(invalid_predicate(Pred), Pos, Options).
  296sasp_predicate(Pred, SASPPred, _, _Options) :-
  297    Pred =.. [Name|Args0],
  298    functor(Pred, Name, Arity),
  299    maplist(asp_term, Args0, Args),
  300    (   atom_concat(-, PName, Name)     % negation in the name
  301    ->  asp_prefix(PName, Arity, ASPName),
  302        atom_concat(c_, ASPName, ASPNameNeg),
  303        SASPPred =.. [ASPNameNeg|Args]
  304    ;   asp_prefix(Name, Arity, ASPName),
  305        SASPPred =.. [ASPName|Args]
  306    ).
  307
  308asp_term(Term, Term).
  309
  310asp_prefix(Name, 2, ASPName) :-
  311    operator(Name, _, _),
  312    !,
  313    ASPName = Name.
  314asp_prefix(Name, Arity, ASPName) :-
  315    builtin(Name/Arity),
  316    !,
  317    ASPName = Name.
  318asp_prefix(Name, Arity, ASPName) :-
  319    handle_prefixes(Name, ASPName0),
  320    join_functor(ASPName, ASPName0, Arity).
  321
  322%!  handle_prefixes(+FunctorIn:atom, -FunctorOut:atom)
  323%
  324%   If the predicate begins with a reserved prefix, add the dummy prefix
  325%   to ensure that it won't be treated  the same as predicates where the
  326%   prefix is added internally. If no prefix, just return the original.
  327
  328handle_prefixes(Fi, Fo) :-
  329    needs_dummy_prefix(Fi),
  330    !,
  331    atom_concat(d_, Fi, Fo).
  332handle_prefixes(F, F).
  333
  334needs_dummy_prefix(F) :-
  335    has_prefix(F, _),
  336    !.
  337needs_dummy_prefix(F) :-
  338    reserved_prefix(F),
  339    !.
  340needs_dummy_prefix(F) :-
  341    sub_atom(F, 0, _, _, '_').
  342
  343%!  builtin(+Pred:pi) is semidet.
  344%
  345%   Predicates that will be executed by Prolog
  346
  347builtin(write/1).
  348builtin(writef/2).
  349builtin(nl/0).
  350
  351illegal_pred($_).
  352illegal_pred(_;_).
  353
  354%!  directive(+Directive, -Statements, +Pos, +Options) is det.
  355%
  356%   Process a directive.
  357
  358directive(include(File), Statements, _, Options) =>
  359    option(base(Base), Options),
  360    absolute_file_name(File, Path,
  361                       [ access(read),
  362                         extensions([asp,pl,'']),
  363                         relative_to(Base)
  364                       ]),
  365    sasp_read(Path, Statements).
  366directive(table(Pred), Statements, _, _) =>
  367    Statements = (:- table(Pred)).
  368directive(show(Pred), Statements, _, _) =>
  369    Statements = (:- show(Pred)).
  370directive(pred(Pred::Template), Statements, Pos, Options) =>
  371    tpos(Pos, Pos1),
  372    tpos(Pos1, PPos, _),
  373    sasp_predicate(Pred, SASPPred, PPos, Options),
  374    Statements = (:- pred(SASPPred::Template)).
  375directive(abducible(Pred), Rules, Pos, Options) =>
  376    sasp_predicate(Pred, ASPPred, Pos, Options),
  377    abducible_rules(ASPPred, Rules, Options).
  378directive(Directive, Statements, Pos, Options) =>
  379    sasp_syntax_error(invalid_directive(Directive), Pos, Options),
  380    Statements = [].
  381
  382abducible_rules(Head,
  383                [ source(Ref, Head                 - [ not AHead, abducible_1(Head) ]),
  384                  source(Ref, AHead                - [ not Head                     ]),
  385                  source(Ref, abducible_1(Head)    - [ not '_abducible_1'(Head)     ]),
  386                  source(Ref, '_abducible_1'(Head) - [ not abducible_1(Head)        ])
  387                ], Options) :-
  388    option(source(Ref), Options, no_path-no_position),
  389    Head =.. [F|Args],
  390    atom_concat('_', F, AF),
  391    AHead =.. [AF|Args].
  392
  393%!  sasp_syntax_error(+Error, +Pos, +Options)
  394%
  395%   @tbd: properly translate the error location
  396
  397sasp_syntax_error(Error, Pos, Options) :-
  398    error_position(Pos, EPos, Options),
  399    print_message(error, sasp_error(Error, EPos)).
  400
  401error_position(Pos, pos(File, Line, Col), Options) :-
  402    option(base(File), Options),
  403    option(stream(In), Options),
  404    prolog_load_context(term_position, Start),
  405    arg(1, Pos, StartChar),
  406    stream_property(In, position(Here)),
  407    setup_call_cleanup(
  408        set_stream_position(In, Start),
  409        ( read_string(In, StartChar, _),
  410          stream_property(In, position(AtError))
  411        ),
  412        set_stream_position(In, Here)),
  413    stream_position_data(line_count, AtError, Line),
  414    stream_position_data(line_position, AtError, Col).
  415
  416
  417%!  comma_list(+BodyTerm, +Pos, -BodyList, -PosList) is det.
  418%
  419%   Translate a conjunction  into  a   list,  also  translating possible
  420%   position information.
  421
  422comma_list(Body, Pos, BodyList, PosList) :-
  423    comma_list(Body, Pos, BodyList, [], PosList, []).
  424
  425comma_list(Term, PPos, TL0, TL, PL0, PL) :-
  426    nonvar(PPos),
  427    PPos = parentheses_term_position(_,_,Pos),
  428    !,
  429    comma_list(Term, Pos, TL0, TL, PL0, PL).
  430comma_list((A,B), term_position(_,_,_,_,[AP, BP]), TL0, TL, PL0, PL) :-
  431    !,
  432    comma_list(A, AP, TL0, TL1, PL0, PL1),
  433    comma_list(B, BP, TL1, TL,  PL1, PL).
  434comma_list(One, Pos, [One|TL], TL, [Pos|PL], PL).
  435
  436		 /*******************************
  437		 *            MESSAGES		*
  438		 *******************************/
  439
  440:- multifile
  441    prolog:message//1.  442
  443prolog:message(sasp_error(Error, EPos)) -->
  444    position(EPos),
  445    error(Error).
  446
  447position(pos(File, Line, Col)) -->
  448    !,
  449    [ '~w:~w:~w: '-[File, Line, Col] ].
  450position(_) -->
  451    [].
  452
  453error(invalid_directive(Directive)) -->
  454    [ 'sCASP: invalid directive ~p'-[Directive] ]