 # a function returning (i + j) * -998
 func $foo (
# var %i xxx,
  var %i i32, var %j i32, var %k i32,
  var %i1 i32, var %j1 i32, var %k1 i32
  ) i32 {
   assertge (dread i32 %i, constval i32 0)
   assertlt (dread i32 %i, dread i32 %k)
   return (
     ashr i32(
      mul i32 (
       add i32 (
        band i32 (dread i32 %i, dread i32 %j),
        bior i32 (
         bxor i32(dread i32 %i1, dread i32 %k1),
         eq i32 i32 (
          depositbits i32 1 23 (
           land i32 (dread i32 %j1, dread i32 %k),
           lior i32 (
             min i32 (
              shl i32 (dread i32 %k1, dread i32 %j),
              sub i32 (dread i32 %j1, dread i32 %i)),
             rem i32 (dread i32 %i, dread i32 %k))),
          div i32(
           lshr i32 ( dread i32 %k, dread i32 %i),
           max i32 ( dread i32 %i, dread i32 %j))))),
       constval i32 -998),
      dread i32 %i))}

 # EXEC: %irbuild Main.mpl
 # EXEC: %irbuild Main.irb.mpl
 # EXEC: %cmp Main.irb.mpl Main.irb.irb.mpl


  banish := module()
    export ModuleApply :=
         proc(g, h :: name, kb :: t_kb_mb, levels :: extended_numeric,
                 x :: name, make, $)
    # banish(g, h, kb, levels, x, make), where the integrand h and the
    # integration variable x take scope over the integral g patently linear
    # in h, should be equivalent to make(kb, g), where the integration operator
    # make binds x in g, except
    #   - integration over x is performed innermost rather than outermost;
    #   - if levels < infinity then levels controls how deeply to banish g;
    #   - make is invoked with the KB in the first argument extended.
    local subintegral, w, y, kb1, lo, hi, m, loops, xx, less;
    if g = 0 or kb :: t_not_a_kb then
      0
    elif levels <= 0 then
      make(kb, g)
    elif not depends(g, x) then
      make(kb, 1) * g
    elif g :: `+` then
      map(banish, _passed)
    elif g :: `*` then
      (subintegral, w) := selectremove(depends, g, h);
      if subintegral :: `*` then error "Nonlinear integral %1", g end if;
      banish(subintegral, h, kb, levels, x, banish_weight(make, w));
    elif g :: 'And'('specfunc({Int,int,Sum,sum})',
                    'anyfunc'('anything','name'='range'('freeof'(h)))) then
      lo, hi      := op(op([2,2],g));
      m           := make;
      if depends(lo, x) then
        m  := banish_guard(eval(m), lo<y);
        lo := -infinity;
      end if;
      if depends(hi, x) then
        m  := banish_guard(eval(m), y<hi);
        hi := infinity;
      end if;
      y, kb1 := `if`(op(0,g) in '{Int,int}',
        genLebesgue(op([2,1],g), lo, hi, kb, make),
        genSummation(op([2,1],g), lo, hi, kb, make));
      subintegral := subs(op([2,1],g)=y, op(1,g));
      op(0,g)(banish(subintegral, h, kb1, levels-1, x, m), y=lo..hi)

    # if `g' is an 'n-' integral or sum of the form
    # {Ints/Sums}(f, nm, x..y, [nm0=x0..y0, .., nmk=xk..yk])
    #   where x..y is free of `h'
    elif g :: 'And'('specfunc({Ints,ints,Sums,sums})',
                    'anyfunc'('anything', 'name', 'range'('freeof'(h)),
                              'list(name=range)')) then
      lo, hi      := op(op(3,g));       # 'primary' (?) integration bounds
      loops       := op(4,g);           # rest of the integration bounds
      xx          := map(lhs, loops);   # [nm0 .. nmk]
      m           := make;
      less        := `if`(op(0,g) in '{Ints,ints}', `<`, `<=`);

      # banish the primary bounds if they depend on the primary integration
      # variable
      if depends(lo, x) then
        m  := banish_guard(m, forall(xx, less(lo, mk_idx(y,loops))));
        lo := -infinity;
      end if;
      if depends(hi, x) then
        m  := banish_guard(m, forall(xx, less(mk_idx(y,loops), hi)));
        hi := infinity;
      end if;

      # augment the KB with a new binding (y) corresponding to the primary
      # variable of integration.
      y, kb1 := genType(op(2,g),
                        mk_HArray(`if`(op(0,g) in '{Ints,ints}',
                                       HReal(open_bounds(lo..hi)),
                                       HInt(closed_bounds(lo..hi))),
                                  op(4,g)),
                        kb);

      # if there are any more integration bounds, then add the information
      # about the last (?) integration bound to the KB.
      if nops(op(4,g)) > 0 then
        kb1 := assert(size(y)=op([4,-1,2,2],g)-op([4,-1,2,1],g)+1, kb1);
          ASSERT(type(kb1,t_kb), "banish/{Ints,Sums}: invalid integration bounds found "
                 "in input.");
      end if;

      subintegral := subs(op(2,g)=y, op(1,g));
      op(0,g)(banish(subintegral, h, kb1, levels-1, x, m), y, lo..hi, op(4,g));
    elif g :: {t_pw, Partition} then
      `if`(g::t_pw,foldr_piecewise,Partition:-Foldr)(banish_pw_cons(x, h, levels), banish_pw_nil, g)(make, kb)
    # elif g ::  then
      # Partition:-Foldr(banish_pw_cons(x, h, levels), banish_pw_nil, g)(make, kb)
    elif g :: t_case then
      map_piecewiselike(banish, _passed)
    elif g :: 'toLO:-integrate(freeof(x), Integrand(name, anything), list)' then
      y           := gensym(op([2,1],g));
      subintegral := subs(op([2,1],g)=y, op([2,2],g));
      subsop(2=Integrand(y, banish(subintegral, h, kb, levels-1, x, make)), g)
    else
      make(kb, g)
    end if
  end proc;

  local banish_pw_nil := proc(make, kb, $) 0 end proc;

  local banish_pw_cons := proc(x, h, levels, $)
        proc(cond, th, el, $) proc(make, kb, $)
          if depends(cond, x) then
            banish(th, h, kb, levels-1, x, banish_guard(make, cond))
              + el(banish_guard(make, Not(cond)), kb)
          else
            piecewise(cond,
              banish(th, h, assert_mb(cond, kb), levels-1, x, make),
              el(make, assert_mb(Not(cond), kb)))
          end if
        end proc end proc;
  end proc;

  local banish_guard := proc(make, cond, $)
    if cond :: 'And(specfunc(Not), anyfunc(anything))' then
      # Work around simplify/piecewise bug:
      #   > simplify(piecewise(Not(i=0), 1, 0))
      #   a
      # (due to PiecewiseTools:-ImportImplementation:-UseSolve calling
      # solve(Not(i=0), {i}, 'AllSolutions', 'SolveOverReals'))
      proc(kb,g,$) make(kb, piecewise(op(1,cond),0,g)) end proc
    else
      proc(kb,g,$) make(kb, piecewise(cond,g,0)) end proc
    end if
  end proc;

  local banish_weight := proc(make, w, $)
    proc(kb,g,$) make(kb, w*g) end proc
  end proc;

end module;


type $SS <struct {
        @real f32,
        @imag f32}>
var $sconst1 <struct {
        @f11 i32,
        @f22 <$SS>,
        @f33 i32,
        @f44 i32,
        @f55 f32,
        @f66 f32}> = [ 1=1007, 2= [1=11.11f, 2=22.22f], 5=-273.0f, 6=75.0f, 4=6023 ]
func $fact () i32 {
  return (dread i32 $sconst1 1)
}
 # EXEC: %irbuild Main.mpl
 # EXEC: %irbuild Main.irb.mpl
 # EXEC: %cmp Main.irb.mpl Main.irb.irb.mpl


fun:=proc()
    uses Grid;
    local node,i,N;
    node:=MyNode();
    N:=NumNodes();
    if node<>0 then
        Threads:-Sleep(N-node);
        print(node);
        Send(0,evalf(Pi-3+node,100));
    else
        for i from 1 to N-1 do
            print(Receive(i));
        end do;
    end if;
