Get rid of more unnecessary logic

Get rid of more unnecessary logic

# Step 2 of 3: computer algebra

  improve := proc(lo :: LO(name, anything), {_ctx :: t_kb := empty}, opts := [], $)
  local r, `&context`;
       userinfo(5, improve, "input: ", print(lo &context _ctx));
       r:= LO(op(1,lo), reduce(op(2,lo), op(1,lo), _ctx, opts));
       userinfo(5, improve, "output: ", print(r));
       r
  end proc;

  # Walk through integrals and simplify, recursing through grammar
  # h - name of the linear operator above us
  # kb - domain information
  reduce := proc(ee, h :: name, kb :: t_kb, opts := [], $)
    local e, elim, subintegral, w, ww, x, c, kb1, with_kb1, dom_specw, dom_specb
         , body, dom_spec, ed, mkDom, vars, rr
         , do_domain := evalb( not ( "no_domain" in {op(opts)} ) ) ;
    e := ee;

    if do_domain then
      rr := reduce_Integrals(e, h, kb, opts);
      if rr <> FAIL then return rr end if;
    end if;
    if e :: 'applyintegrand(anything, anything)' then
      map(simplify_assuming, e, kb)
    elif e :: `+` then
      map(reduce, e, h, kb, opts)
    elif e :: `*` then
      (subintegral, w) := selectremove(depends, e, h);
      if subintegral :: `*` then error "Nonlinear integral %1", e end if;
      subintegral := convert(reduce(subintegral, h, kb, opts), 'list', `*`);
      (subintegral, ww) := selectremove(depends, subintegral, h);
      nub_piecewise(simplify_factor_assuming(`*`(w, op(ww)), kb))
        * `*`(op(subintegral));
    elif e :: Or(Partition,t_pw) then
      if e :: t_pw then e := PWToPartition(e); end if;
      e := Partition:-Flatten(e);
      e := kb_Partition(e, kb, simplify_assuming,
                        ((rhs, kb) -> %reduce(rhs, h, kb, opts)));
      e := eval(e, %reduce=reduce);
      # big hammer: simplify knows about bound variables, amongst many
      # other things
      Testzero := x -> evalb(simplify(x) = 0);
      e := PartitionToPW(e);
      e := nub_piecewise(e);
      if ee::Partition and e :: t_pw then
        e := Partition:-PWToPartition(e,'do_solve');
      end if;
      e;
    elif e :: t_case then
      subsop(2=map(proc(b :: Branch(anything, anything))
                     eval(subsop(2='reduce'(op(2,b),x,c,opts),b),
                          {x=h, c=kb})
                   end proc,
                   op(2,e)),
             e);
    elif e :: 'Context(anything, anything)' then
      kb1 := assert(op(1,e), kb);
      # A contradictory `Context' implies anything, so produce 'anything'
      # In particular, 42 :: t_Hakaru = false, so a term under a false
      # assumption should never be inspected in any way.
      if kb1 :: t_not_a_kb then
          return 42
      end if;
      applyop(reduce, 2, e, h, kb1, opts);
    elif e :: 'toLO:-integrate(anything, Integrand(name, anything), list)' then
      x := gensym(op([2,1],e));
      # If we had HType information for op(1,e),
      # then we could use it to tell kb about x.
      subsop(2=Integrand(x, reduce(subs(op([2,1],e)=x, op([2,2],e)), h, kb, opts)), e)
    else
      simplify_assuming(e, kb)
    end if;
  end proc;

  reduce_Integrals_post := proc(h,kb,opts,dvars,mkDom,body)
    local vars, e
      , ed := mkDom(body)
      , ee := subsindets(ed, specfunc(ELIMED), x->op(1,x))
      , do_r :=
          op(1,
           [ map(x->op(2,x),select(x->x::list and op(1,x)="reduce_on", opts))[]
           , reduce_on_prod ]);
    if ed <> ee then
      ed := reduce(ee,h,kb,opts);
    end if;
    kb_assuming_mb(Partition:-Simpl)(ed, kb, x->x);
  end proc;

  # "Integrals" refers to any types of "integrals" understood by domain (Int,
  # Sum currently)
  reduce_Integrals := proc(expr, h, kb, opts, $)
    local rr;
    rr := Domain:-Fold(expr, kb
      ,proc() elim_intsum:-for_Domain(h,args) end proc
      ,((x,kb1)->reduce(x,h,kb1,opts))
      , proc() reduce_Integrals_post(h,kb,opts,args) end proc
      ,(_->:-DOM_FAIL));

    if has(rr, :-DOM_FAIL) then
      return FAIL;
    elif has(rr, FAIL) then
      error "Something strange happened in reduce_Integral(%a, %a, %a, %a)\n%a"
          , expr, kb, kb, opts, rr;
    else
      return rr;
    end if
  end proc;

  # Helper function for performing reductions
  # given an "ee" and a "var", pulls the portion
  # of "ee" not depending on "var" out, and applies "f"
  # to the portion depending on "var".
  # the 'weights' (factors not depending on "var") are simplified
  # under the given assumption context, "kb0"
  reduce_on_sum := proc(f,ee,var,kb0,$)
    `+`(map(s->reduce_on_prod(f,s,var,kb0), convert(expand(ee), 'list', `+`))[]);
  end proc;
  reduce_on_prod := proc(f,ee, var:: {name, list(name), set(name)} ,kb0::t_kb,$)
      local e := ee, w;
      e, w := selectremove(x->depends(x,var) or x :: realcons, list_of_mul(e));
      nub_piecewise(simplify_factor_assuming(`*`(op(w)), kb0)) * f(`*`(op(e))) ;
  end proc;

  int_assuming := proc(e, v::name=anything, kb::t_kb, $)
    simplify_factor_assuming('int'(e, v), kb);
  end proc;

  sum_assuming := proc(e, v::name=anything, kb::t_kb)
    simplify_factor_assuming('sum'(e, v), kb);
  end proc;

  nub_piecewise := proc(pw, $) # pw may or may not be piecewise
    foldr_piecewise(piecewise_if, 0, pw)
  end proc;

  piecewise_if := proc(cond, th, el, $)
    # piecewise_if should be equivalent to `if`, but it produces
    # 'piecewise' and optimizes for when the 3rd argument is 'piecewise'
    if cond = true then
      th
    elif cond = false or Testzero(th - el) then
      el
    elif el :: t_pw then
      if nops(el) >= 2 and Testzero(th - op(2,el)) then
        applyop(Or, 1, el, cond)
      elif nops(el) = 2 then
        piecewise(cond, th, op(el), 0)
      else
        piecewise(cond, th, op(el))
      end if
    elif Testzero(el) then
      piecewise(cond, th)
    else
      piecewise(cond, th, el)
    end if
  end proc;

  # Int( .., var=var_ty ) == var &X var_ty
  isBound_IntSum := kind -> module()
    option record;

    export MakeKB := (`if`(kind=Sum,KB:-genSummation,KB:-genLebesgue));
    export ExtractVar := (e->op(1,e));
    export ExtractRange := (e->op(2,e));
    export MakeRange := `..`;
    export SplitRange := (e->op(e));
    export Constrain := `if`(kind=Sum,`<=`,`<`);
    export DoMk := ((e,v,t)->kind(e,v=t));
    export EvalInCtx    := `if`(kind=Sum,'sum_assuming','int_assuming');
    export Min := `min`; export Max := `max`;
    export VarType := 'name';
    export RangeType := 'range';
    export MapleType := 'And'('specfunc'(kind), 'anyfunc(anything,name=range)');
    export BoundType := `if`(kind=Sum,'integer','real');
    export RecogBound := `if`(kind=Sum,
              (proc(k,b)
                 if   k = `<=` then (x->subsop(2=b,x))
                 elif k = `>=` then (x->subsop(1=b,x))
                 elif k = `<`  then (x->subsop(2=(b-1),x))
                 elif k = `>`  then (x->subsop(1=b+1,x))
                 end if;
               end proc),
              (proc(k,b)
                 if   k in {`<=`,`<`} then (x->subsop(2=b,x))
                 elif k in {`>=`,`>`} then (x->subsop(1=b,x))
                 end if;
               end proc));
  end module;

  # Ints( .., var::name, var_ty::range, dims::list(name=range) ) ==
  #        [ var   , map(lhs,dims) ] :: list(name)  &X
  #        [ var_ty, map(rhs,dims) ] :: list(range)
  isBound_IntsSums := kind -> module()
    option record;

    export MakeKB := proc(vars, lo, hi, kb, $)
      local var, dims, ty, rngs, x, kb1;
      var  := op(1, vars);
      rngs := zip(`..`,lo,hi);
      ty   := op(1, rngs);
      dims := subsop(1=NULL,zip(`=`,vars,rngs));

      x, kb1 := genType(var,
                        mk_HArray(`if`(kind=Ints,
                                       HReal(open_bounds(ty)),
                                       HInt(closed_bounds(ty))),
                                  dims),kb);
      if nops(dims) > 0 then
        kb1 := assert(size(x)=op([-1,2,2],dims)-op([-1,2,1],dims)+1, kb1);
      end if;
      x, kb1;
    end proc;
    export ExtractVar   := ((v,t,d)->[v,map(lhs,d)[]]);
    export ExtractRange := ((v,t,d)->[t,map(rhs,d)[]]);
    export MakeRange    := ((a,b)->zip(`..`,a,b));
    export SplitRange   := (rs->(map(x->op(1,x),rs), map(x->op(2,x),rs)));
    export Constrain    := ((a,b)->zip(`if`(kind=Ints, `<`, `<=`),a,b)[]);
    export DoMk         := ((e,v,t)->kind( e,op(1,v),op(1,t), subsop(1=NULL,zip(`=`,v,t)) ));
    export EvalInCtx    := `if`(kind=Ints,'ints','sums');
    export Min          := ((a,b)->zip(`min`,a,b));
    export Max          := ((a,b)->zip(`max`,a,b));
    export VarType      := 'And(list(name),satisfies(x->x<>[]))';
    export RangeType    := 'And(list(range),satisfies(x->x<>[]))';
    export MapleType    := 'And'('specfunc'(kind),'anyfunc'('anything', 'name', 'range', 'list(name=range)'));
    export BoundType    := TopProp;
    export RecogBound   := (_->NULL);
  end module;

  # Try to find an eliminate (by evaluation, or simplification) integrals which
  # are free of `applyintegrand`s.
  elim_intsum := module ()
    export ModuleApply := proc(inert0, h :: name, kb :: t_kb, $)
       local ex, un_elim, e1, inert := inert0, done_e := false;

       un_elim := subsindets(inert, specfunc('ELIMED'), x->op(1,x));
       if un_elim <> inert then
         inert := un_elim; done_e := true;
       end if;

       ex := extract_elim(inert, h);
       e1 := apply_elim(h, kb, ex);
       e1 := check_elim(inert, e1);
       if e1 = FAIL then
         `if`(done_e,ELIMED,_->_)(inert)
       else
         ELIMED(e1)
       end if
    end proc;

    export for_Domain := proc(h, kind, e, vn, vt, kb, $)
       ModuleApply(Domain:-Apply:-do_mk(args[2..-1]), h, kb);
    end proc;

    local extract_elim := proc(e, h::name, $)
      local t, intapps, var, f, e_k, e_args;
      t := 'applyintegrand'('identical'(h), 'anything');
      intapps := indets(op(1,e), t);
      if intapps = {} then
        return FAIL;
      end if;
      e_k := op(0,e); e_args := op([2..-1],e);

      if Domain:-Has:-Bound(e) then
        var := Domain:-ExtBound[e_k]:-ExtractVar(e_args);
        ASSERT(var::DomBoundVar);
        if var :: list then var := op(1,var) end if;

        if not depends(intapps, var) then
          f := Domain:-ExtBound[e_k]:-EvalInCtx;
        else
          return FAIL;
        end if;
      end if;

      [ op(1,e), f, var, [e_args] ];
    end proc;

    local apply_elim := proc(h::name,kb::t_kb,todo::{list,identical(FAIL)})
      local body, f, var, rrest;
      if todo = FAIL then return FAIL; end if;
      body, f, var, rrest := op(todo);
      banish(body, h, kb, infinity, var,
             proc (kb1,g,$) do_elim_intsum(kb1, f, g, op(rrest)) end proc);
    end proc;

    local check_elim := proc(e, elim,$)
      if has(elim, {MeijerG, undefined, FAIL}) or e = elim or elim :: SymbolicInfinity then
        return FAIL;
      end if;
      return elim;
    end proc;

    local do_elim_intsum := proc(kb, f, ee, v::{name,name=anything})
      local w, e, x, g, t, r;
      w, e := op(Domain:-Extract:-Shape(ee));
      w := Domain:-Shape:-toConstraints(w);
      e := piecewise_And(w, e, 0);
      e := f(e,v,_rest,kb);
      x := `if`(v::name, v, lhs(v));
      g := '{sum, sum_assuming, sums}';
      if f in g then
        t := {'identical'(x),
              'identical'(x) = 'Not(range(Not({SymbolicInfinity, undefined})))'};
      else
        g := '{int, int_assuming, ints}';
        t := {'identical'(x),
              'identical'(x) = 'anything'};
        if not f in g then g := {f} end if;
      end if;
      for r in indets(e, 'specfunc'(g)) do
        if 1<nops(r) and op(2,r)::t then return FAIL end if
      end do;
      e
    end proc;

  end module;

