Domain:-Apply shouldn't do any solving/simplification

# Apply a domain to an expression.
# Apply will perform certain 'simplifications' to make sure the
# domain application is well-formed. e.g.,
#   DOMAIN( DBound( [x,y], [xt,yt] ), DConstrain(..) )
#      is the same as
#   DOMAIN(        ..               , DInto(x,xt,DInto(y,yt,DConstrain(..))) )
# basically, when we see an 'unbound' variable in the 'RHS' , we should bind
# it with the default 'DInto'.
export Apply := module ()
       export ModuleApply := proc(dom :: HDomain_mb, $)
           local vs, sh, `expression body`;
           if dom :: DomNoSol then
               error "cannot apply %1", dom;
           end if;
           vs, sh := op(dom);
           unapply(do_apply({}, `expression body`, vs, sh), `expression body`);
       end proc;

       export Shape := proc(dsh :: DomShape, e, $) ModuleApply( DOMAIN( [], dsh ), e ) end proc;
       export Bound := proc(dbn :: DomBound, e, $) ModuleApply( DOMAIN( dbn, DConstrain() ), e ) end proc;

       # main loop of the apply function
       # e     := expr
       # vs    := variables
       # vs_ty := domain bounds (as a kb)
       # sh    := domain shape
       local do_apply := proc(done__, e, vs, sh_, $)
           local sh := sh_, done_ := done__
               , cond, r, vs_td, v_td, vn_td, vt_td, vt_mk, vn, vt, shv, vars, deps
               , e1, v, vvn, vvt, vmk,  with_kb1 ;
           # If the solution is a constraint, and the constraint is true,
           # then just produce the expression. If it isn't necessarily true
           # (i.e. trivial) then produce a Partition with the constraint as a
           # guard.
           if sh :: DomConstrain then
               cond := `and`(op(sh));
               if is(cond) then
                   r := e
               else
                   r := piecewise(cond,e,0);
               end if;
               # if there are still integrals which have not been applied,
               # apply them now
               vs_td := select(x -> not(op(1, x) in done_), op(1, vs));
               for v_td in vs_td do
                   vn_td, vt_td, vt_mk := op(v_td);
                   r := do_mk(r, vn_td, vt_td, vt_mk);
               end do;
               r;
           # if the solution is a sum of solutions, produce the algebraic sum
           # of each summand of the solution applied to the expression.
           elif sh :: DomSum then
               `+`(seq(do_apply(done_, e, vs, s), s=sh))
           # if the solution is a split solution, just make `do_apply' over
           # the values of the Partition (the subsolutions)
           elif sh :: DomSplit then
               sh := op(1, sh);
               Partition:-Pmap(p-> do_apply(done_, e, vs, p), sh);
           # performs the 'make' on the expression after recursively
           # applying the solution
           elif sh :: DomInto then
               # deconstruction
               vn, vt, shv := op(sh);
               # extract bounds which have not been applied upon which this
               # bound depends. Those are applied after this one, so are not
               # in 'scope' in the recursive call
               vars := {op(Domain:-Bound:-varsOf(vs))};
               deps := (indets(vt, name) intersect vars) minus done_ ;
               done_ := `union`(done_, deps, {vn}) ;
               # recursively apply
               e1 := do_apply(done_, e, vs, shv);
               # build this integral, and the other this one depended on
               for v in op(1,vs) do
                   vvn, vvt, vmk := op(v);
                   if vvn in deps then
                       e1 := do_mk(e1, vvn, vvt, vmk);
                   elif vvn = vn then
                       e1 := do_mk(e1, vvn,  vt, vmk);
                   end if;
               end do;
               e1;
           else
               error "don't know how to apply %1", sh
           end if;
       end proc;

       local do_mk := proc(e, vn, ty_, mk, $)
           mk(e, Domain:-ExtBound[mk]:-MakeEqn(vn, ty_));
       end proc;
end module;

# Apply a domain to an expression.
# Apply will perform certain 'simplifications' to make sure the
# domain application is well-formed. e.g.,
#   DOMAIN( DBound( [x,y], [xt,yt] ), DConstrain(..) )
#      is the same as
#   DOMAIN(        ..               , DInto(x,xt,DInto(y,yt,DConstrain(..))) )
# basically, when we see an 'unbound' variable in the 'RHS' , we should bind
# it with the default 'DInto'.
export Apply := module ()
       export ModuleApply := proc(dom :: HDomain_mb, $)
           local vs, sh, `expression body`;
           if dom :: DomNoSol then
               error "cannot apply %1", dom;
           end if;
           vs, sh := op(dom);
           unapply(do_apply({}, `expression body`, vs, sh), `expression body`);
       end proc;

       export Shape := proc(dsh :: DomShape, e, $) ModuleApply( DOMAIN( [], dsh ), e ) end proc;
       export Bound := proc(dbn :: DomBound, e, $) ModuleApply( DOMAIN( dbn, DConstrain() ), e ) end proc;

       # main loop of the apply function
       # e     := expr
       # vs    := variables
       # vs_ty := domain bounds (as a kb)
       # sh    := domain shape
       local do_apply := proc(done__, e, vs, sh_, $)
           local sh := sh_, done_ := done__
               , cond, r, vs_td, v_td, vn_td, vt_td, vt_mk, vn, vt, shv, vars, deps
               , e1, v, vvn, vvt, vmk,  with_kb1 ;
           # If the solution is a constraint, and the constraint is true,
           # then just produce the expression. If it isn't necessarily true
           # (i.e. trivial) then produce a Partition with the constraint as a
           # guard.
           if sh :: DomConstrain then
               cond := `and`(op(sh));
               if is(cond) then
                   r := e
               else
                   r := PARTITION([Piece(cond,e), Piece(Not(cond),e)]);
               end if;
               # if there are still integrals which have not been applied,
               # apply them now
               vs_td := select(x -> not(op(1, x) in done_), op(1, vs));
               for v_td in vs_td do
                   vn_td, vt_td, vt_mk := op(v_td);
                   r := do_mk(r, vn_td, vt_td, vt_mk);
               end do;
               r;
           # if the solution is a sum of solutions, produce the algebraic sum
           # of each summand of the solution applied to the expression.
           elif sh :: DomSum then
               `+`(seq(do_apply(done_, e, vs, s), s=sh))
           # if the solution is a split solution, just make `do_apply' over
           # the values of the Partition (the subsolutions)
           elif sh :: DomSplit then
               sh := op(1, sh);
               Partition:-Pmap(p-> do_apply(done_, e, vs, p), sh);
           # performs the 'make' on the expression after recursively
           # applying the solution
           elif sh :: DomInto then
               # deconstruction
               vn, vt, shv := op(sh);
               # extract bounds which have not been applied upon which this
               # bound depends. Those are applied after this one, so are not
               # in 'scope' in the recursive call
               vars := {op(Domain:-Bound:-varsOf(vs))};
               deps := (indets(vt, name) intersect vars) minus done_ ;
               done_ := `union`(done_, deps, {vn}) ;
               # recursively apply
               e1 := do_apply(done_, e, vs, shv);
               # build this integral, and the other this one depended on
               for v in op(1,vs) do
                   vvn, vvt, vmk := op(v);
                   if vvn in deps then
                       e1 := do_mk(e1, vvn, vvt, vmk);
                   elif vvn = vn then
                       e1 := do_mk(e1, vvn,  vt, vmk);
                   end if;
               end do;
               e1;
           else
               error "don't know how to apply %1", sh
           end if;
       end proc;

       local do_mk := proc(e, vn, ty_, mk, $)
           mk(e, Domain:-ExtBound[mk]:-MakeEqn(vn, ty_));
       end proc;