end proc:
Grid:-Launch(fun);


######################################################################
#
# General operad framework.

`check_semi_gamma_args` := proc(J,U,V,is_el_CC)
 local i,k,jj;
 global reason;

 if not type(J,list(nonnegint)) then
  reason := [convert(procname,string),"J is not a list of natural numbers",J];
  return false;
 fi;

 k := nops(J);
 jj := `+`(op(JJ));

 if not is_el_CC(k)(U) then
  reason := [convert(procname,string),"U is not in C(k)",eval(U),k];
  return false;
 fi;

 if not (type(V,list) and nops(V) = k) then
  reason := [convert(procname,string),"V is not a list of length k",eval(V),k];
  return false;
 fi;

 for i from 1 to k do
  if not is_el_CC(J[i])(V[i]) then
   reason := [convert(procname,string),"V[i] is not in C(j[i])",i,j[i],eval(V[i])];
   return false;
  fi;
 od;

 return true;
end;

######################################################################

`check_semi_gamma_axiom` := proc(L,U,V,W,is_el_CC,is_equal_CC,gamma_CC)
 local J,L_,k,jj,ii,H,k0,j0,W0,W_,UV,VW0,VW,UVW0,UVW1;
 global reason;

 if not type(L,list(list(nonnegint))) then
  reason := [convert(procname,string),"L is not a list of lists of natural numbers",L];
  return false;
 fi;

 J := map(nops,L);
 L_ := map(op,L);
 k := nops(J);
 jj := `+`(op(J));
 ii := `+`(op(L_));
 H := [seq(`+`(op(L[k0])),k0=1..k)];

 if not is_el_CC(k)(U) then
  reason := [convert(procname,string),"U is not in O(k)",eval(U),k];
  return false;
 fi;

 if not (type(V,list) and nops(V) = k) then
  reason := [convert(procname,string),"V is not a list of length k",eval(V),k];
  return false;
 fi;

 for k0 from 1 to k do
  if not is_el_CC(J[k0])(V[k0]) then
   reason := [convert(procname,string),"V[k0] is not in O(J[k0])",k0,J[k0],eval(V[k0])];
   return false;
  fi;
 od;

 if not (type(W,list) and nops(W) = k) then
  reason := [convert(procname,string),"W is not a list of length k",eval(W),k];
  return false;
 fi;

 for k0 from 1 to k do
  W0 := W[k0];
  if not (type(W0,list) and nops(W0) = J[k0]) then
   reason := [convert(procname,string),"W[k0] is not a list of length J[k0]",k0,J[k0],W0];
   return false;
  fi;

  for j0 from 1 to J[k0] do
   if not is_el_CC(L[k0][j0])(W[k0][j0]) then
    reason := [convert(procname,string),"W[k0][j0] is not in O(L[k0][j0])",k0,j0,L[k0][j0],eval(W[k0][j0])];
    return false;
   fi;
  od:
 od:

 UV := gamma_CC(J)(U,V);
 if not is_el_CC(jj)(UV) then
  reason := [convert(procname,string),"UV is not in O(jj)",jj,J,eval(U),eval(V),eval(UV)];
  return false;
 fi;

 W_ := map(op,W);

 if not `check_semi_gamma_args`(L_,UV,W_,is_el_CC) then
  reason := [convert(procname,string),"invalid arguments to gamma 1",reason];
  return false;
 fi;

 UVW0 := gamma_CC(L_)(UV,W_);
 if not is_el_CC(ii)(UVW0) then
  reason := [convert(procname,string),"UVW0 is not in O(ii)",ii,eval(UVW0)];
  return false;
 fi;

 VW := [];
 for k0 from 1 to k do
  if not `check_semi_gamma_args`(L[k0],V[k0],W[k0],is_el_CC) then
   reason := [convert(procname,string),"invalid arguments to gamma 2",reason];
   return false;
  fi;
  VW0 := gamma_CC(L[k0])(V[k0],W[k0]);
  if not is_el_CC(H[k0])(VW0) then
   reason := [convert(procname,string),"VW[k0] is not in O(H[k0])",k0,H[k0],eval(VW0)];
   return false;
  fi;
  VW := [op(VW),VW0];
 od;

 if not `check_semi_gamma_args`(H,U,VW,is_el_CC) then
  reason := [convert(procname,string),"invalid arguments to gamma 3",reason];
  return false;
 fi;

 UVW1 := gamma_CC(H)(U,VW);
 if not is_el_CC(ii)(UVW1) then
  reason := [convert(procname,string),"UVW1 is not in O(ii)",ii,eval(UVW1)];
  return false;
 fi;

 if not is_equal_CC(ii)(UVW0,UVW1) then
  reason := [convert(procname,string),"UVW0 != UVW1",eval(UVW0),eval(UVW1)];
  return false;
 fi;

 return true;
end;


read("metaMPFR_common.mpl"):

FUNCTION_SERIES := 0:
FUNCTION_SERIES_RATIONAL := %+1:
CONSTANT_SERIES := %+1:

