(refs #7746) Fixed applications with intermediate effects

[simantics/platform.git] / bundles / org.simantics.scl.compiler / src / org / simantics / scl / compiler / types / Types.java

diff --git a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/types/Types.java b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/types/Types.java
index a9d779bfd81f83d856278ce8c7e76c68282397f9..e1b89eece28ab21f14e87e3e2fd20745ec85e7c5 100644 (file)
--- a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/types/Types.java
+++ b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/types/Types.java
@@ -6,6 +6,7 @@ import java.util.Arrays;
 import java.util.Collections;
 import java.util.List;
 
 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;
 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);
     }
                 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)
     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;
     }
         }
         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);
 
     public static TMetaVar metaVar(Kind kind) {
         return new TMetaVar(kind);