end module;


Bug fix

Bug fix

constraints_about_vars := module()
  uses SolveTools[Inequality];
  export SimplName  := "Make constraints abouts vars";
  export SimplOrder := 6;

    export ModuleApply := proc(vs0 :: DomBound, sh :: DomShape, $)
        local vs := vs0, ctx;
        vs  := {op(Domain:-Bound:-varsOf(vs))};
        ctx := Domain:-Bound:-toConstraints(vs0, 'bound_types');
        subsindets(sh, DomConstrain
                  ,x->do_simpl_constraints(vs0, vs, ctx, x));
    end proc;

    local do_simpl_constraints := proc(vs0, vars, ctx_vs, x, $)
        local ctx1, ctx, ss, td, rest, d, in_vs;
        ss, ctx := selectremove(q->depends(q,indets(vars,And(name,Not(constant)) )), x);
        in_vs := q-> not(lhs(q) in vars) and not(rhs(q) in vars);
        td, rest := selectremove(type, ss, And(relation,satisfies(in_vs)));
        ctx1 := { op(ctx), op(ctx_vs), op(rest) };
        d := map(x->try_make_about(vs0, vars,ctx1,x), td);
        DConstrain(op(d), op(ctx), op(rest));
    end proc;

    local try_make_about := proc(dbnd, vars, ctx1, q0, $)
        local vars_q, q_s, q := q0;
        vars_q := indets(q, name) intersect vars;
        if nops(vars_q)=0 then return q end if;

        vars_q := op(1,vars_q);
        q := KB:-try_improve_exp(q, vars_q, ctx1);

        try
          q_s := LinearUnivariate(q, vars_q) assuming (op(ctx1));
          if q_s :: set(relation) and nops(q_s)=1 then
            op(1,q_s)
          else
            q
          end if;
        catch "when calling '%2'. Received: 'inequality must be linear in %1'":
          q_s := 'solve({q},[op(vars_q)], 'useassumptions'=true) assuming (op(ctx1))';
          q_s := eval(q_s);
          if q_s::list then
            if nops(q_s)=0 then return q end if;
            q_s := map(s->remove(c->c in ctx1 or `and`(c::relation,lhs(c)::name,lhs(c)=rhs(c)), s), q_s);
            q_s := remove(x->x=[],q_s);
            if nops(q_s)=0 then return q end if;
            op(op(1,q_s)); # pick the first solution arbitrarily!
          else
            q
          end if;
        end try;
    end proc;
end module;

# Pushes constraints down, or pulls them up, when there are such constraints.
local do_ctx_dir := dir -> proc(vs :: DomBound, sh :: DomShape, $)
    local ctx := `if`(nops(vs)=2,op(2,vs),{});
    ctx := remove(x->x::`::`,ctx);
    if ctx <> {} then
        dir(ctx)(sh);
    else
        sh;
    end if;
end proc;

push_ctx_down := module()
  export ModuleApply := do_ctx_dir(ctx->sh->subsindets(sh, DomConstrain, x->if nops(x)<>0 then DConstrain(op(x), op(ctx)) else DConstrain() end if));
  export SimplName  := "Push context down";
  export SimplOrder := 1;
end module;

pull_ctx_out := module()
  export ModuleApply :=
    do_ctx_dir(ctx->sh->subsindets(sh, DomConstrain
              ,x->remove(c->c in ctx or (is(c) assuming op(ctx)), x)));
  export SimplName  := "Pull context out";
  export SimplOrder := 20;
end module;

# Turns constraints(relations) into bounds
classify_DConstrains := module()

  export SimplName  := "Classify constraints";
  export SimplOrder := 8;

  export ModuleApply := proc(dbnds::DomBound,dsh::DomShape,$)

    subsindets(dsh, DomConstrain, x->classify_Rels([op(x)], dbnds));

  end proc;

  # Split relations into those we can incorporate
  # into bounds and others; this process also includes
  # some intermediate computations about the new bound:
  #  [ DInto(var), orig, upd_bound, bound_kind, numVars ]
  #    var         :=   variable to be modified
  #    orig        :=   the original relation
  #    upd_bound   :=   how to modify (a function)
  #    bound_kind  :=   {LO/HI}
  #    numVars     :=   how many variables are mentioned by the bound
  local classify_Rel := proc(r0,dbnd,$)

    local ret, vars, mk_k, bnd_k, i, var_k, q, r := r0;
    ret := [ DConstrain, r0 ]
