    # eval_piecewise has the same calling convention as eval_factor.
    # It simplifies piecewise expressions.
    eval_piecewise := proc(e :: specfunc(piecewise),
                           kb :: t_kb, mode :: identical(`*`,`+`),
                           loops :: list([identical(product,Product,sum,Sum),
                                          name=range]),
                           $)
      local default, kbs, pieces, i, cond, inds, res, s, r, x, b, a;
      default := 0; # the catch-all "else" result
      kbs[1] := kb;
      for i from 1 by 2 to nops(e) do
        if i = nops(e) then
          default := op(i,e);
          pieces[i] := default;
        else
          # Simplify piecewise conditions using KB
          cond := op(i,e);
          # cond := eval_factor(cond, kbs[i], `+`, []);
          kbs[i+1] := assert(cond, kbs[i]);
              # This condition is false in context, so delete this piece
              # by not putting anything inside "pieces"
          if kbs[i+1] :: t_kb then
            # find all of the assertions in "kbs[i+1] - kbs[i]"
            cond := map(proc(cond::[identical(assert),anything], $)
                          op(2,cond)
                        end proc,
                        kb_subtract(kbs[i+1], kbs[i]));
            if nops(cond) = 0 then
              default := op(i+1,e);
              pieces[i] := default;
              break;
            else
              cond := `if`(nops(cond)=1, op(1,cond), And(op(cond)));
            end if;
          end if;
          # TODO: Extend KB interface to optimize for
          #       entails(kb,cond) := nops(kb_subtract(assert(cond,kb),kb))=0
          kbs[i+2] := assert(Not(cond), kbs[i]);
          if not(kb_entails(kbs[i], kbs[i+2])) then
            pieces[i] := cond;
            pieces[i+1] := op(i+1,e);
          else
            # This condition is false in context, so delete this piece
            # by not putting anything inside "pieces"
          end if
        end if
      end do;
      # Combine duplicate branches at end
      inds := [indices(pieces, 'nolist', 'indexorder')];
      for i in ListTools:-Reverse(select(type, inds, 'even')) do
        if Testzero(pieces[i]-default) then
          pieces[i  ] := evaln(pieces[i  ]);
          pieces[i-1] := evaln(pieces[i-1]);
        else
          break;
        end if
      end do;
      # Special processing for when the pieces are few
      res := [entries(pieces, 'nolist', 'indexorder')];
      if nops(res) <= 1 then
        return eval_factor(default, kb, mode, loops);
      end if;
      if nops(res) <= 3
         and op(1,res) :: '{`=`,And(specfunc(And),Not(specfunc(Not(`=`),And)))}'
         and Testzero(default - mode()) then
        # Reduce product(piecewise(i=3,f(i),1),i=1..10) to f(3)
        r := op(1,res);
        r := `if`(r::`=`, And(r), select(type,r,`=`));
        for i from 1 to nops(loops) do
          x := op([i,2,1],loops);
          s, r := selectremove(depends, r, x);
          for cond in s do
            if ispoly(lhs(cond)-rhs(cond), 'linear', x, 'b', 'a') then
              b := Normalizer(-b/a);
              if kb_entails(kb,
                            And(b :: integer,
                                op([i,2,2,1],loops) <= b,
                                b <= op([i,2,2,2],loops))
                            ) then
                kb := assert(x=b, kb);# TODO: why not just use kb?
                ASSERT(type(kb,t_kb), "eval_piecewise{product of pw}: not a kb");
                res := `if`(op(1,res) = cond,
                            op(2,res),
                            piecewise(bool_And(op(remove(`=`, op(1,res), cond))),
                                      op(2..-1,res)));
                return eval_factor(eval(res, x=b),
                                   kb,
                                   mode,
                                   eval(subsop(i=NULL, loops), x=b));
              end if;
            end if;
          end do;
          if nops(r) = 0 then break end if;
        end do;
      end if;
      # Recursively process pieces
      inds := [indices(pieces, 'nolist', 'indexorder')];
      for i in inds do
        if i::even or i=op(-1,inds) then
          # only simplify if the piece is not default;
          # note that kbs[i] could be NotAKB(), but this is still valid
          if not Testzero(pieces[i] - default) then
            pieces[i] := eval_factor(pieces[i], kbs[i], mode, []);
          end if;
        end if;
      end do;
      res := piecewise(entries(pieces, 'nolist', 'indexorder'));
      for i in loops do res := op(1,i)(res, op(2,i)) end do;
      return res;
    end proc;


