bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/top/ToplevelEffectDecorator.java

   1 package org.simantics.scl.compiler.top;
   2
   3 import java.util.ArrayList;
   4
   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;
  25
  26 public class ToplevelEffectDecorator implements ExpressionDecorator {
  27
  28     ErrorLog errorLog;
  29     Environment environment;
  30
  31     public ToplevelEffectDecorator(ErrorLog errorLog, Environment environment) {
  32         this.errorLog = errorLog;
  33         this.environment = environment;
  34     }
  35
  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)
  43                 );
  44         if(expression instanceof EApply) {
  45             EApply apply = (EApply)expression;
  46             trans = apply.toANormalForm(trans);
  47         }
  48         return trans;
  49     }
  50
  51     private static final TCon R = Types.con("R/R", "R");
  52
  53     @Override
  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());
  63         return expression;
  64     }
  65
  66     private Expression decorateByEffect(Expression expression, Type effect) {
  67         if(effect == Types.NO_EFFECTS)
  68             return expression;
  69
  70         //System.out.println("decorateByEffect(" + expression + ", " + effect + ")");
  71
  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);
  79                 return expression;
  80             }
  81
  82             expression = decorate(transactionFunction, Types.WRITE_GRAPH, expression);
  83         }
  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);
  89                 return expression;
  90             }
  91
  92             expression = decorate(transactionFunction, Types.READ_GRAPH, expression);
  93         }
  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);
  99                 return expression;
 100             }
 101
 102             expression = decorate(transactionFunction, R, expression);
 103         }
 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);
 109                 return expression;
 110             }
 111
 112             expression = decorate(transactionFunction, Types.RANDOM, expression);
 113         }
 114         return expression;
 115     }
 116
 117     @Override
 118     public boolean decorateSubstructure(Expression expression) {
 119         if(expression instanceof ELambda || expression instanceof ESimpleLambda)
 120             return false;
 121         return true;
 122     }
 123
 124 }