Generalize SimplifyKB_; and call eval_for_Simplify in the strongest context which we encounter

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

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

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

SimplifyKB_ := proc(leaf, e, t::t_type, kb::t_kb, $)
  local patterns, x, kb1, ex;
  if t :: HFunction(anything, anything) then
    patterns := htype_patterns(op(1,t));
    if patterns :: Branches(Branch(PVar(name),anything)) then
      # Eta-expand the function type
      x := `if`(e::lam(name,anything,anything), op(1,e),
                op([1,1,1],patterns));
      x, kb1 := genType(x, op(1,t), kb, e);
      ex := app(e,x);
      lam(x, op(1,t), SimplifyKB_(leaf,ex, op(2,t), kb1))
    else
      # Eta-expand the function type and the sum-of-product argument-type
      x := `if`(e::lam(name,anything,anything), op(1,e), d);
      if depends([e,t,kb], x) then x := gensym(x) end if;
      ex := app(e,x);
      lam(x, op(1,t), 'case'(x,
        map(proc(branch)
            local eSubst, pSubst, p1, binds, y, kb1, i, pSubst1;
              eSubst, pSubst := pattern_match([x,e], x, op(1,branch));
              p1 := subs(pSubst, op(1,branch));
              binds := [pattern_binds(p1)];
              kb1 := kb;
              pSubst1 := table();
              for i from 1 to nops(binds) do
                y, kb1 := genType(op(i,binds), op([2,i],branch), kb1);
                pSubst1[op(i,binds)] := y;
              end do;
              pSubst1 := op(op(pSubst1));
              Branch(subs(pSubst1, p1),
                     SimplifyKB_(leaf,eval(eval(ex,eSubst),pSubst1), op(2,t), kb1))
            end proc,
            patterns)))
    end if
  else
    leaf(e,t,kb)
  end if
end proc;

SimplifyKB := curry(SimplifyKB_,
  proc(e0,t,kb)
    local e := eval_for_Simplify(e0,kb);
    if t :: HMeasure(anything) then
      fromLO(improve(toLO(e), _ctx=kb), _ctx=kb);
    else
      simplify_assuming(e,kb);
    end if;
  end proc);

eval_for_Simplify_tbl := table(
  [ `Int`=`int`
  , `Sum`=`sum`
  , `Product`=`product`
  ]);

eval_for_Simplify := proc(e,kb,$)
  eval_in_ctx(
    proc(x,kb1)
      subsindets(x, {seq(specfunc(q),q=[indices(eval_for_Simplify_tbl, nolist)])},
                 y -> KB:-kb_eval_mb(eval_for_Simplify_tbl[op(0,y)],y,kb1));
    end proc, e, kb);
end proc;

eval_in_ctx_tbl := table(
  [ `PARTITION` = ((e,kb,ev)->KB:-kb_Partition(e,kb,a->a,ev))
  , `piecewise` = ((e,kb,ev)->KB:-kb_piecewise(e,kb,a->a,ev))
  ]);

eval_in_ctx := proc(ev, e, kb, $)
  if assigned(eval_in_ctx_tbl[op(0,e)]) then
    eval_in_ctx_tbl[op(0,e)](e,kb,curry(eval_in_ctx, ev));
  elif has(e, {indices(eval_in_ctx_tbl,nolist)}) then
    map(x->eval_in_ctx(ev,x,kb),e);
  else
    ev(e,kb);
  end if;
end proc;

# Testing

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

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

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

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

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

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

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

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

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

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

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

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

SimplifyKB_ := proc(e, t::t_type, kb::t_kb, $)
  local patterns, x, kb1, ex;
  if t :: HMeasure(anything) then
    %fromLO(%improve(%toLO(e), _ctx=kb), _ctx=kb);
  elif t :: HFunction(anything, anything) then
    patterns := htype_patterns(op(1,t));
    if patterns :: Branches(Branch(PVar(name),anything)) then
      # Eta-expand the function type
      x := `if`(e::lam(name,anything,anything), op(1,e),
                op([1,1,1],patterns));
      x, kb1 := genType(x, op(1,t), kb, e);
      ex := app(e,x);
      lam(x, op(1,t), SimplifyKB_(ex, op(2,t), kb1))
    else
      # Eta-expand the function type and the sum-of-product argument-type
      x := `if`(e::lam(name,anything,anything), op(1,e), d);
      if depends([e,t,kb], x) then x := gensym(x) end if;
      ex := app(e,x);
      lam(x, op(1,t), 'case'(x,
        map(proc(branch)
            local eSubst, pSubst, p1, binds, y, kb1, i, pSubst1;
              eSubst, pSubst := pattern_match([x,e], x, op(1,branch));
              p1 := subs(pSubst, op(1,branch));
              binds := [pattern_binds(p1)];
              kb1 := kb;
              pSubst1 := table();
              for i from 1 to nops(binds) do
                y, kb1 := genType(op(i,binds), op([2,i],branch), kb1);
                pSubst1[op(i,binds)] := y;
              end do;
              pSubst1 := op(op(pSubst1));
              Branch(subs(pSubst1, p1),
                     SimplifyKB_(eval(eval(ex,eSubst),pSubst1), op(2,t), kb1))
            end proc,
            patterns)))
    end if
  else
    %simplify_assuming(e, kb)
  end if
end proc;

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

eval_for_Simplify_tbl := table(
  [ `Int`=`int`
  , `Sum`=`sum`
  , `Product`=`product`
  ]);

eval_for_Simplify := proc(e,kb,$)
  eval_in_ctx(
    proc(x,kb1)
      subsindets(x, {seq(specfunc(q),q=[indices(eval_for_Simplify_tbl, nolist)])},
                 y -> KB:-kb_eval_mb(eval_for_Simplify_tbl[op(0,y)],y,kb1));
    end proc, e, kb);
end proc;

eval_in_ctx_tbl := table(
  [ `PARTITION` = ((e,kb,ev)->KB:-kb_Partition(e,kb,a->a,ev))
  , `piecewise` = ((e,kb,ev)->KB:-kb_piecewise(e,kb,a->a,ev))
  ]);

eval_in_ctx := proc(ev, e, kb, $)
  if assigned(eval_in_ctx_tbl[op(0,e)]) then
    eval_in_ctx_tbl[op(0,e)](e,kb,curry(eval_in_ctx, ev));
  elif has(e, {indices(eval_in_ctx_tbl,nolist)}) then
    map(x->eval_in_ctx(ev,x,kb),e);
  else
    ev(e,kb);
  end if;
end proc;

# Testing

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

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

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

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

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

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

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

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

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


removing dependency leading to broken build of mpsutil project

