-package org.simantics.scl.compiler.elaboration.expressions;\r
-\r
-import java.util.ArrayList;\r
-\r
-import org.simantics.scl.compiler.common.names.Name;\r
-import org.simantics.scl.compiler.common.precedence.Precedence;\r
-import org.simantics.scl.compiler.constants.Constant;\r
-import org.simantics.scl.compiler.elaboration.contexts.ReplaceContext;\r
-import org.simantics.scl.compiler.elaboration.contexts.SimplificationContext;\r
-import org.simantics.scl.compiler.elaboration.contexts.TranslationContext;\r
-import org.simantics.scl.compiler.elaboration.contexts.TypingContext;\r
-import org.simantics.scl.compiler.elaboration.errors.NotPatternException;\r
-import org.simantics.scl.compiler.elaboration.expressions.lhstype.LhsType;\r
-import org.simantics.scl.compiler.elaboration.expressions.lhstype.PatternMatchingLhs;\r
-import org.simantics.scl.compiler.elaboration.modules.SCLValue;\r
-import org.simantics.scl.compiler.environment.Environment;\r
-import org.simantics.scl.compiler.errors.Locations;\r
-import org.simantics.scl.compiler.internal.codegen.references.IVal;\r
-import org.simantics.scl.compiler.internal.codegen.writer.CodeWriter;\r
-import org.simantics.scl.compiler.internal.elaboration.utils.ExpressionDecorator;\r
-import org.simantics.scl.compiler.internal.interpreted.IConstant;\r
-import org.simantics.scl.compiler.internal.interpreted.IExpression;\r
-import org.simantics.scl.compiler.top.ExpressionInterpretationContext;\r
-import org.simantics.scl.compiler.top.SCLCompilerConfiguration;\r
-import org.simantics.scl.compiler.top.ValueNotFound;\r
-import org.simantics.scl.compiler.types.TForAll;\r
-import org.simantics.scl.compiler.types.TMetaVar;\r
-import org.simantics.scl.compiler.types.Type;\r
-import org.simantics.scl.compiler.types.Types;\r
-import org.simantics.scl.compiler.types.exceptions.MatchException;\r
-import org.simantics.scl.compiler.types.util.MultiFunction;\r
-import org.simantics.scl.compiler.types.util.TypeUnparsingContext;\r
-\r
-import gnu.trove.map.hash.TObjectIntHashMap;\r
-import gnu.trove.set.hash.THashSet;\r
-import gnu.trove.set.hash.TIntHashSet;\r
-\r
-public class EConstant extends Expression {\r
- SCLValue value;\r
- Type[] typeParameters;\r
- \r
- public EConstant(SCLValue value, Type ... typeParameters) {\r
- if(SCLCompilerConfiguration.DEBUG)\r
- if(value == null)\r
- throw new NullPointerException();\r
- this.value = value;\r
- this.typeParameters = typeParameters;\r
- }\r
-\r
- public EConstant(SCLValue value) {\r
- if(SCLCompilerConfiguration.DEBUG)\r
- if(value == null)\r
- throw new NullPointerException();\r
- this.value = value;\r
- this.typeParameters = Type.EMPTY_ARRAY;\r
- }\r
-\r
- public EConstant(long loc, SCLValue value) {\r
- super(loc);\r
- if(SCLCompilerConfiguration.DEBUG)\r
- if(value == null)\r
- throw new NullPointerException();\r
- this.value = value;\r
- this.typeParameters = Type.EMPTY_ARRAY;\r
- }\r
- \r
- public EConstant(long loc, SCLValue value, Type ... typeParameters) {\r
- super(loc);\r
- if(SCLCompilerConfiguration.DEBUG)\r
- if(value == null)\r
- throw new NullPointerException();\r
- this.value = value;\r
- this.typeParameters = typeParameters;\r
- }\r
-\r
- public void addTypeParameters(Type ... newTypeParameters) {\r
- typeParameters = Types.concat(typeParameters, newTypeParameters);\r
- }\r
- \r
- public Expression applyType(Type type) {\r
- typeParameters = Types.concat(typeParameters, new Type[] {type});\r
- if(getType() != null)\r
- setType(Types.instantiate(getType(), type));\r
- return this;\r
- }\r
-\r
- public void collectRefs(TObjectIntHashMap<Object> allRefs, TIntHashSet refs) {\r
- int id = allRefs.get(value);\r
- if(id >= 0)\r
- refs.add(id);\r
- }\r
- \r
- @Override\r
- public void collectVars(TObjectIntHashMap<Variable> allVars,\r
- TIntHashSet vars) { \r
- }\r
-\r
- public void toString(StringBuilder b, TypeUnparsingContext tuc) {\r
- Name name = value.getName();\r
- if(name.module.equals("Builtin") || name.module.equals("Prelude"))\r
- b.append(name.name);\r
- else\r
- b.append(name);\r
- /*for(Type type : typeParameters) {\r
- b.append(" <");\r
- b.append(type.toString(tuc));\r
- b.append(">");\r
- }*/\r
- }\r
-\r
- @Override\r
- protected void updateType() throws MatchException {\r
- setType(Types.instantiate(value.getType(), typeParameters));\r
- }\r
- \r
- @Override\r
- public IVal toVal(Environment env, CodeWriter w) {\r
- IVal val = value.getValue(); \r
- if(typeParameters.length > 0) {\r
- val = val.createSpecialization(typeParameters);\r
- }\r
- return val;\r
- }\r
-\r
- @Override\r
- public void collectFreeVariables(THashSet<Variable> vars) {\r
- }\r
-\r
- @Override\r
- public Expression simplify(SimplificationContext context) {\r
- if(value.getInlineInSimplification()) {\r
- if(typeParameters.length > 0) {\r
- context.getErrorLog().log(location, \r
- "Inlining with type parameters not currently supported in simplification.");\r
- return this;\r
- }\r
- else\r
- return value.getExpression().copy().simplify(context);\r
- }\r
- return this;\r
- }\r
-\r
- @Override\r
- public Expression resolve(TranslationContext context) {\r
- return this;\r
- }\r
- \r
- @Override\r
- public void getParameters(TranslationContext translationContext,\r
- ArrayList<Expression> parameters) {\r
- }\r
- \r
- public SCLValue getValue() {\r
- return value;\r
- }\r
- \r
- @Override\r
- public Expression resolveAsPattern(TranslationContext context) {\r
- return this;\r
- }\r
- \r
- @Override\r
- public void removeFreeVariables(THashSet<Variable> vars) { \r
- }\r
-\r
- @Override\r
- public Expression replace(ReplaceContext context) {\r
- Type[] newTypeParameters;\r
- if(typeParameters.length == 0)\r
- newTypeParameters = Type.EMPTY_ARRAY;\r
- else {\r
- newTypeParameters = new Type[typeParameters.length];\r
- for(int i=0;i<newTypeParameters.length;++i)\r
- newTypeParameters[i] = typeParameters[i].replace(context.tvarMap);\r
- }\r
- return new EConstant(value, newTypeParameters);\r
- }\r
- \r
- public Type[] getTypeParameters() {\r
- return typeParameters;\r
- }\r
-\r
- @Override\r
- public LhsType getLhsType() throws NotPatternException {\r
- return new PatternMatchingLhs();\r
- }\r
- \r
- @Override\r
- public IExpression toIExpression(ExpressionInterpretationContext target) {\r
- Name name = value.getName();\r
- try {\r
- return new IConstant(target.runtimeEnvironment.getRuntimeModule(name.module).getValue(name.name));\r
- } catch (ValueNotFound e) {\r
- throw new UnsupportedOperationException();\r
- }\r
- }\r
- \r
- @Override\r
- public Expression inferType(TypingContext context) {\r
- if(context.recursiveValues != null &&\r
- context.recursiveValues.contains(value)) {\r
- // Handles the case where the constant is one of the recursive definitions we are currently checking\r
- // This kind of value is not yet generalized, i.e. it is not necessary to instantiate it.\r
- EPlaceholder placeholder = new EPlaceholder(location, this);\r
- placeholder.setType(value.getType());\r
- \r
- context.recursiveReferences.add(placeholder);\r
- return placeholder;\r
- }\r
- else if(context.isInPattern()) {\r
- /* This is little hackish code that handles the following kind of constructors:\r
- * data Thunk a = Thunk s (a -> s)\r
- * in\r
- * match thunk with Thunk s f -> f s\r
- * We cannot assign s with an unbound metaVar because its type depends on \r
- * how it has been constructed. Therefore we parametrize the function with\r
- * existential variable.\r
- */\r
- Type resultType = value.getType();\r
- if(resultType instanceof TForAll) {\r
- ArrayList<TMetaVar> vars = new ArrayList<TMetaVar>(); \r
- resultType = Types.instantiate(resultType, vars);\r
- MultiFunction mfun = Types.matchFunction(resultType);\r
- resultType = mfun.returnType;\r
- \r
- for(TMetaVar var : vars) {\r
- if(resultType.contains(var))\r
- break;\r
- addTypeParameters(Types.var(var.getKind())); \r
- }\r
- }\r
- return this;\r
- }\r
- else\r
- return applyPUnit(context);\r
- }\r
-\r
- @Override\r
- public Expression decorate(ExpressionDecorator decorator) {\r
- return decorator.decorate(this);\r
- }\r
- \r
- @Override\r
- public boolean isEffectful() {\r
- return false;\r
- }\r
-\r
- @Override\r
- public void collectEffects(THashSet<Type> effects) {\r
- }\r
- \r
- @Override\r
- public void setLocationDeep(long loc) {\r
- if(location == Locations.NO_LOCATION)\r
- location = loc;\r
- }\r
- \r
- @Override\r
- public void accept(ExpressionVisitor visitor) {\r
- visitor.visit(this);\r
- }\r
- \r
- @Override\r
- public Precedence getPrecedence() {\r
- return value.getPrecedence();\r
- }\r
-\r
- @Override\r
- public void forVariables(VariableProcedure procedure) {\r
- }\r
- \r
- @Override\r
- public boolean isPattern(int arity) {\r
- IVal val = value.getValue();\r
- if(!(val instanceof Constant))\r
- return false;\r
- Constant constant = (Constant)val;\r
- return constant.constructorTag() >= 0 && constant.getArity() == arity;\r
- }\r
- \r
- @Override\r
- public Expression accept(ExpressionTransformer transformer) {\r
- return transformer.transform(this);\r
- }\r
-\r
-}\r
+package org.simantics.scl.compiler.elaboration.expressions;
+
+import java.util.ArrayList;
+import java.util.Collections;
+import java.util.Set;
+
+import org.simantics.scl.compiler.common.names.Name;
+import org.simantics.scl.compiler.common.precedence.Precedence;
+import org.simantics.scl.compiler.compilation.CompilationContext;
+import org.simantics.scl.compiler.constants.Constant;
+import org.simantics.scl.compiler.elaboration.contexts.ReplaceContext;
+import org.simantics.scl.compiler.elaboration.contexts.SimplificationContext;
+import org.simantics.scl.compiler.elaboration.contexts.TranslationContext;
+import org.simantics.scl.compiler.elaboration.contexts.TypingContext;
+import org.simantics.scl.compiler.elaboration.errors.NotPatternException;
+import org.simantics.scl.compiler.elaboration.expressions.lhstype.LhsType;
+import org.simantics.scl.compiler.elaboration.expressions.lhstype.PatternMatchingLhs;
+import org.simantics.scl.compiler.elaboration.java.DynamicConstructor;
+import org.simantics.scl.compiler.elaboration.modules.SCLValue;
+import org.simantics.scl.compiler.errors.Locations;
+import org.simantics.scl.compiler.internal.codegen.references.IVal;
+import org.simantics.scl.compiler.internal.codegen.writer.CodeWriter;
+import org.simantics.scl.compiler.internal.interpreted.IConstant;
+import org.simantics.scl.compiler.internal.interpreted.IExpression;
+import org.simantics.scl.compiler.top.ExpressionInterpretationContext;
+import org.simantics.scl.compiler.top.SCLCompilerConfiguration;
+import org.simantics.scl.compiler.top.ValueNotFound;
+import org.simantics.scl.compiler.types.TForAll;
+import org.simantics.scl.compiler.types.TMetaVar;
+import org.simantics.scl.compiler.types.Type;
+import org.simantics.scl.compiler.types.Types;
+import org.simantics.scl.compiler.types.exceptions.MatchException;
+import org.simantics.scl.compiler.types.util.MultiFunction;
+import org.simantics.scl.compiler.types.util.TypeUnparsingContext;
+
+public class EConstant extends Expression {
+ public SCLValue value;
+ Type[] typeParameters;
+
+ public EConstant(SCLValue value, Type ... typeParameters) {
+ if(SCLCompilerConfiguration.DEBUG)
+ if(value == null)
+ throw new NullPointerException();
+ this.value = value;
+ this.typeParameters = typeParameters;
+ }
+
+ public EConstant(SCLValue value) {
+ if(SCLCompilerConfiguration.DEBUG)
+ if(value == null)
+ throw new NullPointerException();
+ this.value = value;
+ this.typeParameters = Type.EMPTY_ARRAY;
+ }
+
+ public EConstant(long loc, SCLValue value) {
+ super(loc);
+ if(SCLCompilerConfiguration.DEBUG)
+ if(value == null)
+ throw new NullPointerException();
+ this.value = value;
+ this.typeParameters = Type.EMPTY_ARRAY;
+ }
+
+ public EConstant(long loc, SCLValue value, Type ... typeParameters) {
+ super(loc);
+ if(SCLCompilerConfiguration.DEBUG)
+ if(value == null)
+ throw new NullPointerException();
+ this.value = value;
+ this.typeParameters = typeParameters;
+ }
+
+ public void addTypeParameters(Type ... newTypeParameters) {
+ typeParameters = Types.concat(typeParameters, newTypeParameters);
+ }
+
+ public Expression applyType(Type type) {
+ typeParameters = Types.concat(typeParameters, new Type[] {type});
+ if(getType() != null)
+ setType(Types.instantiate(getType(), type));
+ return this;
+ }
+
+ @Override
+ public Set<Variable> getFreeVariables() {
+ return Collections.emptySet();
+ }
+
+ public void toString(StringBuilder b, TypeUnparsingContext tuc) {
+ Name name = value.getName();
+ if(name.module.equals("Builtin") || name.module.equals("Prelude"))
+ b.append(name.name);
+ else
+ b.append(name);
+ /*for(Type type : typeParameters) {
+ b.append(" <");
+ b.append(type.toString(tuc));
+ b.append(">");
+ }*/
+ }
+
+ @Override
+ protected void updateType() throws MatchException {
+ setType(Types.instantiate(value.getType(), typeParameters));
+ }
+
+ @Override
+ public IVal toVal(CompilationContext context, CodeWriter w) {
+ IVal val = value.getValue();
+ if(typeParameters.length > 0) {
+ val = val.createSpecialization(typeParameters);
+ }
+ return val;
+ }
+
+ @Override
+ public Expression simplify(SimplificationContext context) {
+ if(value.getInlineInSimplification()) {
+ if(typeParameters.length > 0) {
+ context.getErrorLog().log(location,
+ "Inlining with type parameters not currently supported in simplification.");
+ return this;
+ }
+ else
+ return value.getExpression().copy().simplify(context);
+ }
+ return this;
+ }
+
+ @Override
+ public Expression resolve(TranslationContext context) {
+ return this;
+ }
+
+ @Override
+ public void getParameters(TranslationContext translationContext,
+ ArrayList<Expression> parameters) {
+ }
+
+ public SCLValue getValue() {
+ return value;
+ }
+
+ @Override
+ public Expression resolveAsPattern(TranslationContext context) {
+ return this;
+ }
+
+ @Override
+ public Expression replace(ReplaceContext context) {
+ Type[] newTypeParameters;
+ if(typeParameters.length == 0)
+ newTypeParameters = Type.EMPTY_ARRAY;
+ else {
+ newTypeParameters = new Type[typeParameters.length];
+ for(int i=0;i<newTypeParameters.length;++i)
+ newTypeParameters[i] = typeParameters[i].replace(context.tvarMap);
+ }
+ return new EConstant(value, newTypeParameters);
+ }
+
+ public Type[] getTypeParameters() {
+ return typeParameters;
+ }
+
+ @Override
+ public LhsType getLhsType() throws NotPatternException {
+ return new PatternMatchingLhs();
+ }
+
+ @Override
+ public IExpression toIExpression(ExpressionInterpretationContext target) {
+ Name name = value.getName();
+ try {
+ return new IConstant(target.runtimeEnvironment.getRuntimeModule(name.module).getValue(name.name));
+ } catch (ValueNotFound e) {
+ throw new UnsupportedOperationException();
+ }
+ }
+
+ @Override
+ public Expression inferType(TypingContext context) {
+ if(context.recursiveValues != null &&
+ context.recursiveValues.contains(value)) {
+ // Handles the case where the constant is one of the recursive definitions we are currently checking
+ // This kind of value is not yet generalized, i.e. it is not necessary to instantiate it.
+ EPlaceholder placeholder = new EPlaceholder(location, this);
+ placeholder.setType(value.getType());
+
+ context.recursiveReferences.add(placeholder);
+ return placeholder;
+ }
+ else if(context.isInPattern() && value.getValue() != DynamicConstructor.INSTANCE /* HACK!! */) {
+ /* This is little hackish code that handles the following kind of constructors:
+ * data Thunk a = Thunk s (a -> s)
+ * in
+ * match thunk with Thunk s f -> f s
+ * We cannot assign s with an unbound metaVar because its type depends on
+ * how it has been constructed. Therefore we parametrize the function with
+ * existential variable.
+ */
+ Type resultType = value.getType();
+ if(resultType instanceof TForAll) {
+ ArrayList<TMetaVar> vars = new ArrayList<TMetaVar>();
+ resultType = Types.instantiate(resultType, vars);
+ MultiFunction mfun = Types.matchFunction(resultType);
+ resultType = mfun.returnType;
+
+ for(TMetaVar var : vars) {
+ if(resultType.contains(var))
+ break;
+ addTypeParameters(Types.var(var.getKind()));
+ }
+ }
+ return this;
+ }
+ else
+ return applyPUnit(context);
+ }
+
+ @Override
+ public boolean isEffectful() {
+ return false;
+ }
+
+ @Override
+ public void setLocationDeep(long loc) {
+ if(location == Locations.NO_LOCATION)
+ location = loc;
+ }
+
+ @Override
+ public void accept(ExpressionVisitor visitor) {
+ visitor.visit(this);
+ }
+
+ @Override
+ public Precedence getPrecedence() {
+ return value.getPrecedence();
+ }
+
+ @Override
+ public boolean isPattern(int arity) {
+ IVal val = value.getValue();
+ if(!(val instanceof Constant))
+ return false;
+ Constant constant = (Constant)val;
+ return constant.constructorTag() >= 0 && constant.getArity() == arity;
+ }
+
+ @Override
+ public Expression accept(ExpressionTransformer transformer) {
+ return transformer.transform(this);
+ }
+
+ @Override
+ public boolean equalsExpression(Expression expression) {
+ if(expression.getClass() != getClass())
+ return false;
+ EConstant other = (EConstant)expression;
+ return value == other.value && Types.equals(typeParameters, other.typeParameters);
+ }
+}