injection of ReturnStatement into Closures now runs in a separate generator phase

<?xml version="1.0" encoding="UTF-8"?>
<language namespace="com.mbeddr.core.modules" uuid="6d11763d-483d-4b2b-8efc-09336c1b0001">
  <models>
    <modelRoot contentPath="${module}" type="default">
      <sourceRoot location="languageModels" />
      <sourceRoot location="languageAccessories" />
    </modelRoot>
  </models>
  <accessoryModels>
    <model modelUID="r:ce8731ad-eb56-4f64-b455-5499b4e64857(com.mbddr.core.buildconfig.pluginSolution.plugin)" />
  </accessoryModels>
  <generators>
    <generator name="main" generatorUID="com.mbeddr.core.modules#1758019824472891829" uuid="53c31cc6-9e98-4153-905a-a7b5c490ea53">
      <models>
        <modelRoot contentPath="${module}" type="default">
          <sourceRoot location="generator/template" />
        </modelRoot>
      </models>
      <external-templates>
        <generator generatorUID="be090156-a678-454c-bd8f-89ebd4a0e6af(com.mbeddr.core.modules.gen#1758019824472882132)" />
      </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>6d11763d-483d-4b2b-8efc-09336c1b0001(com.mbeddr.core.modules)</usedLanguage>
        <usedLanguage>3bf5377a-e904-4ded-9754-5a516023bfaa(com.mbeddr.core.pointers)</usedLanguage>
        <usedLanguage>a9d69647-0840-491e-bf39-2eb0805d2011(com.mbeddr.core.statements)</usedLanguage>
        <usedLanguage>63e0e566-5131-447e-90e3-12ea330e1a00(com.mbeddr.mpsutil.blutil)</usedLanguage>
        <usedLanguage>79685937-8b0a-4e7d-8f8c-0888f1581774(com.mbeddr.mpsutil.nodeviewer)</usedLanguage>
        <usedLanguage>b4d28e19-7d2d-47e9-943e-3a41f97a0e52(com.mbeddr.mpsutil.plantuml.node)</usedLanguage>
        <usedLanguage>92d2ea16-5a42-4fdf-a676-c7604efe3504(de.slisson.mps.richtext)</usedLanguage>
        <usedLanguage>ed6d7656-532c-4bc2-81d1-af945aeb8280(jetbrains.mps.baseLanguage.blTypes)</usedLanguage>
        <usedLanguage>443f4c36-fcf5-4eb6-9500-8d06ed259e3e(jetbrains.mps.baseLanguage.classifiers)</usedLanguage>
        <usedLanguage>63650c59-16c8-498a-99c8-005c7ee9515d(jetbrains.mps.lang.access)</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>13744753-c81f-424a-9c1b-cf8943bf4e86(jetbrains.mps.lang.sharedConcepts)</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>
        <usedDevKit>2677cb18-f558-4e33-bc38-a5139cee06dc(jetbrains.mps.devkit.language-design)</usedDevKit>
      </usedDevKits>
      <mapping-priorities>
        <mapping-priority-rule kind="strictly_before">
          <greater-priority-mapping>
            <generator generatorUID="53c31cc6-9e98-4153-905a-a7b5c490ea53(com.mbeddr.core.modules#1758019824472891829)" />
            <external-mapping>
              <all-local-mappings />
            </external-mapping>
          </greater-priority-mapping>
          <lesser-priority-mapping>
            <generator generatorUID="be090156-a678-454c-bd8f-89ebd4a0e6af(com.mbeddr.core.modules.gen#1758019824472882132)" />
            <external-mapping>
              <mapping-node modelUID="r:5f62df63-885f-42f0-80d6-e13ad6c51489(com.mbeddr.core.modules.gen.generator.template.main@generator)" nodeID="1758019824472882133" />
            </external-mapping>
          </lesser-priority-mapping>
        </mapping-priority-rule>
        <mapping-priority-rule kind="strictly_before">
          <greater-priority-mapping>
            <generator generatorUID="53c31cc6-9e98-4153-905a-a7b5c490ea53(com.mbeddr.core.modules#1758019824472891829)" />
            <external-mapping>
              <mapping-node modelUID="r:2ff3ad32-451f-46a7-91af-9ce87f286536(com.mbeddr.core.modules.generator.main.addReturnToClosure@generator)" nodeID="8915003362270206598" />
            </external-mapping>
          </greater-priority-mapping>
          <lesser-priority-mapping>
            <generator generatorUID="53c31cc6-9e98-4153-905a-a7b5c490ea53(com.mbeddr.core.modules#1758019824472891829)" />
            <external-mapping>
              <mapping-node modelUID="r:638e4431-d4fb-45ee-8ca9-e546a9462bf7(com.mbeddr.core.modules.generator.template.main@generator)" nodeID="1758019824472891830" />
            </external-mapping>
          </lesser-priority-mapping>
        </mapping-priority-rule>
      </mapping-priorities>
    </generator>
  </generators>
  <sourcePath />
  <dependencies>
    <dependency reexport="false">3f233e7f-b8a6-46d2-a57f-795d56775243(Annotations)</dependency>
    <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">d4280a54-f6df-4383-aa41-d1b2bffa7eb1(com.mbeddr.core.base)</dependency>
    <dependency reexport="false">223dd778-c44f-4ef3-9535-7aa7d12244a6(com.mbeddr.core.debug)</dependency>
    <dependency reexport="false">63e0e566-5131-447e-90e3-12ea330e1a00(com.mbeddr.mpsutil.blutil)</dependency>
    <dependency reexport="false">cb5fd060-a6fb-423f-827a-02ea829501c8(com.mbeddt.core.expressions.pluginSolution)</dependency>
    <dependency reexport="false">f3061a53-9226-4cc5-a443-f952ceaf5816(jetbrains.mps.baseLanguage)</dependency>
    <dependency reexport="false">2af156ab-65c1-4a62-bd0d-ea734f71eab6(jetbrains.mps.dataFlow.runtime)</dependency>
    <dependency reexport="false">cc7da2f6-419f-4133-a811-31fcd3295a85(jetbrains.mps.debugger.api.api)</dependency>
    <dependency reexport="false">8d29d73f-ed99-4652-ae0a-083cdfe53c34(jetbrains.mps.ide.platform)</dependency>
    <dependency reexport="false">2d3c70e9-aab2-4870-8d8d-6036800e4103(jetbrains.mps.kernel)</dependency>
    <dependency reexport="false">b401a680-8325-4110-8fd3-84331ff25bef(jetbrains.mps.lang.generator)</dependency>
    <dependency reexport="false">9ded098b-ad6a-4657-bfd9-48636cfe8bc3(jetbrains.mps.lang.traceable)</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>
  </dependencies>
  <usedLanguages>
    <usedLanguage>d4280a54-f6df-4383-aa41-d1b2bffa7eb1(com.mbeddr.core.base)</usedLanguage>
    <usedLanguage>223dd778-c44f-4ef3-9535-7aa7d12244a6(com.mbeddr.core.debug)</usedLanguage>
    <usedLanguage>ebb5e132-d298-4649-b320-b3f4d7f3acff(com.mbeddr.core.debug.blext)</usedLanguage>
    <usedLanguage>61c69711-ed61-4850-81d9-7714ff227fb0(com.mbeddr.core.expressions)</usedLanguage>
    <usedLanguage>3bf5377a-e904-4ded-9754-5a516023bfaa(com.mbeddr.core.pointers)</usedLanguage>
    <usedLanguage>a9d69647-0840-491e-bf39-2eb0805d2011(com.mbeddr.core.statements)</usedLanguage>
    <usedLanguage>63e0e566-5131-447e-90e3-12ea330e1a00(com.mbeddr.mpsutil.blutil)</usedLanguage>
    <usedLanguage>c3bfea76-7bba-4f0e-b5a2-ff4e7a8d7cf1(com.mbeddr.mpsutil.spreferences)</usedLanguage>
    <usedLanguage>2e589a6f-51c3-423f-8ea2-0d769a5cc288(com.mbeddr.mpsutil.typsystem.trace)</usedLanguage>
    <usedLanguage>f89904fb-9486-43a1-865e-5ad0375a8a88(de.itemis.mps.editor.bool)</usedLanguage>
    <usedLanguage>ed6d7656-532c-4bc2-81d1-af945aeb8280(jetbrains.mps.baseLanguage.blTypes)</usedLanguage>
    <usedLanguage>443f4c36-fcf5-4eb6-9500-8d06ed259e3e(jetbrains.mps.baseLanguage.classifiers)</usedLanguage>
    <usedLanguage>f2801650-65d5-424e-bb1b-463a8781b786(jetbrains.mps.baseLanguage.javadoc)</usedLanguage>
    <usedLanguage>96ee7a94-411d-4cf8-9b94-96cad7e52411(jetbrains.mps.baseLanguage.jdk7)</usedLanguage>
    <usedLanguage>63650c59-16c8-498a-99c8-005c7ee9515d(jetbrains.mps.lang.access)</usedLanguage>
    <usedLanguage>af65afd8-f0dd-4942-87d9-63a55f2a9db1(jetbrains.mps.lang.behavior)</usedLanguage>
    <usedLanguage>18bc6592-03a6-4e29-a83a-7ff23bde13ba(jetbrains.mps.lang.editor)</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>
    <usedDevKit>2677cb18-f558-4e33-bc38-a5139cee06dc(jetbrains.mps.devkit.language-design)</usedDevKit>
  </usedDevKits>
  <extendedLanguages>
    <extendedLanguage>3bf5377a-e904-4ded-9754-5a516023bfaa(com.mbeddr.core.pointers)</extendedLanguage>
    <extendedLanguage>a9d69647-0840-491e-bf39-2eb0805d2011(com.mbeddr.core.statements)</extendedLanguage>
    <extendedLanguage>61c69711-ed61-4850-81d9-7714ff227fb0(com.mbeddr.core.expressions)</extendedLanguage>
    <extendedLanguage>ceab5195-25ea-4f22-9b92-103b95ca8c0c(jetbrains.mps.lang.core)</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>
  </extendedLanguages>
</language>

