now actually fix t68.  Need to be more aggressive in calling mkProb.  Also fix a bug where a 1/sqrt was changed to sqrt.  Oops.  Also, need to explicitly call mkReal in some places.

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

SLO := module ()
  export ModuleApply, AST, simp, flip_cond, condToProp,
    c; # very important: c is "global".
  local ToAST, t_binds, t_pw, t_rel,
    into_pw, myprod, do_pw,
    mkProb, getCtx, instantiate, lambda_wrap, find_paths,
    mkReal,
    fill_table, toProp, toType,
    twiddle, myint, myint_pw,
    fix_Heaviside,
    adjust_types, compute_domain, analyze_cond, isPos,
    adjust_superpose,
    get_breakcond, merge_pw,
    MyHandler, getBinderForm, infer_type, join_type, join2type,
    infer_type_prod, infer_type_sop, check_sop_type,
    simp_sup, simp_if, into_sup, simp_rel,
    simp_pw, simp_pw_equal, simp_pw3, simp_Or,
    simp_props,
    comp2, comp_algeb, compare, comp_list,

    # density recognisation routines
    get_de, mkRealDensity, recognize_density, recognize_density_01,
    recognize_density_0inf, density;

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

  # SLO output goes into AST
  ModuleApply := proc(spec::Typed(anything,anything))
    local expr, typ, glob, gsiz, ctx, r, inp, meastyp, res, gnumbering;
    expr := op(1, spec);
    typ := op(2, spec);
    glob, gnumbering, gsiz, meastyp := getCtx(typ, {}, table(), 0);
    r := Record('htyp' = typ, 'mtyp' = meastyp,
                'gctx' = glob, 'gnum' = gnumbering, 'gsize' = gsiz);
    inp := instantiate(expr, r, 0, typ);

    # global option
    _EnvUseHeavisideAsUnitStep := true;
    try
      # be context sensitive for this pass too:
      _EnvBinders := {};
      _EnvPathCond := `union`(op(map(toProp, glob)));
      NumericEventHandler(division_by_zero = MyHandler);
      # simp first applied so piecewise is effective,
      # then again in case eval "undoes" work of first simp call
      res := snd(inp(c));
      res := eval(res, 'if_'=piecewise);
      res := simp(res);
      res := eval(res, Int=myint);
      res := HAST(simp(res), r);
    catch "Wrong kind of parameters in piecewise":
      error "Bug in Hakaru -> Maple translation, piecewise used incorrectly.";
    finally :
      NumericEventHandler(division_by_zero = default);
    end try;
    res;
  end proc;

  # AST transforms the Maple to a representation of the mochastic AST
  # environment variables plus indexing functions make tracking info easy!
  AST := proc(inp::HAST(anything, Context))
    local res, ctx, t, i, rng;

    ctx := op(2,inp);

    # global option
    _EnvUseHeavisideAsUnitStep := true;

    # right at the start, put the global context in scope.
    _EnvBinders := map2(op, 1, ctx:-gctx);
    _EnvTypes := `union`(op(map(toType, ctx:-gctx)));
    _EnvPathCond := `union`(op(map(toProp, ctx:-gctx)));
    res := ToAST(op(inp));
    res := adjust_types(res, ctx:-mtyp, ctx);
    res := adjust_superpose(res);
    lambda_wrap(res, 0, ctx);
  end proc;

  # recursive function which does the main translation
  ToAST := proc(inp, ctx)
    local a0, a1, var, vars, rng, ee, cof, d, ld, weight, binders,
      v, subst, ivars, ff, newvar, rest, a, b, e;
    e := inp; # make e mutable
    if type(e, specfunc(name, c)) then
      return Return(op(e))
    # we might have recursively encountered a hidden 0
    elif (e = 0) then
      return Superpose()
    # we might have done something odd, and there is no x anymore (and not 0)
    elif type(e, 'numeric') then
      error "the constant %1 is not a measure", e
    # invariant: we depend on c
    else
      binders := indets(e, t_binds);
      vars := indets(e, specfunc(anything, c));
      subst := map(x-> x = op(0,x)[op(x)], vars);
      ivars := map2(op, 2, subst);
      if binders = {} then
        # this is a 'raw' measure, with no integrals
        ee := subs(subst, e);
        if type(ee, 'polynom'(anything,ivars)) then
          ee := collect(ee, ivars, simplify);
          d := degree(ee, ivars);
          ld := ldegree(ee, ivars);
          cof := [coeffs(ee, ivars, 'v')]; # cof is a list, v expseq
          if (d = 1) and (ld = 1) then
            ff := (x,y) -> WeightedM(simplify(x), Return(op(y)));
            Superpose(op(zip(ff, cof, [v])));
          elif (ee=0) then # collect/simplify could have revealed this
            Superpose()
          elif (ld = 0) then
            error "non-zero constant (%1) encountered as a measure", ee
          else
            error "polynomial in c: %1", ee
          end if;
        elif type(ee, t_pw) then
          return do_pw(map(simplify, [op(e)]), ctx);
        elif type(ee, `+`) then
          Superpose(op(map(ToAST, [op(e)], ctx)));
        else
          error "(%1) has no binders, but is still not a polynomial?", ee
        end if;
      else
        if type(e, 'specfunc'(anything, {'int','Int'})) then
          var, rng := op(op(2,e));
          ee := op(1,e);
          weight := simplify(op(2,rng)-op(1,rng));
          if type(weight, 'SymbolicInfinity') then
            rest := ToAST(ee, ctx);
            mkRealDensity(rest, var, rng)
          else
            # span := RealRange(op(1,rng), op(2,rng));
            v := simplify(weight*ee) assuming AndProp(op(1,rng)<var, var<op(2,rng));
            rest := ToAST(v, ctx);
            # Bind(Uniform(op(rng)), var, rest);
            mkRealDensity(rest, var, rng)
          end if;
        elif type(e, 'specfunc'(anything, {'sum','Sum'})) then
          error "sums not handled yet"
        elif type(e, t_pw) then
          return do_pw([op(e)], ctx);
        elif type(e, `+`) then
          Superpose(op(map(ToAST, [op(e)], ctx)));
        elif type(e, `*`) then
          # we have a binder in here somewhere
          a, b := selectremove(type, e, t_binds);
          # now casesplit on what a is
## from here
          if a=1 then  # no surface binders
            a, b := selectremove(type, e, t_pw);
            if a=1 then # and no piecewise either
              error "buried binder: %1", b
            elif type(a, `*`) then
              error "do not know how to multiply 2 pw: %1", a
            elif type(a, t_pw) then
              WeightedM(b, ToAST(a, ctx))
            else
              error "something weird happened: (%1) was supposed to be pw", a
            end if
          elif type(a, `*`) then
            error "product of 2 binders?!?: %1", a
          else
            WeightedM(b, ToAST(a, ctx))
          end if
