From: Hannu Niemistö Date: Tue, 10 Oct 2017 14:56:31 +0000 (+0300) Subject: (refs #7508) Edo and modified mdo under edo feature X-Git-Tag: v1.31.0~130^2 X-Git-Url: https://gerrit.simantics.org/r/gitweb?a=commitdiff_plain;h=3ccd513530bc718ef384780d3151ddbb85600986;p=simantics%2Fplatform.git (refs #7508) Edo and modified mdo under edo feature Change-Id: I37c9a0e09ef436f29a5fcd92d7f10f14671059c0 --- 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 5664db7bf..84cc220c1 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 @@ -11,6 +11,7 @@ import org.simantics.scl.compiler.elaboration.modules.SCLValue; import org.simantics.scl.compiler.errors.Locations; import org.simantics.scl.compiler.internal.codegen.references.IVal; import org.simantics.scl.compiler.internal.codegen.writer.CodeWriter; +import org.simantics.scl.compiler.internal.header.ModuleHeader; import org.simantics.scl.compiler.types.Type; import org.simantics.scl.compiler.types.Types; import org.simantics.scl.compiler.types.exceptions.MatchException; @@ -52,7 +53,11 @@ public class EBind extends SimplifiableExpression { @Override public Expression checkBasicType(TypingContext context, Type requiredType) { + ModuleHeader header = context.getCompilationContext().header; + boolean edo = header != null && header.edo; + monadType = Types.metaVar(Kinds.STAR_TO_STAR); + inContentType = Types.metaVar(Kinds.STAR); Type monadContent = Types.apply(monadType, inContentType); try { @@ -71,9 +76,13 @@ public class EBind extends SimplifiableExpression { pattern = pattern.checkTypeAsPattern(context, Types.metaVar(Kinds.STAR)); valueContentType = pattern.getType(); value = value.checkType(context, Types.apply(monadType, valueContentType)); - context.pushEffectUpperBound(location, blockType == BlockType.Monad ? Types.NO_EFFECTS : Types.metaVar(Kinds.EFFECT)); + if(edo) + context.pushEffectUpperBound(location, blockType == BlockType.Monad ? Types.NO_EFFECTS : Types.metaVar(Kinds.EFFECT)); in = in.checkType(context, requiredType); - effect = context.popEffectUpperBound(); + if(edo) + effect = context.popEffectUpperBound(); + else + effect = Types.NO_EFFECTS; Type inType = in.getType(); setType(inType); return this; diff --git a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/internal/header/ModuleHeader.java b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/internal/header/ModuleHeader.java index 0ab17f834..7362b38ee 100644 --- a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/internal/header/ModuleHeader.java +++ b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/internal/header/ModuleHeader.java @@ -8,6 +8,7 @@ import org.simantics.scl.compiler.elaboration.expressions.records.FieldAssignmen import org.simantics.scl.compiler.errors.ErrorLog; public class ModuleHeader { + public String deprecated; public String classLoader; public long classLoaderLocation; public String defaultLocalName; @@ -16,6 +17,7 @@ public class ModuleHeader { // Features public boolean chr; public boolean fields; + public boolean edo; private void read(ErrorLog errorLog, FieldAssignment[] fields) { for(FieldAssignment assignment : fields) @@ -60,6 +62,15 @@ public class ModuleHeader { errorLog.log(assignment.value.location, "Expected string here."); } break; + case "deprecated": + if(assignment.value == null) + deprecated = ""; + else { + deprecated = AnnotationUtils.extractString(assignment.value); + if(deprecated == null) + errorLog.log(assignment.value.location, "Expected string here."); + } + break; default: errorLog.logWarning(assignment.location, "Unknown module header field was skipped."); } @@ -69,6 +80,7 @@ public class ModuleHeader { switch(feature.name) { case "chr": chr = true; break; case "fields": fields = true; break; + case "edo": edo = true; break; default: errorLog.log(feature.location, "Unknown feature " + feature.name + "."); } diff --git a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/internal/parsing/parser/SCLLexer.flex b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/internal/parsing/parser/SCLLexer.flex index 0aafe2872..595c082ca 100644 --- a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/internal/parsing/parser/SCLLexer.flex +++ b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/internal/parsing/parser/SCLLexer.flex @@ -42,6 +42,9 @@ import gnu.trove.list.array.TIntArrayList; public boolean supportCHR() { return context.header == null ? false : context.header.chr; } + public boolean supportEDO() { + return context.header == null ? false : context.header.edo; + } %} letter = [a-zA-Z_] @@ -105,7 +108,7 @@ char_literal = "'" ([^'\\\ufffd] | "\\" [^\ufffd]) "'" do { return sym(SCLTerminals.DO); } eq { return sym(options.supportEq ? SCLTerminals.EQ : SCLTerminals.ID); } mdo { return sym(SCLTerminals.MDO); } - edo { return sym(SCLTerminals.EDO); } + edo { return sym(supportEDO() ? SCLTerminals.EDO : SCLTerminals.ID); } class { return sym(SCLTerminals.CLASS); } effect { return sym(SCLTerminals.EFFECT); } match { return sym(SCLTerminals.MATCH); } diff --git a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/internal/parsing/parser/SCLLexer.java b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/internal/parsing/parser/SCLLexer.java index fb9eb54d5..0caade6bf 100644 --- a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/internal/parsing/parser/SCLLexer.java +++ b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/internal/parsing/parser/SCLLexer.java @@ -12,7 +12,7 @@ import gnu.trove.list.array.TIntArrayList; /** * This class is a scanner generated by * JFlex 1.6.1 - * from the specification file C:/GamsGui/git/platform/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/internal/parsing/parser/SCLLexer.flex + * from the specification file C:/Simugawa.git/git/platform/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/internal/parsing/parser/SCLLexer.flex */ public class SCLLexer { @@ -607,6 +607,9 @@ public class SCLLexer { public boolean supportCHR() { return context.header == null ? false : context.header.chr; } + public boolean supportEDO() { + return context.header == null ? false : context.header.edo; + } /** @@ -1194,7 +1197,7 @@ public class SCLLexer { } case 155: break; case 60: - { return sym(SCLTerminals.EDO); + { return sym(supportEDO() ? SCLTerminals.EDO : SCLTerminals.ID); } case 156: break; case 61: diff --git a/bundles/org.simantics.scl.db/scl/Simantics/GShow.scl b/bundles/org.simantics.scl.db/scl/Simantics/GShow.scl index 693e3e31f..c3e899a8c 100644 --- a/bundles/org.simantics.scl.db/scl/Simantics/GShow.scl +++ b/bundles/org.simantics.scl.db/scl/Simantics/GShow.scl @@ -1,3 +1,7 @@ +module { + features = [edo] +} + include "Simantics/DB" hiding (resourceId) import "http://www.simantics.org/Layer0-1.1" as L0 import "http://www.simantics.org/Modeling-1.2" as MOD 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 a61dc965d..f67b7c8b5 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 @@ -183,6 +183,7 @@ public class ModuleRegressionTests extends TestBase { @Test public void MonadSyntax1() { test(); } @Test public void MonadSyntax3() { test(); } @Test public void MonadSyntax4() { test(); } + @Test public void MonadSyntax5() { 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/MonadSyntax3.scl b/tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/scl/MonadSyntax3.scl index fa36d0e95..1f8876df9 100644 --- a/tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/scl/MonadSyntax3.scl +++ b/tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/scl/MonadSyntax3.scl @@ -1,3 +1,6 @@ +module { + features = [edo] +} import "Prelude" a = ["a", "b"] 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 index c410c98c9..20f15f29e 100644 --- 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 @@ -1,3 +1,6 @@ +module { + features = [edo] +} import "Prelude" main = ignore edo diff --git a/tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/scl/MonadSyntax5.scl b/tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/scl/MonadSyntax5.scl new file mode 100644 index 000000000..35327aa02 --- /dev/null +++ b/tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/scl/MonadSyntax5.scl @@ -0,0 +1,22 @@ +// Old mdo +import "Prelude" + +main = mdo + x <- [1,2] + return $ print "\(x :: Integer)" +-- +1 +2 +[(), ()] +-- +// New mdo +module { + features = [edo] +} +import "Prelude" + +main = mdo + x <- [1,2] + return $ print "\(x :: Integer)" +-- +9:12-9:35: No side-effects allowed here. \ No newline at end of file