;
    vars := {Domain:-Bound:-varsOf(dbnd)[]};

    if r :: {`<=`,`<`} then

      if rhs(r) in vars then

        r := op(0,r)(rhs(r),lhs(r));

        mk_k := flip_rel[op(0,r)]; bnd_k := B_LO;

      elif lhs(r) in vars then

        mk_k := op(0,r);           bnd_k := B_HI;

      else

        return ret;
      end if;

      i := Domain:-Bound:-varIx_mb(dbnd, lhs(r));

      if i >= 0 then

        var_k := op([1,i,3], dbnd);

        q := Domain:-ExtBound[var_k]:-RecogBound(mk_k,rhs(r));

        if q <> NULL then

          ret := [ DInto(lhs(r)), r0, q, bnd_k, countVs(vars minus {lhs(r)},r0) ];

        end if;

      end if;

    end if;

    ret;
  end proc;

  # Classifies a set of relations as potential bounds. The process
  # is as follows:
  #  - Classify each relation individually (see classify_Rel)
  #  - "Categorize" by the classification
  #  - Split relations which will be DConstrains, and those where we found
  #      more than one LO/HI bound or more than 2 bounds total.
  #  - Sort the relations which are to become bounds by the number of variables
  #      mentioned in the bound
  #  - Rebuild the continuations producing each new bound (see make_DInto)
  #  - Rebuild the leftover relations as a DConstrain.
  #  - Squash together ("foldr (.) id fs z") the continuations and leftover relations.
  local classify_Rels := proc(rs0,dbnd,$)

    local cs1, cs2, cs, rs := rs0;

    rs := map(r->classify_Rel(r,dbnd), rs);

    rs := [ListTools[Categorize]( ((a,b) -> op(1,a)=op(1,b) ), rs )];

    cs1, rs := selectremove(x->op([1,1],x)=DConstrain, rs);

    rs, cs2 := selectremove(x->nops(x)=1 or (nops(x)=2 and op([1,4],x)<>op([2,4],x)), rs);

    rs := sort(rs, key=(x->(`+`( seq(op(3,z),z=x) ))));

    rs := map(r->make_DInto(r,dbnd),rs);

    cs := DConstrain(map(c->map(q->op(2,q),c)[], [op(cs1),op(cs2)])[]);
    foldr((f,g)->f@g,x->x,op(rs))(cs);

  end proc;

  # Rebuild a classified (by classify_Rel) relation; this
  # takes a list of such classifications, all of whose variable should
  # be identical, and for which the different bound kinds are all distinct.
  # None of this is checked!
  # (since there are 2 bound kinds, this list is at most length 2)
  local make_DInto := proc(r::list([specfunc(DInto),anything,anything,identical(B_LO,B_HI),nonnegint]), dbnd, $)

    local var_nm, var_ty;
    var_nm := op([1,1,1], r);

    var_ty := Domain:-Bound:-get(dbnd, var_nm)[1];

    var_ty := foldr( ((q,x)->op(3,q)(x)), var_ty, op(r) );

    (ctx -> DInto(var_nm, var_ty, ctx))

  end proc;

  local flip_rel := table([`=`=`=`,`<>`=`<>`,`<=`=`>=`,`<`=`>`,`>=`=`<=`,`>`=`<`]);

  local countVs := ((vs,c)-> nops(indets(c, DomBoundVar) intersect {op(vs)} ));

end module;

# todo; this should actually solve for a variable, then substitute
# that variable in. In most cases, it would probably be enough to
# leave that as it is; it would simplify later.
singular_pts := module()
  export SimplName  := "Single_pts";
  export SimplOrder := 14;

    export ModuleApply := proc(bnds_ :: DomBound, sh_ :: DomShape, $)
        local bnds := bnds_, sh := sh_, vs, todo, sh1, vs_ty;
        vs := applyop(bl -> select(b->op(3,b)=`Int`, bl), 1, bnds);
        vs := Domain:-Bound:-varsOf(vs);
        vs_ty := satisfies(x->x in {op(vs)});
        todo := select( x -> nops(x) = 1 and op(1,x) :: `=`
                             # one side mentions exactly one
                             # var, and the other none
                             and nops ( (indets(lhs(op(1,x)), vs_ty))
                                  union (indets(rhs(op(1,x)), vs_ty)) ) = 1
                      , indets(sh, specfunc(`DConstrain`)) ) ;
        subs([seq(t=DSum(),t=todo)], sh);
    end proc;
end module;

constraints_about_vars := module()
  uses SolveTools[Inequality];
  export SimplName  := "Make constraints abouts vars";
  export SimplOrder := 6;

    export ModuleApply := proc(vs0 :: DomBound, sh :: DomShape, $)
        local vs := vs0, ctx;
        vs  := {op(Domain:-Bound:-varsOf(vs))};
        ctx := Domain:-Bound:-toConstraints(vs0, 'bound_types');
        subsindets(sh, DomConstrain
                  ,x->do_simpl_constraints(vs0, vs, ctx, x));
    end proc;

    local do_simpl_constraints := proc(vs0, vars, ctx_vs, x, $)
        local ctx1, ctx, ss, td, rest, d, in_vs;
        ss, ctx := selectremove(q->depends(q,indets(vars,And(name,Not(constant)) )), x);
        in_vs := q-> not(lhs(q) in vars) and not(rhs(q) in vars);
        td, rest := selectremove(type, ss, And(relation,satisfies(in_vs)));
        ctx1 := { op(ctx), op(ctx_vs), op(rest) };
        d := map(x->try_make_about(vs0, vars,ctx1,x), td);
        DConstrain(op(d), op(ctx), op(rest));
    end proc;

    local try_make_about := proc(dbnd, vars, ctx1, q0, $)
        local vars_q, q_s, q := q0;
        vars_q := indets(q, name) intersect vars;
        if nops(vars_q)=0 then return q end if;

        vars_q := op(1,vars_q);
        q := KB:-try_improve_exp(q, vars_q, ctx1);

        try
          q_s := LinearUnivariate(q, vars_q) assuming (op(ctx1));
          if q_s :: set(relation) and nops(q_s)=1 then
            op(1,q_s)
          else
            q
          end if;
        catch "when calling '%2'. Received: 'inequality must be linear in %1'":
          q_s := 'solve({q},[op(vars_q)], 'useassumptions'=true) assuming (op(ctx1))';
          q_s := eval(q_s);
          if q_s::list then
            if nops(q_s)=0 then return q end if;
            q_s := map(s->remove(c->c in ctx1 or `and`(c::relation,lhs(c)::name,lhs(c)=rhs(c)), s), q_s);
            q_s := remove(x->x=[],q_s);
            if nops(q_s)=0 then return q end if;
            op(op(1,q_s)); # pick the first solution arbitrarily!
          else
            q
          end if;
        end try;
    end proc;
