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;
@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 {
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;
import org.simantics.scl.compiler.errors.ErrorLog;
public class ModuleHeader {
+ public String deprecated;
public String classLoader;
public long classLoaderLocation;
public String defaultLocalName;
// Features
public boolean chr;
public boolean fields;
+ public boolean edo;
private void read(ErrorLog errorLog, FieldAssignment[] fields) {
for(FieldAssignment assignment : fields)
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.");
}
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 + ".");
}
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_]
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); }
/**
* 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 {
public boolean supportCHR() {
return context.header == null ? false : context.header.chr;
}
+ public boolean supportEDO() {
+ return context.header == null ? false : context.header.edo;
+ }
/**
}
case 155: break;
case 60:
- { return sym(SCLTerminals.EDO);
+ { return sym(supportEDO() ? SCLTerminals.EDO : SCLTerminals.ID);
}
case 156: break;
case 61:
+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
@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(); }
+module {
+ features = [edo]
+}
import "Prelude"
a = ["a", "b"]
+module {
+ features = [edo]
+}
import "Prelude"
main = ignore edo
--- /dev/null
+// 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