<?xml version="1.0" encoding="UTF-8"?>
<language namespace="com.mbeddr.core.expressions" uuid="61c69711-ed61-4850-81d9-7714ff227fb0" version="0">
  <models>
    <modelRoot contentPath="${module}" type="default">
      <sourceRoot location="languageModels" />
    </modelRoot>
    <modelRoot contentPath="${module}" type="java_classes">
      <sourceRoot location="lib/javassist.jar" />
    </modelRoot>
  </models>
  <accessoryModels />
  <generators>
    <generator name="main" generatorUID="com.mbeddr.core.expressions#540488879270542599" uuid="6a4c6ce0-9bc6-42c5-a001-4972fd960726">
      <models>
        <modelRoot contentPath="${module}/generator/template" type="default">
          <sourceRoot location="." />
        </modelRoot>
      </models>
      <external-templates />
      <usedLanguages>
        <usedLanguage>d4280a54-f6df-4383-aa41-d1b2bffa7eb1(com.mbeddr.core.base)</usedLanguage>
        <usedLanguage>223dd778-c44f-4ef3-9535-7aa7d12244a6(com.mbeddr.core.debug)</usedLanguage>
        <usedLanguage>61c69711-ed61-4850-81d9-7714ff227fb0(com.mbeddr.core.expressions)</usedLanguage>
        <usedLanguage>92d2ea16-5a42-4fdf-a676-c7604efe3504(de.slisson.mps.richtext)</usedLanguage>
        <usedLanguage>ed6d7656-532c-4bc2-81d1-af945aeb8280(jetbrains.mps.baseLanguage.blTypes)</usedLanguage>
        <usedLanguage>96ee7a94-411d-4cf8-9b94-96cad7e52411(jetbrains.mps.baseLanguage.jdk7)</usedLanguage>
        <usedLanguage>b401a680-8325-4110-8fd3-84331ff25bef(jetbrains.mps.lang.generator)</usedLanguage>
        <usedLanguage>d7706f63-9be2-479c-a3da-ae92af1e64d5(jetbrains.mps.lang.generator.generationContext)</usedLanguage>
        <usedLanguage>d4615e3b-d671-4ba9-af01-2b78369b0ba7(jetbrains.mps.lang.pattern)</usedLanguage>
        <usedLanguage>c72da2b9-7cce-4447-8389-f407dc1158b7(jetbrains.mps.lang.structure)</usedLanguage>
        <usedLanguage>9ded098b-ad6a-4657-bfd9-48636cfe8bc3(jetbrains.mps.lang.traceable)</usedLanguage>
        <usedLanguage>7a5dda62-9140-4668-ab76-d5ed1746f2b2(jetbrains.mps.lang.typesystem)</usedLanguage>
      </usedLanguages>
      <usedDevKits>
        <usedDevKit>fbc25dd2-5da4-483a-8b19-70928e1b62d7(jetbrains.mps.devkit.general-purpose)</usedDevKit>
      </usedDevKits>
      <languageVersions>
        <language id="d4280a54-f6df-4383-aa41-d1b2bffa7eb1" fqName="com.mbeddr.core.base" version="0" />
        <language id="223dd778-c44f-4ef3-9535-7aa7d12244a6" fqName="com.mbeddr.core.debug" version="0" />
        <language id="61c69711-ed61-4850-81d9-7714ff227fb0" fqName="com.mbeddr.core.expressions" version="0" />
        <language id="63e0e566-5131-447e-90e3-12ea330e1a00" fqName="com.mbeddr.mpsutil.blutil" version="0" />
        <language id="a482b416-d0c9-473f-8f67-725ed642b3f3" fqName="com.mbeddr.mpsutil.breadcrumb" version="0" />
        <language id="79685937-8b0a-4e7d-8f8c-0888f1581774" fqName="com.mbeddr.mpsutil.nodeviewer" version="0" />
        <language id="b4d28e19-7d2d-47e9-943e-3a41f97a0e52" fqName="com.mbeddr.mpsutil.plantuml.node" version="0" />
        <language id="92d2ea16-5a42-4fdf-a676-c7604efe3504" fqName="de.slisson.mps.richtext" version="0" />
        <language id="f3061a53-9226-4cc5-a443-f952ceaf5816" fqName="jetbrains.mps.baseLanguage" version="1" />
        <language id="ed6d7656-532c-4bc2-81d1-af945aeb8280" fqName="jetbrains.mps.baseLanguage.blTypes" version="0" />
        <language id="443f4c36-fcf5-4eb6-9500-8d06ed259e3e" fqName="jetbrains.mps.baseLanguage.classifiers" version="0" />
        <language id="fd392034-7849-419d-9071-12563d152375" fqName="jetbrains.mps.baseLanguage.closures" version="0" />
        <language id="83888646-71ce-4f1c-9c53-c54016f6ad4f" fqName="jetbrains.mps.baseLanguage.collections" version="0" />
        <language id="f2801650-65d5-424e-bb1b-463a8781b786" fqName="jetbrains.mps.baseLanguage.javadoc" version="1" />
        <language id="96ee7a94-411d-4cf8-9b94-96cad7e52411" fqName="jetbrains.mps.baseLanguage.jdk7" version="0" />
        <language id="760a0a8c-eabb-4521-8bfd-65db761a9ba3" fqName="jetbrains.mps.baseLanguage.logging" version="0" />
        <language id="a247e09e-2435-45ba-b8d2-07e93feba96a" fqName="jetbrains.mps.baseLanguage.tuples" version="0" />
        <language id="63650c59-16c8-498a-99c8-005c7ee9515d" fqName="jetbrains.mps.lang.access" version="0" />
        <language id="aee9cad2-acd4-4608-aef2-0004f6a1cdbd" fqName="jetbrains.mps.lang.actions" version="0" />
        <language id="ceab5195-25ea-4f22-9b92-103b95ca8c0c" fqName="jetbrains.mps.lang.core" version="1" />
        <language id="18bc6592-03a6-4e29-a83a-7ff23bde13ba" fqName="jetbrains.mps.lang.editor" version="0" />
        <language id="b401a680-8325-4110-8fd3-84331ff25bef" fqName="jetbrains.mps.lang.generator" version="0" />
        <language id="d7706f63-9be2-479c-a3da-ae92af1e64d5" fqName="jetbrains.mps.lang.generator.generationContext" version="0" />
        <language id="d4615e3b-d671-4ba9-af01-2b78369b0ba7" fqName="jetbrains.mps.lang.pattern" version="0" />
        <language id="3a13115c-633c-4c5c-bbcc-75c4219e9555" fqName="jetbrains.mps.lang.quotation" version="0" />
        <language id="13744753-c81f-424a-9c1b-cf8943bf4e86" fqName="jetbrains.mps.lang.sharedConcepts" version="0" />
        <language id="7866978e-a0f0-4cc7-81bc-4d213d9375e1" fqName="jetbrains.mps.lang.smodel" version="0" />
        <language id="c72da2b9-7cce-4447-8389-f407dc1158b7" fqName="jetbrains.mps.lang.structure" version="0" />
        <language id="9ded098b-ad6a-4657-bfd9-48636cfe8bc3" fqName="jetbrains.mps.lang.traceable" version="0" />
        <language id="7a5dda62-9140-4668-ab76-d5ed1746f2b2" fqName="jetbrains.mps.lang.typesystem" version="0" />
      </languageVersions>
      <mapping-priorities />
    </generator>
  </generators>
  <stubModelEntries>
    <stubModelEntry path="${module}/lib/javassist.jar" />
  </stubModelEntries>
  <sourcePath />
  <dependencies>
    <dependency reexport="false">7a5dda62-9140-4668-ab76-d5ed1746f2b2(jetbrains.mps.lang.typesystem)</dependency>
    <dependency reexport="false">20c6e580-bdc5-4067-8049-d7e3265a86de(jetbrains.mps.typesystemEngine)</dependency>
    <dependency reexport="false">1ed103c3-3aa6-49b7-9c21-6765ee11f224(MPS.Editor)</dependency>
    <dependency reexport="false">8865b7a8-5271-43d3-884c-6fd1d9cfdd34(MPS.OpenAPI)</dependency>
    <dependency reexport="false">6354ebe7-c22a-4a0f-ac54-50b52ab9b065(JDK)</dependency>
    <dependency reexport="false">e78f91af-08a8-4a7a-bed6-b22739ed069a(com.mbeddr.mpsutil.spreferences.runtime)</dependency>
    <dependency reexport="false">cb5fd060-a6fb-423f-827a-02ea829501c8(com.mbeddt.core.expressions.pluginSolution)</dependency>
    <dependency reexport="false">d4280a54-f6df-4383-aa41-d1b2bffa7eb1(com.mbeddr.core.base)</dependency>
    <dependency reexport="false">6ed54515-acc8-4d1e-a16c-9fd6cfe951ea(MPS.Core)</dependency>
  </dependencies>
  <usedLanguages>
    <usedLanguage>ebb5e132-d298-4649-b320-b3f4d7f3acff(com.mbeddr.core.debug.blext)</usedLanguage>
    <usedLanguage>61c69711-ed61-4850-81d9-7714ff227fb0(com.mbeddr.core.expressions)</usedLanguage>
    <usedLanguage>63e0e566-5131-447e-90e3-12ea330e1a00(com.mbeddr.mpsutil.blutil)</usedLanguage>
    <usedLanguage>c3bfea76-7bba-4f0e-b5a2-ff4e7a8d7cf1(com.mbeddr.mpsutil.spreferences)</usedLanguage>
    <usedLanguage>f89904fb-9486-43a1-865e-5ad0375a8a88(de.itemis.mps.editor.bool)</usedLanguage>
    <usedLanguage>7e450f4e-1ac3-41ef-a851-4598161bdb94(de.slisson.mps.tables)</usedLanguage>
    <usedLanguage>f3061a53-9226-4cc5-a443-f952ceaf5816(jetbrains.mps.baseLanguage)</usedLanguage>
    <usedLanguage>ed6d7656-532c-4bc2-81d1-af945aeb8280(jetbrains.mps.baseLanguage.blTypes)</usedLanguage>
    <usedLanguage>443f4c36-fcf5-4eb6-9500-8d06ed259e3e(jetbrains.mps.baseLanguage.classifiers)</usedLanguage>
    <usedLanguage>83888646-71ce-4f1c-9c53-c54016f6ad4f(jetbrains.mps.baseLanguage.collections)</usedLanguage>
    <usedLanguage>f2801650-65d5-424e-bb1b-463a8781b786(jetbrains.mps.baseLanguage.javadoc)</usedLanguage>
    <usedLanguage>96ee7a94-411d-4cf8-9b94-96cad7e52411(jetbrains.mps.baseLanguage.jdk7)</usedLanguage>
    <usedLanguage>daafa647-f1f7-4b0b-b096-69cd7c8408c0(jetbrains.mps.baseLanguage.regexp)</usedLanguage>
    <usedLanguage>af65afd8-f0dd-4942-87d9-63a55f2a9db1(jetbrains.mps.lang.behavior)</usedLanguage>
    <usedLanguage>7fa12e9c-b949-4976-b4fa-19accbc320b4(jetbrains.mps.lang.dataFlow)</usedLanguage>
    <usedLanguage>0eddeefa-c2d6-4437-bc2c-de50fd4ce470(jetbrains.mps.lang.script)</usedLanguage>
    <usedLanguage>7866978e-a0f0-4cc7-81bc-4d213d9375e1(jetbrains.mps.lang.smodel)</usedLanguage>
    <usedLanguage>9ded098b-ad6a-4657-bfd9-48636cfe8bc3(jetbrains.mps.lang.traceable)</usedLanguage>
  </usedLanguages>
  <usedDevKits>
    <usedDevKit>2677cb18-f558-4e33-bc38-a5139cee06dc(jetbrains.mps.devkit.language-design)</usedDevKit>
  </usedDevKits>
  <languageVersions>
    <language id="d4280a54-f6df-4383-aa41-d1b2bffa7eb1" fqName="com.mbeddr.core.base" version="0" />
    <language id="223dd778-c44f-4ef3-9535-7aa7d12244a6" fqName="com.mbeddr.core.debug" version="0" />
    <language id="ebb5e132-d298-4649-b320-b3f4d7f3acff" fqName="com.mbeddr.core.debug.blext" version="0" />
    <language id="61c69711-ed61-4850-81d9-7714ff227fb0" fqName="com.mbeddr.core.expressions" version="0" />
    <language id="63e0e566-5131-447e-90e3-12ea330e1a00" fqName="com.mbeddr.mpsutil.blutil" version="0" />
    <language id="a482b416-d0c9-473f-8f67-725ed642b3f3" fqName="com.mbeddr.mpsutil.breadcrumb" version="0" />
    <language id="79685937-8b0a-4e7d-8f8c-0888f1581774" fqName="com.mbeddr.mpsutil.nodeviewer" version="0" />
    <language id="b4d28e19-7d2d-47e9-943e-3a41f97a0e52" fqName="com.mbeddr.mpsutil.plantuml.node" version="0" />
    <language id="c3bfea76-7bba-4f0e-b5a2-ff4e7a8d7cf1" fqName="com.mbeddr.mpsutil.spreferences" version="0" />
    <language id="f89904fb-9486-43a1-865e-5ad0375a8a88" fqName="de.itemis.mps.editor.bool" version="0" />
    <language id="92d2ea16-5a42-4fdf-a676-c7604efe3504" fqName="de.slisson.mps.richtext" version="0" />
    <language id="7e450f4e-1ac3-41ef-a851-4598161bdb94" fqName="de.slisson.mps.tables" version="0" />
    <language id="f3061a53-9226-4cc5-a443-f952ceaf5816" fqName="jetbrains.mps.baseLanguage" version="1" />
    <language id="ed6d7656-532c-4bc2-81d1-af945aeb8280" fqName="jetbrains.mps.baseLanguage.blTypes" version="0" />
    <language id="443f4c36-fcf5-4eb6-9500-8d06ed259e3e" fqName="jetbrains.mps.baseLanguage.classifiers" version="0" />
    <language id="fd392034-7849-419d-9071-12563d152375" fqName="jetbrains.mps.baseLanguage.closures" version="0" />
    <language id="83888646-71ce-4f1c-9c53-c54016f6ad4f" fqName="jetbrains.mps.baseLanguage.collections" version="0" />
    <language id="f2801650-65d5-424e-bb1b-463a8781b786" fqName="jetbrains.mps.baseLanguage.javadoc" version="1" />
    <language id="96ee7a94-411d-4cf8-9b94-96cad7e52411" fqName="jetbrains.mps.baseLanguage.jdk7" version="0" />
    <language id="760a0a8c-eabb-4521-8bfd-65db761a9ba3" fqName="jetbrains.mps.baseLanguage.logging" version="0" />
    <language id="daafa647-f1f7-4b0b-b096-69cd7c8408c0" fqName="jetbrains.mps.baseLanguage.regexp" version="0" />
    <language id="a247e09e-2435-45ba-b8d2-07e93feba96a" fqName="jetbrains.mps.baseLanguage.tuples" version="0" />
    <language id="f61473f9-130f-42f6-b98d-6c438812c2f6" fqName="jetbrains.mps.baseLanguage.unitTest" version="0" />
    <language id="df345b11-b8c7-4213-ac66-48d2a9b75d88" fqName="jetbrains.mps.baseLanguageInternal" version="0" />
    <language id="63650c59-16c8-498a-99c8-005c7ee9515d" fqName="jetbrains.mps.lang.access" version="0" />
    <language id="aee9cad2-acd4-4608-aef2-0004f6a1cdbd" fqName="jetbrains.mps.lang.actions" version="0" />
    <language id="af65afd8-f0dd-4942-87d9-63a55f2a9db1" fqName="jetbrains.mps.lang.behavior" version="0" />
    <language id="fe9d76d7-5809-45c9-ae28-a40915b4d6ff" fqName="jetbrains.mps.lang.checkedName" version="0" />
    <language id="3f4bc5f5-c6c1-4a28-8b10-c83066ffa4a1" fqName="jetbrains.mps.lang.constraints" version="0" />
    <language id="ceab5195-25ea-4f22-9b92-103b95ca8c0c" fqName="jetbrains.mps.lang.core" version="1" />
    <language id="7fa12e9c-b949-4976-b4fa-19accbc320b4" fqName="jetbrains.mps.lang.dataFlow" version="0" />
    <language id="18bc6592-03a6-4e29-a83a-7ff23bde13ba" fqName="jetbrains.mps.lang.editor" version="0" />
    <language id="64d34fcd-ad02-4e73-aff8-a581124c2e30" fqName="jetbrains.mps.lang.findUsages" version="0" />
    <language id="b401a680-8325-4110-8fd3-84331ff25bef" fqName="jetbrains.mps.lang.generator" version="0" />
    <language id="d7706f63-9be2-479c-a3da-ae92af1e64d5" fqName="jetbrains.mps.lang.generator.generationContext" version="0" />
    <language id="d7a92d38-f7db-40d0-8431-763b0c3c9f20" fqName="jetbrains.mps.lang.intentions" version="0" />
    <language id="d4615e3b-d671-4ba9-af01-2b78369b0ba7" fqName="jetbrains.mps.lang.pattern" version="0" />
    <language id="3a13115c-633c-4c5c-bbcc-75c4219e9555" fqName="jetbrains.mps.lang.quotation" version="0" />
    <language id="3ecd7c84-cde3-45de-886c-135ecc69b742" fqName="jetbrains.mps.lang.refactoring" version="0" />
    <language id="0eddeefa-c2d6-4437-bc2c-de50fd4ce470" fqName="jetbrains.mps.lang.script" version="0" />
    <language id="13744753-c81f-424a-9c1b-cf8943bf4e86" fqName="jetbrains.mps.lang.sharedConcepts" version="0" />
    <language id="7866978e-a0f0-4cc7-81bc-4d213d9375e1" fqName="jetbrains.mps.lang.smodel" version="0" />
    <language id="c72da2b9-7cce-4447-8389-f407dc1158b7" fqName="jetbrains.mps.lang.structure" version="0" />
    <language id="b83431fe-5c8f-40bc-8a36-65e25f4dd253" fqName="jetbrains.mps.lang.textGen" version="0" />
    <language id="9ded098b-ad6a-4657-bfd9-48636cfe8bc3" fqName="jetbrains.mps.lang.traceable" version="0" />
    <language id="7a5dda62-9140-4668-ab76-d5ed1746f2b2" fqName="jetbrains.mps.lang.typesystem" version="0" />
  </languageVersions>
  <extendedLanguages>
    <extendedLanguage>ceab5195-25ea-4f22-9b92-103b95ca8c0c(jetbrains.mps.lang.core)</extendedLanguage>
    <extendedLanguage>7a5dda62-9140-4668-ab76-d5ed1746f2b2(jetbrains.mps.lang.typesystem)</extendedLanguage>
    <extendedLanguage>9ded098b-ad6a-4657-bfd9-48636cfe8bc3(jetbrains.mps.lang.traceable)</extendedLanguage>
    <extendedLanguage>d4280a54-f6df-4383-aa41-d1b2bffa7eb1(com.mbeddr.core.base)</extendedLanguage>
    <extendedLanguage>223dd778-c44f-4ef3-9535-7aa7d12244a6(com.mbeddr.core.debug)</extendedLanguage>
    <extendedLanguage>63e0e566-5131-447e-90e3-12ea330e1a00(com.mbeddr.mpsutil.blutil)</extendedLanguage>
  </extendedLanguages>
</language>

