bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/expressions/EBind.java

   1 package org.simantics.scl.compiler.elaboration.expressions;
   2
   3 import org.simantics.scl.compiler.common.exceptions.InternalCompilerError;
   4 import org.simantics.scl.compiler.common.names.Names;
   5 import org.simantics.scl.compiler.compilation.CompilationContext;
   6 import org.simantics.scl.compiler.elaboration.contexts.SimplificationContext;
   7 import org.simantics.scl.compiler.elaboration.contexts.TranslationContext;
   8 import org.simantics.scl.compiler.elaboration.contexts.TypingContext;
   9 import org.simantics.scl.compiler.elaboration.expressions.block.BlockType;
  10 import org.simantics.scl.compiler.elaboration.modules.SCLValue;
  11 import org.simantics.scl.compiler.errors.Locations;
  12 import org.simantics.scl.compiler.internal.codegen.references.IVal;
  13 import org.simantics.scl.compiler.internal.codegen.writer.CodeWriter;
  14 import org.simantics.scl.compiler.internal.header.ModuleHeader;
  15 import org.simantics.scl.compiler.types.Type;
  16 import org.simantics.scl.compiler.types.Types;
  17 import org.simantics.scl.compiler.types.exceptions.MatchException;
  18 import org.simantics.scl.compiler.types.exceptions.UnificationException;
  19 import org.simantics.scl.compiler.types.kinds.Kinds;
  20
  21 public class EBind extends SimplifiableExpression {
  22     BlockType blockType;
  23     public Expression pattern;
  24     public Expression value;
  25     public Expression in;
  26     public EVariable monadEvidence;
  27     Type monadType;
  28     Type effect;
  29     Type valueContentType;
  30     Type inContentType;
  31
  32     public EBind(long loc, BlockType blockType, Expression pattern, Expression value, Expression in) {
  33         super(loc);
  34         this.blockType = blockType;
  35         this.pattern = pattern;
  36         this.value = value;
  37         this.in = in;
  38     }
  39
  40     public EBind(long loc, BlockType blockType, Expression pattern, Expression value, Expression in,
  41             SCLValue bindFunction) {
  42         super(loc);
  43         this.blockType = blockType;
  44         this.pattern = pattern;
  45         this.value = value;
  46         this.in = in;
  47     }
  48
  49     @Override
  50     protected void updateType() throws MatchException {
  51         setType(in.getType());
  52     }
  53
  54     @Override
  55     public Expression checkBasicType(TypingContext context, Type requiredType) {
  56         ModuleHeader header = context.getCompilationContext().header;
  57         boolean edo = header != null && header.edo;
  58
  59         monadType = Types.metaVar(Kinds.STAR_TO_STAR);
  60
  61         inContentType = Types.metaVar(Kinds.STAR);
  62         Type monadContent = Types.apply(monadType, inContentType);
  63         try {
  64             Types.unify(requiredType, monadContent);
  65         } catch (UnificationException e) {
  66             context.typeError(location, requiredType, monadContent);
  67             return this;
  68         }
  69
  70         Variable variable = new Variable("monadEvidence");
  71         variable.setType(Types.pred(blockType == BlockType.MonadE ? Types.MONAD_E : Types.MONAD, monadType));
  72         monadEvidence = new EVariable(getLocation(), variable);
  73         monadEvidence.setType(variable.getType());
  74         context.addConstraintDemand(monadEvidence);
  75
  76         pattern = pattern.checkTypeAsPattern(context, Types.metaVar(Kinds.STAR));
  77         valueContentType = pattern.getType();
  78         value = value.checkType(context, Types.apply(monadType, valueContentType));
  79         if(edo)
  80             context.pushEffectUpperBound(location, blockType == BlockType.Monad ? Types.NO_EFFECTS : Types.metaVar(Kinds.EFFECT));
  81         in = in.checkType(context, requiredType);
  82         if(edo) {
  83             effect = context.popEffectUpperBound();
  84             context.declareEffect(location, effect);
  85         }
  86         else
  87             effect = Types.NO_EFFECTS;
  88         Type inType = in.getType();
  89         setType(inType);
  90         return this;
  91     }
  92
  93     @Override
  94     public IVal toVal(CompilationContext context, 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         long loc = getLocation();
 104         monadType = Types.canonical(monadType);
 105         valueContentType = Types.canonical(valueContentType);
 106         effect = Types.canonical(effect);
 107         inContentType = Types.canonical(inContentType);
 108         Type[] types = blockType == BlockType.MonadE
 109                 ? new Type[] {monadType, valueContentType, effect, inContentType}
 110                 : new Type[] {monadType, valueContentType, inContentType};
 111         Expression simplified = new EApply(loc, effect,
 112                 new EConstant(loc, context.getValue(blockType == BlockType.MonadE ? Names.Prelude_bindE : Names.Prelude_bind), types),
 113                 monadEvidence,
 114                 value,
 115                 new ELambda(loc, effect, new Case[] {
 116                     new Case(new Expression[] { pattern }, in)
 117                 }));
 118         simplified.setType(getType());
 119
 120         return simplified.simplify(context);
 121     }
 122
 123     @Override
 124     public Expression resolve(TranslationContext context) {
 125         value = value.resolve(context);
 126
 127         context.pushFrame();
 128         pattern = pattern.resolveAsPattern(context);
 129         in = in.resolve(context);
 130         context.popFrame();
 131
 132         return this;
 133     }
 134
 135     @Override
 136     public void setLocationDeep(long loc) {
 137         if(location == Locations.NO_LOCATION) {
 138             location = loc;
 139             pattern.setLocationDeep(loc);
 140             value.setLocationDeep(loc);
 141             in.setLocationDeep(loc);
 142         }
 143     }
 144
 145     @Override
 146     public void accept(ExpressionVisitor visitor) {
 147         visitor.visit(this);
 148     }
 149
 150     @Override
 151     public Expression accept(ExpressionTransformer transformer) {
 152         return transformer.transform(this);
 153     }
 154
 155 }