## to here
        else
          error "Not sure what to do with %1", e
        end if;
      end if;
    end if;
  end proc;

  simp := proc(e)
    option remember, system;
    local binds, pw, substb, substp, subst, csubst, vbinds, vpw,
      ee, vars, all_vars, num, den, push_in, i,
      cs, simp_poly, simp_prod, simp_npw;

    simp_npw := zz -> `if`(op(1,zz)::t_pw, into_pw(SLO:-c,op(1,zz)), zz);
    if e=undefined or e::numeric or e::SymbolicInfinity then return e end if;
    cs := indets(e, specfunc(anything, c));
    csubst := map(x -> x = simp_npw(map(simp, value(x))), cs);
    ee := eval(e, csubst);
    if not type(csubst, set(specfunc(anything, c) = specfunc(anything,c))) then
      return simp(ee)
    end if;

    binds := indets(ee, t_binds);
    pw := indets(ee, t_pw);

    substb := map(x-> x = freeze(x), binds);
    substp := map(x-> x = freeze(x), pw);
    subst := substb union substp;
    ee := subs(subst union csubst, ee); # simultaneous substitution
    vbinds := map(rhs, substb);
    vpw := map(rhs, substp);
    vars := [op(vbinds union vpw)]; # order does not matter; only subst
    all_vars := [op(vars),op(convert(cs,list))];

    push_in := proc(c, v)
      local actual, cof, ii, rest, res;
      cof := c;
      if v=1 then return cof end if;
      actual := thaw(v);
      if type(actual, t_binds) then
        _EnvBinders := _EnvBinders union {op([2,1], actual)};
        op(0,actual)(simp(cof*op(1,actual)), op(2,actual))
      elif type(actual, t_pw) then
        actual := simplify(actual); # might get rid of pw!
        `if`(actual::t_pw, into_pw((x -> cof * x), actual), cof*actual);
      elif degree(v, vars)>1 then
        if type(actual, '`*`'(t_pw)) then
          res := merge_pw([op(actual)], mul);
          `if`(res::t_pw, into_pw((x->cof*x), res), cof*res);
        else
          (ii, rest) := selectremove(type, actual, t_binds);
          if ii::`*` then error "product? (%1)", ii; end if;
          simp(subsop(1=op(1,ii)*rest, ii));
        end if;
      else
        error "how can (%1) not be a binder, pw or c?", v
      end if;
    end proc;

    simp_poly := proc(p)
      local coef_q, vars_q, q, c0, res, heads;
      q := collect(p, all_vars , 'distributed', simplify);
      if not type(q, polynom(anything, vars)) then return thaw(q) end if;
      if ldegree(q, vars)<1 then
        # need to 'push in' additive constant sometimes
        c0 := tcoeff(q, vars);
        q := q - c0; # this should work because of the collect
      else
        c0 := 0;
      end if;
      if q = undefined then return undefined end if;
      if q=0 then return c0; end if;
      coef_q := [coeffs(q, vars, 'vars_q')];
      vars_q := [vars_q];
      # need to merge things too
      res := add(i,i=zip(push_in, coef_q, vars_q));
      if nops(coef_q) > 1 then
        heads := map2(op, 0, {op(res)}); # res::`+`
        if heads = {piecewise} then
          res := merge_pw([op(res)], add);
        end if;
        c0+res
      elif not (c0 = 0) then
        # don't push additive constants into (usually infinite!) integrals
        if type(res, t_binds) then
          c0+res;
        elif type(res, t_pw) then
          into_pw((x -> c0 + x), res)
        else
          error "Expected a pw or binder, got (%1)", res
        end if;
      else # c0 = 0
        res;
      end if;

    end proc;

    simp_prod := proc(p)
      local den, num;
      den, num := selectremove(type, p, anything ^ negint);
      den := 1/den;
      if degree(den, all_vars)>=1 then
        num := simp_poly(num);
        den := simp_poly(den);
        if den::t_pw then
          den := into_pw((x -> 1/x), den);
          simp(num*den); # this should not loop!
        else
          num/den; # integrals in denominator
        end if;
      else
        num := num / den; # no need to make this fancy
        simp_poly(num);
      end if;

    end proc;

    # keep some of the structure intact
    if type(ee, `*`) then
      ee := simp_prod(ee);
    elif type(ee, polynom(anything, vars)) then
      ee := simp_poly(ee);
    elif type(ee, ratpoly(anything, vars)) then
      ee := normal(ee);
      if type(ee, `*`) then
        ee := simp_prod(ee);
      else
        ee := simp_poly(numer(ee))/simp_poly(denom(ee));
      end if;
    elif type(ee, 'Pair'(anything, anything)) then
      ee := map(x -> simp(thaw(x)), ee);
      if op(1,ee)::t_pw then
        ee := into_pw((x -> Pair(x, op(2,ee))), op(1,ee))
      elif op(2,ee)::t_pw then
        ee := into_pw((x -> Pair(op(1,ee), x)), op(2,ee))
      end if;
    else
      error "ee (%1) should be ratpoly in (%2)", ee, vars;
    end if;

    ee;
  end proc;

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

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

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

  # a hack to make equations symmetric.  Session-dependent, but that's fine.
  twiddle := proc(x)
    local l;
    if type(x,`=`) then
      if rhs(x) = 0 then
        try
          if lhs(x)::`+` and nops(lhs(x))=2 then
            l := lhs(x);
            # Heuristic, as l may not be polynomial
            if sign(op(1,l))=-1 then
              twiddle(op(2,l) = -op(1,l))
            elif sign(op(2,l)) = -1 then
              twiddle(op(1,l) = -op(2,l))
            elif addressof(op(1,l)) > addressof(op(2,l)) then
              twiddle(op(2,l) = -op(1,l))
            else
              twiddle(op(1,l) = -op(2,l))
            end if;
          else
            x
          end if;
        catch:
          x
        end try;
      elif addressof(lhs(x)) > addressof(rhs(x)) then
        rhs(x) = lhs(x)
      else
        x
      end if;
    elif type(x,'list') then
      map(twiddle, x)
    else
      x
    end if;
  end proc;

  fix_Heaviside := proc(e, ee)
    try
      frontend(convert, [e], [{`+`,`*`}, '{Heaviside, Dirac}'], 'piecewise');
    catch "give the main variable as a second argument":
      ee
    end try;
  end proc;

  merge_pw := proc(l::list, f)
    local breakpoints, sbp, i, n, res, npw;

    breakpoints := convert(map(get_breakcond, l), 'set');
    sbp := map(twiddle, breakpoints);
    n := nops(l[1]);
    if nops(sbp)=1 then
      res := simp_pw(piecewise(seq(`if`(i::odd and i<n,
                                   op(i,l[1]),
                                   f(op(i,j),j=l)), i=1..n)));
      simp(res);
    else
      #error "multiple piecewises with different breakpoints %1", l
      # try with Heaviside
      res := f(i,i=l);
      try
        npw := simplify(convert(res, 'Heaviside'));
        npw := fix_Heaviside(npw, res);
      catch "give the main variable as a second argument":
        npw := res;
      end try;
      npw
    end if;
  end proc;

  get_breakcond := proc(pw::specfunc(anything, piecewise))
    local i, n;
    n := nops(pw);
    [seq(`if`(i::odd and i<n, op(i,pw), NULL), i=1..n)]
  end proc;

  simp_rel := proc(r)
    if r::name then
      r
    elif r::t_rel then
      # special case
      if r = ('Right' = 'Left') then
        false
      else
        if lhs(r) = undefined or rhs(r) = undefined then
          false
        else
          map(simp, r); # let map take care of which operator it is
        end if;
      end if;
    elif r::specfunc(anything, {And, Or, Not}) then
      map(simp_rel, r)
    else
      simp(r)
    end;
  end proc;

  simp_Or := proc(a,b)
    if type(a, anything = anything) and type(b, anything < anything)
      and op(1,a) = op(1,b) and op(2,a) = op(2, b) then
      op(1,a) <= op(2,a)
    elif type(b, anything = anything) and type(a, anything < anything)
      and op(1,a) = op(1,b) and op(2,a) = op(2, b) then
      op(1,a) <= op(2,a)
    else
      Or(a,b)
    end if;
  end proc;

  # takes the = conditions and applies & simplifies them
  simp_pw_equal := proc(pw)
    local n, rest, aa, f;
    n := floor(nops(pw)/2);
    rest := evalb(2*n < nops(pw));
    f := proc(cond, piece)
      if cond::(name = name) then
        if member(op(1,cond), _EnvBinders) or
           member(op(2,cond), _EnvBinders) then
          NULL
        else
          cond, eval(piece, cond)
        end if
      elif cond::(name = anything) then
        if member(op(1,cond), _EnvBinders) then
          NULL
        else
          cond, eval(piece, cond)
        end if;
      elif cond::(anything = name) then
        if member(op(2,cond), _EnvBinders) then
          NULL
        else
          cond, eval(piece, op(2,cond) = op(1,cond))
        end if
      else
        cond, piece
      end if
    end proc;
    aa := seq(f(op(2*i+1,pw), op(2*i+2,pw)), i = 0..n-1);
    if aa=NULL then
      if rest then
        op(-1, pw)
      else
        error "pw with all false conditions (%1)", pw
      end if
    else
      `if`(rest, piecewise(aa, op(-1,pw)), piecewise(aa));
    end if;
  end proc;

  # - takes pw conditions and distributes them, for n = 1
  # - simplifies simple cases of nested pw
  simp_pw := proc(pw)
    local res, cond, l, r, b1, b2, b3, rel, new_cond;
    res := simp_pw_equal(pw);
    if not res::t_pw then return res end if;
    if nops(res)=4 then
      b1 := flip_cond(op(1,res));
      if b1 = op(3,res) then
        res := piecewise(op(1,res), op(2, res), op(4,res));
      end if
    end if;

    if nops(res)=3 then
      # trivial case
      if normal(op(2,res)-op(3,res))=0 then return op(2,res) end if;
      # distribute conditions
      cond := op(1,res);
      if cond::t_rel and (op(1,cond)::t_pw or op(2,cond)::t_pw) then
        l := op(1, cond);
        r := op(2, cond);
        if (l::t_pw) and (r::t_pw) then
          error "double-pw condition (%1)", cond;
        end if;
        if l::t_pw then
          rel := x -> op(0,cond)(x,r);
          b1 := rel(op(2,l));
          b2 := op(1,l);
          b3 := rel(op(3,l));
          new_cond := Or(And(b2, b1), And(flip_cond(b2), b3));
          res := piecewise(new_cond, op(2, res), op(3, res))
        else
          rel := x -> op(0,cond)(l,x);
          b1 := rel(op(2,r));
          b2 := op(1,r);
          b3 := rel(op(3,r));
          new_cond := Or(And(b2, b1), And(flip_cond(b2), b3));
          res := piecewise(new_cond, op(2, res), op(3, res))
        end if;
      end if;

      # simplify simple nested cases
      if res::t_pw and op(2,res)::t_pw and nops(op(2,res))=3 and
         normal(op([2,3],res) - op(3,res)) = 0 then
          res := simp_pw(piecewise(And(op(1,res),op([2,1],res)), op([2,2],res), op(3,res)));
      end if;
      if res::t_pw and op(3,res)::t_pw and nops(op(3,res))=3 and
         normal(op([3,2],res) - op(2,res)) = 0 then
          b1 := simp_Or(op(1,res),op([3,1],res));
          res := simp_pw(piecewise(b1, op(2,res), op([3,3],res)));
      end if;
      if res::t_pw and op(3,res)::t_pw and nops(op(3,res))=3 and
         normal(op([3,3],res) - op(2,res)) = 0 then
          res := simp_pw(piecewise(And(op([3,1],res), flip_cond(op(1,res))), op(2,res), op([3,3],res)));
      end if;
    elif nops(res)=6 and op(2,res)=op(6,res) then
      # case of an if-else that has been complicated -- merge
      res := simp_pw(piecewise(And(flip_cond(op(1,res)), op(3,res)),
                               op(4,res), op(2,res)));
    end if;
    res;
  end proc;

  # this assumes we are doing pw of measures.
  do_pw := proc(l, ctx)
    local len, rel, prop_ctx, this, var;
    len := nops(l);
    if len = 0 then Superpose()
    elif len = 1 then ToAST(l[1], ctx)
    else # len>2.
      # special case - boolean
      if type(l[1], name = identical(true)) and len = 3 then
        var := op(1, l[1]);
        If(var, ToAST(eval(l[2], var=true), ctx),
                 ToAST(eval(l[3], var=false), ctx));
      # special case - Either
      elif type(l[1], name = identical(Left)) and len = 3 then
        if op(1,l[1]) = Right then
          ToAST(l[3], ctx)
        else
          error "Checking if %1 = Left ?", op(1,l[1]);
        end if;
      else
        # should analyze and simplify things depending on cond
        If(l[1], ToAST(l[2], ctx), thisproc(l[3..-1], ctx))
      end if;
    end if;
  end;

  mkProb := proc(w, ctx)
    local typ, pb, rl, pos, rest;
    if type(w, `*`) then
      pb, rl := selectremove(x->evalb(infer_type(x,ctx)=Prob), w);
      # have to adjust pb anyways, in case of sqrt, etc.
      pb := maptype(`*`, mkProb, pb, ctx);
      # all parts are Prob
      if rl = 1 then
        pb
      else
        # if there are multiple Real parts
        if type(rl, `*`) then
          pos, rest := selectremove(isPos, rl);
          # deal with pos part right away:
          pos := pb * maptype(`*`, mkProb, pos, ctx);
          if rest = 1 then
            pos
          else
            # make sure the rest really is positive
            # if not isPos(rest) then WARNING("cannot insure it will not crash") end if;
            if pos = 1 then
              unsafeProb(rest); # res it the whole thing, don't recurse!
            else
              pos * mkProb(rest, ctx)
            end if;
          end if;
        else # otherwise rl is a single thing
          # if not isPos(rl) then WARNING("cannot insure it will not crash") end if;
          if pb = 1 then
            unsafeProb(rl); # rl is the whole thing, don't recurse!
          else
            pb * mkProb(rl, ctx); # go ahead
          end if;
        end if;
      end if;
    elif type(w, 'exp'(anything)) then
      exp_(mkReal(op(1,w), ctx));
    elif type(w, 'erf'(anything)) then
      erf_(mkProb(op(1,w)));
    elif type(w, 'ln'(anything)) then
      error "mkProb ln: %1", w;
    elif type(w, anything^{identical(1/2), identical(-1/2)}) then
      typ := infer_type(op(1,w), ctx);
      if typ = 'Prob' then
        `if`(op(2,w)=1/2, sqrt_, recip@sqrt_)(op(1,w))
      elif typ = 'Number' then # is this right?
        w
      else
        mkProb(op(1,w), ctx) ^ op(2,w)
      end if;
    elif type(w, anything^negint) then
      typ := infer_type(op(1,w), ctx);
      if member(typ,{Prob, Number}) then
        op(1,w)^op(2,w)
      else
        unsafeProb(op(1,w))^op(2,w)
      end if;
    elif type(w, anything^fraction) then # won't be sqrt
      unsafeProb(w);
    elif type(w, 'unsafeProb'(anything)) then
      error "there should be no unsafeProb in %1", w
    else
      typ := infer_type(w, ctx);
      if member(typ, {'Prob', 'Number'}) then
        w
      elif typ = 'Real' then
        # we are going to need to cast.  Is it safe?
        # if not isPos(w) then WARNING("cannot insure it will not crash") end if;
        unsafeProb(w);
      else
        error "how do I make a Prob from %1 in %2", w, eval(_EnvTypes)
      end if;
    end if;
  end proc;

  mkReal := proc(w, ctx)
    local prob, rl, typ;
    if w::`*` then
      rl, prob := selectremove(
          x->evalb(member(infer_type(x,ctx),{Real,Number})), w);
      # all parts are Real
      if prob = 1 then
        rl
      else
        rl * fromProb(prob)
      end if;
    elif type(w, 'specfunc'(anything, {cos, sin, exp,erf})) then
      map(mkReal, w, ctx)
    else
      typ := infer_type(w, ctx);
      if member(typ ,{'Real', 'Number'}) then
        w
      else
        error "don't know how to make (%1) real", w;
      end if;
    end if;
  end proc;

  # use assumptions to figure out if we are actually positive, even
  # when the types say otherwise
  isPos := proc(w)
    local res;

    res := signum(0, w, 1) assuming op(_EnvPathCond);
    evalb(res = 1);
  end proc;

  toProp := proc(x::`=`)
    local nm, typ, prop, rest, left, right, r1, r2;
    (nm, typ) := op(x);

    if type(typ, 'symbol') then
      if typ = 'Real' then (prop, rest) := 'real', {};
      elif typ = 'Prob' then (prop, rest) := RealRange(0,infinity), {};
      elif typ = 'Bool' then (prop, rest) := boolean, {};
      elif typ = 'Unit' then (prop, rest) := identical(Unit), {};
      else
        error "Unknown base type %1", x
      end if;
    elif nm :: Pair(anything, anything) and
         typ :: Pair(anything, anything) then
      (left, r1) := thisproc(op(1, nm) = op(1,typ));
      (right, r2) := thisproc(op(2, nm) = op(2,typ));
      (prop, rest) := Pair(op([1,2],left), op([1,2],right)),
                     (`union`(r1, r2, left, right));
    else
      error "How can I make a property from %1", x;
    end if;
    {nm :: prop}, rest
  end proc;

  condToProp := proc(cond)
    eval(cond,{And=AndProp, Or=OrProp})
  end proc;

  toType := proc(x::`=`)
    local nm, typ, prop, rest, r1, r2;
    (nm, typ) := op(x);

    if type(typ, 'symbol') then
      rest := {nm::typ}
    elif nm :: Pair(anything, anything) and
         typ :: Pair(anything, anything) then
      r1 := thisproc(op(1, nm) = op(1,typ));
      r2 := thisproc(op(2, nm) = op(2,typ));
      rest := `union`(r1, r2);
    else
      error "How can I make a property from %1", x;
    end if;
    rest
  end proc;

  fill_table := proc(t, nm, typ)
    if nm::name then
      if typ = 'Real' then
        t[nm] := RealRange(-infinity, infinity)
      elif typ = 'Prob' then
        t[nm] := RealRange(0, infinity)
      elif typ = 'Bool' then
        t[nm] := boolean
      elif typ = 'Unit' then
        # Do nothing, this does not need remembered
      else
        error "Real/Prob/Bool/Unit are the only base types: %1", typ;
      end if;
    elif typ :: 'Pair'(anything, anything) then
      fill_table(t, op(1, nm), op(1, typ));
      fill_table(t, op(2, nm), op(2, typ));
    elif typ :: 'Measure'(anything) then
      error "cannot handle first-class measure types yet"
    elif typ :: 'Arrow'(anything,anything) then
      error "cannot handle first-class -> types yet"
    else
      error "I don't know type %1", typ;
    end if;
  end proc;

  getBinderForm := proc(t)
    local left, right;
    if t = 'Real' then gensym('rr')
    elif t = 'Prob' then gensym('pp')
    elif t :: Pair(anything, anything) then
      left := getBinderForm(op(1,t));
      right := getBinderForm(op(2,t));
      Pair(left, right);
    elif t = 'Bool' then gensym('bb')
    elif t = 'Unit' then gensym('uu') # we really do need a name!
    else
      error "Trying to form a name from a %1", t
    end if;
  end proc;

  getCtx := proc(typ, glob, globNum, ctr)
    local nm, t;
    if type(typ, 'Arrow'(anything, anything)) then
      t := op(1,typ);
      # 'nm' is a name-filled type structure, not necessarily a name
      nm := getBinderForm(t);
      globNum[ctr] := nm;
      getCtx(op(2,typ), glob union {nm = t}, globNum, ctr+1)
    elif type(typ, 'Measure'(anything)) then
      glob, globNum, ctr, typ
    else
      error "must have either Measure or Arrow, got %1", typ;
    end if;
  end proc;

  instantiate := proc(e, ctx, ctr, typ)
    local nm;
    if ctr = ctx:-gsize then
      e
    else
      nm := ctx:-gnum[ctr];
      instantiate(e(nm), ctx, ctr + 1, op(2,typ))
    end if;
  end proc;

  # note that the 'nm' is a path, not necessarily of type name
  find_paths := proc(struct, nm)
    local lv, rv, lsubs, rsubs;
    if struct::Pair(anything, anything) then
      (lv, rv) := op(struct);
      lsubs := `if`(lv::name, {lv = Fst(nm)}, find_paths(lv, Fst(nm)));
      rsubs := `if`(rv::name, {rv = Snd(nm)}, find_paths(rv, Snd(nm)));
      lsubs union rsubs
    else
      error "expected nested tuple of names, got (%1)", struct;
    end if;
  end proc;

  lambda_wrap := proc(expr, cnt, ctx)
    local var, ee, newvar, name_subst;
    if cnt = ctx:-gsize then
      expr
    else
      var := ctx:-gnum[cnt];
      if type(var, 'name') then
        Lambda(var, lambda_wrap(expr, cnt+1, ctx));
      # cheat, for now
      elif type(var, Pair(anything, anything)) then
        newvar := gensym('pr');
        name_subst := find_paths(var, newvar);
        ee := subs({var = newvar} union name_subst, expr);
        Lambda(newvar, lambda_wrap(ee, cnt+1, ctx));
      else
        error "cannot yet lambda_wrap a %1", var
      end if;
    end if;
  end proc;

  infer_type := proc(e, ctx)
    option remember, system;
    local typ, l, res, k, t;
    if type(e, boolean) then
      'Bool'
    elif e = 'Pi' then Prob
    elif e = 'Unit' then Unit
    elif e = 'Lebesgue' then Measure(Real)
    elif e = 'undefined' then Real
    elif type(e, boolean) then
      'Bool'
    elif type(e, anything^integer) then
      infer_type(op(1,e), ctx);
    elif type(e, specfunc(anything, {'exp', 'sin','cos'})) then
      typ := infer_type(op(1,e), ctx); # need to make sure it is inferable
      'Real' # someone else will make sure to cast this correctly
    elif type(e, specfunc(anything, {'GAMMA' })) then
      typ := infer_type(op(1,e), ctx); # need to make sure it is inferable
      'Prob'
    elif type(e, anything^fraction) then
      infer_type(op(1,e), ctx); # need to make sure it is inferable
      # if it is <0, weird things will happen
      # someone else will make sure to cast this correctly
    elif type(e, 'erf'(anything)) then
      infer_type(op(1,e), ctx); # erf is Real, erf_ is Prob
      'Real'
    elif type(e, 'Ei'(posint, anything)) then
      infer_type(op(1,e), ctx);
      'Real'
    elif type(e, 'ln'(anything)) then
      typ := infer_type(op(1,e), ctx); # need to make sure it is inferable
      'Real'
    elif type(e, 'symbol') then
      # first look in the global context
      res := select(type, ctx:-gctx, identical(e) = anything);
      if nops(res)=1 then
        op([1,2], res)
      else # then in the current path
        res := select(type, _EnvTypes, 'identical'(e) :: 'anything');
        if nops(res)=1 then
          typ := op([1,2], res);
          #if type(typ, {'RealRange'(anything, anything), identical(real)}) then
          #  if signum(0,op(1,typ),0)=1 then 'Prob' else 'Real' end if
          #else
            typ
          #end if;
        else
          error "Impossible: an untyped free variable %1 in local context %2, got (%3)",
            e, eval(_EnvTypes), res
        end if;
      end if;
    elif type(e, 'Pair'(anything, anything)) then
      map(infer_type, e, ctx);
    elif type(e, {`+`, `*`}) then
      l := map(infer_type, [op(e)], ctx);
      join_type(op(l));
    elif type(e, {'integer', 'fraction'}) then
      Number # constants are polymorphic!
    elif type(e, specfunc(anything, 'piecewise')) then
      typ := NULL;
      for l from 1 to nops(e) do
        if l::odd and l<nops(e) then
          next;
        else # last or e:: evan
          typ := typ, infer_type(op(l, e), ctx)
        end if;
      end do;
      join_type(typ);
    elif type(e, {specfunc(anything, 'NormalD')}) then
      Measure(Real)
    elif type(e, specfunc(anything, 'Superpose')) then
      res := map(infer_type, {op(e)}, ctx);
      if nops(res) = 1 then
        res[1]
      else
        error "Superpose with multiple types %1", e
      end if;
    elif type(e, specfunc(anything, 'WeightedM')) then
      infer_type(op(2, e), ctx)
    elif type(e, specfunc(anything, 'Uniform')) then
      Measure(Real)
    elif type(e, specfunc(anything, {'BetaD', 'GammaD'})) then
      Measure(Prob)
    elif type(e, 'Bind'(anything, name, anything)) then
      Measure(Real)
    elif type(e, 'Bind'(anything, name = range, anything)) then
      Measure(Real)
    elif type(e, 'Tag'(anything, anything)) then

      (k, t) := infer_type_sop(op(2,e), ctx);
      TagMaple(k, t);

    else
      error "how do I infer a type from %1", e;
    end if;
  end proc;

  infer_type_prod := proc(e, ctx)
    local t0, ts;
    if e = 'Nil' then
      [];
    elif op(0,e) = 'Cons' then
      t0 := infer_type(op(1,e), ctx);
      ts := infer_type_prod (op(2,e), ctx);
      [t0, op(ts)];
    else error "infer_type_prod: %1 is not a product type", e
    end if;
  end proc;

  infer_type_sop := proc(e, ctx)
    local k, t;
    if op(0,e) = 'Zero' then
      (0, infer_type_prod (op(1,e), ctx));
    elif op(0,e) = 'Succ' then
      k, t := infer_type_sop (op(1,e), ctx);
      (k+1, t);
    else error "infer_type_sop: %1 is not a sum of product type", e
    end if;
  end proc;

  check_sop_type := proc(inferredType, actualType)
    local compatible_types, k, t, sopType;

    compatible_types := proc(inf, act)
      if inf = 'Number' then
        member(act, {'Int', 'Real', 'Prob'})
      else
        inf = act
      end if;
    end proc;

    (k, t) := op(inferredType);
    sopType := op(2, actualType);

    `and` (op (zip (compatible_types, t, op(k+1,sopType))))
  end proc;

  join2type := proc(a,b)
    if a = b then a
    elif a = 'Number' then b
    elif b = 'Number' then a
    elif (a = 'Real' and b = 'Prob') or
         (b = 'Real' and a = 'Prob') then 'Mixed' # we'll need to patch
    else error "join2type of %1, %2", a, b
    end if;
  end proc;

  # could foldl, but this will work too
  join_type := proc()
    if _npassed < 2 then error "join_type: cannot happen, nargs<2"
    elif _npassed = 2 then
      join2type(_passed[1], _passed[2])
    else
      join_type(join2type(_passed[1], _passed[2]), _passed[3..-1])
    end if;
  end proc;
  ####
  # Fix-up the types using contextual information.