<?xml version="1.0" encoding="UTF-8"?>
<language namespace="com.mbeddr.core.modules" uuid="6d11763d-483d-4b2b-8efc-09336c1b0001">
  <models>
    <modelRoot contentPath="${module}" type="default">
      <sourceRoot location="languageModels" />
      <sourceRoot location="languageAccessories" />
    </modelRoot>
  </models>
  <accessoryModels>
    <model modelUID="r:ce8731ad-eb56-4f64-b455-5499b4e64857(com.mbddr.core.buildconfig.pluginSolution.plugin)" />
  </accessoryModels>
  <generators>
    <generator name="main" generatorUID="com.mbeddr.core.modules#1758019824472891829" uuid="53c31cc6-9e98-4153-905a-a7b5c490ea53">
      <models>
        <modelRoot contentPath="${module}" type="default">
          <sourceRoot location="generator/template" />
        </modelRoot>
      </models>
      <external-templates>
        <generator generatorUID="be090156-a678-454c-bd8f-89ebd4a0e6af(com.mbeddr.core.modules.gen#1758019824472882132)" />
      </external-templates>
      <usedLanguages>
        <usedLanguage>61c69711-ed61-4850-81d9-7714ff227fb0(com.mbeddr.core.expressions)</usedLanguage>
        <usedLanguage>6d11763d-483d-4b2b-8efc-09336c1b0001(com.mbeddr.core.modules)</usedLanguage>
        <usedLanguage>a9d69647-0840-491e-bf39-2eb0805d2011(com.mbeddr.core.statements)</usedLanguage>
        <usedLanguage>63e0e566-5131-447e-90e3-12ea330e1a00(com.mbeddr.mpsutil.blutil)</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>13744753-c81f-424a-9c1b-cf8943bf4e86(jetbrains.mps.lang.sharedConcepts)</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>
        <usedDevKit>2677cb18-f558-4e33-bc38-a5139cee06dc(jetbrains.mps.devkit.language-design)</usedDevKit>
      </usedDevKits>
      <mapping-priorities>
        <mapping-priority-rule kind="strictly_before">
          <greater-priority-mapping>
            <generator generatorUID="53c31cc6-9e98-4153-905a-a7b5c490ea53(com.mbeddr.core.modules#1758019824472891829)" />
            <external-mapping>
              <all-local-mappings />
            </external-mapping>
          </greater-priority-mapping>
          <lesser-priority-mapping>
            <generator generatorUID="be090156-a678-454c-bd8f-89ebd4a0e6af(com.mbeddr.core.modules.gen#1758019824472882132)" />
            <external-mapping>
              <mapping-node modelUID="r:5f62df63-885f-42f0-80d6-e13ad6c51489(com.mbeddr.core.modules.gen.generator.template.main@generator)" nodeID="1758019824472882133" />
            </external-mapping>
          </lesser-priority-mapping>
        </mapping-priority-rule>
      </mapping-priorities>
    </generator>
  </generators>
  <sourcePath />
  <dependencies>
    <dependency reexport="false">3f233e7f-b8a6-46d2-a57f-795d56775243(Annotations)</dependency>
    <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">d4280a54-f6df-4383-aa41-d1b2bffa7eb1(com.mbeddr.core.base)</dependency>
    <dependency reexport="false">223dd778-c44f-4ef3-9535-7aa7d12244a6(com.mbeddr.core.debug)</dependency>
    <dependency reexport="false">63e0e566-5131-447e-90e3-12ea330e1a00(com.mbeddr.mpsutil.blutil)</dependency>
    <dependency reexport="false">cb5fd060-a6fb-423f-827a-02ea829501c8(com.mbeddt.core.expressions.pluginSolution)</dependency>
    <dependency reexport="false">f3061a53-9226-4cc5-a443-f952ceaf5816(jetbrains.mps.baseLanguage)</dependency>
    <dependency reexport="false">2af156ab-65c1-4a62-bd0d-ea734f71eab6(jetbrains.mps.dataFlow.runtime)</dependency>
    <dependency reexport="false">cc7da2f6-419f-4133-a811-31fcd3295a85(jetbrains.mps.debugger.api.api)</dependency>
    <dependency reexport="false">8d29d73f-ed99-4652-ae0a-083cdfe53c34(jetbrains.mps.ide.platform)</dependency>
    <dependency reexport="false">2d3c70e9-aab2-4870-8d8d-6036800e4103(jetbrains.mps.kernel)</dependency>
    <dependency reexport="false">b401a680-8325-4110-8fd3-84331ff25bef(jetbrains.mps.lang.generator)</dependency>
    <dependency reexport="false">9ded098b-ad6a-4657-bfd9-48636cfe8bc3(jetbrains.mps.lang.traceable)</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>
  </dependencies>
  <usedLanguages>
    <usedLanguage>d4280a54-f6df-4383-aa41-d1b2bffa7eb1(com.mbeddr.core.base)</usedLanguage>
    <usedLanguage>223dd778-c44f-4ef3-9535-7aa7d12244a6(com.mbeddr.core.debug)</usedLanguage>
    <usedLanguage>ebb5e132-d298-4649-b320-b3f4d7f3acff(com.mbeddr.core.debug.blext)</usedLanguage>
    <usedLanguage>61c69711-ed61-4850-81d9-7714ff227fb0(com.mbeddr.core.expressions)</usedLanguage>
    <usedLanguage>3bf5377a-e904-4ded-9754-5a516023bfaa(com.mbeddr.core.pointers)</usedLanguage>
    <usedLanguage>a9d69647-0840-491e-bf39-2eb0805d2011(com.mbeddr.core.statements)</usedLanguage>
    <usedLanguage>63e0e566-5131-447e-90e3-12ea330e1a00(com.mbeddr.mpsutil.blutil)</usedLanguage>
    <usedLanguage>c3bfea76-7bba-4f0e-b5a2-ff4e7a8d7cf1(com.mbeddr.mpsutil.spreferences)</usedLanguage>
    <usedLanguage>2e589a6f-51c3-423f-8ea2-0d769a5cc288(com.mbeddr.mpsutil.typsystem.trace)</usedLanguage>
    <usedLanguage>f89904fb-9486-43a1-865e-5ad0375a8a88(de.itemis.mps.editor.bool)</usedLanguage>
    <usedLanguage>ed6d7656-532c-4bc2-81d1-af945aeb8280(jetbrains.mps.baseLanguage.blTypes)</usedLanguage>
    <usedLanguage>443f4c36-fcf5-4eb6-9500-8d06ed259e3e(jetbrains.mps.baseLanguage.classifiers)</usedLanguage>
    <usedLanguage>f2801650-65d5-424e-bb1b-463a8781b786(jetbrains.mps.baseLanguage.javadoc)</usedLanguage>
    <usedLanguage>96ee7a94-411d-4cf8-9b94-96cad7e52411(jetbrains.mps.baseLanguage.jdk7)</usedLanguage>
    <usedLanguage>63650c59-16c8-498a-99c8-005c7ee9515d(jetbrains.mps.lang.access)</usedLanguage>
    <usedLanguage>af65afd8-f0dd-4942-87d9-63a55f2a9db1(jetbrains.mps.lang.behavior)</usedLanguage>
    <usedLanguage>18bc6592-03a6-4e29-a83a-7ff23bde13ba(jetbrains.mps.lang.editor)</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>
    <usedDevKit>2677cb18-f558-4e33-bc38-a5139cee06dc(jetbrains.mps.devkit.language-design)</usedDevKit>
  </usedDevKits>
  <extendedLanguages>
    <extendedLanguage>3bf5377a-e904-4ded-9754-5a516023bfaa(com.mbeddr.core.pointers)</extendedLanguage>
    <extendedLanguage>a9d69647-0840-491e-bf39-2eb0805d2011(com.mbeddr.core.statements)</extendedLanguage>
    <extendedLanguage>61c69711-ed61-4850-81d9-7714ff227fb0(com.mbeddr.core.expressions)</extendedLanguage>
    <extendedLanguage>ceab5195-25ea-4f22-9b92-103b95ca8c0c(jetbrains.mps.lang.core)</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>
  </extendedLanguages>
</language>


Change a desired output; the old expected value is not necessarily wrong but we want this piecewise inside the weight

kernelopts(assertlevel=2): # be strict on all assertions while testing
kernelopts(opaquemodules=false): # allow testing of internal routines
if not (NewSLO :: `module`) then
  WARNING("loading NewSLO failed");
  `quit`(3);
end if;

with(Hakaru):
with(NewSLO):
with(TestWrapper):
with(Partition):

#####################################################################
#
# disintegration tests
#
#####################################################################

# this uses a *global* name 't'.
# assume(t::real);
`t`:

TestDisint := MakeTest(
 proc(
  M::{t_Hakaru, list({algebraic, name=list})}, #args to disint, or just 1st arg
  n::set({t_Hakaru, identical(NULL)}), #desired return
  {ctx::list:= []}, #context: assumptions, "knowledge"
  {TLim::{positive, identical(-1)}:= 80} #timelimit
)
  local m;
  m:= `if`(M::list, M, [M, :-t])[], :-ctx= ctx;

  timelimit(
       TLim,
       CodeTools[Test]({disint(m)}, n, '`subset`(measure(simplify))', _rest)
  );
end proc
 , testGroup = "Disint" ):

# End of the possibly statistically meaningless tests.

d1 := Bind(Lebesgue(-infinity,infinity), x, Ret(Pair(-5*x,3/x))):
d1r := {Weight(1/5,Ret(-15/t))}:

# should try d2 with 1/c as well
d2 := Bind(Lebesgue(-infinity,infinity), x, Ret(Pair((-1/7)*x-1,3))):
d2r := {Weight(7, Ret(3))}:

#The next two tests are simplified versions of the Borel-Kolmogorov paradox.
#https://en.wikipedia.org/wiki/Borel-Kolmogorov_paradox
d3 := Bind(Uniform(0,1), x, Bind(Uniform(0,1), y, Ret(Pair(x-y,f(x,y))))):
d3r := {
  PARTITION([Piece(t <= -1
                  ,Msum())
            ,Piece(t <= 0 and -1 < t
                  ,Weight(t+1,Bind(Uniform(-t,1),`y`,Ret(f(t+`y`,`y`)))))
            ,Piece(t <= 1 and 0 < t
                  ,Weight(1-t,Bind(Uniform(0,1-t),`y`,Ret(f(t+`y`,`y`)))))
            ,Piece(1 < t
                  ,Msum())
            ]) ,
  PARTITION([Piece(t <= -1
                  ,Msum())
            ,Piece(t <= 0 and -1 < t
                  ,Weight(t+1,Bind(Uniform(0,t+1),`x`,Ret(f(`x`,-t+`x`)))))
            ,Piece(t <= 1 and 0 < t
                  ,Weight(1-t,Bind(Uniform(t,1),`x`,Ret(f(`x`,-t+`x`)))))
            ,Piece(1 < t,Msum())
            ])
}:

