import org.simantics.scl.compiler.common.names.Name;
import org.simantics.scl.compiler.common.names.Names;
+import org.simantics.scl.compiler.elaboration.expressions.Case;
import org.simantics.scl.compiler.elaboration.expressions.EApply;
+import org.simantics.scl.compiler.elaboration.expressions.ECHRRuleset;
import org.simantics.scl.compiler.elaboration.expressions.EConstant;
import org.simantics.scl.compiler.elaboration.expressions.EEnforce;
import org.simantics.scl.compiler.elaboration.expressions.EFieldAccess;
import org.simantics.scl.compiler.elaboration.expressions.EWhen;
import org.simantics.scl.compiler.elaboration.expressions.Expression;
import org.simantics.scl.compiler.elaboration.expressions.Variable;
+import org.simantics.scl.compiler.elaboration.expressions.visitors.StandardExpressionTransformer;
import org.simantics.scl.compiler.elaboration.modules.SCLValue;
import org.simantics.scl.compiler.environment.Environment;
import org.simantics.scl.compiler.errors.ErrorLog;
import org.simantics.scl.compiler.errors.Locations;
-import org.simantics.scl.compiler.internal.elaboration.utils.ExpressionDecorator;
import org.simantics.scl.compiler.types.TCon;
import org.simantics.scl.compiler.types.Type;
import org.simantics.scl.compiler.types.Types;
-public class ToplevelEffectDecorator implements ExpressionDecorator {
+import gnu.trove.map.hash.THashMap;
+
+public class ToplevelEffectDecorator extends StandardExpressionTransformer {
ErrorLog errorLog;
Environment environment;
this.environment = environment;
}
- private static Expression decorate(SCLValue transactionFunction, Type effect, Expression expression) {
- Variable var = new Variable("_");
- var.setType(Types.UNIT);
- Expression trans = new EApply(expression.getLocation(), Types.PROC,
- new EConstant(transactionFunction,
- expression.getType()),
- new ESimpleLambda(Locations.NO_LOCATION, var, effect, expression)
- );
- if(expression instanceof EApply) {
- EApply apply = (EApply)expression;
- trans = apply.toANormalForm(trans);
- }
- return trans;
+ @Override
+ public Expression transform(EEnforce expression) {
+ return decorateByEffect(expression, expression.getEffect());
+ }
+
+ @Override
+ public Expression transform(EWhen expression) {
+ return decorateByEffect(expression, expression.getEffect());
+ }
+
+ @Override
+ public Expression transform(ERuleset expression) {
+ return decorateByEffect(expression, expression.getEffect());
+ }
+
+ @Override
+ public Expression transform(ECHRRuleset expression) {
+ return decorateByEffect(expression, expression.getEffect());
+ }
+
+ @Override
+ public Expression transform(EFieldAccess expression) {
+ // Can we encounter EFieldAccess in this transformer?
+ return decorateByEffect(expression, expression.getEffect());
+ }
+
+ @Override
+ public Expression transform(ESelect expression) {
+ return decorateByEffect(expression, expression.getEffect());
}
- private static final TCon R = Types.con("R/R", "R");
+ @Override
+ public Expression transform(EApply expression) {
+ return decorateByEffect(super.transform(expression), expression.getLocalEffect());
+ }
@Override
- public Expression decorate(Expression expression) {
- if(expression instanceof EApply)
- return decorateByEffect(expression, ((EApply)expression).getLocalEffect());
- else if(expression instanceof ESelect
- || expression instanceof EEnforce
- || expression instanceof EWhen
- || expression instanceof EFieldAccess
- || expression instanceof ERuleset)
- return decorateByEffect(expression, expression.getEffect());
+ public Expression transform(ESimpleLambda expression) {
+ // Never has side effects
return expression;
}
+ @Override
+ public Expression transform(ELambda expression) {
+ // Never has side effects
+ return expression;
+ }
+
+ @Override
+ protected void transformCases(Case[] cases) {
+ for(Case case_ : cases)
+ case_.value = case_.value.accept(this);
+ }
+
+ private static final THashMap<TCon, Name> DECORATION_MAP = new THashMap<TCon, Name>();
+
+ static {
+ DECORATION_MAP.put(Types.WRITE_GRAPH, Names.Simantics_DB_syncWrite);
+ DECORATION_MAP.put(Types.READ_GRAPH, Names.Simantics_DB_syncRead);
+ DECORATION_MAP.put(Types.con("R/R", "R"), Names.R_R_runR);
+ DECORATION_MAP.put(Types.RANDOM, Names.Random_runRandom);
+ }
+
private Expression decorateByEffect(Expression expression, Type effect) {
if(effect == Types.NO_EFFECTS)
return expression;
- //System.out.println("decorateByEffect(" + expression + ", " + effect + ")");
-
ArrayList<TCon> concreteEffects = new ArrayList<TCon>();
effect.collectConcreteEffects(concreteEffects);
- if(concreteEffects.contains(Types.WRITE_GRAPH)) {
- Name name = Names.Simantics_DB_syncWrite;
- SCLValue transactionFunction = environment.getValue(name);
+ for(TCon ce : concreteEffects) {
+ Name transactionFunctionName = DECORATION_MAP.get(ce);
+ if(transactionFunctionName == null)
+ continue;
+ SCLValue transactionFunction = environment.getValue(transactionFunctionName);
if(transactionFunction == null) {
- errorLog.log(expression.location, "Cannot locate " + name);
- return expression;
+ errorLog.log(expression.location, "Cannot locate " + transactionFunctionName);
+ continue;
}
-
- expression = decorate(transactionFunction, Types.WRITE_GRAPH, expression);
+ expression = decorate(transactionFunction, ce, expression);
}
- else if(concreteEffects.contains(Types.READ_GRAPH)) {
- Name name = Names.Simantics_DB_syncRead;
- SCLValue transactionFunction = environment.getValue(name);
- if(transactionFunction == null) {
- errorLog.log(expression.location, "Cannot locate " + name);
- return expression;
- }
-
- expression = decorate(transactionFunction, Types.READ_GRAPH, expression);
- }
- if(concreteEffects.contains(R)) {
- Name name = Names.R_R_runR;
- SCLValue transactionFunction = environment.getValue(name);
- if(transactionFunction == null) {
- errorLog.log(expression.location, "Cannot locate " + name);
- return expression;
- }
-
- expression = decorate(transactionFunction, R, expression);
- }
- if(concreteEffects.contains(Types.RANDOM)) {
- Name name = Names.Random_runRandom;
- SCLValue transactionFunction = environment.getValue(name);
- if(transactionFunction == null) {
- errorLog.log(expression.location, "Cannot locate " + name);
- return expression;
- }
- expression = decorate(transactionFunction, Types.RANDOM, expression);
- }
return expression;
}
- @Override
- public boolean decorateSubstructure(Expression expression) {
- if(expression instanceof ELambda || expression instanceof ESimpleLambda)
- return false;
- return true;
+ private static Expression decorate(SCLValue transactionFunction, Type effect, Expression expression) {
+ Variable var = new Variable("_");
+ var.setType(effect == Types.RANDOM ? Types.PUNIT : Types.UNIT);
+ Expression trans = new EApply(expression.getLocation(), Types.PROC,
+ effect == Types.RANDOM ? new EConstant(transactionFunction, Types.PROC, expression.getType()) : new EConstant(transactionFunction, expression.getType()),
+ new ESimpleLambda(Locations.NO_LOCATION, var, effect, expression)
+ );
+ if(expression instanceof EApply) {
+ EApply apply = (EApply)expression;
+ trans = apply.toANormalForm(trans);
+ }
+ return trans;
}
-
}