SemiAlgebraic := module()
    uses Domain, Domain_Type, SolveTools, Utilities;
    export SimplName  := "SemiAlgebraic";
    export SimplOrder := 6+(1/2);

    export ModuleApply := proc(dbnds :: DomBound, dshape :: DomShape, $)
        local vs;
        vs := ListTools[Reverse](Domain:-Bound:-varsOf(dbnds));
        vs := map(v->if v::list then op(1,v) else v end if, vs);
        do_sh( dshape , dbnds, vs );
    end proc;

    local extra_sol := (c -> c::`=` and (lhs(c)::DomBoundVar and evalb(lhs(c)=rhs(c))));
    local postproc := proc(sol, $)
      foldl((x,k)->subsindets(x,op(k)), sol
           ,[specfunc('piecewise')
            ,x->DSplit(Partition:-PWToPartition(x,'check_valid'))]
           ,[list(list),DSum@op]
           ,[list(relation),x->DConstrain(remove(extra_sol,x)[])]);
    end proc;

    # Check for trivial solutions, which are rejected because they are not an
    # improvement in terms of Hakaru semantics (but SemiAlgebraic doesn't know
    # anything about that)
    local trivial_sol := proc(sh :: DomShape, ctx :: DomBound, $)
      local ps, vs, vsc;
      if sh::DomConstrain then
        nops(sh)=0
      elif sh::DomSplit then
        # we assume that the conditions of a solution of SemiAlgebraic cover the
        # entire domain, so it is left to check only the values
        ps := KB:-kb_Partition( op(1,sh), Domain:-Bound:-contextOf(ctx),
                               ((x_,y_)->true), #unused dummy to pass typechecks
                               ((v,kb)->trivial_sol
                                  (v,Domain:-Bound:-onContext(_->kb,ctx))) );
        `and`(op(map(evalb@Partition:-valOf,Partition:-piecesOf(ps))));
      elif sh::DomSum then
        if nops(sh)<>2 then return false end if;
        if ormap(s->not(s::DomConstrain) or nops(s)<>1,sh)
        then return false; end if;
        vs := Domain:-Bound:-varsOf(ctx,"set");
        vsc := map((v->(v,-v)), vs);
        ps := map2(op,1,[op(sh)]);
        ps := map(p->classify_relation(p,v->v in vsc), ps);
        if not(has(ps, {B_LO,B_HI})) then return false; end if;
        if not(the(map2(op,3,ps))) then return false; end if;
        if not(the(map(abs,map2(op,4,ps)))) then return; false end if;
        return true;
      elif sh::DomInto then
        error "solution should not have DIntos: %1", sh;
      else
        error "unrecognized DomShape: %1", sh;
      end if;
    end proc;

    local do_sh := proc( sh :: DomShape, ctx :: DomBound, vs, $)
        local sol;
        if sh :: DomConstrain then
            sol := do_Constrain(sh, ctx, vs);
            sol := `if`(sol::DomShape, sol, postproc(sol));
            if not(sol::DomNoSol) and trivial_sol(sol, ctx) then
              userinfo(3, Domain:-Improve,
                       printf("Discarding solution: %a\n", sol));
              sh;
            else sol end if;
        elif sh :: DomSplit then
            DSplit(Partition:-Amap(
              [ (c,_)->c
              , (p,c)-> p->do_sh(p, applyop(cs->{c,op(cs)},2,ctx), vs)
              , c->c ], op(1, sh) ));
        elif sh :: DomSum then
            map(s->do_sh(s, ctx, vs), sh);
        else
            DNoSol(sprintf("Don't know how to solve DOMAIN(%a, %a)", ctx, sh));
        end if;
    end proc;

    local do_Constrain := proc( sh :: DomConstrain , ctx, vs_, $ )
        local ts, vs := vs_, cs;
        cs := { op( Domain:-Bound:-toConstraints(ctx,'no_infinity') ), op(sh) } ;
        ts, cs := selectremove(type, cs, `::`);
        ts := select(t->op(2,t)<>real, ts);
        if ts <> {} and has(cs,ts) then
          WARNING("Variables of unrecognized types being passed to SemiAlgebraic: %1",ts);
        end if;
        try SemiAlgebraic(cs, vs);
        catch: DNoSol(StringTools[FormatMessage](lastexception[2..-1]));
        end try;
    end proc;
end module; #SemiAlgebraic


