Fixed incorrect interaction of EAmbigious and TMetaVar.setRef

refs #7530

Change-Id: I6b06e164861fd5eaf7dba9377311106133dd775f

diff --git a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/expressions/EAmbiguous.java b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/expressions/EAmbiguous.java
index 1d17281dd2935462388044641156fb2699125e93..0afb14b89f42c92060710133ae34186d3551d07d 100644 (file)
--- a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/expressions/EAmbiguous.java
+++ b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/expressions/EAmbiguous.java
@@ -56,7 +56,7 @@ public class EAmbiguous extends SimplifiableExpression {
         THashMap<TMetaVar,Type> unifications = new THashMap<TMetaVar,Type>(); 
         Type requiredType = getType();
         if(DEBUG)
-            System.out.println("EAmbigious.filterActive with " + requiredType);
+            System.out.println("EAmbigious.filterActive with " + requiredType.toStringSkeleton());
         for(int i=0;i<alternatives.length;++i)
             if(active[i]) {
                 unifications.clear();
@@ -117,12 +117,12 @@ public class EAmbiguous extends SimplifiableExpression {
     
     private void listenType() {
         if(DEBUG)
-            System.out.println("EAmbigious.listenType " + getType());
+            System.out.println("EAmbigious.listenType " + getType().toStringSkeleton());
         new TypeListener() {
             @Override
             public void notifyAboutChange() {
                 if(DEBUG)
-                    System.out.println("EAmbigious.notifyAboutChange " + getType());
+                    System.out.println("EAmbigious.notifyAboutChange " + getType().toStringSkeleton());
                 Type requiredType = getType();
                 filterActive();
                 if(activeCount == 0) {

diff --git a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/types/TFun.java b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/types/TFun.java
index 6fc9b42b22bb165481e7cb0da6f8c1e0122c3ce2..620ef18307421a9bcfeced6410a6ff3045dd4ff9 100644 (file)
--- a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/types/TFun.java
+++ b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/types/TFun.java
@@ -57,7 +57,7 @@ public class TFun extends Type {
     public TypeAst toTypeAst(TypeUnparsingContext context) {
         TypeAst domainAst = domain.toTypeAst(context);
         TypeAst rangeAst = range.toTypeAst(context);
-        if(Types.canonical(effect) != Types.NO_EFFECTS)
+        if(Types.canonical(effect) != Types.NO_EFFECTS && !context.showSkeletons)
             rangeAst = new TEffectAst(effect.toTypeAst(context), rangeAst);
         Type dom = Types.canonical(domain);
         if(dom instanceof TPred)

diff --git a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/types/TMetaVar.java b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/types/TMetaVar.java
index 00b289f46a1f1b934c5ab271386fedde11f38554..1596467bc2931541350fdfd0fd27a424e084e882 100644 (file)
--- a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/types/TMetaVar.java
+++ b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/types/TMetaVar.java
@@ -92,10 +92,12 @@ public class TMetaVar extends Type {
 
     @Override
     public TypeAst toTypeAst(TypeUnparsingContext context) {
-        if(ref == null)
-            return new TVarAst(/*polarity.getSymbol() +*/ context.getName(this));
-        else
+        if(ref != null)
             return ref.toTypeAst(context);
+        else if(context.showSkeletons && skeletonRef != null)
+            return skeletonRef.toTypeAst(context);
+        else
+            return new TVarAst(/*polarity.getSymbol() +*/ context.getName(this));
     }
     
     @Override
@@ -168,6 +170,10 @@ public class TMetaVar extends Type {
         // Common case
         if(skeletonRef != null) {
             Skeletons.unifySkeletons(thisSkeleton, type);
+            if(ref != null) {
+                Types.unify(this, type);
+                return;
+            }
         }
         setRefBase(type);
     }

diff --git a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/types/Type.java b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/types/Type.java
index c158cb31bc8b99b42d4b390c09bce0df0aef396b..fd7aef52782b5fe5534cc6ff16dc6c4ed74790d7 100644 (file)
--- a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/types/Type.java
+++ b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/types/Type.java
@@ -182,6 +182,12 @@ public abstract class Type {
 
     public abstract Kind getKind(Environment context);
 
-    public abstract Type[] skeletonCanonicalChildren(); 
+    public abstract Type[] skeletonCanonicalChildren();
+
+    public String toStringSkeleton() {
+        TypeUnparsingContext tuc = new TypeUnparsingContext();
+        tuc.showSkeletons = true;
+        return toString(tuc);
+    } 
             
 }
\ No newline at end of file

diff --git a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/types/util/TypeUnparsingContext.java b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/types/util/TypeUnparsingContext.java
index a5c44639e48f9032809c1e3572212d2205e87652..97f23bd9a711b6fb3260b73e23a814c012cbc605 100644 (file)
--- a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/types/util/TypeUnparsingContext.java
+++ b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/types/util/TypeUnparsingContext.java
@@ -6,6 +6,7 @@ public class TypeUnparsingContext {
     
     THashMap<Object, String> names;
     int nameId;
+    public boolean showSkeletons;
     
     public TypeUnparsingContext() {
         this.names = new THashMap<Object, String>();

diff --git a/bundles/org.simantics.scl.runtime/scl/Debug.scl b/bundles/org.simantics.scl.runtime/scl/Debug.scl
index 94112010044ae102b99fa350eb0e168ef6ffcf0d..858f87c80b0f81b94818dcf740440502f1f8dd81 100644 (file)
--- a/bundles/org.simantics.scl.runtime/scl/Debug.scl
+++ b/bundles/org.simantics.scl.runtime/scl/Debug.scl
@@ -15,6 +15,15 @@ time f = do
     endTime = nanoTime ()
     (result, Java.l2d (endTime-beginTime) * 1e-9)
 
+reportTime :: (<e> a) -> <e> a
+reportTime f = runProc do
+    beginTime = nanoTime ()
+    result = f
+    endTime = nanoTime ()
+    time = Java.l2d (endTime-beginTime) * 1e-9
+    print "time \(time) s"
+    result
+
 """
 Prints the given text and returns
 the second parameter.

diff --git a/tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/ModuleRegressionTests.java b/tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/ModuleRegressionTests.java
index 91ddbc5e9742e8ac951340e6cb7df8ab96500985..a61dc965d43b26806e4595c0f5ce2d88dbb7d289 100644 (file)
--- a/tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/ModuleRegressionTests.java
+++ b/tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/ModuleRegressionTests.java
@@ -196,7 +196,8 @@ public class ModuleRegressionTests extends TestBase {
     @Test public void OverloadedArithmetic2() { test(); }
     @Test public void OverloadedArithmetic3() { test(); }
     @Test public void OverloadedLiterals2() { test(); }
-    @Test public void Overloading1() { test(); }    
+    @Test public void Overloading1() { test(); }
+    @Test public void Overloading4() { test(); }
     @Test public void Parsing() { test(); }
     @Test public void PolymorphicRecursion() { test(); }
     @Test public void PolymorphicRecursion2() { test(); }

diff --git a/tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/scl/Overloading4.scl b/tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/scl/Overloading4.scl
new file mode 100644 (file)
index 0000000..040e435
--- /dev/null
+++ b/tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/scl/Overloading4.scl
@@ -0,0 +1,25 @@
+// module M1
+import "Prelude"
+
+foo :: Integer -> Integer -> Integer
+foo = (+)
+--
+// module M2
+import "Prelude"
+
+foo :: String -> String -> String -> <Proc> ()
+foo a b c = do
+    print a
+    print b
+    print c
+--
+import "Prelude"
+import "M1"
+import "M2"
+
+main = ignore (foo "Hello" "world" "!")
+--
+Hello
+world
+!
+()
\ No newline at end of file