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-2023, VU University Amsterdam
    7                              SWI-Prolog Solutions b.v.
    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(arithmetic,
   37          [ arithmetic_function/1,              % +Name/Arity
   38            arithmetic_expression_value/2       % :Expression, -Value
   39          ]).   40:- autoload(library(error),[type_error/2]).   41:- autoload(library(lists),[append/3]).   42
   43:- set_prolog_flag(generate_debug_info, false).

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

 arithmetic_function(:NameArity) is det

Declare a predicate as an arithmetic function. The function is visible in the module in which it is defined as well as modules that import the implementation predicate or inherit from this module. For example:

:- use_module(library(arithmetic)).
:- arithmetic_function(mid/2).
mid(A,B,C) :- C is (A+B)/2.

After which we may call ?- A is mid(3,5)., resulting in A = 4.

The implementation uses goal_expansion/2 to rewrite an arithmetic expression using user functions into a conjunction of arithmetic evaluation and predicate calls. This implies that the expression must be known at compile time. Runtime evaluation is supported using arithmetic_expression_value/2.

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.

   87arithmetic_function(Term) :-
   88    throw(error(context_error(nodirective, arithmetic_function(Term)), _)).
   89
   90arith_decl_clauses(NameArity,
   91                   [(:- public(PI)),
   92                    arithmetic:evaluable(Term, Q)
   93                   ]) :-
   94    prolog_load_context(module, M),
   95    strip_module(M:NameArity, Q, Spec),
   96    (   Q == M
   97    ->  PI = Name/ImplArity
   98    ;   PI = Q:Name/ImplArity
   99    ),
  100    (   Spec = Name/Arity
  101    ->  functor(Term, Name, Arity),
  102        ImplArity is Arity+1
  103    ;   type_error(predicate_indicator, Term)
  104    ).

 eval_clause(+Term, -Clause) is det

