1%
    2% Arithmetic functions for single numbers
    3%
    4% Define hooks for R functions etc.
    5%
    6eval(Expr, Res),
    7    eval_hook(Expr, R)
    8 => Res = R.
    9
   10eval(X, Res)
   11 => Res is X.
   12
   13% For convenience
   14eval(Expr1, Expr2, L ... U) :-
   15    eval(Expr1, L),
   16    eval(Expr2, U).
   17
   18
   19interval_(atomic(A), Res, _Flags),
   20    Res = L...U
   21 => L = A,
   22    U = A.
   23
   24interval_(atomic(A), Res, _Flags)
   25 => Res = atomic(A).
   26
   27interval_(L...U, Res, _Flags)
   28 => Res = L...U.
   29
   30interval_(Expr, Res, Flags),
   31    compound(Expr),
   32    compound_name_arguments(Expr, Name, Args),
   33    int_hook(Name, Mask, Res0, Opt),
   34    option(evaluate(true), Opt, true),
   35    instantiate(Res0, Res),
   36    compound_name_arguments(Mask, Fun, Args1),
   37    maplist(instantiate, Args1, Args2),
   38    maplist(interval__(Flags), Args, Args2)
   39 => compound_name_arguments(Goal, Fun, Args2),
   40    call(Goal, Res, Flags).
   41
   42interval__(Flags, A, Res) :-
   43    interval_(A, Res, Flags).
   44
   45instantiate(A, Res), 
   46    A = atomic
   47 => Res = atomic(_).
   48
   49instantiate(A, Res), 
   50    A = ...
   51 => Res = _..._.
   52
   53instantiate(A, Res),
   54    var(A)
   55 => Res = A.
   56
   57% Skipping evaluation of arguments
   58interval_(Expr, Res, Flags),
   59    compound(Expr),
   60    compound_name_arguments(Expr, Name, Args),
   61    int_hook(Name, Mask, Res0, Opt),
   62    option(evaluate(false), Opt, true),
   63    instantiate(Res0, Res),
   64    compound_name_arguments(Mask, Fun, Args1),
   65    maplist(instantiate, Args1, Args2),
   66    maplist(instantiate_, Args, Args2)
   67 => compound_name_arguments(Goal, Fun, Args2),
   68    call(Goal, Res, Flags).
   69
   70instantiate_(atomic(A), Res),
   71    Res = atomic(_)
   72 => Res = atomic(A).
   73
   74instantiate_(atomic(A), Res),
   75    Res = _..._
   76 => Res = A...A.
   77
   78instantiate_(L...U, Res),
   79    Res = _..._
   80 => Res = L...U.
   81
   82instantiate_(ci(A, B), Res),
   83    Res = ci(_, _)
   84 => Res = ci(A, B).
   85
   86instantiate_(A, Res)
   87 => Res = A.
   88
   89% special case: multiplication ([*, *], commutative)
   90interval_(Expr, Res, Flags),
   91    compound(Expr),
   92    compound_name_arity(Expr, Name, Arity),
   93    mono(Name/Arity, **)
   94 => compound_name_arguments(Expr, Name, Args),
   95    maplist(interval__(Flags), Args, Args1),
   96    findall(R, both(Name, Args1, R), Bounds),
   97    min_list(Bounds, L),
   98    max_list(Bounds, U),
   99    Res = L...U.
  100
  101% general case
  102interval_(Expr, Res, Flags),
  103    compound(Expr),
  104    compound_name_arity(Expr, Name, Arity),
  105    mono(Name/Arity, Dir)
  106 => compound_name_arguments(Expr, Name, Args),
  107    maplist(interval__(Flags), Args, Args1),
  108    findall(R, lower(Dir, Name, Args1, R), Lower),
  109    min_list(Lower, L),
  110    findall(R, upper(Dir, Name, Args1, R), Upper),
  111    max_list(Upper, U),
  112    Res = L...U.
  113
  114%
  115% Default case
  116%
  117interval_(_, _, _Flags)
  118 => fail.
  119
  120lower(Dir, Name, Args, Res) :-
  121    maplist(lower, Dir, Args, Lower),
  122    Expr =.. [Name | Lower],
  123    eval(Expr, Res).
  124
  125upper(Dir, Name, Args, Res) :-
  126    maplist(upper, Dir, Args, Upper),
  127    Expr =.. [Name | Upper],
  128    eval(Expr, Res).
  129
  130both(Name, Args, Res) :-
  131    maplist(lower(*), Args, Lower),
  132    Expr =.. [Name | Lower],
  133    eval(Expr, Res).
  134
  135% Obtain lower and upper bounds
  136lower(+, A..._, L)
  137 => L = A.
  138
  139lower(-, _...A, L)
  140 => L = A.
  141
  142lower(*, A...B, L)
  143 => L = A ; L = B.
  144
  145lower(_, atomic(A), L)
  146 => L = A.
  147
  148lower(_, A, L),
  149    atomic(A)
  150 => L = A.
  151
  152upper(+, _...B, U)
  153 => U = B.
  154
  155upper(-, A..._, U)
  156 => U = A.
  157
  158upper(*, A...B, U)
  159 => U = A ; U = B.
  160
  161upper(_, atomic(A), U)
  162 => U = A.
  163
  164upper(_, A, U),
  165    atomic(A)
  166 => U = A