end module;

# Pushes constraints down, or pulls them up, when there are such constraints.
local do_ctx_dir := dir -> proc(vs :: DomBound, sh :: DomShape, $)
    local ctx := `if`(nops(vs)=2,op(2,vs),{});
    ctx := remove(x->x::`::`,ctx);
    if ctx <> {} then
        dir(ctx)(sh);
    else
        sh;
    end if;
end proc;

push_ctx_down := module()
  export ModuleApply := do_ctx_dir(ctx->sh->subsindets(sh, DomConstrain, x->if nops(x)<>0 then DConstrain(op(x), op(ctx)) else DConstrain() end if));
  export SimplName  := "Push context down";
  export SimplOrder := 1;
end module;

pull_ctx_out := module()
  export ModuleApply :=
    do_ctx_dir(ctx->sh->subsindets(sh, DomConstrain
              ,x->remove(c->c in ctx or (is(c) assuming ctx), x)));
  export SimplName  := "Pull context out";
  export SimplOrder := 20;
end module;

# Turns constraints(relations) into bounds
classify_DConstrains := module()

  export SimplName  := "Classify constraints";
  export SimplOrder := 8;

  export ModuleApply := proc(dbnds::DomBound,dsh::DomShape,$)

    subsindets(dsh, DomConstrain, x->classify_Rels([op(x)], dbnds));

  end proc;

  # Split relations into those we can incorporate
  # into bounds and others; this process also includes
  # some intermediate computations about the new bound:
  #  [ DInto(var), orig, upd_bound, bound_kind, numVars ]
  #    var         :=   variable to be modified
  #    orig        :=   the original relation
  #    upd_bound   :=   how to modify (a function)
  #    bound_kind  :=   {LO/HI}
  #    numVars     :=   how many variables are mentioned by the bound
  local classify_Rel := proc(r0,dbnd,$)

    local ret, vars, mk_k, bnd_k, i, var_k, q, r := r0;
    ret := [ DConstrain, r0 ]
;
    vars := {Domain:-Bound:-varsOf(dbnd)[]};

    if r :: {`<=`,`<`} then

      if rhs(r) in vars then

        r := op(0,r)(rhs(r),lhs(r));

        mk_k := flip_rel[op(0,r)]; bnd_k := B_LO;

      elif lhs(r) in vars then

        mk_k := op(0,r);           bnd_k := B_HI;

      else

        return ret;
      end if;

      i := Domain:-Bound:-varIx_mb(dbnd, lhs(r));

      if i >= 0 then

        var_k := op([1,i,3], dbnd);

        q := Domain:-ExtBound[var_k]:-RecogBound(mk_k,rhs(r));

        if q <> NULL then

          ret := [ DInto(lhs(r)), r0, q, bnd_k, countVs(vars minus {lhs(r)},r0) ];

        end if;

      end if;

    end if;

    ret;
  end proc;

  # Classifies a set of relations as potential bounds. The process
  # is as follows:
  #  - Classify each relation individually (see classify_Rel)
  #  - "Categorize" by the classification
  #  - Split relations which will be DConstrains, and those where we found
  #      more than one LO/HI bound or more than 2 bounds total.
  #  - Sort the relations which are to become bounds by the number of variables
  #      mentioned in the bound
  #  - Rebuild the continuations producing each new bound (see make_DInto)
  #  - Rebuild the leftover relations as a DConstrain.
  #  - Squash together ("foldr (.) id fs z") the continuations and leftover relations.
  local classify_Rels := proc(rs0,dbnd,$)

    local cs1, cs2, cs, rs := rs0;

    rs := map(r->classify_Rel(r,dbnd), rs);

    rs := [ListTools[Categorize]( ((a,b) -> op(1,a)=op(1,b) ), rs )];

    cs1, rs := selectremove(x->op([1,1],x)=DConstrain, rs);

    rs, cs2 := selectremove(x->nops(x)=1 or (nops(x)=2 and op([1,4],x)<>op([2,4],x)), rs);

    rs := sort(rs, key=(x->(`+`( seq(op(3,z),z=x) ))));

    rs := map(r->make_DInto(r,dbnd),rs);

    cs := DConstrain(map(c->map(q->op(2,q),c)[], [op(cs1),op(cs2)])[]);
    foldr((f,g)->f@g,x->x,op(rs))(cs);

  end proc;

  # Rebuild a classified (by classify_Rel) relation; this
  # takes a list of such classifications, all of whose variable should
  # be identical, and for which the different bound kinds are all distinct.
  # None of this is checked!
  # (since there are 2 bound kinds, this list is at most length 2)
  local make_DInto := proc(r::list([specfunc(DInto),anything,anything,identical(B_LO,B_HI),nonnegint]), dbnd, $)

    local var_nm, var_ty;
    var_nm := op([1,1,1], r);

    var_ty := Domain:-Bound:-get(dbnd, var_nm)[1];

    var_ty := foldr( ((q,x)->op(3,q)(x)), var_ty, op(r) );

    (ctx -> DInto(var_nm, var_ty, ctx))

  end proc;

  local flip_rel := table([`=`=`=`,`<>`=`<>`,`<=`=`>=`,`<`=`>`,`>=`=`<=`,`>`=`<`]);

  local countVs := ((vs,c)-> nops(indets(c, DomBoundVar) intersect {op(vs)} ));

end module;