d4 := Bind(Uniform(0,1), x, Bind(Uniform(0,1), y, Ret(Pair(x/y,x)))):
d4r := {
  Weight(1/abs(t)^2,
    Bind(Uniform(0,1),x,
         piecewise(x < t,Weight(x,Ret(x)),Msum()))),
  piecewise(0 < t,
    Bind(Uniform(0,1),y,
         piecewise(t < 1/y,
           Weight(y,Ret(t*y)),
           Msum())),
    Msum()),
  PARTITION([Piece(t <  0,Msum())
           , Piece(t =  0,undefined)
           , Piece(t <= 1 and 0 < t,Weight(1/t,Bind(Uniform(0,t),x,Weight(x,Ret(x)))))
           , Piece(1 < t,Weight(1/2/t^2,BetaD(2,1)))])
}:

d5 := Bind(Gaussian(0,1), x, Bind(Gaussian(x,1), y, Ret(Pair(y,x)))):
d5r := {Weight((1/2)*exp(-(1/4)*t^2)/Pi^(1/2), Gaussian((1/2)*t, (1/2)*2^(1/2)))}:

d6 := Bind(Gaussian(0,1), x, Bind(Gaussian(x,1), y, Ret(Pair(x,y)))):
d6r := {Weight(1/2*2^(1/2)/Pi^(1/2)*exp(-1/2*t^2),Gaussian(t,1))}:

# note (y+y), which gives trouble for a syntactic approach
normalFB1 :=
  Bind(Gaussian(0,1), x,
  Bind(Gaussian(x,1), y,
  Ret(Pair((y+y)+x, _Unit)))):

normalFB1r := {Weight(1/26*exp(-1/26*t^2)/Pi^(1/2)*13^(1/2)*2^(1/2),Ret(_Unit))}:

# tests taken from haskell/Tests/Disintegrate.hs
# use same names, to be clearer
norm0a :=
  Bind(Gaussian(0,1), x,
  Bind(Gaussian(x,1), y,
  Ret(Pair(y, x)))):
  # note that the answer below is much nicer than the one expected in Haskell
norm0r := {Weight(1/2*exp(-1/4*t^2)/Pi^(1/2),Gaussian(t/2,sqrt(2)/2))}:

norm1a :=
  Bind(Gaussian(3,2), x,Ret(piecewise(x<0, Pair(-x, _Unit), Pair(x, _Unit)))):
norm1b :=
  Bind(Gaussian(3,2), x,piecewise(x<0, Ret(Pair(-x, _Unit)), Ret(Pair(x, _Unit)))):

norm1r_w := (1/4)*sqrt(2)*exp(-9/8)*((exp(t))^(3/4)/(exp(t^2))^(1/8)+1/((exp(t^2))^(1/8)*(exp(t))^(3/4)))/sqrt(Pi):
norm1r := {
  Weight( piecewise(t < 0  , 0
                   ,0 <= t , norm1r_w
                   )
        , Ret(_Unit)
        ) ,
  Weight( PARTITION([Piece(t < 0  , 0)
                    ,Piece(0 <= t , norm1r_w)
                   ])
        , Ret(_Unit)
        )
}:

assume(s::real, noiseT >= 3, noiseT <= 8, noiseE >= 1, noiseE <= 8);
easyRoad:= [
  Bind(Uniform(3, 8), noiseT,
  Bind(Uniform(1, 4), noiseE,
  Bind(Gaussian(0, noiseT), x1,
  Bind(Gaussian(x1, noiseE), m1,
  Bind(Gaussian(x1, noiseT), x2,
  Bind(Gaussian(x2, noiseE), m2,
  Ret(Pair(Pair(m1,m2), Pair(noiseT,noiseE)))
  )))))),
  Pair(s,t)
]:
#The first expression below comes from the actual output of disint, hand-
#simplified 1) to bring factors into the innnermost integral, 2) to combine
#products of exps, and 3) to express the polynomial arg of exp in a logical way
#by sub-factoring.
easyRoadr:= {
  Weight(                #Weight 1
    Pi/8,
    Bind(                #Bind 1
      Uniform(3, 8), noiseT,
      Weight(            #Weight 2
        1/noiseT^2,
        Bind(            #Bind 2
          Uniform(1, 4), noiseE,
          Weight(        #Weight 3
            int(         #Int 1
              int(       #Int 2
                exp(
                  -(x2^2/2 - x1*x2 + x1^2)/noiseT^2 -
                  ((t-x2)^2 + (s-x1)^2)/noiseE^2
                )*2/Pi/noiseE,
                x2= -infinity..infinity
              ),         #-Int 2
              x1= -infinity..infinity
            ),           #-Int 1
            Ret(Pair(noiseT, noiseE))
          )              #-Weight 3
        )                #-Bind 2
      )                  #-Weight 2
    )                    #-Bind 1
  ),                     #-Weight 1

  #Hopefully, that's equivalent to...
  Bind(Uniform(3, 8), noiseT,
  Bind(Uniform(1, 4), noiseE,
  Bind(Gaussian(0, noiseT), x1,
  Bind(Weight(density[Gaussian](x1, noiseE)(s), Ret(_Unit)), _,
  Bind(Gaussian(x1, noiseT), x2,
  Weight(density[Gaussian](x2, noiseE)(t), Ret(Pair(noiseT, noiseE)))
  )))))
}:
helloWorld:= [
  Bind(Gaussian(0,1), mu,
  Bind(Plate(n, k, Gaussian(mu, 1)), nu,
  Ret(Pair(nu, mu))
  )),
  :-t,
  ctx= [n::integer, n > 0]
]:
helloWorldr:= {
  Bind(Gaussian(0,1), mu,
  Plate(n, i, Weight(density[Gaussian](mu, 1)(idx(t,i)), Ret(mu)))
  )
}:

#This first block of tests is to test the basic functionality of disint, and,
#to some extent, the system as a whole. These tests may be meaningless to you,
#the statistician and end user of this Hakaru product; they aren't meant to
#have any statistical meaning.--Carl 2016Oct04

TestDisint(
     [Ret(Pair(sqrt(Pi), x)), t &M Ret(7)],
     {Msum()},
     label= "(d0_2) `Dirac` test 1"
);

TestDisint(
     [Ret(Pair(sqrt(Pi), x^2)), t &M Ret(sqrt(Pi))],
     {Ret(x^2)},
     label= "(d0_3) `Dirac` test 2"
);

TestDisint(
     [Bind(Lebesgue((-1,1)*~infinity), x, Ret(Pair(sqrt(Pi), x^2))),
      t &M Ret(sqrt(Pi))
     ],
     {Bind(Lebesgue((-1,1)*~infinity), x1, Ret(x1^2))},
     label= "(d0_4) `Dirac` test with `Bind`"
);

TestDisint(d1, d1r, label = "(d1) Disintegrate linear function");
TestDisint(d2, d2r, label = "(d2) Disintegrate linear function II");
TestDisint(d5, d5r, label = "(d5) Disintegrate N(0,1)*N(x,1), over y");
TestDisint(d6, d6r, label = "(d6) Disintegrate N(0,1)*N(x,1), over x");
TestDisint(norm0a, norm0r,
     label = "(norm0a) U(0,1) >>= \x -> U(x,1) >>= \y -> Ret(y,x)"
);

## This one is kind of cosmetic; it would be 'fixed' properly if the
## disintegration process did not use 'improve' to do "domain information
## discovery", but rather had a specific function (and then improve could
## indeed do this integral).
# should work now
TestDisint( normalFB1, normalFB1r,
     label = "(d7_normalFB1) Disintegrate N(0,1)*N(x,1), over (y+y)+x"
            );

######################################################################
#
# These tests fail, and are expected to.  Move them up when they
# start passing (and are expected to).
#
# They are, however, roughly in order of what we'd like to have work.
#

# change of variables
TestDisint(d3, d3r, label = "(d3) Disintegrate U(0,1) twice, over x-y");
TestDisint(d4, d4r, label = "(d4) Disintegrate U(0,1) twice, over x/y");

# funky piecewise
TestDisint(norm1a, norm1r,
     label = "(norm1a) U(0,1) into Ret of pw"
);
TestDisint(norm1b, norm1r,
     label = "(norm1b) U(0,1) into pw of Ret"
);
#In this one the function in the inequality, x+x^3, is injective but nonlinear.
TestDisint(
     Bind(Gaussian(0,1), x, Ret(Pair(x+x^3, f(x)))),
     {}, #I don't know what to expect.
     label= "(d0_5) Injective nonlinear inequality"
);
# takes too long.
TestDisint(
     easyRoad, easyRoadr,
     label= "(easyRoad) Combo of Normals with distinct Uniform noises",
     TLim= 5 #takes 6 - 8 minutes to `improve` on an Intel i7
);

#This one is a basic test of the Counting wrt-var type.
#This one gives the Weight(-1, ...) error
assume(n_, integer);
TestDisint(
     [Bind(PoissonD(2), n, Ret(Pair(3,n))), n_ &M Counting((-1,1)*~infinity)],
     {},  #I don't know what to expect.
     ctx= [n::integer, n >= 0],
     label= "(d0_1) `Counting` test; `Weight` bug (currently failing)"
);

TestDisint(
     helloWorld, helloWorldr,
     label= "(helloWorld) Plate of Normals",
     ctx= [n::integer, n > 0]
);

kernelopts(assertlevel=2): # be strict on all assertions while testing
kernelopts(opaquemodules=false): # allow testing of internal routines
if not (NewSLO :: `module`) then
  WARNING("loading NewSLO failed");
  `quit`(3);
end if;

with(Hakaru):
with(NewSLO):
with(TestWrapper):
with(Partition):

#####################################################################
#
# disintegration tests
#
#####################################################################

# this uses a *global* name 't'.
# assume(t::real);
`t`:

TestDisint := MakeTest(
 proc(
  M::{t_Hakaru, list({algebraic, name=list})}, #args to disint, or just 1st arg
  n::set({t_Hakaru, identical(NULL)}), #desired return
  {ctx::list:= []}, #context: assumptions, "knowledge"
  {TLim::{positive, identical(-1)}:= 80} #timelimit
)
  local m;
  m:= `if`(M::list, M, [M, :-t])[], :-ctx= ctx;

  timelimit(
       TLim,
       CodeTools[Test]({disint(m)}, n, '`subset`(measure(simplify))', _rest)
  );
end proc
 , testGroup = "Disint" ):

# End of the possibly statistically meaningless tests.

d1 := Bind(Lebesgue(-infinity,infinity), x, Ret(Pair(-5*x,3/x))):
d1r := {Weight(1/5,Ret(-15/t))}:

