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.common.names.Names;
7 import org.simantics.scl.compiler.elaboration.expressions.EApply;
8 import org.simantics.scl.compiler.elaboration.expressions.EConstant;
9 import org.simantics.scl.compiler.elaboration.expressions.EEnforce;
10 import org.simantics.scl.compiler.elaboration.expressions.EFieldAccess;
11 import org.simantics.scl.compiler.elaboration.expressions.ELambda;
12 import org.simantics.scl.compiler.elaboration.expressions.ERuleset;
13 import org.simantics.scl.compiler.elaboration.expressions.ESelect;
14 import org.simantics.scl.compiler.elaboration.expressions.ESimpleLambda;
15 import org.simantics.scl.compiler.elaboration.expressions.EWhen;
16 import org.simantics.scl.compiler.elaboration.expressions.Expression;
17 import org.simantics.scl.compiler.elaboration.expressions.Variable;
18 import org.simantics.scl.compiler.elaboration.modules.SCLValue;
19 import org.simantics.scl.compiler.environment.Environment;
20 import org.simantics.scl.compiler.errors.ErrorLog;
21 import org.simantics.scl.compiler.errors.Locations;
22 import org.simantics.scl.compiler.internal.elaboration.utils.ExpressionDecorator;
23 import org.simantics.scl.compiler.types.TCon;
24 import org.simantics.scl.compiler.types.Type;
25 import org.simantics.scl.compiler.types.Types;
27 public class ToplevelEffectDecorator implements ExpressionDecorator {
30 Environment environment;
32 public ToplevelEffectDecorator(ErrorLog errorLog, Environment environment) {
33 this.errorLog = errorLog;
34 this.environment = environment;
37 private static Expression decorate(SCLValue transactionFunction, Type effect, Expression expression) {
38 Variable var = new Variable("_");
39 var.setType(Types.UNIT);
40 Expression trans = new EApply(expression.getLocation(), Types.PROC,
41 new EConstant(transactionFunction,
42 expression.getType()),
43 new ESimpleLambda(Locations.NO_LOCATION, var, effect, expression)
45 if(expression instanceof EApply) {
46 EApply apply = (EApply)expression;
47 trans = apply.toANormalForm(trans);
52 private static final TCon R = Types.con("R/R", "R");
55 public Expression decorate(Expression expression) {
56 if(expression instanceof EApply)
57 return decorateByEffect(expression, ((EApply)expression).getLocalEffect());
58 else if(expression instanceof ESelect
59 || expression instanceof EEnforce
60 || expression instanceof EWhen
61 || expression instanceof EFieldAccess
62 || expression instanceof ERuleset)
63 return decorateByEffect(expression, expression.getEffect());
67 private Expression decorateByEffect(Expression expression, Type effect) {
68 if(effect == Types.NO_EFFECTS)
71 //System.out.println("decorateByEffect(" + expression + ", " + effect + ")");
73 ArrayList<TCon> concreteEffects = new ArrayList<TCon>();
74 effect.collectConcreteEffects(concreteEffects);
75 if(concreteEffects.contains(Types.WRITE_GRAPH)) {
76 Name name = Names.Simantics_DB_syncWrite;
77 SCLValue transactionFunction = environment.getValue(name);
78 if(transactionFunction == null) {
79 errorLog.log(expression.location, "Cannot locate " + name);
83 expression = decorate(transactionFunction, Types.WRITE_GRAPH, expression);
85 else if(concreteEffects.contains(Types.READ_GRAPH)) {
86 Name name = Names.Simantics_DB_syncRead;
87 SCLValue transactionFunction = environment.getValue(name);
88 if(transactionFunction == null) {
89 errorLog.log(expression.location, "Cannot locate " + name);
93 expression = decorate(transactionFunction, Types.READ_GRAPH, expression);
95 if(concreteEffects.contains(R)) {
96 Name name = Names.R_R_runR;
97 SCLValue transactionFunction = environment.getValue(name);
98 if(transactionFunction == null) {
99 errorLog.log(expression.location, "Cannot locate " + name);
103 expression = decorate(transactionFunction, R, expression);
105 if(concreteEffects.contains(Types.RANDOM)) {
106 Name name = Names.Random_runRandom;
107 SCLValue transactionFunction = environment.getValue(name);
108 if(transactionFunction == null) {
109 errorLog.log(expression.location, "Cannot locate " + name);
113 expression = decorate(transactionFunction, Types.RANDOM, expression);
119 public boolean decorateSubstructure(Expression expression) {
120 if(expression instanceof ELambda || expression instanceof ESimpleLambda)