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
   13eval(Expr1, Expr2, L ... U) :-
   14    eval(Expr1, L),
   15    eval(Expr2, U).
   16
   17% External definitions of interval_/3 
   18interval_(A, Res, Flags),
   19    interval_hook(A, Res1, Flags)
   20 => Res = Res1.
   21
   22% Force atomic to interval
   23interval_(atomic(A), Res, _Flags),
   24    Res = L...U
   25 => L = A,
   26    U = A.
   27
   28interval_(atomic(A), Res, _Flags)
   29 => Res = atomic(A).
   30
   31interval_(L...U, Res, _Flags)
   32 => Res = L...U.
   33
   34interval_([], Res, _Flags)
   35 => Res = [].
   36
   37interval_([H | T], Res, Flags)
   38 => maplist(interval__(Flags), [H | T], Res).
   39
   40% Skip evaluation of arguments
   41interval_(Expr, Res, Flags),
   42    compound(Expr),
   43    compound_name_arguments(Expr, Name, Args),
   44    int_hook(Name, Mask, Res0, [evaluate(false) | _T]),
   45    compound_name_arguments(Mask, Fun, Types),
   46    maplist(instantiate, Types, Args),
   47    compound_name_arguments(Goal, Fun, Args),
   48    findall(Res1, call(Goal, Res1, Flags), Sol),
   49    maplist(instantiate(Res0), Sol)
   50 => member(Res, Sol).
   51
   52% Evaluate arguments
   53interval_(Expr, Res, Flags),
   54    compound(Expr),
   55    compound_name_arguments(Expr, Name, Args),
   56    maplist(interval__(Flags), Args, Args1),
   57    compound_name_arguments(Expr1, Name, Args1)
   58 => interval2_(Expr1, Res, Flags).
   59
   60interval__(Flags, A, Res) :-
   61    interval_(A, Res, Flags).
   62
   63instantiate(atomic, atomic(_)).
   64instantiate(..., _..._).
   65instantiate(A, Res) :-
   66    var(A),
   67    A = Res.
   68
   69% Find int_hook
   70interval2_(Expr, Res, Flags),
   71    compound(Expr),
   72    compound_name_arguments(Expr, Name, Args),
   73    maplist(instantiate, Types, Args),
   74    int_hook(Name, Mask, Res0, _Opt),
   75    compound_name_arguments(Mask, Fun, Types),
   76    compound_name_arguments(Goal, Fun, Args),
   77    findall(Res1, call(Goal, Res1, Flags), Sol),
   78    maplist(instantiate(Res0), Sol)
   79 => member(Res, Sol).
   80
   81% Special case: multiplication ([*, *], commutative)
   82interval2_(Expr, Res, _Flags),
   83    compound(Expr),
   84    compound_name_arity(Expr, Name, Arity),
   85    mono(Name/Arity, **)
   86 => compound_name_arguments(Expr, Name, Args),
   87    findall(R, both_(Name, Args, R), Bounds),
   88    min_list(Bounds, L),
   89    max_list(Bounds, U),
   90    Res = L...U.
   91
   92% General case 
   93interval2_(Expr, Res, _Flags),
   94    compound(Expr),
   95    compound_name_arity(Expr, Name, Arity),
   96    mono(Name/Arity, Dir)
   97 => compound_name_arguments(Expr, Name, Args),
   98    findall(R, lower_(Dir, Name, Args, R), Lower),
   99    min_list(Lower, L),
  100    findall(R, upper_(Dir, Name, Args, R), Upper),
  101    max_list(Upper, U),  
  102    return(L, U, Res).
  103
  104%
  105% Default case
  106%
  107interval2_(_, _, _Flags)
  108 => fail.
  109
  110interval_(_, _, _Flags)
  111 => fail.
  112
  113lower_(Dir, Name, Args, Res) :-
  114    maplist(lower_, Dir, Args, Lower),
  115    Expr =.. [Name | Lower],
  116    eval(Expr, Res).
  117
  118upper_(Dir, Name, Args, Res) :-
  119    maplist(upper_, Dir, Args, Upper),
  120    Expr =.. [Name | Upper],
  121    eval(Expr, Res).
  122
  123both_(Name, Args, Res) :-
  124    maplist(lower_(*), Args, Lower),
  125    Expr =.. [Name | Lower],
  126    eval(Expr, Res).
  127
  128% Obtain lower and upper bounds
  129lower_(+, A..._, L)
  130 => L = A.
  131
  132lower_(-, _...A, L)
  133 => L = A.
  134
  135lower_(*, A...B, L)
  136 => L = A ; L = B.
  137
  138lower_(_, atomic(A), L)
  139 => L = A.
  140
  141lower_(_, [H | T], L)
  142 => unwrap([H | T], L).
  143
  144lower_(_, A, L)
  145 => L = A.
  146
  147upper_(+, _...B, U)
  148 => U = B.
  149
  150upper_(-, A..._, U)
  151 => U = A.
  152
  153upper_(*, A...B, U)
  154 => U = A ; U = B.
  155
  156upper_(_, atomic(A), U)
  157 => U = A.
  158
  159upper_(_, [H | T], U)
  160 => unwrap([H | T], U).
  161
  162upper_(_, A, U)
  163 => U = A