repeat process ACV_smoothTeleportation {
/scoreboard players reset @e ACV_TP_FROM
/scoreboard players reset @e ACV_TP_UNEVEN
/scoreboard players reset @e ACV_TP_TO
/scoreboard players reset @e ACV_TP_IR
/scoreboard players reset @e ACV_TP_OR
/scoreboard players reset @e ACV_TP_RD

/execute @e[type=area_effect_cloud,name=ACV_PortalIn] ~ ~ ~ scoreboard players operation @e[tag=!ACV_TpProof,dy=0] ACV_TP_FROM = @e[type=area_effect_cloud,name=ACV_PortalIn,r=0,c=1] ACV_COLOR

// Calulate the target portal
/execute @e[score_ACV_TP_FROM_min=0] ~ ~ ~ scoreboard players operation @e[score_ACV_TP_FROM_min=0,r=0,c=1] ACV_TP_TO = @e[score_ACV_TP_FROM_min=0,r=0,c=1] ACV_TP_FROM
/execute @e[score_ACV_TP_FROM_min=0] ~ ~ ~ scoreboard players operation @e[score_ACV_TP_FROM_min=0,r=0,c=1] ACV_TP_UNEVEN = @e[score_ACV_TP_FROM_min=0,r=0,c=1] ACV_TP_FROM
/scoreboard players operation @e[score_ACV_TP_FROM_min=0] ACV_TP_UNEVEN %= 2 ACV_CONSTANT
/scoreboard players add @e[score_ACV_TP_UNEVEN_min=0,score_ACV_TP_UNEVEN=0] ACV_TP_TO 1
/scoreboard players remove @e[score_ACV_TP_UNEVEN_min=1,score_ACV_TP_UNEVEN=1] ACV_TP_TO 1

// Assign In-Rotation
/execute @e[type=area_effect_cloud,name=ACV_PortalIn] ~ ~ ~ scoreboard players operation @e[score_ACV_TP_TO_min=0,dy=0] ACV_TP_IR = @e[type=area_effect_cloud,name=ACV_PortalIn,r=0,c=1] ACV_DIRECTION

// Lightbridges must be rotated to look away from the portal, because the idle bridge is a fresh summon that always looks south
/scoreboard players set @e[tag=ACV_RotationProof] ACV_TP_IR -1

// Assign Out-Rotation

// Bug Workaround: https://bugs.mojang.com/browse/MC-89667
// /tp @e[score_ACV_TP_TO_min=0,score_ACV_TP_TO=0] @e[type=area_effect_cloud,name=ACV_PortalOut,score_ACV_COLOR_min=0,score_ACV_COLOR=0]
// /tp @e[score_ACV_TP_TO_min=1,score_ACV_TP_TO=1] @e[type=area_effect_cloud,name=ACV_PortalOut,score_ACV_COLOR_min=1,score_ACV_COLOR=1]
// /tp @e[score_ACV_TP_TO_min=2,score_ACV_TP_TO=2] @e[type=area_effect_cloud,name=ACV_PortalOut,score_ACV_COLOR_min=2,score_ACV_COLOR=2]
// /tp @e[score_ACV_TP_TO_min=3,score_ACV_TP_TO=3] @e[type=area_effect_cloud,name=ACV_PortalOut,score_ACV_COLOR_min=3,score_ACV_COLOR=3]
///execute @e[name=ACV_PortalOut] ~ ~ ~ scoreboard players operation @e[score_ACV_TP_TO_min=0,tag=!ACV_TpProof,dy=0] ACV_TP_OR = @e[r=0,c=1] ACV_DIRECTION

// Bug Workaround: https://bugs.mojang.com/browse/MC-89667
/scoreboard players operation @e[score_ACV_TP_TO_min=0,score_ACV_TP_TO=0] ACV_TP_OR = @e[type=area_effect_cloud,name=ACV_PortalOut,score_ACV_COLOR_min=0,score_ACV_COLOR=0] ACV_DIRECTION
/scoreboard players operation @e[score_ACV_TP_TO_min=1,score_ACV_TP_TO=1] ACV_TP_OR = @e[type=area_effect_cloud,name=ACV_PortalOut,score_ACV_COLOR_min=1,score_ACV_COLOR=1] ACV_DIRECTION
/scoreboard players operation @e[score_ACV_TP_TO_min=2,score_ACV_TP_TO=2] ACV_TP_OR = @e[type=area_effect_cloud,name=ACV_PortalOut,score_ACV_COLOR_min=2,score_ACV_COLOR=2] ACV_DIRECTION
/scoreboard players operation @e[score_ACV_TP_TO_min=3,score_ACV_TP_TO=3] ACV_TP_OR = @e[type=area_effect_cloud,name=ACV_PortalOut,score_ACV_COLOR_min=3,score_ACV_COLOR=3] ACV_DIRECTION

// Rotation Calculation
/execute @e[score_ACV_TP_IR_min=0,score_ACV_TP_OR_min=0] ~ ~ ~ scoreboard players operation @e[score_ACV_TP_IR_min=0,score_ACV_TP_OR_min=0,r=0,c=1] ACV_TP_RD = @e[score_ACV_TP_IR_min=0,score_ACV_TP_OR_min=0,r=0,c=1] ACV_TP_IR
/execute @e[score_ACV_TP_IR_min=0,score_ACV_TP_OR_min=0] ~ ~ ~ scoreboard players operation @e[score_ACV_TP_IR_min=0,score_ACV_TP_OR_min=0,r=0,c=1] ACV_TP_RD -= @e[score_ACV_TP_IR_min=0,score_ACV_TP_OR_min=0,r=0,c=1] ACV_TP_OR
/execute @e[score_ACV_TP_IR_min=0,score_ACV_TP_OR_min=0] ~ ~ ~ scoreboard players add @e[score_ACV_TP_IR_min=0,score_ACV_TP_OR_min=0,r=0,c=1] ACV_TP_RD 4
/execute @e[score_ACV_TP_IR_min=0,score_ACV_TP_OR_min=0] ~ ~ ~ scoreboard players operation @e[score_ACV_TP_IR_min=0,score_ACV_TP_OR_min=0,r=0,c=1] ACV_TP_RD %= 4 ACV_CONSTANT

// Teleport the entity to the other portal

// Bug Workaround: https://bugs.mojang.com/browse/MC-89667
/execute @e[type=area_effect_cloud,name=ACV_PortalOut,score_ACV_COLOR_min=0,score_ACV_COLOR=0] ~ ~ ~ teleport @e[score_ACV_TP_TO_min=0,score_ACV_TP_TO=0] ~ ~ ~
/execute @e[type=area_effect_cloud,name=ACV_PortalOut,score_ACV_COLOR_min=1,score_ACV_COLOR=1] ~ ~ ~ teleport @e[score_ACV_TP_TO_min=1,score_ACV_TP_TO=1] ~ ~ ~
/execute @e[type=area_effect_cloud,name=ACV_PortalOut,score_ACV_COLOR_min=2,score_ACV_COLOR=2] ~ ~ ~ teleport @e[score_ACV_TP_TO_min=2,score_ACV_TP_TO=2] ~ ~ ~
/execute @e[type=area_effect_cloud,name=ACV_PortalOut,score_ACV_COLOR_min=3,score_ACV_COLOR=3] ~ ~ ~ teleport @e[score_ACV_TP_TO_min=3,score_ACV_TP_TO=3] ~ ~ ~

// Rotate the entity
/tp @e[score_ACV_TP_RD_min=0,score_ACV_TP_RD=0] ~ ~ ~ ~180 ~
/tp @e[score_ACV_TP_RD_min=1,score_ACV_TP_RD=1] ~ ~ ~ ~90 ~
//tp @e[score_ACV_TP_RD_min=2,score_ACV_TP_RD=2] ~ ~ ~ ~0 ~
/tp @e[score_ACV_TP_RD_min=3,score_ACV_TP_RD=3] ~ ~ ~ ~-90 ~

// when IR is up or down, but OR is on a wall (or it is a lightbridge)
/tp @e[score_ACV_TP_IR=-1,score_ACV_TP_OR_min=0,score_ACV_TP_OR=0] ~ ~ ~ 0 ~
/tp @e[score_ACV_TP_IR=-1,score_ACV_TP_OR_min=1,score_ACV_TP_OR=1] ~ ~ ~ 90 ~
/tp @e[score_ACV_TP_IR=-1,score_ACV_TP_OR_min=2,score_ACV_TP_OR=2] ~ ~ ~ 180 ~
/tp @e[score_ACV_TP_IR=-1,score_ACV_TP_OR_min=3,score_ACV_TP_OR=3] ~ ~ ~ -90 ~

// Lightbridges must look also look away from horizontal portals
/tp @e[tag=ACV_RotationProof,score_ACV_TP_OR_min=-1,score_ACV_TP_OR=-1] ~ ~ ~ ~ -90
/tp @e[tag=ACV_RotationProof,score_ACV_TP_OR_min=-2,score_ACV_TP_OR=-2] ~ ~ ~ ~ 90
}