<?xml version="1.0" encoding="UTF-8"?>
<language namespace="com.mbeddr.core.expressions" uuid="61c69711-ed61-4850-81d9-7714ff227fb0" version="0">
  <models>
    <modelRoot contentPath="${module}" type="default">
      <sourceRoot location="languageModels" />
    </modelRoot>
    <modelRoot contentPath="${module}" type="java_classes">
      <sourceRoot location="lib/javassist.jar" />
    </modelRoot>
  </models>
  <accessoryModels />
  <generators>
    <generator name="main" generatorUID="com.mbeddr.core.expressions#540488879270542599" uuid="6a4c6ce0-9bc6-42c5-a001-4972fd960726">
      <models>
        <modelRoot contentPath="${module}/generator/template" type="default">
          <sourceRoot location="." />
        </modelRoot>
      </models>
      <external-templates />
      <usedLanguages>
        <usedLanguage>d4280a54-f6df-4383-aa41-d1b2bffa7eb1(com.mbeddr.core.base)</usedLanguage>
        <usedLanguage>223dd778-c44f-4ef3-9535-7aa7d12244a6(com.mbeddr.core.debug)</usedLanguage>
        <usedLanguage>61c69711-ed61-4850-81d9-7714ff227fb0(com.mbeddr.core.expressions)</usedLanguage>
        <usedLanguage>92d2ea16-5a42-4fdf-a676-c7604efe3504(de.slisson.mps.richtext)</usedLanguage>
        <usedLanguage>ed6d7656-532c-4bc2-81d1-af945aeb8280(jetbrains.mps.baseLanguage.blTypes)</usedLanguage>
        <usedLanguage>96ee7a94-411d-4cf8-9b94-96cad7e52411(jetbrains.mps.baseLanguage.jdk7)</usedLanguage>
        <usedLanguage>b401a680-8325-4110-8fd3-84331ff25bef(jetbrains.mps.lang.generator)</usedLanguage>
        <usedLanguage>d7706f63-9be2-479c-a3da-ae92af1e64d5(jetbrains.mps.lang.generator.generationContext)</usedLanguage>
        <usedLanguage>d4615e3b-d671-4ba9-af01-2b78369b0ba7(jetbrains.mps.lang.pattern)</usedLanguage>
        <usedLanguage>c72da2b9-7cce-4447-8389-f407dc1158b7(jetbrains.mps.lang.structure)</usedLanguage>
        <usedLanguage>9ded098b-ad6a-4657-bfd9-48636cfe8bc3(jetbrains.mps.lang.traceable)</usedLanguage>
        <usedLanguage>7a5dda62-9140-4668-ab76-d5ed1746f2b2(jetbrains.mps.lang.typesystem)</usedLanguage>
      </usedLanguages>
      <usedDevKits>
        <usedDevKit>fbc25dd2-5da4-483a-8b19-70928e1b62d7(jetbrains.mps.devkit.general-purpose)</usedDevKit>
      </usedDevKits>
      <languageVersions>
        <language id="d4280a54-f6df-4383-aa41-d1b2bffa7eb1" fqName="com.mbeddr.core.base" version="0" />
        <language id="223dd778-c44f-4ef3-9535-7aa7d12244a6" fqName="com.mbeddr.core.debug" version="0" />
        <language id="61c69711-ed61-4850-81d9-7714ff227fb0" fqName="com.mbeddr.core.expressions" version="0" />
        <language id="63e0e566-5131-447e-90e3-12ea330e1a00" fqName="com.mbeddr.mpsutil.blutil" version="0" />
        <language id="a482b416-d0c9-473f-8f67-725ed642b3f3" fqName="com.mbeddr.mpsutil.breadcrumb" version="0" />
        <language id="79685937-8b0a-4e7d-8f8c-0888f1581774" fqName="com.mbeddr.mpsutil.nodeviewer" version="0" />
        <language id="b4d28e19-7d2d-47e9-943e-3a41f97a0e52" fqName="com.mbeddr.mpsutil.plantuml.node" version="0" />
        <language id="92d2ea16-5a42-4fdf-a676-c7604efe3504" fqName="de.slisson.mps.richtext" version="0" />
        <language id="f3061a53-9226-4cc5-a443-f952ceaf5816" fqName="jetbrains.mps.baseLanguage" version="1" />
        <language id="ed6d7656-532c-4bc2-81d1-af945aeb8280" fqName="jetbrains.mps.baseLanguage.blTypes" version="0" />
        <language id="443f4c36-fcf5-4eb6-9500-8d06ed259e3e" fqName="jetbrains.mps.baseLanguage.classifiers" version="0" />
        <language id="fd392034-7849-419d-9071-12563d152375" fqName="jetbrains.mps.baseLanguage.closures" version="0" />
        <language id="83888646-71ce-4f1c-9c53-c54016f6ad4f" fqName="jetbrains.mps.baseLanguage.collections" version="0" />
        <language id="f2801650-65d5-424e-bb1b-463a8781b786" fqName="jetbrains.mps.baseLanguage.javadoc" version="1" />
        <language id="96ee7a94-411d-4cf8-9b94-96cad7e52411" fqName="jetbrains.mps.baseLanguage.jdk7" version="0" />
        <language id="760a0a8c-eabb-4521-8bfd-65db761a9ba3" fqName="jetbrains.mps.baseLanguage.logging" version="0" />
        <language id="a247e09e-2435-45ba-b8d2-07e93feba96a" fqName="jetbrains.mps.baseLanguage.tuples" version="0" />
        <language id="63650c59-16c8-498a-99c8-005c7ee9515d" fqName="jetbrains.mps.lang.access" version="0" />
        <language id="aee9cad2-acd4-4608-aef2-0004f6a1cdbd" fqName="jetbrains.mps.lang.actions" version="0" />
        <language id="ceab5195-25ea-4f22-9b92-103b95ca8c0c" fqName="jetbrains.mps.lang.core" version="1" />
        <language id="18bc6592-03a6-4e29-a83a-7ff23bde13ba" fqName="jetbrains.mps.lang.editor" version="0" />
        <language id="b401a680-8325-4110-8fd3-84331ff25bef" fqName="jetbrains.mps.lang.generator" version="0" />
        <language id="d7706f63-9be2-479c-a3da-ae92af1e64d5" fqName="jetbrains.mps.lang.generator.generationContext" version="0" />
        <language id="d4615e3b-d671-4ba9-af01-2b78369b0ba7" fqName="jetbrains.mps.lang.pattern" version="0" />
        <language id="3a13115c-633c-4c5c-bbcc-75c4219e9555" fqName="jetbrains.mps.lang.quotation" version="0" />
        <language id="13744753-c81f-424a-9c1b-cf8943bf4e86" fqName="jetbrains.mps.lang.sharedConcepts" version="0" />
        <language id="7866978e-a0f0-4cc7-81bc-4d213d9375e1" fqName="jetbrains.mps.lang.smodel" version="0" />
        <language id="c72da2b9-7cce-4447-8389-f407dc1158b7" fqName="jetbrains.mps.lang.structure" version="0" />
        <language id="9ded098b-ad6a-4657-bfd9-48636cfe8bc3" fqName="jetbrains.mps.lang.traceable" version="0" />
        <language id="7a5dda62-9140-4668-ab76-d5ed1746f2b2" fqName="jetbrains.mps.lang.typesystem" version="0" />
      </languageVersions>
      <mapping-priorities />
    </generator>
  </generators>
  <stubModelEntries>
    <stubModelEntry path="${module}/lib/javassist.jar" />
  </stubModelEntries>
  <sourcePath />
  <dependencies>
    <dependency reexport="false">6354ebe7-c22a-4a0f-ac54-50b52ab9b065(JDK)</dependency>
    <dependency reexport="false">6ed54515-acc8-4d1e-a16c-9fd6cfe951ea(MPS.Core)</dependency>
    <dependency reexport="false">1ed103c3-3aa6-49b7-9c21-6765ee11f224(MPS.Editor)</dependency>
    <dependency reexport="false">8865b7a8-5271-43d3-884c-6fd1d9cfdd34(MPS.OpenAPI)</dependency>
    <dependency reexport="false">d4280a54-f6df-4383-aa41-d1b2bffa7eb1(com.mbeddr.core.base)</dependency>
    <dependency reexport="false">e78f91af-08a8-4a7a-bed6-b22739ed069a(com.mbeddr.mpsutil.spreferences.runtime)</dependency>
    <dependency reexport="false">cb5fd060-a6fb-423f-827a-02ea829501c8(com.mbeddt.core.expressions.pluginSolution)</dependency>
    <dependency reexport="false">7a5dda62-9140-4668-ab76-d5ed1746f2b2(jetbrains.mps.lang.typesystem)</dependency>
    <dependency reexport="false">20c6e580-bdc5-4067-8049-d7e3265a86de(jetbrains.mps.typesystemEngine)</dependency>
    <dependency reexport="false">a9d69647-0840-491e-bf39-2eb0805d2011(com.mbeddr.core.statements)</dependency>
  </dependencies>
  <usedLanguages>
    <usedLanguage>ebb5e132-d298-4649-b320-b3f4d7f3acff(com.mbeddr.core.debug.blext)</usedLanguage>
    <usedLanguage>61c69711-ed61-4850-81d9-7714ff227fb0(com.mbeddr.core.expressions)</usedLanguage>
    <usedLanguage>63e0e566-5131-447e-90e3-12ea330e1a00(com.mbeddr.mpsutil.blutil)</usedLanguage>
    <usedLanguage>c3bfea76-7bba-4f0e-b5a2-ff4e7a8d7cf1(com.mbeddr.mpsutil.spreferences)</usedLanguage>
    <usedLanguage>f89904fb-9486-43a1-865e-5ad0375a8a88(de.itemis.mps.editor.bool)</usedLanguage>
    <usedLanguage>7e450f4e-1ac3-41ef-a851-4598161bdb94(de.slisson.mps.tables)</usedLanguage>
    <usedLanguage>f3061a53-9226-4cc5-a443-f952ceaf5816(jetbrains.mps.baseLanguage)</usedLanguage>
    <usedLanguage>ed6d7656-532c-4bc2-81d1-af945aeb8280(jetbrains.mps.baseLanguage.blTypes)</usedLanguage>
    <usedLanguage>443f4c36-fcf5-4eb6-9500-8d06ed259e3e(jetbrains.mps.baseLanguage.classifiers)</usedLanguage>
    <usedLanguage>83888646-71ce-4f1c-9c53-c54016f6ad4f(jetbrains.mps.baseLanguage.collections)</usedLanguage>
    <usedLanguage>f2801650-65d5-424e-bb1b-463a8781b786(jetbrains.mps.baseLanguage.javadoc)</usedLanguage>
    <usedLanguage>96ee7a94-411d-4cf8-9b94-96cad7e52411(jetbrains.mps.baseLanguage.jdk7)</usedLanguage>
    <usedLanguage>daafa647-f1f7-4b0b-b096-69cd7c8408c0(jetbrains.mps.baseLanguage.regexp)</usedLanguage>
    <usedLanguage>af65afd8-f0dd-4942-87d9-63a55f2a9db1(jetbrains.mps.lang.behavior)</usedLanguage>
    <usedLanguage>7fa12e9c-b949-4976-b4fa-19accbc320b4(jetbrains.mps.lang.dataFlow)</usedLanguage>
    <usedLanguage>0eddeefa-c2d6-4437-bc2c-de50fd4ce470(jetbrains.mps.lang.script)</usedLanguage>
    <usedLanguage>7866978e-a0f0-4cc7-81bc-4d213d9375e1(jetbrains.mps.lang.smodel)</usedLanguage>
    <usedLanguage>9ded098b-ad6a-4657-bfd9-48636cfe8bc3(jetbrains.mps.lang.traceable)</usedLanguage>
  </usedLanguages>
  <usedDevKits>
    <usedDevKit>2677cb18-f558-4e33-bc38-a5139cee06dc(jetbrains.mps.devkit.language-design)</usedDevKit>
  </usedDevKits>
  <languageVersions>
    <language id="d4280a54-f6df-4383-aa41-d1b2bffa7eb1" fqName="com.mbeddr.core.base" version="0" />
    <language id="223dd778-c44f-4ef3-9535-7aa7d12244a6" fqName="com.mbeddr.core.debug" version="0" />
    <language id="ebb5e132-d298-4649-b320-b3f4d7f3acff" fqName="com.mbeddr.core.debug.blext" version="0" />
    <language id="61c69711-ed61-4850-81d9-7714ff227fb0" fqName="com.mbeddr.core.expressions" version="0" />
    <language id="63e0e566-5131-447e-90e3-12ea330e1a00" fqName="com.mbeddr.mpsutil.blutil" version="0" />
    <language id="a482b416-d0c9-473f-8f67-725ed642b3f3" fqName="com.mbeddr.mpsutil.breadcrumb" version="0" />
    <language id="79685937-8b0a-4e7d-8f8c-0888f1581774" fqName="com.mbeddr.mpsutil.nodeviewer" version="0" />
    <language id="b4d28e19-7d2d-47e9-943e-3a41f97a0e52" fqName="com.mbeddr.mpsutil.plantuml.node" version="0" />
    <language id="c3bfea76-7bba-4f0e-b5a2-ff4e7a8d7cf1" fqName="com.mbeddr.mpsutil.spreferences" version="0" />
    <language id="f89904fb-9486-43a1-865e-5ad0375a8a88" fqName="de.itemis.mps.editor.bool" version="0" />
    <language id="92d2ea16-5a42-4fdf-a676-c7604efe3504" fqName="de.slisson.mps.richtext" version="0" />
    <language id="7e450f4e-1ac3-41ef-a851-4598161bdb94" fqName="de.slisson.mps.tables" version="0" />
    <language id="f3061a53-9226-4cc5-a443-f952ceaf5816" fqName="jetbrains.mps.baseLanguage" version="1" />
    <language id="ed6d7656-532c-4bc2-81d1-af945aeb8280" fqName="jetbrains.mps.baseLanguage.blTypes" version="0" />
    <language id="443f4c36-fcf5-4eb6-9500-8d06ed259e3e" fqName="jetbrains.mps.baseLanguage.classifiers" version="0" />
    <language id="fd392034-7849-419d-9071-12563d152375" fqName="jetbrains.mps.baseLanguage.closures" version="0" />
    <language id="83888646-71ce-4f1c-9c53-c54016f6ad4f" fqName="jetbrains.mps.baseLanguage.collections" version="0" />
    <language id="f2801650-65d5-424e-bb1b-463a8781b786" fqName="jetbrains.mps.baseLanguage.javadoc" version="1" />
    <language id="96ee7a94-411d-4cf8-9b94-96cad7e52411" fqName="jetbrains.mps.baseLanguage.jdk7" version="0" />
    <language id="760a0a8c-eabb-4521-8bfd-65db761a9ba3" fqName="jetbrains.mps.baseLanguage.logging" version="0" />
    <language id="daafa647-f1f7-4b0b-b096-69cd7c8408c0" fqName="jetbrains.mps.baseLanguage.regexp" version="0" />
    <language id="a247e09e-2435-45ba-b8d2-07e93feba96a" fqName="jetbrains.mps.baseLanguage.tuples" version="0" />
    <language id="f61473f9-130f-42f6-b98d-6c438812c2f6" fqName="jetbrains.mps.baseLanguage.unitTest" version="0" />
    <language id="df345b11-b8c7-4213-ac66-48d2a9b75d88" fqName="jetbrains.mps.baseLanguageInternal" version="0" />
    <language id="63650c59-16c8-498a-99c8-005c7ee9515d" fqName="jetbrains.mps.lang.access" version="0" />
    <language id="aee9cad2-acd4-4608-aef2-0004f6a1cdbd" fqName="jetbrains.mps.lang.actions" version="0" />
    <language id="af65afd8-f0dd-4942-87d9-63a55f2a9db1" fqName="jetbrains.mps.lang.behavior" version="0" />
    <language id="fe9d76d7-5809-45c9-ae28-a40915b4d6ff" fqName="jetbrains.mps.lang.checkedName" version="0" />
    <language id="3f4bc5f5-c6c1-4a28-8b10-c83066ffa4a1" fqName="jetbrains.mps.lang.constraints" version="0" />
    <language id="ceab5195-25ea-4f22-9b92-103b95ca8c0c" fqName="jetbrains.mps.lang.core" version="1" />
    <language id="7fa12e9c-b949-4976-b4fa-19accbc320b4" fqName="jetbrains.mps.lang.dataFlow" version="0" />
    <language id="18bc6592-03a6-4e29-a83a-7ff23bde13ba" fqName="jetbrains.mps.lang.editor" version="0" />
    <language id="64d34fcd-ad02-4e73-aff8-a581124c2e30" fqName="jetbrains.mps.lang.findUsages" version="0" />
    <language id="b401a680-8325-4110-8fd3-84331ff25bef" fqName="jetbrains.mps.lang.generator" version="0" />
    <language id="d7706f63-9be2-479c-a3da-ae92af1e64d5" fqName="jetbrains.mps.lang.generator.generationContext" version="0" />
    <language id="d7a92d38-f7db-40d0-8431-763b0c3c9f20" fqName="jetbrains.mps.lang.intentions" version="0" />
    <language id="d4615e3b-d671-4ba9-af01-2b78369b0ba7" fqName="jetbrains.mps.lang.pattern" version="0" />
    <language id="3a13115c-633c-4c5c-bbcc-75c4219e9555" fqName="jetbrains.mps.lang.quotation" version="0" />
    <language id="3ecd7c84-cde3-45de-886c-135ecc69b742" fqName="jetbrains.mps.lang.refactoring" version="0" />
    <language id="0eddeefa-c2d6-4437-bc2c-de50fd4ce470" fqName="jetbrains.mps.lang.script" version="0" />
    <language id="13744753-c81f-424a-9c1b-cf8943bf4e86" fqName="jetbrains.mps.lang.sharedConcepts" version="0" />
    <language id="7866978e-a0f0-4cc7-81bc-4d213d9375e1" fqName="jetbrains.mps.lang.smodel" version="0" />
    <language id="c72da2b9-7cce-4447-8389-f407dc1158b7" fqName="jetbrains.mps.lang.structure" version="0" />
    <language id="b83431fe-5c8f-40bc-8a36-65e25f4dd253" fqName="jetbrains.mps.lang.textGen" version="0" />
    <language id="9ded098b-ad6a-4657-bfd9-48636cfe8bc3" fqName="jetbrains.mps.lang.traceable" version="0" />
    <language id="7a5dda62-9140-4668-ab76-d5ed1746f2b2" fqName="jetbrains.mps.lang.typesystem" version="0" />
  </languageVersions>
  <extendedLanguages>
    <extendedLanguage>ceab5195-25ea-4f22-9b92-103b95ca8c0c(jetbrains.mps.lang.core)</extendedLanguage>
    <extendedLanguage>d4280a54-f6df-4383-aa41-d1b2bffa7eb1(com.mbeddr.core.base)</extendedLanguage>
    <extendedLanguage>9ded098b-ad6a-4657-bfd9-48636cfe8bc3(jetbrains.mps.lang.traceable)</extendedLanguage>
    <extendedLanguage>7a5dda62-9140-4668-ab76-d5ed1746f2b2(jetbrains.mps.lang.typesystem)</extendedLanguage>
    <extendedLanguage>223dd778-c44f-4ef3-9535-7aa7d12244a6(com.mbeddr.core.debug)</extendedLanguage>
    <extendedLanguage>63e0e566-5131-447e-90e3-12ea330e1a00(com.mbeddr.mpsutil.blutil)</extendedLanguage>
  </extendedLanguages>
