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