# TODO: need to add unsafeProb around the Prob-typed input variables,
# and then fix-up things like log.
#
# The right way to do this is really to do
# - full 'type' inference of e
# - full 'range-of-value' inference of e
  adjust_types := proc(e, typ, ctx)
    local ee, dom, opc, res, var, left, right, inf_typ, typ2, cond, fcond, cl;
    if type(e, specfunc(anything, 'Superpose')) then
      map(thisproc, e, typ, ctx)
    elif type(e, 'WeightedM'(anything, anything)) then
      WeightedM(mkProb(op(1,e), ctx), thisproc(op(2,e), typ, ctx));
    elif type(e, 'Return'(anything)) and type(typ, 'Measure'(anything)) then
      typ2 := op(1, typ);
      inf_typ := infer_type(op(1,e), ctx);
      if typ2 = Unit and op(1,e) = Unit then
        e
      elif typ2 = Prob then
        ee := op(1,e);
        res := mkProb(ee, ctx);
        'Return'(res);
      elif typ2 = Real and type(op(1,e), 'ln'(anything)) then
        ee := op(1,e);
        inf_typ := infer_type(op(1, ee), ctx);
        if inf_typ = 'Prob' then
          'Return'(ln_(op(1,ee)))
        else
          'Return'(ee);
        end if;
      elif typ2 = Real and member(inf_typ, {'Real', 'Number'}) then
        'Return'(op(1,e))
      elif typ2 = Real and inf_typ = 'Mixed' then
        'Return'(mkReal(op(1,e), ctx));
      elif typ2 :: Pair(anything, anything) and
           op(1,e) :: Pair(anything, anything) then
        left  := adjust_types('Return'(op([1,1],e)), Measure(op(1,typ2)), ctx);
        right := adjust_types('Return'(op([1,2],e)), Measure(op(2,typ2)), ctx);
        'Return'(Pair(op(1,left), op(1,right)));
      elif typ2 = Bool and member(op(1,e), {true,false}) then
        e
      elif type(typ2, 'Tagged'(anything, anything)) then
        if check_sop_type(inf_typ, typ2) then
          e
        else
          error "Type check failed in Tagged (adjust_types); type{%1} inf_type{%2} expr{%3}", typ2, inf_typ, e;
        end if;
      else
         error "adjust_types with type %1, inf_typ %2, for %3", typ, inf_typ, e;
      end if;
    elif type(e, 'Bind'(identical(Lebesgue), name, anything)) then
      var := op(2,e);
      _EnvTypes := _EnvTypes union {var :: Real};
      _EnvPathCond := _EnvPathCond union {var :: real};
      Bind(Lebesgue, var, adjust_types(op(3,e), typ, ctx));
    elif type(e, 'Bind'(identical(Lebesgue), name = range, anything)) then
      dom := RealRange(op([2,2,1],e), op([2,2,2], e));
      var := op([2,1],e);
      _EnvTypes := _EnvTypes union {var :: Real};
      _EnvPathCond := _EnvPathCond union {var :: dom};
      Bind(op(1,e), op(2,e), adjust_types(op(3,e), typ, ctx));
    elif type(e, 'Bind'(anything, name = range, anything)) then
      dom := compute_domain(op(1,e), var);
      var := op([2,1],e);
      inf_typ := infer_type(op(1,e), ctx); # should assert Measure(..)
      _EnvTypes := _EnvTypes union {var :: op(1,inf_typ)};
      _EnvPathCond := _EnvPathCond union {dom};
      # need to adjust types on first op, to its own type, as that may require
      # tweaking which functions are used
      Bind(adjust_types(op(1,e), inf_typ, ctx), op(2,e), adjust_types(op(3,e), typ, ctx));
    elif type(e, 'Bind'(anything, name, anything)) then
      dom := compute_domain(op(1,e), var);
      var := op(2,e);
      inf_typ := infer_type(op(1,e), ctx); # should assert Measure(..)
      _EnvTypes := _EnvTypes union {var :: op(1,inf_typ)};
      _EnvPathCond := _EnvPathCond union {dom};
      # need to adjust types on first op, to its own type, as that may require
      # tweaking which functions are used
      Bind(adjust_types(op(1,e), inf_typ, ctx), op(2,e), adjust_types(op(3,e), typ, ctx));
    elif type(e, 'If'(name, anything, anything)) then
      # special case
      var := op(1,e);
      left := adjust_types(eval(op(2,e), var=true), typ, ctx);
      right := adjust_types(eval(op(3,e), var=false), typ, ctx);
      If(var, left, right);
    elif type(e, 'If'(anything, anything, anything)) then
      cond := op(1,e);
      fcond := flip_cond(cond);
      opc := _EnvPathCond;
      cl := simp_props(opc union {cond});
      if cl = false then  # cond is unsat
        cl := simp_props(opc union {fcond});
        if cl = false then # so is fcond, oh my!
          error "_EnvPathCond (%1) itself is unsat!", _EnvPathCond;
        end if;
        _EnvPathCond := cl;
        adjust_types(op(3,e), typ, ctx);
      else
        _EnvPathCond := cl;
        left := adjust_types(op(2,e), typ, ctx);
        cl := simp_props(opc union {fcond});
        if cl = false then # fcond is unsat, just return left
          return left;
        else
          _EnvPathCond := cl;
          right := adjust_types(op(3,e), typ, ctx);
          If(cond, left, right);
        end if;
      end if;
    elif type(e, 'Uniform'(anything, anything)) and typ = 'Measure(Real)' then
      e
    elif type(e, 'Uniform'(anything, anything)) and typ = 'Measure(Prob)' then
      var := gensym('pp');
      Bind(e, var, Return(unsafeProb(var)))
    elif type(e, 'BetaD'(anything, anything)) and typ = 'Measure(Prob)' then
      BetaD(mkProb(op(1,e), ctx), mkProb(op(2,e), ctx))
    elif type(e, 'BetaD'(anything, anything)) and typ = 'Measure(Real)' then
      var := gensym('pp');
      res := BetaD(mkProb(op(1,e), ctx), mkProb(op(2,e), ctx));
      Bind(res, var, Return(fromProb(var)))
    elif type(e, 'GammaD'(anything, anything)) and typ = 'Measure(Prob)' then
      GammaD(mkProb(op(1,e), ctx), mkProb(op(2,e), ctx))
    elif type(e, 'NormalD'(anything, anything)) and typ = 'Measure(Real)' then
      NormalD(mkReal(op(1,e),ctx), mkProb(op(2, e), ctx))
    else
     error "adjust_types of %1 at type %2", e, typ;
    end if;
  end proc;

  flip_cond := proc(cond)
    if type(cond, `<`) then op(2,cond) <= op(1,cond)
    elif type(cond, `<=`) then op(2,cond) < op(1,cond)
    elif type(cond, `=`) then op(1,cond) <> op(2,cond)
    elif type(cond, `<>`) then op(1,cond) = op(2,cond)
    elif cond::specfunc(anything, 'And') and nops(cond)=2 then
      Or(flip_cond(op(1,cond)), flip_cond(op(2,cond)))
    elif cond::specfunc(anything, 'Or') and nops(cond)=2 then
      And(flip_cond(op(1,cond)), flip_cond(op(2,cond)))
    elif cond::specfunc(anything, 'Not') then
      op(1,cond)
    elif cond::name then
      'Not'(cond)
    else
      error "Don't know how to deal with condition %1", cond
    end if;
  end proc;

  compute_domain := proc(e, v)
    local res;
    if type(e, 'Uniform'(anything, anything)) then
      # 'RealRange'(op(e));
      AndProp(v>=op(1,e), v<=op(2,e));
    elif type(e, 'GammaD'(anything, anything)) then
      v::'RealRange'(0,infinity);
    elif type(e, 'BetaD'(anything, anything)) then
      v::'RealRange'(0,1);
    elif type(e, {identical('Lebesgue'), specfunc(anything, 'NormalD')}) then
      v::'real'
    elif type(e, specfunc(anything, 'Superpose')) then
      res := map((x -> compute_domain(op(2,x),v)), {op(e)});
      if nops(res)=1 then
        res[1]
      else
        error "expression %1 has multiple domain: %2", e, res
      end if;
    elif type(e, 'Bind'(anything, name, anything)) then
      v::'real'
    elif type(e, 'Bind'(anything, name = range, anything)) then
      v::RealRange(op([2,2,1], e), op([2,2,2], e))
    elif type(e, 'WeightedM'(anything, anything)) then
      compute_domain(op(2,e))
    else
      error "compute domain: %1", e;
    end if;
  end proc;

  # returns something of the right shape for assume
  analyze_cond := proc(c,ctx)
    if type(c, name = identical(true)) then
      error "analyze_cond should not be called with a boolean variable";
    else
      c
    end if;
  end proc;

  # while inside the evaluator, we want infinities
  MyHandler := proc(operator, operands, default_value)
    NumericStatus( division_by_zero = false);
    if operator='ln' then -infinity else default_value end if;
  end proc;

  # dirac < uniform < NormalD < bind < WeightedM < If < SUPERPOSE
  # returns false on equality
  comp2 := proc(x,y)
    if evalb(x=y) then false
    elif x::Return(anything) then
      if y::Return(anything) then
        comp_algeb(op(1,x), op(1,y))
      else
	true
      end if
    elif x::Uniform(numeric, numeric) then
      if y::Uniform(numeric, numeric) then
	evalb(op(1,x) < op(1,y))
      else
	evalb(not member(op(0,y), '{Return}'))
      end if
    elif x::specfunc(anything, NormalD) then
      if y::specfunc(anything, NormalD) then
        comp_list(zip( compare, [op(x)], [op(y)]));
      else
	evalb(not member(op(0,y), '{Return, Uniform}'));
      end if;
    elif x::specfunc(anything, 'Bind') then
      if y::specfunc(anything, 'Bind') then
	comp2(op(3, x), op(3, y))
      else
	evalb(not member(op(0,y), '{Return, Uniform, NormalD}'));
      end if
    elif x::specfunc(anything, 'WeightedM') then
      if y::specfunc(anything, 'WeightedM') then
        comp2(op(2, x), op(2, y))
      else
	evalb(not member(op(0,y), '{Return, Uniform, NormalD, WeightedM}'));
      end if;
    elif x::specfunc(anything, 'If') then
      if y::specfunc(anything, 'If') then
        # cheat!
        evalb( length(x) < length(y) )
      else
	evalb(not member(op(0,y), '{Return, Uniform, NormalD, WeightedM, If}'));
      end if;
    elif x::specfunc(anything, 'SUPERPOSE') then
      if y::specfunc(anything, 'SUPERPOSE') then
        error "cannot compare 2 SUPERPOSE %1, %2", x, y
      else
	evalb(not member(op(0,y), '{Return, Uniform, NormalD, WeightedM, If, SUPERPOSE}'));
      end if;
    else
      error "cannot compare: %1, %2", x, y
    end if;
  end proc;

  comp_algeb := proc(x, y)
    if x::numeric and y::numeric then
      evalb( x < y )
    elif {op(0,x), op(0,y)} = {Pair} then
      comp_list(zip( compare, [op(x)], [op(y)]));
    else # just cheat
      evalb( length(x) < length(y) )
    end if;
  end proc;

  comp_list := proc(l)
    if nops(l)=0 then
      false
    elif l[1]=LESS then
      true
    elif l[1]=GREATER then
      false
    else
      comp_list(l[2..-1])
    end if;
  end proc;

  compare := proc(x, y)
    if evalb(x=y) then
      EQUAL
    elif comp_algeb(x,y) then
      LESS
    elif comp_algeb(y,x) then
      GREATER
    else
      EQUAL # can this happen?
    end if;
  end proc;

  # helper routines for tweaking ASTs
  simp_sup := proc()
    SUPERPOSE(op(sort([_passed], 'strict'=comp2)))
  end proc;

  # weird routine to catch unsat, which means a condition list implies false
  simp_props := proc(p)
    local res, X, pl, ii;
    pl := map(condToProp, p);
    ii := remove(type, indets(pl, 'name'), constant);
    try
      # dummy query for unsat only
      coulditbe(X(op(ii)) > 0) assuming op(pl);
      res := pl;
    catch "when calling '%1'. Received: 'contradictory assumptions'":
    # catch "the assumed property", "contradictory assumptions":
      res := false;
    catch "when calling": # all other errors
      res := pl;
    end try;
    res;
  end proc;

  into_sup := proc(wm, w) WeightedM(simplify(w*op(1,wm)), op(2,wm)) end proc;

  # sort, then fix things up to make printing easier
  adjust_superpose := proc(e)
    local f;
    f := proc()
      'SUPERPOSE'(seq(`if`(op(0,_passed[i])='WeightedM',
                          'WM'(op(_passed[i])),
                          'WM'(1,_passed[i])), i=1.._npassed))
    end proc;
    eval(eval(e, Superpose=simp_sup), SUPERPOSE = f);
  end proc;

  get_de := proc(dens, var, Dx)
    local de, init, diffop;
    try
      de := gfun[holexprtodiffeq](dens, f(var));
      if not (de = NULL) and not (de :: set) then
        de := gfun[diffeqtohomdiffeq](de, f(var));
      end if;
      if de::set then
        init, de := selectremove(type, de, `=`);
        if nops(de)=1 then
          de := de[1];
          diffop := DEtools[de2diffop](de, f(var), [Dx, var]);
          return Diffop(diffop, init)
        end if;
      elif not (de = NULL) then # no initial condition returned
        diffop := DEtools[de2diffop](de, f(var), [Dx, var]);
        return Diffop(diffop, {}); # should be {f(0)=0} ?
      end if;
    catch: # do nothing
    end try;
    Nothing
  end proc;

  # density recognizer for reals
  recognize_density := proc(diffop, init, Dx, var)
    local a0, a1, scale, at0, mu, sigma, ii;
    if degree(diffop, Dx) = 1 then
      a0 := coeff(diffop, Dx, 0);
      a1 := coeff(diffop, Dx, 1);
      if degree(a0, var) = 1 and degree(a1, var) = 0 and nops(init) = 1 then
        ii := rhs(init[1]);
        scale := coeff(a0, var, 1);
        mu := -coeff(a0, var, 0)/scale;
        sigma := sqrt(coeff(a1, var, 0)/scale);
        at0 := simplify(eval(ii/density[NormalD](mu, sigma)(0)));
        return WeightedM(at0, NormalD(mu,sigma));
      end if;
    end if;
    NULL;
  end proc;

  # density recognizer for 0..1
  recognize_density_01 := proc(full_diffop, init, Dx, var)
    local a0, a1, scale, at0, a, b, c0, ii, constraints, sol, diffop;

    # throw away the content, it does not help us!
    diffop := primpart(full_diffop, Dx);
    if degree(diffop, Dx) = 1 then
      ii := map(convert, init, 'diff');
      a0 := coeff(diffop, Dx, 0);
      a1 := coeff(diffop, Dx, 1);
      if degree(a0,var)=1 and degree(a1,var)=2 and normal(var^2-var - a1)=0 then
        a := coeff(a0, var, 0) + 1;
        b := -coeff(a0, var, 1) - a + 2;
        if init = {} then
          return BetaD(a,b);
        else
          constraints := eval(ii, f = (x -> c0*density[BetaD](a,b)(x)));
          sol := solve(constraints, c0);
          return WeightedM(eval(c0, sol), BetaD(a,b));
        end if;
      # degenerate case with b=1
      elif degree(a0,var)=0 and degree(a1,var)=1 and normal(var + a1)=0 then
        a := coeff(a0, var, 0) + 1;
        if init = {} then
          return BetaD(a,1);
        else
          constraints := eval(ii, f = (x -> c0*density[BetaD](a,1)(x)));
          sol := solve(constraints, c0);
          return WeightedM(eval(c0, sol), BetaD(a,1));
        end if;
      # degenerate case with a=1
      elif degree(a0,var)=0 and degree(a1,var)=1 and normal(a1 - (var-1))=0 then
        b := -(coeff(a0, var, 0) - 1);
        if init = {} then
          return BetaD(1,b);
        else
          constraints := eval(ii, f = (x -> c0*density[BetaD](1,b)(x)));
          sol := solve(constraints, c0);
          return WeightedM(eval(c0, sol), BetaD(1,b));
        end if
      # degenerate case with a=1, presented differently
      elif degree(a0,var)=0 and degree(a1,var)=1 and normal(a1 + (var-1))=0 then
        b := (coeff(a0, var, 0) + 1);
        if init = {} then
          return BetaD(1,b);
        else
          constraints := eval(ii, f = (x -> c0*density[BetaD](1,b)(x)));
          sol := solve(constraints, c0);
          return WeightedM(eval(c0, sol), BetaD(1,b));
        end if;
      end if;
    end if;
    NULL;
  end proc;

  # density recognizer for 0..infinity
  # warning: Maple's gamma distribution swaps its parameters wrt Hakaru's!
  recognize_density_0inf := proc(diffop, init, Dx, var)
    local a0, a1, scale, at0, b, c;
    if degree(diffop, Dx) = 1 then
      a0 := coeff(diffop, Dx, 0);
      a1 := coeff(diffop, Dx, 1);
      if degree(a0, var) = 1 and degree(a1, var) = 1 then
        if coeff(a1,var,0)= 0 then
          scale := coeff(a0,var,1);
          b := coeff(a1, var, 1)/scale;
          c := (b-(coeff(a0,var,0)/scale))/b;
          return GammaD(c, b);
        end if;
      # and Hakaru uses the 'alternate' definition of exponential...
      # TODO: take care of initial condition too
      elif degree(a0,var) = 0 and degree(a1, var) = 0 then
        scale := coeff(a1, var, 0);
        b := coeff(a0, var, 0)/scale;
        return GammaD(1,1/b);
      end if;
    end if;
    NULL;
  end proc;

  mkRealDensity := proc(dens, var, rng)
    local de, res, new_dens, Dx, diffop, init, c, d;
    if dens :: specfunc(anything, 'WeightedM') then
      res := NULL;
      # no matter what, get the de.
      # TODO: might want to switch from var=0 sometimes
      de := get_de(op(1,dens),var,Dx);
      if de::specfunc(anything, 'Diffop') then
        (diffop, init) := op(de);
        # dispatch on rng
        if rng = 0..1 then
          res := recognize_density_01(diffop, init, Dx, var) assuming op(_EnvPathCond), var::RealRange(0,1);
        elif rng = 0..infinity then
          res := recognize_density_0inf(diffop, init, Dx, var) assuming op(_EnvPathCond), var>0;
          # need to fix up initial conditions
          if res <> NULL then
            (c,d) := op(res);
            new_dens := op(1,dens)/density[GammaD](c,d)(var);
            new_dens := simplify(new_dens) assuming op(_EnvPathCond),var>0;
            if depends(new_dens,var) then
              error "mkRealDensity problem";
            end if;
            res := WeightedM(new_dens, res);
          end if;
        else # actually use 'real' recognizer in all these cases
          res := recognize_density(diffop, init, Dx, var) assuming op(_EnvPathCond), var::real;
        end if;
      end if;

      if res<>NULL then
        Bind(res, var = rng, op(2,dens))
      else
        Bind(Lebesgue, var = rng, dens)
      end if;
    elif dens :: specfunc(anything, 'Bind') then
      new_dens := mkRealDensity(op(1, dens), var, rng);
      # uses associatibity of >>=
      Bind(op(1, new_dens), op(2, new_dens),
        Bind(op(3, new_dens), op(2, dens), op(3, dens)));
    elif dens :: specfunc(anything, 'Return') then
      Bind(Uniform(op(1,rng), op(2,rng)), var, dens)
    else
      Bind(Lebesgue, var = rng, dens)
    end if
  end proc;

  density[NormalD] := proc(mu, sigma) proc(x)
    1/sigma/sqrt(2)/sqrt(Pi)*exp(-(x-mu)^2/2/sigma^2)
  end proc end proc;
  density[BetaD] := proc(a, b) proc(x)
    x^(a-1)*(1-x)^(b-1)/Beta(a,b)
  end proc end proc;
  # Hakaru uses the alternate definition of gamma, so the args are backwards
  density[GammaD] := proc(theta,k) proc(x)
    x^(theta-1)/k^(theta-1)*exp(-x/k)/k/GAMMA(theta);
  end proc end proc;