</language>


Add a very general utility to Domain:-Improve; currently it isn't used, but probably very many things can make use of it

export Improve := module ()
    export Simplifiers := table();
    export ModuleApply := proc(dom :: HDomain, $)::HDomain_mb;
        local es := map(si->Simplifiers[si]
                       , sort( [indices(Domain:-Improve:-Simplifiers,nolist) ]
                             , key=(si->Simplifiers[si]:-SimplOrder)))
             , bnd, sh;
        bnd, sh := op([1..2], dom);
        sh := foldr(((f,q)->proc() cmp_simp_sh(f,q,args) end proc)
                   ,(proc(_,b,$) b end proc), op(es))(bnd, sh);
        DOMAIN(bnd, sh);
    end proc;

    local ModuleLoad := proc($)
      LoadSimplifiers();
      LoadSimplifiers := (proc() end proc);
    end proc;#ModuleLoad

    local LoadSimplifiers := proc($)
      local lib_path, drs, improve_path, simpls_paths, simpl_path, names0, names1, new_names, nm;
      unprotect(Simplifiers);
      lib_path := LibraryTools:-FindLibrary(Hakaru);
      ASSERT(lib_path<>NULL);
      lib_path := FileTools:-ParentDirectory(lib_path);
      drs := kernelopts(dirsep);
      improve_path := `cat`(lib_path,drs,"Domain",drs,"Improve");

      simpls_paths := FileTools:-ListDirectory(improve_path);
      for simpl_path in simpls_paths do
        names0 := {anames(user)};
        read(`cat`(improve_path,drs,simpl_path));
        names1 := {anames(user)};
        new_names := names1 minus names0;
        for nm in new_names minus {entries(Simplifiers,nolist)} do
          if nm :: `module`(SimplName,SimplOrder) then
            if assigned(Simplifiers[nm:-SimplName])
            and not Simplifiers[nm:-SimplName] = nm then
              WARNING("overwriting old simplifier! (%1)", Simplifiers[nm:-SimplName]):
            end if;
            Simplifiers[nm:-SimplName] := eval(nm);
          else
            WARNING("not recognized as a simplifier: %1", nm);
          end if;
        end do;
      end do;
      protect(Simplifiers);
    end proc;#LoadSimplifiers

    local combine_errs := proc(err::DomNoSol, mb, $)
        if mb :: DomNoSol then
            DNoSol(op(err),op(mb));
        else
            mb
        end if;
    end proc;

    # compose two simplifiers, combining errors if both fail
    local cmp_simp_sh := proc(simp0, simp1, bnd, sh :: {DomShape,DomNoSol}, $)::{DomShape,DomNoSol};
      local res, sh1; sh1 := simp0(bnd, sh); simp0:-SimplName;
      if not sh1 :: DomNoSol then
          simp1(bnd, sh1);
      else
          combine_errs( sh1, simp1(bnd, sh) );
      end if;
    end proc;

    export classify_relation := proc(r0::relation, vars0, $)
      ::{identical(FAIL), [identical(B_LO,B_HI,B_EQ,B_NEQ), satisfies(q->q in {indices(flip_relation,nolist)}), name, algebraic]};
      local in_vars, vars := vars0, r := r0;
      if vars :: ({set,list})(name) then
        vars := {op(vars)}; in_vars := x->x in vars;
      elif vars :: DomBound then
        vars := DomBound:-Bound:-varsOf(vars); in_vars := x->x in vars;
      elif vars :: appliable then
        in_vars := vars;
      elif vars :: type then
        in_vars := x->type(x,vars);
      else error "unknown argument: %1 (expecting variables, variable membership check, "
                 "or domain bounds)", vars;
      end if;

      if r :: {`<=`,`<`, `=`, `<>`} then
        if in_vars(rhs(r)) then
          r := op(0,r)(rhs(r), lhs(r));
        end if;
        if not in_vars(lhs(r)) then return FAIL end if;
        [ classify_relop[op(0,r)], op(0,r), lhs(r), rhs(r) ];
      else FAIL
      end if;
    end proc;
    local flip_relation := table([`=`=`=`,`<>`=`<>`,`<=`=`>=`,`<`=`>`,`>=`=`<=`,`>`=`<`]);
    local classify_relop := table([`=`=B_EQ,`<>`=B_NEQ,`<=`=B_HI,`<`=B_HI,`>=`=B_LO,`>`=B_LO]);
end module;

export Improve := module ()
    export Simplifiers := table();
    export ModuleApply := proc(dom :: HDomain, $)::HDomain_mb;
        local es := map(si->Simplifiers[si]
                       , sort( [indices(Domain:-Improve:-Simplifiers,nolist) ]
                             , key=(si->Simplifiers[si]:-SimplOrder)))
             , bnd, sh;
        bnd, sh := op([1..2], dom);
        sh := foldr(((f,q)->proc() cmp_simp_sh(f,q,args) end proc)
                   ,(proc(_,b,$) b end proc), op(es))(bnd, sh);
        DOMAIN(bnd, sh);
    end proc;

    local ModuleLoad := proc($)
      LoadSimplifiers();
      LoadSimplifiers := (proc() end proc);
    end proc;#ModuleLoad

    local LoadSimplifiers := proc($)
      local lib_path, drs, improve_path, simpls_paths, simpl_path, names0, names1, new_names, nm;
      unprotect(Simplifiers);
      lib_path := LibraryTools:-FindLibrary(Hakaru);
      ASSERT(lib_path<>NULL);
      lib_path := FileTools:-ParentDirectory(lib_path);
      drs := kernelopts(dirsep);
      improve_path := `cat`(lib_path,drs,"Domain",drs,"Improve");

      simpls_paths := FileTools:-ListDirectory(improve_path);
      for simpl_path in simpls_paths do
        names0 := {anames(user)};
        read(`cat`(improve_path,drs,simpl_path));
        names1 := {anames(user)};
        new_names := names1 minus names0;
        for nm in new_names minus {entries(Simplifiers,nolist)} do
          if nm :: `module`(SimplName,SimplOrder) then
            if assigned(Simplifiers[nm:-SimplName])
            and not Simplifiers[nm:-SimplName] = nm then
              WARNING("overwriting old simplifier! (%1)", Simplifiers[nm:-SimplName]):
            end if;
            Simplifiers[nm:-SimplName] := eval(nm);
          else
            WARNING("not recognized as a simplifier: %1", nm);
          end if;
        end do;
      end do;
      protect(Simplifiers);
    end proc;#LoadSimplifiers

    local combine_errs := proc(err::DomNoSol, mb, $)
        if mb :: DomNoSol then
            DNoSol(op(err),op(mb));
        else
            mb
        end if;
    end proc;

    # compose two simplifiers, combining errors if both fail
    local cmp_simp_sh := proc(simp0, simp1, bnd, sh :: {DomShape,DomNoSol}, $)::{DomShape,DomNoSol};
      local res, sh1; sh1 := simp0(bnd, sh); simp0:-SimplName;
      if not sh1 :: DomNoSol then
          simp1(bnd, sh1);
      else
          combine_errs( sh1, simp1(bnd, sh) );
      end if;
    end proc;
end module;


piecewise sometimes still needed

piecewise sometimes still needed

# Teach Maple (through depends and eval) about our new binding forms.
# lam binds from 1st arg to 3rd arg.
# Branch binds from 1st arg (a pattern) to 2nd arg.
# Bind and ary bind from 2nd arg to 3rd arg.

# note that v _can_ in principle occur in t.
`depends/lam` := proc(v::name, t, e, x, $)
  depends(t, x) or depends(e, x minus {v})
end proc:

