gerrit.simantics Code Review - simantics/platform.git/blob

   1 package org.simantics.scl.compiler.elaboration.expressions;
   2
   3 import org.simantics.scl.compiler.common.exceptions.InternalCompilerError;
   4 import org.simantics.scl.compiler.elaboration.contexts.SimplificationContext;
   5 import org.simantics.scl.compiler.elaboration.contexts.TranslationContext;
   6 import org.simantics.scl.compiler.elaboration.contexts.TypingContext;
   7 import org.simantics.scl.compiler.elaboration.modules.SCLValue;
   8 import org.simantics.scl.compiler.environment.Environment;
   9 import org.simantics.scl.compiler.errors.Locations;
  10 import org.simantics.scl.compiler.internal.codegen.references.IVal;
  11 import org.simantics.scl.compiler.internal.codegen.writer.CodeWriter;
  12 import org.simantics.scl.compiler.internal.elaboration.utils.ExpressionDecorator;
  13 import org.simantics.scl.compiler.types.Type;
  14 import org.simantics.scl.compiler.types.Types;
  15 import org.simantics.scl.compiler.types.exceptions.MatchException;
  16 import org.simantics.scl.compiler.types.exceptions.UnificationException;
  17 import org.simantics.scl.compiler.types.kinds.Kinds;
  18
  19 import gnu.trove.map.hash.TObjectIntHashMap;
  20 import gnu.trove.set.hash.THashSet;
  21 import gnu.trove.set.hash.TIntHashSet;
  22
  23 public class EBind extends SimplifiableExpression {
  24     public Expression pattern;
  25     public Expression value;
  26     public Expression in;
  27     private EVariable monadEvidence;
  28     SCLValue bindFunction;
  29     Type monadType;
  30     Type valueContentType;
  31     Type inContentType;
  32
  33     public EBind(long loc, Expression pattern, Expression value, Expression in) {
  34         super(loc);
  35         this.pattern = pattern;
  36         this.value = value;
  37         this.in = in;
  38     }
  39
  40     public EBind(long loc, Expression pattern, Expression value, Expression in,
  41             SCLValue bindFunction) {
  42         super(loc);
  43         this.pattern = pattern;
  44         this.value = value;
  45         this.in = in;
  46     }
  47
  48     @Override
  49     public void collectRefs(final TObjectIntHashMap<Object> allRefs, final TIntHashSet refs) {
  50         value.collectRefs(allRefs, refs);
  51         in.collectRefs(allRefs, refs);
  52     }
  53
  54     @Override
  55     public void collectVars(TObjectIntHashMap<Variable> allVars,
  56             TIntHashSet vars) {
  57         value.collectVars(allVars, vars);
  58         in.collectVars(allVars, vars);
  59     }
  60
  61     @Override
  62     protected void updateType() throws MatchException {
  63         setType(in.getType());
  64     }
  65
  66     @Override
  67     public Expression checkBasicType(TypingContext context, Type requiredType) {
  68         monadType = Types.metaVar(Kinds.STAR_TO_STAR);
  69         inContentType = Types.metaVar(Kinds.STAR);
  70         Type monadContent = Types.apply(monadType, inContentType);
  71         try {
  72             Types.unify(requiredType, monadContent);
  73         } catch (UnificationException e) {
  74             context.typeError(location, requiredType, monadContent);
  75             return this;
  76         }
  77
  78         Variable variable = new Variable("monadEvidence");
  79         variable.setType(Types.pred(Types.MONAD, monadType));
  80         monadEvidence = new EVariable(getLocation(), variable);
  81         monadEvidence.setType(variable.getType());
  82         context.addConstraintDemand(monadEvidence);
  83
  84         pattern = pattern.checkTypeAsPattern(context, Types.metaVar(Kinds.STAR));
  85         valueContentType = pattern.getType();
  86         value = value.checkType(context, Types.apply(monadType, valueContentType));
  87         in = in.checkType(context, requiredType);
  88         Type inType = in.getType();
  89         setType(inType);
  90         return this;
  91     }
  92
  93     @Override
  94     public IVal toVal(Environment env, CodeWriter w) {
  95         throw new InternalCompilerError("EBind should be eliminated.");
  96     }
  97
  98     /**
  99      * Splits let
 100      */
 101     @Override
 102     public Expression simplify(SimplificationContext context) {
 103         value = value.simplify(context);
 104         in = in.simplify(context);
 105         pattern = pattern.simplify(context);
 106
 107         long loc = getLocation();
 108         Expression simplified = new EApply(loc,
 109                 new EConstant(loc, bindFunction, Types.canonical(monadType), Types.canonical(valueContentType), Types.canonical(inContentType)),
 110                 monadEvidence,
 111                 value,
 112                 new ELambda(loc, new Case[] {
 113                     new Case(new Expression[] { pattern }, in)
 114                 }));
 115         simplified.setType(getType());
 116
 117         return simplified.simplify(context);
 118     }
 119
 120     @Override
 121     public void collectFreeVariables(THashSet<Variable> vars) {
 122         in.collectFreeVariables(vars);
 123         value.collectFreeVariables(vars);
 124         pattern.removeFreeVariables(vars);
 125     }
 126
 127     @Override
 128     public Expression resolve(TranslationContext context) {
 129         value = value.resolve(context);
 130
 131         context.pushFrame();
 132         pattern = pattern.resolveAsPattern(context);
 133         in = in.resolve(context);
 134         context.popFrame();
 135
 136         bindFunction = context.getBindFunction();
 137
 138         return this;
 139     }
 140
 141     @Override
 142     public Expression decorate(ExpressionDecorator decorator) {
 143         pattern = pattern.decorate(decorator);
 144         value = value.decorate(decorator);
 145         in = in.decorate(decorator);
 146         return decorator.decorate(this);
 147     }
 148
 149     @Override
 150     public void collectEffects(THashSet<Type> effects) {
 151         pattern.collectEffects(effects);
 152         value.collectEffects(effects);
 153         in.collectEffects(effects);
 154     }
 155
 156     @Override
 157     public void setLocationDeep(long loc) {
 158         if(location == Locations.NO_LOCATION) {
 159             location = loc;
 160             pattern.setLocationDeep(loc);
 161             value.setLocationDeep(loc);
 162             in.setLocationDeep(loc);
 163         }
 164     }
 165
 166     @Override
 167     public void accept(ExpressionVisitor visitor) {
 168         visitor.visit(this);
 169     }
 170
 171     @Override
 172     public void forVariables(VariableProcedure procedure) {
 173         pattern.forVariables(procedure);
 174         value.forVariables(procedure);
 175         if(monadEvidence != null)
 176             monadEvidence.forVariables(procedure);
 177     }
 178
 179     @Override
 180     public Expression accept(ExpressionTransformer transformer) {
 181         return transformer.transform(this);
 182     }
 183
 184 }