# should try d2 with 1/c as well
d2 := Bind(Lebesgue(-infinity,infinity), x, Ret(Pair((-1/7)*x-1,3))):
d2r := {Weight(7, Ret(3))}:

#The next two tests are simplified versions of the Borel-Kolmogorov paradox.
#https://en.wikipedia.org/wiki/Borel-Kolmogorov_paradox
d3 := Bind(Uniform(0,1), x, Bind(Uniform(0,1), y, Ret(Pair(x-y,f(x,y))))):
d3r := {
  PARTITION([Piece(t <= -1
                  ,Msum())
            ,Piece(t <= 0 and -1 < t
                  ,Weight(t+1,Bind(Uniform(-t,1),`y`,Ret(f(t+`y`,`y`)))))
            ,Piece(t <= 1 and 0 < t
                  ,Weight(1-t,Bind(Uniform(0,1-t),`y`,Ret(f(t+`y`,`y`)))))
            ,Piece(1 < t
                  ,Msum())
            ]) ,
  PARTITION([Piece(t <= -1
                  ,Msum())
            ,Piece(t <= 0 and -1 < t
                  ,Weight(t+1,Bind(Uniform(0,t+1),`x`,Ret(f(`x`,-t+`x`)))))
            ,Piece(t <= 1 and 0 < t
                  ,Weight(1-t,Bind(Uniform(t,1),`x`,Ret(f(`x`,-t+`x`)))))
            ,Piece(1 < t,Msum())
            ])
}:

d4 := Bind(Uniform(0,1), x, Bind(Uniform(0,1), y, Ret(Pair(x/y,x)))):
d4r := {
  Weight(1/abs(t)^2,
    Bind(Uniform(0,1),x,
         piecewise(x < t,Weight(x,Ret(x)),Msum()))),
  piecewise(0 < t,
    Bind(Uniform(0,1),y,
         piecewise(t < 1/y,
           Weight(y,Ret(t*y)),
           Msum())),
    Msum()),
  PARTITION([Piece(t <  0,Msum())
           , Piece(t =  0,undefined)
           , Piece(t <= 1 and 0 < t,Weight(1/t,Bind(Uniform(0,t),x,Weight(x,Ret(x)))))
           , Piece(1 < t,Weight(1/2/t^2,BetaD(2,1)))])
}:

d5 := Bind(Gaussian(0,1), x, Bind(Gaussian(x,1), y, Ret(Pair(y,x)))):
d5r := {Weight((1/2)*exp(-(1/4)*t^2)/Pi^(1/2), Gaussian((1/2)*t, (1/2)*2^(1/2)))}:

d6 := Bind(Gaussian(0,1), x, Bind(Gaussian(x,1), y, Ret(Pair(x,y)))):
d6r := {Weight(1/2*2^(1/2)/Pi^(1/2)*exp(-1/2*t^2),Gaussian(t,1))}:

# note (y+y), which gives trouble for a syntactic approach
normalFB1 :=
  Bind(Gaussian(0,1), x,
  Bind(Gaussian(x,1), y,
  Ret(Pair((y+y)+x, _Unit)))):

normalFB1r := {Weight(1/26*exp(-1/26*t^2)/Pi^(1/2)*13^(1/2)*2^(1/2),Ret(_Unit))}:

# tests taken from haskell/Tests/Disintegrate.hs
# use same names, to be clearer
norm0a :=
  Bind(Gaussian(0,1), x,
  Bind(Gaussian(x,1), y,
  Ret(Pair(y, x)))):
  # note that the answer below is much nicer than the one expected in Haskell
norm0r := {Weight(1/2*exp(-1/4*t^2)/Pi^(1/2),Gaussian(t/2,sqrt(2)/2))}:

norm1a :=
  Bind(Gaussian(3,2), x,Ret(piecewise(x<0, Pair(-x, _Unit), Pair(x, _Unit)))):
norm1b :=
  Bind(Gaussian(3,2), x,piecewise(x<0, Ret(Pair(-x, _Unit)), Ret(Pair(x, _Unit)))):

norm1r := {
  piecewise(t < 0 , Weight(0, Ret(_Unit))
           ,0 <= t, Weight((1/4)*sqrt(2)*exp(-9/8)*((exp(t))^(3/4)/(exp(t^2))^(1/8)+1/((exp(t^2))^(1/8)*(exp(t))^(3/4)))/sqrt(Pi)
                          , Ret(_Unit))) ,
  PARTITION([Piece(t < 0 , Weight(0, Ret(_Unit)))
            ,Piece(0 <= t, Weight((1/4)*sqrt(2)*exp(-9/8)*((exp(t))^(3/4)/(exp(t^2))^(1/8)+1/((exp(t^2))^(1/8)*(exp(t))^(3/4)))/sqrt(Pi)
                          , Ret(_Unit)))
            ])
}: #Desired output unknown(?)

assume(s::real, noiseT >= 3, noiseT <= 8, noiseE >= 1, noiseE <= 8);
easyRoad:= [
  Bind(Uniform(3, 8), noiseT,
  Bind(Uniform(1, 4), noiseE,
  Bind(Gaussian(0, noiseT), x1,
  Bind(Gaussian(x1, noiseE), m1,
  Bind(Gaussian(x1, noiseT), x2,
  Bind(Gaussian(x2, noiseE), m2,
  Ret(Pair(Pair(m1,m2), Pair(noiseT,noiseE)))
  )))))),
  Pair(s,t)
]:
#The first expression below comes from the actual output of disint, hand-
#simplified 1) to bring factors into the innnermost integral, 2) to combine
#products of exps, and 3) to express the polynomial arg of exp in a logical way
#by sub-factoring.
easyRoadr:= {
  Weight(                #Weight 1
    Pi/8,
    Bind(                #Bind 1
      Uniform(3, 8), noiseT,
      Weight(            #Weight 2
        1/noiseT^2,
        Bind(            #Bind 2
          Uniform(1, 4), noiseE,
          Weight(        #Weight 3
            int(         #Int 1
              int(       #Int 2
                exp(
                  -(x2^2/2 - x1*x2 + x1^2)/noiseT^2 -
                  ((t-x2)^2 + (s-x1)^2)/noiseE^2
                )*2/Pi/noiseE,
                x2= -infinity..infinity
              ),         #-Int 2
              x1= -infinity..infinity
            ),           #-Int 1
            Ret(Pair(noiseT, noiseE))
          )              #-Weight 3
        )                #-Bind 2
      )                  #-Weight 2
    )                    #-Bind 1
  ),                     #-Weight 1

  #Hopefully, that's equivalent to...
  Bind(Uniform(3, 8), noiseT,
  Bind(Uniform(1, 4), noiseE,
  Bind(Gaussian(0, noiseT), x1,
  Bind(Weight(density[Gaussian](x1, noiseE)(s), Ret(_Unit)), _,
  Bind(Gaussian(x1, noiseT), x2,
  Weight(density[Gaussian](x2, noiseE)(t), Ret(Pair(noiseT, noiseE)))
  )))))
}:
helloWorld:= [
  Bind(Gaussian(0,1), mu,
  Bind(Plate(n, k, Gaussian(mu, 1)), nu,
  Ret(Pair(nu, mu))
  )),
  :-t,
  ctx= [n::integer, n > 0]
]:
helloWorldr:= {
  Bind(Gaussian(0,1), mu,
  Plate(n, i, Weight(density[Gaussian](mu, 1)(idx(t,i)), Ret(mu)))
  )
}:

#This first block of tests is to test the basic functionality of disint, and,
#to some extent, the system as a whole. These tests may be meaningless to you,
#the statistician and end user of this Hakaru product; they aren't meant to
#have any statistical meaning.--Carl 2016Oct04

TestDisint(
     [Ret(Pair(sqrt(Pi), x)), t &M Ret(7)],
     {Msum()},
     label= "(d0_2) `Dirac` test 1"
);

TestDisint(
     [Ret(Pair(sqrt(Pi), x^2)), t &M Ret(sqrt(Pi))],
     {Ret(x^2)},
     label= "(d0_3) `Dirac` test 2"
);

TestDisint(
     [Bind(Lebesgue((-1,1)*~infinity), x, Ret(Pair(sqrt(Pi), x^2))),
      t &M Ret(sqrt(Pi))
     ],
     {Bind(Lebesgue((-1,1)*~infinity), x1, Ret(x1^2))},
     label= "(d0_4) `Dirac` test with `Bind`"
);

TestDisint(d1, d1r, label = "(d1) Disintegrate linear function");
TestDisint(d2, d2r, label = "(d2) Disintegrate linear function II");
TestDisint(d5, d5r, label = "(d5) Disintegrate N(0,1)*N(x,1), over y");
TestDisint(d6, d6r, label = "(d6) Disintegrate N(0,1)*N(x,1), over x");
TestDisint(norm0a, norm0r,
     label = "(norm0a) U(0,1) >>= \x -> U(x,1) >>= \y -> Ret(y,x)"
);

## This one is kind of cosmetic; it would be 'fixed' properly if the
## disintegration process did not use 'improve' to do "domain information
## discovery", but rather had a specific function (and then improve could
## indeed do this integral).
# should work now
TestDisint( normalFB1, normalFB1r,
     label = "(d7_normalFB1) Disintegrate N(0,1)*N(x,1), over (y+y)+x"
            );

######################################################################
#
# These tests fail, and are expected to.  Move them up when they
# start passing (and are expected to).
#
# They are, however, roughly in order of what we'd like to have work.
#

# change of variables
TestDisint(d3, d3r, label = "(d3) Disintegrate U(0,1) twice, over x-y");
TestDisint(d4, d4r, label = "(d4) Disintegrate U(0,1) twice, over x/y");

# funky piecewise
TestDisint(norm1a, norm1r,
     label = "(norm1a) U(0,1) into Ret of pw"
);
TestDisint(norm1b, norm1r,
     label = "(norm1b) U(0,1) into pw of Ret"
);
#In this one the function in the inequality, x+x^3, is injective but nonlinear.
TestDisint(
     Bind(Gaussian(0,1), x, Ret(Pair(x+x^3, f(x)))),
     {}, #I don't know what to expect.
     label= "(d0_5) Injective nonlinear inequality"
);
# takes too long.
TestDisint(
     easyRoad, easyRoadr,
     label= "(easyRoad) Combo of Normals with distinct Uniform noises",
     TLim= 5 #takes 6 - 8 minutes to `improve` on an Intel i7
);