`depends/Branch` := proc(p, e, x, $)
  depends(e, x minus {Hakaru:-pattern_binds(p)})
end proc:

# note that v _can_ occur in m1.
`depends/Bind` := proc(m1, v::name, m2, x, $)
  depends(m1, x) or depends(m2, x minus {v})
end proc:

# note that i _can_ occur in n.
`depends/ary` := proc(n, i::name, e, x, $)
  depends(n, x) or depends(e, x minus {i})
end proc:
`depends/Plate` := eval(`depends/ary`):

`eval/lam` := proc(e, eqs, $)
  local v, t, ee;
  v, t, ee := op(e);
  v, ee := BindingTools:-generic_evalat(v, ee, eqs);
  t := eval(t, eqs);
  eval(op(0,e), eqs)(v, t, ee)
end proc:

`eval/Branch` := proc(e, eqs, $)
  local p, ee, vBefore, vAfter;
  p, ee := op(e);
  vBefore := [Hakaru:-pattern_binds(p)];
  vAfter, ee := BindingTools:-generic_evalat(vBefore, ee, eqs);
  eval(op(0,e), eqs)(subs(op(zip(`=`, vBefore, vAfter)), p), ee)
end proc:

`eval/Bind` := proc(e, eqs, $)
  local m1, v, m2;
  m1, v, m2 := op(e);
  eval(op(0,e), eqs)(eval(m1, eqs), BindingTools:-generic_evalat(v, m2, eqs))
end proc:

`eval/ary` := proc(e, eqs, $)
  local n, i, ee;
  n, i, ee := op(e);
  eval(op(0,e), eqs)(eval(n, eqs), BindingTools:-generic_evalat(i, ee, eqs))
end proc:
`eval/Plate` := eval(`eval/ary`):