###############################################################################
######################### We can now generate the code ########################
###############################################################################
# This procedure generate code for a straightforward evaluation of the series
# corresponding to a recurrence.
#   rec is a recurrence with inital conditions
#   type can take three values, depending on which series should be evaluated:
#     FUNCTION_SERIES -> produces code for evaluating sum( a(i)*x^i )
#     FUNCTION_SERIES_RATIONAL -> produces code for evaluating sum( a(i)*(p/q)^i )
#     CONSTANT_SERIES -> produces code for evaluating sum( a(i) )
#   name is the name the should be given to the produced procedure.
#   fofx is an optional parameter. It is the function being implemented.
#     -> if provided, this argument will be used to (heuristically) find the limits
#        of the function at +/-oo and find its asymptotical behavior.
#   *IMPORTANT NOTE*: it must be a function of the variable 'x'.
#                     Moreover, neither _f nor x shall be assigned at the time of
#                     calling the function
#
generateStraightforwardAlgo := proc(rec, aofn, type, name, filename, fofx := _f(x))
  local a, b, n, fd, init_cond, nc, d, exponents, formalRec, c, s1, s2, p, q, hardconstant, f0, i0, ri0, i, j, var, var1, var2, var3, guard_bits, required_mulsi, required_divsi, temp, error_counter, error_in_loop, maxofti, additional_error:

  getname(aofn, a, n):

  required_mulsi := {}:
  required_divsi := {}:
  fd := fopen(filename, WRITE):

  # We check that we have a recurrence of the form a(n+d)=r(n)*a(n)
  # and we extract its canonical form:
  #    a(n+d) = c * s1(n)/s1(n+d) * s2(n+d)/s2(n) * p(n)/q(n) * a(n)
  #
  formalRec := checkOneTermRecurrence(rec, a(n)):
  decomposeOneTermRecurrence(formalRec, c, s1, s2, p, q):
  d := formalRec:-order:

  # We keep only non-trivial inital conditions
  init_cond := removeTrivialConditions(rec, a(n));
  nc := nops(init_cond):
  exponents := {1, d}:
  for i from 1 to nc do
    exponents := { op(exponents), init_cond[i][1] }
  od:
  exponents := findFixpointOfDifferences(exponents):
  exponents := exponents minus {0}:

  error_counter := []:

  fprintf(fd, "/* Evaluation by a straightforward algorithm */\n"):
  fprintf(fd, "/* Code automatically generated by metaMPFR. */\n"):

  fprintf(fd, "static int\n"):
  if (type=FUNCTION_SERIES)
    then fprintf(fd, "mpfr_%a (mpfr_ptr res, mpfr_srcptr x, mpfr_rnd_t rnd)\n", name):
  elif (type=FUNCTION_SERIES_RATIONAL)
    then fprintf(fd, "mpfr_%a (mpfr_ptr res, int u, int v, mpfr_rnd_t rnd)\n", name):
  elif (type=CONSTANT_SERIES)
    then fprintf(fd, "mpfr_%a (mpfr_ptr res, mpfr_rnd_t rnd)\n", name):
  fi:
  fprintf(fd, "{\n"):

  ######################################################
  #################### Declarations ####################
  ######################################################

  fprintf(fd, "  MPFR_ZIV_DECL (loop);\n"):
  fprintf(fd, "  MPFR_SAVE_EXPO_DECL (expo);\n"):
  fprintf(fd, "  mpfr_prec_t wprec;             /* working precision */\n"):
  fprintf(fd, "  mpfr_prec_t prec;              /* target precision */\n"):
  fprintf(fd, "  mpfr_prec_t err;               /* used to estimate the evaluation error */\n"):
  fprintf(fd, "  mpfr_prec_t correctBits;       /* estimates the number of correct bits*/\n"):
  fprintf(fd, "  unsigned long int k;\n"):
  fprintf(fd, "  unsigned long int conditionNumber;        /* condition number of the series */\n"):
  fprintf(fd, "  unsigned assumed_exponent;     /* used as a lowerbound of -EXP(f(x)) */\n"):
  fprintf(fd, "  int r;                         /* returned ternary value */\n"):
  fprintf(fd, "  mpfr_t s;                      /* used to store the partial sum */\n"):

  if (whattype(c) = 'fraction') or (whattype(c) = 'integer')
    then hardconstant := 0
    else hardconstant := 1
  fi:
  if (type=FUNCTION_SERIES) then hardconstant := 1 fi:

  if (hardconstant=1)
  then
    if (type=CONSTANT_SERIES)
      then fprintf(fd, "  mpfr_t x%d;                     /* used to store %a */\n", d, c):
    elif (type=FUNCTION_SERIES_RATIONAL)
      then fprintf(fd, "  mpfr_t x%d;                     /* used to store %a */\n", d, c*(u/v)^d):
    elif (type=FUNCTION_SERIES)
      then fprintf(fd, "  mpfr_t x%d;                     /* used to store %a */\n", d, c*x^d):
    fi:
  fi:

  if (type=FUNCTION_SERIES)
  then
    fprintf(fd, "  mpfr_t tmp;\n"):
    if (nops(exponents)-1 >= 1) then fprintf(fd, "  mpfr_t ") fi:
    for i from 1 to nops(exponents)-1 do
      fprintf(fd, "x%d", exponents[i]):
      if (i<nops(exponents)-1) then fprintf(fd, ", ") else fprintf(fd, ";                     /* used to store x^i */\n") fi
    od:
  fi:

  fprintf(fd, "  mpfr_t ");
  for i from 1 to nc do
    fprintf(fd, "tip%d", init_cond[i][1]):
    if (i<nc) then fprintf(fd, ", ") else fprintf(fd, "; /* used to store successive values of t_i */\n") fi:
  od:
  fprintf(fd, "  int "):
  for i from 1 to nc do
    fprintf(fd, "test%d", init_cond[i][1]):
    if (i<nc) then fprintf(fd, ", ") else fprintf(fd, ";\n") fi:
  od:
  fprintf(fd, "  int global_test;               /* used to test when the sum can be stopped */"):

  fprintf(fd, "\n"):
  fprintf(fd, "  /* Logging */\n"):
  if (type=FUNCTION_SERIES)
    then fprintf(fd, "  MPFR_LOG_FUNC ( (\"x[%%#R]=%%R rnd=%%d\", x, x, rnd), (\"res[%%#R]=%%R\", res, res) );\n\n")
  elif (type=FUNCTION_SERIES_RATIONAL)
    then fprintf(fd, "  MPFR_LOG_FUNC ( (\"x=u/v with u=%%d and v=%%d, rnd=%%d\", u, v, rnd), (\"res[%%#R]=%%R\", res, res) );\n\n")
  else fprintf(fd, "  MPFR_LOG_FUNC ( (\"rnd=%%d\", rnd), (\"res[%%#R]=%%R\", res, res) );\n\n")
  fi:

  ######################################################
  #################### Special cases ###################
  ######################################################

  if ( (type=FUNCTION_SERIES) or (type=FUNCTION_SERIES_RATIONAL) )
  then
    fprintf(fd, "  /* Special cases */\n"):

    if (type=FUNCTION_SERIES)
      then fprintf(fd, "  if (MPFR_UNLIKELY (MPFR_IS_NAN (x)))\n")
      else fprintf(fd, "  if (MPFR_UNLIKELY (v==0))\n")
    fi:
    fprintf(fd, "    {\n"):
    fprintf(fd, "      MPFR_SET_NAN (res);\n"):
    fprintf(fd, "      MPFR_RET_NAN;\n"):
    fprintf(fd, "    }\n"):

    if (init_cond[1][1] > 0) then f0 := 0 else f0 := init_cond[1][2] fi:
    if (type=FUNCTION_SERIES)
      then fprintf(fd, "  if (MPFR_UNLIKELY (MPFR_IS_ZERO (x)))\n")
      else fprintf(fd, "  if (MPFR_UNLIKELY (u==0))\n")
    fi:
    if (whattype(f0) = 'integer')
    then
      fprintf(fd, "    {\n"):
      fprintf(fd, "      return mpfr_set_si (res, %a, rnd);\n", f0):
      fprintf(fd, "    }\n")
    else
      printf("You need to provide a function mpfr_%a0(mpfr_t, mpfr_rnd_t) that evaluates %a with correct rounding\n", name, f0):
      fprintf(fd, "    {\n"):
      fprintf(fd, "      return mpfr_%a0 (res, rnd);\n", name):
      fprintf(fd, "    }\n")
    fi:

    if (type=FUNCTION_SERIES)
    then
      fprintf(fd, "  if (MPFR_UNLIKELY (MPFR_IS_INF (x)))\n"):
      fprintf(fd, "    {\n"):
      for i from -1 to 1 by 2 do  # Trick to handle both -oo and +oo
        if (i<0)
          then fprintf(fd, "      if (MPFR_IS_NEG (x))\n"):
          else fprintf(fd, "      else\n")
        fi:
        fprintf(fd, "        {\n"):
        if (i<0) then f0 := "m" else f0 := "p" fi:
        if (fofx <> _f(x))
        then
          f0 := limit(fofx, x=i*infinity):
          if (whattype(f0)='integer')
          then fprintf(fd, "          return mpfr_set_si (res, %a, rnd);\n", f0):
          elif (f0 = infinity) or (f0 = -infinity)
          then
            fprintf(fd, "          MPFR_SET_INF(res);\n"):
            if (f0>0)
            then fprintf(fd, "          MPFR_SET_POS(res);\n")
            else fprintf(fd, "          MPFR_SET_NEG(res);\n")
            fi:
            fprintf(fd, "          MPFR_RET(0);\n"):
          else
            if (i<0) then f0 := "m" else f0 := "p" fi:
          fi:
        fi:
        if ((f0 = "p") or (f0 = "m"))
        then
          printf("You need to provide a function mpfr_%a%sinf(mpfr_t, mpfr_rnd_t) that evaluates lim(f(x), x=", name, f0):
          if (f0 = "m") then printf("-") fi:
          printf("inf) with correct rounding.\n"):
          fprintf(fd, "          return mpfr_%a%sinf (res, rnd);\n", name, f0)
        fi:
        fprintf(fd, "        }\n")
      od:
      fprintf(fd, "    }\n")
    fi:
  fi:

  ######################################################
  ################## Precomputations ###################
  ######################################################

  fprintf(fd, "\n"):
  fprintf(fd, "  /* Save current exponents range */\n"):
  fprintf(fd, "  MPFR_SAVE_EXPO_MARK (expo);\n\n"):

  if ( (type=FUNCTION_SERIES) or (type=FUNCTION_SERIES_RATIONAL) )
  then  fprintf(fd, "  /* FIXME: special case for large values of |x| ? */\n\n")
  fi:

  # Note : prec is the value such that we will try to compute an approximation
  # with relative error smaller than 2^(1-prec).
  # Several things may happen:
  #   1) We do not achieve the intended error: this is because we badly estimated the exponent of the result
  #   2) We achieve the error, but it is not sufficient to decide correct rounding (Ziv's bad case)
  # Against 1), we can try to make our estimate of the exponent better with any heuristic.
  # Against 2), we can consider more guard bits. 11 guard bits seem a good value for the beginning
  #   (statistically, we expect to fail in less than 0.1 % of the cases)
  # wprec is the precision used during the computation, in order to ensure the final relative error 2^(1-prec)
  #
  fprintf(fd, "  /* We begin with 11 guard bits */\n"):
  fprintf(fd, "  prec = MPFR_PREC (res) + 11;\n"):
  fprintf(fd, "  MPFR_ZIV_INIT (loop, prec);\n"):

  # TODO: the value here can be chosen completely heursitically. We could do something much better
  # when fofx is known by using asympt(fofx, x, 1). A clean implementation appears to be complex though.
  # We must catch errors if the development does not exist (e.g. AiryAi(-x));
  # We must find a separation after which the asymptotic behavior is valid (e.g. x>1)
  printf("The code contains a variable assumed_exponent arbitrarily set to 10. You can put any value heuristically chosen. The closer it is to -log_2(|f(x)|), the better it is.\n"):
  fprintf(fd, "  assumed_exponent = 10; /* TIP: You can put any value heuristically chosen. The closer it is to -log_2(|f(x)|), the better it is */\n"):

  # TODO: find a way of putting a rigorous value here.
  # This value *must* be rigorous: the safety of the implementation relies on it.
  # Precisely, we need to have sum(|a(i)*x^i|) <= 2^conditionNumber
  fprintf(fd, "  conditionNumber = xxx; /* FIXME: set a value such that sum(|a(i)*x^i|) <= 2^conditionNumber */\n"):
  printf("The code contains a variable conditionNumber that you must manually set to a suitable value, in order to ensure that sum_{i=0}^{infinity} |a(i)*x^i| <= 2^conditionNumber\n"):
  fprintf(fd, "  wprec = prec + ERRORANALYSISPREC + conditionNumber + assumed_exponent;\n"):

  ######################################################
  ################## Initialisations ###################
  ######################################################

  if (hardconstant=1)
  then
    fprintf(fd, "  mpfr_init (x%d);\n", d):
  fi:
  if (type = FUNCTION_SERIES)
  then
    fprintf(fd, "  mpfr_init (tmp);\n"):
    for i from 1 to nops(exponents)-1 do
      fprintf(fd, "  mpfr_init (x%d);\n", exponents[i])
    od:
  fi:

  for i from 1 to nc do
    fprintf(fd, "  mpfr_init (tip%d);\n", init_cond[i][1])
  od:
  fprintf(fd, "  mpfr_init (s);\n\n"):

  ######################################################
  ########## Ziv' loop: setting the precision ##########
  ######################################################

  fprintf(fd, "  /* ZIV' loop */\n"):
  fprintf(fd, "  for (;;)\n"):
  fprintf(fd, "    {\n"):

  fprintf(fd, "      MPFR_LOG_MSG ((\"Working precision: %%d\\n\", wprec, 0));\n\n"):
  if (hardconstant=1)
  then
    fprintf(fd, "      mpfr_set_prec (x%d, wprec);\n", d):
  fi:
  if (type = FUNCTION_SERIES)
  then
    fprintf(fd, "      mpfr_set_prec (tmp, wprec);\n"):
    fprintf(fd, "      if(mpfr_get_prec (x) > wprec)\n"):
    fprintf(fd, "        mpfr_set_prec (x1, wprec);\n"):
    fprintf(fd, "      else\n"):
    fprintf(fd, "        mpfr_set_prec (x1, mpfr_get_prec (x));\n"):
    for i from 2 to nops(exponents)-1 do
      fprintf(fd, "      mpfr_set_prec (x%d, wprec);\n", exponents[i])
    od:
  fi:

  for i from 1 to nc do
    fprintf(fd, "      mpfr_set_prec (tip%d, wprec);\n", init_cond[i][1])
  od:
  fprintf(fd, "      mpfr_set_prec (s, wprec);\n\n"):

  ######################################################
  ############ Ziv' loop: initial conditions ###########
  ######################################################

  fprintf(fd, "      mpfr_set_ui (s, 0, MPFR_RNDN);\n"):

  if (type = FUNCTION_SERIES)
  then
    fprintf(fd, "      mpfr_set (x1, x, MPFR_RNDN);\n"):
    error_counter := init_error_counter("x1", error_counter):
    for i from 2 to nops(exponents) do
        fprintf(fd, "      mpfr_mul (x%d, x%d, x%d, MPFR_RNDN);\n", exponents[i], exponents[i-1], exponents[i]-exponents[i-1]):
	var1 := sprintf("x%d", exponents[i]):
        var2 := sprintf("x%d", exponents[i-1]):
        var3 := sprintf("x%d", exponents[i]-exponents[i-1]):
	error_counter := error_counter_of_a_multiplication(var1, var2, var3, error_counter):
    od:
  fi:

  for i from 1 to nc do
    i0 := init_cond[i][1]:
    ri0 := init_cond[i][2]:  # We implement t_{i0} <- ri0
    if (whattype(ri0)='integer') or (whattype(ri0)='fraction')
    then
      if (type = FUNCTION_SERIES) and (i0 <> 0)
        then
          var :=  sprintf("      mpfr_mul_si (tip%d, x%d, ", i0, i0):
          var1 := sprintf("tip%d", i0):
          var2 := sprintf("x%d", i0):
          error_counter := error_counter_of_a_multiplication(var1, var2, "", error_counter):
        else
          var := sprintf("      mpfr_set_si (tip%d, ", i0):
          var1 := sprintf("tip%d", i0):
          error_counter := init_error_counter(var1, error_counter):
      fi:
      fprintf(fd, "%s%d, MPFR_RNDN);\n", var, numer(ri0)):
      if (whattype(ri0)='fraction')
      then
        fprintf(fd, "      mpfr_div_si (tip%d, tip%d, %d, MPFR_RNDN);\n", i0, i0, denom(ri0)):
        var1 := sprintf("tip%d", i0):
        error_counter := error_counter_of_a_multiplication(var1, var1, "", error_counter):
      fi:
    else
      printf("You need to provide a function mpfr_%a%d (mpfr_t, mpfr_rnd_t) that evaluates %a with faithful rounding.\n", name, i0, ri0):
      fprintf(fd, "      mpfr_%a%d (tip%d, MPFR_RNDN);\n", name, i0, i0):
      var1 := sprintf("tip%d", i0):
      error_counter := init_error_counter(var1, error_counter):
      if (type = FUNCTION_SERIES) and (i0 <> 0)
      then
        fprintf(fd, "      mpfr_mul (tip%d, tip%d, x%d, MPFR_RNDN);\n", i0, i0, i0):
        var1 := sprintf("tip%d", i0):
        var2 := sprintf("x%d", i0):
        error_counter := error_counter_of_a_multiplication(var1, var1, var2, error_counter):
      fi:
    fi:

    if (type = FUNCTION_SERIES_RATIONAL) and (i0 <> 0)
    then
      var1 := sprintf("tip%d", i0):
      if (i0 = 1)
      then fprintf(fd, "      mpfr_mul_si (tip%d, tip%d, ", i0, i0):
      else
        required_mulsi := { op(required_mulsi), i0 }:
        fprintf(fd, "      mpfr_mul_si%d (tip%d, tip%d, ", i0, i0, i0):
      fi:
      for j from 1 to i0 do
        fprintf(fd, "u, "):
        error_counter := error_counter_of_a_multiplication(var1, var1, "", error_counter):
      od:
      fprintf(fd, "MPFR_RNDN);\n"):
      if (i0 = 1)
      then fprintf(fd, "      mpfr_div_si (tip%d, tip%d, ", i0, i0):
      else
        required_divsi := { op(required_divsi), i0 }:
        fprintf(fd, "      mpfr_div_si%d (tip%d, tip%d, ", i0, i0, i0):
      fi:
      for j from 1 to i0 do
        fprintf(fd, "v, "):
        error_counter := error_counter_of_a_multiplication(var1, var1, "", error_counter):
      od:
      fprintf(fd, "MPFR_RNDN);\n"):
    fi:

    fprintf(fd, "      mpfr_add (s, s, tip%d, MPFR_RNDN);\n\n", i0):
  od:

  if (whattype(c) = 'integer') or (whattype(c) = 'fraction')
  then
    if (type = FUNCTION_SERIES) and (c = -1)
    then
      fprintf(fd, "      MPFR_CHANGE_SIGN (x%d);\n", d):
    elif (type = FUNCTION_SERIES) and (c <> 1)
    then
      fprintf(fd, "      mpfr_mul_si (x%d, x%d, %d, MPFR_RNDN);\n", d, d, numer(c)):
      var1 := sprintf("x%d", d):
      error_counter := error_counter_of_a_multiplication(var1, var1, "", error_counter):
      if (whattype(c) = 'fraction')
      then
        fprintf(fd, "      mpfr_div_si (x%d, x%d, %d, MPFR_RNDN);\n", d, d, denom(c)):
        error_counter := error_counter_of_a_multiplication(var1, var1, "", error_counter):
      fi:
    fi:
  else
    printf("You need to provide a function mpfr_%a_cste (mpfr_t, mpfr_rnd_t) that evaluates %a with faithful rounding.\n", name, c):
    if (type = CONSTANT_SERIES)
    then
      fprintf(fd, "      mpfr_%a_cste (x%d, MPFR_RNDN);\n", name, d):
      var1 := sprintf("x%d", d):
      error_counter := init_error_counter(var1, error_counter):
    elif (type = FUNCTION_SERIES) then
      fprintf(fd, "      mpfr_%a_cste (tmp, MPFR_RNDN);\n", name):
      error_counter := init_error_counter("tmp", error_counter):
      fprintf(fd, "      mpfr_mul (x%d, tmp, x%d, MPFR_RNDN);\n", d, d):
      var1 := sprintf("x%d", d):
      error_counter := error_counter_of_a_multiplication(var1, "tmp", var1, error_counter):
    elif (type = FUNCTION_SERIES_RATIONAL) then
      fprintf(fd, "      mpfr_%a_cste (x%d, MPFR_RNDN);\n", name, d):
      var1 := sprintf("x%d", d):
      error_counter := init_error_counter(var1, error_counter):
      if (d = 1)
      then fprintf(fd, "      mpfr_mul_si (x%d, x%d, ", d, d):
      else
        required_mulsi := { op(required_mulsi), d }:
        fprintf(fd, "      mpfr_mul_si%d (x%d, x%d, ", d, d, d):
      fi:
      for j from 1 to d do
        fprintf(fd, "u, "):
        error_counter := error_counter_of_a_multiplication(var1, var1, "", error_counter):
      od:
      fprintf(fd, "MPFR_RNDN);\n"):
      var1 := sprintf("x%d", d):
      if (d = 1)
      then fprintf(fd, "      mpfr_div_si (x%d, x%d, ", d, d):
      else
        required_divsi := { op(required_divsi), d }:
        fprintf(fd, "      mpfr_div_si%d (x%d, x%d, ", d, d, d):
      fi:
      for j from 1 to d do
        fprintf(fd, "v, "):
        error_counter := error_counter_of_a_multiplication(var1, var1, "", error_counter):
      od:
      fprintf(fd, "MPFR_RNDN);\n"):
    fi:
  fi:

  ######################################################
  ######### Ziv' loop: evaluation of the series ########
  ######################################################

  fprintf(fd, "\n"):
  fprintf(fd, "      /* Evaluation of the series */\n"):
  fprintf(fd, "      k = %d;\n", d):
  fprintf(fd, "      for (;;)\n"):
  fprintf(fd, "        {\n"):
  if (init_cond[1][1] <> 0) then fprintf(fd, "          k += %d;\n", init_cond[1][1]) fi:

  for i from 1 to nc do
    error_in_loop := 0:
    i0 := init_cond[i][1]:
    if (hardconstant = 1)
    then
      fprintf(fd, "          mpfr_mul (tip%d, tip%d, x%d, MPFR_RNDN);\n", i0, i0, d):
      var1 := sprintf("x%d", d):
      error_in_loop := error_in_loop + 1 + find_in_error_counter(var1, error_counter):
    else
      var := sprintf("tip%d", i0):
      temp := generate_multiply_rational(fd, var, var, c, [[var, error_in_loop]], "          "):
      error_in_loop := find_in_error_counter(var, temp):
      if (type = FUNCTION_SERIES_RATIONAL)
      then
        if (d=1)
        then
          fprintf(fd, "          mpfr_mul_si (tip%d, tip%d, u, MPFR_RNDN);\n", i0, i0):
          fprintf(fd, "          mpfr_div_si (tip%d, tip%d, v, MPFR_RNDN);\n", i0, i0):
	  error_in_loop := error_in_loop + 2:
        else
          required_mulsi := { op(required_mulsi), d }:
          fprintf(fd, "          mpfr_mul_si%d (tip%d, tip%d", d, i0, i0):
          for j from 1 to d do fprintf(fd, ", u") od:
          fprintf(fd, ", MPFR_RNDN);\n"):
	  error_in_loop := error_in_loop + d:

          required_divsi := { op(required_divsi), d }:
          fprintf(fd, "          mpfr_div_si%d (tip%d, tip%d", d, i0, i0):
          for j from 1 to d do fprintf(fd, ", v") od:
          fprintf(fd, ", MPFR_RNDN);\n" ):
	  error_in_loop := error_in_loop + d:
        fi
      fi
    fi:
    var := sprintf("tip%d", i0):

    temp := generate_multiply_poly(fd, var, var, subs(n=k-d, p/q), [[var, error_in_loop]], "          "):
    required_mulsi := { op(required_mulsi), op(temp[1]) }:
    required_divsi := { op(required_divsi), op(temp[2]) }:
    error_in_loop := find_in_error_counter(var, temp[3]):
    temp := generate_multiply_poly(fd, "tmp", var, subs(n=k, s2/s1), [[var, error_in_loop]], "          "):
    required_mulsi := { op(required_mulsi), op(temp[1]) }:
    required_divsi := { op(required_divsi), op(temp[2]) }:

    fprintf(fd, "          mpfr_add (s, s, tmp, MPFR_RNDN);\n"):

    if (i<nc) then fprintf(fd, "\n          k += %d;\n", init_cond[i+1][1]-i0)
    else  fprintf(fd, "\n          k += %d;\n", d-i0)
    fi:
  od:

  ######################################################
  ################### Error analysis ###################
  ######################################################

  maxofti := 0: # store the maximum of the error counters of the initial conditions
  for i from 1 to nc do
    var := sprintf("tip%d", init_cond[i][1]):
    if find_in_error_counter(var, error_counter) > maxofti
      then maxofti := find_in_error_counter(var, error_counter):
    fi:
  od:
  additional_error := find_in_error_counter("tmp", temp[3]) - error_in_loop:

  ######################################################
  #### Ziv' loop: stopping criterion for the series ####
  ######################################################

  # The first neglected term is tk, so the remainder is made by
  # tk + t(k+d) + t(k+2d).... and the corresponding series
  # beginning with t(k+1), t(k+2), etc. up to t(k+d-1).
  #
  # We have t(k0+d) = c*s1(k0)/s1(k0+d) * s2(k0+d)/s2(k0)* p(k0)/q(k0) * x^d t(k0)
  # (where x=u/v or x=1 in cases of rational series or constant series)
  # So it suffices that:
  # forall k0>=k-d, |c * s1(k0)/s1(k0+d) * s2(k0+d)/s2(k0) * p(k0)/q(k0) * x^d| <= 1/2     (1)
  #
  # If this is true, |tk| = |c*s1(k-d)/s1(k) * s2(k)/s2(k-d)* p(k-d)/q(k-d) * x^d t(k-d)| <= t(k-d)/2
  # This is also true for larger values of k, so we can bound |tk + t(k+d) + t(k+2d) + ...| by |t(k-d)|.
  # And the same holds for |t(k+1) + ...|, |t(k+2) + ...|, etc. up to |t(k+d-1)+...|.
  #
  # global_test depends on k and we must satisfy:
  #  "if (global_test) then (1) holds".
  #
  # the total remainder is bounded by 2*nc*tk.

  fprintf(fd, "          global_test = xxx; /* FIXME: set the value in order to ensure that, whenever global_test is true, we have: forall k'>=k, |r(k')*x^d| <= 1/2, where r is the fraction such that a(n)=r(n)a(n-d)*/\n"):
  printf("The code contains a variable global_test that you must manually set to a suitable value, in order to ensure that when global_test is true, the following holds:\n"):
  printf("        forall k'>=k, |r(k')*x^d| <= 1/2, where r is the fraction such that a(n)=r(n)a(n-d)\n"):
  guard_bits := 1+1+ceil(log[2](nc)):
  for i from 1 to nc do
    i0 := init_cond[i][1]:
    fprintf(fd, "          test%d = ( (!MPFR_IS_ZERO(s))\n", i0):
    fprintf(fd, "                    && ( MPFR_IS_ZERO(tip%d)\n", i0):
    fprintf(fd, "                         || (MPFR_EXP(tip%d) + (mp_exp_t)prec + %d <= MPFR_EXP(s))\n", i0, guard_bits):
    fprintf(fd, "                         )\n"):
    fprintf(fd, "                    );\n"):
  od:
  fprintf(fd, "          if (");
  for i from 1 to nc do
    fprintf(fd, "test%d && ", init_cond[i][1]):
  od:
  fprintf(fd, "global_test)\n"):
  fprintf(fd, "            break;\n"):
  fprintf(fd, "        }\n\n"):

  ######################################################
  ############## Ziv' loop: testing final ##############
  ######################################################

  fprintf(fd, "      MPFR_LOG_MSG ((\"Truncation rank: %%lu\\n\", k));\n\n"):
  fprintf(fd, "      err = ERRORANALYSISK + conditionNumber - MPFR_GET_EXP (s);\n\n"):
  fprintf(fd, "      /* err is the number of bits lost due to the evaluation error */\n"):
  fprintf(fd, "      /* wprec-(prec+1): number of bits lost due to the approximation error */\n"):
  fprintf(fd, "      MPFR_LOG_MSG ((\"Roundoff error: %%Pu\\n\", err));\n"):
  fprintf(fd, "      MPFR_LOG_MSG ((\"Approxim error: %%Pu\\n\", wprec-prec-1));\n\n"):
  fprintf(fd, "      if (wprec < err+1)\n"):
  fprintf(fd, "        correct_bits=0;\n"):
  fprintf(fd, "      else\n"):
  fprintf(fd, "        {\n"):
  fprintf(fd, "          if (wprec < err+prec+1)\n"):
  fprintf(fd, "            correct_bits =  wprec - err - 1;\n"):
  fprintf(fd, "          else\n"):
  fprintf(fd, "            correct_bits = prec;\n"):
  fprintf(fd, "        }\n\n"):
  fprintf(fd, "      if (MPFR_LIKELY (MPFR_CAN_ROUND (s, correct_bits, MPFR_PREC (y), rnd)))\n"):
  fprintf(fd, "        break;\n\n"):

  fprintf(fd, "      if (correct_bits == 0)\n"):
  fprintf(fd, "        {\n"):
  fprintf(fd, "          assumed_exponent *= 2;\n"):
  fprintf(fd, "          MPFR_LOG_MSG ((\"Not a single bit correct (assumed_exponent=%%lu)\\n\",\n"):
  fprintf(fd, "                         assumed_exponent));\n"):
  fprintf(fd, "          wprec = prec + ERRORANALYSISK + conditionNumber + assumed_exponent;\n"):
  fprintf(fd, "        }\n"):
  fprintf(fd, "      else\n"):
  fprintf(fd, "        {\n"):
  fprintf(fd, "          if (correct_bits < prec)\n"):
  fprintf(fd, "            { /* The precision was badly chosen */\n"):
  fprintf(fd, "              MPFR_LOG_MSG ((\"Bad assumption on the exponent of %s(x)\", 0));\n", name):
  fprintf(fd, "              MPFR_LOG_MSG ((\" (E=%%ld)\\n\", (long) MPFR_GET_EXP (s)));\n"):
  fprintf(fd, "              wprec = prec + err + 1;\n"):
  fprintf(fd, "            }\n"):
  fprintf(fd, "          else\n"):
  fprintf(fd, "            { /* We are really in a bad case of the TMD */\n"):
  fprintf(fd, "              MPFR_ZIV_NEXT (loop, prec);\n\n"):

  fprintf(fd, "              /* We update wprec */\n"):
  fprintf(fd, "              /* We assume that K will not be multiplied by more than 4 */\n"):
  fprintf(fd, "              wprec = prec + ERRORANALYSIS4K + conditionNumber\n"):
  fprintf(fd, "                - MPFR_GET_EXP (s);\n"):
  fprintf(fd, "            }\n"):
  fprintf(fd, "        }\n\n"):

  fprintf(fd, "    } /* End of ZIV loop */\n\n"):
  fprintf(fd, "  MPFR_ZIV_FREE (loop);\n\n"):
  fprintf(fd, "  r = mpfr_set (res, s, rnd);\n\n"):

  ######################################################
  ################ Clearing everything #################
  ######################################################

  fprintf(fd, "  mpfr_clear (s);\n"):
  if (hardconstant=1)
  then
    fprintf(fd, "  mpfr_clear (x%d);\n", d):
  fi:
  if (type = FUNCTION_SERIES)
  then
    fprintf(fd, "  mpfr_clear (tmp);\n"):
    for i from 1 to nops(exponents)-1 do
      fprintf(fd, "  mpfr_clear (x%d);\n", exponents[i]):
    od:
  fi:

  for i from 1 to nc do
    fprintf(fd, "  mpfr_clear (tip%d);\n", init_cond[i][1]):
  od:

  fprintf(fd, "\n"):
  fprintf(fd, "  MPFR_SAVE_EXPO_FREE (expo);\n"):
  fprintf(fd, "  return mpfr_check_range (res, r, rnd);\n"):
  fprintf(fd, "}\n"):

  fclose(fd):

  for i from 1 to nops(required_mulsi) do
    printf("You need to provide a mpfr_mul_si%d function.\n", required_mulsi[i]):
    printf("  -> This can be achieved by a call to generate_muldivsin(\"mul\", %d):\n",  required_mulsi[i]):
  od:
  for i from 1 to nops(required_divsi) do
    printf("You need to provide a mpfr_div_si%d function.\n", required_divsi[i]):
    printf("  -> This can be achieved by a call to generate_muldivsin(\"div\", %d):\n",  required_divsi[i]):
  od:

  ######################################################
  ################## Error analysis ####################
  ######################################################

  printf("\n\n"):
  printf("Before the loop, we have "):
  for i from 1 to nc do
    var := sprintf("tip%d", init_cond[i][1]):
    printf("%s {%d}", var, find_in_error_counter(var, error_counter)):
    if (i <> nc) then printf(", ") else printf("\n") fi:
  od:
  printf("Each step of the loop adds another {%d}\n", error_in_loop):
  if (additional_error <> 0)
  then printf("Moreover, the multiplication by %a adds another {%d} to each term before it is summed.\n", subs(n=k, s2/s1), additional_error)
  fi:
  printf("Finally, we have s = sum_(i=0)^(k-1) ( ti{%d + %dk} )\n", maxofti + additional_error + 1 - error_in_loop, error_in_loop):
  printf("We bound it by {(k+%d)*2^(%d)}\n", ceil( (maxofti + additional_error + 1 - error_in_loop)/error_in_loop), ceil(log[2](error_in_loop))):

  a := ceil( (maxofti + additional_error + 1 - error_in_loop)/error_in_loop):
  b := ceil(log[2](error_in_loop)):

  if (a > 0)
    then var := sprintf("MPFR_INT_CEIL_LOG2 (prec + %d)", a)
    elif (a=0) then  var := sprintf("MPFR_INT_CEIL_LOG2 (prec)")
    else sprintf("MPFR_INT_CEIL_LOG2 (prec - %d)", -a)
  fi:
  if (b > 0) then var := sprintf("%s + %d", var, b+2) fi:
  var := sprintf("sed -n -i 's/ERRORANALYSISPREC/%s/g;p' %s", var, filename):
  system(var):

  if (a > 0)
    then var := sprintf("MPFR_INT_CEIL_LOG2 (k + %d)", a)
    elif (a=0) then  var := sprintf("MPFR_INT_CEIL_LOG2 (k)")
    else sprintf("MPFR_INT_CEIL_LOG2 (k - %d)", -a)
  fi:
  if (b > 0) then var := sprintf("%s + %d", var, b+2) fi:
  var := sprintf("sed -n -i 's/ERRORANALYSISK/%s/g;p' %s", var, filename):
  system(var):

  if (a > 0)
    then var := sprintf("MPFR_INT_CEIL_LOG2 (k + %d)", a)
    elif (a=0) then  var := sprintf("MPFR_INT_CEIL_LOG2 (k)")
    else sprintf("MPFR_INT_CEIL_LOG2 (k - %d)", -a)
  fi:
  var := sprintf("%s + %d", var, b+4):
  var := sprintf("sed -n -i 's/ERRORANALYSIS4K/%s/g;p' %s", var, filename):
  system(var):