#This one is a basic test of the Counting wrt-var type.
#This one gives the Weight(-1, ...) error
assume(n_, integer);
TestDisint(
     [Bind(PoissonD(2), n, Ret(Pair(3,n))), n_ &M Counting((-1,1)*~infinity)],
     {},  #I don't know what to expect.
     ctx= [n::integer, n >= 0],
     label= "(d0_1) `Counting` test; `Weight` bug (currently failing)"
);

TestDisint(
     helloWorld, helloWorldr,
     label= "(helloWorld) Plate of Normals",
     ctx= [n::integer, n > 0]
);


This module is removed

This module is removed

kernelopts(assertlevel=2): # be strict on all assertions while testing
kernelopts(opaquemodules=false): # allow testing of internal routines
if not (NewSLO :: `module`) then
  WARNING("loading NewSLO failed");
  `quit`(3);
end if;

with(Hakaru):
with(NewSLO):
with(Partition):

#####################################################################
#
# disintegration tests
#
#####################################################################
d1 := Bind(Lebesgue(-infinity,infinity), x, Ret(Pair(-5*x,3/x))):
d1r := {Weight(1/5,Ret(-15/t))}:

# should try d2 with 1/c as well
d2 := Bind(Lebesgue(-infinity,infinity), x, Ret(Pair((-1/7)*x-1,3))):
d2r := {Weight(7, Ret(3))}:

#The next two tests are simplified versions of the Borel-Kolmogorov paradox.
#https://en.wikipedia.org/wiki/Borel-Kolmogorov_paradox
d3 := Bind(Uniform(0,1), x, Bind(Uniform(0,1), y, Ret(Pair(x-y,f(x,y))))):
d3r := {
  PARTITION([Piece(t <= -1
                  ,Msum())
            ,Piece(t <= 0 and -1 < t
                  ,Weight(t+1,Bind(Uniform(-t,1),`y`,Ret(f(t+`y`,`y`)))))
            ,Piece(t <= 1 and 0 < t
                  ,Weight(1-t,Bind(Uniform(0,1-t),`y`,Ret(f(t+`y`,`y`)))))
            ,Piece(1 < t
                  ,Msum())
            ]) ,
  PARTITION([Piece(t <= -1
                  ,Msum())
            ,Piece(t <= 0 and -1 < t
                  ,Weight(t+1,Bind(Uniform(0,t+1),`x`,Ret(f(`x`,-t+`x`)))))
            ,Piece(t <= 1 and 0 < t
                  ,Weight(1-t,Bind(Uniform(t,1),`x`,Ret(f(`x`,-t+`x`)))))
            ,Piece(1 < t,Msum())
            ])
}:

BUniform := proc(x,b,$) Bind(Uniform(0,1), x, b) end proc:
d3_3 := BUniform(x, BUniform(y, BUniform(z, Ret(Pair(x+y+z,f(x,y,z)))))):
d3_3_r := {}:

d4 := Bind(Uniform(0,1), x, Bind(Uniform(0,1), y, Ret(Pair(x/y,x)))):
d4r := {
  Weight(1/abs(t)^2,
    Bind(Uniform(0,1),x,
         piecewise(x < t,Weight(x,Ret(x)),Msum()))),
  piecewise(0 < t,
    Bind(Uniform(0,1),y,
         piecewise(t < 1/y,
           Weight(y,Ret(t*y)),
           Msum())),
    Msum()),
  PARTITION([Piece(t <= 0,Msum())
           , Piece(t <= 1 and 0 < t,Weight(1/t,Bind(Uniform(0,t),x,Weight(x,Ret(x)))))
           , Piece(1 < t,Weight(1/2/t^2,BetaD(2,1)))])
}:

# like d3 but positive, and the entire parametric family.
d3posfam := Bind(Uniform(0, 1), x, Bind(Uniform(0, 1), y, Ret(Pair(x+y+K_0, f(x, y))))):
d3posfam_r := {
  PARTITION([ Piece(t <= K_0, Msum())
            , Piece(K_0 < t and t <= 1+K_0, Weight(t-K_0, Bind(Uniform(0, t-K_0), x, Ret(f(x, t-x-K_0)))))
            , Piece(t < 2+K_0 and 1+K_0 < t, Weight(2-t+K_0, Bind(Uniform(-1+t-K_0, 1), x, Ret(f(x, t-x-K_0)))))
            , Piece(2+K_0 <= t, Msum())]) }:
d3posfam_ctx := [K_0::real]:

d5 := Bind(Gaussian(0,1), x, Bind(Gaussian(x,1), y, Ret(Pair(y,x)))):
d5r := {Weight((1/2)*exp(-(1/4)*t^2)/Pi^(1/2), Gaussian((1/2)*t, (1/2)*2^(1/2)))}:

d6 := Bind(Gaussian(0,1), x, Bind(Gaussian(x,1), y, Ret(Pair(x,y)))):
d6r := {Weight(1/2*2^(1/2)/Pi^(1/2)*exp(-1/2*t^2),Gaussian(t,1))}:

# note (y+y), which gives trouble for a syntactic approach
normalFB1 :=
  Bind(Gaussian(0,1), x,
  Bind(Gaussian(x,1), y,
  Ret(Pair((y+y)+x, _Unit)))):

normalFB1r := {Weight(1/26*exp(-1/26*t^2)/Pi^(1/2)*13^(1/2)*2^(1/2),Ret(_Unit))}:

# tests taken from haskell/Tests/Disintegrate.hs
# use same names, to be clearer
norm0a :=
  Bind(Gaussian(0,1), x,
  Bind(Gaussian(x,1), y,
  Ret(Pair(y, x)))):
  # note that the answer below is much nicer than the one expected in Haskell
norm0r := {Weight(1/2*exp(-1/4*t^2)/Pi^(1/2),Gaussian(t/2,sqrt(2)/2))}:

norm1a :=
  Bind(Gaussian(3,2), x,Ret(piecewise(x<0, Pair(-x, _Unit), Pair(x, _Unit)))):
norm1b :=
  Bind(Gaussian(3,2), x,piecewise(x<0, Ret(Pair(-x, _Unit)), Ret(Pair(x, _Unit)))):

norm1r_w := (1/4)*sqrt(2)*exp(-9/8)*((exp(t))^(3/4)/(exp(t^2))^(1/8)+1/((exp(t^2))^(1/8)*(exp(t))^(3/4)))/sqrt(Pi):
norm1r := {
  Weight( piecewise(t < 0  , 0
                   ,0 <= t , norm1r_w
                   )
        , Ret(_Unit)
        ) ,
  Weight( PARTITION([Piece(t < 0  , 0)
                    ,Piece(0 <= t , norm1r_w)
                   ])
        , Ret(_Unit)
        )
}:

assume(s::real, noiseT >= 3, noiseT <= 8, noiseE >= 1, noiseE <= 8);
easyRoad:= [
  Bind(Uniform(3, 8), noiseT,
  Bind(Uniform(1, 4), noiseE,
  Bind(Gaussian(0, noiseT), x1,
  Bind(Gaussian(x1, noiseE), m1,
  Bind(Gaussian(x1, noiseT), x2,
  Bind(Gaussian(x2, noiseE), m2,
  Ret(Pair(Pair(m1,m2), Pair(noiseT,noiseE)))
  )))))),
  Pair(s,t)
]:
#The first expression below comes from the actual output of disint, hand-
#simplified 1) to bring factors into the innnermost integral, 2) to combine
#products of exps, and 3) to express the polynomial arg of exp in a logical way
#by sub-factoring.
easyRoadr:= {
  Weight(                #Weight 1
    Pi/8,
    Bind(                #Bind 1
      Uniform(3, 8), noiseT,
      Weight(            #Weight 2
        1/noiseT^2,
        Bind(            #Bind 2
          Uniform(1, 4), noiseE,
          Weight(        #Weight 3
            int(         #Int 1
              int(       #Int 2
                exp(
                  -(x2^2/2 - x1*x2 + x1^2)/noiseT^2 -
                  ((t-x2)^2 + (s-x1)^2)/noiseE^2
                )*2/Pi/noiseE,
                x2= -infinity..infinity
              ),         #-Int 2
              x1= -infinity..infinity
            ),           #-Int 1
            Ret(Pair(noiseT, noiseE))
          )              #-Weight 3
        )                #-Bind 2
      )                  #-Weight 2
    )                    #-Bind 1
  ),                     #-Weight 1

  #Hopefully, that's equivalent to...
  Bind(Uniform(3, 8), noiseT,
  Bind(Uniform(1, 4), noiseE,
  Bind(Gaussian(0, noiseT), x1,
  Bind(Weight(density[Gaussian](x1, noiseE)(s), Ret(_Unit)), _,
  Bind(Gaussian(x1, noiseT), x2,
  Weight(density[Gaussian](x2, noiseE)(t), Ret(Pair(noiseT, noiseE)))
  )))))
}:
helloWorld:=
  Bind(Gaussian(0,1), mu,
  Bind(Plate(n, k, Gaussian(mu, 1)), nu,
  Ret(Pair(nu, mu))
  )):
helloWorldr:= {
  Bind(Gaussian(0,1), mu,
  Plate(n, i, Weight(density[Gaussian](mu, 1)(idx(t,i)), Ret(mu)))
  )
}:

pair_x_x := Bind(Uniform(0, 1), x, Ret(Pair(x, x))):
pair_x_x_r := {
  PARTITION([Piece(t < 0, Msum()), Piece(0 <= t and t <= 1, Ret(t)), Piece(1 < t, Msum())]) }:

#This first block of tests is to test the basic functionality of disint, and,
#to some extent, the system as a whole. These tests may be meaningless to you,
#the statistician and end user of this Hakaru product; they aren't meant to
#have any statistical meaning.--Carl 2016Oct04

TestDisint(
     [Ret(Pair(sqrt(Pi), x)), t &M Ret(7)],
     {Msum()},
     label= "(d0_2) `Dirac` test 1"
);

TestDisint(
     [Ret(Pair(sqrt(Pi), x^2)), t &M Ret(sqrt(Pi))],
     {Ret(x^2)},
     label= "(d0_3) `Dirac` test 2"
);

TestDisint(
     [Bind(Lebesgue((-1,1)*~infinity), x, Ret(Pair(sqrt(Pi), x^2))),
      t &M Ret(sqrt(Pi))
     ],
     {Bind(Lebesgue((-1,1)*~infinity), x1, Ret(x1^2))},
     label= "(d0_4) `Dirac` test with `Bind`"
);