#############
# more hacks to get around Maple weaknesses
  myint := proc(expr, b)
    local var, inds, res, res0, res1;
    _EnvBinders := _EnvBinders union {op(1,b)};
    var := op(1,b);
    inds := indets(expr, specfunc(anything,c));
    inds := select(depends, inds, var);
    if inds={} then
      if type(expr, t_binds) then
        subsop(1=myint(op(1,expr),b), expr) assuming op(_EnvPathCond);
      else
        res0 := int(expr, b) assuming op(_EnvPathCond);
        if type(res0, t_binds) and op(2,res0)=b then # didn't work, try harder
          res1 := int(convert(expr, Heaviside), b) assuming op(_EnvPathCond);
          if not type(res1, t_binds) then # success!
            res := fix_Heaviside(res1, res0);
          else
            res := res0;
          end if;
        else
          res := res0;
        end if;
        res;
      end if;
    elif type(expr, t_pw) then
      # what is really needed here is to 'copy'
      # PiecewiseTools:-IntImplementation:-Definite
      try
        myint_pw(expr, b)
      catch "cannot handle condition":
        Int(expr, b)
      end try;
    elif type(expr, t_binds) then
      # go in?
      Int(expr, b)
    else
      Int(expr, b)
    end if;
  end proc;

  # if the boundaries are not 'natural' for the piecewise, things might go weird
  myint_pw := proc(expr, b :: name = `..`)
    local rels, n, rest, i, res, var, lower, upper, cond;
    n := floor(nops(expr)/2);
    rels := [seq(op(2*i-1, expr), i=1..n)];
    rest := evalb(2*n < nops(expr));
    upper := op([2,2],b);
    if type(rels, list({`<`, `<=`})) then # and indets(rels) = {op(1,b)} then
      res := 0; lower := op([2,1], b); var := op(1,b);
      for i from 1 to n do
        cond := op(2*i-1, expr);
        if cond::{identical(var) < anything, identical(var) <= anything} then
          res := res + myint(op(2*i, expr), var = lower .. op(2,cond));
          lower := op(2,cond);
        elif cond::{anything < identical(var), anything <= identical(var)} then
          res := res + myint(op(2*i, expr), var = op(1,cond) .. upper);
          upper := op(1,cond);
        else
          error "cannot handle condition (%1) while integrating pw", cond;
        end if;
      end do;
      if rest then
        if lower = upper then error "What the hey?" end if;
        res := res + myint(op(-1, expr), var = lower..upper);
      end if;
      res
    elif length(expr) < 200 then # what have we got to lose?
      res := int(convert(expr, Heaviside), b);
      if not (indets(res, specfunc(anything, '{Dirac,Heaviside}')) = {}) then
        fix_Heaviside(res, Int(expr,b))
      else
        res
      end if;
    else # well, too much time!
      Int(expr, b)
    end if;
  end proc;
end;

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

# Disabled until Pair is removed in Hakaru

# Pair := proc(a,b) Tag(P2, Zero(Cons(a, Cons(b, Nil )))) end proc;

# `type/Nil` := proc(val) evalb(val = 'Nil') end proc;

# `type/Pair` := proc(val, t0, t1)
#   type(val, Tag(identical(P2), Zero(Cons(t0, Cons (t1, Nil )))))
# end proc;

# PairType := proc(a,b) Tagged(P2(a,b), [[ a,b ]]); end proc;

# `type/PairType` := proc(val, t0, t1)
#   type(val, Tagged(P2(t0, t1), [[ t0, t1 ]] ));
# end proc;

fst := proc(e)
  if e::Pair(anything, anything) then
    op(1,e)
  elif e::specfunc(anything, if_) then
    if_(op(1,e), fst(op(2,e)), fst(op(3,e)))
  else
    'fst'(e)
  end if;
end proc;

snd := proc(e)
  if e::Pair(anything, anything) then
    op(2,e)
  elif e::specfunc(anything, if_) then
    if_(op(1,e), snd(op(2,e)), snd(op(3,e)))
  else
    'snd'(e)
  end if;
end proc;

# piecewise is horrible, so this hack takes care of some of it
if_ := proc(cond, tb, eb)
  if cond::name then
    if_(cond = true, tb, eb)
  else
    'if_'(cond, tb, eb)
  end if;
end proc;

WeightedM := proc(w, m)
  if w=1 then
    m
  elif type(m, specfunc(anything, 'Superpose')) then
    Superpose(op(map(into_sup, m, w)));
  elif type(m, specfunc(anything, 'WeightedM')) then
    WeightedM(w*op(1,m), op(2,m))
  else
    'WeightedM'(w,m)
  end if;
end;

Superpose := module()
  export ModuleApply;
  local bb;

  bb := proc(t, k, no_rng)
    local bds, var;
    bds := t[op(k)];
    var := gensym('xx');
    if bds::`+` then
      if no_rng then
        bds := map(x -> subs(op(2,x)=var, x), [op(bds)]); # rename uniformly
        Bind(k[1], var, Superpose(op(map2(op, 3, bds))))
      else
        bds := map(x -> subs(op([2,1],x)=var, x), [op(bds)]); # rename uniformly
        Bind(k[1], var = k[2], Superpose(op(map2(op, 3, bds))))
      end if;
    else
      bds
    end if;
  end proc;
  ModuleApply := proc()
    local wm, bind, bindrr, i, j, res, l;
    if _npassed = 1 then
      _passed[1]
    else
      wm := table('sparse'); bind := table('sparse'); bindrr := table('sparse');
      l := map(x -> `if`(op(0,x)='Superpose', op(x), x), [_passed]);
      for i in l do
        if i::'WeightedM'(anything, anything) then
          wm[op(2,i)] := wm[op(2,i)] + op(1,i);
        elif i::'Return'(anything) then
          wm[i] := wm[i] + 1;
        elif i::'Bind'(anything, name, anything) then
          bind[op(1,i)] := bind[op(1,i)] + i;
        elif i::'Bind'(anything, name = range, anything) then
          bindrr[op(1,i), op([2,2],i)] := bindrr[op(1,i), op([2,2], i)] + i;
        elif i::specfunc(anything, 'If') then
          wm[i] := wm[i] + 1;
        else
          # error "how do I superpose %1", i;
          # rather than error out, just pass it through
          wm[i] := wm[i] + 1;
        end if;
      end do;
      res := [
        seq(WeightedM(wm[j], j), j = [indices(wm, 'nolist')]),
        seq(bb(bind,j,true), j = [indices(bind)]),
        seq(bb(bindrr,j,false), j = [indices(bindrr)])];
      if nops(res)=1 then res[1] else 'Superpose'(op(res)) end if;
    end if;
  end proc;
end module;

Bind := proc(w, var, meas)
  if var::name and meas = Return(var) then
    w
#  elif var::name and
#    meas :: 'WeightedM'(anything, 'Return'(identical(var))) and
#    not depends(op(1, meas), var) then
#    WeightedM(op(1,meas), w)
  elif var::name and meas :: 'WeightedM'(anything, anything) and
    not depends(op(1, meas), var) then
    WeightedM(op(1,meas), Bind(w, var, op(2,meas)))
  elif var::name and meas :: 'Return'(identical(var)) then
    w
  elif var::`=` and op(2,var) = (-infinity)..infinity then
    Bind(w, op(1,var), meas)
  elif var::`=` and op(2,var) = 0..1 and w::specfunc(anything,'BetaD') then
    Bind(w, op(1,var), meas)
  elif var::`=` and op(2,var) = 0..infinity and w::specfunc(anything,'GammaD') then
    Bind(w, op(1,var), meas)
  elif w='Lebesgue' and var::`=` and not(op([2,1],var) :: SymbolicInfinity)
        and not(op([2,2],var) :: SymbolicInfinity) then
    Bind(Uniform(op([2,1],var), op([2,2],var)), op(1,var), meas)
  elif w :: 'WeightedM'(anything, anything) then
    WeightedM(op(1,w), Bind(op(2,w), var, meas));
  else
    'Bind'(w, var, meas)
  end if;
end proc;

If := module()
  export ModuleApply;
  local patch_eb;

  patch_eb := proc(eb2, cond2)
    local fcond, new_cond, rest_cond, t1, t2, rest;

    fcond := SLO:-flip_cond(cond2);
    new_cond := And(op(1,eb2), fcond);
    rest_cond := And(SLO:-flip_cond(op(1,eb2)), fcond);
    t1 := coulditbe(new_cond) assuming op(_EnvPathCond);
    t2 := simplify(piecewise(rest_cond, 1, 0));
    t2 := not (evalb(t2=0));
    if t1=false then
      rest := op(3,eb2);
      if op(0,rest) = 'If' then
        If(And(op(1,rest), rest_cond), op(2, rest), op(3, rest))
      else
        rest
      end if;
    elif t2 then
      eb2
    else
      op(2,eb2)
    end if;
  end proc;

  ModuleApply := proc(cond, tb, eb)
    local new_eb;
    if cond = true then
      tb
    elif cond = false then
      eb
    elif tb = 'Return'(undefined) then
      # must 'patch things up' if we had a nested If
      `if`(op(0,eb) = 'If', patch_eb(eb, cond), eb);
    elif eb = Return(undefined) then
      tb
    elif tb = eb then
      eb
    elif type(cond, anything = identical(true)) then
      If(op(1,cond), tb, eb)
    elif op(0,eb) = 'If' and op(3,eb)=Superpose() then
      new_eb := patch_eb(eb, cond);
      if normal(new_eb-eb) = 0 then
        'If'(cond, tb, new_eb)
      else
        If(cond, tb, new_eb)
      end if;
    else
      'If'(cond, tb, eb)
    end if;
  end proc;
end module;

# A Context contains
# - a (Maple-encoded) Hakaru type 'htyp' (H-types)
# - a Measure type
# - a global context of var = H-types
# - a global numbering context for var names
# - the size of the global context (in # of variables)
`type/Context` := 'record'('htyp', 'mtyp', 'gctx', 'gnum', 'gsize');

