(refs #7746) Fixed applications with intermediate effects 24/1424/2
authorHannu Niemistö <hannu.niemisto@semantum.fi>
Tue, 6 Feb 2018 12:25:27 +0000 (14:25 +0200)
committerJani Simomaa <jani.simomaa@semantum.fi>
Tue, 6 Feb 2018 13:39:30 +0000 (15:39 +0200)
Change-Id: Ida2b7c8e96cbfd45361838e69900a7307e69e343

bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/expressions/EApply.java
bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/expressions/ELambda.java
bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/expressions/printing/ExpressionToStringVisitor.java
bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/types/Types.java
tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/ModuleRegressionTests.java
tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/scl/TypeInferenceBug2.scl
tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/scl/TypeInferenceBug3.scl [new file with mode: 0644]

index 5d915a98dce93b2ac88e2476effaed460e2d25ba..7f50d730b9f0d536fc91f6dfa439f8ccebc43fcd 100644 (file)
@@ -1,6 +1,7 @@
 package org.simantics.scl.compiler.elaboration.expressions;
 
 import java.util.ArrayList;
+import java.util.Arrays;
 
 import org.simantics.scl.compiler.common.names.Name;
 import org.simantics.scl.compiler.common.names.Names;
@@ -28,7 +29,6 @@ import org.simantics.scl.compiler.types.TFun;
 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.exceptions.UnificationException;
 import org.simantics.scl.compiler.types.kinds.Kinds;
 import org.simantics.scl.compiler.types.util.MultiFunction;
 
@@ -220,14 +220,13 @@ public class EApply extends Expression {
         return new IApply(function.toIExpression(target), parametersI);
     }
     
-    private void inferType(TypingContext context, boolean ignoreResult) {
+    private Expression inferType(TypingContext context, boolean ignoreResult) {
         function = function.inferType(context);
         function = context.instantiate(function);
-        MultiFunction mfun;
-        try {
-            mfun = Types.unifyFunction(function.getType(), parameters.length);
-        } catch (UnificationException e) {
-            int arity = Types.getArity(function.getType());
+        Type functionType = function.getType();
+        
+        int arity = Types.getMaxArity(functionType);
+        if(arity < parameters.length) {
             if(arity == 0)
                 context.getErrorLog().log(location, "Application of non-function.");
             else
@@ -236,40 +235,50 @@ public class EApply extends Expression {
             setType(Types.metaVar(Kinds.STAR));
             for(int i=0;i<parameters.length;++i)
                 parameters[i] = parameters[i].inferType(context);
-            return;
-        }
-        if((ignoreResult && Skeletons.canonicalSkeleton(mfun.returnType) instanceof TFun &&
-                Types.canonical(mfun.effect) == Types.NO_EFFECTS) ||
-                (context.isInPattern() && Skeletons.canonicalSkeleton(mfun.returnType) instanceof TFun)) {
-            context.getErrorLog().log(location, "The function is applied with too few parameters.");
+            return this;
         }
         
-        // Check parameter types
-        for(int i=0;i<parameters.length;++i)
-            parameters[i] = parameters[i].checkType(context, mfun.parameterTypes[i]);
+        EApply current = this;
+        while(true) {
+            MultiFunction mfun = Types.unifyFunction2(functionType, current.parameters.length);
+            int marity = mfun.parameterTypes.length;
+            for(int i=0;i<marity;++i)
+                current.parameters[i] = current.parameters[i].checkType(context, mfun.parameterTypes[i]);
+            current.effect = mfun.effect;
+            context.declareEffect(location, mfun.effect);
+            current.setType(mfun.returnType);
 
-        effect = mfun.effect;
-        
-        context.declareEffect(location, mfun.effect);
-        setType(mfun.returnType);
+            if(marity < current.parameters.length) {
+                Expression[] missingParameters = Arrays.copyOfRange(current.parameters, marity, current.parameters.length);
+                functionType = mfun.returnType;
+                current.parameters = Arrays.copyOf(current.parameters, marity);
+                current = new EApply(current, missingParameters);
+            }
+            else {
+                if((ignoreResult && mfun.effect == Types.NO_EFFECTS && Skeletons.canonicalSkeleton(mfun.returnType) instanceof TFun) ||
+                        (context.isInPattern() && Skeletons.canonicalSkeleton(mfun.returnType) instanceof TFun)) {
+                    context.getErrorLog().log(location, "The function is applied with too few parameters.");
+                }
+                return current;
+            }
+        }
     }
     
     @Override
     public Expression inferType(TypingContext context) {
         if(parameters.length == 2 && function instanceof EConstant && ((EConstant)function).value.getName() == Names.Prelude_dollar)
             return new EApply(location, parameters[0], parameters[1]).inferType(context);
-        inferType(context, false);
-        return this;
+        return inferType(context, false);
     }
     
     @Override
     public Expression checkIgnoredType(TypingContext context) {
         if(parameters.length == 2 && function instanceof EConstant && ((EConstant)function).value.getName() == Names.Prelude_dollar)
             return new EApply(location, parameters[0], parameters[1]).checkIgnoredType(context);
-        inferType(context, true);
+        Expression expression = inferType(context, true);
         if(Types.canonical(getType()) != Types.UNIT)
-            return new ESimpleLet(location, null, this, new ELiteral(NoRepConstant.PUNIT));
-        return this;
+            expression = new ESimpleLet(location, null, expression, new ELiteral(NoRepConstant.PUNIT));
+        return expression;
     }
     
     public Type getLocalEffect() {
index b01b771894a831b16d193d208317b746eede221e..e580648deee8cbe9a551777f82b79c7a1d44ccca 100644 (file)
@@ -14,7 +14,7 @@ import org.simantics.scl.compiler.types.util.MultiFunction;
 
 public class ELambda extends SimplifiableExpression {
     public Case[] cases;
-    Type effect = Types.NO_EFFECTS;
+    public Type effect = Types.NO_EFFECTS;
     
     public ELambda(Case[] cases) {
         this.cases = cases;
index b1a05d70e2e42a6541d180bfe38d085d8dc9d319..122548fac399e6868d97c00fabebcbb5ad333847 100644 (file)
@@ -73,6 +73,8 @@ import org.simantics.scl.compiler.elaboration.rules.TransformationRule;
 
 public class ExpressionToStringVisitor implements ExpressionVisitor, QueryVisitor {
 
+    public static final boolean SHOW_EFFECTS = false;
+    
     StringBuilder b = new StringBuilder();
     int indentation;
     
@@ -124,6 +126,8 @@ public class ExpressionToStringVisitor implements ExpressionVisitor, QueryVisito
     @Override
     public void visit(EApply expression) {
         showPar(expression.getFunction());
+        if(SHOW_EFFECTS)
+            b.append(" {" + expression.effect + "}");
         for(Expression parameter : expression.getParameters()) {
             b.append(' ');
             showPar(parameter);
@@ -227,6 +231,8 @@ public class ExpressionToStringVisitor implements ExpressionVisitor, QueryVisito
                 showPar(pat);
                 b.append(' ');
             }
+            if(SHOW_EFFECTS)
+                b.append("{" + expression.effect + "} ");
             b.append("-> ");
             ++indentation;
             case_.value.accept(this);
@@ -346,6 +352,8 @@ public class ExpressionToStringVisitor implements ExpressionVisitor, QueryVisito
             b.append(' ');
             show(expression.getParameter());
         }
+        if(SHOW_EFFECTS)
+            b.append(" {" + expression.effect + "}");
         b.append(" -> ");
         expression.getValue().accept(this);
     }
index a9d779bfd81f83d856278ce8c7e76c68282397f9..e1b89eece28ab21f14e87e3e2fd20745ec85e7c5 100644 (file)
@@ -6,6 +6,7 @@ import java.util.Arrays;
 import java.util.Collections;
 import java.util.List;
 
+import org.simantics.scl.compiler.common.exceptions.InternalCompilerError;
 import org.simantics.scl.compiler.errors.Locations;
 import org.simantics.scl.compiler.internal.parsing.exceptions.SCLSyntaxErrorException;
 import org.simantics.scl.compiler.internal.parsing.parser.SCLParserImpl;
@@ -642,7 +643,52 @@ public class Types {
                 effect,
                 type);
     }
+    
+    /**
+     * This function always success, but may return a multi function
+     * with arity smaller than given parameter
+     */
+    public static MultiFunction unifyFunction2(Type type, int arity) {
+        type = canonical(type);
 
+        Type[] parameterTypes = new Type[arity];
+        Type effect = Types.NO_EFFECTS;
+        int i;
+        for(i=0;i<arity;++i) {
+            if(type instanceof TFun) {
+                TFun fun = (TFun)type;
+                parameterTypes[i] = fun.getCanonicalDomain();
+                type = fun.getCanonicalRange();
+                effect = fun.getCanonicalEffect();
+                if(effect != Types.NO_EFFECTS) {
+                    ++i;
+                    break;
+                }
+            }
+            else if(type instanceof TMetaVar) {
+                Type domain = metaVar(Kinds.STAR);
+                parameterTypes[i] = domain;
+                Type range = metaVar(Kinds.STAR);
+                effect = metaVar(Kinds.EFFECT);
+                try {
+                    ((TMetaVar) type).setRef(functionE(domain, effect, range));
+                } catch (UnificationException e) {
+                    // Should never happen, if we have checked maximum arity before calling this function
+                    throw new InternalCompilerError(e);
+                }
+                type = range;
+                ++i;
+                break;
+            }
+            else
+                break;
+        }
+        
+        if(i < arity)
+            parameterTypes = Arrays.copyOf(parameterTypes, i);
+        return new MultiFunction(parameterTypes, effect, type);
+    }
+    
     public static MultiFunction unifyFunction(Type type, int arity) throws UnificationException {
         Type[] parameterTypes = new Type[arity];
         for(int i=0;i<arity;++i)
@@ -692,6 +738,23 @@ public class Types {
         }
         return arity;
     }
+    
+    public static int getMaxArity(Type type) {
+        type = Skeletons.canonicalSkeleton(type);
+        int arity = 0;
+        while(true) {
+            if(type instanceof TFun) {
+                ++arity;
+                type = Skeletons.canonicalSkeleton(((TFun) type).getCanonicalRange());
+            }
+            else if(type instanceof TMetaVar) {
+                return Integer.MAX_VALUE;
+            }
+            else
+                break;
+        }
+        return arity;
+    }
 
     public static TMetaVar metaVar(Kind kind) {
         return new TMetaVar(kind);
index e11755fc3c7ed4c899c7966ce8d50d646102bb63..6c17830273c43eed42ab7688cd93e2512437050b 100644 (file)
@@ -283,6 +283,7 @@ public class ModuleRegressionTests extends TestBase {
     @Test public void TypeClass() { test(); }    
     @Test public void TypeClassBug1() { test(); }
     @Test(timeout=1000L) public void TypeInferenceBug2() { test(); }
+    @Test public void TypeInferenceBug3() { test(); }
     @Test public void TypeOf1() { test(); }
     @Test public void TypingBug1() { test(); }
     @Test public void TypingError1() { test(); }
index e8c80551f6761ff8c723a4ae1ac754ce61c45e86..5ea916b1e6bcc3f58b0017ab5f9b40d06db2e76a 100644 (file)
@@ -4,4 +4,5 @@ distance (x1,y1) (x2,y2) = let dx = x1-x2
                                dy = y1-y2
                            in sqrt (dx*dx + dy*dy) print x1
 --
+5:31-5:35: Constrain Real ((a -> <Proc> ()) -> <e> b -> <d> c) contains free variables not mentioned in the type of the value.
 5:58-5:60: Expected <a> got <b>.
\ No newline at end of file
diff --git a/tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/scl/TypeInferenceBug3.scl b/tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/scl/TypeInferenceBug3.scl
new file mode 100644 (file)
index 0000000..657183c
--- /dev/null
@@ -0,0 +1,12 @@
+import "Prelude"
+
+foo :: Integer -> <Proc> (Integer -> <Proc> ())
+foo i = do
+    print i
+    \j -> print j
+
+main = foo 3 4
+--
+3
+4
+()
\ No newline at end of file