# todo; this should actually solve for a variable, then substitute
# that variable in. In most cases, it would probably be enough to
# leave that as it is; it would simplify later.
singular_pts := module()
  export SimplName  := "Single_pts";
  export SimplOrder := 14;

    export ModuleApply := proc(bnds_ :: DomBound, sh_ :: DomShape, $)
        local bnds := bnds_, sh := sh_, vs, todo, sh1, vs_ty;
        vs := applyop(bl -> select(b->op(3,b)=`Int`, bl), 1, bnds);
        vs := Domain:-Bound:-varsOf(vs);
        vs_ty := satisfies(x->x in {op(vs)});
        todo := select( x -> nops(x) = 1 and op(1,x) :: `=`
                             # one side mentions exactly one
                             # var, and the other none
                             and nops ( (indets(lhs(op(1,x)), vs_ty))
                                  union (indets(rhs(op(1,x)), vs_ty)) ) = 1
                      , indets(sh, specfunc(`DConstrain`)) ) ;
        subs([seq(t=DSum(),t=todo)], sh);
    end proc;
end module;


Make Let look more like Bind

Make Let look more like Bind

`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:

`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:

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

  RoundTrip := proc(e)
    local result;
    interface(screenwidth=infinity, 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({Weight, Fanout, Split, Nop, Add,
                          exp, log, 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 := map(SummarizeKB, op([2,2],e), kb);
      x, kb1 := genType(op([2,1],e), HInt(closed_bounds(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,
                     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

`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:

`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:

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

  RoundTrip := proc(e)
    local result;
    interface(screenwidth=infinity, 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({Weight, Fanout, Split, Nop, Add,
                          exp, log, 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 := map(SummarizeKB, op([2,2],e), kb);
      x, kb1 := genType(op([2,1],e), HInt(closed_bounds(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(simplify_factor_assuming(f, kb),
                     summary = Bucket(mr, x=rng));
        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


Bug fix

Bug fix

local single_case_Partition := module()
    export ModuleApply := proc(vs :: DomBound, sh :: DomShape, $)
        subsindets(sh, DomSplit, x->do_simp(op(x)));
    end proc;

    local do_simp := proc(p:: Partition,$)::DomShape;
        local r := Partition:-Simpl:-single_nonzero_piece_cps(
            proc(c,v) if v::DomConstrain then DConstrain(conv_bool(c),op(v)) else p end if
            end proc,p,_testzero=(x->x=DSum()));
        if r :: Partition then DSplit(r) else r end if;
    end proc;

    local conv_bool := proc(r, $)
        if r :: {specfunc(`And`), `and`} then
            op(map(conv_bool,r))
        else
            r
        end if;
    end proc;
end module;

local single_case_Partition := module()
    export ModuleApply := proc(vs :: DomBound, sh :: DomShape, $)
        subsindets(sh, DomSplit, do_simp);
    end proc;

    local do_simp := proc(p,$)
        Partition:-Simpl:-single_nonzero_piece_cps(
            proc(c,v) if v::DomConstrain then DConstrain(conv_bool(c),op(v)) else p end if
            end proc,op(1,p),_testzero=(x->x=DSum()))
    end proc;

    local conv_bool := proc(r, $)
        if r :: {specfunc(`And`), `and`} then
            op(map(conv_bool,r))
        else
            r
        end if;
    end proc;
end module;


fix bug in simplify/unsafeProb

fix bug in simplify/unsafeProb

# SLO = Simplify Linear Operator.
#
#  This assumes that the input is the output of Language.Hakaru.Syntax.tester
# No checking is done that this is actually the case.
#
# SLO : simplifier
# AST : takes simplified form and transform to AST
#

SLO := module ()
  export ModuleApply, AST, simp, c; # very important: this c is "global".
  local ToAST, t_binds, t_pw, into_pw, myprod, gensym, gs_counter, do_pw;

  t_binds := 'specfunc(anything, {int, Int, sum, Sum})';
  t_pw := 'specfunc(anything, piecewise)';

  ModuleApply := proc(inp::anything)
    local e;
    try
      simp(value(eval(inp(c), 'if_'=piecewise)));
    catch "Wrong kind of parameters in piecewise":
      error "Bug in Hakaru -> Maple translation, piecewise used incorrectly.";
    end try;
  end proc;

  # AST transforms the Maple to a representation of the mochastic AST
  AST := proc(inp::anything)
    local cs;
    cs := indets(inp, 'specfunc'(anything,c));
    # deal with trivial input first
    if inp=0 then
        0
    # then deal with 'bad' input
    elif nops(cs) = 0 then
      error "the constant", inp, " is not a measure."
    elif type(inp, `+`) then
      map(AST, SUM(op(inp)))
    else
      ToAST(inp, []);
    end if;
  end proc;

  # recursive function which does the main translation
  ToAST := proc(e, ctx)
    local a0, a1, var, vars, rng, ee, cof, d, ld, weight, binders,
      v, subst, ivars, ff, newvar, rest;
    if type(e, specfunc(name, c)) then
        return Return(op(e))
    # we might have recursively encountered a hidden 0
    elif (e = 0) then
       return 0
    # we might have done something odd, and there is no x anymore (and not 0)
    elif type(e, 'numeric') then
      error "the constant", e, "is not a measure"
    # invariant: we depend on c
    else
      binders := indets(e, t_binds);
      vars := indets(e, specfunc(anything, c));
      subst := map(x-> x = op(0,x)[op(x)], vars);
      ivars := map2(op, 2, subst);
      if binders = {} then
        # this is a 'raw' measure, with no integrals
        ee := subs(subst, e);
        if type(ee, 'polynom'(anything,ivars)) then
          ee := collect(ee, ivars, simplify);
          d := degree(ee, ivars);
          ld := ldegree(ee, ivars);
          cof := [coeffs(ee, ivars, 'v')]; # cof is a list, v expseq
          if (d = 1) and (ld = 1) then
            # WM = Weight-Measure pair
            ff := (x,y) -> WM(simplify(x), Return(op(y)));
            Superpose(op(zip(ff, cof, [v])));
            # `if`(cof=1, rest, Bind_(Factor(simplify(cof)), rest))
          else
            if (ld = 0) then
              error "non-zero constant encountered as a measure", ee
            else
              error "polynomial in c:", ee
            end if;
          end if;
        elif type(ee, t_pw) then
          return do_pw(map(simplify, [op(e)]), ctx);
        else
          error "no binders, but still not a polynomial?", ee
        end if;
      else
        if type(e, 'specfunc'(anything, {'int','Int'})) then
          var, rng := op(op(2,e));
          ee := op(1,e);
          weight := simplify(op(2,rng)-op(1,rng));
          if type(weight, 'SymbolicInfinity') then
            rest := ToAST(ee, [op(2,e), op(ctx)]);
            # should recognize densities here
            Bind(Lebesgue, var = rng, rest)
          else
            rest := ToAST(weight*ee, [op(2,e), op(ctx)]);
            # process the rest, and then recognize
            # recognize 'raw' uniform
            if type(rest, specfunc(identical(var), 'Return')) then
              Uniform(op(rng));
            elif type(rest, 'Superpose'('WM'(anything, anything))) then
              # finite range.
              weight := simplify(op([1,1], rest));
              ee := op([1,2], rest);
              if ctx=[] and type(ee, Return(anything)) then
                Bind(Uniform(op(1, rng), op(2, rng)), var,
                    Superpose(WM(weight, simplify(ee))))
              else
                error "almost uniform but not quite?", e
              end if;
            else
              Bind(Lebesgue, var = rng, rest)
            end if;
          end if;
        elif type(e, 'specfunc'(anything, {'sum','Sum'})) then
            error "sums not handled yet"
        elif type(e, t_pw) then
          return do_pw(map(simplify, [op(e)]), ctx);
        else
            error "constants should have been pushed inside already", e
        end if;
      end if;
    end if;
  end proc;

  # simp mostly pushes things in.
  simp := proc(e)
    local a, b, d;
    if type(e, `+`) then
      map(simp, e)
    elif type(e, `*`) then
      a, b := selectremove(type, e, t_binds);
      # now casesplit on what a is
      if a=1 then  # no binders
        a, b := selectremove(type, e, t_pw);
        if a=1 then # and no piecewise either
          d := expand(b); # probably need to write something less brutal
          if b=d then # nothing happened
            simplify(b)
          else # this might be better
            simp(d)
          end if
        elif type(a, `*`) then
          error "do not know how to multiply 2 pw:", a
        elif type(a, t_pw) then
          into_pw(b, a)
        else
          error "something weird happened:", a, " was supposed to be pw"
        end if
      elif type(a, `*`) then
        error "product of 2 binders?!?", a
      else
        subsop(1=myprod(simp(b),simp(op(1,a))), a)
      end if
    elif type(e, t_binds) then
      subsop(1=simp(op(1,e)), e)
    # need to go into pw even if there is no factor to push in
    elif type(e, t_pw) then
      into_pw(1, e)
    else
      simplify(e)
    end if;
  end;

  into_pw := proc(fact, pw)
    local n, f;

    n := nops(pw);
    f := proc(j)
      if j=n then # last one is special, always a value
        simp(myprod(fact, simp(op(j, pw))))
      elif type(j,'odd') then # a condition
        op(j, pw)
      else # j even
        simp(myprod(fact , simp(op(j, pw))))
      end if;
    end proc;
    piecewise(seq(f(i),i=1..n))
  end proc;

  # myprod takes care of pushing a product inside a `+`
  myprod := proc(a, b)
    if type(b,`+`) then
      map2(myprod, a, b)
    else
      a*b
    end if;
  end proc;

  gs_counter := 0;
  gensym := proc(x::name) gs_counter := gs_counter + 1; x || gs_counter; end proc;

  do_pw := proc(l, ctx)
    local len;
    len := nops(l);
    if len = 0 then 0
    elif len = 1 then ToAST(l[1], ctx)
    else # l>=2. Note how conditions go through straight
      If(l[1], ToAST(l[2], ctx), thisproc(l[3..-1], ctx))
    end if;
  end;
end;

# this has to be global!
unsafeProb := proc(v)
  if type(v,'realcons') and signum(0, v, 1) = 1 then v else 'unsafeProb'(v) end if;
end proc;

# will get called on expressions containing 'unsafeProb'
`simplify/unsafeProb` := proc(x) local sub, f;
  sub := indets(x, 'specfunc'(anything, unsafeProb));
  f := proc(a) local b;
    b := op(1,a);
    if type(b, 'exp'(anything)) then exp_(op(1, b)) else a end if;
  end proc;
  subs(map(y -> y = f(y), sub), x)
end proc;

# works, but could be made more robust
`evalapply/if_` := proc(f, t) if_(op(1,f), op(2,f)(t[1]), op(3,f)(t[1])) end;

# SLO = Simplify Linear Operator.
#
#  This assumes that the input is the output of Language.Hakaru.Syntax.tester
# No checking is done that this is actually the case.
#
# SLO : simplifier
# AST : takes simplified form and transform to AST
#

SLO := module ()
  export ModuleApply, AST, simp, c; # very important: this c is "global".
  local ToAST, t_binds, t_pw, into_pw, myprod, gensym, gs_counter, do_pw;

  t_binds := 'specfunc(anything, {int, Int, sum, Sum})';
  t_pw := 'specfunc(anything, piecewise)';

  ModuleApply := proc(inp::anything)
    local e;
    try
      simp(value(eval(inp(c), 'if_'=piecewise)));
    catch "Wrong kind of parameters in piecewise":
      error "Bug in Hakaru -> Maple translation, piecewise used incorrectly.";
    end try;
  end proc;

  # AST transforms the Maple to a representation of the mochastic AST
  AST := proc(inp::anything)
    local cs;
    cs := indets(inp, 'specfunc'(anything,c));
    # deal with trivial input first
    if inp=0 then
        0
    # then deal with 'bad' input
    elif nops(cs) = 0 then
      error "the constant", inp, " is not a measure."
    elif type(inp, `+`) then
      map(AST, SUM(op(inp)))
    else
      ToAST(inp, []);
    end if;
  end proc;

  # recursive function which does the main translation
  ToAST := proc(e, ctx)
    local a0, a1, var, vars, rng, ee, cof, d, ld, weight, binders,
      v, subst, ivars, ff, newvar, rest;
    if type(e, specfunc(name, c)) then
        return Return(op(e))
    # we might have recursively encountered a hidden 0
    elif (e = 0) then
       return 0
    # we might have done something odd, and there is no x anymore (and not 0)
    elif type(e, 'numeric') then
      error "the constant", e, "is not a measure"
    # invariant: we depend on c
    else
      binders := indets(e, t_binds);
      vars := indets(e, specfunc(anything, c));
      subst := map(x-> x = op(0,x)[op(x)], vars);
      ivars := map2(op, 2, subst);
      if binders = {} then
        # this is a 'raw' measure, with no integrals
        ee := subs(subst, e);
        if type(ee, 'polynom'(anything,ivars)) then
          ee := collect(ee, ivars, simplify);
          d := degree(ee, ivars);
          ld := ldegree(ee, ivars);
          cof := [coeffs(ee, ivars, 'v')]; # cof is a list, v expseq
          if (d = 1) and (ld = 1) then
            # WM = Weight-Measure pair
            ff := (x,y) -> WM(simplify(x), Return(op(y)));
            Superpose(op(zip(ff, cof, [v])));
            # `if`(cof=1, rest, Bind_(Factor(simplify(cof)), rest))
          else
            if (ld = 0) then
              error "non-zero constant encountered as a measure", ee
            else
              error "polynomial in c:", ee
            end if;
          end if;
        elif type(ee, t_pw) then
          return do_pw(map(simplify, [op(e)]), ctx);
        else
          error "no binders, but still not a polynomial?", ee
        end if;
      else
        if type(e, 'specfunc'(anything, {'int','Int'})) then
          var, rng := op(op(2,e));
          ee := op(1,e);
          weight := simplify(op(2,rng)-op(1,rng));
          if type(weight, 'SymbolicInfinity') then
            rest := ToAST(ee, [op(2,e), op(ctx)]);
            # should recognize densities here
            Bind(Lebesgue, var = rng, rest)
          else
            rest := ToAST(weight*ee, [op(2,e), op(ctx)]);
            # process the rest, and then recognize
            # recognize 'raw' uniform
            if type(rest, specfunc(identical(var), 'Return')) then
              Uniform(op(rng));
            elif type(rest, 'Superpose'('WM'(anything, anything))) then
              # finite range.
              weight := simplify(op([1,1], rest));
              ee := op([1,2], rest);
              if ctx=[] and type(ee, Return(anything)) then
                Bind(Uniform(op(1, rng), op(2, rng)), var,
                    Superpose(WM(weight, simplify(ee))))
              else
                error "almost uniform but not quite?", e
              end if;
            else
              Bind(Lebesgue, var = rng, rest)
            end if;
          end if;
        elif type(e, 'specfunc'(anything, {'sum','Sum'})) then
            error "sums not handled yet"
        else
            error "constants should have been pushed inside already", e
        end if;
      end if;
    end if;
  end proc;

  # simp mostly pushes things in.
  simp := proc(e)
    local a, b, d;
    if type(e, `+`) then
      map(simp, e)
    elif type(e, `*`) then
      a, b := selectremove(type, e, t_binds);
      # now casesplit on what a is
      if a=1 then  # no binders
        a, b := selectremove(type, e, t_pw);
        if a=1 then # and no piecewise either
          d := expand(b); # probably need to write something less brutal
          if b=d then # nothing happened
            simplify(b)
          else # this might be better
            simp(d)
          end if
        elif type(a, `*`) then
          error "do not know how to multiply 2 pw:", a
        elif type(a, t_pw) then
          into_pw(b, a)
        else
          error "something weird happened:", a, " was supposed to be pw"
        end if
      elif type(a, `*`) then
        error "product of 2 binders?!?", a
      else
        subsop(1=myprod(simp(b),simp(op(1,a))), a)
      end if
    elif type(e, t_binds) then
      subsop(1=simp(op(1,e)), e)
    # need to go into pw even if there is no factor to push in
    elif type(e, t_pw) then
      into_pw(1, e)
    else
      simplify(e)
    end if;
  end;

  into_pw := proc(fact, pw)
    local n, f;

    n := nops(pw);
    f := proc(j)
      if j=n then # last one is special, always a value
        simp(myprod(fact, simp(op(j, pw))))
      elif type(j,'odd') then # a condition
        op(j, pw)
      else # j even
        simp(myprod(fact , simp(op(j, pw))))
      end if;
    end proc;
    piecewise(seq(f(i),i=1..n))
  end proc;

  # myprod takes care of pushing a product inside a `+`
  myprod := proc(a, b)
    if type(b,`+`) then
      map2(myprod, a, b)
    else
      a*b
    end if;
  end proc;

  gs_counter := 0;
  gensym := proc(x::name) gs_counter := gs_counter + 1; x || gs_counter; end proc;

  do_pw := proc(l, ctx)
    local len;
    len := nops(l);
    if len = 0 then 0
    elif len = 1 then ToAST(l[1], ctx)
    else # l>=2. Note how conditions go through straight
      If(l[1], ToAST(l[2], ctx), thisproc(l[3..-1], ctx))
    end if;
  end;
end;

# this has to be global!
unsafeProb := proc(v)
  if signum(0, v, 1) = 1 then v else 'unsafeProb'(v) end if;
end proc;

# will get called with 'unsafeProb(...)'
`simplify/unsafeProb` := proc(a) local b;
  b := op(1,a);
  if type(b, 'exp'(anything)) then exp_(op(1, b)) else a end if;
end proc;

# works, but could be made more robust
`evalapply/if_` := proc(f, t) if_(op(1,f), op(2,f)(t[1]), op(3,f)(t[1])) end;


Move some manually written table lookup into Domain:-Ext

# 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);
      nub_piecewise(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));

    if ed = ee then
      vars := indets(Domain:-Bound:-varsOf(dvars), name);
      ed := reduce_on_prod(mkDom, body, vars, kb);
      kb_assuming_mb(x->subsindets(x, Partition, Partition:-Simpl))(ed, kb, x->x);
    else
      reduce(ee,h,kb,opts);
    end if
  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_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)
      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');
  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;
  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);
      nub_piecewise(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));

    if ed = ee then
      vars := indets(Domain:-Bound:-varsOf(dvars), name);
      ed := reduce_on_prod(mkDom, body, vars, kb);
      kb_assuming_mb(x->subsindets(x, Partition, Partition:-Simpl))(ed, kb, x->x);
    else
      reduce(ee,h,kb,opts);
    end if
  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_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)
      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 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');
  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 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;
  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;
      t := 'applyintegrand'('identical'(h), 'anything');
      intapps := indets(op(1,e), t);
      if intapps = {} then
        return FAIL;
      end if;

      if e :: Int(anything, name=anything) and
      not depends(intapps, op([2,1],e)) then
        var := op([2,1],e);
        f := 'int_assuming';
      elif e :: Sum(anything, name=anything)and
      not depends(intapps, op([2,1],e)) then
        var := op([2,1],e);
        f := 'sum_assuming';
      elif e :: Ints(anything, name, range, list(name=range)) and
      not depends(intapps, op(2,e)) then
        var := op(2,e);
        f := 'ints';
      elif e :: Sums(anything, name, range, list(name=range)) and
      not depends(intapps, op(2,e)) then
        var := op(2,e);
        f := 'sums';
      else
        return FAIL;
      end if;

      [ op(1,e), f, var, [op(2..-1,e)] ];
    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;


Add some debug printing

Add some debug printing

# 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:-Simpl(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;

# "Integrals" refers to any types of "integrals" understood by domain (Int,
# Sum currently)
reduce_Integrals := module()
  export ModuleApply;
  local
  # The callbacks passed by reduce_Integrals to Domain:-Reduce
    reduce_Integrals_body, reduce_Integrals_into
  # tries to evaluate a RootOf
  , try_eval_Root;

  reduce_Integrals_body := proc(h,opts,x,kb1) reduce(x,h,kb1,opts) end proc;
  reduce_Integrals_into := proc(h,kind,e,vn,vt,kb,$)
    local rr;
    rr := elim_intsum(Domain:-Apply:-do_mk(args[2..-1]), h, kb);
    rr := subsindets(rr, specfunc(RootOf), x->try_eval_Root(x,a->a));
    return rr;
  end proc;

  ModuleApply := proc(expr, h, kb, opts, $)
    local rr, elim;
    rr := Domain:-Reduce(expr, kb
      ,curry(reduce_Integrals_into,h)
      ,curry(reduce_Integrals_body,h,opts)
      ,(_->:-DOM_FAIL));
   elim := subsindets(rr, specfunc(ELIMED), x->op(1,x));
    if elim <> rr then rr := reduce(elim,h,kb,opts) end if;
    rr := kb_assuming_mb(Partition:-Simpl)(rr, kb, x->x);
   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;
    end if;
    rr;
  end proc;

  try_eval_Root := proc(e0::specfunc(`RootOf`),on_fail := (_->FAIL), $)
    local ix,e := e0;
    try
      if nops(e)=2 or nops(e)=3
      and op(-1,e) :: `=`(identical(index),{specindex(real),nonnegint}) then
        ix := op([2,-1],e);
        if ix :: specindex(real) then ix := op(ix); end if;
        e := op(0,e)(op(1,e));
      else
        ix := NULL;
      end if;
      e := convert(e, 'radical', ix);
      if e :: specfunc(RootOf) then return on_fail(e) end if;
      return e;
    catch: return on_fail(e0); end try;
  end proc;

  # 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;

    local known_tys := table([Int=int_assuming,Sum=sum_assuming,Ints=ints,Sums=sums]);
    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) and assigned(known_tys[e_k]) 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 := eval(known_tys[e_k]);
        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; # elim
end module; # reduce_Integrals

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
  local res := foldr_piecewise(piecewise_if, 0, pw);
  `if`(res=pw,'NULL',userinfo(3, procname, printf("nub_piecewise(%a) produced\n\t%a\n", pw, res)));
  res;
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 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 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;

# 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:-Simpl(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;

# "Integrals" refers to any types of "integrals" understood by domain (Int,
# Sum currently)
reduce_Integrals := module()
  export ModuleApply;
  local
  # The callbacks passed by reduce_Integrals to Domain:-Reduce
    reduce_Integrals_body, reduce_Integrals_into
  # tries to evaluate a RootOf
  , try_eval_Root;

  reduce_Integrals_body := proc(h,opts,x,kb1) reduce(x,h,kb1,opts) end proc;
  reduce_Integrals_into := proc(h,kind,e,vn,vt,kb,$)
    local rr;
    rr := elim_intsum(Domain:-Apply:-do_mk(args[2..-1]), h, kb);
    rr := subsindets(rr, specfunc(RootOf), x->try_eval_Root(x,a->a));
    return rr;
  end proc;

  ModuleApply := proc(expr, h, kb, opts, $)
    local rr, elim;
    rr := Domain:-Reduce(expr, kb
      ,curry(reduce_Integrals_into,h)
      ,curry(reduce_Integrals_body,h,opts)
      ,(_->:-DOM_FAIL));
   elim := subsindets(rr, specfunc(ELIMED), x->op(1,x));
    if elim <> rr then rr := reduce(elim,h,kb,opts) end if;
    rr := kb_assuming_mb(Partition:-Simpl)(rr, kb, x->x);
   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;
    end if;
    rr;
  end proc;

  try_eval_Root := proc(e0::specfunc(`RootOf`),on_fail := (_->FAIL), $)
    local ix,e := e0;
    try
      if nops(e)=2 or nops(e)=3
      and op(-1,e) :: `=`(identical(index),{specindex(real),nonnegint}) then
        ix := op([2,-1],e);
        if ix :: specindex(real) then ix := op(ix); end if;
        e := op(0,e)(op(1,e));
      else
        ix := NULL;
      end if;
      e := convert(e, 'radical', ix);
      if e :: specfunc(RootOf) then return on_fail(e) end if;
      return e;
    catch: return on_fail(e0); end try;
  end proc;

  # 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;

    local known_tys := table([Int=int_assuming,Sum=sum_assuming,Ints=ints,Sums=sums]);
    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) and assigned(known_tys[e_k]) 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 := eval(known_tys[e_k]);
        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; # elim
end module; # reduce_Integrals

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 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 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;