gensym := module()
  export ModuleApply;
  local gs_counter;
  gs_counter := 0;
  ModuleApply := proc(x::name)
    gs_counter := gs_counter + 1;
    x || gs_counter;
  end proc;
end module;

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

SLO := module ()
  export ModuleApply, AST, simp, flip_cond, condToProp,
    c; # very important: c is "global".
  local ToAST, t_binds, t_pw, t_rel,
    into_pw, myprod, do_pw,
    mkProb, getCtx, instantiate, lambda_wrap, find_paths,
    mkReal,
    fill_table, toProp, toType,
    twiddle, myint, myint_pw,
    fix_Heaviside,
    adjust_types, compute_domain, analyze_cond, isPos,
    adjust_superpose,
    get_breakcond, merge_pw,
    MyHandler, getBinderForm, infer_type, join_type, join2type,
    infer_type_prod, infer_type_sop, check_sop_type,
    simp_sup, simp_if, into_sup, simp_rel,
    simp_pw, simp_pw_equal, simp_pw3, simp_Or,
    simp_props,
    comp2, comp_algeb, compare, comp_list,

    # density recognisation routines
    get_de, mkRealDensity, recognize_density, recognize_density_01,
    recognize_density_0inf, density;

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

  # SLO output goes into AST
  ModuleApply := proc(spec::Typed(anything,anything))
    local expr, typ, glob, gsiz, ctx, r, inp, meastyp, res, gnumbering;
    expr := op(1, spec);
    typ := op(2, spec);
    glob, gnumbering, gsiz, meastyp := getCtx(typ, {}, table(), 0);
    r := Record('htyp' = typ, 'mtyp' = meastyp,
                'gctx' = glob, 'gnum' = gnumbering, 'gsize' = gsiz);
    inp := instantiate(expr, r, 0, typ);

    # global option
    _EnvUseHeavisideAsUnitStep := true;
    try
      # be context sensitive for this pass too:
      _EnvBinders := {};
      _EnvPathCond := `union`(op(map(toProp, glob)));
      NumericEventHandler(division_by_zero = MyHandler);
      # simp first applied so piecewise is effective,
      # then again in case eval "undoes" work of first simp call
      res := snd(inp(c));
      res := eval(res, 'if_'=piecewise);
      res := simp(res);
      res := eval(res, Int=myint);
      res := HAST(simp(res), r);
    catch "Wrong kind of parameters in piecewise":
      error "Bug in Hakaru -> Maple translation, piecewise used incorrectly.";
    finally :
      NumericEventHandler(division_by_zero = default);
    end try;
    res;
  end proc;

  # AST transforms the Maple to a representation of the mochastic AST
  # environment variables plus indexing functions make tracking info easy!
  AST := proc(inp::HAST(anything, Context))
    local res, ctx, t, i, rng;

    ctx := op(2,inp);

    # global option
    _EnvUseHeavisideAsUnitStep := true;

    # right at the start, put the global context in scope.
    _EnvBinders := map2(op, 1, ctx:-gctx);
    _EnvTypes := `union`(op(map(toType, ctx:-gctx)));
    _EnvPathCond := `union`(op(map(toProp, ctx:-gctx)));
    res := ToAST(op(inp));
    res := adjust_types(res, ctx:-mtyp, ctx);
    res := adjust_superpose(res);
    lambda_wrap(res, 0, ctx);
  end proc;

  # recursive function which does the main translation
  ToAST := proc(inp, ctx)
    local a0, a1, var, vars, rng, ee, cof, d, ld, weight, binders,
      v, subst, ivars, ff, newvar, rest, a, b, e;
    e := inp; # make e mutable
    if type(e, specfunc(name, c)) then
      return Return(op(e))
    # we might have recursively encountered a hidden 0
    elif (e = 0) then
      return Superpose()
    # we might have done something odd, and there is no x anymore (and not 0)
    elif type(e, 'numeric') then
      error "the constant %1 is not a measure", e
    # invariant: we depend on c
    else
      binders := indets(e, t_binds);
      vars := indets(e, specfunc(anything, c));
      subst := map(x-> x = op(0,x)[op(x)], vars);
      ivars := map2(op, 2, subst);
      if binders = {} then
        # this is a 'raw' measure, with no integrals
        ee := subs(subst, e);
        if type(ee, 'polynom'(anything,ivars)) then
          ee := collect(ee, ivars, simplify);
          d := degree(ee, ivars);
          ld := ldegree(ee, ivars);
          cof := [coeffs(ee, ivars, 'v')]; # cof is a list, v expseq
          if (d = 1) and (ld = 1) then
            ff := (x,y) -> WeightedM(simplify(x), Return(op(y)));
            Superpose(op(zip(ff, cof, [v])));
          elif (ee=0) then # collect/simplify could have revealed this
            Superpose()
          elif (ld = 0) then
            error "non-zero constant (%1) encountered as a measure", ee
          else
            error "polynomial in c: %1", ee
          end if;
        elif type(ee, t_pw) then
          return do_pw(map(simplify, [op(e)]), ctx);
        elif type(ee, `+`) then
          Superpose(op(map(ToAST, [op(e)], ctx)));
        else
          error "(%1) has no binders, but is still not a polynomial?", ee
        end if;
      else
        if type(e, 'specfunc'(anything, {'int','Int'})) then
          var, rng := op(op(2,e));
          ee := op(1,e);
          weight := simplify(op(2,rng)-op(1,rng));
          if type(weight, 'SymbolicInfinity') then
            rest := ToAST(ee, ctx);
            mkRealDensity(rest, var, rng)
          else
            # span := RealRange(op(1,rng), op(2,rng));
            v := simplify(weight*ee) assuming AndProp(op(1,rng)<var, var<op(2,rng));
            rest := ToAST(v, ctx);
            # Bind(Uniform(op(rng)), var, rest);
            mkRealDensity(rest, var, rng)
          end if;
        elif type(e, 'specfunc'(anything, {'sum','Sum'})) then
          error "sums not handled yet"
        elif type(e, t_pw) then
          return do_pw([op(e)], ctx);
        elif type(e, `+`) then
          Superpose(op(map(ToAST, [op(e)], ctx)));
        elif type(e, `*`) then
          # we have a binder in here somewhere
          a, b := selectremove(type, e, t_binds);
          # now casesplit on what a is
## from here
          if a=1 then  # no surface binders
            a, b := selectremove(type, e, t_pw);
            if a=1 then # and no piecewise either
              error "buried binder: %1", b
            elif type(a, `*`) then
              error "do not know how to multiply 2 pw: %1", a
            elif type(a, t_pw) then
              WeightedM(b, ToAST(a, ctx))
            else
              error "something weird happened: (%1) was supposed to be pw", a
            end if
          elif type(a, `*`) then
            error "product of 2 binders?!?: %1", a
          else
            WeightedM(b, ToAST(a, ctx))
          end if
