Migrated source code from Simantics SVN

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

diff --git a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/types/kinds/Kinds.java b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/types/kinds/Kinds.java
new file mode 100644 (file)
index 0000000..edf63df
--- /dev/null
+++ b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/types/kinds/Kinds.java
@@ -0,0 +1,81 @@
+package org.simantics.scl.compiler.types.kinds;
+
+import org.simantics.scl.compiler.types.exceptions.KindUnificationException;
+
+public class Kinds {
+    public static final KCon STAR = new KCon("*");
+    public static final KCon EFFECT = new KCon("E");
+    public static final Kind STAR_TO_STAR = new KArrow(STAR, STAR);
+    public static final Kind STAR_TO_STAR_TO_STAR = new KArrow(STAR, STAR_TO_STAR);
+    
+    public static KArrow arrow(Kind domain, Kind range) {
+        return new KArrow(domain, range);
+    }
+    
+    public static KMetaVar metaVar() {
+        return new KMetaVar();
+    }
+    
+    public static Kind canonical(Kind a) {
+        while(a instanceof KMetaVar) {
+            KMetaVar mv = (KMetaVar)a;
+            if(mv.ref == null)
+                return a;
+            a = mv.ref;
+        }
+        return a;
+    }
+    
+    public static void unifyWithStar(Kind a) throws KindUnificationException {
+        a = canonical(a);
+        if(a == STAR)
+            return;
+        if(a instanceof KMetaVar)
+            ((KMetaVar)a).ref = STAR;
+        throw new KindUnificationException();
+    }
+    
+    /**
+     * Tries to unify two kinds by linking matching meta-variables.
+     * @throws KindUnificationException  if unification fails
+     */
+    public static void unify(Kind a, Kind b) throws KindUnificationException {
+        a = canonical(a);
+        b = canonical(b);
+        if(a == b)
+            return;
+        if(a instanceof KMetaVar) {
+            ((KMetaVar)a).setRef(b);
+            return;
+        }
+        if(b instanceof KMetaVar) {
+            ((KMetaVar)b).setRef(a);
+            return;
+        }
+        if(a instanceof KArrow && b instanceof KArrow) {
+            KArrow arrowA = (KArrow)a;
+            KArrow arrowB = (KArrow)b;
+            unify(arrowA.domain, arrowB.domain);
+            unify(arrowA.range, arrowB.range);
+            return;
+        }
+        throw new KindUnificationException();
+    }
+
+    public static boolean equalsCanonical(Kind a, Kind b) {
+        if(a == b)
+            return true;
+        if(!(a instanceof KArrow))
+            return false;
+        if(!(b instanceof KArrow))
+            return false;
+        KArrow arrowA = (KArrow)a;
+        KArrow arrowB = (KArrow)b;
+        return equals(arrowA.domain, arrowB.domain) && 
+                equals(arrowA.range, arrowB.range);
+    }
+
+    public static boolean equals(Kind a, Kind b) {
+        return equalsCanonical(canonical(a), canonical(b));
+    }    
+}