Merge "(refs #7508) Added missing effects in the simplification of EBind"
[simantics/platform.git] / 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.types.Type;
15 import org.simantics.scl.compiler.types.Types;
16 import org.simantics.scl.compiler.types.exceptions.MatchException;
17 import org.simantics.scl.compiler.types.exceptions.UnificationException;
18 import org.simantics.scl.compiler.types.kinds.Kinds;
19
20 public class EBind extends SimplifiableExpression {
21     BlockType blockType;
22     public Expression pattern;
23     public Expression value;
24     public Expression in;
25     public EVariable monadEvidence;
26     Type monadType;
27     Type effect;
28     Type valueContentType;
29     Type inContentType;
30     
31     public EBind(long loc, BlockType blockType, Expression pattern, Expression value, Expression in) {
32         super(loc);
33         this.blockType = blockType;
34         this.pattern = pattern;
35         this.value = value;
36         this.in = in;
37     }
38
39     public EBind(long loc, BlockType blockType, Expression pattern, Expression value, Expression in,
40             SCLValue bindFunction) {
41         super(loc);
42         this.blockType = blockType;
43         this.pattern = pattern;
44         this.value = value;
45         this.in = in;
46     }
47     
48     @Override
49     protected void updateType() throws MatchException {
50         setType(in.getType());
51     }
52     
53     @Override
54     public Expression checkBasicType(TypingContext context, Type requiredType) {
55         monadType = Types.metaVar(Kinds.STAR_TO_STAR);
56         inContentType = Types.metaVar(Kinds.STAR);
57         Type monadContent = Types.apply(monadType, inContentType);
58         try {
59             Types.unify(requiredType, monadContent);
60         } catch (UnificationException e) {
61             context.typeError(location, requiredType, monadContent);
62             return this;
63         }
64         
65         Variable variable = new Variable("monadEvidence");
66         variable.setType(Types.pred(blockType == BlockType.MonadE ? Types.MONAD_E : Types.MONAD, monadType));
67         monadEvidence = new EVariable(getLocation(), variable);
68         monadEvidence.setType(variable.getType());
69         context.addConstraintDemand(monadEvidence);
70         
71         pattern = pattern.checkTypeAsPattern(context, Types.metaVar(Kinds.STAR));
72         valueContentType = pattern.getType();
73         value = value.checkType(context, Types.apply(monadType, valueContentType));
74         context.pushEffectUpperBound(location, blockType == BlockType.Monad ? Types.NO_EFFECTS : Types.metaVar(Kinds.EFFECT));
75         in = in.checkType(context, requiredType);
76         effect = context.popEffectUpperBound();
77         Type inType = in.getType();
78         setType(inType);
79         return this;
80     }
81
82     @Override
83     public IVal toVal(CompilationContext context, CodeWriter w) {
84         throw new InternalCompilerError("EBind should be eliminated.");
85     }
86
87     /**
88      * Splits let 
89      */
90     @Override
91     public Expression simplify(SimplificationContext context) {    
92         long loc = getLocation();
93         monadType = Types.canonical(monadType);
94         valueContentType = Types.canonical(valueContentType);
95         effect = Types.canonical(effect);
96         inContentType = Types.canonical(inContentType);
97         Type[] types = blockType == BlockType.MonadE 
98                 ? new Type[] {monadType, valueContentType, effect, inContentType} 
99                 : new Type[] {monadType, valueContentType, inContentType};
100         Expression simplified = new EApply(loc, effect,
101                 new EConstant(loc, context.getValue(blockType == BlockType.MonadE ? Names.Prelude_bindE : Names.Prelude_bind), types),
102                 monadEvidence, 
103                 value,
104                 new ELambda(loc, effect, new Case[] {
105                     new Case(new Expression[] { pattern }, in)
106                 }));
107         simplified.setType(getType());
108         
109         return simplified.simplify(context);
110     }
111
112     @Override
113     public Expression resolve(TranslationContext context) {
114         value = value.resolve(context);
115         
116         context.pushFrame();
117         pattern = pattern.resolveAsPattern(context);        
118         in = in.resolve(context);
119         context.popFrame();
120         
121         return this; 
122     }
123     
124     @Override
125     public void setLocationDeep(long loc) {
126         if(location == Locations.NO_LOCATION) {
127             location = loc;
128             pattern.setLocationDeep(loc);
129             value.setLocationDeep(loc);
130             in.setLocationDeep(loc);
131         }
132     }
133     
134     @Override
135     public void accept(ExpressionVisitor visitor) {
136         visitor.visit(this);
137     }
138     
139     @Override
140     public Expression accept(ExpressionTransformer transformer) {
141         return transformer.transform(this);
142     }
143
144 }