## to here
        else
          error "Not sure what to do with %1", e
        end if;
      end if;
    end if;
  end proc;

  simp := proc(e)
    option remember, system;
    local binds, pw, substb, substp, subst, csubst, vbinds, vpw,
      ee, vars, all_vars, num, den, push_in, i,
      cs, simp_poly, simp_prod, simp_npw;

    simp_npw := zz -> `if`(op(1,zz)::t_pw, into_pw(SLO:-c,op(1,zz)), zz);
    if e=undefined or e::numeric or e::SymbolicInfinity then return e end if;
    cs := indets(e, specfunc(anything, c));
    csubst := map(x -> x = simp_npw(map(simp, value(x))), cs);
    ee := eval(e, csubst);
    if not type(csubst, set(specfunc(anything, c) = specfunc(anything,c))) then
      return simp(ee)
    end if;

    binds := indets(ee, t_binds);
    pw := indets(ee, t_pw);

    substb := map(x-> x = freeze(x), binds);
    substp := map(x-> x = freeze(x), pw);
    subst := substb union substp;
    ee := subs(subst union csubst, ee); # simultaneous substitution
    vbinds := map(rhs, substb);
    vpw := map(rhs, substp);
    vars := [op(vbinds union vpw)]; # order does not matter; only subst
    all_vars := [op(vars),op(convert(cs,list))];

    push_in := proc(c, v)
      local actual, cof, ii, rest, res;
      cof := c;
      if v=1 then return cof end if;
      actual := thaw(v);
      if type(actual, t_binds) then
        _EnvBinders := _EnvBinders union {op([2,1], actual)};
        op(0,actual)(simp(cof*op(1,actual)), op(2,actual))
      elif type(actual, t_pw) then
        actual := simplify(actual); # might get rid of pw!
        `if`(actual::t_pw, into_pw((x -> cof * x), actual), cof*actual);
      elif degree(v, vars)>1 then
        if type(actual, '`*`'(t_pw)) then
          res := merge_pw([op(actual)], mul);
          `if`(res::t_pw, into_pw((x->cof*x), res), cof*res);
        else
          (ii, rest) := selectremove(type, actual, t_binds);
          if ii::`*` then error "product? (%1)", ii; end if;
          simp(subsop(1=op(1,ii)*rest, ii));
        end if;
      else
        error "how can (%1) not be a binder, pw or c?", v
      end if;
    end proc;

    simp_poly := proc(p)
      local coef_q, vars_q, q, c0, res, heads;
      q := collect(p, all_vars , 'distributed', simplify);
      if not type(q, polynom(anything, vars)) then return thaw(q) end if;
      if ldegree(q, vars)<1 then
        # need to 'push in' additive constant sometimes
        c0 := tcoeff(q, vars);
        q := q - c0; # this should work because of the collect
      else
        c0 := 0;
      end if;
      if q = undefined then return undefined end if;
      if q=0 then return c0; end if;
      coef_q := [coeffs(q, vars, 'vars_q')];
      vars_q := [vars_q];
      # need to merge things too
      res := add(i,i=zip(push_in, coef_q, vars_q));
      if nops(coef_q) > 1 then
        heads := map2(op, 0, {op(res)}); # res::`+`
        if heads = {piecewise} then
          res := merge_pw([op(res)], add);
        end if;
        c0+res
      elif not (c0 = 0) then
        # don't push additive constants into (usually infinite!) integrals
        if type(res, t_binds) then
          c0+res;
        elif type(res, t_pw) then
          into_pw((x -> c0 + x), res)
        else
          error "Expected a pw or binder, got (%1)", res
        end if;
      else # c0 = 0
        res;
      end if;

    end proc;

    simp_prod := proc(p)
      local den, num;
      den, num := selectremove(type, p, anything ^ negint);
      den := 1/den;
      if degree(den, all_vars)>=1 then
        num := simp_poly(num);
        den := simp_poly(den);
        if den::t_pw then
          den := into_pw((x -> 1/x), den);
          simp(num*den); # this should not loop!
        else
          num/den; # integrals in denominator
        end if;
      else
        num := num / den; # no need to make this fancy
        simp_poly(num);
      end if;

    end proc;

    # keep some of the structure intact
    if type(ee, `*`) then
      ee := simp_prod(ee);
    elif type(ee, polynom(anything, vars)) then
      ee := simp_poly(ee);
    elif type(ee, ratpoly(anything, vars)) then
      ee := normal(ee);
      if type(ee, `*`) then
        ee := simp_prod(ee);
      else
        ee := simp_poly(numer(ee))/simp_poly(denom(ee));
      end if;
    elif type(ee, 'Pair'(anything, anything)) then
      ee := map(x -> simp(thaw(x)), ee);
      if op(1,ee)::t_pw then
        ee := into_pw((x -> Pair(x, op(2,ee))), op(1,ee))
      elif op(2,ee)::t_pw then
        ee := into_pw((x -> Pair(op(1,ee), x)), op(2,ee))
      end if;
    else
      error "ee (%1) should be ratpoly in (%2)", ee, vars;
    end if;

    ee;
  end proc;

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

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

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

  # a hack to make equations symmetric.  Session-dependent, but that's fine.
  twiddle := proc(x)
    local l;
    if type(x,`=`) then
      if rhs(x) = 0 then
        try
          if lhs(x)::`+` and nops(lhs(x))=2 then
            l := lhs(x);
            # Heuristic, as l may not be polynomial
            if sign(op(1,l))=-1 then
              twiddle(op(2,l) = -op(1,l))
            elif sign(op(2,l)) = -1 then
              twiddle(op(1,l) = -op(2,l))
            elif addressof(op(1,l)) > addressof(op(2,l)) then
              twiddle(op(2,l) = -op(1,l))
            else
              twiddle(op(1,l) = -op(2,l))
            end if;
          else
            x
          end if;
        catch:
          x
        end try;
      elif addressof(lhs(x)) > addressof(rhs(x)) then
        rhs(x) = lhs(x)
      else
        x
      end if;
    elif type(x,'list') then
      map(twiddle, x)
    else
      x
    end if;
  end proc;

  fix_Heaviside := proc(e, ee)
    try
      frontend(convert, [e], [{`+`,`*`}, '{Heaviside, Dirac}'], 'piecewise');
    catch "give the main variable as a second argument":
      ee
    end try;
  end proc;

  merge_pw := proc(l::list, f)
    local breakpoints, sbp, i, n, res, npw;

    breakpoints := convert(map(get_breakcond, l), 'set');
    sbp := map(twiddle, breakpoints);
    n := nops(l[1]);
    if nops(sbp)=1 then
      res := simp_pw(piecewise(seq(`if`(i::odd and i<n,
                                   op(i,l[1]),
                                   f(op(i,j),j=l)), i=1..n)));
      simp(res);
    else
      #error "multiple piecewises with different breakpoints %1", l
      # try with Heaviside
      res := f(i,i=l);
      try
        npw := simplify(convert(res, 'Heaviside'));
        npw := fix_Heaviside(npw, res);
      catch "give the main variable as a second argument":
        npw := res;
      end try;
      npw
    end if;
  end proc;

  get_breakcond := proc(pw::specfunc(anything, piecewise))
    local i, n;
    n := nops(pw);
    [seq(`if`(i::odd and i<n, op(i,pw), NULL), i=1..n)]
  end proc;

  simp_rel := proc(r)
    if r::name then
      r
    elif r::t_rel then
      # special case
      if r = ('Right' = 'Left') then
        false
      else
        if lhs(r) = undefined or rhs(r) = undefined then
          false
        else
          map(simp, r); # let map take care of which operator it is
        end if;
      end if;
    elif r::specfunc(anything, {And, Or, Not}) then
      map(simp_rel, r)
    else
      simp(r)
    end;
  end proc;

  simp_Or := proc(a,b)
    if type(a, anything = anything) and type(b, anything < anything)
      and op(1,a) = op(1,b) and op(2,a) = op(2, b) then
      op(1,a) <= op(2,a)
    elif type(b, anything = anything) and type(a, anything < anything)
      and op(1,a) = op(1,b) and op(2,a) = op(2, b) then
      op(1,a) <= op(2,a)
    else
      Or(a,b)
    end if;
  end proc;

  # takes the = conditions and applies & simplifies them
  simp_pw_equal := proc(pw)
    local n, rest, aa, f;
    n := floor(nops(pw)/2);
    rest := evalb(2*n < nops(pw));
    f := proc(cond, piece)
      if cond::(name = name) then
        if member(op(1,cond), _EnvBinders) or
           member(op(2,cond), _EnvBinders) then
          NULL
        else
          cond, eval(piece, cond)
        end if
      elif cond::(name = anything) then
        if member(op(1,cond), _EnvBinders) then
          NULL
        else
          cond, eval(piece, cond)
        end if;
      elif cond::(anything = name) then
        if member(op(2,cond), _EnvBinders) then
          NULL
        else
          cond, eval(piece, op(2,cond) = op(1,cond))
        end if
      else
        cond, piece
      end if
    end proc;
    aa := seq(f(op(2*i+1,pw), op(2*i+2,pw)), i = 0..n-1);
    if aa=NULL then
      if rest then
        op(-1, pw)
      else
        error "pw with all false conditions (%1)", pw
      end if
    else
      `if`(rest, piecewise(aa, op(-1,pw)), piecewise(aa));
    end if;
  end proc;

  # - takes pw conditions and distributes them, for n = 1
  # - simplifies simple cases of nested pw
  simp_pw := proc(pw)
    local res, cond, l, r, b1, b2, b3, rel, new_cond;
    res := simp_pw_equal(pw);
    if not res::t_pw then return res end if;
    if nops(res)=4 then
      b1 := flip_cond(op(1,res));
      if b1 = op(3,res) then
        res := piecewise(op(1,res), op(2, res), op(4,res));
      end if
    end if;

    if nops(res)=3 then
      # trivial case
      if normal(op(2,res)-op(3,res))=0 then return op(2,res) end if;
      # distribute conditions
      cond := op(1,res);
      if cond::t_rel and (op(1,cond)::t_pw or op(2,cond)::t_pw) then
        l := op(1, cond);
        r := op(2, cond);
        if (l::t_pw) and (r::t_pw) then
          error "double-pw condition (%1)", cond;
        end if;
        if l::t_pw then
          rel := x -> op(0,cond)(x,r);
          b1 := rel(op(2,l));
          b2 := op(1,l);
          b3 := rel(op(3,l));
          new_cond := Or(And(b2, b1), And(flip_cond(b2), b3));
          res := piecewise(new_cond, op(2, res), op(3, res))
        else
          rel := x -> op(0,cond)(l,x);
          b1 := rel(op(2,r));
          b2 := op(1,r);
          b3 := rel(op(3,r));
          new_cond := Or(And(b2, b1), And(flip_cond(b2), b3));
          res := piecewise(new_cond, op(2, res), op(3, res))
        end if;
      end if;

      # simplify simple nested cases
      if res::t_pw and op(2,res)::t_pw and nops(op(2,res))=3 and
         normal(op([2,3],res) - op(3,res)) = 0 then
          res := simp_pw(piecewise(And(op(1,res),op([2,1],res)), op([2,2],res), op(3,res)));
      end if;
      if res::t_pw and op(3,res)::t_pw and nops(op(3,res))=3 and
         normal(op([3,2],res) - op(2,res)) = 0 then
          b1 := simp_Or(op(1,res),op([3,1],res));
          res := simp_pw(piecewise(b1, op(2,res), op([3,3],res)));
      end if;
      if res::t_pw and op(3,res)::t_pw and nops(op(3,res))=3 and
         normal(op([3,3],res) - op(2,res)) = 0 then
          res := simp_pw(piecewise(And(op([3,1],res), flip_cond(op(1,res))), op(2,res), op([3,3],res)));
      end if;
    elif nops(res)=6 and op(2,res)=op(6,res) then
      # case of an if-else that has been complicated -- merge
      res := simp_pw(piecewise(And(flip_cond(op(1,res)), op(3,res)),
                               op(4,res), op(2,res)));
    end if;
    res;
  end proc;

  # this assumes we are doing pw of measures.
  do_pw := proc(l, ctx)
    local len, rel, prop_ctx, this, var;
    len := nops(l);
    if len = 0 then Superpose()
    elif len = 1 then ToAST(l[1], ctx)
    else # len>2.
      # special case - boolean
      if type(l[1], name = identical(true)) and len = 3 then
        var := op(1, l[1]);
        If(var, ToAST(eval(l[2], var=true), ctx),
                 ToAST(eval(l[3], var=false), ctx));
      # special case - Either
      elif type(l[1], name = identical(Left)) and len = 3 then
        if op(1,l[1]) = Right then
          ToAST(l[3], ctx)
        else
          error "Checking if %1 = Left ?", op(1,l[1]);
        end if;
      else
        # should analyze and simplify things depending on cond
        If(l[1], ToAST(l[2], ctx), thisproc(l[3..-1], ctx))
      end if;
    end if;
  end;

  mkProb := proc(w, ctx)
    local typ, pb, rl, pos, rest;
    if type(w, `*`) then
      pb, rl := selectremove(x->evalb(infer_type(x,ctx)=Prob), w);
      # all parts are Prob
      if rl = 1 then
        pb
      else
        # if there are multiple Real parts
        if type(rl, `*`) then
          pos, rest := selectremove(isPos, rl);
          # deal with pos part right away:
          pos := pb * maptype(`*`, mkProb, pos, ctx);
          if rest = 1 then
            pos
          else
            # make sure the rest really is positive
            # if not isPos(rest) then WARNING("cannot insure it will not crash") end if;
            if pos = 1 then
              unsafeProb(rest); # res it the whole thing, don't recurse!
            else
              pos * mkProb(rest, ctx)
            end if;
          end if;
        else # otherwise rl is a single thing
          # if not isPos(rl) then WARNING("cannot insure it will not crash") end if;
          if pb = 1 then
            unsafeProb(rl); # rl is the whole thing, don't recurse!
          else
            pb * mkProb(rl, ctx); # go ahead
          end if;
        end if;
      end if;
    elif type(w, 'exp'(anything)) then
      exp_(mkReal(op(1,w), ctx));
    elif type(w, 'erf'(anything)) then
      erf_(mkProb(op(1,w)));
    elif type(w, 'ln'(anything)) then
      error "mkProb ln: %1", w;
    elif type(w, anything^{identical(1/2), identical(-1/2)}) then
      typ := infer_type(op(1,w), ctx);
      if typ = 'Prob' then
        sqrt_(op(1,w))
      elif typ = 'Number' then # is this right?
        w
      else
        mkProb(op(1,w), ctx) ^ op(2,w)
      end if;
    elif type(w, anything^negint) then
      typ := infer_type(op(1,w), ctx);
      if member(typ,{Prob, Number}) then
        op(1,w)^op(2,w)
      else
        unsafeProb(op(1,w))^op(2,w)
      end if;
    elif type(w, anything^fraction) then # won't be sqrt
      unsafeProb(w);
    elif type(w, 'unsafeProb'(anything)) then
      error "there should be no unsafeProb in %1", w
    else
      typ := infer_type(w, ctx);
      if member(typ, {'Prob', 'Number'}) then
        w
      elif typ = 'Real' then
        # we are going to need to cast.  Is it safe?
        # if not isPos(w) then WARNING("cannot insure it will not crash") end if;
        unsafeProb(w);
      else
        error "how do I make a Prob from %1 in %2", w, eval(_EnvTypes)
      end if;
    end if;
  end proc;

  mkReal := proc(w, ctx)
    local prob, rl, typ;
    if w::`*` then
      rl, prob := selectremove(x->evalb(infer_type(x,ctx)=Real), w);
      # all parts are Real
      if prob = 1 then
        rl
      else
        rl * fromProb(prob)
      end if;
    elif type(w, 'specfunc'(anything, {cos, sin, exp,erf})) then
      map(mkReal, w, ctx)
    else
      typ := infer_type(w, ctx);
      if member(typ ,{'Real', 'Number'}) then
        w
      else
        error "don't know how to make (%1) real", w;
      end if;
    end if;
  end proc;

  # use assumptions to figure out if we are actually positive, even
  # when the types say otherwise
  isPos := proc(w)
    local res;

    res := signum(0, w, 1) assuming op(_EnvPathCond);
    evalb(res = 1);
  end proc;

  toProp := proc(x::`=`)
    local nm, typ, prop, rest, left, right, r1, r2;
    (nm, typ) := op(x);

    if type(typ, 'symbol') then
      if typ = 'Real' then (prop, rest) := 'real', {};
      elif typ = 'Prob' then (prop, rest) := RealRange(0,infinity), {};
      elif typ = 'Bool' then (prop, rest) := boolean, {};
      elif typ = 'Unit' then (prop, rest) := identical(Unit), {};
      else
        error "Unknown base type %1", x
      end if;
    elif nm :: Pair(anything, anything) and
         typ :: Pair(anything, anything) then
      (left, r1) := thisproc(op(1, nm) = op(1,typ));
      (right, r2) := thisproc(op(2, nm) = op(2,typ));
      (prop, rest) := Pair(op([1,2],left), op([1,2],right)),
                     (`union`(r1, r2, left, right));
    else
      error "How can I make a property from %1", x;
    end if;
    {nm :: prop}, rest
  end proc;

  condToProp := proc(cond)
    eval(cond,{And=AndProp, Or=OrProp})
  end proc;

  toType := proc(x::`=`)
    local nm, typ, prop, rest, r1, r2;
    (nm, typ) := op(x);

    if type(typ, 'symbol') then
      rest := {nm::typ}
    elif nm :: Pair(anything, anything) and
         typ :: Pair(anything, anything) then
      r1 := thisproc(op(1, nm) = op(1,typ));
      r2 := thisproc(op(2, nm) = op(2,typ));
      rest := `union`(r1, r2);
    else
      error "How can I make a property from %1", x;
    end if;
    rest
  end proc;

  fill_table := proc(t, nm, typ)
    if nm::name then
      if typ = 'Real' then
        t[nm] := RealRange(-infinity, infinity)
      elif typ = 'Prob' then
        t[nm] := RealRange(0, infinity)
      elif typ = 'Bool' then
        t[nm] := boolean
      elif typ = 'Unit' then
        # Do nothing, this does not need remembered
      else
        error "Real/Prob/Bool/Unit are the only base types: %1", typ;
      end if;
    elif typ :: 'Pair'(anything, anything) then
      fill_table(t, op(1, nm), op(1, typ));
      fill_table(t, op(2, nm), op(2, typ));
    elif typ :: 'Measure'(anything) then
      error "cannot handle first-class measure types yet"
    elif typ :: 'Arrow'(anything,anything) then
      error "cannot handle first-class -> types yet"
    else
      error "I don't know type %1", typ;
    end if;
  end proc;

  getBinderForm := proc(t)
    local left, right;
    if t = 'Real' then gensym('rr')
    elif t = 'Prob' then gensym('pp')
    elif t :: Pair(anything, anything) then
      left := getBinderForm(op(1,t));
      right := getBinderForm(op(2,t));
      Pair(left, right);
    elif t = 'Bool' then gensym('bb')
    elif t = 'Unit' then gensym('uu') # we really do need a name!
    else
      error "Trying to form a name from a %1", t
    end if;
  end proc;

  getCtx := proc(typ, glob, globNum, ctr)
    local nm, t;
    if type(typ, 'Arrow'(anything, anything)) then
      t := op(1,typ);
      # 'nm' is a name-filled type structure, not necessarily a name
      nm := getBinderForm(t);
      globNum[ctr] := nm;
      getCtx(op(2,typ), glob union {nm = t}, globNum, ctr+1)
    elif type(typ, 'Measure'(anything)) then
      glob, globNum, ctr, typ
    else
      error "must have either Measure or Arrow, got %1", typ;
    end if;
  end proc;

  instantiate := proc(e, ctx, ctr, typ)
    local nm;
    if ctr = ctx:-gsize then
      e
    else
      nm := ctx:-gnum[ctr];
      instantiate(e(nm), ctx, ctr + 1, op(2,typ))
    end if;
  end proc;

  # note that the 'nm' is a path, not necessarily of type name
  find_paths := proc(struct, nm)
    local lv, rv, lsubs, rsubs;
    if struct::Pair(anything, anything) then
      (lv, rv) := op(struct);
      lsubs := `if`(lv::name, {lv = Fst(nm)}, find_paths(lv, Fst(nm)));
      rsubs := `if`(rv::name, {rv = Snd(nm)}, find_paths(rv, Snd(nm)));
      lsubs union rsubs
    else
      error "expected nested tuple of names, got (%1)", struct;
    end if;
  end proc;

  lambda_wrap := proc(expr, cnt, ctx)
    local var, ee, newvar, name_subst;
    if cnt = ctx:-gsize then
      expr
    else
      var := ctx:-gnum[cnt];
      if type(var, 'name') then
        Lambda(var, lambda_wrap(expr, cnt+1, ctx));
      # cheat, for now
      elif type(var, Pair(anything, anything)) then
        newvar := gensym('pr');
        name_subst := find_paths(var, newvar);
        ee := subs({var = newvar} union name_subst, expr);
        Lambda(newvar, lambda_wrap(ee, cnt+1, ctx));
      else
        error "cannot yet lambda_wrap a %1", var
      end if;
    end if;
  end proc;

  infer_type := proc(e, ctx)
    local typ, l, res, k, t;
    if type(e, boolean) then
      'Bool'
    elif e = 'Pi' then Prob
    elif e = 'Unit' then Unit
    elif e = 'Lebesgue' then Measure(Real)
    elif e = 'undefined' then Real
    elif type(e, boolean) then
      'Bool'
    elif type(e, anything^integer) then
      infer_type(op(1,e), ctx);
    elif type(e, specfunc(anything, {'exp', 'sin','cos'})) then
      typ := infer_type(op(1,e), ctx); # need to make sure it is inferable
      'Real' # someone else will make sure to cast this correctly
    elif type(e, specfunc(anything, {'GAMMA' })) then
      typ := infer_type(op(1,e), ctx); # need to make sure it is inferable
      'Prob'
    elif type(e, anything^fraction) then
      infer_type(op(1,e), ctx); # need to make sure it is inferable
      # if it is <0, weird things will happen
      # someone else will make sure to cast this correctly
    elif type(e, 'erf'(anything)) then
      infer_type(op(1,e), ctx); # erf is Real, erf_ is Prob
      'Real'
    elif type(e, 'Ei'(posint, anything)) then
      infer_type(op(1,e), ctx);
      'Real'
    elif type(e, 'ln'(anything)) then
      typ := infer_type(op(1,e), ctx); # need to make sure it is inferable
      'Real'
    elif type(e, 'symbol') then
      # first look in the global context
      res := select(type, ctx:-gctx, identical(e) = anything);
      if nops(res)=1 then
        op([1,2], res)
      else # then in the current path
        res := select(type, _EnvTypes, 'identical'(e) :: 'anything');
        if nops(res)=1 then
          typ := op([1,2], res);
          #if type(typ, {'RealRange'(anything, anything), identical(real)}) then
          #  if signum(0,op(1,typ),0)=1 then 'Prob' else 'Real' end if
          #else
            typ
          #end if;
        else
          error "Impossible: an untyped free variable %1 in local context %2, got (%3)",
            e, eval(_EnvTypes), res
        end if;
      end if;
    elif type(e, 'Pair'(anything, anything)) then
      map(infer_type, e, ctx);
    elif type(e, {`+`, `*`}) then
      l := map(infer_type, [op(e)], ctx);
      join_type(op(l));
    elif type(e, {'integer', 'fraction'}) then
      Number # constants are polymorphic!
    elif type(e, specfunc(anything, 'piecewise')) then
      typ := NULL;
      for l from 1 to nops(e) do
        if l::odd and l<nops(e) then
          next;
        else # last or e:: evan
          typ := typ, infer_type(op(l, e), ctx)
        end if;
      end do;
      join_type(typ);
    elif type(e, {specfunc(anything, 'NormalD')}) then
      Measure(Real)
    elif type(e, specfunc(anything, 'Superpose')) then
      res := map(infer_type, {op(e)}, ctx);
      if nops(res) = 1 then
        res[1]
      else
        error "Superpose with multiple types %1", e
      end if;
    elif type(e, specfunc(anything, 'WeightedM')) then
      infer_type(op(2, e), ctx)
    elif type(e, specfunc(anything, 'Uniform')) then
      Measure(Real)
    elif type(e, specfunc(anything, {'BetaD', 'GammaD'})) then
      Measure(Prob)
    elif type(e, 'Bind'(anything, name, anything)) then
      Measure(Real)
    elif type(e, 'Bind'(anything, name = range, anything)) then
      Measure(Real)
    elif type(e, 'Tag'(anything, anything)) then

      (k, t) := infer_type_sop(op(2,e), ctx);
      TagMaple(k, t);

    else
      error "how do I infer a type from %1", e;
    end if;
  end proc;

  infer_type_prod := proc(e, ctx)
    local t0, ts;
    if e = 'Nil' then
      [];
    elif op(0,e) = 'Cons' then
      t0 := infer_type(op(1,e), ctx);
      ts := infer_type_prod (op(2,e), ctx);
      [t0, op(ts)];
    else error "infer_type_prod: %1 is not a product type", e
    end if;
  end proc;

  infer_type_sop := proc(e, ctx)
    local k, t;
    if op(0,e) = 'Zero' then
      (0, infer_type_prod (op(1,e), ctx));
    elif op(0,e) = 'Succ' then
      k, t := infer_type_sop (op(1,e), ctx);
      (k+1, t);
    else error "infer_type_sop: %1 is not a sum of product type", e
    end if;
  end proc;

  check_sop_type := proc(inferredType, actualType)
    local compatible_types, k, t, sopType;

    compatible_types := proc(inf, act)
      if inf = 'Number' then
        member(act, {'Int', 'Real', 'Prob'})
      else
        inf = act
      end if;
    end proc;

    (k, t) := op(inferredType);
    sopType := op(2, actualType);

    `and` (op (zip (compatible_types, t, op(k+1,sopType))))
  end proc;

  join2type := proc(a,b)
    if a = b then a
    elif a = 'Number' then b
    elif b = 'Number' then a
    elif (a = 'Real' and b = 'Prob') or
         (b = 'Real' and a = 'Prob') then 'Mixed' # we'll need to patch
    else error "join2type of %1, %2", a, b
    end if;
  end proc;

  # could foldl, but this will work too
  join_type := proc()
    if _npassed < 2 then error "join_type: cannot happen, nargs<2"
    elif _npassed = 2 then
      join2type(_passed[1], _passed[2])
    else
      join_type(join2type(_passed[1], _passed[2]), _passed[3..-1])
    end if;
  end proc;
  ####
  # Fix-up the types using contextual information.
