Merge "(refs #7508) Edo and modified mdo under edo feature"

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 5664db7bfdd768f17dbbda87c45a5c6abb8ae995..84cc220c1a0222e75def8781fe657eaff1a88aa3 100644 (file)
--- 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 0ab17f83478313ee3f5df5209850ce3178b198ef..7362b38ee1c81db4da85d7261640b273800e27fb 100644 (file)
--- 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 0aafe287261101a5ac1d099ae9b3c988e223a40b..595c082ca4c70151f946cf37a63353d4a078bd2e 100644 (file)
--- 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 fb9eb54d518293a91d5f3baab61b931a130c1e23..0caade6bf77160202c519831b25f30bd2365b5e9 100644 (file)
--- 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 
  * <a href="http://www.jflex.de/">JFlex</a> 1.6.1
- * from the specification file <tt>C:/GamsGui/git/platform/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/internal/parsing/parser/SCLLexer.flex</tt>
+ * from the specification file <tt>C:/Simugawa.git/git/platform/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/internal/parsing/parser/SCLLexer.flex</tt>
  */
 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 693e3e31f4565fcba87d3ab494070fe878e22457..c3e899a8c06ff2b83956144f359f17e7a2cb3ae1 100644 (file)
--- 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 23ae54a976c5563696f6144e5393c048a6a5f0d9..2321a93f6e57bc87d8d79d0ad4e696f1b72f7670 100644 (file)
--- 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
@@ -184,6 +184,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 fa36d0e95de90bf5122d13e06aab259b351bf0ba..1f8876df9c89f825af98e5b16ea093032bb07aee 100644 (file)
--- 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 c410c98c9f651a557bbc7ee876f0f8104a3f00d7..20f15f29e95f1dc1749f4a675a381b9852a93150 100644 (file)
--- 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 (file)
index 0000000..35327aa
--- /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