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)  2011-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(arithmetic,
   36          [ arithmetic_function/1,              % +Name/Arity
   37            arithmetic_expression_value/2       % :Expression, -Value
   38          ]).   39:- use_module(library(error)).   40:- use_module(library(lists)).   41:- set_prolog_flag(generate_debug_info, false).

   53:- meta_predicate
   54    arithmetic_function(:),
   55    arithmetic_expression_value(:, -).   56:- multifile
   57    evaluable/2.                            % Term, Module

 arithmetic_function(:NameArity) is det

Declare a predicate as an arithmetic function.

deprecated

- This function provides a partial work around for pure Prolog user-defined arithmetic functions that has been dropped in SWI-Prolog 5.11.23. Notably, it only deals with expression know at compile time.

   68arithmetic_function(Term) :-
   69    throw(error(context_error(nodirective, arithmetic_function(Term)), _)).
   70
   71arith_decl_clauses(NameArity,
   72                   [(:- public(PI)),
   73                    arithmetic:evaluable(Term, Q)
   74                   ]) :-
   75    prolog_load_context(module, M),
   76    strip_module(M:NameArity, Q, Spec),
   77    (   Q == M
   78    ->  PI = Name/ImplArity
   79    ;   PI = Q:Name/ImplArity
   80    ),
   81    (   Spec = Name/Arity
   82    ->  functor(Term, Name, Arity),
   83        ImplArity is Arity+1
   84    ;   type_error(predicate_indicator, Term)
   85    ).

 eval_clause(+Term, -Clause) is det

Clause is a clause for evaluating the arithmetic expression Term.

   92eval_clause(Term, (eval(Gen, M, Result) :- Body)) :-
   93    functor(Term, Name, Arity),
   94    functor(Gen, Name, Arity),
   95    Gen =.. [_|Args],
   96    eval_args(Args, PlainArgs, M, Goals, [Result is NewTerm]),
   97    NewTerm =.. [Name|PlainArgs],
   98    list_conj(Goals, Body).
   99
  100eval_args([], [], _, Goals, Goals).
  101eval_args([E0|T0], [A0|T], M, [eval(E0, M, A0)|GT], RT) :-
  102    eval_args(T0, T, M, GT, RT).
  103
  104list_conj([One], One) :- !.
  105list_conj([H|T0], (H,T)) :-
  106    list_conj(T0, T).
  107
  108eval_clause(Clause) :-
  109    current_arithmetic_function(Term),
  110    eval_clause(Term, Clause).
  111
  112term_expansion(eval('$builtin', _, _), Clauses) :-
  113    findall(Clause, eval_clause(Clause), Clauses).

 arithmetic_expression_value(:Expression, -Result) is det