end proc:


func $fact (
 var %n i32) i32 {
 var %foo <func(i32) i32>
 var %r1 i32
 var %r2 i32
 var %r3 i32
 if (ne i32 i32 (dread i32 %n, constval i32 1)) {
    icallassigned ( dread a64 %foo,
      sub i32 (dread i32 %n, constval i32 1)) {
      dassign %r1 0
    }
    # Not correct, but for parse and dump test.
    icallassigned ( dread a64 %foo,
      sub i32 (dread i32 %n, constval i32 1)) {
      dassign %r1 1
      dassign %r2 2
      dassign %r3 3
    }
    return (dread i32 %n)
  }
}
 # EXEC: %irbuild Main.mpl
 # EXEC: %irbuild Main.irb.mpl
 # EXEC: %cmp Main.irb.mpl Main.irb.irb.mpl


`depends/Bucket` := proc(mr, r::(name=range), x, $)
  depends(rhs(r), x) or depends(mr, x minus {lhs(r)})
end proc:

`depends/Index` := proc(n, o::name, e, mr, x, $)
  depends({n,e}, x) or depends(mr, x minus {o})
end proc:

# note that v _can_ occur in m1.
`depends/Let` := proc(m1, v::name, m2, x, $)
  depends(m1, x) or depends(m2, x minus {v})