### Domain abstraction

# A domain is abstractly a pair of a "square" domain (a product of square
# domains, or an interval), the domain "bounds", and a domain "shape". The
# domain "bounds" are essentially the variables, each with the type of domain
# (Int,Sum, etc) ; the domains "shape" is sums of products of constraints
# (relations) on the domain, interspersed with 'makes' (DInto) which parametrize
# a subdomain by one of the domain variables ('picking' a particular
# parametrization of the domain, in which one variable is fixed in subsequent
# "shape" constructors).

# the seperation between the two 'stages' of domain exists mainly because
# certain simplifications need to happen after extracting the domain
# bounds but before extracting the domain shape, as the shape ends up
# becoming part of the bounds of an inner simplification.

# Broad TODOs:
#
# Mechanism for 'checking if' and 'making' constraints about variables should
#   be abstracted out into its own module (it is needed in multiple places, and
#   done sort of ad-hoc) (this could be fixed by a broader design - see "merging
#   KB with Domain")
#
# DInto should also optionally omit the bounds if they are identical to the
#   bounds in the a-priori domain bounds (i.e. just `DInto(x)`); DInto sort of
#   means 'we've solved this bound in this subcontext' but the `DInto`s where
#   the bound is identically the a-priori bound are erased (as they should be)
#   - we want a slightly seperate form to mean "we are done improving this", but
#   we still want to be able to omit bounds which would be identical. It should
#   also allow specifying only a subset of the bounds.
#
# A more granular interface for composing/re-composing simplifiers, including
#   call simplifier A {before/after} B
#
# Domain bounds should store a representation of 'dependancy' of variables
#   (a more refined representation; the current one is a linear order of variables)
#   Basically we want a list of graphs, nodes are variables and edges are
#   variable dependencies. If each graph is acyclic, the variable dependency
#   in the bounds is valid. e.g.
#     [x=0..1, y=0..1, z=0..1]  =>  [ {[x, {}]}, {[y, {}]}, {[z, {}]} ]
#     [x=0..1, y=x..1, z=0..y]  =>  [ {[z, {y}], [y, {x}], [x, {}]} ]
#   This generalizes the previous notion of variable order, although in certain
#     cases it is ambiguous what the 'original' order was. This is only when
#     there are variable dependencies, so perhaps this isn't a big deal - we may
#     want to rearrange the dependant bounds even when there is no 'interesting'
#     constraint to solve in the shape, because we know a particular order will
#     be better in some way.
#   The graph is probably not a convenient place to store the variable bounds.
#    (this is one of the big reasons we want to view the variables as a table -
#    we have lots of different information for which the convenient formats are
#    all different)
#
# Long term, KB and Domain should be merged, as their functionality overlaps
#   quite a bit; basically
#     - Introduce becomes a variable in DBound
#     - Constrain becomes DConstrain
#     - DBound becomes DInto
#     - Let becomes (probably?) a one piece partition,
#           or maybe a new variable type
#          (it doesn't seem to appear in present code?)
#  Logically, this is at most an ephemeral change - Domain already generalizes
#   KB. But mechanically it is no small undertaking.
#  assert_deny becomes a "DConstrain" smart constructor (note that in the
#   current AST for Domain, DConstrain appears only at leaves, i.e. products
#   are pushed all the way down; whereas KB is 'flat') but the shape of domains
#   means it is probably much simpler to 'normalize' the constraints all at
#   once, as opposed to when every constrain is inserted, as KB currently does.
#  kb_subtract becomes a similar `domain_combine` function (kb_subtract is really
#   an 'combine' as well as a 'deconstruct into a way to rebuild the KB' together in
#   one - we don't really need the 'deconstruct' part anymore, but 'add' is
#   still useful) - basically this function takes two domains, checks if the
#   variables of the first are a subset of the second (non commutative!) and if
#   so, combines the shapes according to the passed 'shape constructor'; all of
#   the constructors (aside from DInto)
#  gen{whatever} becomes a part of `Domain:-Extract` - basically we will not
#   have `gen` as part of the "interface" to KB+Domain, but rather an entry in
#   the `Ext` function tables.
#  most of the other functions in KB can be basically literally translated to
#    the subset of Domain which corresponds to KB