# TODO: need to add unsafeProb around the Prob-typed input variables,
# and then fix-up things like log.
#
# The right way to do this is really to do
# - full 'type' inference of e
# - full 'range-of-value' inference of e
  adjust_types := proc(e, typ, ctx)
    local ee, dom, opc, res, var, left, right, inf_typ, typ2, cond, fcond, cl;
    if type(e, specfunc(anything, 'Superpose')) then
      map(thisproc, e, typ, ctx)
    elif type(e, 'WeightedM'(anything, anything)) then
      WeightedM(mkProb(op(1,e), ctx), thisproc(op(2,e), typ, ctx));
    elif type(e, 'Return'(anything)) and type(typ, 'Measure'(anything)) then
      typ2 := op(1, typ);
      inf_typ := infer_type(op(1,e), ctx);
      if typ2 = Unit and op(1,e) = Unit then
        e
      elif typ2 = Prob then
        ee := op(1,e);
        res := mkProb(ee, ctx);
        'Return'(res);
      elif typ2 = Real and type(op(1,e), 'ln'(anything)) then
        ee := op(1,e);
        inf_typ := infer_type(op(1, ee), ctx);
        if inf_typ = 'Prob' then
          'Return'(ln_(op(1,ee)))
        else
          'Return'(ee);
        end if;
      elif typ2 = Real and member(inf_typ, {'Real', 'Number'}) then
        'Return'(op(1,e))
      elif typ2 = Real and inf_typ = 'Mixed' then
        'Return'(mkReal(op(1,e), ctx));
      elif typ2 :: Pair(anything, anything) and
           op(1,e) :: Pair(anything, anything) then
        left  := adjust_types('Return'(op([1,1],e)), Measure(op(1,typ2)), ctx);
        right := adjust_types('Return'(op([1,2],e)), Measure(op(2,typ2)), ctx);
        'Return'(Pair(op(1,left), op(1,right)));
      elif typ2 = Bool and member(op(1,e), {true,false}) then
        e
      elif type(typ2, 'Tagged'(anything, anything)) then
        if check_sop_type(inf_typ, typ2) then
          e
        else
          error "Type check failed in Tagged (adjust_types); type{%1} inf_type{%2} expr{%3}", typ2, inf_typ, e;
        end if;
      else
         error "adjust_types with type %1, inf_typ %2, for %3", typ, inf_typ, e;
      end if;
    elif type(e, 'Bind'(identical(Lebesgue), name, anything)) then
      var := op(2,e);
      _EnvTypes := _EnvTypes union {var :: Real};
      _EnvPathCond := _EnvPathCond union {var :: real};
      Bind(Lebesgue, var, adjust_types(op(3,e), typ, ctx));
    elif type(e, 'Bind'(identical(Lebesgue), name = range, anything)) then
      dom := RealRange(op([2,2,1],e), op([2,2,2], e));
      var := op([2,1],e);
      _EnvTypes := _EnvTypes union {var :: Real};
      _EnvPathCond := _EnvPathCond union {var :: dom};
      Bind(op(1,e), op(2,e), adjust_types(op(3,e), typ, ctx));
    elif type(e, 'Bind'(anything, name = range, anything)) then
      dom := compute_domain(op(1,e), var);
      var := op([2,1],e);
      inf_typ := infer_type(op(1,e), ctx); # should assert Measure(..)
      _EnvTypes := _EnvTypes union {var :: op(1,inf_typ)};
      _EnvPathCond := _EnvPathCond union {dom};
      # need to adjust types on first op, to its own type, as that may require
      # tweaking which functions are used
      Bind(adjust_types(op(1,e), inf_typ, ctx), op(2,e), adjust_types(op(3,e), typ, ctx));
    elif type(e, 'Bind'(anything, name, anything)) then
      dom := compute_domain(op(1,e), var);
      var := op(2,e);
      inf_typ := infer_type(op(1,e), ctx); # should assert Measure(..)
      _EnvTypes := _EnvTypes union {var :: op(1,inf_typ)};
      _EnvPathCond := _EnvPathCond union {dom};
      # need to adjust types on first op, to its own type, as that may require
      # tweaking which functions are used
      Bind(adjust_types(op(1,e), inf_typ, ctx), op(2,e), adjust_types(op(3,e), typ, ctx));
    elif type(e, 'If'(name, anything, anything)) then
      # special case
      var := op(1,e);
      left := adjust_types(eval(op(2,e), var=true), typ, ctx);
      right := adjust_types(eval(op(3,e), var=false), typ, ctx);
      If(var, left, right);
    elif type(e, 'If'(anything, anything, anything)) then
      cond := op(1,e);
      fcond := flip_cond(cond);
      opc := _EnvPathCond;
      cl := simp_props(opc union {cond});
      if cl = false then  # cond is unsat
        cl := simp_props(opc union {fcond});
        if cl = false then # so is fcond, oh my!
          error "_EnvPathCond (%1) itself is unsat!", _EnvPathCond;
        end if;
        _EnvPathCond := cl;
        adjust_types(op(3,e), typ, ctx);
      else
        _EnvPathCond := cl;
        left := adjust_types(op(2,e), typ, ctx);
        cl := simp_props(opc union {fcond});
        if cl = false then # fcond is unsat, just return left
          return left;
        else
          _EnvPathCond := cl;
          right := adjust_types(op(3,e), typ, ctx);
          If(cond, left, right);
        end if;
      end if;
    elif type(e, 'Uniform'(anything, anything)) and typ = 'Measure(Real)' then
      e
    elif type(e, 'Uniform'(anything, anything)) and typ = 'Measure(Prob)' then
      var := gensym('pp');
      Bind(e, var, Return(unsafeProb(var)))
    elif type(e, 'BetaD'(anything, anything)) and typ = 'Measure(Prob)' then
      BetaD(mkProb(op(1,e), ctx), mkProb(op(2,e), ctx))
    elif type(e, 'BetaD'(anything, anything)) and typ = 'Measure(Real)' then
      var := gensym('pp');
      res := BetaD(mkProb(op(1,e), ctx), mkProb(op(2,e), ctx));
      Bind(res, var, Return(fromProb(var)))
    elif type(e, 'GammaD'(anything, anything)) and typ = 'Measure(Prob)' then
      GammaD(mkProb(op(1,e), ctx), mkProb(op(2,e), ctx))
    elif type(e, 'NormalD'(anything, anything)) and typ = 'Measure(Real)' then
      NormalD(op(1,e), mkProb(op(2, e), ctx))
    else
     error "adjust_types of %1 at type %2", e, typ;
    end if;
  end proc;

  flip_cond := proc(cond)
    if type(cond, `<`) then op(2,cond) <= op(1,cond)
    elif type(cond, `<=`) then op(2,cond) < op(1,cond)
    elif type(cond, `=`) then op(1,cond) <> op(2,cond)
    elif type(cond, `<>`) then op(1,cond) = op(2,cond)
    elif cond::specfunc(anything, 'And') and nops(cond)=2 then
      Or(flip_cond(op(1,cond)), flip_cond(op(2,cond)))
    elif cond::specfunc(anything, 'Or') and nops(cond)=2 then
      And(flip_cond(op(1,cond)), flip_cond(op(2,cond)))
    elif cond::specfunc(anything, 'Not') then
      op(1,cond)
    elif cond::name then
      'Not'(cond)
    else
      error "Don't know how to deal with condition %1", cond
    end if;
  end proc;

  compute_domain := proc(e, v)
    local res;
    if type(e, 'Uniform'(anything, anything)) then
      # 'RealRange'(op(e));
      AndProp(v>=op(1,e), v<=op(2,e));
    elif type(e, 'GammaD'(anything, anything)) then
      v::'RealRange'(0,infinity);
    elif type(e, 'BetaD'(anything, anything)) then
      v::'RealRange'(0,1);
    elif type(e, {identical('Lebesgue'), specfunc(anything, 'NormalD')}) then
      v::'real'
    elif type(e, specfunc(anything, 'Superpose')) then
      res := map((x -> compute_domain(op(2,x),v)), {op(e)});
      if nops(res)=1 then
        res[1]
      else
        error "expression %1 has multiple domain: %2", e, res
      end if;
    elif type(e, 'Bind'(anything, name, anything)) then
      v::'real'
    elif type(e, 'Bind'(anything, name = range, anything)) then
      v::RealRange(op([2,2,1], e), op([2,2,2], e))
    elif type(e, 'WeightedM'(anything, anything)) then
      compute_domain(op(2,e))
    else
      error "compute domain: %1", e;
    end if;
  end proc;

  # returns something of the right shape for assume
  analyze_cond := proc(c,ctx)
    if type(c, name = identical(true)) then
      error "analyze_cond should not be called with a boolean variable";
    else
      c
    end if;
  end proc;

  # while inside the evaluator, we want infinities
  MyHandler := proc(operator, operands, default_value)
    NumericStatus( division_by_zero = false);
    if operator='ln' then -infinity else default_value end if;
  end proc;

  # dirac < uniform < NormalD < bind < WeightedM < If < SUPERPOSE
  # returns false on equality
  comp2 := proc(x,y)
    if evalb(x=y) then false
    elif x::Return(anything) then
      if y::Return(anything) then
        comp_algeb(op(1,x), op(1,y))
      else
	true
      end if
    elif x::Uniform(numeric, numeric) then
      if y::Uniform(numeric, numeric) then
	evalb(op(1,x) < op(1,y))
      else
	evalb(not member(op(0,y), '{Return}'))
      end if
    elif x::specfunc(anything, NormalD) then
      if y::specfunc(anything, NormalD) then
        comp_list(zip( compare, [op(x)], [op(y)]));
      else
	evalb(not member(op(0,y), '{Return, Uniform}'));
      end if;
    elif x::specfunc(anything, 'Bind') then
      if y::specfunc(anything, 'Bind') then
	comp2(op(3, x), op(3, y))
      else
	evalb(not member(op(0,y), '{Return, Uniform, NormalD}'));
      end if
    elif x::specfunc(anything, 'WeightedM') then
      if y::specfunc(anything, 'WeightedM') then
        comp2(op(2, x), op(2, y))
      else
	evalb(not member(op(0,y), '{Return, Uniform, NormalD, WeightedM}'));
      end if;
    elif x::specfunc(anything, 'If') then
      if y::specfunc(anything, 'If') then
        # cheat!
        evalb( length(x) < length(y) )
      else
	evalb(not member(op(0,y), '{Return, Uniform, NormalD, WeightedM, If}'));
      end if;
    elif x::specfunc(anything, 'SUPERPOSE') then
      if y::specfunc(anything, 'SUPERPOSE') then
        error "cannot compare 2 SUPERPOSE %1, %2", x, y
      else
	evalb(not member(op(0,y), '{Return, Uniform, NormalD, WeightedM, If, SUPERPOSE}'));
      end if;
    else
      error "cannot compare: %1, %2", x, y
    end if;
  end proc;

  comp_algeb := proc(x, y)
    if x::numeric and y::numeric then
      evalb( x < y )
    elif {op(0,x), op(0,y)} = {Pair} then
      comp_list(zip( compare, [op(x)], [op(y)]));
    else # just cheat
      evalb( length(x) < length(y) )
    end if;
  end proc;

  comp_list := proc(l)
    if nops(l)=0 then
      false
    elif l[1]=LESS then
      true
    elif l[1]=GREATER then
      false
    else
      comp_list(l[2..-1])
    end if;
  end proc;

  compare := proc(x, y)
    if evalb(x=y) then
      EQUAL
    elif comp_algeb(x,y) then
      LESS
    elif comp_algeb(y,x) then
      GREATER
    else
      EQUAL # can this happen?
    end if;
  end proc;

  # helper routines for tweaking ASTs
  simp_sup := proc()
    SUPERPOSE(op(sort([_passed], 'strict'=comp2)))
  end proc;

  # weird routine to catch unsat, which means a condition list implies false
  simp_props := proc(p)
    local res, X, pl, ii;
    pl := map(condToProp, p);
    ii := remove(type, indets(pl, 'name'), constant);
    try
      # dummy query for unsat only
      coulditbe(X(op(ii)) > 0) assuming op(pl);
      res := pl;
    catch "when calling '%1'. Received: 'contradictory assumptions'":
    # catch "the assumed property", "contradictory assumptions":
      res := false;
    catch "when calling": # all other errors
      res := pl;
    end try;
    res;
  end proc;

  into_sup := proc(wm, w) WeightedM(simplify(w*op(1,wm)), op(2,wm)) end proc;

  # sort, then fix things up to make printing easier
  adjust_superpose := proc(e)
    local f;
    f := proc()
      'SUPERPOSE'(seq(`if`(op(0,_passed[i])='WeightedM',
                          'WM'(op(_passed[i])),
                          'WM'(1,_passed[i])), i=1.._npassed))
    end proc;
    eval(eval(e, Superpose=simp_sup), SUPERPOSE = f);
  end proc;

  get_de := proc(dens, var, Dx)
    local de, init, diffop;
    try
      de := gfun[holexprtodiffeq](dens, f(var));
      if not (de = NULL) and not (de :: set) then
        de := gfun[diffeqtohomdiffeq](de, f(var));
      end if;
      if de::set then
        init, de := selectremove(type, de, `=`);
        if nops(de)=1 then
          de := de[1];
          diffop := DEtools[de2diffop](de, f(var), [Dx, var]);
          return Diffop(diffop, init)
        end if;
      elif not (de = NULL) then # no initial condition returned
        diffop := DEtools[de2diffop](de, f(var), [Dx, var]);
        return Diffop(diffop, {}); # should be {f(0)=0} ?
      end if;
    catch: # do nothing
    end try;
    Nothing
  end proc;

  # density recognizer for reals
  recognize_density := proc(diffop, init, Dx, var)
    local a0, a1, scale, at0, mu, sigma, ii;
    if degree(diffop, Dx) = 1 then
      a0 := coeff(diffop, Dx, 0);
      a1 := coeff(diffop, Dx, 1);
      if degree(a0, var) = 1 and degree(a1, var) = 0 and nops(init) = 1 then
        ii := rhs(init[1]);
        scale := coeff(a0, var, 1);
        mu := -coeff(a0, var, 0)/scale;
        sigma := sqrt(coeff(a1, var, 0)/scale);
        at0 := simplify(eval(ii/density[NormalD](mu, sigma)(0)));
        return WeightedM(at0, NormalD(mu,sigma));
      end if;
    end if;
    NULL;
  end proc;

  # density recognizer for 0..1
  recognize_density_01 := proc(full_diffop, init, Dx, var)
    local a0, a1, scale, at0, a, b, c0, ii, constraints, sol, diffop;

    # throw away the content, it does not help us!
    diffop := primpart(full_diffop, Dx);
    if degree(diffop, Dx) = 1 then
      ii := map(convert, init, 'diff');
      a0 := coeff(diffop, Dx, 0);
      a1 := coeff(diffop, Dx, 1);
      if degree(a0,var)=1 and degree(a1,var)=2 and normal(var^2-var - a1)=0 then
        a := coeff(a0, var, 0) + 1;
        b := -coeff(a0, var, 1) - a + 2;
        if init = {} then
          return BetaD(a,b);
        else
          constraints := eval(ii, f = (x -> c0*density[BetaD](a,b)(x)));
          sol := solve(constraints, c0);
          return WeightedM(eval(c0, sol), BetaD(a,b));
        end if;
      # degenerate case with b=1
      elif degree(a0,var)=0 and degree(a1,var)=1 and normal(var + a1)=0 then
        a := coeff(a0, var, 0) + 1;
        if init = {} then
          return BetaD(a,1);
        else
          constraints := eval(ii, f = (x -> c0*density[BetaD](a,1)(x)));
          sol := solve(constraints, c0);
          return WeightedM(eval(c0, sol), BetaD(a,1));
        end if;
      # degenerate case with a=1
      elif degree(a0,var)=0 and degree(a1,var)=1 and normal(a1 - (var-1))=0 then
        b := -(coeff(a0, var, 0) - 1);
        if init = {} then
          return BetaD(1,b);
        else
          constraints := eval(ii, f = (x -> c0*density[BetaD](1,b)(x)));
          sol := solve(constraints, c0);
          return WeightedM(eval(c0, sol), BetaD(1,b));
        end if
      # degenerate case with a=1, presented differently
      elif degree(a0,var)=0 and degree(a1,var)=1 and normal(a1 + (var-1))=0 then
        b := (coeff(a0, var, 0) + 1);
        if init = {} then
          return BetaD(1,b);
        else
          constraints := eval(ii, f = (x -> c0*density[BetaD](1,b)(x)));
          sol := solve(constraints, c0);
          return WeightedM(eval(c0, sol), BetaD(1,b));
        end if;
      end if;
    end if;
    NULL;
  end proc;

  # density recognizer for 0..infinity
  # warning: Maple's gamma distribution swaps its parameters wrt Hakaru's!
  recognize_density_0inf := proc(diffop, init, Dx, var)
    local a0, a1, scale, at0, b, c;
    if degree(diffop, Dx) = 1 then
      a0 := coeff(diffop, Dx, 0);
      a1 := coeff(diffop, Dx, 1);
      if degree(a0, var) = 1 and degree(a1, var) = 1 then
        if coeff(a1,var,0)= 0 then
          scale := coeff(a0,var,1);
          b := coeff(a1, var, 1)/scale;
          c := (b-(coeff(a0,var,0)/scale))/b;
          return GammaD(c, b);
        end if;
      # and Hakaru uses the 'alternate' definition of exponential...
      # TODO: take care of initial condition too
      elif degree(a0,var) = 0 and degree(a1, var) = 0 then
        scale := coeff(a1, var, 0);
        b := coeff(a0, var, 0)/scale;
        return GammaD(1,1/b);
      end if;
    end if;
    NULL;
  end proc;

  mkRealDensity := proc(dens, var, rng)
    local de, res, new_dens, Dx, diffop, init, c, d;
    if dens :: specfunc(anything, 'WeightedM') then
      res := NULL;
      # no matter what, get the de.
      # TODO: might want to switch from var=0 sometimes
      de := get_de(op(1,dens),var,Dx);
      if de::specfunc(anything, 'Diffop') then
        (diffop, init) := op(de);
        # dispatch on rng
        if rng = 0..1 then
          res := recognize_density_01(diffop, init, Dx, var) assuming op(_EnvPathCond), var::RealRange(0,1);
        elif rng = 0..infinity then
          res := recognize_density_0inf(diffop, init, Dx, var) assuming op(_EnvPathCond), var>0;
          # need to fix up initial conditions
          if res <> NULL then
            (c,d) := op(res);
            new_dens := op(1,dens)/density[GammaD](c,d)(var);
            new_dens := simplify(new_dens) assuming op(_EnvPathCond),var>0;
            if depends(new_dens,var) then
              error "mkRealDensity problem";
            end if;
            res := WeightedM(new_dens, res);
          end if;
        else # actually use 'real' recognizer in all these cases
          res := recognize_density(diffop, init, Dx, var) assuming op(_EnvPathCond), var::real;
        end if;
      end if;

      if res<>NULL then
        Bind(res, var = rng, op(2,dens))
      else
        Bind(Lebesgue, var = rng, dens)
      end if;
    elif dens :: specfunc(anything, 'Bind') then
      new_dens := mkRealDensity(op(1, dens), var, rng);
      # uses associatibity of >>=
      Bind(op(1, new_dens), op(2, new_dens),
        Bind(op(3, new_dens), op(2, dens), op(3, dens)));
    elif dens :: specfunc(anything, 'Return') then
      Bind(Uniform(op(1,rng), op(2,rng)), var, dens)
    else
      Bind(Lebesgue, var = rng, dens)
    end if
  end proc;

  density[NormalD] := proc(mu, sigma) proc(x)
    1/sigma/sqrt(2)/sqrt(Pi)*exp(-(x-mu)^2/2/sigma^2)
  end proc end proc;
  density[BetaD] := proc(a, b) proc(x)
    x^(a-1)*(1-x)^(b-1)/Beta(a,b)
  end proc end proc;
  # Hakaru uses the alternate definition of gamma, so the args are backwards
  density[GammaD] := proc(theta,k) proc(x)
    x^(theta-1)/k^(theta-1)*exp(-x/k)/k/GAMMA(theta);
  end proc end proc;