# Step 2 of 3: computer algebra

  improve := proc(lo :: LO(name, anything), {_ctx :: t_kb := empty}, opts := [], $)
  local r, `&context`;
       userinfo(5, improve, "input: ", print(lo &context _ctx));
       r:= LO(op(1,lo), reduce(op(2,lo), op(1,lo), _ctx, opts));
       userinfo(5, improve, "output: ", print(r));
       r
  end proc;

  # Walk through integrals and simplify, recursing through grammar
  # h - name of the linear operator above us
  # kb - domain information
  reduce := proc(ee, h :: name, kb :: t_kb, opts := [], $)
    local e, elim, subintegral, w, ww, x, c, kb1, with_kb1, dom_specw, dom_specb
         , body, dom_spec, ed, mkDom, vars, rr
         , do_domain := evalb( not ( "no_domain" in {op(opts)} ) ) ;
    e := ee;

    if do_domain then
      rr := reduce_Integrals(e, h, kb, opts);
      if rr <> FAIL then return rr end if;
    end if;
    if e :: 'applyintegrand(anything, anything)' then
      map(simplify_assuming, e, kb)
    elif e :: `+` then
      map(reduce, e, h, kb, opts)
    elif e :: `*` then
      (subintegral, w) := selectremove(depends, e, h);
      if subintegral :: `*` then error "Nonlinear integral %1", e end if;
      subintegral := convert(reduce(subintegral, h, kb, opts), 'list', `*`);
      (subintegral, ww) := selectremove(depends, subintegral, h);
      nub_piecewise(simplify_factor_assuming(`*`(w, op(ww)), kb))
        * `*`(op(subintegral));
    elif e :: Or(Partition,t_pw) then
      if e :: t_pw then e := PWToPartition(e); end if;
      e := Partition:-Flatten(e);
      e := kb_Partition(e, kb, simplify_assuming,
                        ((rhs, kb) -> %reduce(rhs, h, kb, opts)));
      e := eval(e, %reduce=reduce);
      # big hammer: simplify knows about bound variables, amongst many
      # other things
      Testzero := x -> evalb(simplify(x) = 0);
      e := PartitionToPW(e);
      e := nub_piecewise(e);
      if ee::Partition and e :: t_pw then
        e := Partition:-PWToPartition(e,'do_solve');
      end if;
      e;
    elif e :: t_case then
      subsop(2=map(proc(b :: Branch(anything, anything))
                     eval(subsop(2='reduce'(op(2,b),x,c,opts),b),
                          {x=h, c=kb})
                   end proc,
                   op(2,e)),
             e);
    elif e :: 'Context(anything, anything)' then
      kb1 := assert(op(1,e), kb);
      # A contradictory `Context' implies anything, so produce 'anything'
      # In particular, 42 :: t_Hakaru = false, so a term under a false
      # assumption should never be inspected in any way.
      if kb1 :: t_not_a_kb then
          return 42
      end if;
      applyop(reduce, 2, e, h, kb1, opts);
    elif e :: 'toLO:-integrate(anything, Integrand(name, anything), list)' then
      x := gensym(op([2,1],e));
      # If we had HType information for op(1,e),
      # then we could use it to tell kb about x.
      subsop(2=Integrand(x, reduce(subs(op([2,1],e)=x, op([2,2],e)), h, kb, opts)), e)
    else
      simplify_assuming(e, kb)
    end if;
  end proc;

  reduce_Integrals_post := proc(h,kb,opts,dvars,mkDom,body)
    local vars, e
      , ed := mkDom(body)
      , ee := subsindets(ed, specfunc(ELIMED), x->op(1,x))
      , do_r :=
          op(1,
           [ map(x->op(2,x),select(x->x::list and op(1,x)="reduce_on", opts))[]
           , reduce_on_prod ]);
    if ed = ee then
      vars := indets(Domain:-Bound:-varsOf(dvars), name);
      ed := do_r(mkDom, body, vars, kb);
    else
      ed := reduce(ee,h,kb,opts);
    end if;
    kb_assuming_mb(Partition:-Simpl)(ed, kb, x->x);
  end proc;

  # "Integrals" refers to any types of "integrals" understood by domain (Int,
  # Sum currently)
  reduce_Integrals := proc(expr, h, kb, opts, $)
    local rr;
    rr := Domain:-Fold(expr, kb
      ,proc() elim_intsum:-for_Domain(h,args) end proc
      ,((x,kb1)->reduce(x,h,kb1,opts))
      , proc() reduce_Integrals_post(h,kb,opts,args) end proc
      ,(_->:-DOM_FAIL));

    if has(rr, :-DOM_FAIL) then
      return FAIL;
    elif has(rr, FAIL) then
      error "Something strange happened in reduce_Integral(%a, %a, %a, %a)\n%a"
          , expr, kb, kb, opts, rr;
    else
      return rr;
    end if
  end proc;

  # Helper function for performing reductions
  # given an "ee" and a "var", pulls the portion
  # of "ee" not depending on "var" out, and applies "f"
  # to the portion depending on "var".
  # the 'weights' (factors not depending on "var") are simplified
  # under the given assumption context, "kb0"
  reduce_on_sum := proc(f,ee,var,kb0,$)
    `+`(map(s->reduce_on_prod(f,s,var,kb0), convert(expand(ee), 'list', `+`))[]);
  end proc;
  reduce_on_prod := proc(f,ee, var:: {name, list(name), set(name)} ,kb0::t_kb,$)
      local e := ee, w;
      e, w := selectremove(x->depends(x,var) or x :: realcons, list_of_mul(e));
      nub_piecewise(simplify_factor_assuming(`*`(op(w)), kb0)) * f(`*`(op(e))) ;
  end proc;

  int_assuming := proc(e, v::name=anything, kb::t_kb, $)
    simplify_factor_assuming('int'(e, v), kb);
  end proc;

  sum_assuming := proc(e, v::name=anything, kb::t_kb)
    simplify_factor_assuming('sum'(e, v), kb);
  end proc;

  nub_piecewise := proc(pw, $) # pw may or may not be piecewise
    foldr_piecewise(piecewise_if, 0, pw)
  end proc;

  piecewise_if := proc(cond, th, el, $)
    # piecewise_if should be equivalent to `if`, but it produces
    # 'piecewise' and optimizes for when the 3rd argument is 'piecewise'
    if cond = true then
      th
    elif cond = false or Testzero(th - el) then
      el
    elif el :: t_pw then
      if nops(el) >= 2 and Testzero(th - op(2,el)) then
        applyop(Or, 1, el, cond)
      elif nops(el) = 2 then
        piecewise(cond, th, op(el), 0)
      else
        piecewise(cond, th, op(el))
      end if
    elif Testzero(el) then
      piecewise(cond, th)
    else
      piecewise(cond, th, el)
    end if
  end proc;

  # Int( .., var=var_ty ) == var &X var_ty
  isBound_IntSum := kind -> module()
    option record;

    export MakeKB := (`if`(kind=Sum,KB:-genSummation,KB:-genLebesgue));
    export ExtractVar := (e->op(1,e));
    export ExtractRange := (e->op(2,e));
    export MakeRange := `..`;
    export SplitRange := (e->op(e));
    export Constrain := `if`(kind=Sum,`<=`,`<`);
    export DoMk := ((e,v,t)->kind(e,v=t));
    export EvalInCtx    := `if`(kind=Sum,'sum_assuming','int_assuming');
    export Min := `min`; export Max := `max`;
    export VarType := 'name';
    export RangeType := 'range';
    export MapleType := 'And'('specfunc'(kind), 'anyfunc(anything,name=range)');
    export BoundType := `if`(kind=Sum,'integer','real');
    export RecogBound := `if`(kind=Sum,
              (proc(k,b)
                 if   k = `<=` then (x->subsop(2=b,x))
                 elif k = `>=` then (x->subsop(1=b,x))
                 elif k = `<`  then (x->subsop(2=(b-1),x))
                 elif k = `>`  then (x->subsop(1=b+1,x))
                 end if;
               end proc),
              (proc(k,b)
                 if   k in {`<=`,`<`} then (x->subsop(2=b,x))
                 elif k in {`>=`,`>`} then (x->subsop(1=b,x))
                 end if;
               end proc));
  end module;

  # Ints( .., var::name, var_ty::range, dims::list(name=range) ) ==
  #        [ var   , map(lhs,dims) ] :: list(name)  &X
  #        [ var_ty, map(rhs,dims) ] :: list(range)
  isBound_IntsSums := kind -> module()
    option record;

    export MakeKB := proc(vars, lo, hi, kb, $)
      local var, dims, ty, rngs, x, kb1;
      var  := op(1, vars);
      rngs := zip(`..`,lo,hi);
      ty   := op(1, rngs);
      dims := subsop(1=NULL,zip(`=`,vars,rngs));

      x, kb1 := genType(var,
                        mk_HArray(`if`(kind=Ints,
                                       HReal(open_bounds(ty)),
                                       HInt(closed_bounds(ty))),
                                  dims),kb);
      if nops(dims) > 0 then
        kb1 := assert(size(x)=op([-1,2,2],dims)-op([-1,2,1],dims)+1, kb1);
      end if;
      x, kb1;
    end proc;
    export ExtractVar   := ((v,t,d)->[v,map(lhs,d)[]]);
    export ExtractRange := ((v,t,d)->[t,map(rhs,d)[]]);
    export MakeRange    := ((a,b)->zip(`..`,a,b));
    export SplitRange   := (rs->(map(x->op(1,x),rs), map(x->op(2,x),rs)));
    export Constrain    := ((a,b)->zip(`if`(kind=Ints, `<`, `<=`),a,b)[]);
    export DoMk         := ((e,v,t)->kind( e,op(1,v),op(1,t), subsop(1=NULL,zip(`=`,v,t)) ));
    export EvalInCtx    := `if`(kind=Ints,'ints','sums');
    export Min          := ((a,b)->zip(`min`,a,b));
    export Max          := ((a,b)->zip(`max`,a,b));
    export VarType      := 'And(list(name),satisfies(x->x<>[]))';
    export RangeType    := 'And(list(range),satisfies(x->x<>[]))';
    export MapleType    := 'And'('specfunc'(kind),'anyfunc'('anything', 'name', 'range', 'list(name=range)'));
    export BoundType    := TopProp;
    export RecogBound   := (_->NULL);
  end module;

  # Try to find an eliminate (by evaluation, or simplification) integrals which
  # are free of `applyintegrand`s.
  elim_intsum := module ()
    export ModuleApply := proc(inert0, h :: name, kb :: t_kb, $)
       local ex, un_elim, e1, inert := inert0, done_e := false;

       un_elim := subsindets(inert, specfunc('ELIMED'), x->op(1,x));
       if un_elim <> inert then
         inert := un_elim; done_e := true;
       end if;

       ex := extract_elim(inert, h);
       e1 := apply_elim(h, kb, ex);
       e1 := check_elim(inert, e1);
       if e1 = FAIL then
         `if`(done_e,ELIMED,_->_)(inert)
       else
         ELIMED(e1)
       end if
    end proc;

    export for_Domain := proc(h, kind, e, vn, vt, kb, $)
       ModuleApply(Domain:-Apply:-do_mk(args[2..-1]), h, kb);
    end proc;

    local extract_elim := proc(e, h::name, $)
      local t, intapps, var, f, e_k, e_args;
      t := 'applyintegrand'('identical'(h), 'anything');
      intapps := indets(op(1,e), t);
      if intapps = {} then
        return FAIL;
      end if;
      e_k := op(0,e); e_args := op([2..-1],e);

      if Domain:-Has:-Bound(e) then
        var := Domain:-ExtBound[e_k]:-ExtractVar(e_args);
        ASSERT(var::DomBoundVar);
        if var :: list then var := op(1,var) end if;

        if not depends(intapps, var) then
          f := Domain:-ExtBound[e_k]:-EvalInCtx;
        else
          return FAIL;
        end if;
      end if;

      [ op(1,e), f, var, [e_args] ];
    end proc;

    local apply_elim := proc(h::name,kb::t_kb,todo::{list,identical(FAIL)})
      local body, f, var, rrest;
      if todo = FAIL then return FAIL; end if;
      body, f, var, rrest := op(todo);
      banish(body, h, kb, infinity, var,
             proc (kb1,g,$) do_elim_intsum(kb1, f, g, op(rrest)) end proc);
    end proc;

    local check_elim := proc(e, elim,$)
      if has(elim, {MeijerG, undefined, FAIL}) or e = elim or elim :: SymbolicInfinity then
        return FAIL;
      end if;
      return elim;
    end proc;

    local do_elim_intsum := proc(kb, f, ee, v::{name,name=anything})
      local w, e, x, g, t, r;
      w, e := op(Domain:-Extract:-Shape(ee));
      w := Domain:-Shape:-toConstraints(w);
      e := piecewise_And(w, e, 0);
      e := f(e,v,_rest,kb);
      x := `if`(v::name, v, lhs(v));
      g := '{sum, sum_assuming, sums}';
      if f in g then
        t := {'identical'(x),
              'identical'(x) = 'Not(range(Not({SymbolicInfinity, undefined})))'};
      else
        g := '{int, int_assuming, ints}';
        t := {'identical'(x),
              'identical'(x) = 'anything'};
        if not f in g then g := {f} end if;
      end if;
      for r in indets(e, 'specfunc'(g)) do
        if 1<nops(r) and op(2,r)::t then return FAIL end if
      end do;
      e
    end proc;

  end module;


