Recognize a piecewise with an explicit otherwise as efficient (?)

# This module forms part of NewSLO and is `$include`d there

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

Simplify := proc(e, t::t_type, {ctx :: list := []}, $)
  subsindets(SimplifyKB(value(e), t, build_kb(ctx, "Simplify")),
             And({t_sum, t_product}, anyfunc(anything, anything=range)),
             e -> subsop(0 = `if`(e::t_sum, SumIE, ProductIE),
                         applyop(`+`, [2,2,2], e, 1)))
end proc;

SimplifyKB_ := proc(e, t::t_type, kb::t_kb, $)
  local patterns, x, kb1, ex;
  if t :: HMeasure(anything) then
    %fromLO(%improve(%toLO(e), _ctx=kb), _ctx=kb);
  elif t :: HFunction(anything, anything) then
    patterns := htype_patterns(op(1,t));
    if patterns :: Branches(Branch(PVar(name),anything)) then
      # Eta-expand the function type
      x := `if`(e::lam(name,anything,anything), op(1,e),
                op([1,1,1],patterns));
      x, kb1 := genType(x, op(1,t), kb, e);
      ex := app(e,x);
      lam(x, op(1,t), SimplifyKB_(ex, op(2,t), kb1))
    else
      # Eta-expand the function type and the sum-of-product argument-type
      x := `if`(e::lam(name,anything,anything), op(1,e), d);
      if depends([e,t,kb], x) then x := gensym(x) end if;
      ex := app(e,x);
      lam(x, op(1,t), '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),
                     SimplifyKB_(eval(eval(ex,eSubst),pSubst1), op(2,t), kb1))
            end proc,
            patterns)))
    end if
  else
    %simplify_assuming(e, kb)
  end if
end proc;

SimplifyKB := proc(e, t::t_type, kb::t_kb, $)
    eval(SimplifyKB_(args), [%fromLO=fromLO,%improve=improve,%toLO=toLO,%simplify_assuming=simplify_assuming]);
end proc;

# Testing

TestSimplify := proc(m, t, n::algebraic:=m, {verify:=simplify})
  local s, r;
  # How to pass keyword argument {ctx::list:=[]} on to Simplify?
  s, r := selectremove(type, [_rest], 'identical(ctx)=anything');
  CodeTools[Test](Simplify(m,t,op(s)), n, measure(verify), op(r))
end proc;

TestHakaru := proc(m, n::{set(algebraic),algebraic}:=m,
                   {simp:=improve, verify:=simplify, ctx::list:=[]})
  local kb := build_kb(ctx, "TestHakaru"), ver := measure(verify);
  ver := `if`(n::set, 'member'(ver), ver);

  CodeTools[Test](fromLO(simp(toLO(m), _ctx=kb), _ctx=kb), n,
    ver, _rest)
end proc;

TestDisint := module()
    export ModuleApply := proc(
      M::{t_Hakaru, list(anything)}, #args to disint, or just 1st arg
      n::set({t_Hakaru, identical(NULL)}), #desired return
      ctx::t_kb_atoms:= [], #context: assumptions, "knowledge"
      TLim::{positive, identical(-1)}:= 80 #timelimit
    )
      local disint_args, disint_var, expected := n;
      if M :: list then
        disint_args := [op(M),ctx];
      else
        disint_var := gensym('t');
        disint_args := [M,disint_var,ctx];
        expected := subs(:-`t`=disint_var,expected);
      end if;
      try
        do_test(disint_args, copy(expected), TLim, _rest);
      catch "time expired":
        error "Time expired while running: disint(%1)", disint_args;
      end try;
    end proc;

    # This is necessary because CodeTools seems to forgot the value
    # of our local variables (but only the `expected result' arg)
    # unless that arg is precisely a formal parameter, and we `copy' the
    # input to this function.
    local do_test := proc(disint_args, expected, tlim)
      timelimit( tlim, CodeTools[Test]
                 ( {disint(op(disint_args))}
                 , expected
                 , '`subset`(measure(simplify))'
                 , _rest));
    end proc;
end module;

TestEfficient := proc(e, t::t_type, t_kb := KB:-empty, {label::string := "Test" })
  local done_, result, todo;
  todo := SimplifyKB_(args[1..3]);
  done_ := eval(todo, [%fromLO=fromLO,%improve=improve,%toLO=toLO,%simplify_assuming=simplify_assuming]);

  _Env_TestTools_Try_printf := false;
  result := TestTools[Try](label, Efficient(done_),true);
  if result = NULL then
    printf("%s passed.\n", label);
  else
    error sprintf("%s FAILED.\n"
                  "The result of\n\t%a\n\tis not efficient.\n"
                 , label, todo );
  end if;
end proc;

# Test roughly for "efficient" Hakaru measure terms,
# i.e., those we want simplification to produce.
Efficient := proc(mm, $)
  local m, n;
  m := mm;
  if has(m, 'undefined') then
    return false;
  end if;
  while m :: '{lam(name, anything, anything),
               Context(anything, anything),
               And(specfunc(piecewise)
                  ,{anyfunc(anything, anything, Msum())
                   ,anyfunc(anything, anything, anything, Msum())})}' do
    m := op(`if`(op(0,m)='lam',3,2),m);
  end do;
  if m :: 'Weight(anything, anything)' then m := op(2,m) end if;
  if has(m, '{infinity, Lebesgue, int, Int, Beta, GAMMA}') then
    return false;
  end if;
  for n in `if`(m :: 'specfunc(Msum)', m, [m]) do
    if n :: 'Weight(anything, anything)' then n := op(2,n) end if;
    if has(subsindets(n, 'specfunc(Weight(anything, anything), Msum)',
                      s -> `if`(Testzero(`+`(op(map2(op, 1, s))) - 1),
                                map2(op, 2, s), s)),
           '{Msum, Weight}') then
      return false;
    end if;
  end do;
  return true;
end proc;

