From: Hannu Niemistö Date: Wed, 4 Oct 2017 19:24:31 +0000 (+0300) Subject: (refs #7508) Added missing effects in the simplification of EBind X-Git-Tag: v1.31.0~144^2 X-Git-Url: https://gerrit.simantics.org/r/gitweb?a=commitdiff_plain;h=2148e9b3fecb3385ac71f302eea7045cf370afe2;p=simantics%2Fplatform.git (refs #7508) Added missing effects in the simplification of EBind Change-Id: I648db6332ebc7d6501dd07c44271bab0b5ab7857 --- diff --git a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/expressions/EBind.java b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/expressions/EBind.java index c72776b35..5664db7bf 100644 --- a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/expressions/EBind.java +++ b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/expressions/EBind.java @@ -89,10 +89,6 @@ public class EBind extends SimplifiableExpression { */ @Override public Expression simplify(SimplificationContext context) { - value = value.simplify(context); - in = in.simplify(context); - pattern = pattern.simplify(context); - long loc = getLocation(); monadType = Types.canonical(monadType); valueContentType = Types.canonical(valueContentType); @@ -101,11 +97,11 @@ public class EBind extends SimplifiableExpression { Type[] types = blockType == BlockType.MonadE ? new Type[] {monadType, valueContentType, effect, inContentType} : new Type[] {monadType, valueContentType, inContentType}; - Expression simplified = new EApply(loc, + Expression simplified = new EApply(loc, effect, new EConstant(loc, context.getValue(blockType == BlockType.MonadE ? Names.Prelude_bindE : Names.Prelude_bind), types), monadEvidence, value, - new ELambda(loc, new Case[] { + new ELambda(loc, effect, new Case[] { new Case(new Expression[] { pattern }, in) })); simplified.setType(getType()); diff --git a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/expressions/ELambda.java b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/expressions/ELambda.java index ccf86bbf5..b01b77189 100644 --- a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/expressions/ELambda.java +++ b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/expressions/ELambda.java @@ -29,6 +29,12 @@ public class ELambda extends SimplifiableExpression { this.cases = cases; } + public ELambda(long loc, Type effect, Case ... cases) { + super(loc); + this.cases = cases; + this.effect = effect; + } + public ELambda(long loc, Expression pat, Expression exp) { this(loc, new Case(new Expression[] {pat}, exp)); } diff --git a/tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/ModuleRegressionTests.java b/tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/ModuleRegressionTests.java index 7e419f6ab..91ddbc5e9 100644 --- a/tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/ModuleRegressionTests.java +++ b/tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/ModuleRegressionTests.java @@ -181,7 +181,8 @@ public class ModuleRegressionTests extends TestBase { @Test public void MonadBug1() { test(); } @Test public void Monads1() { test(); } @Test public void MonadSyntax1() { test(); } - @Test public void MonadSyntax3() { test(); } + @Test public void MonadSyntax3() { test(); } + @Test public void MonadSyntax4() { test(); } @Test public void NoDefinitionErrorMessage() { test(); } @Test public void NoInstance() { test(); } @Test public void NoInstance2() { test(); } diff --git a/tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/scl/MonadSyntax4.scl b/tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/scl/MonadSyntax4.scl new file mode 100644 index 000000000..c410c98c9 --- /dev/null +++ b/tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/scl/MonadSyntax4.scl @@ -0,0 +1,9 @@ +import "Prelude" + +main = ignore edo + x <- [print "Hello"] + return (print "world!") +-- +Hello +world! +() \ No newline at end of file