]> gerrit.simantics Code Review - simantics/platform.git/blob
84cc220c1a0222e75def8781fe657eaff1a88aa3
[simantics/platform.git] /
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         else
85             effect = Types.NO_EFFECTS;
86         Type inType = in.getType();
87         setType(inType);
88         return this;
89     }
90
91     @Override
92     public IVal toVal(CompilationContext context, CodeWriter w) {
93         throw new InternalCompilerError("EBind should be eliminated.");
94     }
95
96     /**
97      * Splits let 
98      */
99     @Override
100     public Expression simplify(SimplificationContext context) {    
101         long loc = getLocation();
102         monadType = Types.canonical(monadType);
103         valueContentType = Types.canonical(valueContentType);
104         effect = Types.canonical(effect);
105         inContentType = Types.canonical(inContentType);
106         Type[] types = blockType == BlockType.MonadE 
107                 ? new Type[] {monadType, valueContentType, effect, inContentType} 
108                 : new Type[] {monadType, valueContentType, inContentType};
109         Expression simplified = new EApply(loc, effect,
110                 new EConstant(loc, context.getValue(blockType == BlockType.MonadE ? Names.Prelude_bindE : Names.Prelude_bind), types),
111                 monadEvidence, 
112                 value,
113                 new ELambda(loc, effect, new Case[] {
114                     new Case(new Expression[] { pattern }, in)
115                 }));
116         simplified.setType(getType());
117         
118         return simplified.simplify(context);
119     }
120
121     @Override
122     public Expression resolve(TranslationContext context) {
123         value = value.resolve(context);
124         
125         context.pushFrame();
126         pattern = pattern.resolveAsPattern(context);        
127         in = in.resolve(context);
128         context.popFrame();
129         
130         return this; 
131     }
132     
133     @Override
134     public void setLocationDeep(long loc) {
135         if(location == Locations.NO_LOCATION) {
136             location = loc;
137             pattern.setLocationDeep(loc);
138             value.setLocationDeep(loc);
139             in.setLocationDeep(loc);
140         }
141     }
142     
143     @Override
144     public void accept(ExpressionVisitor visitor) {
145         visitor.visit(this);
146     }
147     
148     @Override
149     public Expression accept(ExpressionTransformer transformer) {
150         return transformer.transform(this);
151     }
152
153 }