end proc:

`eval/Bucket` := proc(e::anyfunc(anything,name=range), eqs, $)
  local bvar, body;
  bvar, body := BindingTools:-generic_evalat(op([2,1],e), op(1,e), eqs);
  eval(op(0,e), eqs)(body, bvar = eval(op([2,2],e), eqs))
end proc:

`eval/Index` := proc(e::anyfunc(anything,name,anything,anything), eqs, $)
  local o, mr;
  o, mr := BindingTools:-generic_evalat(op(2,e), op(4,e), eqs);
  eval(op(0,e), eqs)(eval(op(1,e), eqs), o, eval(op(3,e), eqs), mr)
end proc:

`eval/Let` := proc(e, eqs, $)
  local m1, v, m2;
  m1, v, m2 := op(e);
  eval(op(0,e), eqs)(eval(m1, eqs), BindingTools:-generic_evalat(v, m2, eqs))
end proc:

Summary := module ()
  option package;
  export RoundTrip, Summarize, SummarizeKB, bucket, summarize;
  global Bucket, Fanout, Index, Split, Nop, Add, Let,
         SumIE, ProductIE, BucketIE;
  uses Hakaru, KB;

  RoundTrip := proc(e)
    local result;
    interface(screenwidth=9999, prettyprint=0, warnlevel=0,
      showassumed=0,quiet=true);
    kernelopts(assertlevel=0);
    result := eval(ToInert(Summarize(_passed)), _Inert_ATTRIBUTE=NULL);
    lprint(result)
  end proc;

  Summarize := proc(e, {ctx :: list := []}, $)
    local ie;
    ie := table('[sum    =SumIE    , Sum    =SumIE    ,
                  product=ProductIE, Product=ProductIE,
                  bucket =BucketIE , Bucket =BucketIE ]');
    subsindets(SummarizeKB(e, foldr(assert, empty, op(ctx))),
               And(specfunc({indices(ie, 'nolist')}),
                   anyfunc(anything, anything=range)),
               e -> subsop(0 = ie[op(0,e)],
                           applyop(`+`, [2,2,2], e, 1)))
  end proc;

  SummarizeKB := proc(e, kb :: t_kb, $)
    local patterns, x, kb1, e1, rng, summary, mr, f;
    if not hasfun(e, '{Sum,sum}', 'piecewise') then
      e;
    elif e :: '{known_continuous, known_discrete,
                specfunc({Msum, Weight, Fanout, Split, Nop, Add,
                          exp, log, GAMMA, Beta, idx, And, Or, Not}),
                `+`, `*`, `^`, `..`, boolean, indexed, list}' then
      map(procname, _passed);
    elif e :: 'Context(anything, anything)' then
      kb1 := assert(op(1,e), kb);
      applyop(procname, 2, e, kb1);
    elif e :: 'specfunc(piecewise)' then
      kb_piecewise(e, kb, ((lhs, kb) -> lhs), SummarizeKB);
    elif e :: 'lam(name, anything, anything)' then
      patterns := htype_patterns(op(2,e));
      if patterns :: Branches(Branch(PVar(name),anything)) then
        # Eta-expand the function type
        x := op(1,e);
        x, kb1 := genType(x, op(2,e), kb);
        e1 := eval(op(3,e), op(1,e)=x);
        lam(x, op(2,e), SummarizeKB(e1, kb1))
      else
        # Eta-expand the function type and the sum-of-product argument-type
        x := op(1,e);
        if depends([e,kb], x) then x := gensym(x) end if;
        e1 := eval(op(3,e), op(1,e)=x);
        lam(x, op(2,e), 'case'(x,
          map(proc(branch)
                local eSubst, pSubst, p1, binds, y, kb1, i, pSubst1;
                eSubst, pSubst := pattern_match([x,e], x, op(1,branch));
                p1 := subs(pSubst, op(1,branch));
                binds := [pattern_binds(p1)];
                kb1 := kb;
                pSubst1 := table();
                for i from 1 to nops(binds) do
                  y, kb1 := genType(op(i,binds), op([2,i],branch), kb1);
                  pSubst1[op(i,binds)] := y;
                end do;
                pSubst1 := op(op(pSubst1));
                Branch(subs(pSubst1, p1),
                       SummarizeKB(eval(eval(e1,eSubst),pSubst1), kb1))
              end proc,
              patterns)))
      end if
    elif e :: 'ary(anything, name, anything)' then
      x, kb1 := genType(op(2,e), HInt(closed_bounds(0..op(1,e)-1)), kb);
      e1 := SummarizeKB(eval(op(3,e), op(2,e)=x), kb1);
      subsop(2=x, 3=e1, e);
    elif e :: 'And(specfunc({sum, Sum, product, Product}),
                   anyfunc(anything, name=range))' then
      rng := op([2,2],e);
      x, kb1 := genType(op([2,1],e), HInt(closed_bounds(rng)), kb);
      rng := map(SummarizeKB, rng, kb);
      e1 := eval(op(1,e), op([2,1],e)=x);
      if op(0, e) in '{sum, Sum}' and has(e1, 'piecewise') then
        mr, f := summarize(e1, kb, x, summary);
        if hasfun(mr, '{Fanout, Index}') then
          mr := SummarizeKB(mr, kb1);
          return Let(Bucket(mr, x=rng),
                     summary,
                     NewSLO:-simplify_factor_assuming(f, kb));
        end if;
      end if;
      e1 := SummarizeKB(e1, kb1);
      subsop(2=(x=rng), 1=e1, e);
    else
      error "SummarizeKB doesn't know how to handle %1", e;
    end if;
  end proc;

  bucket := proc(mr, r::(name=range), cond::list:=[], $)
    if mr :: 'Fanout(anything,anything)' then
      Pair(op(map(procname, _passed)))
    elif mr :: 'Split(anything,anything,anything)' then
      Pair(bucket(op(2,mr), r, [    op(1,mr) ,op(cond)]),
           bucket(op(3,mr), r, [Not(op(1,mr)),op(cond)]))
    elif mr :: 'Index(anything,name,anything,anything)' then
      ary(op(1,mr), op(2,mr),
          bucket(op(4,mr), r, [op(2,mr)=op(3,mr),op(cond)]));
    elif mr :: 'Nop()' then
      _Unit
    elif mr :: 'Add(anything)' then
      sum(piecewise_And(cond, op(1,mr), 0), r)
    else
      'procname(_passed)'
    end if;
  end proc;

  summarize := proc(ee,
                    kb :: t_kb,
                    i :: {name,list(name),set(name)},
                    summary, $)
    local e, r, s,
          e1, mr1, f1, e2, mr2, f2,
          variables, var_outerness, outermost, thunk, consider,
          o, t, lo, hi, b, a;

    # Try to ensure termination
    e := simplify_assuming(ee, kb);
    if length(e) >= length(ee) then e := ee end if;

    # Nop rule
    if Testzero(e) then return Nop(), 0 end if;

    r := indets(e, '{relation, logical, specfunc({And,Or})}');
    s, r := selectremove(depends, r, i);
    # Fanout rule
    r := sort(convert(r, 'list'), 'length');
    while nops(r) > 0 do
      e1 := eval(e, r[-1]=true);  if e = e1 then r := r[1..-2]; next end if;
      e2 := eval(e, r[-1]=false); if e = e2 then r := r[1..-2]; next end if;
      mr1, f1 := summarize(e1, kb, i, 'fst(summary)');
      mr2, f2 := summarize(e2, kb, i, 'snd(summary)');
      return Fanout(mr1, mr2), 'piecewise'(r[-1], f1, f2);
    end do;

    variables     := kb_to_variables(kb);
    var_outerness := table(variables =~ [seq(1..nops(variables))]);
    outermost     := -infinity;
    consider      := proc(expr, th, $)
      local outerness;
      outerness := map((n -> var_outerness[n]), indets(expr, 'name'));
      outerness := min(select(type, outerness, 'integer'));
      if outermost < outerness then
        outermost := outerness;
        thunk     := th;
      end if;
    end proc;
    if has(variables, i) then
      error "The loop to be summarized shadows the variable %1", i;
    end if;
    for r in s do
      e1 := eval(e, r=true);  if e = e1 then next end if;
      e2 := eval(e, r=false); if e = e2 then next end if;
      # Index rule
      if r :: `=` and Testzero(e2) then
        for o in indets(r, 'name') minus convert(i, 'set') do
          if not (var_outerness[o] :: integer) then next end if;
          t := getType(kb, o);
          if not (t :: specfunc(HInt)) then next end if;
          lo := op(select(type, t, 'Bound(identical(`>=`), anything)'));
          if lo = NULL then next else lo := op(2,lo) end if;
          hi := op(select(type, t, 'Bound(identical(`<=`), anything)'));
          if hi = NULL then next else hi := op(2,hi) end if;
          if not ispoly(`-`(op(r)), 'linear', o, 'b', 'a') then next end if;
          b := Normalizer(-b/a);
          consider(b, ((e1, o, lo, hi, b) -> proc($)
            local mr, f;
            mr, f := summarize(e1, kb, i, 'idx'(summary, o-lo));
            Index(hi-lo+1, o, b, mr),
              'piecewise'(And(o::integer, lo<=o, o<=hi), f, 0);
          end proc)(e1, o, lo, hi, b));
        end do;
      end if;
      # Split rule
      consider(r, ((e1, e2, r) -> proc($)
        local mr1, f1, mr2, f2;
        mr1, f1 := summarize(e1, kb, i, 'fst(summary)');
        mr2, f2 := summarize(e2, kb, i, 'snd(summary)');
        Split(r, mr1, mr2), f1 + f2;
      end proc)(e1, e2, r));
    end do;
    if thunk :: procedure then
      return thunk();
    else
      # Add rule
      return Add(e), summary;
    end if;
  end proc;