Clause is a clause for evaluating the arithmetic expression Term.

  111eval_clause(roundtoward(_,Round), (eval(Gen,M,Result) :- Body)) :-
  112    !,
  113    Gen = roundtoward(Arg,Round),
  114    eval_args([Arg], [PlainArg], M, Goals,
  115              [Result is roundtoward(PlainArg,Round)]),
  116    list_conj(Goals, Body).
  117eval_clause(Term, (eval(Gen, M, Result) :- Body)) :-
  118    functor(Term, Name, Arity),
  119    functor(Gen, Name, Arity),
  120    Gen =.. [_|Args],
  121    eval_args(Args, PlainArgs, M, Goals, [Result is NewTerm]),
  122    NewTerm =.. [Name|PlainArgs],
  123    list_conj(Goals, Body).
  124
  125eval_args([], [], _, Goals, Goals).
  126eval_args([E0|T0], [A0|T], M, [eval(E0, M, A0)|GT], RT) :-
  127    eval_args(T0, T, M, GT, RT).
  128
  129list_conj([One], One) :- !.
  130list_conj([H|T0], (H,T)) :-
  131    list_conj(T0, T).
  132
  133eval_clause(Clause) :-
  134    current_arithmetic_function(Term),
  135    eval_clause(Term, Clause).
  136
  137term_expansion(eval('$builtin', _, _), Clauses) :-
  138    findall(Clause, eval_clause(Clause), Clauses).

 arithmetic_expression_value(:Expression, -Result) is det

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

  146arithmetic_expression_value(M:Expression, Result) :-
  147    eval(Expression, M, Result).
  148
  149eval(Number, _, Result) :-
  150    number(Number),
  151    !,
  152    Result = Number.
  153eval(Term, M, Result) :-
  154    evaluable(Term, M2),
  155    visible(Term, M, M2),
  156    !,
  157    call(M2:Term, Result).
  158eval('$builtin', _, _).
  159
  160
  161visible(_, M, M) :- !.
  162visible(F, M, Super) :-
  163    import_module(M, Parent),
  164    visible(F, Parent, Super),
  165    !.
  166visible(F, M, Super) :-
  167    functor(F, Name, Arity),
  168    PredArity is Arity+1,
  169    functor(Head, Name, PredArity),
  170    predicate_property(M:Head, imported_from(Super)),
  171    !.
  172
  173                 /*******************************
  174                 *         COMPILE-TIME         *
  175                 *******************************/
  176
  177math_goal_expansion(A is Expr, Goal) :-
  178    expand_function(Expr, Native, Pre),
  179    tidy((Pre, A is Native), Goal).
  180math_goal_expansion(ExprA =:= ExprB, Goal) :-
  181    expand_function(ExprA, NativeA, PreA),
  182    expand_function(ExprB, NativeB, PreB),
  183    tidy((PreA, PreB, NativeA =:= NativeB), Goal).
  184math_goal_expansion(ExprA =\= ExprB, Goal) :-
  185    expand_function(ExprA, NativeA, PreA),
  186    expand_function(ExprB, NativeB, PreB),
  187    tidy((PreA, PreB, NativeA =\= NativeB), Goal).
  188math_goal_expansion(ExprA > ExprB, Goal) :-
  189    expand_function(ExprA, NativeA, PreA),
  190    expand_function(ExprB, NativeB, PreB),
  191    tidy((PreA, PreB, NativeA > NativeB), Goal).
  192math_goal_expansion(ExprA < ExprB, Goal) :-
  193    expand_function(ExprA, NativeA, PreA),
  194    expand_function(ExprB, NativeB, PreB),
  195    tidy((PreA, PreB, NativeA < NativeB), Goal).
  196math_goal_expansion(ExprA >= ExprB, Goal) :-
  197    expand_function(ExprA, NativeA, PreA),
  198    expand_function(ExprB, NativeB, PreB),
  199    tidy((PreA, PreB, NativeA >= NativeB), Goal).
  200math_goal_expansion(ExprA =< ExprB, Goal) :-
  201    expand_function(ExprA, NativeA, PreA),
  202    expand_function(ExprB, NativeB, PreB),
  203    tidy((PreA, PreB, NativeA =< NativeB), Goal).
  204
  205expand_function(Expression, NativeExpression, Goal) :-
  206    do_expand_function(Expression, NativeExpression, Goal0),
  207    tidy(Goal0, Goal).
  208
  209do_expand_function(X, X, true) :-
  210    evaluable(X),
  211    !.
  212do_expand_function(roundtoward(Expr0, Round),
  213                   roundtoward(Expr, Round),
  214                   ArgCode) :-
  215    !,
  216    do_expand_function(Expr0, Expr, ArgCode).
  217do_expand_function(Function, Result, ArgCode) :-
  218    current_arithmetic_function(Function),
  219    !,
  220    Function =.. [Name|Args],
  221    expand_function_arguments(Args, ArgResults, ArgCode),
  222    Result =.. [Name|ArgResults].
  223do_expand_function(Function, Result, (ArgCode, Pred)) :-
  224    prolog_load_context(module, M),
  225    evaluable(Function, M2),
  226    visible(Function, M, M2),
  227    !,
  228    Function =.. [Name|Args],
  229    expand_predicate_arguments(Args, ArgResults, ArgCode),
  230    append(ArgResults, [Result], PredArgs),
  231    Pred =.. [Name|PredArgs].
  232do_expand_function(Function, _, _) :-
  233    type_error(evaluable, Function).
  234
  235
  236expand_function_arguments([], [], true).
  237expand_function_arguments([H0|T0], [H|T], (A,B)) :-
  238    do_expand_function(H0, H, A),
  239    expand_function_arguments(T0, T, B).
  240
  241expand_predicate_arguments([], [], true).
  242expand_predicate_arguments([H0|T0], [H|T], (A,B)) :-
  243    do_expand_function(H0, H1, A0),
  244    (   callable(H1),
  245        current_arithmetic_function(H1)
  246    ->  A = (A0, H is H1)
  247    ;   A = A0,
  248        H = H1
  249    ),
  250    expand_predicate_arguments(T0, T, B).

 evaluable(F) is semidet

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

  256evaluable(F) :-
  257    var(F),
  258    !.
  259evaluable(F) :-
  260    number(F),
  261    !.
  262evaluable([_Code]) :- !.
  263evaluable(Func) :-                              % Funtional notation.
  264    functor(Func, ., 2),
  265    !.
  266evaluable(F) :-
  267    string(F),
  268    !,
  269    string_length(F, 1).
  270evaluable(roundtoward(F,_Round)) :-
  271    !,
  272    evaluable(F).
  273evaluable(F) :-
  274    current_arithmetic_function(F),
  275    (   compound(F)
  276    ->  forall(arg(_,F,A), evaluable(A))
  277    ;   true
  278    ).

 tidy(+GoalIn, -GoalOut)

Cleanup the output from expand_function/3.

  284tidy(A, A) :-
  285    var(A),
  286    !.
  287tidy(((A,B),C), R) :-
  288    !,
  289    tidy((A,B,C), R).
  290tidy((true,A), R) :-
  291    !,
  292    tidy(A, R).
  293tidy((A,true), R) :-
  294    !,
  295    tidy(A, R).
  296tidy((A, X is Y), R) :-
  297    var(X), var(Y),
  298    !,
  299    tidy(A, R),
  300    X = Y.
  301tidy((A,B), (TA,TB)) :-
  302    !,
  303    tidy(A, TA),
  304    tidy(B, TB).
  305tidy(A, A).
  306
  307
  308                 /*******************************
  309                 *        EXPANSION HOOK        *
  310                 *******************************/
  311
  312:- multifile
  313    system:term_expansion/2,
  314    system:goal_expansion/2.  315
  316system:term_expansion((:- arithmetic_function(Term)), Clauses) :-
  317    arith_decl_clauses(Term, Clauses).
  318
  319system:goal_expansion(Math, MathGoal) :-
  320    math_goal_expansion(Math, MathGoal)