View source with formatted comments or as raw
    1/*
    2* Copyright (c) 2016, University of Texas at Dallas
    3* All rights reserved.
    4*
    5* Redistribution and use in source and binary forms, with or without
    6* modification, are permitted provided that the following conditions are met:
    7*     * Redistributions of source code must retain the above copyright
    8*       notice, this list of conditions and the following disclaimer.
    9*     * Redistributions in binary form must reproduce the above copyright
   10*       notice, this list of conditions and the following disclaimer in the
   11*       documentation and/or other materials provided with the distribution.
   12*     * Neither the name of the University of Texas at Dallas nor the
   13*       names of its contributors may be used to endorse or promote products
   14*       derived from this software without specific prior written permission.
   15*
   16* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
   17* AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
   18* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
   19* DISCLAIMED. IN NO EVENT SHALL THE UNIVERSITY OF TEXAS AT DALLAS BE LIABLE FOR
   20* ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
   21* (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   22* LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
   23* ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
   24* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
   25* SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
   26*/
   27
   28:- module(scasp_common,
   29          [ predicate/3,
   30            c_rule/3,
   31            rule/4,
   32            negate_functor/2,
   33            is_dual/1,
   34            is_global_constraint/2,     % +Name, -Nth
   35            split_functor/3,            % +Functor, -Name, -Arity
   36            join_functor/3,             % -Functor, +Name, +Arity
   37            create_unique_functor/3,
   38            operator/3,
   39            raise_negation/2,           % +Goal,-UserGoal
   40            intern_negation/2           % +QIn,-QOut
   41          ]).   42
   43/** <module> Common predicates used in multiple files
   44
   45Common and utility predicates that may be called from multiple locations.
   46
   47@author Kyle Marple
   48@version 20170127
   49@license BSD-3
   50*/
   51
   52:- use_module(program, [has_prefix/2]).   53
   54%!  predicate(?PredicateStruct:compound, ?Name:atom, ?Args:list) is det
   55%
   56%   Convert a predicate struct to its  components, or vice-versa. Ensure
   57%   this doesn't succeed for operators or not(_).
   58%
   59%   @arg  PredicateStruct Predicate sturct.
   60%   @arg  Name Predicate name, in name/arity format.
   61%   @arg  Args List of predicate args.
   62
   63predicate(Predicate, Name, Args) :-
   64    Predicate =.. [Name | Args],
   65    \+ operator(Name, _, _),
   66    Name \= not,
   67    !.
   68
   69%!  c_rule(?Rule:compound, ?Head:compound, ?Body:list) is det
   70%
   71%   Convert a rule structure into its head and body, or vice-versa. Note
   72%   that if an ID has been attached, it  will be paired with the head as
   73%   `Head = -(RealHead, ID)`. This can be taken advantage of if the head
   74%   and ID are simply being copied, but should be used with care.
   75%
   76%   @arg  Rule Rule struct.
   77%   @arg  Head Rule head.
   78%   @arg  Body Rule body.
   79
   80c_rule(-(H, B), H, B).
   81
   82%!  rule(?Rule:compound, ?Head:compound, ?ID:int, ?Body:list) is det
   83%
   84%   Convert a rule structure with an id into   its head, ID and body, or
   85%   vice-versa.
   86%
   87%   @arg  Rule Rule struct.
   88%   @arg  Head Rule head.
   89%   @arg  ID Rule ID.
   90%   @arg  Body Rule body.
   91
   92rule(-(-(H, I), B), H, I, B).
   93
   94%!  negate_functor(+Functor:atom, -NegFunctor:atom) is det
   95%
   96%   Given the functor of a predicate   (of  the form name/arity), return
   97%   the negation.
   98%
   99%   @arg  Functor The functor of a predicate.
  100%   @arg  NegFunctor The negated functor.
  101
  102negate_functor(F, N) :-
  103    atom_concat(n_, N0, F),
  104    !,
  105    N = N0.
  106negate_functor(F, N) :-
  107    atom_concat(n_, F, N).
  108
  109%!  is_dual(+Functor:atom) is semidet.
  110%
  111%   Succeed if a functor contains the   prefix  '_not_', indicating that
  112%   it's a dual.
  113%
  114%   @arg Functor The functor to test.
  115
  116is_dual(X) :-
  117    has_prefix(X, n).
  118
  119%!  is_global_constraint(+Term:callable, -Nth:integer) is semidet.
  120%
  121%   True when this is a predicate implementing the Nth global constraint
  122
  123is_global_constraint(Term, Nth) :-
  124    functor(Term, Name, _),
  125    atom_concat(o_, Func, Name),
  126    split_functor(Func, Pr, Nth),
  127    Nth \== -1,
  128    Pr == chk.
  129
  130%!  split_functor(+Functor:atom, -Name:atom, -Arity:int) is det.
  131%
  132%   Given a predicate functor, return the components. Since the arity is
  133%   at the end, we have to be creative to remove it.
  134%
  135%   @arg Functor The predicate functor, of the form Name_Arity.
  136%   @arg Name The name with the arity stripped. A list of characters.
  137%   @arg Arity The arity of the predicate, or -1 if no arity is
  138%        attached.
  139
  140split_functor(P, Name, Arity) :-
  141    sub_atom(P, Plen, _, Slen, '_'),
  142    sub_string(P, _, Slen, 0, NS),
  143    \+ sub_string(NS, _, _, _, "_"),
  144    number_string(Arity, NS),
  145    !,
  146    sub_atom(P, 0, Plen, _, Name).
  147split_functor(P, P, -1). % no arity attached
  148
  149%!  join_functor(-Functor, +Name, +Arity) is det.
  150
  151join_functor(Functor, Name, Arity) :-
  152    atomic_list_concat([Name, '_', Arity], Functor).
  153
  154
  155%!  create_unique_functor(+Head:ground, +Counter:int, -NewHead:ground) is det
  156%
  157%   Create a unique functor by  inserting   the  counter characters just
  158%   before the ``_Arity``.
  159%
  160%   @arg  Head A functor of the form head/arity to form the base of the unique
  161%        functor.
  162%   @arg  Counter Counter to ensure that the functor is unique. Don't reuse it
  163%        with the same base.
  164%   @arg  DualHead The functor for the dual of an individual clause.
  165
  166create_unique_functor(Hi, C, Ho) :-
  167    split_functor(Hi, F, A), % Strip the arity
  168    atomic_list_concat([F, '_', C, '_', A], Ho).
  169
  170%!  raise_negation(+Goal, -UserGoal) is det.
  171
  172raise_negation(WrappedTerm, UserTerm),
  173    nonvar(WrappedTerm), scasp_wrapper(WrappedTerm) =>
  174    WrappedTerm =.. [F,ArgIn],
  175    raise_negation(ArgIn, Arg),
  176    UserTerm =.. [F,Arg].
  177raise_negation(TermIn, UserTerm),
  178    functor(TermIn, Name, _),
  179    negation_name(Name, Plain)
  180    =>
  181    TermIn =.. [Name|Args],
  182    Term   =.. [Plain|Args],
  183    UserTerm = -Term.
  184raise_negation(Term, UserTerm) =>
  185    UserTerm = Term.
  186
  187negation_name(Name, Plain) :-
  188    atom_concat(-, Plain, Name),
  189    !.
  190negation_name(Name, Plain) :-
  191    atom_concat('o_-', Base, Name),
  192    atom_concat('o_', Base, Plain).
  193
  194scasp_wrapper(not(_)).
  195scasp_wrapper(proved(_)).
  196scasp_wrapper(chs(_)).
  197scasp_wrapper(assume(_)).
  198
  199
  200%!  intern_negation(+QIn, -QOut) is det.
  201
  202intern_negation(not(Q0), Q) =>
  203    intern_negation(Q0, Q1),
  204    Q = not(Q1).
  205intern_negation(-Q0, Q) =>
  206    Q0 =.. [Name|Args],
  207    atom_concat(-, Name, NName),
  208    Name \== '',
  209    Q =.. [NName|Args].
  210intern_negation(Q0, Q) =>
  211    Q = Q0.
  212
  213%!  operator(+Operator:ground, -Specifier:atom, -Priority:int) is det
  214%
  215%   ASP/Prolog operator table.  Original  table   from  the  ISO  Prolog
  216%   standard, with unsupported operators  removed.   NOTE:  Some  of the
  217%   operators below may not have been implemented yet.
  218%
  219%   @arg Operator An arithmetic operator.
  220%   @arg Specifier Defines associativity of operator.
  221%   @arg Priority Defines operator priority.
  222
  223operator(',', xfy, 1000).
  224operator(=, xfx, 700).
  225operator(\=, xfx, 700).
  226operator(@<, xfx, 700).
  227operator(@>, xfx, 700).
  228operator(@>=, xfx, 700).
  229operator(@=<, xfx, 700).
  230%operator(=.., xfx, 700).
  231operator(is, xfx, 700).
  232operator(=:=, xfx, 700).
  233operator(=\=, xfx, 700).
  234operator(<, xfx, 700).
  235operator(=<, xfx, 700).
  236operator(>, xfx, 700).
  237operator(>=, xfx, 700).
  238operator(+, yfx, 500).
  239operator(-, yfx, 500).
  240operator(*, yfx, 400).
  241operator(/, yfx, 400).
  242operator(//, yfx, 400).
  243operator(rem, yfx, 400).
  244operator(mod, yfx, 400).
  245operator(<<, yfx, 400).
  246operator(>>, yfx, 400).
  247operator('**', xfx, 200).
  248operator(^, xfy, 200).
  249% constraint operator
  250operator(#=, xfx, 700).
  251operator(#<>, xfx, 700).
  252operator(#<, xfx, 700).
  253operator(#>, xfx, 700).
  254operator(#>=, xfx, 700).
  255operator(#=<, xfx, 700).
  256% operator for human output
  257operator(::, xfx, 950)