# The `Domain' type, i.e., its constructors. For a description of the
# intended semantics (as an algebraic datatype), see Domain/Types.mpl
Domain_Type := module()
  option package;
  export
    DOMAIN, DBound, DConstrain, DSum,
    # These intentionally have no definition
    DSplit, DInto, DNoSol;

  DOMAIN := proc()
    local errs := indets([args[2..-1]], specfunc(`DNoSol`));
    if errs <> {} then
      'procname'(args[1], 'DNoSol'(map(op,errs)[]));
    end if;
    'procname'(args);
  end proc;

  DBound := proc(a)
    local b,cs;
    b := `if`(nargs>=2,[args[2]],[KB:-empty])[];
    cs := `if`(nargs>=3,[args[3..-1]],[])[];
    'procname'(a,b,cs) ;
  end proc;

  DConstrain := proc()
    local as := {args};
    if false in as then return DSum() end if;
    as := remove(x->x::identical(false),as);
    'procname'(op(as));
  end proc;

  DSum := proc()
    local as := [args];
    as := subsindets(as, specfunc(`DSum`), xs->
                     map(x->if op(0,x)=`DSum` then op(x) else x end if,
                         xs));
    if nops(as) = 1 then return op(1,as) end if;
    'procname'(op(as));
  end proc;