TestDisint(d1, d1r, label = "(d1) Disintegrate linear function");
TestDisint(d2, d2r, label = "(d2) Disintegrate linear function II");
TestDisint(d5, d5r, label = "(d5) Disintegrate N(0,1)*N(x,1), over y");
TestDisint(d6, d6r, label = "(d6) Disintegrate N(0,1)*N(x,1), over x");
TestDisint(norm0a, norm0r,
     label = "(norm0a) U(0,1) >>= \x -> U(x,1) >>= \y -> Ret(y,x)"
);

## This one is kind of cosmetic; it would be 'fixed' properly if the
## disintegration process did not use 'improve' to do "domain information
## discovery", but rather had a specific function (and then improve could
## indeed do this integral).
# should work now
TestDisint( normalFB1, normalFB1r,
     label = "(d7_normalFB1) Disintegrate N(0,1)*N(x,1), over (y+y)+x"
            );

TestDisint(d3, d3r, label = "(d3) Disintegrate U(0,1) twice, over x-y");

######################################################################
#
# These tests fail, and are expected to.  Move them up when they
# start passing (and are expected to).
#
# They are, however, roughly in order of what we'd like to have work.
#

# change of variables
TestDisint(d4, d4r, label = "(d4) Disintegrate U(0,1) twice, over x/y");
# funky piecewise
TestDisint(norm1a, norm1r,
     label = "(norm1a) U(0,1) into Ret of pw"
);
TestDisint(norm1b, norm1r,
     label = "(norm1b) U(0,1) into pw of Ret"
);
#In this one the function in the inequality, x+x^3, is injective but nonlinear.
TestDisint(
     Bind(Gaussian(0,1), x, Ret(Pair(x+x^3, f(x)))),
     {}, #I don't know what to expect.
     label= "(d0_5) Injective nonlinear inequality"
);

TestDisint(pair_x_x, pair_x_x_r, label="(pair_x_x) Disintegrate U(0,1) over Ret(x,x)");
TestDisint(d3_3, d3_3_r, label = "(d3_3) Disintegrate U(0,1) thrice, over x+y+z");
TestDisint(d3posfam, d3posfam_r, d3posfam_ctx
          , label = "(d3posfam) Disintegrate U(0,1) twice, over x+y+K");

#This one is a basic test of the Counting wrt-var type.
#This one gives the Weight(-1, ...) error
TestDisint(
     [Bind(PoissonD(2), n, Ret(Pair(3,n))), n_ &M Counting((-1,1)*~infinity)],
     {},  #I don't know what to expect.
     [n::integer, n >= 0],
     label= "(d0_1) `Counting` test; `Weight` bug (currently failing)"
);

TestDisint(
     helloWorld, helloWorldr,
     [n::integer, n > 0],
     label= "(helloWorld) Plate of Normals"
);

# tests which take too long
TestDisint(
     easyRoad, easyRoadr, [],
     120, #takes 6 - 8 minutes to `improve` on an Intel i7
     label= "(easyRoad) Combo of Normals with distinct Uniform noises"
);

kernelopts(assertlevel=2): # be strict on all assertions while testing
kernelopts(opaquemodules=false): # allow testing of internal routines
if not (NewSLO :: `module`) then
  WARNING("loading NewSLO failed");
  `quit`(3);
end if;

with(Hakaru):
with(NewSLO):
with(TestWrapper):
with(Partition):

#####################################################################
#
# disintegration tests
#
#####################################################################
d1 := Bind(Lebesgue(-infinity,infinity), x, Ret(Pair(-5*x,3/x))):
d1r := {Weight(1/5,Ret(-15/t))}:

# should try d2 with 1/c as well
d2 := Bind(Lebesgue(-infinity,infinity), x, Ret(Pair((-1/7)*x-1,3))):
d2r := {Weight(7, Ret(3))}:

#The next two tests are simplified versions of the Borel-Kolmogorov paradox.
#https://en.wikipedia.org/wiki/Borel-Kolmogorov_paradox
d3 := Bind(Uniform(0,1), x, Bind(Uniform(0,1), y, Ret(Pair(x-y,f(x,y))))):
d3r := {
  PARTITION([Piece(t <= -1
                  ,Msum())
            ,Piece(t <= 0 and -1 < t
                  ,Weight(t+1,Bind(Uniform(-t,1),`y`,Ret(f(t+`y`,`y`)))))
            ,Piece(t <= 1 and 0 < t
                  ,Weight(1-t,Bind(Uniform(0,1-t),`y`,Ret(f(t+`y`,`y`)))))
            ,Piece(1 < t
                  ,Msum())
            ]) ,
  PARTITION([Piece(t <= -1
                  ,Msum())
            ,Piece(t <= 0 and -1 < t
                  ,Weight(t+1,Bind(Uniform(0,t+1),`x`,Ret(f(`x`,-t+`x`)))))
            ,Piece(t <= 1 and 0 < t
                  ,Weight(1-t,Bind(Uniform(t,1),`x`,Ret(f(`x`,-t+`x`)))))
            ,Piece(1 < t,Msum())
            ])
}:

BUniform := proc(x,b,$) Bind(Uniform(0,1), x, b) end proc:
d3_3 := BUniform(x, BUniform(y, BUniform(z, Ret(Pair(x+y+z,f(x,y,z)))))):
d3_3_r := {}:

d4 := Bind(Uniform(0,1), x, Bind(Uniform(0,1), y, Ret(Pair(x/y,x)))):
d4r := {
  Weight(1/abs(t)^2,
    Bind(Uniform(0,1),x,
         piecewise(x < t,Weight(x,Ret(x)),Msum()))),
  piecewise(0 < t,
    Bind(Uniform(0,1),y,
         piecewise(t < 1/y,
           Weight(y,Ret(t*y)),
           Msum())),
    Msum()),
  PARTITION([Piece(t <= 0,Msum())
           , Piece(t <= 1 and 0 < t,Weight(1/t,Bind(Uniform(0,t),x,Weight(x,Ret(x)))))
           , Piece(1 < t,Weight(1/2/t^2,BetaD(2,1)))])
}:

# like d3 but positive, and the entire parametric family.
d3posfam := Bind(Uniform(0, 1), x, Bind(Uniform(0, 1), y, Ret(Pair(x+y+K_0, f(x, y))))):
d3posfam_r := {
  PARTITION([ Piece(t <= K_0, Msum())
            , Piece(K_0 < t and t <= 1+K_0, Weight(t-K_0, Bind(Uniform(0, t-K_0), x, Ret(f(x, t-x-K_0)))))
            , Piece(t < 2+K_0 and 1+K_0 < t, Weight(2-t+K_0, Bind(Uniform(-1+t-K_0, 1), x, Ret(f(x, t-x-K_0)))))
            , Piece(2+K_0 <= t, Msum())]) }:
d3posfam_ctx := [K_0::real]:

d5 := Bind(Gaussian(0,1), x, Bind(Gaussian(x,1), y, Ret(Pair(y,x)))):
d5r := {Weight((1/2)*exp(-(1/4)*t^2)/Pi^(1/2), Gaussian((1/2)*t, (1/2)*2^(1/2)))}:

d6 := Bind(Gaussian(0,1), x, Bind(Gaussian(x,1), y, Ret(Pair(x,y)))):
d6r := {Weight(1/2*2^(1/2)/Pi^(1/2)*exp(-1/2*t^2),Gaussian(t,1))}:

# note (y+y), which gives trouble for a syntactic approach
normalFB1 :=
  Bind(Gaussian(0,1), x,
  Bind(Gaussian(x,1), y,
  Ret(Pair((y+y)+x, _Unit)))):

normalFB1r := {Weight(1/26*exp(-1/26*t^2)/Pi^(1/2)*13^(1/2)*2^(1/2),Ret(_Unit))}:

# tests taken from haskell/Tests/Disintegrate.hs
# use same names, to be clearer
norm0a :=
  Bind(Gaussian(0,1), x,
  Bind(Gaussian(x,1), y,
  Ret(Pair(y, x)))):
  # note that the answer below is much nicer than the one expected in Haskell
norm0r := {Weight(1/2*exp(-1/4*t^2)/Pi^(1/2),Gaussian(t/2,sqrt(2)/2))}:

norm1a :=
  Bind(Gaussian(3,2), x,Ret(piecewise(x<0, Pair(-x, _Unit), Pair(x, _Unit)))):
norm1b :=
  Bind(Gaussian(3,2), x,piecewise(x<0, Ret(Pair(-x, _Unit)), Ret(Pair(x, _Unit)))):

norm1r_w := (1/4)*sqrt(2)*exp(-9/8)*((exp(t))^(3/4)/(exp(t^2))^(1/8)+1/((exp(t^2))^(1/8)*(exp(t))^(3/4)))/sqrt(Pi):
norm1r := {
  Weight( piecewise(t < 0  , 0
                   ,0 <= t , norm1r_w
                   )
        , Ret(_Unit)
        ) ,
  Weight( PARTITION([Piece(t < 0  , 0)
                    ,Piece(0 <= t , norm1r_w)
                   ])
        , Ret(_Unit)
        )
}:

assume(s::real, noiseT >= 3, noiseT <= 8, noiseE >= 1, noiseE <= 8);
easyRoad:= [
  Bind(Uniform(3, 8), noiseT,
  Bind(Uniform(1, 4), noiseE,
  Bind(Gaussian(0, noiseT), x1,
  Bind(Gaussian(x1, noiseE), m1,
  Bind(Gaussian(x1, noiseT), x2,
  Bind(Gaussian(x2, noiseE), m2,
  Ret(Pair(Pair(m1,m2), Pair(noiseT,noiseE)))
  )))))),
  Pair(s,t)
]:
#The first expression below comes from the actual output of disint, hand-
#simplified 1) to bring factors into the innnermost integral, 2) to combine
#products of exps, and 3) to express the polynomial arg of exp in a logical way
#by sub-factoring.
easyRoadr:= {
  Weight(                #Weight 1
    Pi/8,
    Bind(                #Bind 1
      Uniform(3, 8), noiseT,
      Weight(            #Weight 2
        1/noiseT^2,
        Bind(            #Bind 2
          Uniform(1, 4), noiseE,
          Weight(        #Weight 3
            int(         #Int 1
              int(       #Int 2
                exp(
                  -(x2^2/2 - x1*x2 + x1^2)/noiseT^2 -
                  ((t-x2)^2 + (s-x1)^2)/noiseE^2
                )*2/Pi/noiseE,
                x2= -infinity..infinity
              ),         #-Int 2
              x1= -infinity..infinity
            ),           #-Int 1
            Ret(Pair(noiseT, noiseE))
          )              #-Weight 3
        )                #-Bind 2
      )                  #-Weight 2
    )                    #-Bind 1
  ),                     #-Weight 1

  #Hopefully, that's equivalent to...
  Bind(Uniform(3, 8), noiseT,
  Bind(Uniform(1, 4), noiseE,
  Bind(Gaussian(0, noiseT), x1,
  Bind(Weight(density[Gaussian](x1, noiseE)(s), Ret(_Unit)), _,
  Bind(Gaussian(x1, noiseT), x2,
  Weight(density[Gaussian](x2, noiseE)(t), Ret(Pair(noiseT, noiseE)))
  )))))
}:
helloWorld:=
  Bind(Gaussian(0,1), mu,
  Bind(Plate(n, k, Gaussian(mu, 1)), nu,
  Ret(Pair(nu, mu))
  )):
