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