end module; # Summary


######################################################################

`is_element/P/itloc` := (N::set(nonnegint)) -> (AA) -> (T) -> proc(TT)
 `is_element/M1/itloc`(N)(AA)(TT) and `omega/itloc`(TT) = T;
end:

`is_leq/P/itloc` := (N::set(nonnegint)) -> (AA) -> (T) -> proc(TT0,TT1)
 `and`(seq(TT0[i] minus TT1[i] = {},i=1..nops(TT0)));
end:

`list_elements/P/itloc` := (N::set(nonnegint)) -> (AA) -> proc(T)
 local BB,L;

 BB := `cap/itloc`(AA,T);
 L := `list_elements/M1/itloc`(T)(BB);
 L := select(TT -> `omega/itloc`(TT) = T,L);
 return L;
end:

######################################################################

`is_element/P_star/itloc` := (N) -> (AA) -> (T) -> (iu) -> proc(TT)
 local i,u;

 i,u := op(iu);

 if not(`is_element/P/itloc`(N)(AA)(T)(TT)) then
  return false;
 fi;

 if max(u,op(TT[i])) <> u then
  return false;
 fi;

 return true;
end:

`Alpha/itloc` := (N) -> (AA) -> (T) -> (iu) -> proc(TT)
 local i,u,r,UU;

 i,u := op(iu);

 if max(op(TT[i])) < u then
  return TT;
 fi;

 r := nops(AA);
 UU := [
  seq(TT[k],k=1..i),
  TT[i+1] union {u},
  seq(TT[k],k=i+2..r)
 ];

 return UU;