True when Result unifies with the arithmetic result of evaluating Expression.

  121arithmetic_expression_value(M:Expression, Result) :-
  122    eval(Expression, M, Result).
  123
  124eval(Number, _, Result) :-
  125    number(Number),
  126    !,
  127    Result = Number.
  128eval(Term, M, Result) :-
  129    evaluable(Term, M2),
  130    visible(M, M2),
  131    !,
  132    call(M2:Term, Result).
  133eval('$builtin', _, _).
  134
  135
  136visible(M, M) :- !.
  137visible(M, Super) :-
  138    import_module(M, Parent),
  139    visible(Parent, Super).
  140
  141
  142                 /*******************************
  143                 *         COMPILE-TIME         *
  144                 *******************************/
  145
  146math_goal_expansion(A is Expr, Goal) :-
  147    expand_function(Expr, Native, Pre),
  148    tidy((Pre, A is Native), Goal).
  149math_goal_expansion(ExprA =:= ExprB, Goal) :-
  150    expand_function(ExprA, NativeA, PreA),
  151    expand_function(ExprB, NativeB, PreB),
  152    tidy((PreA, PreB, NativeA =:= NativeB), Goal).
  153math_goal_expansion(ExprA =\= ExprB, Goal) :-
  154    expand_function(ExprA, NativeA, PreA),
  155    expand_function(ExprB, NativeB, PreB),
  156    tidy((PreA, PreB, NativeA =\= NativeB), Goal).
  157math_goal_expansion(ExprA > ExprB, Goal) :-
  158    expand_function(ExprA, NativeA, PreA),
  159    expand_function(ExprB, NativeB, PreB),
  160    tidy((PreA, PreB, NativeA > NativeB), Goal).
  161math_goal_expansion(ExprA < ExprB, Goal) :-
  162    expand_function(ExprA, NativeA, PreA),
  163    expand_function(ExprB, NativeB, PreB),
  164    tidy((PreA, PreB, NativeA < NativeB), Goal).
  165math_goal_expansion(ExprA >= ExprB, Goal) :-
  166    expand_function(ExprA, NativeA, PreA),
  167    expand_function(ExprB, NativeB, PreB),
  168    tidy((PreA, PreB, NativeA >= NativeB), Goal).
  169math_goal_expansion(ExprA =< ExprB, Goal) :-
  170    expand_function(ExprA, NativeA, PreA),
  171    expand_function(ExprB, NativeB, PreB),
  172    tidy((PreA, PreB, NativeA =< NativeB), Goal).
  173
  174expand_function(Expression, NativeExpression, Goal) :-
  175    do_expand_function(Expression, NativeExpression, Goal0),
  176    tidy(Goal0, Goal).
  177
  178do_expand_function(X, X, true) :-
  179    evaluable(X),
  180    !.
  181do_expand_function(Function, Result, ArgCode) :-
  182    current_arithmetic_function(Function),
  183    !,
  184    Function =.. [Name|Args],
  185    expand_function_arguments(Args, ArgResults, ArgCode),
  186    Result =.. [Name|ArgResults].
  187do_expand_function(Function, Result, (ArgCode, Pred)) :-
  188    prolog_load_context(module, M),
  189    evaluable(Function, M2),
  190    visible(M, M2),
  191    !,
  192    Function =.. [Name|Args],
  193    expand_predicate_arguments(Args, ArgResults, ArgCode),
  194    append(ArgResults, [Result], PredArgs),
  195    Pred =.. [Name|PredArgs].
  196do_expand_function(Function, _, _) :-
  197    type_error(evaluable, Function).
  198
  199
  200expand_function_arguments([], [], true).
  201expand_function_arguments([H0|T0], [H|T], (A,B)) :-
  202    do_expand_function(H0, H, A),
  203    expand_function_arguments(T0, T, B).
  204
  205expand_predicate_arguments([], [], true).
  206expand_predicate_arguments([H0|T0], [H|T], (A,B)) :-
  207    do_expand_function(H0, H1, A0),
  208    (   callable(H1),
  209        current_arithmetic_function(H1)
  210    ->  A = (A0, H is H1)
  211    ;   A = A0,
  212        H = H1
  213    ),
  214    expand_predicate_arguments(T0, T, B).

 evaluable(F) is semidet

True if F and all its subterms are evaluable terms or variables.

  220evaluable(F) :-
  221    var(F),
  222    !.
  223evaluable(F) :-
  224    number(F),
  225    !.
  226evaluable([_Code]) :- !.
  227evaluable(Func) :-                              % Funtional notation.
  228    functor(Func, ., 2),
  229    !.
  230evaluable(F) :-
  231    string(F),
  232    !,
  233    string_length(F, 1).
  234evaluable(F) :-
  235    current_arithmetic_function(F),
  236    (   compound(F)
  237    ->  forall(arg(_,F,A), evaluable(A))
  238    ;   true
  239    ).

 tidy(+GoalIn, -GoalOut)

Cleanup the output from expand_function/3.

  245tidy(A, A) :-
  246    var(A),
  247    !.
  248tidy(((A,B),C), R) :-
  249    !,
  250    tidy((A,B,C), R).
  251tidy((true,A), R) :-
  252    !,
  253    tidy(A, R).
  254tidy((A,true), R) :-
  255    !,
  256    tidy(A, R).
  257tidy((A, X is Y), R) :-
  258    var(X), var(Y),
  259    !,
  260    tidy(A, R),
  261    X = Y.
  262tidy((A,B), (TA,TB)) :-
  263    !,
  264    tidy(A, TA),
  265    tidy(B, TB).
  266tidy(A, A).
  267
  268
  269                 /*******************************
  270                 *        EXPANSION HOOK        *
  271                 *******************************/
  272
  273:- multifile
  274    system:term_expansion/2,
  275    system:goal_expansion/2.  276
  277system:term_expansion((:- arithmetic_function(Term)), Clauses) :-
  278    arith_decl_clauses(Term, Clauses).
  279
  280system:goal_expansion(Math, MathGoal) :-
  281    math_goal_expansion(Math, MathGoal)