Call `reparam' from `ReparamDetermined' properly

  ReparamDetermined := proc(lo :: LO(name, anything), kb::t_kb)
    local h;
    h := op(1,lo);
    LO(h,
       evalindets(op(2,lo),
                  'And'('specfunc({Int,int})',
                        'anyfunc'(anything, 'name=anything')),
                  g -> `if`(determined(op(1,g),h), reparam(g,h,kb), g)))
  end proc;

  determined := proc(e, h :: name)
    local i;
    for i in indets(e, 'specfunc({Int,int})') do
      if hastype(IntegrationTools:-GetIntegrand(i),
           'applyintegrand'('identical'(h),
             'dependent'(IntegrationTools:-GetVariable(i)))) then
        return false
      end if
    end do;
    return true
  end proc;

  #Beginning of Carl's code devoted to disintegration and the reparametrization (aka change
  #of variables) of integrals and sums.

  #Finds the innermost Ints or Sums in an expression, that is, those which
  #don't contain further Ints or Sums
  innermostIntSum:= proc(e::anything, $)::set(specfunc({Int,Sum}));
    select(IS-> nops(indets(IS, specfunc({Int,Sum}))) = 1, indets(e, specfunc({Int,Sum})))
  end proc;

  #my substitute for IntegrationTools:-Change
  ChangeVarInt:= proc(J::specfunc(Int), target::algebraic, $)
    local
    newJ, #What J will become.
    x::name:= op([2,1], J),
    u::name:= gensym(x),    #new variable of integration
    s,                      #What x will become
    F                       #Boolean: flip integral?
    ;
    s:= {solve({u = target}, {x})};
    if nops(s) = 0 then
      userinfo(1, 'reparam', "Can't solve substitution target.");
      return J
    end if;
    if nops(s) > 1 then
      userinfo(1, 'reparam', "Case of multi-branched substitution not handled.");
      return J
    end if;
    s:= s[];

    newJ:= Int(
      eval(implicitdiff(u = target, x, u)*op(1,J), s),
      u=
      limit(target, x= op([2,2,1], J), right).. #lower limit
      limit(target, x= op([2,2,2], J), left),   #upper limit
      op(3.., J) #optional Int args (unlikely to be used)
      );

    #If lower limit > upper limit, then flip limits of integration.
    F:= is(op([2,2,1], newJ) > op([2,2,2], newJ));
    if F::truefalse then
      if F then
        userinfo(2, reparam, "Switching limits:", op([2,2], newJ));
        newJ:= IntegrationTools:-Flip(newJ)
      end if
    else #If inequality can't be decided, then don't reverse.
      userinfo(1, reparam, "Can't order new limits:", op([2,2], newJ))
    end if;
    newJ
  end proc;

  #main procedure for int/sum reparamterizations
  reparam:= proc(e::algebraic, h::symbol, ctx::{list,t_kb}:= [], $)
    local
    J:= innermostIntSum(e),   #the integral or sum
    newJ, #What J will become possible subs target(s)
    oldarg:=
    map2(op, 2, indets(e, specfunc(applyintegrand))),
    kb := build_kb(ctx,"reparam"),
    newarg, Jbnds, del
    ;
    if not(oldargs::{algebraic, set(algebraic), list(algebraic)}) then
      userinfo(2, 'procname', "Unexpected arguements to applyintegrand");
      return e;
    end if;
    if nops(J) = 0 then
      userinfo(2, 'procname', "No sum or integral found.");
      return e
    end if;
    if nops(J) > 1 then
      userinfo(1, 'procname', "Case of multiple innermost Int or Sums not yet handled.");
      return e
    end if;
    J:= J[];
    if J::specfunc(Sum) then
      userinfo(1, 'procname', "Sums not yet handled.");
      return e
    end if;
    if hastype(op(1,J), t_pw_or_part) then
      userinfo(1, 'procname', "Reparam of piecewise body not yet handled.");
      return e;
    end if;
    if nops(oldarg) <> 1 then
      userinfo(1, 'procname', "More than 1 reparam possible:", oldarg);
      return e
    end if;
    oldarg:= oldarg[];   #Extract the reparam target.

    Jbnds := op([2,2], J);
    del := simplify_assuming(op(2,Jbnds)-op(1,Jbnds), kb);
    if del in {-1,1} then
      userinfo(2, 'procname', "No need for a reparameterization (bound diff is 1).");
      return e;
    end if;
    if has(Jbnds, infinity) then
      userinfo(2, 'procname', "Reparam of infinity bounds probably won't work.");
      return e;
    end if;

    # if the arg to applyintegrand is not a variable or a datum or an index
    # into an array
    if oldarg::And(Not({symbol, function, indexed, list})) then
      newarg := oldarg;
    # if the bounds don't contain infinity, do not have a difference of 1
    # and contain a product of that variable
    elif oldarg::symbol and
         op(1,J)::`*`   and
         select(type, [op(op(1,J))], identical(oldarg))<>[]
    then
      newarg := oldarg/del;
    else
      userinfo(2, 'procname', "No need for a reparameterization.");
      return e
    end if;

    #Make the change of vars.
    newJ:= kb_assuming_mb(ChangeVarInt@op, [J, newarg], kb, _->FAIL);

    if newJ = 0 or not(newJ::specfunc(Int)) or newJ=FAIL then
      userinfo(
        1, 'procname',
        printf(
          "Invalid reparam, likely due to improper handling of an infinity issue.\n"
          "u subs:%a",
          #Reformat the ChangeVarInt command for readability.
          subs(
            x= ':-x',
            'ChangeVarInt'(
              subsindets(
                J,
                   specfunc(applyintegrand),
                f-> ':-h'(op(2,f)))),
            newarg)));
      return e;
    end if;
    subs(J= newJ, e)
  end proc;

  ReparamDetermined := proc(lo :: LO(name, anything))
    local h;
    h := op(1,lo);
    LO(h,
       evalindets(op(2,lo),
                  'And'('specfunc({Int,int})',
                        'anyfunc'(anything, 'name=anything')),
                  g -> `if`(determined(op(1,g),h), Reparam(g,h), g)))
  end proc;

  determined := proc(e, h :: name)
    local i;
    for i in indets(e, 'specfunc({Int,int})') do
      if hastype(IntegrationTools:-GetIntegrand(i),
           'applyintegrand'('identical'(h),
             'dependent'(IntegrationTools:-GetVariable(i)))) then
        return false
      end if
    end do;
    return true
  end proc;

  #Beginning of Carl's code devoted to disintegration and the reparametrization (aka change
  #of variables) of integrals and sums.

  #Finds the innermost Ints or Sums in an expression, that is, those which
  #don't contain further Ints or Sums
  innermostIntSum:= proc(e::anything, $)::set(specfunc({Int,Sum}));
    select(IS-> nops(indets(IS, specfunc({Int,Sum}))) = 1, indets(e, specfunc({Int,Sum})))
  end proc;

  #my substitute for IntegrationTools:-Change
  ChangeVarInt:= proc(J::specfunc(Int), target::algebraic, $)
    local
    newJ, #What J will become.
    x::name:= op([2,1], J),
    u::name:= gensym(x),    #new variable of integration
    s,                      #What x will become
    F                       #Boolean: flip integral?
    ;
    s:= {solve({u = target}, {x})};
    if nops(s) = 0 then
      userinfo(1, 'reparam', "Can't solve substitution target.");
      return J
    end if;
    if nops(s) > 1 then
      userinfo(1, 'reparam', "Case of multi-branched substitution not handled.");
      return J
    end if;
    s:= s[];

    newJ:= Int(
      eval(implicitdiff(u = target, x, u)*op(1,J), s),
      u=
      limit(target, x= op([2,2,1], J), right).. #lower limit
      limit(target, x= op([2,2,2], J), left),   #upper limit
      op(3.., J) #optional Int args (unlikely to be used)
      );

    #If lower limit > upper limit, then flip limits of integration.
    F:= is(op([2,2,1], newJ) > op([2,2,2], newJ));
    if F::truefalse then
      if F then
        userinfo(2, reparam, "Switching limits:", op([2,2], newJ));
        newJ:= IntegrationTools:-Flip(newJ)
      end if
    else #If inequality can't be decided, then don't reverse.
      userinfo(1, reparam, "Can't order new limits:", op([2,2], newJ))
    end if;
    newJ
  end proc;

  #main procedure for int/sum reparamterizations
  reparam:= proc(e::LO(symbol, algebraic), ctx::{list,t_kb}:= [], $)
    local
    J:= innermostIntSum(e),   #the integral or sum
    newJ, #What J will become possible subs target(s)
    oldarg:=
    map2(op, 2, indets(e, specfunc(applyintegrand))),
    kb := build_kb(ctx,"reparam"),
    newarg, Jbnds, del
    ;
    if not(oldargs::{algebraic, set(algebraic), list(algebraic)}) then
      userinfo(2, 'procname', "Unexpected arguements to applyintegrand");
      return e;
    end if;
    if nops(J) = 0 then
      userinfo(2, 'procname', "No sum or integral found.");
      return e
    end if;
    if nops(J) > 1 then
      userinfo(1, 'procname', "Case of multiple innermost Int or Sums not yet handled.");
      return e
    end if;
    J:= J[];
    if J::specfunc(Sum) then
      userinfo(1, 'procname', "Sums not yet handled.");
      return e
    end if;
    if hastype(op(1,J), t_pw_or_part) then
      userinfo(1, 'procname', "Reparam of piecewise body not yet handled.");
      return e;
    end if;
    if nops(oldarg) <> 1 then
      userinfo(1, 'procname', "More than 1 reparam possible:", oldarg);
      return e
    end if;
    oldarg:= oldarg[];   #Extract the reparam target.

    Jbnds := op([2,2], J);
    del := simplify_assuming(op(2,Jbnds)-op(1,Jbnds), kb);
    if del in {-1,1} then
      userinfo(2, 'procname', "No need for a reparameterization (bound diff is 1).");
      return e;
    end if;
    if has(Jbnds, infinity) then
      userinfo(2, 'procname', "Reparam of infinity bounds probably won't work.");
      return e;
    end if;

    # if the arg to applyintegrand is not a variable or a datum or an index
    # into an array
    if oldarg::And(Not({symbol, function, indexed, list})) then
      newarg := oldarg;
    # if the bounds don't contain infinity, do not have a difference of 1
    # and contain a product of that variable
    elif oldarg::symbol and
         op(1,J)::`*`   and
         select(type, [op(op(1,J))], identical(oldarg))<>[]
    then
      newarg := oldarg/del;
    else
      userinfo(2, 'procname', "No need for a reparameterization.");
      return e
    end if;

    #Make the change of vars.
    newJ:= kb_assuming_mb(ChangeVarInt@op, [J, newarg], kb, _->FAIL);

    if newJ = 0 or not(newJ::specfunc(Int)) or newJ=FAIL then
      userinfo(
        1, 'procname',
        printf(
          "Invalid reparam, likely due to improper handling of an infinity issue.\n"
          "u subs:%a",
          #Reformat the ChangeVarInt command for readability.
          subs(
            x= ':-x',
            'ChangeVarInt'(
              subsindets(
                J,
                   specfunc(applyintegrand),
                f-> ':-h'(op(2,f)))),
            newarg)));
      return e;
    end if;
    subs(J= newJ, e)
  end proc;