helloWorldr:= {
  Bind(Gaussian(0,1), mu,
  Plate(n, i, Weight(density[Gaussian](mu, 1)(idx(t,i)), Ret(mu)))
  )
}:

pair_x_x := Bind(Uniform(0, 1), x, Ret(Pair(x, x))):
pair_x_x_r := {
  PARTITION([Piece(t < 0, Msum()), Piece(0 <= t and t <= 1, Ret(t)), Piece(1 < t, Msum())]) }:

#This first block of tests is to test the basic functionality of disint, and,
#to some extent, the system as a whole. These tests may be meaningless to you,
#the statistician and end user of this Hakaru product; they aren't meant to
#have any statistical meaning.--Carl 2016Oct04

TestDisint(
     [Ret(Pair(sqrt(Pi), x)), t &M Ret(7)],
     {Msum()},
     label= "(d0_2) `Dirac` test 1"
);

TestDisint(
     [Ret(Pair(sqrt(Pi), x^2)), t &M Ret(sqrt(Pi))],
     {Ret(x^2)},
     label= "(d0_3) `Dirac` test 2"
);

TestDisint(
     [Bind(Lebesgue((-1,1)*~infinity), x, Ret(Pair(sqrt(Pi), x^2))),
      t &M Ret(sqrt(Pi))
     ],
     {Bind(Lebesgue((-1,1)*~infinity), x1, Ret(x1^2))},
     label= "(d0_4) `Dirac` test with `Bind`"
);

TestDisint(d1, d1r, label = "(d1) Disintegrate linear function");
TestDisint(d2, d2r, label = "(d2) Disintegrate linear function II");
TestDisint(d5, d5r, label = "(d5) Disintegrate N(0,1)*N(x,1), over y");
TestDisint(d6, d6r, label = "(d6) Disintegrate N(0,1)*N(x,1), over x");
TestDisint(norm0a, norm0r,
     label = "(norm0a) U(0,1) >>= \x -> U(x,1) >>= \y -> Ret(y,x)"
);

## This one is kind of cosmetic; it would be 'fixed' properly if the
## disintegration process did not use 'improve' to do "domain information
## discovery", but rather had a specific function (and then improve could
## indeed do this integral).
# should work now
TestDisint( normalFB1, normalFB1r,
     label = "(d7_normalFB1) Disintegrate N(0,1)*N(x,1), over (y+y)+x"
            );

TestDisint(d3, d3r, label = "(d3) Disintegrate U(0,1) twice, over x-y");

######################################################################
#
# These tests fail, and are expected to.  Move them up when they
# start passing (and are expected to).
#
# They are, however, roughly in order of what we'd like to have work.
#

# change of variables
TestDisint(d4, d4r, label = "(d4) Disintegrate U(0,1) twice, over x/y");
# funky piecewise
TestDisint(norm1a, norm1r,
     label = "(norm1a) U(0,1) into Ret of pw"
);
TestDisint(norm1b, norm1r,
     label = "(norm1b) U(0,1) into pw of Ret"
);
#In this one the function in the inequality, x+x^3, is injective but nonlinear.
TestDisint(
     Bind(Gaussian(0,1), x, Ret(Pair(x+x^3, f(x)))),
     {}, #I don't know what to expect.
     label= "(d0_5) Injective nonlinear inequality"
);

TestDisint(pair_x_x, pair_x_x_r, label="(pair_x_x) Disintegrate U(0,1) over Ret(x,x)");
TestDisint(d3_3, d3_3_r, label = "(d3_3) Disintegrate U(0,1) thrice, over x+y+z");
TestDisint(d3posfam, d3posfam_r, d3posfam_ctx
          , label = "(d3posfam) Disintegrate U(0,1) twice, over x+y+K");

#This one is a basic test of the Counting wrt-var type.
#This one gives the Weight(-1, ...) error
TestDisint(
     [Bind(PoissonD(2), n, Ret(Pair(3,n))), n_ &M Counting((-1,1)*~infinity)],
     {},  #I don't know what to expect.
     [n::integer, n >= 0],
     label= "(d0_1) `Counting` test; `Weight` bug (currently failing)"
);

TestDisint(
     helloWorld, helloWorldr,
     [n::integer, n > 0],
     label= "(helloWorld) Plate of Normals"
);

# tests which take too long
TestDisint(
     easyRoad, easyRoadr, [],
     120, #takes 6 - 8 minutes to `improve` on an Intel i7
     label= "(easyRoad) Combo of Normals with distinct Uniform noises"
);


tweak display and level of userinfo

tweak display and level of userinfo

# Step 2 of 3: computer algebra

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

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

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

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

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

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

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

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

      if has_Domain(arg) then
          extract_Domain(h, kb1, kb, vars1, op(0,arg), op(arg));
      else
          arg, vars1, kb1
      end if;
  end proc;

  # Walk through integrals and simplify, recursing through grammar
  # h - name of the linear operator above us
  # kb - domain information
  reduce := proc(ee, h :: name, kb :: t_kb, $)
    local e, subintegral, w, ww, x, c, kb1;
    e := ee;

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

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

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

    # end if;

    # if e :: 'And(specfunc({Int,Sum}), anyfunc(anything,name=range))' then
    # userinfo(3, 'disint_trace',
    #     printf("case Int/Sum \n"
    #            "  expr : %a\n"
    #            "  h    : %a\n"
    #            "  ctx  : %a\n\n"
    #      , ee, h, kb ));

    #   x, kb1 := `if`(op(0,e)=Int,
    #     genLebesgue(op([2,1],e), op([2,2,1],e), op([2,2,2],e), kb),
    #     genSummation(op([2,1],e), op(op([2,2],e)), kb));
    #   reduce_IntSum(op(0,e),
    #     reduce(subs(op([2,1],e)=x, op(1,e)), h, kb1), h, kb1, kb)

    elif e :: 'And(specfunc({Ints,Sums}),
                   anyfunc(anything, name, range, list(name=range)))' then
      x, kb1 := genType(op(2,e),
                        mk_HArray(`if`(op(0,e)=Ints,
                                       HReal(open_bounds(op(3,e))),
                                       HInt(closed_bounds(op(3,e)))),
                                  op(4,e)),
                        kb);
      if nops(op(4,e)) > 0 then
        kb1 := assert(size(x)=op([4,-1,2,2],e)-op([4,-1,2,1],e)+1, kb1);
      end if;
      reduce_IntsSums(op(0,e), reduce(subs(op(2,e)=x, op(1,e)), h, kb1), x,
        op(3,e), op(4,e), h, kb1)
    elif e :: 'applyintegrand(anything, anything)' then
      map(simplify_assuming, e, kb)
    elif e :: `+` then
      map(reduce, e, h, kb)
    elif e :: `*` then
      (subintegral, w) := selectremove(depends, e, h);
      if subintegral :: `*` then error "Nonlinear integral %1", e end if;
      subintegral := convert(reduce(subintegral, h, kb), 'list', `*`);
      (subintegral, ww) := selectremove(depends, subintegral, h);
      reduce_pw(simplify_factor_assuming(`*`(w, op(ww)), kb))
        * `*`(op(subintegral));
    elif e :: t_pw then
      e:= flatten_piecewise(e);
      e := kb_piecewise(e, kb, simplify_assuming,
                        ((rhs, kb) -> %reduce(rhs, h, kb)));
      e := eval(e, %reduce=reduce);
      # big hammer: simplify knows about bound variables, amongst many
      # other things
      Testzero := x -> evalb(simplify(x) = 0);
      e := reduce_pw(e);
      e;
    elif e :: t_case then
      subsop(2=map(proc(b :: Branch(anything, anything))
                     eval(subsop(2='reduce'(op(2,b),x,c),b),
                          {x=h, c=kb})
                   end proc,
                   op(2,e)),
             e);
    elif e :: 'Context(anything, anything)' then
      kb1 := assert(op(1,e), kb);
      # A contradictory `Context' implies anything, so produce 'anything'
      # In particular, 42 :: t_Hakaru = false, so a term under a false
      # assumption should never be inspected in any way.
      if kb1 :: t_not_a_kb then
          return 42
      end if;
      applyop(reduce, 2, e, h, kb1);
    elif e :: 'integrate(anything, Integrand(name, anything), list)' then
      x := gensym(op([2,1],e));
      # If we had HType information for op(1,e),
      # then we could use it to tell kb about x.
      subsop(2=Integrand(x, reduce(subs(op([2,1],e)=x, op([2,2],e)), h, kb)), e)
    else
      simplify_assuming(e, kb)
    end if;
  end proc;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

          end if;

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

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

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

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

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

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

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

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

          sol := sol2;

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

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

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

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

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

          end do;

          # maybe simplify here...
          er := e

      elif sol :: Partition then

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

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

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

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

          er := e;

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

      end if;

      er;

  end proc;

  app_dom_spec_IntSum :=
    proc(mk :: identical(Int, Sum), ee, h, kb0 :: t_kb
        ,dom_spec_
        ,$)
    local new_rng, make, var, elim, w,
          dom_spec := dom_spec_, e := ee ;

    new_rng, dom_spec := selectremove(type, dom_spec,
      {`if`(mk=Int, [identical(genLebesgue), name, anything, anything], NULL),
       `if`(mk=Sum, [identical(genType), name, specfunc(HInt)], NULL),
       [identical(genLet), name, anything]});
    if not (new_rng :: [list]) then
      error "kb_subtract should return exactly one gen*"
    end if;
    make    := mk;
    new_rng := op(new_rng);
    var     := op(2,new_rng);
    if op(1,new_rng) = genLebesgue then
      new_rng := op(3,new_rng)..op(4,new_rng);
    elif op(1,new_rng) = genType then
      new_rng := range_of_HInt(op(3,new_rng));
    else # op(1,new_rng) = genLet
      if mk=Int then
          # this was just a return, but now is in its own
          # local function and the control flow must be handled
          # up above. although calling 'reduce' on 0 will probably
          # return immediately anyways(?)
          return DONE(0)
      else
          make := eval;
          new_rng := op(3,new_rng)
      end if;
    end if;

    userinfo(3, 'LMS',
        printf("    dom-spec        : %a\n"
               "    dom-var         : %a\n"
         , dom_spec, var ));

    e := `*`(e, op(map(proc(a::[identical(assert),anything], $)
                         Indicator(op(2,a))
                       end proc,
                       dom_spec)));

    userinfo(3, 'LMS',
        printf("    expr-ind        : %a\n"
         , e ));

    elim := elim_intsum(make(e, var=new_rng), h, kb0);

    userinfo(3, 'LMS',
        printf("    expr-elimed     : %a\n"
         , elim ));

    if elim = FAIL then
      DONE( reduce_on_prod(p->make(p,var=new_rng), e, var, kb0) );
    else
      elim
    end if;

  end proc;

  do_app_dom_spec := proc(mk, e, h, kb0, kb2)
      local e2, dom_spec;

      dom_spec := kb_subtract(kb2, kb0);

      # apply the domain restrictions, which can produce
      #   DONE(x) - produced something which can't be simplified further
      #   x       - more work to be done
      e2 := app_dom_spec_IntSum(mk, e, h, kb0, dom_spec);

      userinfo(3, 'LMS',
               printf("    expr            : %a\n"
                      "    expr after dom  : %a\n"
                      , e, e2 ));

      if e2 :: specfunc('DONE') then
          e2 := op(1,e2);
      else
          e2 := reduce(e2, h, kb0);
          userinfo(3, 'LMS',
                   printf("    expr-reduced    : %a\n"
                          , e2 ));
      end if;

      e2;

  end proc;

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

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

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

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

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

    userinfo(3, 'disint_trace',
        printf("reduce_IntSum input:\n"
               "  integral type: %a\n"
               "  expr : %a\n"
               "  h    : %a\n"
               "  ctx expr  : %a\n"
               "  ctx above : %a\n"
               "  ctx below : %a\n\n"
         , mks, ee, h, kb2, kb1, kb0 ));

    lmss := kb_LMS(kb2, mks);

    # userinfo(3, 'LMS',
    #      printf("    LMS     : %a\n"
    #             "    kb Big  : %a\n"
    #             "    kb small: %a\n"
    #             "    domain  : %a\n"
    #             "    var     : %a\n"
    #      , lmss, kb2, kb0, dom_spec, h ));

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

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

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

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

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

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

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

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

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

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

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

    # end try;

    e2;

  end proc;

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

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

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

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

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

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

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

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

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