#############
# more hacks to get around Maple weaknesses
  myint := proc(expr, b)
    local var, inds, res, res0, res1;
    _EnvBinders := _EnvBinders union {op(1,b)};
    var := op(1,b);
    inds := indets(expr, specfunc(anything,c));
    inds := select(depends, inds, var);
    if inds={} then
      if type(expr, t_binds) then
        subsop(1=myint(op(1,expr),b), expr) assuming op(_EnvPathCond);
      else
        res0 := int(expr, b) assuming op(_EnvPathCond);
        if type(res0, t_binds) and op(2,res0)=b then # didn't work, try harder
          res1 := int(convert(expr, Heaviside), b) assuming op(_EnvPathCond);
          if not type(res1, t_binds) then # success!
            res := fix_Heaviside(res1, res0);
          else
            res := res0;
          end if;
        else
          res := res0;
        end if;
        res;
      end if;
    elif type(expr, t_pw) then
      # what is really needed here is to 'copy'
      # PiecewiseTools:-IntImplementation:-Definite
      try
        myint_pw(expr, b)
      catch "cannot handle condition":
        Int(expr, b)
      end try;
    elif type(expr, t_binds) then
      # go in?
      Int(expr, b)
    else
      Int(expr, b)
    end if;
  end proc;

  # if the boundaries are not 'natural' for the piecewise, things might go weird
  myint_pw := proc(expr, b :: name = `..`)
    local rels, n, rest, i, res, var, lower, upper, cond;
    n := floor(nops(expr)/2);
    rels := [seq(op(2*i-1, expr), i=1..n)];
    rest := evalb(2*n < nops(expr));
    upper := op([2,2],b);
    if type(rels, list({`<`, `<=`})) then # and indets(rels) = {op(1,b)} then
      res := 0; lower := op([2,1], b); var := op(1,b);
      for i from 1 to n do
        cond := op(2*i-1, expr);
        if cond::{identical(var) < anything, identical(var) <= anything} then
          res := res + myint(op(2*i, expr), var = lower .. op(2,cond));
          lower := op(2,cond);
        elif cond::{anything < identical(var), anything <= identical(var)} then
          res := res + myint(op(2*i, expr), var = op(1,cond) .. upper);
          upper := op(1,cond);
        else
          error "cannot handle condition (%1) while integrating pw", cond;
        end if;
      end do;
      if rest then
        if lower = upper then error "What the hey?" end if;
        res := res + myint(op(-1, expr), var = lower..upper);
      end if;
      res
    elif length(expr) < 200 then # what have we got to lose?
      res := int(convert(expr, Heaviside), b);
      if not (indets(res, specfunc(anything, '{Dirac,Heaviside}')) = {}) then
        fix_Heaviside(res, Int(expr,b))
      else
        res
      end if;
    else # well, too much time!
      Int(expr, b)
    end if;
  end proc;
end;

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

# Disabled until Pair is removed in Hakaru

# Pair := proc(a,b) Tag(P2, Zero(Cons(a, Cons(b, Nil )))) end proc;

# `type/Nil` := proc(val) evalb(val = 'Nil') end proc;

# `type/Pair` := proc(val, t0, t1)
#   type(val, Tag(identical(P2), Zero(Cons(t0, Cons (t1, Nil )))))
# end proc;

# PairType := proc(a,b) Tagged(P2(a,b), [[ a,b ]]); end proc;

# `type/PairType` := proc(val, t0, t1)
#   type(val, Tagged(P2(t0, t1), [[ t0, t1 ]] ));
# end proc;

fst := proc(e)
  if e::Pair(anything, anything) then
    op(1,e)
  elif e::specfunc(anything, if_) then
    if_(op(1,e), fst(op(2,e)), fst(op(3,e)))
  else
    'fst'(e)
  end if;
end proc;

snd := proc(e)
  if e::Pair(anything, anything) then
    op(2,e)
  elif e::specfunc(anything, if_) then
    if_(op(1,e), snd(op(2,e)), snd(op(3,e)))
  else
    'snd'(e)
  end if;
end proc;

# piecewise is horrible, so this hack takes care of some of it
if_ := proc(cond, tb, eb)
  if cond::name then
    if_(cond = true, tb, eb)
  else
    'if_'(cond, tb, eb)
  end if;
end proc;

WeightedM := proc(w, m)
  if w=1 then
    m
  elif type(m, specfunc(anything, 'Superpose')) then
    Superpose(op(map(into_sup, m, w)));
  elif type(m, specfunc(anything, 'WeightedM')) then
    WeightedM(w*op(1,m), op(2,m))
  else
    'WeightedM'(w,m)
  end if;
end;

Superpose := module()
  export ModuleApply;
  local bb;

  bb := proc(t, k, no_rng)
    local bds, var;
    bds := t[op(k)];
    var := gensym('xx');
    if bds::`+` then
      if no_rng then
        bds := map(x -> subs(op(2,x)=var, x), [op(bds)]); # rename uniformly
        Bind(k[1], var, Superpose(op(map2(op, 3, bds))))
      else
        bds := map(x -> subs(op([2,1],x)=var, x), [op(bds)]); # rename uniformly
        Bind(k[1], var = k[2], Superpose(op(map2(op, 3, bds))))
      end if;
    else
      bds
    end if;
  end proc;
  ModuleApply := proc()
    local wm, bind, bindrr, i, j, res, l;
    if _npassed = 1 then
      _passed[1]
    else
      wm := table('sparse'); bind := table('sparse'); bindrr := table('sparse');
      l := map(x -> `if`(op(0,x)='Superpose', op(x), x), [_passed]);
      for i in l do
        if i::'WeightedM'(anything, anything) then
          wm[op(2,i)] := wm[op(2,i)] + op(1,i);
        elif i::'Return'(anything) then
          wm[i] := wm[i] + 1;
        elif i::'Bind'(anything, name, anything) then
          bind[op(1,i)] := bind[op(1,i)] + i;
        elif i::'Bind'(anything, name = range, anything) then
          bindrr[op(1,i), op([2,2],i)] := bindrr[op(1,i), op([2,2], i)] + i;
        elif i::specfunc(anything, 'If') then
          wm[i] := wm[i] + 1;
        else
          # error "how do I superpose %1", i;
          # rather than error out, just pass it through
          wm[i] := wm[i] + 1;
        end if;
      end do;
      res := [
        seq(WeightedM(wm[j], j), j = [indices(wm, 'nolist')]),
        seq(bb(bind,j,true), j = [indices(bind)]),
        seq(bb(bindrr,j,false), j = [indices(bindrr)])];
      if nops(res)=1 then res[1] else 'Superpose'(op(res)) end if;
    end if;
  end proc;
end module;

Bind := proc(w, var, meas)
  if var::name and meas = Return(var) then
    w
#  elif var::name and
#    meas :: 'WeightedM'(anything, 'Return'(identical(var))) and
#    not depends(op(1, meas), var) then
#    WeightedM(op(1,meas), w)
  elif var::name and meas :: 'WeightedM'(anything, anything) and
    not depends(op(1, meas), var) then
    WeightedM(op(1,meas), Bind(w, var, op(2,meas)))
  elif var::name and meas :: 'Return'(identical(var)) then
    w
  elif var::`=` and op(2,var) = (-infinity)..infinity then
    Bind(w, op(1,var), meas)
  elif var::`=` and op(2,var) = 0..1 and w::specfunc(anything,'BetaD') then
    Bind(w, op(1,var), meas)
  elif var::`=` and op(2,var) = 0..infinity and w::specfunc(anything,'GammaD') then
    Bind(w, op(1,var), meas)
  elif w='Lebesgue' and var::`=` and not(op([2,1],var) :: SymbolicInfinity)
        and not(op([2,2],var) :: SymbolicInfinity) then
    Bind(Uniform(op([2,1],var), op([2,2],var)), op(1,var), meas)
  elif w :: 'WeightedM'(anything, anything) then
    WeightedM(op(1,w), Bind(op(2,w), var, meas));
  else
    'Bind'(w, var, meas)
  end if;
end proc;

If := module()
  export ModuleApply;
  local patch_eb;

  patch_eb := proc(eb2, cond2)
    local fcond, new_cond, rest_cond, t1, t2, rest;

    fcond := SLO:-flip_cond(cond2);
    new_cond := And(op(1,eb2), fcond);
    rest_cond := And(SLO:-flip_cond(op(1,eb2)), fcond);
    t1 := coulditbe(new_cond) assuming op(_EnvPathCond);
    t2 := simplify(piecewise(rest_cond, 1, 0));
    t2 := not (evalb(t2=0));
    if t1=false then
      rest := op(3,eb2);
      if op(0,rest) = 'If' then
        If(And(op(1,rest), rest_cond), op(2, rest), op(3, rest))
      else
        rest
      end if;
    elif t2 then
      eb2
    else
      op(2,eb2)
    end if;
  end proc;

  ModuleApply := proc(cond, tb, eb)
    local new_eb;
    if cond = true then
      tb
    elif cond = false then
      eb
    elif tb = 'Return'(undefined) then
      # must 'patch things up' if we had a nested If
      `if`(op(0,eb) = 'If', patch_eb(eb, cond), eb);
    elif eb = Return(undefined) then
      tb
    elif tb = eb then
      eb
    elif type(cond, anything = identical(true)) then
      If(op(1,cond), tb, eb)
    elif op(0,eb) = 'If' and op(3,eb)=Superpose() then
      new_eb := patch_eb(eb, cond);
      if normal(new_eb-eb) = 0 then
        'If'(cond, tb, new_eb)
      else
        If(cond, tb, new_eb)
      end if;
    else
      'If'(cond, tb, eb)
    end if;
  end proc;
end module;

# A Context contains
# - a (Maple-encoded) Hakaru type 'htyp' (H-types)
# - a Measure type
# - a global context of var = H-types
# - a global numbering context for var names
# - the size of the global context (in # of variables)
`type/Context` := 'record'('htyp', 'mtyp', 'gctx', 'gnum', 'gsize');

gensym := module()
  export ModuleApply;
  local gs_counter;
  gs_counter := 0;
  ModuleApply := proc(x::name)
    gs_counter := gs_counter + 1;
    x || gs_counter;
  end proc;
end module;