Add try_eval_Root; and a little bit of cleanup of reduce_Integrals

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

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

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

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

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

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

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

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

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

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

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

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

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

    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:-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 := proc(expr, h, kb, opts, $)
    local rr, elim;
    rr := Domain:-Reduce(expr, kb
      ,proc() elim_intsum:-for_Domain(h,args) end proc
      ,((x,kb1)->reduce(x,h,kb1,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;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

  end module;


remove saving of SLO and Haskell modules.

lib := "ppaml.mla":
if FileTools:-Exists(lib) then FileTools:-Remove(lib) end if:
LibraryTools:-Create(lib):

read("./NewSLO.mpl"):
LibraryTools:-Save(`depends/Integrand`, lib):
LibraryTools:-Save(`depends/LO`, lib):
LibraryTools:-Save(`depends/lam`, lib):
LibraryTools:-Save(`depends/Branch`, lib):
LibraryTools:-Save(pattern_binds, lib):
LibraryTools:-Save(`depends/Bind`, lib):
LibraryTools:-Save(`depends/ary`, lib):
LibraryTools:-Save(generic_evalat, lib):
LibraryTools:-Save(`eval/Integrand`, lib):
LibraryTools:-Save(`eval/LO`, lib):
LibraryTools:-Save(`eval/lam`, lib):
LibraryTools:-Save(`eval/Branch`, lib):
LibraryTools:-Save(`eval/Bind`, lib):
LibraryTools:-Save(`eval/ary`, lib):
LibraryTools:-Save(`gensym`, lib):
LibraryTools:-Save('NewSLO', lib):

lib := "ppaml.mla":
if FileTools:-Exists(lib) then FileTools:-Remove(lib) end if:
LibraryTools:-Create(lib):

read("./Haskell.mpl"):
LibraryTools:-Save(Haskell, lib):

read("./SLO.mpl"):
LibraryTools:-Save(SLO, lib):
LibraryTools:-Save(`evalapply/if_`, lib):
LibraryTools:-Save(`evalapply/Pair`, lib):
# LibraryTools:-Save(`evalapply/piecewise`, lib):
LibraryTools:-Save(`if_`, lib):
LibraryTools:-Save(`fst`, lib):
LibraryTools:-Save(`snd`, lib):
LibraryTools:-Save(`unpair`, lib):
LibraryTools:-Save(`uneither`, lib):
LibraryTools:-Save(`WeightedM`, lib):
LibraryTools:-Save(`Superpose`, lib):
LibraryTools:-Save(`Bind`, lib):
LibraryTools:-Save(`If`, lib):
LibraryTools:-Save('`type/Context`', lib):
#LibraryTools:-Save(`index/TopProp`, lib):
#LibraryTools:-Save(`gensym`, lib): # use the one from NewSLO.mpl
LibraryTools:-Save(`MVECTOR`, lib):
LibraryTools:-Save(`Reduce`, lib):
LibraryTools:-Save(`vindex`, lib):
LibraryTools:-Save(`vsize`, lib):

read("./NewSLO.mpl"):
LibraryTools:-Save(`depends/Integrand`, lib):
LibraryTools:-Save(`depends/LO`, lib):
LibraryTools:-Save(`depends/lam`, lib):
LibraryTools:-Save(`depends/Branch`, lib):
LibraryTools:-Save(pattern_binds, lib):
LibraryTools:-Save(`depends/Bind`, lib):
LibraryTools:-Save(`depends/ary`, lib):
LibraryTools:-Save(generic_evalat, lib):
LibraryTools:-Save(`eval/Integrand`, lib):
LibraryTools:-Save(`eval/LO`, lib):
LibraryTools:-Save(`eval/lam`, lib):
LibraryTools:-Save(`eval/Branch`, lib):
LibraryTools:-Save(`eval/Bind`, lib):
LibraryTools:-Save(`eval/ary`, lib):
LibraryTools:-Save(`gensym`, lib):
LibraryTools:-Save('NewSLO', lib):


Silly bug

Silly bug

local LMS := module()
    # We use the opposite "integration order" than LMS, so
    # reverse the variables. The scare quotes are because LMS
    # knows nothing about domains or integration, but it does
    # try to place the first variable "outermost" (probably
    # because it solves for each variable one by one, at starts
    # at the left) which will flip things around for no reason.
    export ModuleApply := proc(dbnds :: DomBound, dshape :: DomShape, $)
        local vs;
        vs := ListTools[Reverse](Domain:-Bound:-varsOf(dbnds));
        vs := map(v->if v::list then op(1,v) else v end if, vs);
        do_LMS( dshape , dbnds, vs );
    end proc;

    local countVs := vs -> (c-> nops(indets(c, name) intersect {op(vs)} ));
    # Sorts the solutions so that resulting integrals are
    # well-scoped
    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;

    # given a solution for a single variable,
    # either extracts upper and/or lower bounds from the solution
    # or leaves that solution as a constraint.
    local classifySol1 := proc(sol :: set({relation,boolean}), v, 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);
        elif nops(sol) = 1 and (nops(hi) = 1 or nops(lo) = 1) then
            lo := `if`( nops(lo) = 1 , op(1,lo), -infinity );
            hi := `if`( nops(hi) = 1 , op(1,hi),  infinity );
            v_t := lo .. hi;
            DInto(v, v_t, ctx);
        else
            subsindets( ctx, DomConstrain
                        , x-> DConstrain(op(x), op(sol)));
        end if;
    end proc;

    # Orders the solution, then classifies each solution, and
    # builds the single solution with the correct variable order.
    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(v), ctx);
        end do; ctx;
    end proc; end proc;

    # transforms the solution to the form required by Domain
    # this would be a straightforward syntactic manipulation,
    # but for the facts that we have to:
    #  decide the order of integration
    #  decide which solutions become integrations and which
    #     become constrains
    local postproc := proc(sol, ctx, vs, $)
        local ret := sol;
        ret := subsindets(ret, specfunc('piecewise')
                         , x-> DSplit(Partition:-PWToPartition(x, 'do_solve')));
        ret := subsindets(ret
                         , Or(identical({}), set(list))
                         , x -> DSum(op(x)) );
        # vs := Domain:-Bound:-varsOf(ctx);
        # `true' (produced by LMS for trivial systems) - to the
        #    interval for the variable corresponding to this index in
        #    the sequence.
        # `c : name' - to the interval for `v'
        # everything else - to itself
        ret := subsindets(ret, list(set({relation,boolean, name}))
                         , classifySols(vs, ctx) @
                          (ls->map(si->remove(x->x::identical(true) or x::name, si), ls)) );
        subsindets(ret,[DomShape],op);
    end proc;

    # Note this will not simplify solutions, in the sense that if
    # there are multiple places to apply LMS, the resulting
    # solution after applying LMS is not simplified any
    # further. This should probably be done by a seperate
    # simplifier.
    local do_LMS := proc( sh :: DomShape, ctx :: DomBound, vs, $)
        local sol;
        if sh :: DomConstrain then
            sol := do_LMS_Constrain(sh, ctx, vs);
            if sol :: DomShape then
                sol
            else
                postproc(sol, ctx, vs);
            end if;
        elif sh :: DomSplit then
            # todo: incorporate piece condition into context
            DSplit( Partition:-Pmap(p->do_LMS(p, ctx, vs), op(1, sh)) );
        elif sh :: DomSum then
            map(s->do_LMS(s, ctx, vs), sh);
        else
            DNoSol(sprintf("Don't know how to solve DOMAIN(%a, %a)", ctx, sh));
        end if;
    end proc;

    # ask Maple for a solution to our system
    local do_LMS_Constrain := proc( sh :: DomConstrain , ctx, vs_, $ )
        local vs := vs_, cs, do_rn, ret;
        cs := { op( Domain:-Bound:-toConstraints(ctx,'no_infinity') )
              , op(sh) } ;
        if nops(ctx) >= 2 then
          # LMS doesn't understand constraints (those are excluded by default
          # in Bound:-toConstraints)
          cs := remove(x->not(x::{`<`,`<=`,`=`}), cs union op(2,ctx));
        end if;

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

local LMS := module()
    # We use the opposite "integration order" than LMS, so
    # reverse the variables. The scare quotes are because LMS
    # knows nothing about domains or integration, but it does
    # try to place the first variable "outermost" (probably
    # because it solves for each variable one by one, at starts
    # at the left) which will flip things around for no reason.
    export ModuleApply := proc(dbnds :: DomBound, dshape :: DomShape, $)
        local vs;
        vs := ListTools[Reverse](Domain:-Bound:-varsOf(dbnds));
        vs := map(v->if v::list then op(1,v) else v end if, vs);
        do_LMS( dshape , dbnds, vs );
    end proc;

    local countVs := vs -> (c-> nops(indets(c, name) intersect {op(vs)} ));
    # Sorts the solutions so that resulting integrals are
    # well-scoped
    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;

    # given a solution for a single variable,
    # either extracts upper and/or lower bounds from the solution
    # or leaves that solution as a constraint.
    local classifySol1 := proc(sol :: set({relation,boolean}), v, 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);
        elif nops(sol) = 1 and (nops(hi) = 1 or nops(lo) = 1) then
            lo := `if`( nops(lo) = 1 , op(1,lo), -infinity );
            hi := `if`( nops(hi) = 1 , op(1,hi),  infinity );
            v_t := lo .. hi;
            DInto(v, v_t, ctx);
        else
            subsindets( ctx, DomConstrain
                        , x-> DConstrain(op(x), op(sol)));
        end if;
    end proc;

    # Orders the solution, then classifies each solution, and
    # builds the single solution with the correct variable order.
    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(v), ctx);
        end do; ctx;
    end proc; end proc;

    # transforms the solution to the form required by Domain
    # this would be a straightforward syntactic manipulation,
    # but for the facts that we have to:
    #  decide the order of integration
    #  decide which solutions become integrations and which
    #     become constrains
    local postproc := proc(sol, ctx, vs, $)
        local ret := sol;
        ret := subsindets(ret, specfunc('piecewise')
                         , x-> DSplit(Partition:-PWToPartition(x, 'do_solve')));
        ret := subsindets(ret
                         , Or(identical({}), set(list))
                         , x -> DSum(op(x)) );
        # vs := Domain:-Bound:-varsOf(ctx);
        # `true' (produced by LMS for trivial systems) - to the
        #    interval for the variable corresponding to this index in
        #    the sequence.
        # `c : name' - to the interval for `v'
        # everything else - to itself
        subsindets(ret, list(set({relation,boolean, name}))
                      , classifySols(vs, ctx) @
                        (ls->map(si->remove(x->x::identical(true) or x::name, si), ls)) );
        subsindets(ret,[DomShape],op);
    end proc;

    # Note this will not simplify solutions, in the sense that if
    # there are multiple places to apply LMS, the resulting
    # solution after applying LMS is not simplified any
    # further. This should probably be done by a seperate
    # simplifier.
    local do_LMS := proc( sh :: DomShape, ctx :: DomBound, vs, $)
        local sol;
        if sh :: DomConstrain then
            sol := do_LMS_Constrain(sh, ctx, vs);
            if sol :: DomShape then
                sol
            else
                postproc(sol, ctx, vs);
            end if;
        elif sh :: DomSplit then
            # todo: incorporate piece condition into context
            DSplit( Partition:-Pmap(p->do_LMS(p, ctx, vs), op(1, sh)) );
        elif sh :: DomSum then
            map(s->do_LMS(s, ctx, vs), sh);
        else
            DNoSol(sprintf("Don't know how to solve DOMAIN(%a, %a)", ctx, sh));
        end if;
    end proc;

    # ask Maple for a solution to our system
    local do_LMS_Constrain := proc( sh :: DomConstrain , ctx, vs_, $ )
        local vs := vs_, cs, do_rn, ret;
        cs := { op( Domain:-Bound:-toConstraints(ctx,'no_infinity') )
              , op(sh) } ;
        if nops(ctx) >= 2 then
          # LMS doesn't understand constraints (those are excluded by default
          # in Bound:-toConstraints)
          cs := remove(x->not(x::{`<`,`<=`,`=`}), cs union op(2,ctx));
        end if;

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


Revert "Domain:-Apply shouldn't do any solving/simplification"
This change was unneccessary; it doesn't particularly make any difference
here whether we return Partition or piecewise, but we want to move away
from piecewise wherever possible.

This reverts commit 1def90bf8160892990aa051e23b919acf4613c02.

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

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