end module;

Domain := module()
    uses Hakaru, Utilities, Partition, SolveTools[Inequality], Domain_Type ;

    local ModuleLoad := proc($)
      local g;
      BindingTools:-load_types_from_table(DomainTypes);

      #op([2,6], ...) of a module is its globals.
      for g in op([2,6], thismodule) do
        if g <> eval(g) then
          unassign(g);
          WARNING("Previous value of global name '%1' erased.", g)
        end if;
        protect(g);
      end do;
      Apply:-ModuleLoad(); # Needed to load types properly (?)
    end proc;

    local ModuleUnload := proc($) NULL; end proc;

    # Extending domain extraction and replacement.
    export ExtBound := table();
    export ExtShape := table();

    export Set_ExtBound := proc(nm,val,$)
      unprotect(Domain:-ExtBound);
      Domain:-ExtBound[nm] := val;
      protect(Domain:-ExtBound);
    end proc;

    export Set_ExtShape := proc(nm,val,$)
      unprotect(Domain:-ExtShape);
      Domain:-ExtShape[nm] := val;
      protect(Domain:-ExtShape);
    end proc;

$include "Domain/Has.mpl"
$include "Domain/Bound.mpl"
$include "Domain/Shape.mpl"
$include "Domain/Types.mpl"
$include "Domain/Extract.mpl"
$include "Domain/Apply.mpl"
$include "Domain/Improve.mpl"

    local default_handlers :=
      Record('f_apply'=((f,x)->f(x)), 'f_nosimp'=(_->FAIL));

    # The main interface to Domain
    export Reduce :=
      proc(e0,dom_ctx::t_kb,handlers0,opts:=[],$)
      local e := e0, dom_specb, dom_specw, dom_spec, dom_ctx1, rn, ws
          , handlers := merge_record_default(default_handlers, handlers0)
          , apply_ctx ;

      # Build the domain
      dom_specb, e, ws := op(Domain:-Extract:-Bound(e));
      # No simplification needed if the bounds are empty
      if Domain:-Bound:-isEmpty(dom_specb)
      then return handlers:-f_nosimp(e0) end if;
      # Bounds are converted to a KB to use during extraction of the shape
      dom_ctx1, rn := Domain:-Bound:-toKB(dom_specb)[];
      dom_specb, e, ws := subs(rn,[dom_specb,e,ws])[];
      dom_specw, e := op(Domain:-Extract:-Shape(e, dom_ctx1));
      # Append the outer context (a KB) to the domain bounds
      dom_specb := DBound(op(1,dom_specb), dom_ctx);
      # Create the actual domain
      dom_spec := DOMAIN(dom_specb, dom_specw);

      # Improve, if necessary, then apply back to the expression
      if dom_specw <> DConstrain() and not ("no_domain" in {opts[]})
      then dom_spec := Domain:-Improve(dom_spec) end if;

      # The handlers which are used by Domain:-Apply
      apply_ctx := Record[handlers]('weights'=table(ws),-'f_apply',-'f_nosimp');
      handlers:-f_apply(Domain:-Apply(dom_spec, apply_ctx), e);
    end proc;

    ModuleLoad();
end module;