Migrated source code from Simantics SVN

[simantics/platform.git] / bundles / org.simantics.scl.runtime / scl / Unification.scl

diff --git a/bundles/org.simantics.scl.runtime/scl/Unification.scl b/bundles/org.simantics.scl.runtime/scl/Unification.scl
new file mode 100644 (file)
index 0000000..3efe129
--- /dev/null
+++ b/bundles/org.simantics.scl.runtime/scl/Unification.scl
@@ -0,0 +1,68 @@
+import "JavaBuiltin" as Java
+
+importJava "org.simantics.scl.runtime.unification.UTag" where
+    data UTag a t
+    
+    @JavaName "<init>"
+    uTag :: Integer -> (t -> <Proc> a) -> (a -> t) -> UTag a t
+
+importJava "java.lang.Object" where
+    data Unifiable a
+
+uId :: a -> Unifiable a
+uId = Java.unsafeCoerce 
+
+importJava "org.simantics.scl.runtime.unification.UCons" where
+    @JavaName "<init>"
+    uCons :: UTag a t -> t -> Unifiable a
+
+importJava "org.simantics.scl.runtime.unification.UPending" where
+    @JavaName "<init>"
+    uPending :: (<Proc> a) -> Unifiable a
+
+importJava "org.simantics.scl.runtime.unification.UVar" where
+    @JavaName "<init>"
+    uVar :: <Proc> Unifiable a
+
+importJava "org.simantics.scl.runtime.unification.Unification" where
+    unify :: Unifiable a -> Unifiable a -> <Proc> ()
+    extractWithDefault :: (<Proc> a) -> Unifiable a -> <Proc> a
+
+class Default a where
+    createDefault :: <Proc> a
+
+instance Default () where
+    createDefault = ()
+    
+instance (Default a, Default b) => Default (a, b) where
+    createDefault = (createDefault, createDefault)
+
+instance (Default a, Default b, Default c) => Default (a, b, c) where
+    createDefault = (createDefault, createDefault, createDefault)
+    
+instance Default Double where
+    createDefault = fail "Double type has no default value."
+
+instance Default Integer where
+    createDefault = fail "Integer type has no default value."
+
+@inline
+extract :: Default a => Unifiable a -> <Proc> a
+extract u = extractWithDefault createDefault u
+
+importJava "gnu.trove.map.hash.THashMap" where
+    data UMap a b
+    
+    @JavaName "<init>"
+    createUMap :: <Proc> UMap a b
+
+importJava "org.simantics.scl.runtime.unification.UMapUtils" where
+    @JavaName put
+    putUMap :: UMap a b -> a -> Unifiable b -> <Proc> ()
+    @JavaName put
+    putUMapC :: UMap a b -> a -> b -> <Proc> ()
+    @JavaName get
+    getUMapWithDefault :: (<Proc> b) -> UMap a b -> a -> <Proc> b
+
+getUMap :: Default b => UMap a b -> a -> <Proc> b
+getUMap = getUMapWithDefault createDefault
\ No newline at end of file