# Load a file in concrete Hakaru syntax (using the "momiji" command)
# and return its term (in which Sum and Product are inert) and type.
Concrete := proc(path::string, $)
  local cmd, res, dangerous_chars;
  cmd := FileTools:-AbsolutePath(path,
    (FileTools:-ParentDirectory@@2)(LibraryTools:-FindLibrary(Hakaru)));
  dangerous_chars := [ " ", "'", """", `if`(kernelopts(platform)="windows", [], ["\\"])[] ];
  if ormap((c->StringTools:-Has(cmd,c)), dangerous_chars) then
    error "Dangerous characters in path: %1", cmd;
  end if;
  cmd := cat("momiji ", cmd);
  res := ssystem(cmd);
  if res :: [0, string] then
    parse(cat("use Hakaru in ", op(2,res), " end use"));
  else
    error "ssystem %1: %2", cmd, res;
  end if;
end proc;

# This module forms part of NewSLO and is `$include`d there

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

Simplify := proc(e, t::t_type, {ctx :: list := []}, $)
  subsindets(SimplifyKB(value(e), t, build_kb(ctx, "Simplify")),
             And({t_sum, t_product}, anyfunc(anything, anything=range)),
             e -> subsop(0 = `if`(e::t_sum, SumIE, ProductIE),
                         applyop(`+`, [2,2,2], e, 1)))
end proc;

SimplifyKB_ := proc(e, t::t_type, kb::t_kb, $)
  local patterns, x, kb1, ex;
  if t :: HMeasure(anything) then
    %fromLO(%improve(%toLO(e), _ctx=kb), _ctx=kb);
  elif t :: HFunction(anything, anything) then
    patterns := htype_patterns(op(1,t));
    if patterns :: Branches(Branch(PVar(name),anything)) then
      # Eta-expand the function type
      x := `if`(e::lam(name,anything,anything), op(1,e),
                op([1,1,1],patterns));
      x, kb1 := genType(x, op(1,t), kb, e);
      ex := app(e,x);
      lam(x, op(1,t), SimplifyKB_(ex, op(2,t), kb1))
    else
      # Eta-expand the function type and the sum-of-product argument-type
      x := `if`(e::lam(name,anything,anything), op(1,e), d);
      if depends([e,t,kb], x) then x := gensym(x) end if;
      ex := app(e,x);
      lam(x, op(1,t), '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),
                     SimplifyKB_(eval(eval(ex,eSubst),pSubst1), op(2,t), kb1))
            end proc,
            patterns)))
    end if
  else
    %simplify_assuming(e, kb)
  end if
end proc;

SimplifyKB := proc(e, t::t_type, kb::t_kb, $)
    eval(SimplifyKB_(args), [%fromLO=fromLO,%improve=improve,%toLO=toLO,%simplify_assuming=simplify_assuming]);
end proc;

# Testing

TestSimplify := proc(m, t, n::algebraic:=m, {verify:=simplify})
  local s, r;
  # How to pass keyword argument {ctx::list:=[]} on to Simplify?
  s, r := selectremove(type, [_rest], 'identical(ctx)=anything');
  CodeTools[Test](Simplify(m,t,op(s)), n, measure(verify), op(r))
end proc;

TestHakaru := proc(m, n::{set(algebraic),algebraic}:=m,
                   {simp:=improve, verify:=simplify, ctx::list:=[]})
  local kb := build_kb(ctx, "TestHakaru"), ver := measure(verify);
  ver := `if`(n::set, 'member'(ver), ver);

  CodeTools[Test](fromLO(simp(toLO(m), _ctx=kb), _ctx=kb), n,
    ver, _rest)
end proc;

TestDisint := module()
    export ModuleApply := proc(
      M::{t_Hakaru, list(anything)}, #args to disint, or just 1st arg
      n::set({t_Hakaru, identical(NULL)}), #desired return
      ctx::t_kb_atoms:= [], #context: assumptions, "knowledge"
      TLim::{positive, identical(-1)}:= 80 #timelimit
    )
      local disint_args, disint_var, expected := n;
      if M :: list then
        disint_args := [op(M),ctx];
      else
        disint_var := gensym('t');
        disint_args := [M,disint_var,ctx];
        expected := subs(:-`t`=disint_var,expected);
      end if;
      try
        do_test(disint_args, copy(expected), TLim, _rest);
      catch "time expired":
        error "Time expired while running: disint(%1)", disint_args;
      end try;
    end proc;

    # This is necessary because CodeTools seems to forgot the value
    # of our local variables (but only the `expected result' arg)
    # unless that arg is precisely a formal parameter, and we `copy' the
    # input to this function.
    local do_test := proc(disint_args, expected, tlim)
      timelimit( tlim, CodeTools[Test]
                 ( {disint(op(disint_args))}
                 , expected
                 , '`subset`(measure(simplify))'
                 , _rest));
    end proc;
end module;

TestEfficient := proc(e, t::t_type, t_kb := KB:-empty, {label::string := "Test" })
  local done_, result, todo;
  todo := SimplifyKB_(args[1..3]);
  done_ := eval(todo, [%fromLO=fromLO,%improve=improve,%toLO=toLO,%simplify_assuming=simplify_assuming]);

  _Env_TestTools_Try_printf := false;
  result := TestTools[Try](label, Efficient(done_),true);
  if result = NULL then
    printf("%s passed.\n", label);
  else
    error sprintf("%s FAILED.\n"
                  "The result of\n\t%a\n\tis not efficient.\n"
                 , label, todo );
  end if;
end proc;

# Test roughly for "efficient" Hakaru measure terms,
# i.e., those we want simplification to produce.
Efficient := proc(mm, $)
  local m, n;
  m := mm;
  if has(m, 'undefined') then
    return false;
  end if;
  while m :: '{lam(name, anything, anything),
               Context(anything, anything),
               And(specfunc(piecewise), anyfunc(anything, anything, Msum()))}' do
    m := op(`if`(op(0,m)='lam',3,2),m);
  end do;
  if m :: 'Weight(anything, anything)' then m := op(2,m) end if;
  if has(m, '{infinity, Lebesgue, int, Int, Beta, GAMMA}') then
    return false;
  end if;
  for n in `if`(m :: 'specfunc(Msum)', m, [m]) do
    if n :: 'Weight(anything, anything)' then n := op(2,n) end if;
    if has(subsindets(n, 'specfunc(Weight(anything, anything), Msum)',
                      s -> `if`(Testzero(`+`(op(map2(op, 1, s))) - 1),
                                map2(op, 2, s), s)),
           '{Msum, Weight}') then
      return false;
    end if;
  end do;
  return true;
end proc;

# Load a file in concrete Hakaru syntax (using the "momiji" command)
# and return its term (in which Sum and Product are inert) and type.
Concrete := proc(path::string, $)
  local cmd, res, dangerous_chars;
  cmd := FileTools:-AbsolutePath(path,
    (FileTools:-ParentDirectory@@2)(LibraryTools:-FindLibrary(Hakaru)));
  dangerous_chars := [ " ", "'", """", `if`(kernelopts(platform)="windows", [], ["\\"])[] ];
  if ormap((c->StringTools:-Has(cmd,c)), dangerous_chars) then
    error "Dangerous characters in path: %1", cmd;
  end if;
  cmd := cat("momiji ", cmd);
  res := ssystem(cmd);
  if res :: [0, string] then
    parse(cat("use Hakaru in ", op(2,res), " end use"));
  else
    error "ssystem %1: %2", cmd, res;
  end if;
end proc;


Postprocessing of LMS solution; and produce a Partition from Apply

Domain := module()

#   Domain = DOMAIN(DomBound, DomShape)
#   DomBound = DOMBOUND(list(name), KB)
#   DomShape =
#     | DConstrain(relation*)
#     | DSum (DomShape*)
#     | DSplit(Partition(DomShape))
#     | DInto(name, BoundType, DomShape)

    global DOMAIN;
    global DBound;

    global DConstrain;
    global DSum;
    global DSplit;
    global DInto;

    global DNoSol;

    export Has := module ()

       export Bound := proc(e, $)
               assigned(Domain:-ExtBound[op(0,e)]) and
               evalb(e :: Domain:-ExtBound[op(0,e)]:-MapleType);
       end proc;

       export Shape := proc(e, $)
               assigned(Domain:-ExtShape[op(0,e)]) and
               evalb(e :: Domain:-ExtShape[op(0,e)]:-MapleType);
       end proc;

       export ModuleApply := proc(e, $)
               Bound(e) or Shape(e);
       end proc;

    end module;

    export ToKB := module ()

       export Bound := proc(dom, $)
         op(2, dom);
       end proc;

       export Shape := module ()
         export AsConstraints := proc(sh_, $)
           local sh := sh_;

           if sh :: specfunc(`DConstrain`) then
               [ op(sh) ];

           # elif sh :: specfunc(`DSum`) then
           # elif sh :: specfunc(`DSplit`) then

           elif sh :: specfunc(`DInto`) then
               AsConstraints(op(3, sh));
           else
               error "don't know how to apply %1", sh
           end if;

         end proc;

         export ModuleApply := proc(dom, $)
           build_kb(AsConstraints(dom), "Domain/ToKB/Shape");
         end proc;

       end module;

       export ModuleApply := proc(dom, $)
          build_kb( Domain:-ToKB:-Shape:-AsConstraints(op(2,dom)), "Domain/ToKB", Bound(op(1,dom)));
       end proc;
    end module;

    export ExtBound := table();
    export ExtShape := table();

    local ModuleLoad := proc($)
           ExtBound[`Int`] :=
               Record('MakeKB'=(e -> kb -> genLebesgue(op([1],e), op([2,1],e), op([2,2],e), kb))
                     ,'MakeEqn'=`=`
                     ,'MapleType'='And(specfunc({Int}), anyfunc(anything,name=range))'
                     ,'HType'=AlmostEveryReal
                     ,'RangeOf'=
                      (proc(v,$)
                         local lo, hi, lo_b, hi_b, k ;

                         k := nops(v);
                         lo_b, hi_b := -infinity, infinity;

                         if k = 0 then
                            # do nothing

                         elif k = 2 then
                             lo, hi := op(v);
                             lo, lo_b := op(1,lo), op(2, lo);
                             hi, hi_b := op(1,hi), op(2, hi);

                         elif k = 1 then
                             if op([1,1],v) in {`<`, `<=`} then
                                 hi_b := op([1,2], v);
                             elif op([1,1],v) in {`>`, `>=`} then
                                 lo_b := op([1,2], v);
                             else
                                 error "unknown bound %1", op([1,1],v);
                             end if;

                         end if;
                         return lo_b .. hi_b;
                       end proc)
                     );

           ExtBound[`Sum`] :=
               Record('MakeKB'=(e -> kb -> genSummation(op([1],e), op(op([2],e)), kb))
                     ,'MakeEqn'=`=`
                     ,'MapleType'='And(specfunc({Sum}), anyfunc(anything,name=range))'
                     ,'HType'=HInt
                     ,'RangeOf'=KB:-range_of_HInt
                     );

           ExtShape[`Indicator`] :=
               Record('MakeCtx'=(e -> ( {op(1,e)}, 1 ))
                     ,'MapleType'='Indicator(anything)'
                     );

           ExtShape[`PARTITION`] :=
               Record('MakeCtx'=Partition:-Simpl:-single_nonzero_piece
                     ,'MapleType'='Partition'
                     );

    end proc;

    export Extract := module ()

           export MakeOfType := module()
              local makeTable := proc()
                 table([seq( ExtBound[e]:-HType=e,e=[indices(ExtBound,'nolist')])]);
              end proc;

              export ModuleApply := proc(t, $)
                 makeTable()[op(0,t)];
              end proc;
           end module;

           export Bound := module ()
             local do_extract_arg := proc(kb1_, kb, vars, kind, arg_, bound, $)
               local kb1 := kb1_, x0, x, vars1, ty, arg := arg_;

               x0 := op(1, bound);
               x, kb1 := ExtBound[kind]:-MakeKB(bound)(kb1);

               vars1 := [ x, op(vars) ];
               arg   := subs(ExtBound[kind]:-MakeEqn(x0,x), arg);

               do_extract(kb1, kb, vars1, arg);
             end proc;

             local do_extract := proc(kb1, kb, vars, arg, $)
               if Domain:-Has:-Bound(arg) then
                   do_extract_arg(kb1, kb, vars, op(0,arg), op(arg));
               else
                   arg, vars, kb1
               end if;

             end proc;

             export ModuleApply := proc(e, ctx := {empty}, $)
                        local arg, vars, kb;
                        arg, vars, kb := do_extract(ctx, ctx, [], e);

                        arg, DBound(vars, kb);
             end proc;
           end module;

           export Shape := module ()

             local do_get := proc(f, f_ty, $) proc(e, $)
               local sub, inds, rest;
               if e::`*` then
                 sub := map((s -> [do_get(f, f_ty)(s)]), [op(e)]);
                 `union`(op(map2(op,1,sub))), `*`(op(map2(op,2,sub)))
               elif e::`^` then
                 inds, rest := do_get(f, f_ty)(op(1,e));
                 inds, subsop(1=rest, e)
               elif e:: f_ty then
                 f(e)
               else
                 {}, e
               end if

             end proc; end proc;

             local do_gets := proc(todo::list, w, e, $)
                       local t0, ts, w1, e1;
                       if nops(todo) = 0 then
                           w, e
                       else
                           t0 := op(1, todo);
                           ts := op(subsop(1=NULL, todo));
                           if indets(e, specfunc(t0)) <> {} then
                               w1, e1 :=
                                 do_get(ExtShape[t0]:-MakeCtx
                                       ,ExtShape[t0]:-MapleType
                                       )(e);
                               ts := `if`(w1={}, [ts], [ts, t0]);

                               do_gets( ts, w1 union w, e1 );
                           else
                               do_gets( [ ts ], w, e );
                           end if;
                       end if;
             end proc;

             local simpl_shape := (x->x);

             export ModuleApply := proc(e, $)
                        local ixs, w, e1;
                        ixs := [indices(ExtShape, 'nolist')];
                        w, e1 := do_gets(ixs, {}, e);

                        w := DConstrain(op(w));
                        w := simpl_shape(w);

                        w, e1
             end proc;
           end module;

           export ModuleApply := proc(e, $)
                      local b, eb, s, es;
                      b, eb := Bound(e);
                      s, es := Shape(eb);
                      DOMAIN(b, s), es;
           end proc;
    end module;

    export Apply := module ()
           local do_mk := proc(e, vs_ty, vn, ty_, $)
              local mk, rng, ty := ty_;

              if ty :: t_type then
                  mk := Extract:-MakeOfType(ty);
                  rng := Domain:-ExtBound[mk]:-RangeOf(ty);

              elif ty :: `..` then
                  mk := Extract:-MakeOfType( getType(vs_ty, vn) );
                  rng := ty;

              else
                  error "don't know how to make %1", ty
              end if;

              rng := Domain:-ExtBound[mk]:-MakeEqn(vn, rng);

              mk(e, rng);

           end proc;

           local do_apply := proc(e, vs, vs_ty, sh_, $)
              local sh := sh_, e1, vn, vt, shv, ty, vn_ty, kb1, cond;
              if sh :: specfunc(`DConstrain`) then
                  # foldr(`*`, e, op( map(c->Indicator(c), sh) ));
                  cond := `and`(op(sh));
                  if is(cond) then
                      e
                  else
                      PWToPartition(piecewise(cond, e, 0));
                  end if;

              elif sh :: specfunc(`DSum`) then
                  `+`(seq(do_apply(e, vs, vs_ty, s), s=sh))

              elif sh :: specfunc(`DSplit`) then
                  sh := op(1, sh);
                  Partition:-Pmap(p-> do_apply(e, vs, vs_ty, p), sh);

              elif sh :: specfunc(`DInto`) then
                  # deconstruction
                  vn, vt, shv := op(sh);

                  # recursively apply
                  e1 := do_apply(e, [vn], vs_ty, shv);

                  # build this integral
                  do_mk(e1, vs_ty, vn, vt);
              else
                  error "don't know how to apply %1", sh
              end if;
           end proc;

           export ModuleApply := proc(dom, e, kb :: t_kb, $)
             local vs, sh, vs_ty, vn, e1, ty, _, kb_as;
             vs, sh := op(dom);
             vs, vs_ty := op(vs);

             kb_as := kb_to_assumptions(kb);
             vs_ty := build_kb( kb_as, "Domain/Apply", vs_ty );

             e1 := do_apply(e, vs, vs_ty, sh);

             # for vn in vs do
             #     if not (e1 :: freeof(vn)) then
             #       ty := KB:-getType(vs_ty, vn);

             #       e1 := subsindets(e1, Not(freeof(vn))
             #                       ,x -> do_mk(x, vs_ty, vn, ty));

             #     end if;
             # end do;

             e1;
           end proc;
    end module;

    export Improve := module ()
           export Simplifiers := table();

           export ModuleLoad := proc($)

             Simplifiers[`LMS`] := (
                 module()

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

                   local orderSols := proc(sol,vs,$)
                     local sol2, solOrder ;

                     # sort the conjs by the number of variables which they mention
                     sol2, solOrder :=
                               sort( sol, key= (x-> -(countVs(vs)(x)))
                                   , output=[sorted,permutation]
                                   );

                   end proc;

                   local classifySol1 :=
                     proc(v, vs_ty, sol :: set({relation,boolean}), ctx, $)
                         local hi, lo, v_t;

                         # try to check if we can extract upper and lower bounds from the
                         # solution directly
                         hi := subsindets( sol , {relation,boolean} , extract_bound_hi(v) );
                         lo := subsindets( sol , {relation,boolean} , extract_bound_lo(v) );

                         if `and`(nops(sol) = 2
                                 ,nops(hi) = 1
                                 ,nops(lo) = 1
                                 ) then
                             v_t := op(1,lo) .. op(1,hi) ;

                             DInto(v, v_t, ctx);
                         else
                             subsindets( ctx, specfunc(`DConstrain`)
                                       , x-> DConstrain(op(x), op(sol))
                                       );
                         end if;
                 end proc;

                 local classifySols := proc(vs, vs_ty, $) proc( sol :: list(set({relation,boolean})), $ )
                    local sol1, ctx, dmk, s, solOrd, vso, v;
                    sol1, solOrd := orderSols(sol, vs);
                    vso := vs[solOrd];

                    sol1 := zip(proc() [_passed] end proc, sol1, vso);

                    ctx := DConstrain();
                    for v in sol1 do
                        ctx := classifySol1(op(2,v), vs_ty, op(1, v), ctx);
                    end do;

                    ctx;
                 end proc; end proc;

                 local classifyAtom := proc(c, vs_ty, $)
                    local ty, mk, bnd, lo, hi;
                    if c :: name then
                        ty := getType(vs_ty, c);

                        mk   := Extract:-MakeOfType(ty);
                        bnd  := ExtBound[mk]:-RangeOf(ty);

                        lo, hi := op(bnd);

                        lo <= c, c <= hi;
                    else
                        c
                    end if;
                 end proc;

                 local postproc := proc(sol, vs, vs_ty, $)
                   local ret := sol;

                   ret := subsindets(ret, set
                                    , s-> map(a-> classifyAtom(a, vs_ty) ,s)
                                    );

                   ret := subsindets(ret, specfunc('piecewise')
                                    , x-> DSplit(Partition:-PWToPartition(x)));

                   ret := subsindets(ret
                                    , Or(identical({}), set(list))
                                    , x -> DSum(op(x)) );

                   ret := subsindets(ret, list(set({relation,boolean}))
                                    , classifySols(vs, vs_ty) );

                   ret;
                 end proc;

                 local do_LMS := proc( ctx, vs_, $ )
                   local vs := vs_, cs, ret;

                   cs := op(3, kb_extract(ctx));
                   cs := {op(cs)};

                  # there are variables to solve for, but no non-trivial
                  # constraints which need to be solved.
                   if cs = {} and not vs = [] then
                     # this matches the output format of LMS; [x,y] -> { [ {true}, {true} ] }
                     ret := { map(o->{true}, vs) };

                   elif not cs = {} and vs = [] then
                       ret := DNoSol("There are no variables to solve for, but there are constraints."
                                   " This means the variables have not been correctly identified.");

                   elif cs = {} and vs = [] then
                       ret := DNoSol("Something went very wrong");

                   else
                       try
                           ret := LinearMultivariateSystem( cs, vs );
                       catch "the system must be linear in %1":
                           ret := DNoSol(sprintf("The system (%a) must be linear in %a."
                                                , cs, vs ));

                       catch "inequality must be linear in %1":
                           ret := DNoSol(sprintf("The system (%a) contains nonlinear inequality in "
                                                "one of %a."
                                                , cs, vs ));
                       end try;

                   end if;

                   ret;
                 end proc;

                 export ModuleApply := proc(dom, $)
                    local dbnds, dshape, db_vars, db_ctx, sol, domKb, domCtx, res;
                    dbnds, dshape := op(dom);
                    db_vars, db_ctx := op(dbnds);

                    sol := do_LMS( ToKB(dom) , db_vars );
                    sol := postproc(sol, db_vars, db_ctx);

                    DOMAIN( dbnds, sol );
                 end proc;

                 end module);

           end proc;

           local cmp_simp := proc(s0, s1, $) proc(dom, $)
              local dom1 := s0(dom);
              if not dom1 :: specfunc(`DNoSol`) then
                  s1(dom1);
              else
                  s1(dom);
              end if;
           end proc; end proc;

           export ModuleApply := proc(dom, $)
               local es := entries(Simplifiers)
                   , mk := foldr( cmp_simp , (x->x), op(es) );
               mk(dom);
           end proc;
    end module;

    uses Hakaru, KB, Partition, SolveTools[Inequality] ;

end module;

  # app_dom_spec_IntSum :=
  #   proc(mk :: identical(Int, Sum), ee, h, kb0 :: t_kb
  #       ,dom_spec_
  #       ,$)
  #   local new_rng, make, var, elim, w,
  #         dom_spec := dom_spec_, e := ee ;

  #   new_rng, dom_spec := selectremove(type, dom_spec,
  #     {`if`(mk=Int, [identical(genLebesgue), name, anything, anything], NULL),
  #      `if`(mk=Sum, [identical(genType), name, specfunc(HInt)], NULL),
  #      [identical(genLet), name, anything]});
  #   if not (new_rng :: [list]) then
  #     error "kb_subtract should return exactly one gen*"
  #   end if;
  #   make    := mk;
  #   new_rng := op(new_rng);
  #   var     := op(2,new_rng);
  #   if op(1,new_rng) = genLebesgue then
  #     new_rng := op(3,new_rng)..op(4,new_rng);
  #   elif op(1,new_rng) = genType then
  #     new_rng := range_of_HInt(op(3,new_rng));
  #   else # op(1,new_rng) = genLet
  #     if mk=Int then
  #         # this was just a return, but now is in its own
  #         # local function and the control flow must be handled
  #         # up above. although calling 'reduce' on 0 will probably
  #         # return immediately anyways(?)
  #         return DONE(0)
  #     else
  #         make := eval;
  #         new_rng := op(3,new_rng)
  #     end if;
  #   end if;

  #   userinfo(3, 'LMS',
  #       printf("    dom-spec        : %a\n"
  #              "    dom-var         : %a\n"
  #        , dom_spec, var ));

  #   e := `*`(e, op(map(proc(a::[identical(assert),anything], $)
  #                        Indicator(op(2,a))
  #                      end proc,
  #                      dom_spec)));

  #   userinfo(3, 'LMS',
  #       printf("    expr-ind        : %a\n"
  #        , e ));

  #   elim := elim_intsum(make(e, var=new_rng), h, kb0);

  #   userinfo(3, 'LMS',
  #       printf("    expr-elimed     : %a\n"
  #        , elim ));

  #   if elim = FAIL then
  #     DONE( reduce_on_prod(p->make(p,var=new_rng), e, var, kb0) );
  #   else
  #     elim
  #   end if;

  # end proc;

  # do_app_dom_spec := proc(mk, e, h, kb0, kb2)
  #     local e2, dom_spec;

  #     dom_spec := kb_subtract(kb2, kb0);

  #     # apply the domain restrictions, which can produce
  #     #   DONE(x) - produced something which can't be simplified further
  #     #   x       - more work to be done
  #     e2 := app_dom_spec_IntSum(mk, e, h, kb0, dom_spec);

  #     userinfo(3, 'LMS',
  #              printf("    expr            : %a\n"
  #                     "    expr after dom  : %a\n"
  #                     , e, e2 ));

  #     if e2 :: specfunc('DONE') then
  #         e2 := op(1,e2);
  #     else
  #         e2 := reduce(e2, h, kb0);
  #         userinfo(3, 'LMS',
  #                  printf("    expr-reduced    : %a\n"
  #                         , e2 ));
  #     end if;

  #     e2;

  # end proc;

    # end if;

    # if e :: 'And(specfunc({Int,Sum}), anyfunc(anything,name=range))' then
    # userinfo(3, 'disint_trace',
    #     printf("case Int/Sum \n"
    #            "  expr : %a\n"
    #            "  h    : %a\n"
    #            "  ctx  : %a\n\n"
    #      , ee, h, kb ));

    #   x, kb1 := `if`(op(0,e)=Int,
    #     genLebesgue(op([2,1],e), op([2,2,1],e), op([2,2,2],e), kb),
    #     genSummation(op([2,1],e), op(op([2,2],e)), kb));
    #   reduce_IntSum(op(0,e),
    #     reduce(subs(op([2,1],e)=x, op(1,e)), h, kb1), h, kb1, kb)

  # reduce_IntSum := proc(mks, h :: name, dom_specw, kb1 :: t_kb, kb0 :: t_kb, $)
  #   local dom_spec, kb2, lmss, vs; # , e2, e3, _;

  #   # if there are domain restrictions, try to apply them
  #   # (dom_specw, e) := getDomainSpec(ee);

  #   kb2 := foldr(assert, kb1, op(dom_specw));

  #   if kb2 :: t_not_a_kb then
  #       error "not a kb: %1 + %2", dom_specw, kb1;
  #   end if;

  #   # userinfo(3, 'disint_trace',
  #   #     printf("reduce_IntSum input:\n"
  #   #            "  integral type: %a\n"
  #   #            "  expr : %a\n"
  #   #            "  h    : %a\n"
  #   #            "  ctx expr  : %a\n"
  #   #            "  ctx above : %a\n"
  #   #            "  ctx below : %a\n\n"
  #   #      , mks, ee, h, kb2, kb1, kb0 ));

  #   lmss := kb_LMS(kb2, mks);

  #   # userinfo(3, 'LMS',
  #   #      printf("    LMS     : %a\n"
  #   #             "    kb Big  : %a\n"
  #   #             "    kb small: %a\n"
  #   #             "    domain  : %a\n"
  #   #             "    var     : %a\n"
  #   #      , lmss, kb2, kb0, dom_spec, h ));

Domain := module()

#   Domain = DOMAIN(DomBound, DomShape)
#   DomBound = DOMBOUND(list(name), KB)
#   DomShape =
#     | DConstrain(relation*)
#     | DSum (DomShape*)
#     | DSplit(Partition(DomShape))
#     | DInto(name, BoundType, DomShape)

    global DOMAIN;
    global DBound;

    global DConstrain;
    global DSum;
    global DSplit;
    global DInto;

    global DNoSol;

    export Has := module ()

       export Bound := proc(e, $)
               assigned(Domain:-ExtBound[op(0,e)]) and
               evalb(e :: Domain:-ExtBound[op(0,e)]:-MapleType);
       end proc;

       export Shape := proc(e, $)
               assigned(Domain:-ExtShape[op(0,e)]) and
               evalb(e :: Domain:-ExtShape[op(0,e)]:-MapleType);
       end proc;

       export ModuleApply := proc(e, $)
               Bound(e) or Shape(e);
       end proc;

    end module;

    export ToKB := module ()

       export Bound := proc(dom, $)
         op(2, dom);
       end proc;

       export Shape := module ()
         export AsConstraints := proc(sh_, $)
           local sh := sh_;

           if sh :: specfunc(`DConstrain`) then
               [ op(sh) ];

           # elif sh :: specfunc(`DSum`) then
           # elif sh :: specfunc(`DSplit`) then

           elif sh :: specfunc(`DInto`) then
               AsConstraints(op(3, sh));
           else
               error "don't know how to apply %1", sh
           end if;

         end proc;

         export ModuleApply := proc(dom, $)
           build_kb(AsConstraints(dom), "Domain/ToKB/Shape");
         end proc;

       end module;

       export ModuleApply := proc(dom, $)
          build_kb( Domain:-ToKB:-Shape:-AsConstraints(op(2,dom)), "Domain/ToKB", Bound(op(1,dom)));
       end proc;
    end module;

    export ExtBound := table();
    export ExtShape := table();

    local ModuleLoad := proc($)
           ExtBound[`Int`] :=
               Record('MakeKB'=(e -> kb -> genLebesgue(op([1],e), op([2,1],e), op([2,2],e), kb))
                     ,'MakeEqn'=`=`
                     ,'MapleType'='And(specfunc({Int}), anyfunc(anything,name=range))'
                     ,'HType'=AlmostEveryReal
                     ,'RangeOf'=
                      (proc(v,$)
                         local lo, hi, lo_b, hi_b, k ;

                         k := nops(v);
                         lo_b, hi_b := -infinity, infinity;

                         if k = 0 then
                            # do nothing

                         elif k = 2 then
                             lo, hi := op(v);
                             lo, lo_b := op(1,lo), op(2, lo);
                             hi, hi_b := op(1,hi), op(2, hi);

                         elif k = 1 then
                             if op([1,1],v) in {`<`, `<=`} then
                                 hi_b := op([1,2], v);
                             elif op([1,1],v) in {`>`, `>=`} then
                                 lo_b := op([1,2], v);
                             else
                                 error "unknown bound %1", op([1,1],v);
                             end if;

                         end if;
                         return lo_b .. hi_b;
                       end proc)
                     );

           ExtBound[`Sum`] :=
               Record('MakeKB'=(e -> kb -> genSummation(op([1],e), op(op([2],e)), kb))
                     ,'MakeEqn'=`=`
                     ,'MapleType'='And(specfunc({Sum}), anyfunc(anything,name=range))'
                     ,'HType'=HInt
                     ,'RangeOf'=KB:-range_of_HInt
                     );

           ExtShape[`Indicator`] :=
               Record('MakeCtx'=(e -> ( {op(1,e)}, 1 ))
                     ,'MapleType'='Indicator(anything)'
                     );

           ExtShape[`PARTITION`] :=
               Record('MakeCtx'=Partition:-Simpl:-single_nonzero_piece
                     ,'MapleType'='Partition'
                     );

    end proc;

    export Extract := module ()

           export MakeOfType := module()
              local makeTable := proc()
                 table([seq( ExtBound[e]:-HType=e,e=[indices(ExtBound,'nolist')])]);
              end proc;

              export ModuleApply := proc(t, $)
                 makeTable()[op(0,t)];
              end proc;
           end module;

           export Bound := module ()
             local do_extract_arg := proc(kb1_, kb, vars, kind, arg_, bound, $)
               local kb1 := kb1_, x0, x, vars1, ty, arg := arg_;

               x0 := op(1, bound);
               x, kb1 := ExtBound[kind]:-MakeKB(bound)(kb1);

               vars1 := [ x, op(vars) ];
               arg   := subs(ExtBound[kind]:-MakeEqn(x0,x), arg);

               do_extract(kb1, kb, vars1, arg);
             end proc;

             local do_extract := proc(kb1, kb, vars, arg, $)
               if Domain:-Has:-Bound(arg) then
                   do_extract_arg(kb1, kb, vars, op(0,arg), op(arg));
               else
                   arg, vars, kb1
               end if;

             end proc;

             export ModuleApply := proc(e, ctx := {empty}, $)
                        local arg, vars, kb;
                        arg, vars, kb := do_extract(ctx, ctx, [], e);

                        arg, DBound(vars, kb);
             end proc;
           end module;

           export Shape := module ()

             local do_get := proc(f, f_ty, $) proc(e, $)
               local sub, inds, rest;
               if e::`*` then
                 sub := map((s -> [do_get(f, f_ty)(s)]), [op(e)]);
                 `union`(op(map2(op,1,sub))), `*`(op(map2(op,2,sub)))
               elif e::`^` then
                 inds, rest := do_get(f, f_ty)(op(1,e));
                 inds, subsop(1=rest, e)
               elif e:: f_ty then
                 f(e)
               else
                 {}, e
               end if

             end proc; end proc;

             local do_gets := proc(todo::list, w, e, $)
                       local t0, ts, w1, e1;
                       if nops(todo) = 0 then
                           w, e
                       else
                           t0 := op(1, todo);
                           ts := op(subsop(1=NULL, todo));
                           if indets(e, specfunc(t0)) <> {} then
                               w1, e1 :=
                                 do_get(ExtShape[t0]:-MakeCtx
                                       ,ExtShape[t0]:-MapleType
                                       )(e);
                               ts := `if`(w1={}, [ts], [ts, t0]);

                               do_gets( ts, w1 union w, e1 );
                           else
                               do_gets( [ ts ], w, e );
                           end if;
                       end if;
             end proc;

             local simpl_shape := (x->x);

             export ModuleApply := proc(e, $)
                        local ixs, w, e1;
                        ixs := [indices(ExtShape, 'nolist')];
                        w, e1 := do_gets(ixs, {}, e);

                        w := DConstrain(op(w));
                        w := simpl_shape(w);

                        w, e1
             end proc;
           end module;

           export ModuleApply := proc(e, $)
                      local b, eb, s, es;
                      b, eb := Bound(e);
                      s, es := Shape(eb);
                      DOMAIN(b, s), es;
           end proc;
    end module;

    export Apply := module ()
           local do_mk := proc(e, vs_ty, vn, ty_, $)
              local mk, rng, ty := ty_;

              if ty :: t_type then
                  mk := Extract:-MakeOfType(ty);
                  rng := Domain:-ExtBound[mk]:-RangeOf(ty);

              elif ty :: `..` then
                  mk := Extract:-MakeOfType( getType(vs_ty, vn) );
                  rng := ty;

              else
                  error "don't know how to make %1", ty
              end if;

              rng := Domain:-ExtBound[mk]:-MakeEqn(vn, rng);

              mk(e, rng);

           end proc;

           local do_apply := proc(e, vs, vs_ty, sh_, $)
              local sh := sh_, e1, vn, vt, shv, ty, vn_ty, kb1;
              if sh :: specfunc(`DConstrain`) then
                  foldr(`*`, e, op( map(c->Indicator(c), sh) ));

              elif sh :: specfunc(`DSum`) then
                  `+`(seq(do_apply(e, vs, vs_ty, s), s=sh))

              elif sh :: specfunc(`DSplit`) then
                  sh := op(1, sh);
                  Partition:-Pmap(p-> do_apply(e, vs, vs_ty, p), sh);

              elif sh :: specfunc(`DInto`) then
                  # deconstruction
                  vn, vt, shv := op(sh);

                  # recursively apply
                  e1 := do_apply(e, [vn], vs_ty, shv);

                  # build this integral
                  do_mk(e1, vs_ty, vn, vt);
              else
                  error "don't know how to apply %1", sh
              end if;
           end proc;

           export ModuleApply := proc(dom, e, kb :: t_kb, $)
             local vs, sh, vs_ty, vn, e1, ty, _, kb_as;
             vs, sh := op(dom);
             vs, vs_ty := op(vs);

             kb_as := kb_to_assumptions(kb);
             vs_ty := build_kb( kb_as, "Domain/Apply", vs_ty );

             e1 := do_apply(e, vs, vs_ty, sh);

             for vn in vs do
                 if not (e1 :: freeof(vn)) then
                   ty := KB:-getType(vs_ty, vn);

                   e1 := subsindets(e1, Not(freeof(vn))
                                   ,x -> do_mk(x, vs_ty, vn, ty));

                 end if;
             end do;

             e1;
           end proc;
    end module;

    export Improve := module ()
           export Simplifiers := table();

           export ModuleLoad := proc($)

             Simplifiers[`LMS`] := (
                 module()

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

                   local orderSols := proc(sol,vs,$)
                     local sol2, solOrder ;

                     # sort the conjs by the number of variables which they mention
                     sol2, solOrder :=
                               sort( sol, key= (x-> -(countVs(vs)(x)))
                                   , output=[sorted,permutation]
                                   );

                   end proc;

                   local classifySol1 :=
                     proc(v, vs_ty, sol :: set({relation,boolean}), ctx, $)
                         local hi, lo, v_t;

                         # try to check if we can extract upper and lower bounds from the
                         # solution directly
                         hi := subsindets( sol , {relation,boolean} , extract_bound_hi(v) );
                         lo := subsindets( sol , {relation,boolean} , extract_bound_lo(v) );

                         if `and`(nops(sol) = 2
                                 ,nops(hi) = 1
                                 ,nops(lo) = 1
                                 ) then
                             v_t := op(1,lo) .. op(1,hi) ;

                             DInto(v, v_t, ctx);
                         else
                             subsindets( ctx, specfunc(`DConstrain`)
                                       , x-> DConstrain(op(x), op(sol))
                                       );
                         end if;
                 end proc;

                 local classifySols := proc(vs, vs_ty, $) proc( sol :: list(set({relation,boolean})), $ )
                    local sol1, ctx, dmk, s, solOrd, vso, v;
                    sol1, solOrd := orderSols(sol, vs);
                    vso := vs[solOrd];

                    sol1 := zip(proc() [_passed] end proc, sol1, vso);

                    ctx := DConstrain();
                    for v in sol1 do
                        ctx := classifySol1(op(2,v), vs_ty, op(1, v), ctx);
                    end do;

                    ctx;
                 end proc; end proc;

                 local postproc := proc(sol, vs, vs_ty, $)
                   local ret := sol;

                   ret := subsindets(ret, specfunc('piecewise')
                                    , x-> DSplit(Partition:-PWToPartition(x)));

                   ret := subsindets(ret
                                    , Or(identical({}), set(list))
                                    , x -> DSum(op(x)) );

                   ret := subsindets(ret, list(set({relation,boolean}))
                                    , classifySols(vs, vs_ty) );

                   ret;
                 end proc;

                 local do_LMS := proc( ctx, vs_, $ )
                   local vs := vs_, cs, ret;

                   cs := op(3, kb_extract(ctx));
                   cs := {op(cs)};

                  # there are variables to solve for, but no non-trivial
                  # constraints which need to be solved.
                   if cs = {} and not vs = [] then
                     # this matches the output format of LMS; [x,y] -> { [ {true}, {true} ] }
                     ret := { map(o->{true}, vs) };

                   elif not cs = {} and vs = [] then
                       ret := DNoSol("There are no variables to solve for, but there are constraints."
                                   " This means the variables have not been correctly identified.");

                   elif cs = {} and vs = [] then
                       ret := DNoSol("Something went very wrong");

                   else
                       try
                           ret := LinearMultivariateSystem( cs, vs );
                       catch "the system must be linear in %1":
                           ret := DNoSol(sprintf("The system (%a) must be linear in %a."
                                                , cs, vs ));

                       catch "inequality must be linear in %1":
                           ret := DNoSol(sprintf("The system (%a) contains nonlinear inequality in "
                                                "one of %a."
                                                , cs, vs ));
                       end try;

                   end if;

                   lprint(ret);
                   ret;
                 end proc;

                 export ModuleApply := proc(dom, $)
                    local dbnds, dshape, db_vars, db_ctx, sol, domKb, domCtx, res;
                    dbnds, dshape := op(dom);
                    db_vars, db_ctx := op(dbnds);

                    sol := do_LMS( ToKB(dom) , db_vars );
                    sol := postproc(sol, db_vars, db_ctx);

                    DOMAIN( dbnds, sol );
                 end proc;

                 end module);

           end proc;

           local cmp_simp := proc(s0, s1, $) proc(dom, $)
              local dom1 := s0(dom);
              if not dom1 :: specfunc(`DNoSol`) then
                  s1(dom1);
              else
                  s1(dom);
              end if;
           end proc; end proc;

           export ModuleApply := proc(dom, $)
               local es := entries(Simplifiers)
                   , mk := foldr( cmp_simp , (x->x), op(es) );
               mk(dom);
           end proc;
    end module;

    uses Hakaru, KB, Partition, SolveTools[Inequality] ;

end module;

  # app_dom_spec_IntSum :=
  #   proc(mk :: identical(Int, Sum), ee, h, kb0 :: t_kb
  #       ,dom_spec_
  #       ,$)
  #   local new_rng, make, var, elim, w,
  #         dom_spec := dom_spec_, e := ee ;

  #   new_rng, dom_spec := selectremove(type, dom_spec,
  #     {`if`(mk=Int, [identical(genLebesgue), name, anything, anything], NULL),
  #      `if`(mk=Sum, [identical(genType), name, specfunc(HInt)], NULL),
  #      [identical(genLet), name, anything]});
  #   if not (new_rng :: [list]) then
  #     error "kb_subtract should return exactly one gen*"
  #   end if;
  #   make    := mk;
  #   new_rng := op(new_rng);
  #   var     := op(2,new_rng);
  #   if op(1,new_rng) = genLebesgue then
  #     new_rng := op(3,new_rng)..op(4,new_rng);
  #   elif op(1,new_rng) = genType then
  #     new_rng := range_of_HInt(op(3,new_rng));
  #   else # op(1,new_rng) = genLet
  #     if mk=Int then
  #         # this was just a return, but now is in its own
  #         # local function and the control flow must be handled
  #         # up above. although calling 'reduce' on 0 will probably
  #         # return immediately anyways(?)
  #         return DONE(0)
  #     else
  #         make := eval;
  #         new_rng := op(3,new_rng)
  #     end if;
  #   end if;

  #   userinfo(3, 'LMS',
  #       printf("    dom-spec        : %a\n"
  #              "    dom-var         : %a\n"
  #        , dom_spec, var ));

  #   e := `*`(e, op(map(proc(a::[identical(assert),anything], $)
  #                        Indicator(op(2,a))
  #                      end proc,
  #                      dom_spec)));

  #   userinfo(3, 'LMS',
  #       printf("    expr-ind        : %a\n"
  #        , e ));

  #   elim := elim_intsum(make(e, var=new_rng), h, kb0);

  #   userinfo(3, 'LMS',
  #       printf("    expr-elimed     : %a\n"
  #        , elim ));

  #   if elim = FAIL then
  #     DONE( reduce_on_prod(p->make(p,var=new_rng), e, var, kb0) );
  #   else
  #     elim
  #   end if;

  # end proc;

  # do_app_dom_spec := proc(mk, e, h, kb0, kb2)
  #     local e2, dom_spec;

  #     dom_spec := kb_subtract(kb2, kb0);

  #     # apply the domain restrictions, which can produce
  #     #   DONE(x) - produced something which can't be simplified further
  #     #   x       - more work to be done
  #     e2 := app_dom_spec_IntSum(mk, e, h, kb0, dom_spec);

  #     userinfo(3, 'LMS',
  #              printf("    expr            : %a\n"
  #                     "    expr after dom  : %a\n"
  #                     , e, e2 ));

  #     if e2 :: specfunc('DONE') then
  #         e2 := op(1,e2);
  #     else
  #         e2 := reduce(e2, h, kb0);
  #         userinfo(3, 'LMS',
  #                  printf("    expr-reduced    : %a\n"
  #                         , e2 ));
  #     end if;

  #     e2;

  # end proc;

    # end if;

    # if e :: 'And(specfunc({Int,Sum}), anyfunc(anything,name=range))' then
    # userinfo(3, 'disint_trace',
    #     printf("case Int/Sum \n"
    #            "  expr : %a\n"
    #            "  h    : %a\n"
    #            "  ctx  : %a\n\n"
    #      , ee, h, kb ));

    #   x, kb1 := `if`(op(0,e)=Int,
    #     genLebesgue(op([2,1],e), op([2,2,1],e), op([2,2,2],e), kb),
    #     genSummation(op([2,1],e), op(op([2,2],e)), kb));
    #   reduce_IntSum(op(0,e),
    #     reduce(subs(op([2,1],e)=x, op(1,e)), h, kb1), h, kb1, kb)

  # reduce_IntSum := proc(mks, h :: name, dom_specw, kb1 :: t_kb, kb0 :: t_kb, $)
  #   local dom_spec, kb2, lmss, vs; # , e2, e3, _;

  #   # if there are domain restrictions, try to apply them
  #   # (dom_specw, e) := getDomainSpec(ee);

  #   kb2 := foldr(assert, kb1, op(dom_specw));

  #   if kb2 :: t_not_a_kb then
  #       error "not a kb: %1 + %2", dom_specw, kb1;
  #   end if;

  #   # userinfo(3, 'disint_trace',
  #   #     printf("reduce_IntSum input:\n"
  #   #            "  integral type: %a\n"
  #   #            "  expr : %a\n"
  #   #            "  h    : %a\n"
  #   #            "  ctx expr  : %a\n"
  #   #            "  ctx above : %a\n"
  #   #            "  ctx below : %a\n\n"
  #   #      , mks, ee, h, kb2, kb1, kb0 ));

  #   lmss := kb_LMS(kb2, mks);

  #   # userinfo(3, 'LMS',
  #   #      printf("    LMS     : %a\n"
  #   #             "    kb Big  : %a\n"
  #   #             "    kb small: %a\n"
  #   #             "    domain  : %a\n"
  #   #             "    var     : %a\n"
  #   #      , lmss, kb2, kb0, dom_spec, h ));