]> gerrit.simantics Code Review - simantics/platform.git/blob - bundles/org.simantics.scl.runtime/scl/Unification.scl
Fix desktop product configuration
[simantics/platform.git] / bundles / org.simantics.scl.runtime / scl / Unification.scl
1 import "JavaBuiltin" as Java
2
3 importJava "org.simantics.scl.runtime.unification.UTag" where
4     data UTag a t
5     
6     @JavaName "<init>"
7     uTag :: Integer -> (t -> <Proc> a) -> (a -> t) -> UTag a t
8
9 importJava "java.lang.Object" where
10     data Unifiable a
11
12 uId :: a -> Unifiable a
13 uId = Java.unsafeCoerce 
14
15 importJava "org.simantics.scl.runtime.unification.UCons" where
16     @JavaName "<init>"
17     uCons :: UTag a t -> t -> Unifiable a
18
19 importJava "org.simantics.scl.runtime.unification.UPending" where
20     @JavaName "<init>"
21     uPending :: (<Proc> a) -> Unifiable a
22
23 importJava "org.simantics.scl.runtime.unification.UVar" where
24     @JavaName "<init>"
25     uVar :: <Proc> Unifiable a
26
27 importJava "org.simantics.scl.runtime.unification.Unification" where
28     unify :: Unifiable a -> Unifiable a -> <Proc> ()
29     extractWithDefault :: (<Proc> a) -> Unifiable a -> <Proc> a
30
31 class Default a where
32     createDefault :: <Proc> a
33
34 instance Default () where
35     createDefault = ()
36     
37 instance (Default a, Default b) => Default (a, b) where
38     createDefault = (createDefault, createDefault)
39
40 instance (Default a, Default b, Default c) => Default (a, b, c) where
41     createDefault = (createDefault, createDefault, createDefault)
42     
43 instance Default Double where
44     createDefault = fail "Double type has no default value."
45
46 instance Default Integer where
47     createDefault = fail "Integer type has no default value."
48
49 @inline
50 extract :: Default a => Unifiable a -> <Proc> a
51 extract u = extractWithDefault createDefault u
52
53 importJava "gnu.trove.map.hash.THashMap" where
54     data UMap a b
55     
56     @JavaName "<init>"
57     createUMap :: <Proc> UMap a b
58
59 importJava "org.simantics.scl.runtime.unification.UMapUtils" where
60     @JavaName put
61     putUMap :: UMap a b -> a -> Unifiable b -> <Proc> ()
62     @JavaName put
63     putUMapC :: UMap a b -> a -> b -> <Proc> ()
64     @JavaName get
65     getUMapWithDefault :: (<Proc> b) -> UMap a b -> a -> <Proc> b
66
67 getUMap :: Default b => UMap a b -> a -> <Proc> b
68 getUMap = getUMapWithDefault createDefault