#############################################################################
Hakaru := module ()
  option package;
  local p_true, p_false, make_piece, Mk_Plus, lift1_piecewise, TYPES,
        ModuleLoad, ModuleUnload;
  export
     # These first few are smart constructors (for themselves):
         case, app, ary, idx, fst, snd, size, Datum,
     # while these are "proper functions"
         verify_measure, verify_hboolean, pattern_equiv,
         piecewise_And, map_piecewiselike, lift_piecewise, foldr_piecewise,
         flatten_piecewise,
         pattern_match, pattern_binds,
         closed_bounds, open_bounds,
         htype_patterns,
         bool_And, bool_Or, bool_Not,
         UpdateArchive;
  # These names are not assigned (and should not be).  But they are
  # used as global names, so document that here.
  global
     # Basic syntax for composing measures
         Bind, Weight, Ret, Msum, Plate, Context, Pair, _Unit, PARTITION,
     # Primitive (known) measures
         Lebesgue, Uniform, Gaussian, Cauchy, StudentT, BetaD,
         GammaD, ChiSquared,
         Counting, Categorical, NegativeBinomial, PoissonD,
     # Functions, annotated with argument type, applied using "app"
         lam,
     # Term constructors for Datum (algebraic data type)
         Inr, Inl, Et, Done, Konst, Ident,
     # The parts of "case" besides the scrutinee
         Branches, Branch,
     # Pattern constructors
         PWild, PVar, PDatum, PInr, PInl, PEt, PDone, PKonst, PIdent,
     # Verification of alpha-equivalence among measures
         measure,
     # Punctuation for matching free variables with measures for disintegration
         `&M`,
     # Structure types for Hakaru types and Hakaru "case" expressions
         known_continuous, known_discrete, t_Hakaru, t_type, t_case,
     # Structure types for piecewise-like expressions:
     # piecewise, case, and idx into literal array
         t_pw, t_piecewiselike,
     #other types
         `&implies`,
     # Type constructors for Hakaru
         AlmostEveryReal, HReal, HInt, HData, HMeasure, HArray, HFunction,
         Bound, DatumStruct;
  p_true  := 'PDatum(true,PInl(PDone))';
  p_false := 'PDatum(false,PInr(PInl(PDone)))';

  case := proc(e, bs :: specfunc(Branch(anything, anything), Branches), $)
    local ret, b, substs, eSubst, pSubst, p, binds, uncertain;
    if e :: 't_piecewiselike' then
      map_piecewiselike(procname, _passed)
    else
      ret := Branches();
      for b in bs do
        substs := pattern_match(e, e, op(1,b));
        if substs <> NULL then
          eSubst, pSubst := substs;
          p := subs(pSubst, op(1,b));
          binds := {pattern_binds(p)};
          uncertain := remove((eq -> lhs(eq) in binds), eSubst);
          if nops(uncertain) = 0 then p := PWild end if;
          ret := Branches(op(ret),
                          Branch(p, eval(eval(op(2,b), pSubst), eSubst)));
          if nops(uncertain) = 0 then break end if;
        end if
      end do;
      if ret :: Branches(Branch(identical(PWild), anything)) then
        op([1,2], ret)
      elif ret :: Branches(Branch(identical(p_true), anything),
                           Branch({identical(p_false),
                                   identical(PWild),
                                   PVar(anything)}, anything)) then
        'piecewise'(make_piece(e), op([1,2], ret), op([2,2], ret))
      elif ret :: Branches(Branch(identical(p_false), anything),
                           Branch({identical(p_true),
                                   identical(PWild),
                                   PVar(anything)}, anything)) then
        'piecewise'(make_piece(e), op([2,2], ret), op([1,2], ret))
      else
        'case'(e, ret)
      end if
    end if
  end proc;

  pattern_match := proc(e0, e, p, $)
    local x, substs, eSubst, pSubst;
    if p = PWild then return {}, {}
    elif p :: PVar(anything) then
      x := op(1,p);
      pSubst := {`if`(depends(e0,x), x=gensym(x), NULL)};
      return {subs(pSubst,x)=e}, pSubst;
    elif p = p_true then
      if e = true then return {}, {}
      elif e = false then return NULL
      end if
    elif p = p_false then
      if e = false then return {}, {}
      elif e = true then return NULL
      end if
    elif p :: PDatum(anything, anything) then
      if e :: Datum(anything, anything) then
        if op(1,e) = op(1,p) then return pattern_match(e0, op(2,e), op(2,p))
        else return NULL
        end if
      end if
    elif p :: PInl(anything) then
      if e :: Inl(anything) then return pattern_match(e0, op(1,e), op(1,p))
      elif e :: Inr(anything) then return NULL
      end if
    elif p :: PInr(anything) then
      if e :: Inr(anything) then return pattern_match(e0, op(1,e), op(1,p))
      elif e :: Inl(anything) then return NULL
      end if
    elif p :: PEt(anything, anything) then
      if e :: Et(anything, anything) then
        substs := pattern_match(e0, op(1,e), op(1,p));
        if substs = NULL then return NULL end if;
        eSubst, pSubst := substs;
        substs := pattern_match(e0, eval(op(2,e),eSubst), op(2,p));
        if substs = NULL then return NULL end if;
        return eSubst union substs[1], pSubst union substs[2];
      elif e = Done then return NULL
      end if
    elif p = PDone then
      if e = Done then return {}, {}
      elif e :: Et(anything, anything) then return NULL
      end if
    elif p :: PKonst(anything) then
      if e :: Konst(anything) then return pattern_match(e0, op(1,e), op(1,p))
      end if
    elif p :: PIdent(anything) then
      if e :: Ident(anything) then return pattern_match(e0, op(1,e), op(1,p))
      end if
    else
      error "pattern_match: %1 is not a pattern", p
    end if;
    pSubst := map((x -> `if`(depends(e0,x), x=gensym(x), NULL)),
                  {pattern_binds(p)});
    eSubst := {e=subsindets(
                   subsindets[nocache](
                     subs(pSubst,
                          p_true=true,
                          p_false=false,
                          PDatum=Datum, PInr=Inr, PInl=Inl, PEt=Et, PDone=Done,
                          PKonst=Konst, PIdent=Ident,
                          p),
                     identical(PWild),
                     p -> gensym(_)),
                   PVar(anything),
                   p -> op(1,p))};
    eSubst, pSubst
  end proc;

  make_piece := proc(rel, $)
    # Try to prevent PiecewiseTools:-Is from complaining
    # "Wrong kind of parameters in piecewise"
    if rel :: {specfunc(anything, {And,Or,Not}), `and`, `or`, `not`} then
      map(make_piece, rel)
    elif rel :: {'`::`', 'boolean', '`in`'} then
      rel
    else
      rel = true
    end if
  end proc;

  pattern_binds := proc(p, $)
    if p = PWild or p = PDone then
      NULL
    elif p :: PVar(anything) then
      op(1,p)
    elif p :: PDatum(anything, anything) then
      pattern_binds(op(2,p))
    elif p :: {PInl(anything), PInr(anything),
               PKonst(anything), PIdent(anything)} then
      pattern_binds(op(1,p))
    elif p :: PEt(anything, anything) then
      pattern_binds(op(1,p)), pattern_binds(op(2,p))
    else
      error "pattern_binds: %1 is not a pattern", p
    end if
  end proc:

  verify_hboolean := proc(a, b, $)
    local x,y,conv_tbl,and_fn,or_fn,not_fn;
    and_fn := ((x->AND({op(x)}))@`bool_And`);
    or_fn  := ((x->OR({op(x)}))@`bool_Or`);
    not_fn := bool_Not;
    conv_tbl := table([`and`=and_fn,`And`=and_fn,`Or`=or_fn,`or`=or_fn,`Not`=not_fn,`not`=not_fn]);
    x,y := subsindets([a,b], Or(`and`,`or`,`not`, specfunc({`And`,`Or`,`Not`})), x->conv_tbl[op(0,x)](op(x)))[];
    evalb(x=y);
  end proc;

  verify_measure := proc(m, n, v:='hboolean', $)
    local mv, x, i, j, k;
    mv := measure(v);
    if m :: specfunc({Bind, Plate}) and n :: specfunc({Bind, Plate}) and
       (verify(m, n, 'Bind'(mv, true, true))
      or verify(m, n, 'Plate'(v, true, true))) then
      x := gensym(cat(op(2,m), "_", op(2,n), "_"));
      thisproc(subs(op(2,m)=x, op(3,m)),
               subs(op(2,n)=x, op(3,n)), v)
    elif m :: 'specfunc(Msum)' and n :: 'specfunc(Msum)'
         and nops(m) = nops(n) then
      k := nops(m);
      verify(k, GraphTheory[BipartiteMatching](GraphTheory[Graph]({
                seq(seq(`if`(thisproc(op(i,m), op(j,n), v), {i,-j}, NULL),
                        j=1..k), i=1..k)}))[1]);
    elif andmap(type, [m,n], 'specfunc(piecewise)') and nops(m) = nops(n) then
      k := nops(m);
      verify(m, n, 'piecewise'(seq(`if`(i::even or i=k, mv, hboolean), i=1..k)));

    elif andmap(type, [m,n], 'specfunc(PARTITION)') then
      Partition:-SamePartition(verify_hboolean, verify_measure, m, n);

    elif m :: specfunc('case') and
        verify(m, n, 'case'(v, specfunc(Branch(true, true), Branches))) then
      # This code unfortunately only handles alpha-equivalence for 'case' along
      # the control path -- not if 'case' occurs in the argument to 'Ret', say.
      k := nops(op(2,m));
      for i from 1 to k do
        j := pattern_equiv(op([2,i,1],m), op([2,i,1],n));
        if j = false then return j end if;
        j := map(proc(eq, $)
                   local x;
                   x := gensym(cat(lhs(eq), "_", rhs(eq), "_"));
                   [lhs(eq)=x, rhs(eq)=x]
                 end proc, j);
        j := thisproc(subs(map2(op,1,j), op([2,i,2],m)),
                      subs(map2(op,2,j), op([2,i,2],n)), v);
        if j = false then return j end if;
      end do;
      true
    elif m :: 'LO(name, anything)' and n :: 'LO(name, anything)' then
      x := gensym(cat(op(1,m), "_", op(1,n), "_"));
      verify(subs(op(1,m)=x, op(2,m)),
             subs(op(1,n)=x, op(2,n)), v)
    elif m :: specfunc('lam') and n :: specfunc('lam') and
        verify(m, n, 'lam'(true, v, true)) then
      # m and n are not even measures, but we verify them anyway...
      x := gensym(cat(op(1,m), "_", op(1,n), "_"));
      thisproc(subs(op(1,m)=x, op(2,m)),
               subs(op(1,n)=x, op(2,n)), v)
    else
      verify(m, n, {v, Ret(v), Weight(v, mv), Context(v, mv)})
    end if
  end proc;

  pattern_equiv := proc(p, q, $) :: {identical(false),set(`=`)};
    local r, s;
    if ormap((t->andmap(`=`, [p,q], t)), [PWild, PDone]) then
      {}
    elif andmap(type, [p,q], PVar(anything)) then
      {op(1,p)=op(1,q)}
    elif andmap(type, [p,q], PDatum(anything,anything)) and op(1,p)=op(1,q) then
      pattern_equiv(op(2,p),op(2,q))
    elif ormap((t->andmap(type, [p,q], t(anything))),
               [PInl, PInr, PKonst, PIdent]) then
      pattern_equiv(op(1,p),op(1,q))
    elif andmap(type, [p,q], PEt(anything, anything)) then
      r := pattern_equiv(op(1,p),op(1,q));
      s := pattern_equiv(op(2,p),op(2,q));
      if map(lhs,r) intersect map(lhs,s) = {} and
         map(rhs,r) intersect map(rhs,s) = {} then
        r union s
      else
        false
      end if
    else
      false
    end if
  end proc;

  piecewise_And := proc(cond::{list,set,specfunc(`And`),`and`}, th, el, $)
    if nops(cond) = 0 or th = el then
      th
    else
      piecewise(And(op(cond)), th, el)
    end if
  end proc;

  map_piecewiselike := proc(f, p::t_piecewiselike)
    local i, g, h;
    if p :: 'specfunc(piecewise)' then
      piecewise(seq(`if`(i::even or i=nops(p), f(op(i,p),_rest), op(i,p)),
                    i=1..nops(p)))
    elif p :: 't_case' then
      # Mind the hygiene
      subsindets(eval(subsop(2 = map[3](applyop, g, 2, op(2,p)), p),
                      g=h(f,_rest)),
                 'typefunc(specfunc(h))',
                 (e -> op([0,1],e)(op(1,e), op(2..-1,op(0,e)))))
    elif p :: 'idx(list, anything)' then
      idx(map(f,op(1,p),_rest), op(2,p))
    else
      error "map_piecewiselike: %1 is not t_piecewiselike", p
    end if
  end proc;

  lift_piecewise := proc(e, extra:={}, $)
    local e1, e2;
    e2 := e;
    while e1 <> e2 do
      e1 := e2;
      e2 := subsindets(e1,
              '{extra,
                And(`+`, Not(specop(Not(specfunc(piecewise)), `+`))),
                And(`*`, Not(specop(Not(specfunc(piecewise)), `*`))),
                And(`^`, Not(specop(Not(specfunc(piecewise)), `^`))),
                exp(specfunc(piecewise))}',
              lift1_piecewise)
    end do
  end proc;

  lift1_piecewise := proc(e, $)
    local i, p;
    if membertype(t_piecewiselike, [op(e)], i) then
      p := op(i,e);
      if nops(p) :: even and not (e :: `*`) and op(-1,p) <> 0 then
        p := piecewise(op(p), 0);
      end if;
      map_piecewiselike((arm->lift1_piecewise(subsop(i=arm,e))), p)
    else
      e
    end if
  end proc;

  foldr_piecewise := proc(cons, nil, pw, $) # pw may or may not be piecewise
    # View pw as a piecewise and foldr over its arms
    if pw :: 'specfunc(piecewise)' then
      foldr(proc(i,x) cons(op(i,pw), op(i+1,pw), x) end proc,
            `if`(nops(pw)::odd, cons(true, op(-1,pw), nil), nil),
            seq(1..nops(pw)-1, 2))
    else
      cons(true, pw, nil)
    end if
  end proc;

  #Take a piecewise: If some of the branches also contain piecewises, attempt
  #to re-express the whole as a single piecewise. In short: fewer piecewises, more
  #branches, more complex conditions.--Carl 2016Sep09
  flatten_piecewise:= proc(PW::specfunc(piecewise), $)::specfunc(piecewise);
  local
     pwL:= [op(PW)],
     nP:= nops(pwL),
     conds:= pwL[[seq(1..nP-1, 2)]],
     branches:= pwL[[seq(2..nP-1, 2), nP]],
     innerPW:= indets(branches, specfunc(piecewise)),
     outerPW, C_O, C_I, B_I, r
  ;
     if indets(conds, specfunc(piecewise)) <> {} then
          userinfo(2, procname, "Case of inner pw in a condition not yet handled.");
          return PW
     end if;
     if innerPW = {} then
          userinfo(3, procname, "No inner pw.");
          return PW
     end if;
     if nops~(innerPW) <> {3} then
          userinfo(2, procname, "Case of inner pw of other than 3 ops not yet handled.");
          return PW
     end if;
     if nops(PW) <> 3 then
          userinfo(2, procname, "Case of outer pw of other than 3 ops not yet handled.");
          return PW
     end if;
     outerPW:= applyop(lift_piecewise, {2,3}, PW);
     if membertype(
          And(
               satisfies(e-> indets(e, specfunc(piecewise)) <> {}),
               Not(specfunc(piecewise))
          ),
          {op(2..3, outerPW)}
     )
     then
          userinfo(1, procname, "Unliftable pw.");
          return PW
     end if;
     C_O:= op(1,outerPW);
     C_I:= map(e-> `if`(e::specfunc(piecewise), op(1,e), true), [op(2..3, outerPW)]);
     B_I:= map(e-> `if`(e::specfunc(piecewise), [op(2..3, e)], [e$2])[], [op(2..3, outerPW)]);
     #For debugging purposes, I want to show the proposed output before it's passed to
     #piecewise.
     r:= [
          And(C_O, C_I[1]), B_I[1],
          And(C_O, KB:-negate_rel(C_I[1])), B_I[2],
          And(KB:-negate_rel(C_O), C_I[2]), B_I[3],
          And(KB:-negate_rel(C_O), KB:-negate_rel(C_I[2])), B_I[4]
     ];
     userinfo(3, procname, "Proposed ouput: ", print(%piecewise(r[])));
     piecewise(r[])
  end proc;

  app := proc (func, argu, $)
    if func :: 'lam(name, anything, anything)' then
      eval(op(3,func), op(1,func)=argu)
    elif func :: 't_piecewiselike' then
      map_piecewiselike(procname, _passed)
    else
      'procname(_passed)'
    end if
  end proc;

  ary := proc (n, i, e, $)
    local j;
    if e :: 'idx'('freeof'(i), 'identical'(i)) then
      # Array eta-reduction. Assume the size matches.  (We should keep array
      # size information in the KB and use it here, but we don't currently.)
      op(1,e)
    elif n :: nonnegint then
      [seq(eval(e,i=j), j=0..n-1)] # Unroll array with literal size
    else
      'procname(_passed)'
    end if
  end proc;

  idx := proc (a, i, $)
    if a :: 'ary(anything, name, anything)' then
      eval(op(3,a), op(2,a)=i)
    elif a :: 'list' and i::nonnegint then
      a[i+1]
    elif a :: 'list' and nops(convert(a,'set')) = 1 then
      a[1] # Indexing into a literal array whose elements are all the same
    elif a :: 't_piecewiselike' then
      map_piecewiselike(procname, _passed)
    else
      'procname(_passed)'
    end if
  end proc;

  #Extract the first member of a Pair.
  fst:= proc(p, $)
    if p :: 'Pair'('anything'$2) then
      op(1,p)
    elif p :: t_piecewiselike then
      map_piecewiselike(fst, p)
    else
      'procname'(p)
    end if;
  end proc;

  #Extract the second member of a Pair.
  snd:= proc(p, $)
    if p :: 'Pair'('anything'$2) then
      op(2,p)
    elif p :: t_piecewiselike then
      map_piecewiselike(snd, p)
    else
      'procname'(p)
    end if;
  end proc;

  size := proc(a, $)
    local res;
    if a :: 'ary(anything, name, anything)' then
      op(1,a)
    elif a :: 'list' then
      nops(a)
    elif a :: 't_piecewiselike' then
      map_piecewiselike(procname, _passed)
    else
      'procname(_passed)'
    end if
  end proc;

  Datum := proc(hint, payload, $)
    # Further cheating to equate Maple booleans and Hakaru booleans
    if hint = true and payload = Inl(Done) or
       hint = false and payload = Inr(Inl(Done)) then
      hint
    else
      'procname(_passed)'
    end if
  end proc;

  closed_bounds := proc(r::range, $)
    Bound(`>=`, lhs(r)), Bound(`<=`, rhs(r))
  end proc;

  open_bounds := proc(r::range, $)
    Bound(`>`, lhs(r)), Bound(`<`, rhs(r))
  end proc;

  # Creates an N-ary operator `Plus` such:
  #  Plus(Plus(a,b),c)=Plus(a,Plus(a,b))
  #  Plus(a,Zero)=a
  #  Plus(a)=a
  #  Plus(x,x)=x
  Mk_Plus := proc(plus,zero,$) proc()
    local as := {args};
    as := map(a->if op(0,a)=plus then op(a) else a end if, as);
    if nops(as)=0 then zero
    elif nops(as)=1 then op(1,as)
    else plus(op(as))
    end if;
  end proc; end proc;

  # Replacements for `and` and `or` which do not
  # evaluate "x = y" to "false" when "x,y" are unbound vars.
  bool_And := Mk_Plus('And','true' );
  bool_Or  := Mk_Plus('Or' ,'false');

  bool_Not := proc(a,$)
    if a :: t_kb_atom then
      subsindets(KB:-negate_rel(a), `not`, Not@op);
    else
      Not(a)
    end if;
  end proc;

  # Enumerate patterns for a given Hakaru type
  htype_patterns := proc(t::t_type, $)
    :: specfunc(Branch(anything, list(t_type)), Branches);
    local struct;
    uses StringTools;
    if t :: specfunc(DatumStruct(anything, list(Konst(anything))), HData) then
      foldr(proc(struct,ps,$) Branches(
              op(map((p -> Branch(PDatum(op(1,struct), PInl(op(1,p))),
                                  op(2,p))),
                     foldr(proc(kt,qs,$)
                             local p, q;
                             Branches(seq(seq(Branch(PEt(PKonst(op(1,p)),
                                                         op(1,q)),
                                                     [op(op(2,p)),op(op(2,q))]),
                                              q in qs),
                                          p in htype_patterns(op(1,kt))))
                           end proc,
                           Branches(Branch(PDone, [])), op(op(2,struct))))),
              op(map[3](applyop, PInr, [1,2], ps)))
            end proc,
            Branches(), op(t))
    else
      Branches(Branch(PVar(gensym(convert(LowerCase(op(-1, ["x", op(
                                            `if`(t::function,
                                              select(IsUpper, Explode(op(0,t))),
                                              []))])),
                                          name))),
                      [t]))
    end if
  end proc;

  TYPES := table(
    [(`&implies` =
         'proc(e, t1, t2, $) type(e, Or(Not(t1), t2)) end proc')
    ,(Name = 'And(name, Not({constant,undefined}))')
    ,(known_continuous =
         ''{
              Lebesgue(anything, anything), Uniform(anything, anything),
              Gaussian(anything, anything), Cauchy(anything, anything),
              StudentT(anything, anything, anything), ChiSquared(anything),
              BetaD(anything, anything), GammaD(anything, anything),
              InverseGammaD(anything, anything)
         }''
    )
    ,(known_discrete =
         ''{
              Counting(anything, anything),
              Categorical(anything),
              Binomial(anything,anything),
              NegativeBinomial(anything,anything),
              PoissonD(anything)
          }''
    )
    #This type t_Hakaru is the basic syntax checker for that part of the
    #Maple/Hakaru language accessible by the external user.--Carl 2016Sep20
    ,(t_Hakaru =
         #Alternation/conjunction of types via {} or And follows the McCarthy
         #short-cut rule: Proceeding left to right, once satisfaction of the type
         #can be determined, the remaining elements aren't evaluated. Therefore,
         #recursive types are possible by placing the base cases at the beginning.
         #But use Or instead of {} because you can't control the order of
         #expressions with {}.
         'Or(
           'known_continuous', 'known_discrete',
           t_pw, #Needs to be more specific!
           t_partition,
           t_case,
          'Ret(anything)',
          'Bind(t_Hakaru, name, t_Hakaru)',
          'specfunc(t_Hakaru, Msum)',
          'Weight(algebraic, t_Hakaru)',
          'Plate(algebraic, name, t_Hakaru)',
          t_lam
         )'
    )
    ,(t_type =
     ''{specfunc(Bound(identical(`<`,`<=`,`>`,`>=`), anything),
                 {AlmostEveryReal, HReal, HInt}),
        specfunc(DatumStruct(anything, list({Konst(t_type), Ident(t_type)})),
                 HData),
        HMeasure(t_type),
        HArray(t_type),
        HFunction(t_type, t_type)}'')
    ,(t_case =
      ''case(anything, specfunc(Branch(anything, anything), Branches))'')
    ,(t_pw = ''specfunc(piecewise)'')
    ,(t_partition = ''specfunc(PARTITION)'') #Appropriate to put this here?
    ,(t_piecewiselike =
      ''{specfunc(piecewise), t_case, idx(list, anything)}'')
    ,(t_lam = ''lam(name, t_type, t_Hakaru)'')

    # A temporary type which should be removed when piecewise is gone
    ,(t_pw_or_part = 'Or(t_pw,t_partition)')
    ]);

  ModuleLoad := proc($)
    local g; #Iterator over thismodule's globals
    VerifyTools[AddVerification](measure = eval(verify_measure));
    VerifyTools[AddVerification](hboolean = eval(verify_hboolean));

    BindingTools:-load_types_from_table(TYPES);

    #Protect the keywords of the Hakaru language.
    #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 Hakaru keyword '%1' erased.", g);
         end if;
         protect(g)
    end do
  end proc;

  ModuleUnload := proc($)
    unprotect(op([2,6], thismodule)); #See comment in ModuleLoad.
    #Skip restoring the globals to any prior value they had.
  end proc;
  ModuleLoad();
end module; # Hakaru

# Teach Maple (through depends and eval) about our new binding forms.
# lam binds from 1st arg to 3rd arg.
# Branch binds from 1st arg (a pattern) to 2nd arg.
# Bind and ary bind from 2nd arg to 3rd arg.