# Step 2 of 3: computer algebra

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

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

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

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

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

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

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

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

      if has_Domain(arg) then
          extract_Domain(h, kb1, kb, vars1, op(0,arg), op(arg));
      else
          arg, vars1, kb1
      end if;
  end proc;

  # Walk through integrals and simplify, recursing through grammar
  # h - name of the linear operator above us
  # kb - domain information
  reduce := proc(ee, h :: name, kb :: t_kb, $)
    local e, subintegral, w, ww, x, c, kb1;
    e := ee;

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

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

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

    # end if;

    # if e :: 'And(specfunc({Int,Sum}), anyfunc(anything,name=range))' then
    # userinfo(3, 'disint_trace',
    #     printf("case Int/Sum \n"
    #            "  expr : %a\n"
    #            "  h    : %a\n"
    #            "  ctx  : %a\n\n"
    #      , ee, h, kb ));

    #   x, kb1 := `if`(op(0,e)=Int,
    #     genLebesgue(op([2,1],e), op([2,2,1],e), op([2,2,2],e), kb),
    #     genSummation(op([2,1],e), op(op([2,2],e)), kb));
    #   reduce_IntSum(op(0,e),
    #     reduce(subs(op([2,1],e)=x, op(1,e)), h, kb1), h, kb1, kb)

    elif e :: 'And(specfunc({Ints,Sums}),
                   anyfunc(anything, name, range, list(name=range)))' then
      x, kb1 := genType(op(2,e),
                        mk_HArray(`if`(op(0,e)=Ints,
                                       HReal(open_bounds(op(3,e))),
                                       HInt(closed_bounds(op(3,e)))),
                                  op(4,e)),
                        kb);
      if nops(op(4,e)) > 0 then
        kb1 := assert(size(x)=op([4,-1,2,2],e)-op([4,-1,2,1],e)+1, kb1);
      end if;
      reduce_IntsSums(op(0,e), reduce(subs(op(2,e)=x, op(1,e)), h, kb1), x,
        op(3,e), op(4,e), h, kb1)
    elif e :: 'applyintegrand(anything, anything)' then
      map(simplify_assuming, e, kb)
    elif e :: `+` then
      map(reduce, e, h, kb)
    elif e :: `*` then
      (subintegral, w) := selectremove(depends, e, h);
      if subintegral :: `*` then error "Nonlinear integral %1", e end if;
      subintegral := convert(reduce(subintegral, h, kb), 'list', `*`);
      (subintegral, ww) := selectremove(depends, subintegral, h);
      reduce_pw(simplify_factor_assuming(`*`(w, op(ww)), kb))
        * `*`(op(subintegral));
    elif e :: t_pw then
      e:= flatten_piecewise(e);
      e := kb_piecewise(e, kb, simplify_assuming,
                        ((rhs, kb) -> %reduce(rhs, h, kb)));
      e := eval(e, %reduce=reduce);
      # big hammer: simplify knows about bound variables, amongst many
      # other things
      Testzero := x -> evalb(simplify(x) = 0);
      e := reduce_pw(e);
      e;
    elif e :: t_case then
      subsop(2=map(proc(b :: Branch(anything, anything))
                     eval(subsop(2='reduce'(op(2,b),x,c),b),
                          {x=h, c=kb})
                   end proc,
                   op(2,e)),
             e);
    elif e :: 'Context(anything, anything)' then
      kb1 := assert(op(1,e), kb);
      # A contradictory `Context' implies anything, so produce 'anything'
      # In particular, 42 :: t_Hakaru = false, so a term under a false
      # assumption should never be inspected in any way.
      if kb1 :: t_not_a_kb then
          return 42
      end if;
      applyop(reduce, 2, e, h, kb1);
    elif e :: 'integrate(anything, Integrand(name, anything), list)' then
      x := gensym(op([2,1],e));
      # If we had HType information for op(1,e),
      # then we could use it to tell kb about x.
      subsop(2=Integrand(x, reduce(subs(op([2,1],e)=x, op([2,2],e)), h, kb)), e)
    else
      simplify_assuming(e, kb)
    end if;
  end proc;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

          end if;

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

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

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

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

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

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

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

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

          sol := sol2;

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

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

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

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

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

          end do;

          # maybe simplify here...
          er := e

      elif sol :: Partition then

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

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

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

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

          er := e;

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

      end if;

      er;

  end proc;

  app_dom_spec_IntSum :=
    proc(mk :: identical(Int, Sum), ee, h, kb0 :: t_kb
        ,dom_spec_
        ,$)
    local new_rng, make, var, elim, w,
          dom_spec := dom_spec_, e := ee ;

    new_rng, dom_spec := selectremove(type, dom_spec,
      {`if`(mk=Int, [identical(genLebesgue), name, anything, anything], NULL),
       `if`(mk=Sum, [identical(genType), name, specfunc(HInt)], NULL),
       [identical(genLet), name, anything]});
    if not (new_rng :: [list]) then
      error "kb_subtract should return exactly one gen*"
    end if;
    make    := mk;
    new_rng := op(new_rng);
    var     := op(2,new_rng);
    if op(1,new_rng) = genLebesgue then
      new_rng := op(3,new_rng)..op(4,new_rng);
    elif op(1,new_rng) = genType then
      new_rng := range_of_HInt(op(3,new_rng));
    else # op(1,new_rng) = genLet
      if mk=Int then
          # this was just a return, but now is in its own
          # local function and the control flow must be handled
          # up above. although calling 'reduce' on 0 will probably
          # return immediately anyways(?)
          return DONE(0)
      else
          make := eval;
          new_rng := op(3,new_rng)
      end if;
    end if;

    userinfo(3, 'LMS',
        printf("    dom-spec        : %a\n"
               "    dom-var         : %a\n"
         , dom_spec, var ));

    e := `*`(e, op(map(proc(a::[identical(assert),anything], $)
                         Indicator(op(2,a))
                       end proc,
                       dom_spec)));

    userinfo(3, 'LMS',
        printf("    expr-ind        : %a\n"
         , e ));

    elim := elim_intsum(make(e, var=new_rng), h, kb0);

    userinfo(3, 'LMS',
        printf("    expr-elimed     : %a\n"
         , elim ));

    if elim = FAIL then
      DONE( reduce_on_prod(p->make(p,var=new_rng), e, var, kb0) );
    else
      elim
    end if;

  end proc;

  do_app_dom_spec := proc(mk, e, h, kb0, kb2)
      local e2, dom_spec;

      dom_spec := kb_subtract(kb2, kb0);

      # apply the domain restrictions, which can produce
      #   DONE(x) - produced something which can't be simplified further
      #   x       - more work to be done
      e2 := app_dom_spec_IntSum(mk, e, h, kb0, dom_spec);

      userinfo(3, 'LMS',
               printf("    expr            : %a\n"
                      "    expr after dom  : %a\n"
                      , e, e2 ));

      if e2 :: specfunc('DONE') then
          e2 := op(1,e2);
      else
          e2 := reduce(e2, h, kb0);
          userinfo(3, 'LMS',
                   printf("    expr-reduced    : %a\n"
                          , e2 ));
      end if;

      e2;

  end proc;

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

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

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

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

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

    userinfo(3, 'disint_trace',
        printf("input:\n"
               "  integral type: %a\n"
               "  expr : %a\n"
               "  h    : %a\n"
               "  ctx dom   : %a\n"
               "  ctx above : %a\n"
               "  ctx below : %a\n\n"
         , mk, ee, h, kb2, kb1, kb0 ));

    lmss := kb_LMS(kb2, mks);

    # userinfo(3, 'LMS',
    #      printf("    LMS     : %a\n"
    #             "    kb Big  : %a\n"
    #             "    kb small: %a\n"
    #             "    domain  : %a\n"
    #             "    var     : %a\n"
    #      , lmss, kb2, kb0, dom_spec, h ));

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

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

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

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

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

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

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

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

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

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

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

    # end try;

    e2;

  end proc;

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

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

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

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

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

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

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

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

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