end:

`Beta/itloc` := (N) -> (AA) -> (T) -> (iu) -> proc(TT)
 local i,u,r,UU;

 i,u := op(iu);

 if max(op(TT[i])) < u then
  return TT;
 fi;

 r := nops(AA);
 UU := [
  seq(TT[k],k=1..i-1),
  TT[i] minus {u},
  TT[i+1] union {u},
  seq(TT[k],k=i+2..r)
 ];

 return UU;
end:

######################################################################

`is_element/MM/itloc` := (N) -> (AA) -> (T) -> (i) -> proc(TT)
 local a,r,k,UU;

 if not(`is_element/P/itloc`(N)(AA)(T)(TT)) then
  return false;
 fi;

 a := `bot/threads/itloc`(`cap/itloc`(AA,T));
 r := nops(AA);
 UU := [
  select(t -> t <= a[1],T),
  seq(select(t -> a[k-1] <= t and t <= a[k],T),k=2..r)
 ];

 for k from 1 to i do
  if TT[k] <> UU[k] then return false; fi;
 od;

 return true;
end:

`is_element/NN/itloc` := (N) -> (AA) -> (T) -> (i) -> proc(TT)
 local a,r,k,UU;

 if not(`is_element/P/itloc`(N)(AA)(T)(TT)) then
  return false;
 fi;

 a := `bot/threads/itloc`(`cap/itloc`(AA,T));
 r := nops(AA);
 UU := [
  select(t -> t <= a[1],T),
  seq(select(t -> a[k-1] <= t and t <= a[k],T),k=2..r)
 ];

 for k from 1 to i do
  if TT[k] <> UU[k] then return false; fi;
 od;

 if i = 0 and not(member(min(op(T)),TT[1])) then
  return false;
 fi;

 if i > 0 and not(member(a[i],TT[i+1])) then
  return false;
 fi;

 return true;
end:

`is_element/LL/itloc` := (N) -> (AA) -> (T) -> (iu) -> proc(TT)
 local i,u,a,r,k,UU;

 i,u := op(iu);

 if not(`is_element/NN/itloc`(N)(AA)(T)(i-1)(TT)) then
  return false;
 fi;

 if max(op(TT[i])) > u then
  return false;
 fi;

 return true;
end:

`theta/itloc` := (N) -> (AA) -> (T) -> (i) -> proc(TT)
 local a,r;

 a := `bot/threads/itloc`(`cap/itloc`(AA,T));
 r := nops(AA);

 return [
  seq(TT[k],k=1..i),
  TT[i+1] union {a[i]},
  seq(TT[k],k=i+2..r)
 ];
end;