1 package org.simantics.scl.compiler.top;
3 import java.util.ArrayList;
5 import org.simantics.scl.compiler.common.names.Name;
6 import org.simantics.scl.compiler.elaboration.expressions.EApply;
7 import org.simantics.scl.compiler.elaboration.expressions.EConstant;
8 import org.simantics.scl.compiler.elaboration.expressions.EEnforce;
9 import org.simantics.scl.compiler.elaboration.expressions.EFieldAccess;
10 import org.simantics.scl.compiler.elaboration.expressions.ELambda;
11 import org.simantics.scl.compiler.elaboration.expressions.ERuleset;
12 import org.simantics.scl.compiler.elaboration.expressions.ESelect;
13 import org.simantics.scl.compiler.elaboration.expressions.ESimpleLambda;
14 import org.simantics.scl.compiler.elaboration.expressions.EWhen;
15 import org.simantics.scl.compiler.elaboration.expressions.Expression;
16 import org.simantics.scl.compiler.elaboration.expressions.Variable;
17 import org.simantics.scl.compiler.elaboration.modules.SCLValue;
18 import org.simantics.scl.compiler.environment.Environment;
19 import org.simantics.scl.compiler.errors.ErrorLog;
20 import org.simantics.scl.compiler.errors.Locations;
21 import org.simantics.scl.compiler.internal.elaboration.utils.ExpressionDecorator;
22 import org.simantics.scl.compiler.types.TCon;
23 import org.simantics.scl.compiler.types.Type;
24 import org.simantics.scl.compiler.types.Types;
26 public class ToplevelEffectDecorator implements ExpressionDecorator {
29 Environment environment;
31 public ToplevelEffectDecorator(ErrorLog errorLog, Environment environment) {
32 this.errorLog = errorLog;
33 this.environment = environment;
36 private static Expression decorate(SCLValue transactionFunction, Type effect, Expression expression) {
37 Variable var = new Variable("_");
38 var.setType(Types.UNIT);
39 Expression trans = new EApply(expression.getLocation(), Types.PROC,
40 new EConstant(transactionFunction,
41 expression.getType()),
42 new ESimpleLambda(Locations.NO_LOCATION, var, effect, expression)
44 if(expression instanceof EApply) {
45 EApply apply = (EApply)expression;
46 trans = apply.toANormalForm(trans);
51 private static final TCon R = Types.con("R/R", "R");
54 public Expression decorate(Expression expression) {
55 if(expression instanceof EApply)
56 return decorateByEffect(expression, ((EApply)expression).getLocalEffect());
57 else if(expression instanceof ESelect
58 || expression instanceof EEnforce
59 || expression instanceof EWhen
60 || expression instanceof EFieldAccess
61 || expression instanceof ERuleset)
62 return decorateByEffect(expression, expression.getEffect());
66 private Expression decorateByEffect(Expression expression, Type effect) {
67 if(effect == Types.NO_EFFECTS)
70 //System.out.println("decorateByEffect(" + expression + ", " + effect + ")");
72 ArrayList<TCon> concreteEffects = new ArrayList<TCon>();
73 effect.collectConcreteEffects(concreteEffects);
74 if(concreteEffects.contains(Types.WRITE_GRAPH)) {
75 Name name = Name.create("Simantics/DB", "syncWrite");
76 SCLValue transactionFunction = environment.getValue(name);
77 if(transactionFunction == null) {
78 errorLog.log(expression.location, "Cannot locate " + name);
82 expression = decorate(transactionFunction, Types.WRITE_GRAPH, expression);
84 else if(concreteEffects.contains(Types.READ_GRAPH)) {
85 Name name = Name.create("Simantics/DB", "syncRead");
86 SCLValue transactionFunction = environment.getValue(name);
87 if(transactionFunction == null) {
88 errorLog.log(expression.location, "Cannot locate " + name);
92 expression = decorate(transactionFunction, Types.READ_GRAPH, expression);
94 if(concreteEffects.contains(R)) {
95 Name name = Name.create("R/R", "runR");
96 SCLValue transactionFunction = environment.getValue(name);
97 if(transactionFunction == null) {
98 errorLog.log(expression.location, "Cannot locate " + name);
102 expression = decorate(transactionFunction, R, expression);
104 if(concreteEffects.contains(Types.RANDOM)) {
105 Name name = Name.create("Random", "runRandom");
106 SCLValue transactionFunction = environment.getValue(name);
107 if(transactionFunction == null) {
108 errorLog.log(expression.location, "Cannot locate " + name);
112 expression = decorate(transactionFunction, Types.RANDOM, expression);
118 public boolean decorateSubstructure(Expression expression) {
119 if(expression instanceof ELambda || expression instanceof ESimpleLambda)