# note that v _can_ in principle occur in t.
`depends/lam` := proc(v::name, t, e, x, $)
  depends(t, x) or depends(e, x minus {v})
end proc:

`depends/Branch` := proc(p, e, x, $)
  depends(e, x minus {Hakaru:-pattern_binds(p)})
end proc:

# note that v _can_ occur in m1.
`depends/Bind` := proc(m1, v::name, m2, x, $)
  depends(m1, x) or depends(m2, x minus {v})
end proc:

# note that i _can_ occur in n.
`depends/ary` := proc(n, i::name, e, x, $)
  depends(n, x) or depends(e, x minus {i})
end proc:
`depends/Plate` := eval(`depends/ary`):

`eval/lam` := proc(e, eqs, $)
  local v, t, ee;
  v, t, ee := op(e);
  v, ee := BindingTools:-generic_evalat(v, ee, eqs);
  t := eval(t, eqs);
  eval(op(0,e), eqs)(v, t, ee)
end proc:

`eval/Branch` := proc(e, eqs, $)
  local p, ee, vBefore, vAfter;
  p, ee := op(e);
  vBefore := [Hakaru:-pattern_binds(p)];
  vAfter, ee := BindingTools:-generic_evalat(vBefore, ee, eqs);
  eval(op(0,e), eqs)(subs(op(zip(`=`, vBefore, vAfter)), p), ee)
end proc:

`eval/Bind` := proc(e, eqs, $)
  local m1, v, m2;
  m1, v, m2 := op(e);
  eval(op(0,e), eqs)(eval(m1, eqs), BindingTools:-generic_evalat(v, m2, eqs))
end proc:

`eval/ary` := proc(e, eqs, $)
  local n, i, ee;
  n, i, ee := op(e);
  eval(op(0,e), eqs)(eval(n, eqs), BindingTools:-generic_evalat(i, ee, eqs))
end proc:
`eval/Plate` := eval(`eval/ary`):

