X-Git-Url: https://gerrit.simantics.org/r/gitweb?p=simantics%2Fplatform.git;a=blobdiff_plain;f=bundles%2Forg.simantics.scl.compiler%2Fsrc%2Forg%2Fsimantics%2Fscl%2Fcompiler%2Ftop%2FToplevelEffectDecorator.java;h=da4ce4febc22363f8ba3dd02d5b6a54893433d97;hp=5a3c39e60a3fcecd9f56bf68cc6a2a8f32cf85d1;hb=747231cca0974ca9ed5f78caa6517ee9dcb8e4fc;hpb=db00b51c6ab9c63883de134e669b5da5be0f1bd5 diff --git a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/top/ToplevelEffectDecorator.java b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/top/ToplevelEffectDecorator.java index 5a3c39e60..da4ce4feb 100644 --- a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/top/ToplevelEffectDecorator.java +++ b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/top/ToplevelEffectDecorator.java @@ -4,7 +4,9 @@ import java.util.ArrayList; 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; @@ -14,17 +16,19 @@ import org.simantics.scl.compiler.elaboration.expressions.ESelect; import org.simantics.scl.compiler.elaboration.expressions.ESimpleLambda; import org.simantics.scl.compiler.elaboration.expressions.EWhen; import org.simantics.scl.compiler.elaboration.expressions.Expression; +import org.simantics.scl.compiler.elaboration.expressions.StandardExpressionTransformer; import org.simantics.scl.compiler.elaboration.expressions.Variable; 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; @@ -34,92 +38,101 @@ public class ToplevelEffectDecorator implements ExpressionDecorator { 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 DECORATION_MAP = new THashMap(); + + 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 concreteEffects = new ArrayList(); 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; } - }