Generalize get_indicators (partially)

Generalize get_indicators (partially)

# Step 2 of 3: computer algebra

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

Domain_extract_bound[`Int`] := e -> kb -> genLebesgue(op([1],e), op([2,1],e), op([2,2],e), kb);
Domain_extract_bound[`Sum`] := e -> kb -> genSummation(op([1],e), op(op([2],e)), kb);

Domain_bound_type[`Int`] := 'And(specfunc({Int}), anyfunc(anything,name=range))';
Domain_bound_type[`Sum`] := 'And(specfunc({Sum}), anyfunc(anything,name=range))';

Domain_type_make[`AlmostEveryReal`] := `Int`;
Domain_type_make[`HInt`] := `Sum`;
Domain_type_make[`EveryInteger`] := eval(Domain_type_make[`HInt`]);

has_Domain := proc(e,$)
    assigned(Domain_bound_type[op(0,e)]) and evalb(e :: Domain_bound_type[op(0,e)]);
end proc;

  extract_Domain := proc(h, kb1_, kb, vars, kind, arg_, bound,$)
      local kb1 := kb1_, x0, x, vars1, ty, arg := arg_;

      x0 := op(1, bound);
      x, kb1 := Domain_extract_bound[kind](bound)(kb1);

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

      if has_Domain(arg) then
          extract_Domain(h, kb1, kb, vars1, op(0,arg), op(arg));
      else
          arg, vars1, kb1
      end if;
  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, $)
    local e, subintegral, w, ww, x, c, kb1;
    e := ee;

    if has_Domain(e) then
        body, vars, kb1 := extract_Domain(h, kb, kb, [], op(0,e), op(e));

        userinfo(3, 'disint_trace',
                 printf("domain extract:\n"
                        "  body : %a\n"
                        "  vars : %a\n"
                        "  kb   : %a\n\n"
                        , body, vars, kb1 ));

        reduce_IntSum( vars, reduce(body, h, kb1), h, kb1, kb );

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

    elif e :: 'And(specfunc({Ints,Sums}),
                   anyfunc(anything, name, range, list(name=range)))' then
      x, kb1 := genType(op(2,e),
                        mk_HArray(`if`(op(0,e)=Ints,
                                       HReal(open_bounds(op(3,e))),
                                       HInt(closed_bounds(op(3,e)))),
                                  op(4,e)),
                        kb);
      if nops(op(4,e)) > 0 then
        kb1 := assert(size(x)=op([4,-1,2,2],e)-op([4,-1,2,1],e)+1, kb1);
      end if;
      reduce_IntsSums(op(0,e), reduce(subs(op(2,e)=x, op(1,e)), h, kb1), x,
        op(3,e), op(4,e), h, kb1)
    elif e :: 'applyintegrand(anything, anything)' then
      map(simplify_assuming, e, kb)
    elif e :: `+` then
      map(reduce, e, h, kb)
    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), 'list', `*`);
      (subintegral, ww) := selectremove(depends, subintegral, h);
      reduce_pw(simplify_factor_assuming(`*`(w, op(ww)), kb))
        * `*`(op(subintegral));
    elif e :: t_pw then
      e:= flatten_piecewise(e);
      e := kb_piecewise(e, kb, simplify_assuming,
                        ((rhs, kb) -> %reduce(rhs, h, kb)));
      e := eval(e, %reduce=reduce);
      # big hammer: simplify knows about bound variables, amongst many
      # other things
      Testzero := x -> evalb(simplify(x) = 0);
      e := reduce_pw(e);
      e;
    elif e :: t_case then
      subsop(2=map(proc(b :: Branch(anything, anything))
                     eval(subsop(2='reduce'(op(2,b),x,c),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);
    elif e :: '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)), e)
    else
      simplify_assuming(e, kb)
    end if;
  end proc;

  app_dom_spec_IntSum_LMS :=
   proc( ee
       , sol_, vs_
       , $)

      local sol := sol_, vs := vs_, e := ee, er, kb1, i
          , sol1, sol2, op_rng
          , v, v_t, lo, hi, lo_s, hi_s
          , vnms, countVs, countVsInRels, solOrder ;

      # vnms := map(x->op(1,x), indets(vs, 'Introduce(name, anything)'));
      # vnms    := [op(map(i->op(1,i), op(1, kb_extract(vs))))] ;
      vnms    := map(v->op(1,v), vs);
      countVs := (c-> nops(indets(c, name) intersect {op(vnms)} ));
      countVsInRels :=
        (c-> nops(indets(map(o-> op(1..2,o), indets(c, relation)), name)));

      if sol :: identical({}) then
          # an empty solution
          er := 0;

      elif sol :: set(list) then
          # a formal (algebraic?) sum of solutions.
          er := `+`(seq( app_dom_spec_IntSum_LMS(e, s, vs)
                 , s=sol)
             );

          if nops(sol)>1 then
              userinfo(3, 'disint_trace',
                       printf("sum of solutions\n"
                          "  result: %a\n"
                          "  sol  : %a\n\n"
                          , er, sol_ ));
          end if;

      elif sol :: set({relation,boolean}) then
          # a single atomic solution, with (hopefully) at most two conjuncts
          # one which becomes incorporated into the lower bound, and the other
          # into the upper bound

          ASSERT(nops(vs)=1);
          v, v_t0 := op(op(1,vs));

          mk := Domain_type_make[op(0,v_t0)];

          # v := op([1,1],vs); # KB(Introduce(v,..))

          v, kb1 := genType(v, v_t0, empty);

          kb1 := foldl(proc(a,b) assert(b,a) end proc
                      ,kb1
                      ,op(sol)
                      );

          hi := subsindets( sol , {relation,boolean} , extract_bound_hi(v) );
          lo := subsindets( sol , {relation,boolean} , extract_bound_lo(v) );

          # this logic should really be inside KB
          if `and`(nops(sol) = 2
                  ,nops(hi) = 1
                  ,nops(lo) = 1
                  ) then
              v_t := op(1,lo) .. op(1,hi) ;

          else
              # TODO: should probably check that `mk` matches the type,
              # otherwise we are solving something we weren't asked to solve (?)
              v_t := getType(kb1, v);
              v_t := kb_range_of_var(v_t);

          end if;

          # er := reduce_on_prod( p -> mk(p, v=v_t)
          #               , e, v, kb1 );

          er := mk(e, v=v_t);

          userinfo(5, 'disint_trace',
                   printf("applied solution: %a\n"
                          "  result    : %a\n"
                          "  expr body : %a\n\n"
                          , sol_, er, e ));

      elif sol :: list then
          # a (nonempty, hopefully) conjunction of constraints which
          # are hopefully in a nice form...

          # if we have fewer conjuncts than variables, pad the conjunts
          # with trivial solutions (for the recursive call)
          if nops(sol) < nops(vs) then
              sol := [ seq( {true} , _=1..(nops(vs) - nops(sol)) )  , sol ];
          end if;

          op_rng := seq(1..nops(sol));

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

          if nops(sol) > 1 then
              userinfo(5, 'disint_trace',
                   printf("rearranged solutions\n"
                          "  sol   : %a\n"
                          "  permuation: %a\n\n"
                          , sol, solOrder ));
          end if;

          sol := sol2;

          # check that the `k'th (from 1) conjunct mentions at most `k'
          # variables. we can (hopefully) integrate these things in
          # a way that differentiation (due to disintegration) eliminates
          # the integral, by making the body free of that integration variable

          # when nops(sol) is 1, then "i in 1..1" gives us "1,1". but "seq(1,1)"
          # is "1".
          for i in op_rng do
              ASSERT(countVs(op(-i,sol)) <= i);
          end do;

          # get the list of variables in the order we hope to integrate
          vnms := vnms[solOrder];

          # to each variable, the range of integration is given in the
          # context. the range will be contracted as we apply the solution
          # starting with the leftmost solution, apply them all
          # hopefully this should only produce valid integrals (i.e. we've done
          # enough checks to guarantee it)
          for i in op_rng do
              sol1 := op(i, sol);

              e := app_dom_spec_IntSum_LMS
                     ( e
                     , sol1
                     , select(c->depends(c, vnms[i]), vs)
                     ) ;

          end do;

          # maybe simplify here...
          er := e

      elif sol :: Partition then

          e := PARTITION((
            map(proc (cl,$)

                userinfo(5, 'disint_trace',
                   printf("partition piece\n"
                          "  sub sol: %a\n"
                          "  ctx    : %a\n\n"
                         , valOf(cl), condOf(cl) ));

                Piece( condOf(cl)
                      , app_dom_spec_IntSum_LMS
                  ( e
                  , valOf(cl)
                  , vs
                  ) )

                    end proc
                , op(1,sol) )
              ));

          er := e;

      else
          # can't deal with such solutions (what are they?)
          er := FAIL

      end if;

      er;

  end proc;

  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;

  # Helper function for performing reductions
  # given an "ee" and a "var", pulls the portion
  # of "ee" not depending on "var" out, and applies "f"
  # to the portion depending on "var".
  # the 'weights' (factors not depending on "var") are simplified
  # under the given assumption context, "kb0"
  reduce_on_prod := proc(f,ee,var::name,kb0::t_kb,$)
      local e := ee, w;
      e, w := selectremove(depends, list_of_mul(e), var);
      reduce_pw(simplify_factor_assuming(`*`(op(w)), kb0)) * f(`*`(op(e))) ;
  end proc;

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

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

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

    ASSERT(type(kb2,t_kb), "reduce_IntSum : domain spec KB contains a contradiction.");

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

    # try
          if not lmss :: specfunc('NoSol') then
              lmss, vs, _ := op(lmss);

              if lmss :: 'piecewise' then
                  lmss := PWToPartition(lmss) ;
              end if;

              # userinfo(3, 'LMS',
              #          printf("    LMS-pp   : %a\n"
              #                 "    LMS-vs   : %a\n"
              #                 , lmss, vs ));

              e2 := app_dom_spec_IntSum_LMS( e, lmss, vs );

              # userinfo(3, 'LMS',
              #          printf("    expr LMS     : %a\n"
              #                 "    expr LMS - s : %a\n"
              #                 , e2, simplify(e2) ));

              if e2 :: identical('FAIL') then
                  error "LMS: failed to apply (%a, %a)", lmss, vs
              end if;

              # e3 := elim_intsum(e2, h, kb0);

              # if e3 <> FAIL then
                  # e2 := e3;
                  # e2 := reduce(e3, h, kb0);
              # end if;

          else
              error "LMS: no solution(%s)", op(1,lmss), ""
          end if;
    # catch:
    #       userinfo(3, 'LMS',
    #                printf("    LMS threw an error: %a\n"
    #                       , lastexception ));

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

    # userinfo(3, 'disint_trace',
    #     printf("In `reduce_IntSum': fallback on old solution\n"
    #            "  expr :%a\n"
    #            "  res  :%a\n"
    #            "  ctx below :%a\n"
    #            "  ctx above :%a\n"
    #      , e, e2, kb0, kb2 ));

    # end try;

    e2;

  end proc;

  reduce_IntsSums := proc(makes, ee, var::name, rng, bds, h::name, kb::t_kb, $)
    local e, elim;
    # TODO we should apply domain restrictions like reduce_IntSum does.
    e := makes(ee, var, rng, bds);
    elim := elim_intsum(e, h, kb);
    if elim = FAIL then e else reduce(elim, h, kb) end if
  end proc;

  getDomainSpec := module
     local get_indicators := proc(e, $)
       local sub, inds, rest;
       if e::`*` then
         sub := map((s -> [get_indicators(s)]), [op(e)]);
         `union`(op(map2(op,1,sub))), `*`(op(map2(op,2,sub)))
       elif e::`^` then
         inds, rest := get_indicators(op(1,e));
         inds, subsop(1=rest, e)
       elif e::'Indicator(anything)' then
         {op(1,e)}, 1
       else
         {}, e
       end if
     end proc;

     local getPartitionDom := proc(e, $)
               local zs, nzs, nz;
               if e :: Partition then
                   zs, nzs := selectremove(p -> Testzero(valOf(p)), op(1, e));

                   if nops(nzs) = 1 then
                       nz := op(1,nzs);
                       {condOf(nz), valOf(nz)}
                   else
                       {}, e
                   end if;
               else
                   {}, e
               end if;
     end proc;

     export ModuleApply :=
      proc(e, $)
            local e1 := e, inds0, inds1;

            inds0, e1 := get_indicators(e1);
            inds1, e1 := getPartitionDom(e1);

            inds0 union inds1, e1;
     end proc;

  end module;

  elim_intsum := proc(e, h :: name, kb :: t_kb, $)
    local t, var, f, elim;
    t := 'applyintegrand'('identical'(h), 'anything');
    if e :: Int(anything, name=anything) and
       not depends(indets(op(1,e), t), op([2,1],e)) then
      var := op([2,1],e);
      f := 'int_assuming';
    elif e :: Sum(anything, name=anything) and
       not depends(indets(op(1,e), t), op([2,1],e)) then
      var := op([2,1],e);
      f := 'sum_assuming';
    elif e :: Ints(anything, name, range, list(name=range)) and
         not depends(indets(op(1,e), t), op(2,e)) then
      var := op(2,e);
      f := 'ints';
    elif e :: Sums(anything, name, range, list(name=range)) and
         not depends(indets(op(1,e), t), op(2,e)) then
      var := op(2,e);
      f := 'sums';
    else
      return FAIL;
    end if;
    # try to eliminate unused var
    elim := banish(op(1,e), h, kb, infinity, var,
      proc (kb,g,$) do_elim_intsum(kb, f, g, op(2..-1,e)) end proc);
    if has(elim, {MeijerG, undefined, FAIL}) or e = elim or elim :: SymbolicInfinity then
      return FAIL;
    end if;
    elim
  end proc;

  do_elim_intsum := proc(kb, f, ee, v::{name,name=anything})
    local w, e, x, g, t, r;
    w, e := get_indicators(ee);
    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;

  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;

  reduce_pw := proc(ee, $) # ee may or may not be piecewise
    local e;
    e := nub_piecewise(ee);
    if e :: t_pw then
      if nops(e) = 2 then
        return Indicator(op(1,e)) * op(2,e)
      elif nops(e) = 3 and Testzero(op(2,e)) then
        return Indicator(Not(op(1,e))) * op(3,e)
      elif nops(e) = 3 and Testzero(op(3,e)) then
        return Indicator(op(1,e))*op(2,e)
      elif nops(e) = 4 and Testzero(op(2,e)) then
        return Indicator(And(Not(op(1,e)),op(3,e))) * op(4,e)
      end if
    end if;
    return e
  end proc;

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

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

# Step 2 of 3: computer algebra

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

Domain_extract_bound[`Int`] := e -> kb -> genLebesgue(op([1],e), op([2,1],e), op([2,2],e), kb);
Domain_extract_bound[`Sum`] := e -> kb -> genSummation(op([1],e), op(op([2],e)), kb);

Domain_bound_type[`Int`] := 'And(specfunc({Int}), anyfunc(anything,name=range))';
Domain_bound_type[`Sum`] := 'And(specfunc({Sum}), anyfunc(anything,name=range))';

Domain_type_make[`AlmostEveryReal`] := `Int`;
Domain_type_make[`HInt`] := `Sum`;
Domain_type_make[`EveryInteger`] := eval(Domain_type_make[`HInt`]);

has_Domain := proc(e,$)
    assigned(Domain_bound_type[op(0,e)]) and evalb(e :: Domain_bound_type[op(0,e)]);
end proc;

  extract_Domain := proc(h, kb1_, kb, vars, kind, arg_, bound,$)
      local kb1 := kb1_, x0, x, vars1, ty, arg := arg_;

      x0 := op(1, bound);
      x, kb1 := Domain_extract_bound[kind](bound)(kb1);

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

      if has_Domain(arg) then
          extract_Domain(h, kb1, kb, vars1, op(0,arg), op(arg));
      else
          arg, vars1, kb1
      end if;
  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, $)
    local e, subintegral, w, ww, x, c, kb1;
    e := ee;

    if has_Domain(e) then
        body, vars, kb1 := extract_Domain(h, kb, kb, [], op(0,e), op(e));

        userinfo(3, 'disint_trace',
                 printf("domain extract:\n"
                        "  body : %a\n"
                        "  vars : %a\n"
                        "  kb   : %a\n\n"
                        , body, vars, kb1 ));

        reduce_IntSum( vars, reduce(body, h, kb1), h, kb1, kb );

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

    elif e :: 'And(specfunc({Ints,Sums}),
                   anyfunc(anything, name, range, list(name=range)))' then
      x, kb1 := genType(op(2,e),
                        mk_HArray(`if`(op(0,e)=Ints,
                                       HReal(open_bounds(op(3,e))),
                                       HInt(closed_bounds(op(3,e)))),
                                  op(4,e)),
                        kb);
      if nops(op(4,e)) > 0 then
        kb1 := assert(size(x)=op([4,-1,2,2],e)-op([4,-1,2,1],e)+1, kb1);
      end if;
      reduce_IntsSums(op(0,e), reduce(subs(op(2,e)=x, op(1,e)), h, kb1), x,
        op(3,e), op(4,e), h, kb1)
    elif e :: 'applyintegrand(anything, anything)' then
      map(simplify_assuming, e, kb)
    elif e :: `+` then
      map(reduce, e, h, kb)
    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), 'list', `*`);
      (subintegral, ww) := selectremove(depends, subintegral, h);
      reduce_pw(simplify_factor_assuming(`*`(w, op(ww)), kb))
        * `*`(op(subintegral));
    elif e :: t_pw then
      e:= flatten_piecewise(e);
      e := kb_piecewise(e, kb, simplify_assuming,
                        ((rhs, kb) -> %reduce(rhs, h, kb)));
      e := eval(e, %reduce=reduce);
      # big hammer: simplify knows about bound variables, amongst many
      # other things
      Testzero := x -> evalb(simplify(x) = 0);
      e := reduce_pw(e);
      e;
    elif e :: t_case then
      subsop(2=map(proc(b :: Branch(anything, anything))
                     eval(subsop(2='reduce'(op(2,b),x,c),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);
    elif e :: '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)), e)
    else
      simplify_assuming(e, kb)
    end if;
  end proc;

  app_dom_spec_IntSum_LMS :=
   proc( ee
       , sol_, vs_
       , $)

      local sol := sol_, vs := vs_, e := ee, er, kb1, i
          , sol1, sol2, op_rng
          , v, v_t, lo, hi, lo_s, hi_s
          , vnms, countVs, countVsInRels, solOrder ;

      # vnms := map(x->op(1,x), indets(vs, 'Introduce(name, anything)'));
      # vnms    := [op(map(i->op(1,i), op(1, kb_extract(vs))))] ;
      vnms    := map(v->op(1,v), vs);
      countVs := (c-> nops(indets(c, name) intersect {op(vnms)} ));
      countVsInRels :=
        (c-> nops(indets(map(o-> op(1..2,o), indets(c, relation)), name)));

      if sol :: identical({}) then
          # an empty solution
          er := 0;

      elif sol :: set(list) then
          # a formal (algebraic?) sum of solutions.
          er := `+`(seq( app_dom_spec_IntSum_LMS(e, s, vs)
                 , s=sol)
             );

          if nops(sol)>1 then
              userinfo(3, 'disint_trace',
                       printf("sum of solutions\n"
                          "  result: %a\n"
                          "  sol  : %a\n\n"
                          , er, sol_ ));
          end if;

      elif sol :: set({relation,boolean}) then
          # a single atomic solution, with (hopefully) at most two conjuncts
          # one which becomes incorporated into the lower bound, and the other
          # into the upper bound

          ASSERT(nops(vs)=1);
          v, v_t0 := op(op(1,vs));

          mk := Domain_type_make[op(0,v_t0)];

          # v := op([1,1],vs); # KB(Introduce(v,..))

          v, kb1 := genType(v, v_t0, empty);

          kb1 := foldl(proc(a,b) assert(b,a) end proc
                      ,kb1
                      ,op(sol)
                      );

          hi := subsindets( sol , {relation,boolean} , extract_bound_hi(v) );
          lo := subsindets( sol , {relation,boolean} , extract_bound_lo(v) );

          # this logic should really be inside KB
          if `and`(nops(sol) = 2
                  ,nops(hi) = 1
                  ,nops(lo) = 1
                  ) then
              v_t := op(1,lo) .. op(1,hi) ;

          else
              # TODO: should probably check that `mk` matches the type,
              # otherwise we are solving something we weren't asked to solve (?)
              v_t := getType(kb1, v);
              v_t := kb_range_of_var(v_t);

          end if;

          # er := reduce_on_prod( p -> mk(p, v=v_t)
          #               , e, v, kb1 );

          er := mk(e, v=v_t);

          userinfo(5, 'disint_trace',
                   printf("applied solution: %a\n"
                          "  result    : %a\n"
                          "  expr body : %a\n\n"
                          , sol_, er, e ));

      elif sol :: list then
          # a (nonempty, hopefully) conjunction of constraints which
          # are hopefully in a nice form...

          # if we have fewer conjuncts than variables, pad the conjunts
          # with trivial solutions (for the recursive call)
          if nops(sol) < nops(vs) then
              sol := [ seq( {true} , _=1..(nops(vs) - nops(sol)) )  , sol ];
          end if;

          op_rng := seq(1..nops(sol));

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

          if nops(sol) > 1 then
              userinfo(5, 'disint_trace',
                   printf("rearranged solutions\n"
                          "  sol   : %a\n"
                          "  permuation: %a\n\n"
                          , sol, solOrder ));
          end if;

          sol := sol2;

          # check that the `k'th (from 1) conjunct mentions at most `k'
          # variables. we can (hopefully) integrate these things in
          # a way that differentiation (due to disintegration) eliminates
          # the integral, by making the body free of that integration variable

          # when nops(sol) is 1, then "i in 1..1" gives us "1,1". but "seq(1,1)"
          # is "1".
          for i in op_rng do
              ASSERT(countVs(op(-i,sol)) <= i);
          end do;

          # get the list of variables in the order we hope to integrate
          vnms := vnms[solOrder];

          # to each variable, the range of integration is given in the
          # context. the range will be contracted as we apply the solution
          # starting with the leftmost solution, apply them all
          # hopefully this should only produce valid integrals (i.e. we've done
          # enough checks to guarantee it)
          for i in op_rng do
              sol1 := op(i, sol);

              e := app_dom_spec_IntSum_LMS
                     ( e
                     , sol1
                     , select(c->depends(c, vnms[i]), vs)
                     ) ;

          end do;

          # maybe simplify here...
          er := e

      elif sol :: Partition then

          e := PARTITION((
            map(proc (cl,$)

                userinfo(5, 'disint_trace',
                   printf("partition piece\n"
                          "  sub sol: %a\n"
                          "  ctx    : %a\n\n"
                         , valOf(cl), condOf(cl) ));

                Piece( condOf(cl)
                      , app_dom_spec_IntSum_LMS
                  ( e
                  , valOf(cl)
                  , vs
                  ) )

                    end proc
                , op(1,sol) )
              ));

          er := e;

      else
          # can't deal with such solutions (what are they?)
          er := FAIL

      end if;

      er;

  end proc;

  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;

  # Helper function for performing reductions
  # given an "ee" and a "var", pulls the portion
  # of "ee" not depending on "var" out, and applies "f"
  # to the portion depending on "var".
  # the 'weights' (factors not depending on "var") are simplified
  # under the given assumption context, "kb0"
  reduce_on_prod := proc(f,ee,var::name,kb0::t_kb,$)
      local e := ee, w;
      e, w := selectremove(depends, list_of_mul(e), var);
      reduce_pw(simplify_factor_assuming(`*`(op(w)), kb0)) * f(`*`(op(e))) ;
  end proc;

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

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

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

    ASSERT(type(kb2,t_kb), "reduce_IntSum : domain spec KB contains a contradiction.");

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

    # try
          if not lmss :: specfunc('NoSol') then
              lmss, vs, _ := op(lmss);

              if lmss :: 'piecewise' then
                  lmss := PWToPartition(lmss) ;
              end if;

              # userinfo(3, 'LMS',
              #          printf("    LMS-pp   : %a\n"
              #                 "    LMS-vs   : %a\n"
              #                 , lmss, vs ));

              e2 := app_dom_spec_IntSum_LMS( e, lmss, vs );

              # userinfo(3, 'LMS',
              #          printf("    expr LMS     : %a\n"
              #                 "    expr LMS - s : %a\n"
              #                 , e2, simplify(e2) ));

              if e2 :: identical('FAIL') then
                  error "LMS: failed to apply (%a, %a)", lmss, vs
              end if;

              # e3 := elim_intsum(e2, h, kb0);

              # if e3 <> FAIL then
                  # e2 := e3;
                  # e2 := reduce(e3, h, kb0);
              # end if;

          else
              error "LMS: no solution(%s)", op(1,lmss), ""
          end if;
    # catch:
    #       userinfo(3, 'LMS',
    #                printf("    LMS threw an error: %a\n"
    #                       , lastexception ));

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

    # userinfo(3, 'disint_trace',
    #     printf("In `reduce_IntSum': fallback on old solution\n"
    #            "  expr :%a\n"
    #            "  res  :%a\n"
    #            "  ctx below :%a\n"
    #            "  ctx above :%a\n"
    #      , e, e2, kb0, kb2 ));

    # end try;

    e2;

  end proc;

  reduce_IntsSums := proc(makes, ee, var::name, rng, bds, h::name, kb::t_kb, $)
    local e, elim;
    # TODO we should apply domain restrictions like reduce_IntSum does.
    e := makes(ee, var, rng, bds);
    elim := elim_intsum(e, h, kb);
    if elim = FAIL then e else reduce(elim, h, kb) end if
  end proc;

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

  elim_intsum := proc(e, h :: name, kb :: t_kb, $)
    local t, var, f, elim;
    t := 'applyintegrand'('identical'(h), 'anything');
    if e :: Int(anything, name=anything) and
       not depends(indets(op(1,e), t), op([2,1],e)) then
      var := op([2,1],e);
      f := 'int_assuming';
    elif e :: Sum(anything, name=anything) and
       not depends(indets(op(1,e), t), op([2,1],e)) then
      var := op([2,1],e);
      f := 'sum_assuming';
    elif e :: Ints(anything, name, range, list(name=range)) and
         not depends(indets(op(1,e), t), op(2,e)) then
      var := op(2,e);
      f := 'ints';
    elif e :: Sums(anything, name, range, list(name=range)) and
         not depends(indets(op(1,e), t), op(2,e)) then
      var := op(2,e);
      f := 'sums';
    else
      return FAIL;
    end if;
    # try to eliminate unused var
    elim := banish(op(1,e), h, kb, infinity, var,
      proc (kb,g,$) do_elim_intsum(kb, f, g, op(2..-1,e)) end proc);
    if has(elim, {MeijerG, undefined, FAIL}) or e = elim or elim :: SymbolicInfinity then
      return FAIL;
    end if;
    elim
  end proc;

  do_elim_intsum := proc(kb, f, ee, v::{name,name=anything})
    local w, e, x, g, t, r;
    w, e := get_indicators(ee);
    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;

  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;

  reduce_pw := proc(ee, $) # ee may or may not be piecewise
    local e;
    e := nub_piecewise(ee);
    if e :: t_pw then
      if nops(e) = 2 then
        return Indicator(op(1,e)) * op(2,e)
      elif nops(e) = 3 and Testzero(op(2,e)) then
        return Indicator(Not(op(1,e))) * op(3,e)
      elif nops(e) = 3 and Testzero(op(3,e)) then
        return Indicator(op(1,e))*op(2,e)
      elif nops(e) = 4 and Testzero(op(2,e)) then
        return Indicator(And(Not(op(1,e)),op(3,e))) * op(4,e)
      end if
    end if;
    return e
  end proc;

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

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


Re-enable this check

Re-enable this check

(now that it is not too strong)

# 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));
  _Env_HakaruSolve := true;
  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, w1, ww, x, c, kb1, with_kb1, dom_specw, dom_specb
       , body, dom_spec, ed, mkDom, vars, rr;
  e := ee;

  rr := reduce_Integrals(e, h, kb, opts);
  if rr <> FAIL then return rr end if;
  if e :: 'applyintegrand(anything, anything)' then
    applyop(reduce_scalar, 2, e, kb)
  elif can_reduce_Partition(e) then
    reduce_Partition(e,h,kb,opts,false)
  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);
    w := `*`(w,op(ww));
    w1 := simplify_factor_assuming(w, kb);
    if w1 = w then
      w := subsindets[flat](w, t_pw_or_part, x->reduce_Partition(x,h,kb,opts,false));
    else w := w1; end if;
    w * `*`(op(subintegral));
  elif e :: t_case then
    subsop(2=map(proc(b :: Branch(anything, anything))
                   eval(subsop(2='reduce'(op(2,b),x,c,opts),b),
                        {x=h, c=kb})
                 end proc,
                 op(2,e)),
           e);
  elif e :: 'Context(anything, anything)' then
    kb1 := assert(op(1,e), kb);
    # A contradictory `Context' implies anything, so produce 'anything'
    # In particular, 42 :: t_Hakaru = false, so a term under a false
    # assumption should never be inspected in any way.
    if kb1 :: t_not_a_kb then
        return 42
    end if;
    applyop(reduce, 2, e, h, kb1, opts);
  elif e :: 'toLO:-integrate(anything, Integrand(name, anything), list)' then
    x := gensym(op([2,1],e));
    # If we had HType information for op(1,e),
    # then we could use it to tell kb about x.
    subsop(2=Integrand(x, reduce(subs(op([2,1],e)=x, op([2,2],e)), h, kb, opts)), e)
  else
    simplify_assuming(e, kb)
  end if;
end proc;

reduce_scalar := proc(e, kb :: t_kb, $)
  foldr(((f,x)->f(x,kb)), e
        ,simplify_assuming
        ,Partition:-Simpl
        ,(x->subsindets(x, t_pw, PWToPartition))
       );
end proc;

# Returns true for expressions for which we could conceivably
# do a Partition simplification.
can_reduce_Partition := proc(e,$)
  local ps;
  if   type(e,Or(Partition,t_pw)) then true
  elif type(e,{indices(Partition:-Simpl:-distrib_op_Partition,nolist)}) then
    # in this case, we hope to apply PProd and then maybe do some cleanup; this
    # is only possible if the expression has at least two sub-Partitions.
    ps := select(can_reduce_Partition, convert(e,list));
    ps := map(Partition:-PWToPartition_mb, indets(ps, t_pw_or_part));
    if nops(ps) < 2 then return false; end if;

    # We also only do this simplification if the Partitions have the same pieces.
    andmap(p->SamePartition(((a,b)->true),`=`,p,op(1,ps)), [op(2..-1,ps)]);
  else false
  end if;
end proc;

# Same as reduce, but for Partitions; and contains an additional flag which,
# when true, checks `can_reduce_Partition' (when the check is false, there is a
# great chance this function will throw an error!)
reduce_Partition := proc(ee,h::name,kb::t_kb,opts::list,do_check::truefalse, $)
  local e := ee;
  if do_check and not(can_reduce_Partition(e)) then return e end if;

  e := subsindets(e, t_pw, PWToPartition);
  e := Partition:-Simpl(e, kb);

  # This is necessary because subsequent calls to kb_Partition do not work on
  # nested Partitions; but Simpl calls flatten, which should gives us a
  # Partition on the top level.
  e := (`if`(e::Partition,do_reduce_Partition,reduce))(e, h, kb, opts);
  if ee::t_pw and e :: Partition then
    e := Partition:-PartitionToPW(e);
  end if;
  e;
end proc;

do_reduce_Partition := proc(ee,h::name,kb::t_kb,opts::list,$)
  local e := ee;
  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 := Partition:-Simpl(e, kb);
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
  # tries to evaluate Int/Sum/Ints/Sums
  , elim_intsum;

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

  ModuleApply := proc(expr, h, kb, opts, $)
    local rr;
    rr := Domain:-Reduce(expr, kb
      ,curry(reduce_Integrals_into,h,opts)
      ,curry(reduce_Integrals_body,h,opts)
      ,(_->:-DOM_FAIL), opts);
    rr := Partition:-Simpl(rr, kb);
    if has(rr, :-DOM_FAIL) then
      return FAIL;
    elif has(rr, FAIL) then
      error "Something strange happened in reduce_Integral(%a, %a, %a, %a)\n%a"
           , expr, kb, kb, opts, rr;
    end if;
    rr;
  end proc;

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

  # Try to find an eliminate (by evaluation, or simplification) integrals which
  # are free of `applyintegrand`s.
  elim_intsum := module ()
    export ModuleApply := proc(inert0, h :: name, kb :: t_kb, opts, $)
       local ex, e, inert := inert0;
       ex := extract_elim(inert, h, kb);
       e[0] := apply_elim(h, kb, ex);
       e[1] := check_elim(inert, e[0]);
       if e[1] = FAIL then inert
       else
         e[2] := reduce(e[1],h,kb,opts);
         if has(e[2], {csgn}) then
           WARNING("Throwing away an eliminated result result containing csgn (this "
                   "could be a bug!):\n%1\n(while running %2)", e[2], ex);
           inert;
         else e[2] end if;
       end if
    end proc;

    local known_tys := table([Int=int_assuming,Sum=sum_assuming,Ints=ints,Sums=sums]);
    # Returns FAIL if we probably can't eliminate this intsum, or
    # the work to be done as a list:
    #  [ intsum body, intsum function, primary var, other var args ]
    local extract_elim := proc(e, h::name, kb::t_kb,$)
      local t, intapps, var, f, e_k, e_args, vs, blo, bhi,
            case_var, cond_case_var;
      vs := {op(KB:-kb_to_variables(kb))};
      t := 'applyintegrand'('identical'(h), 'anything');
      intapps := indets(op(1,e), t);
      if intapps = {} then
        return FAIL;
      end if;
      e_k := op(0,e); e_args := op([2..-1],e);
      if Domain:-Has:-Bound(e) and assigned(known_tys[e_k]) then
        var := Domain:-ExtBound[e_k]:-ExtractVar(e_args);
        ASSERT(var::DomBoundVar);
        blo, bhi := Domain:-ExtBound[e_k]:-SplitRange
                    (Domain:-ExtBound[e_k]:-ExtractRange(e_args));
        if ormap(b->op(1,b) in map((q-> (q,-q)), vs) and op(2,b)::SymbolicInfinity
                ,[[blo,bhi],[bhi,blo]]) then
          return FAIL end if; # This is something that `disint` wants to see unevaluated
        if var :: list then var := op(1,var) end if;
        case_var := c->hastype(c, 'idx'(list,name));
        cond_case_var := p->Partition:-ConditionsSatisfy(p,case_var);

        # independant of `h' - this is a weight
        if not depends(intapps, var)
        # A sum whose bounds are literals and which contains a
        # `case(idx(<literal array>, ...)) ...', or
        # `idx(<literal array>, ...' inside a `Ret'
        or (e_k in {Sum,Sums} and andmap(b->b::And(realcons,integer),[blo,bhi])
            and (hastype(op(1,e),
                           {And(Partition, satisfies(cond_case_var)),
                            And(t_pw, satisfies(cond_case_var@PWToPartition))})
                 or hastype(intapps, satisfies(case_var))))
        then f := known_tys[e_k];
        else return FAIL;
        end if;
      else
        error "extract_elim was passed something which is not an intsum: %1", e;
      end if;
      [ op(1,e), f, var, [e_args] ];
    end proc;

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

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

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

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

sum_assuming := proc(e, v::name=anything, kb::t_kb)
  local r;
  r := simplify_factor_assuming('sum'(e, v), kb);
  if r::specfunc(`sum`) then sum(op(r)) else r; end if;
end proc;

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

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

# Step 2 of 3: computer algebra

improve := proc(lo :: LO(name, anything), {_ctx :: t_kb := empty}, opts := [], $)
local r, `&context`;
  userinfo(5, improve, "input: ", print(lo &context _ctx));
  _Env_HakaruSolve := true;
  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, w1, ww, x, c, kb1, with_kb1, dom_specw, dom_specb
       , body, dom_spec, ed, mkDom, vars, rr;
  e := ee;

  rr := reduce_Integrals(e, h, kb, opts);
  if rr <> FAIL then return rr end if;
  if e :: 'applyintegrand(anything, anything)' then
    applyop(reduce_scalar, 2, 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);
    w := `*`(w,op(ww));
    w1 := simplify_factor_assuming(w, kb);
    if w1 = w then
      w := subsindets[flat](w, t_pw_or_part, x->reduce_Partition(x,h,kb,opts,false));
    else w := w1; end if;
    w * `*`(op(subintegral));
  elif e :: Or(Partition,t_pw) then
    reduce_Partition(e,h,kb,opts,false)
  elif e :: t_case then
    subsop(2=map(proc(b :: Branch(anything, anything))
                   eval(subsop(2='reduce'(op(2,b),x,c,opts),b),
                        {x=h, c=kb})
                 end proc,
                 op(2,e)),
           e);
  elif e :: 'Context(anything, anything)' then
    kb1 := assert(op(1,e), kb);
    # A contradictory `Context' implies anything, so produce 'anything'
    # In particular, 42 :: t_Hakaru = false, so a term under a false
    # assumption should never be inspected in any way.
    if kb1 :: t_not_a_kb then
        return 42
    end if;
    applyop(reduce, 2, e, h, kb1, opts);
  elif e :: 'toLO:-integrate(anything, Integrand(name, anything), list)' then
    x := gensym(op([2,1],e));
    # If we had HType information for op(1,e),
    # then we could use it to tell kb about x.
    subsop(2=Integrand(x, reduce(subs(op([2,1],e)=x, op([2,2],e)), h, kb, opts)), e)
  else
    simplify_assuming(e, kb)
  end if;
end proc;

reduce_scalar := proc(e, kb :: t_kb, $)
  foldr(((f,x)->f(x,kb)), e
        ,simplify_assuming
        ,Partition:-Simpl
        ,(x->subsindets(x, t_pw, PWToPartition))
       );
end proc;

# Returns true for expressions for which we could conceivably
# do a Partition simplification.
can_reduce_Partition := proc(e,$)
  local ps;
  if   type(e,Or(Partition,t_pw)) then true
  elif type(e,{indices(Partition:-Simpl:-distrib_op_Partition,nolist)}) then
    # in this case, we hope to apply PProd and then maybe do some cleanup; this
    # is only possible if the expression has at least two sub-Partitions.
    ps := select(can_reduce_Partition, convert(e,list));
    ps := map(Partition:-PWToPartition_mb, indets(ps, t_pw_or_part));
    if nops(ps) < 2 then return false; end if;

    # We also only do this simplification if the Partitions have the same pieces.
    andmap(p->SamePartition(((a,b)->true),`=`,p,op(1,ps)), [op(2..-1,ps)]);
  else false
  end if;
end proc;

# Same as reduce, but for Partitions; and contains an additional flag which,
# when true, checks `can_reduce_Partition' (when the check is false, there is a
# great chance this function will throw an error!)
reduce_Partition := proc(ee,h::name,kb::t_kb,opts::list,do_check::truefalse, $)
  local e := ee;
  if do_check and not(can_reduce_Partition(e)) then return e end if;

  e := subsindets(e, t_pw, PWToPartition);
  e := Partition:-Simpl(e, kb);

  # This is necessary because subsequent calls to kb_Partition do not work on
  # nested Partitions; but Simpl calls flatten, which should gives us a
  # Partition on the top level.
  e := (`if`(e::Partition,do_reduce_Partition,reduce))(e, h, kb, opts);
  if ee::t_pw and e :: Partition then
    e := Partition:-PartitionToPW(e);
  end if;
  e;
end proc;

do_reduce_Partition := proc(ee,h::name,kb::t_kb,opts::list,$)
  local e := ee;
  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 := Partition:-Simpl(e, kb);
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
  # tries to evaluate Int/Sum/Ints/Sums
  , elim_intsum;

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

  ModuleApply := proc(expr, h, kb, opts, $)
    local rr;
    rr := Domain:-Reduce(expr, kb
      ,curry(reduce_Integrals_into,h,opts)
      ,curry(reduce_Integrals_body,h,opts)
      ,(_->:-DOM_FAIL), opts);
    rr := Partition:-Simpl(rr, kb);
    if has(rr, :-DOM_FAIL) then
      return FAIL;
    elif has(rr, FAIL) then
      error "Something strange happened in reduce_Integral(%a, %a, %a, %a)\n%a"
           , expr, kb, kb, opts, rr;
    end if;
    rr;
  end proc;

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

  # Try to find an eliminate (by evaluation, or simplification) integrals which
  # are free of `applyintegrand`s.
  elim_intsum := module ()
    export ModuleApply := proc(inert0, h :: name, kb :: t_kb, opts, $)
       local ex, e, inert := inert0;
       ex := extract_elim(inert, h, kb);
       e[0] := apply_elim(h, kb, ex);
       e[1] := check_elim(inert, e[0]);
       if e[1] = FAIL then inert
       else
         e[2] := reduce(e[1],h,kb,opts);
         if has(e[2], {csgn}) then
           WARNING("Throwing away an eliminated result result containing csgn (this "
                   "could be a bug!):\n%1\n(while running %2)", e[2], ex);
           inert;
         else e[2] end if;
       end if
    end proc;

    local known_tys := table([Int=int_assuming,Sum=sum_assuming,Ints=ints,Sums=sums]);
    # Returns FAIL if we probably can't eliminate this intsum, or
    # the work to be done as a list:
    #  [ intsum body, intsum function, primary var, other var args ]
    local extract_elim := proc(e, h::name, kb::t_kb,$)
      local t, intapps, var, f, e_k, e_args, vs, blo, bhi,
            case_var, cond_case_var;
      vs := {op(KB:-kb_to_variables(kb))};
      t := 'applyintegrand'('identical'(h), 'anything');
      intapps := indets(op(1,e), t);
      if intapps = {} then
        return FAIL;
      end if;
      e_k := op(0,e); e_args := op([2..-1],e);
      if Domain:-Has:-Bound(e) and assigned(known_tys[e_k]) then
        var := Domain:-ExtBound[e_k]:-ExtractVar(e_args);
        ASSERT(var::DomBoundVar);
        blo, bhi := Domain:-ExtBound[e_k]:-SplitRange
                    (Domain:-ExtBound[e_k]:-ExtractRange(e_args));
        if ormap(b->op(1,b) in map((q-> (q,-q)), vs) and op(2,b)::SymbolicInfinity
                ,[[blo,bhi],[bhi,blo]]) then
          return FAIL end if; # This is something that `disint` wants to see unevaluated
        if var :: list then var := op(1,var) end if;
        case_var := c->hastype(c, 'idx'(list,name));
        cond_case_var := p->Partition:-ConditionsSatisfy(p,case_var);

        # independant of `h' - this is a weight
        if not depends(intapps, var)
        # A sum whose bounds are literals and which contains a
        # `case(idx(<literal array>, ...)) ...', or
        # `idx(<literal array>, ...' inside a `Ret'
        or (e_k in {Sum,Sums} and andmap(b->b::And(realcons,integer),[blo,bhi])
            and (hastype(op(1,e),
                           {And(Partition, satisfies(cond_case_var)),
                            And(t_pw, satisfies(cond_case_var@PWToPartition))})
                 or hastype(intapps, satisfies(case_var))))
        then f := known_tys[e_k];
        else return FAIL;
        end if;
      else
        error "extract_elim was passed something which is not an intsum: %1", e;
      end if;
      [ op(1,e), f, var, [e_args] ];
    end proc;

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

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

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

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

sum_assuming := proc(e, v::name=anything, kb::t_kb)
  local r;
  r := simplify_factor_assuming('sum'(e, v), kb);
  if r::specfunc(`sum`) then sum(op(r)) else r; end if;
end proc;

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

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


Export GobyWebPluginRunner lib in the test language.

<?xml version="1.0" encoding="UTF-8"?>
<language namespace="org.campagnelab.gobyweb.plugins.test" uuid="489e31af-0445-4cbf-894b-a4bab1f18426">
  <models>
    <modelRoot contentPath="${module}" type="default">
      <sourceRoot location="languageModels" />
    </modelRoot>
    <modelRoot contentPath="${module}" type="java_classes">
      <sourceRoot location="GobyWebPluginRunner-1.0.jar" />
    </modelRoot>
  </models>
  <accessoryModels />
  <generators>
    <generator name="" generatorUID="org.campagnelab.gobyweb.plugins.test#3827903497649027977" uuid="19499a97-9cf5-4e08-9862-e5728789bd87">
      <models>
        <modelRoot contentPath="${module}" type="default">
          <sourceRoot location="generator/template" />
        </modelRoot>
      </models>
      <external-templates />
      <dependencies>
        <dependency reexport="true">6354ebe7-c22a-4a0f-ac54-50b52ab9b065(JDK)</dependency>
        <dependency reexport="false">f3061a53-9226-4cc5-a443-f952ceaf5816(jetbrains.mps.baseLanguage)</dependency>
        <dependency reexport="false">f61473f9-130f-42f6-b98d-6c438812c2f6(jetbrains.mps.baseLanguage.unitTest)</dependency>
        <dependency reexport="false">83f155ff-422c-4b5a-a2f2-b459302dd215(jetbrains.mps.baseLanguage.unitTest.libs)</dependency>
        <dependency reexport="false">642f71f8-327a-425b-84f9-44ad58786d27(jetbrains.mps.lang.project.modules)</dependency>
        <dependency reexport="false">7620dd3f-7541-48a3-b1e6-01cced81a7a5(org.campagnelab.clusterConfig)</dependency>
        <dependency reexport="false">a8fb88b0-7e9f-478c-aab4-a1b076131192(org.campagnelab.gobyweb.interactive)</dependency>
        <dependency reexport="true">0202ed86-955d-4227-9c20-377dd6b1f9ff(org.campagnelab.nyosh.lib)</dependency>
        <dependency reexport="false">901f5cf3-dc77-4c1e-bc5a-6382baee28b4(org.campagnelab.textoutput)</dependency>
        <dependency reexport="false">3b3d39a8-ff6e-47f3-9c9e-1888a27699ed(org.campagnelab.util)</dependency>
      </dependencies>
      <usedLanguages>
        <usedLanguage>b401a680-8325-4110-8fd3-84331ff25bef(jetbrains.mps.lang.generator)</usedLanguage>
        <usedLanguage>d7706f63-9be2-479c-a3da-ae92af1e64d5(jetbrains.mps.lang.generator.generationContext)</usedLanguage>
        <usedLanguage>489e31af-0445-4cbf-894b-a4bab1f18426(org.campagnelab.gobyweb.plugins.test)</usedLanguage>
        <usedLanguage>0202ed86-955d-4227-9c20-377dd6b1f9ff(org.campagnelab.nyosh.lib)</usedLanguage>
        <usedLanguage>901f5cf3-dc77-4c1e-bc5a-6382baee28b4(org.campagnelab.textoutput)</usedLanguage>
      </usedLanguages>
      <usedDevKits>
        <usedDevKit>fbc25dd2-5da4-483a-8b19-70928e1b62d7(jetbrains.mps.devkit.general-purpose)</usedDevKit>
      </usedDevKits>
      <mapping-priorities />
    </generator>
  </generators>
  <stubModelEntries>
    <stubModelEntry path="${module}/GobyWebPluginRunner-1.0.jar" />
  </stubModelEntries>
  <sourcePath />
  <dependencies>
    <dependency reexport="true">6354ebe7-c22a-4a0f-ac54-50b52ab9b065(JDK)</dependency>
    <dependency reexport="false">6ed54515-acc8-4d1e-a16c-9fd6cfe951ea(MPS.Core)</dependency>
    <dependency reexport="false">498d89d2-c2e9-11e2-ad49-6cf049e62fe5(MPS.IDEA)</dependency>
    <dependency reexport="false">8865b7a8-5271-43d3-884c-6fd1d9cfdd34(MPS.OpenAPI)</dependency>
    <dependency reexport="false">f3061a53-9226-4cc5-a443-f952ceaf5816(jetbrains.mps.baseLanguage)</dependency>
    <dependency reexport="false">760a0a8c-eabb-4521-8bfd-65db761a9ba3(jetbrains.mps.baseLanguage.logging)</dependency>
    <dependency reexport="false">e39e4a59-8cb6-498e-860e-8fa8361c0d90(jetbrains.mps.baseLanguage.scopes)</dependency>
    <dependency reexport="false">f61473f9-130f-42f6-b98d-6c438812c2f6(jetbrains.mps.baseLanguage.unitTest)</dependency>
    <dependency reexport="false">83f155ff-422c-4b5a-a2f2-b459302dd215(jetbrains.mps.baseLanguage.unitTest.libs)</dependency>
    <dependency reexport="false">c7d01124-66d5-486d-8b50-7fdccb60b839(jetbrains.mps.baseLanguage.util)</dependency>
    <dependency reexport="false">2d3c70e9-aab2-4870-8d8d-6036800e4103(jetbrains.mps.kernel)</dependency>
    <dependency reexport="false">ceab5195-25ea-4f22-9b92-103b95ca8c0c(jetbrains.mps.lang.core)</dependency>
    <dependency reexport="false">9ded098b-ad6a-4657-bfd9-48636cfe8bc3(jetbrains.mps.lang.traceable)</dependency>
    <dependency reexport="false">f8e20673-3f65-44e9-84c0-c4a4b6ede37e(jetbrains.mps.make.facets)</dependency>
    <dependency reexport="false">a1250a4d-c090-42c3-ad7c-d298a3357dd4(jetbrains.mps.make.runtime)</dependency>
    <dependency reexport="false">df9d410f-2ebb-43f7-893a-483a4f085250(jetbrains.mps.smodel.resources)</dependency>
    <dependency reexport="false">7620dd3f-7541-48a3-b1e6-01cced81a7a5(org.campagnelab.clusterConfig)</dependency>
    <dependency reexport="false">adfd00cb-58d7-4094-bca8-f941a491e04f(org.campagnelab.gobyweb)</dependency>
    <dependency reexport="false">57af9408-ffae-472e-9367-5cb44434e8b3(org.campagnelab.gobyweb.interactive.users)</dependency>
    <dependency reexport="false">0b7d8bbd-896e-495e-be60-01a0d738a649(org.campagnelab.gobyweb.plugins)</dependency>
    <dependency reexport="false">82ffebe3-3685-4fd9-b560-0c1d348d295c(org.campagnelab.logger)</dependency>
    <dependency reexport="false">0202ed86-955d-4227-9c20-377dd6b1f9ff(org.campagnelab.nyosh.lib)</dependency>
    <dependency reexport="false">3b3d39a8-ff6e-47f3-9c9e-1888a27699ed(org.campagnelab.util)</dependency>
  </dependencies>
  <usedLanguages>
    <usedLanguage>760a0a8c-eabb-4521-8bfd-65db761a9ba3(jetbrains.mps.baseLanguage.logging)</usedLanguage>
    <usedLanguage>63650c59-16c8-498a-99c8-005c7ee9515d(jetbrains.mps.lang.access)</usedLanguage>
    <usedLanguage>af65afd8-f0dd-4942-87d9-63a55f2a9db1(jetbrains.mps.lang.behavior)</usedLanguage>
    <usedLanguage>b401a680-8325-4110-8fd3-84331ff25bef(jetbrains.mps.lang.generator)</usedLanguage>
    <usedLanguage>28f9e497-3b42-4291-aeba-0a1039153ab1(jetbrains.mps.lang.plugin)</usedLanguage>
    <usedLanguage>d8f591ec-4d86-4af2-9f92-a9e93c803ffa(jetbrains.mps.lang.scopes)</usedLanguage>
    <usedLanguage>13744753-c81f-424a-9c1b-cf8943bf4e86(jetbrains.mps.lang.sharedConcepts)</usedLanguage>
    <usedLanguage>696c1165-4a59-463b-bc5d-902caab85dd0(jetbrains.mps.make.facet)</usedLanguage>
    <usedLanguage>a8fb88b0-7e9f-478c-aab4-a1b076131192(org.campagnelab.gobyweb.interactive)</usedLanguage>
    <usedLanguage>57af9408-ffae-472e-9367-5cb44434e8b3(org.campagnelab.gobyweb.interactive.users)</usedLanguage>
    <usedLanguage>0b7d8bbd-896e-495e-be60-01a0d738a649(org.campagnelab.gobyweb.plugins)</usedLanguage>
    <usedLanguage>82ffebe3-3685-4fd9-b560-0c1d348d295c(org.campagnelab.logger)</usedLanguage>
    <usedLanguage>0202ed86-955d-4227-9c20-377dd6b1f9ff(org.campagnelab.nyosh.lib)</usedLanguage>
    <usedLanguage>c1ba4037-e4db-47d8-8b61-b3c805b648f2(org.campagnelab.ui)</usedLanguage>
  </usedLanguages>
  <usedDevKits>
    <usedDevKit>fbc25dd2-5da4-483a-8b19-70928e1b62d7(jetbrains.mps.devkit.general-purpose)</usedDevKit>
    <usedDevKit>2677cb18-f558-4e33-bc38-a5139cee06dc(jetbrains.mps.devkit.language-design)</usedDevKit>
  </usedDevKits>
  <runtime>
    <dependency reexport="false">3b3d39a8-ff6e-47f3-9c9e-1888a27699ed(org.campagnelab.util)</dependency>
    <dependency reexport="false">6354ebe7-c22a-4a0f-ac54-50b52ab9b065(JDK)</dependency>
  </runtime>
  <extendedLanguages>
    <extendedLanguage>22e72e4c-0f69-46ce-8403-6750153aa615(jetbrains.mps.execution.configurations)</extendedLanguage>
    <extendedLanguage>0202ed86-955d-4227-9c20-377dd6b1f9ff(org.campagnelab.nyosh.lib)</extendedLanguage>
    <extendedLanguage>a8fb88b0-7e9f-478c-aab4-a1b076131192(org.campagnelab.gobyweb.interactive)</extendedLanguage>
  </extendedLanguages>
</language>

<?xml version="1.0" encoding="UTF-8"?>
<language namespace="org.campagnelab.gobyweb.plugins.test" uuid="489e31af-0445-4cbf-894b-a4bab1f18426">
  <models>
    <modelRoot contentPath="${module}" type="default">
      <sourceRoot location="languageModels" />
    </modelRoot>
    <modelRoot contentPath="${module}" type="java_classes">
      <sourceRoot location="GobyWebPluginRunner-1.0.jar" />
    </modelRoot>
  </models>
  <accessoryModels />
  <generators>
    <generator name="" generatorUID="org.campagnelab.gobyweb.plugins.test#3827903497649027977" uuid="19499a97-9cf5-4e08-9862-e5728789bd87">
      <models>
        <modelRoot contentPath="${module}" type="default">
          <sourceRoot location="generator/template" />
        </modelRoot>
      </models>
      <external-templates />
      <dependencies>
        <dependency reexport="true">6354ebe7-c22a-4a0f-ac54-50b52ab9b065(JDK)</dependency>
        <dependency reexport="false">f3061a53-9226-4cc5-a443-f952ceaf5816(jetbrains.mps.baseLanguage)</dependency>
        <dependency reexport="false">f61473f9-130f-42f6-b98d-6c438812c2f6(jetbrains.mps.baseLanguage.unitTest)</dependency>
        <dependency reexport="false">83f155ff-422c-4b5a-a2f2-b459302dd215(jetbrains.mps.baseLanguage.unitTest.libs)</dependency>
        <dependency reexport="false">642f71f8-327a-425b-84f9-44ad58786d27(jetbrains.mps.lang.project.modules)</dependency>
        <dependency reexport="false">7620dd3f-7541-48a3-b1e6-01cced81a7a5(org.campagnelab.clusterConfig)</dependency>
        <dependency reexport="false">a8fb88b0-7e9f-478c-aab4-a1b076131192(org.campagnelab.gobyweb.interactive)</dependency>
        <dependency reexport="true">0202ed86-955d-4227-9c20-377dd6b1f9ff(org.campagnelab.nyosh.lib)</dependency>
        <dependency reexport="false">901f5cf3-dc77-4c1e-bc5a-6382baee28b4(org.campagnelab.textoutput)</dependency>
        <dependency reexport="false">3b3d39a8-ff6e-47f3-9c9e-1888a27699ed(org.campagnelab.util)</dependency>
      </dependencies>
      <usedLanguages>
        <usedLanguage>b401a680-8325-4110-8fd3-84331ff25bef(jetbrains.mps.lang.generator)</usedLanguage>
        <usedLanguage>d7706f63-9be2-479c-a3da-ae92af1e64d5(jetbrains.mps.lang.generator.generationContext)</usedLanguage>
        <usedLanguage>489e31af-0445-4cbf-894b-a4bab1f18426(org.campagnelab.gobyweb.plugins.test)</usedLanguage>
        <usedLanguage>0202ed86-955d-4227-9c20-377dd6b1f9ff(org.campagnelab.nyosh.lib)</usedLanguage>
        <usedLanguage>901f5cf3-dc77-4c1e-bc5a-6382baee28b4(org.campagnelab.textoutput)</usedLanguage>
      </usedLanguages>
      <usedDevKits>
        <usedDevKit>fbc25dd2-5da4-483a-8b19-70928e1b62d7(jetbrains.mps.devkit.general-purpose)</usedDevKit>
      </usedDevKits>
      <mapping-priorities />
    </generator>
  </generators>
  <stubModelEntries>
    <stubModelEntry path="${module}/GobyWebPluginRunner-1.0-SNAPSHOT.jar" />
  </stubModelEntries>
  <sourcePath />
  <dependencies>
    <dependency reexport="true">6354ebe7-c22a-4a0f-ac54-50b52ab9b065(JDK)</dependency>
    <dependency reexport="false">6ed54515-acc8-4d1e-a16c-9fd6cfe951ea(MPS.Core)</dependency>
    <dependency reexport="false">498d89d2-c2e9-11e2-ad49-6cf049e62fe5(MPS.IDEA)</dependency>
    <dependency reexport="false">8865b7a8-5271-43d3-884c-6fd1d9cfdd34(MPS.OpenAPI)</dependency>
    <dependency reexport="false">f3061a53-9226-4cc5-a443-f952ceaf5816(jetbrains.mps.baseLanguage)</dependency>
    <dependency reexport="false">760a0a8c-eabb-4521-8bfd-65db761a9ba3(jetbrains.mps.baseLanguage.logging)</dependency>
    <dependency reexport="false">e39e4a59-8cb6-498e-860e-8fa8361c0d90(jetbrains.mps.baseLanguage.scopes)</dependency>
    <dependency reexport="false">f61473f9-130f-42f6-b98d-6c438812c2f6(jetbrains.mps.baseLanguage.unitTest)</dependency>
    <dependency reexport="false">83f155ff-422c-4b5a-a2f2-b459302dd215(jetbrains.mps.baseLanguage.unitTest.libs)</dependency>
    <dependency reexport="false">c7d01124-66d5-486d-8b50-7fdccb60b839(jetbrains.mps.baseLanguage.util)</dependency>
    <dependency reexport="false">2d3c70e9-aab2-4870-8d8d-6036800e4103(jetbrains.mps.kernel)</dependency>
    <dependency reexport="false">ceab5195-25ea-4f22-9b92-103b95ca8c0c(jetbrains.mps.lang.core)</dependency>
    <dependency reexport="false">9ded098b-ad6a-4657-bfd9-48636cfe8bc3(jetbrains.mps.lang.traceable)</dependency>
    <dependency reexport="false">f8e20673-3f65-44e9-84c0-c4a4b6ede37e(jetbrains.mps.make.facets)</dependency>
    <dependency reexport="false">a1250a4d-c090-42c3-ad7c-d298a3357dd4(jetbrains.mps.make.runtime)</dependency>
    <dependency reexport="false">df9d410f-2ebb-43f7-893a-483a4f085250(jetbrains.mps.smodel.resources)</dependency>
    <dependency reexport="false">7620dd3f-7541-48a3-b1e6-01cced81a7a5(org.campagnelab.clusterConfig)</dependency>
    <dependency reexport="false">adfd00cb-58d7-4094-bca8-f941a491e04f(org.campagnelab.gobyweb)</dependency>
    <dependency reexport="false">57af9408-ffae-472e-9367-5cb44434e8b3(org.campagnelab.gobyweb.interactive.users)</dependency>
    <dependency reexport="false">0b7d8bbd-896e-495e-be60-01a0d738a649(org.campagnelab.gobyweb.plugins)</dependency>
    <dependency reexport="false">82ffebe3-3685-4fd9-b560-0c1d348d295c(org.campagnelab.logger)</dependency>
    <dependency reexport="false">0202ed86-955d-4227-9c20-377dd6b1f9ff(org.campagnelab.nyosh.lib)</dependency>
    <dependency reexport="false">3b3d39a8-ff6e-47f3-9c9e-1888a27699ed(org.campagnelab.util)</dependency>
  </dependencies>
  <usedLanguages>
    <usedLanguage>760a0a8c-eabb-4521-8bfd-65db761a9ba3(jetbrains.mps.baseLanguage.logging)</usedLanguage>
    <usedLanguage>63650c59-16c8-498a-99c8-005c7ee9515d(jetbrains.mps.lang.access)</usedLanguage>
    <usedLanguage>af65afd8-f0dd-4942-87d9-63a55f2a9db1(jetbrains.mps.lang.behavior)</usedLanguage>
    <usedLanguage>b401a680-8325-4110-8fd3-84331ff25bef(jetbrains.mps.lang.generator)</usedLanguage>
    <usedLanguage>28f9e497-3b42-4291-aeba-0a1039153ab1(jetbrains.mps.lang.plugin)</usedLanguage>
    <usedLanguage>d8f591ec-4d86-4af2-9f92-a9e93c803ffa(jetbrains.mps.lang.scopes)</usedLanguage>
    <usedLanguage>13744753-c81f-424a-9c1b-cf8943bf4e86(jetbrains.mps.lang.sharedConcepts)</usedLanguage>
    <usedLanguage>696c1165-4a59-463b-bc5d-902caab85dd0(jetbrains.mps.make.facet)</usedLanguage>
    <usedLanguage>a8fb88b0-7e9f-478c-aab4-a1b076131192(org.campagnelab.gobyweb.interactive)</usedLanguage>
    <usedLanguage>57af9408-ffae-472e-9367-5cb44434e8b3(org.campagnelab.gobyweb.interactive.users)</usedLanguage>
    <usedLanguage>0b7d8bbd-896e-495e-be60-01a0d738a649(org.campagnelab.gobyweb.plugins)</usedLanguage>
    <usedLanguage>82ffebe3-3685-4fd9-b560-0c1d348d295c(org.campagnelab.logger)</usedLanguage>
    <usedLanguage>0202ed86-955d-4227-9c20-377dd6b1f9ff(org.campagnelab.nyosh.lib)</usedLanguage>
    <usedLanguage>c1ba4037-e4db-47d8-8b61-b3c805b648f2(org.campagnelab.ui)</usedLanguage>
  </usedLanguages>
  <usedDevKits>
    <usedDevKit>fbc25dd2-5da4-483a-8b19-70928e1b62d7(jetbrains.mps.devkit.general-purpose)</usedDevKit>
    <usedDevKit>2677cb18-f558-4e33-bc38-a5139cee06dc(jetbrains.mps.devkit.language-design)</usedDevKit>
  </usedDevKits>
  <runtime>
    <dependency reexport="false">3b3d39a8-ff6e-47f3-9c9e-1888a27699ed(org.campagnelab.util)</dependency>
    <dependency reexport="false">6354ebe7-c22a-4a0f-ac54-50b52ab9b065(JDK)</dependency>
  </runtime>
  <extendedLanguages>
    <extendedLanguage>22e72e4c-0f69-46ce-8403-6750153aa615(jetbrains.mps.execution.configurations)</extendedLanguage>
    <extendedLanguage>0202ed86-955d-4227-9c20-377dd6b1f9ff(org.campagnelab.nyosh.lib)</extendedLanguage>
    <extendedLanguage>a8fb88b0-7e9f-478c-aab4-a1b076131192(org.campagnelab.gobyweb.interactive)</extendedLanguage>
  </extendedLanguages>
</language>