#############################################################################
Hakaru := module ()
  option package;
  local p_true, p_false, make_piece, Mk_Plus, lift1_piecewise, TYPES,
        ModuleLoad, ModuleUnload;
  export
     # These first few are smart constructors (for themselves):
         case, app, ary, idx, fst, snd, size, Datum,
     # while these are "proper functions"
         verify_measure, verify_hboolean, pattern_equiv,
         piecewise_And, map_piecewiselike, lift_piecewise, foldr_piecewise,
         flatten_piecewise,
         pattern_match, pattern_binds,
         closed_bounds, open_bounds,
         htype_patterns,
         bool_And, bool_Or, bool_Not,
         UpdateArchive;
  # These names are not assigned (and should not be).  But they are
  # used as global names, so document that here.
  global
     # Basic syntax for composing measures
         Bind, Weight, Ret, Msum, Plate, Context, Pair, _Unit, PARTITION,
     # Primitive (known) measures
         Lebesgue, Uniform, Gaussian, Cauchy, StudentT, BetaD,
         GammaD, ChiSquared,
         Counting, Categorical, NegativeBinomial, PoissonD,
     # Functions, annotated with argument type, applied using "app"
         lam,
     # Term constructors for Datum (algebraic data type)
         Inr, Inl, Et, Done, Konst, Ident,
     # The parts of "case" besides the scrutinee
         Branches, Branch,
     # Pattern constructors
         PWild, PVar, PDatum, PInr, PInl, PEt, PDone, PKonst, PIdent,
     # Verification of alpha-equivalence among measures
         measure,
     # Punctuation for matching free variables with measures for disintegration
         `&M`,
     # Structure types for Hakaru types and Hakaru "case" expressions
         known_continuous, known_discrete, t_Hakaru, t_type, t_case,
     # Structure types for piecewise-like expressions:
     # piecewise, case, and idx into literal array
         t_pw, t_piecewiselike,
     #other types
         `&implies`,
     # Type constructors for Hakaru
         AlmostEveryReal, HReal, HInt, HData, HMeasure, HArray, HFunction,
         Bound, DatumStruct;
  p_true  := 'PDatum(true,PInl(PDone))';
  p_false := 'PDatum(false,PInr(PInl(PDone)))';

  case := proc(e, bs :: specfunc(Branch(anything, anything), Branches), $)
    local ret, b, substs, eSubst, pSubst, p, binds, uncertain;
    if e :: 't_piecewiselike' then
      map_piecewiselike(procname, _passed)
    else
      ret := Branches();
      for b in bs do
        substs := pattern_match(e, e, op(1,b));
        if substs <> NULL then
          eSubst, pSubst := substs;
          p := subs(pSubst, op(1,b));
          binds := {pattern_binds(p)};
          uncertain := remove((eq -> lhs(eq) in binds), eSubst);
          if nops(uncertain) = 0 then p := PWild end if;
          ret := Branches(op(ret),
                          Branch(p, eval(eval(op(2,b), pSubst), eSubst)));
          if nops(uncertain) = 0 then break end if;
        end if
      end do;
      if ret :: Branches(Branch(identical(PWild), anything)) then
        op([1,2], ret)
      elif ret :: Branches(Branch(identical(p_true), anything),
                           Branch({identical(p_false),
                                   identical(PWild),
                                   PVar(anything)}, anything)) then
        'Partition'(make_piece(e), op([1,2], ret), op([2,2], ret))
      elif ret :: Branches(Branch(identical(p_false), anything),
                           Branch({identical(p_true),
                                   identical(PWild),
                                   PVar(anything)}, anything)) then
        'Partition'(make_piece(e), op([2,2], ret), op([1,2], ret))
      else
        'case'(e, ret)
      end if
    end if
  end proc;

  pattern_match := proc(e0, e, p, $)
    local x, substs, eSubst, pSubst;
    if p = PWild then return {}, {}
    elif p :: PVar(anything) then
      x := op(1,p);
      pSubst := {`if`(depends(e0,x), x=gensym(x), NULL)};
      return {subs(pSubst,x)=e}, pSubst;
    elif p = p_true then
      if e = true then return {}, {}
      elif e = false then return NULL
      end if
    elif p = p_false then
      if e = false then return {}, {}
      elif e = true then return NULL
      end if
    elif p :: PDatum(anything, anything) then
      if e :: Datum(anything, anything) then
        if op(1,e) = op(1,p) then return pattern_match(e0, op(2,e), op(2,p))
        else return NULL
        end if
      end if
    elif p :: PInl(anything) then
      if e :: Inl(anything) then return pattern_match(e0, op(1,e), op(1,p))
      elif e :: Inr(anything) then return NULL
      end if
    elif p :: PInr(anything) then
      if e :: Inr(anything) then return pattern_match(e0, op(1,e), op(1,p))
      elif e :: Inl(anything) then return NULL
      end if
    elif p :: PEt(anything, anything) then
      if e :: Et(anything, anything) then
        substs := pattern_match(e0, op(1,e), op(1,p));
        if substs = NULL then return NULL end if;
        eSubst, pSubst := substs;
        substs := pattern_match(e0, eval(op(2,e),eSubst), op(2,p));
        if substs = NULL then return NULL end if;
        return eSubst union substs[1], pSubst union substs[2];
      elif e = Done then return NULL
      end if
    elif p = PDone then
      if e = Done then return {}, {}
      elif e :: Et(anything, anything) then return NULL
      end if
    elif p :: PKonst(anything) then
      if e :: Konst(anything) then return pattern_match(e0, op(1,e), op(1,p))
      end if
    elif p :: PIdent(anything) then
      if e :: Ident(anything) then return pattern_match(e0, op(1,e), op(1,p))
      end if
    else
      error "pattern_match: %1 is not a pattern", p
    end if;
    pSubst := map((x -> `if`(depends(e0,x), x=gensym(x), NULL)),
                  {pattern_binds(p)});
    eSubst := {e=subsindets(
                   subsindets[nocache](
                     subs(pSubst,
                          p_true=true,
                          p_false=false,
                          PDatum=Datum, PInr=Inr, PInl=Inl, PEt=Et, PDone=Done,
                          PKonst=Konst, PIdent=Ident,
                          p),
                     identical(PWild),
                     p -> gensym(_)),
                   PVar(anything),
                   p -> op(1,p))};
    eSubst, pSubst
  end proc;

  make_piece := proc(rel, $)
    # Try to prevent PiecewiseTools:-Is from complaining
    # "Wrong kind of parameters in piecewise"
    if rel :: {specfunc(anything, {And,Or,Not}), `and`, `or`, `not`} then
      map(make_piece, rel)
    elif rel :: {'`::`', 'boolean', '`in`'} then
      rel
    else
      rel = true
    end if
  end proc;

  pattern_binds := proc(p, $)
    if p = PWild or p = PDone then
      NULL
    elif p :: PVar(anything) then
      op(1,p)
    elif p :: PDatum(anything, anything) then
      pattern_binds(op(2,p))
    elif p :: {PInl(anything), PInr(anything),
               PKonst(anything), PIdent(anything)} then
      pattern_binds(op(1,p))
    elif p :: PEt(anything, anything) then
      pattern_binds(op(1,p)), pattern_binds(op(2,p))
    else
      error "pattern_binds: %1 is not a pattern", p
    end if
  end proc:

  verify_hboolean := proc(a, b, $)
    local x,y,conv_tbl,and_fn,or_fn,not_fn;
    and_fn := ((x->AND({op(x)}))@`bool_And`);
    or_fn  := ((x->OR({op(x)}))@`bool_Or`);
    not_fn := bool_Not;
    conv_tbl := table([`and`=and_fn,`And`=and_fn,`Or`=or_fn,`or`=or_fn,`Not`=not_fn,`not`=not_fn]);
    x,y := subsindets([a,b], Or(`and`,`or`,`not`, specfunc({`And`,`Or`,`Not`})), x->conv_tbl[op(0,x)](op(x)))[];
    evalb(x=y);
  end proc;

  verify_measure := proc(m, n, v:='hboolean', $)
    local mv, x, i, j, k;
    mv := measure(v);
    if m :: specfunc({Bind, Plate}) and n :: specfunc({Bind, Plate}) and
       (verify(m, n, 'Bind'(mv, true, true))
      or verify(m, n, 'Plate'(v, true, true))) then
      x := gensym(cat(op(2,m), "_", op(2,n), "_"));
      thisproc(subs(op(2,m)=x, op(3,m)),
               subs(op(2,n)=x, op(3,n)), v)
    elif m :: 'specfunc(Msum)' and n :: 'specfunc(Msum)'
         and nops(m) = nops(n) then
      k := nops(m);
      verify(k, GraphTheory[BipartiteMatching](GraphTheory[Graph]({
                seq(seq(`if`(thisproc(op(i,m), op(j,n), v), {i,-j}, NULL),
                        j=1..k), i=1..k)}))[1]);
    elif andmap(type, [m,n], 'specfunc(piecewise)') and nops(m) = nops(n) then
      k := nops(m);
      verify(m, n, 'piecewise'(seq(`if`(i::even or i=k, mv, hboolean), i=1..k)));

    elif andmap(type, [m,n], 'specfunc(PARTITION)') then
      Partition:-SamePartition(verify_hboolean, verify_measure, m, n);

    elif m :: specfunc('case') and
        verify(m, n, 'case'(v, specfunc(Branch(true, true), Branches))) then
      # This code unfortunately only handles alpha-equivalence for 'case' along
      # the control path -- not if 'case' occurs in the argument to 'Ret', say.
      k := nops(op(2,m));
      for i from 1 to k do
        j := pattern_equiv(op([2,i,1],m), op([2,i,1],n));
        if j = false then return j end if;
        j := map(proc(eq, $)
                   local x;
                   x := gensym(cat(lhs(eq), "_", rhs(eq), "_"));
                   [lhs(eq)=x, rhs(eq)=x]
                 end proc, j);
        j := thisproc(subs(map2(op,1,j), op([2,i,2],m)),
                      subs(map2(op,2,j), op([2,i,2],n)), v);
        if j = false then return j end if;
      end do;
      true
    elif m :: 'LO(name, anything)' and n :: 'LO(name, anything)' then
      x := gensym(cat(op(1,m), "_", op(1,n), "_"));
      verify(subs(op(1,m)=x, op(2,m)),
             subs(op(1,n)=x, op(2,n)), v)
    elif m :: specfunc('lam') and n :: specfunc('lam') and
        verify(m, n, 'lam'(true, v, true)) then
      # m and n are not even measures, but we verify them anyway...
      x := gensym(cat(op(1,m), "_", op(1,n), "_"));
      thisproc(subs(op(1,m)=x, op(2,m)),
               subs(op(1,n)=x, op(2,n)), v)
    else
      verify(m, n, {v, Ret(v), Weight(v, mv), Context(v, mv)})
    end if
  end proc;

  pattern_equiv := proc(p, q, $) :: {identical(false),set(`=`)};
    local r, s;
    if ormap((t->andmap(`=`, [p,q], t)), [PWild, PDone]) then
      {}
    elif andmap(type, [p,q], PVar(anything)) then
      {op(1,p)=op(1,q)}
    elif andmap(type, [p,q], PDatum(anything,anything)) and op(1,p)=op(1,q) then
      pattern_equiv(op(2,p),op(2,q))
    elif ormap((t->andmap(type, [p,q], t(anything))),
               [PInl, PInr, PKonst, PIdent]) then
      pattern_equiv(op(1,p),op(1,q))
    elif andmap(type, [p,q], PEt(anything, anything)) then
      r := pattern_equiv(op(1,p),op(1,q));
      s := pattern_equiv(op(2,p),op(2,q));
      if map(lhs,r) intersect map(lhs,s) = {} and
         map(rhs,r) intersect map(rhs,s) = {} then
        r union s
      else
        false
      end if
    else
      false
    end if
  end proc;

  piecewise_And := proc(cond::{list,set,specfunc(`And`),`and`}, th, el, $)
    if nops(cond) = 0 or th = el then
      th
    else
      piecewise(And(op(cond)), th, el)
    end if
  end proc;

  map_piecewiselike := proc(f, p::t_piecewiselike)
    local i, g, h;
    if p :: 'specfunc(piecewise)' then
      piecewise(seq(`if`(i::even or i=nops(p), f(op(i,p),_rest), op(i,p)),
                    i=1..nops(p)))
    elif p :: 't_case' then
      # Mind the hygiene
      subsindets(eval(subsop(2 = map[3](applyop, g, 2, op(2,p)), p),
                      g=h(f,_rest)),
                 'typefunc(specfunc(h))',
                 (e -> op([0,1],e)(op(1,e), op(2..-1,op(0,e)))))
    elif p :: 'idx(list, anything)' then
      idx(map(f,op(1,p),_rest), op(2,p))
    else
      error "map_piecewiselike: %1 is not t_piecewiselike", p
    end if
  end proc;

  lift_piecewise := proc(e, extra:={}, $)
    local e1, e2;
    e2 := e;
    while e1 <> e2 do
      e1 := e2;
      e2 := subsindets(e1,
              '{extra,
                And(`+`, Not(specop(Not(specfunc(piecewise)), `+`))),
                And(`*`, Not(specop(Not(specfunc(piecewise)), `*`))),
                And(`^`, Not(specop(Not(specfunc(piecewise)), `^`))),
                exp(specfunc(piecewise))}',
              lift1_piecewise)
    end do
  end proc;

  lift1_piecewise := proc(e, $)
    local i, p;
    if membertype(t_piecewiselike, [op(e)], i) then
      p := op(i,e);
      if nops(p) :: even and not (e :: `*`) and op(-1,p) <> 0 then
        p := piecewise(op(p), 0);
      end if;
      map_piecewiselike((arm->lift1_piecewise(subsop(i=arm,e))), p)
    else
      e
    end if
  end proc;

  foldr_piecewise := proc(cons, nil, pw, $) # pw may or may not be piecewise
    # View pw as a piecewise and foldr over its arms
    if pw :: 'specfunc(piecewise)' then
      foldr(proc(i,x) cons(op(i,pw), op(i+1,pw), x) end proc,
            `if`(nops(pw)::odd, cons(true, op(-1,pw), nil), nil),
            seq(1..nops(pw)-1, 2))
    else
      cons(true, pw, nil)
    end if
  end proc;

  #Take a piecewise: If some of the branches also contain piecewises, attempt
  #to re-express the whole as a single piecewise. In short: fewer piecewises, more
  #branches, more complex conditions.--Carl 2016Sep09
  flatten_piecewise:= proc(PW::specfunc(piecewise), $)::specfunc(piecewise);
  local
     pwL:= [op(PW)],
     nP:= nops(pwL),
     conds:= pwL[[seq(1..nP-1, 2)]],
     branches:= pwL[[seq(2..nP-1, 2), nP]],
     innerPW:= indets(branches, specfunc(piecewise)),
     outerPW, C_O, C_I, B_I, r
  ;
     if indets(conds, specfunc(piecewise)) <> {} then
          userinfo(2, procname, "Case of inner pw in a condition not yet handled.");
          return PW
     end if;
     if innerPW = {} then
          userinfo(3, procname, "No inner pw.");
          return PW
     end if;
     if nops~(innerPW) <> {3} then
          userinfo(2, procname, "Case of inner pw of other than 3 ops not yet handled.");
          return PW
     end if;
     if nops(PW) <> 3 then
          userinfo(2, procname, "Case of outer pw of other than 3 ops not yet handled.");
          return PW
     end if;
     outerPW:= applyop(lift_piecewise, {2,3}, PW);
     if membertype(
          And(
               satisfies(e-> indets(e, specfunc(piecewise)) <> {}),
               Not(specfunc(piecewise))
          ),
          {op(2..3, outerPW)}
     )
     then
          userinfo(1, procname, "Unliftable pw.");
          return PW
     end if;
     C_O:= op(1,outerPW);
     C_I:= map(e-> `if`(e::specfunc(piecewise), op(1,e), true), [op(2..3, outerPW)]);
     B_I:= map(e-> `if`(e::specfunc(piecewise), [op(2..3, e)], [e$2])[], [op(2..3, outerPW)]);
     #For debugging purposes, I want to show the proposed output before it's passed to
     #piecewise.
     r:= [
          And(C_O, C_I[1]), B_I[1],
          And(C_O, KB:-negate_rel(C_I[1])), B_I[2],
          And(KB:-negate_rel(C_O), C_I[2]), B_I[3],
          And(KB:-negate_rel(C_O), KB:-negate_rel(C_I[2])), B_I[4]
     ];
     userinfo(3, procname, "Proposed ouput: ", print(%piecewise(r[])));
     piecewise(r[])
  end proc;

  app := proc (func, argu, $)
    if func :: 'lam(name, anything, anything)' then
      eval(op(3,func), op(1,func)=argu)
    elif func :: 't_piecewiselike' then
      map_piecewiselike(procname, _passed)
    else
      'procname(_passed)'
    end if
  end proc;

  ary := proc (n, i, e, $)
    local j;
    if e :: 'idx'('freeof'(i), 'identical'(i)) then
      # Array eta-reduction. Assume the size matches.  (We should keep array
      # size information in the KB and use it here, but we don't currently.)
      op(1,e)
    elif n :: nonnegint then
      [seq(eval(e,i=j), j=0..n-1)] # Unroll array with literal size
    else
      'procname(_passed)'
    end if
  end proc;

  idx := proc (a, i, $)
    if a :: 'ary(anything, name, anything)' then
      eval(op(3,a), op(2,a)=i)
    elif a :: 'list' and i::nonnegint then
      a[i+1]
    elif a :: 'list' and nops(convert(a,'set')) = 1 then
      a[1] # Indexing into a literal array whose elements are all the same
    elif a :: 't_piecewiselike' then
      map_piecewiselike(procname, _passed)
    else
      'procname(_passed)'
    end if
  end proc;

  #Extract the first member of a Pair.
  fst:= proc(p, $)
    if p :: 'Pair'('anything'$2) then
      op(1,p)
    elif p :: t_piecewiselike then
      map_piecewiselike(fst, p)
    else
      'procname'(p)
    end if;
  end proc;

  #Extract the second member of a Pair.
  snd:= proc(p, $)
    if p :: 'Pair'('anything'$2) then
      op(2,p)
    elif p :: t_piecewiselike then
      map_piecewiselike(snd, p)
    else
      'procname'(p)
    end if;
  end proc;

  size := proc(a, $)
    local res;
    if a :: 'ary(anything, name, anything)' then
      op(1,a)
    elif a :: 'list' then
      nops(a)
    elif a :: 't_piecewiselike' then
      map_piecewiselike(procname, _passed)
    else
      'procname(_passed)'
    end if
  end proc;

  Datum := proc(hint, payload, $)
    # Further cheating to equate Maple booleans and Hakaru booleans
    if hint = true and payload = Inl(Done) or
       hint = false and payload = Inr(Inl(Done)) then
      hint
    else
      'procname(_passed)'
    end if
  end proc;

  closed_bounds := proc(r::range, $)
    Bound(`>=`, lhs(r)), Bound(`<=`, rhs(r))
  end proc;

  open_bounds := proc(r::range, $)
    Bound(`>`, lhs(r)), Bound(`<`, rhs(r))
  end proc;

  # Creates an N-ary operator `Plus` such:
  #  Plus(Plus(a,b),c)=Plus(a,Plus(a,b))
  #  Plus(a,Zero)=a
  #  Plus(a)=a
  #  Plus(x,x)=x
  Mk_Plus := proc(plus,zero,$) proc()
    local as := {args};
    as := map(a->if op(0,a)=plus then op(a) else a end if, as);
    if nops(as)=0 then zero
    elif nops(as)=1 then op(1,as)
    else plus(op(as))
    end if;
  end proc; end proc;

  # Replacements for `and` and `or` which do not
  # evaluate "x = y" to "false" when "x,y" are unbound vars.
  bool_And := Mk_Plus('And','true' );
  bool_Or  := Mk_Plus('Or' ,'false');

  bool_Not := proc(a,$)
    if a :: t_kb_atom then
      subsindets(KB:-negate_rel(a), `not`, Not@op);
    else
      Not(a)
    end if;
  end proc;

  # Enumerate patterns for a given Hakaru type
  htype_patterns := proc(t::t_type, $)
    :: specfunc(Branch(anything, list(t_type)), Branches);
    local struct;
    uses StringTools;
    if t :: specfunc(DatumStruct(anything, list(Konst(anything))), HData) then
      foldr(proc(struct,ps,$) Branches(
              op(map((p -> Branch(PDatum(op(1,struct), PInl(op(1,p))),
                                  op(2,p))),
                     foldr(proc(kt,qs,$)
                             local p, q;
                             Branches(seq(seq(Branch(PEt(PKonst(op(1,p)),
                                                         op(1,q)),
                                                     [op(op(2,p)),op(op(2,q))]),
                                              q in qs),
                                          p in htype_patterns(op(1,kt))))
                           end proc,
                           Branches(Branch(PDone, [])), op(op(2,struct))))),
              op(map[3](applyop, PInr, [1,2], ps)))
            end proc,
            Branches(), op(t))
    else
      Branches(Branch(PVar(gensym(convert(LowerCase(op(-1, ["x", op(
                                            `if`(t::function,
                                              select(IsUpper, Explode(op(0,t))),
                                              []))])),
                                          name))),
                      [t]))
    end if
  end proc;

  TYPES := table(
    [(`&implies` =
         'proc(e, t1, t2, $) type(e, Or(Not(t1), t2)) end proc')
    ,(Name = 'And(name, Not({constant,undefined}))')
    ,(known_continuous =
         ''{
              Lebesgue(anything, anything), Uniform(anything, anything),
              Gaussian(anything, anything), Cauchy(anything, anything),
              StudentT(anything, anything, anything), ChiSquared(anything),
              BetaD(anything, anything), GammaD(anything, anything),
              InverseGammaD(anything, anything)
         }''
    )
    ,(known_discrete =
         ''{
              Counting(anything, anything),
              Categorical(anything),
              Binomial(anything,anything),
              NegativeBinomial(anything,anything),
              PoissonD(anything)
          }''
    )
    #This type t_Hakaru is the basic syntax checker for that part of the
    #Maple/Hakaru language accessible by the external user.--Carl 2016Sep20
    ,(t_Hakaru =
         #Alternation/conjunction of types via {} or And follows the McCarthy
         #short-cut rule: Proceeding left to right, once satisfaction of the type
         #can be determined, the remaining elements aren't evaluated. Therefore,
         #recursive types are possible by placing the base cases at the beginning.
         #But use Or instead of {} because you can't control the order of
         #expressions with {}.
         'Or(
           'known_continuous', 'known_discrete',
           t_pw, #Needs to be more specific!
           t_partition,
           t_case,
          'Ret(anything)',
          'Bind(t_Hakaru, name, t_Hakaru)',
          'specfunc(t_Hakaru, Msum)',
          'Weight(algebraic, t_Hakaru)',
          'Plate(algebraic, name, t_Hakaru)',
          t_lam
         )'
    )
    ,(t_type =
     ''{specfunc(Bound(identical(`<`,`<=`,`>`,`>=`), anything),
                 {AlmostEveryReal, HReal, HInt}),
        specfunc(DatumStruct(anything, list({Konst(t_type), Ident(t_type)})),
                 HData),
        HMeasure(t_type),
        HArray(t_type),
        HFunction(t_type, t_type)}'')
    ,(t_case =
      ''case(anything, specfunc(Branch(anything, anything), Branches))'')
    ,(t_pw = ''specfunc(piecewise)'')
    ,(t_partition = ''specfunc(PARTITION)'') #Appropriate to put this here?
    ,(t_piecewiselike =
      ''{specfunc(piecewise), t_case, idx(list, anything)}'')
    ,(t_lam = ''lam(name, t_type, t_Hakaru)'')

    # A temporary type which should be removed when piecewise is gone
    ,(t_pw_or_part = 'Or(t_pw,t_partition)')
    ]);

  ModuleLoad := proc($)
    local g; #Iterator over thismodule's globals
    VerifyTools[AddVerification](measure = eval(verify_measure));
    VerifyTools[AddVerification](hboolean = eval(verify_hboolean));

    BindingTools:-load_types_from_table(TYPES);

    #Protect the keywords of the Hakaru language.
    #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 Hakaru keyword '%1' erased.", g);
         end if;
         protect(g)
    end do
  end proc;

  ModuleUnload := proc($)
    unprotect(op([2,6], thismodule)); #See comment in ModuleLoad.
    #Skip restoring the globals to any prior value they had.
  end proc;
  ModuleLoad();
end module; # Hakaru