Implemented many type class instances for Set.T

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

diff --git a/bundles/org.simantics.scl.runtime/scl/SetClasses.scl b/bundles/org.simantics.scl.runtime/scl/SetClasses.scl
new file mode 100644 (file)
index 0000000..8c3d1e6
--- /dev/null
+++ b/bundles/org.simantics.scl.runtime/scl/SetClasses.scl
@@ -0,0 +1,61 @@
+import "Prelude"
+import "MSet" as MSet
+import "Set" as Set
+
+instance Functor Set.T where
+    fmap = map
+        
+instance FunctorE Set.T where
+    map f set = runProc do
+        result = MSet.create ()
+        Set.iter (\x -> MSet.add result $ f x) set
+        MSet.freeze result
+        
+    iter = Set.iter
+    iterI = Set.iterI
+    
+instance Monad Set.T where
+    return = Set.singleton
+    (>>=) = bindE
+
+@private
+importJava "java.util.Set" where
+    @JavaName addAll
+    addAll' :: MSet.T a -> Set.T a -> <Proc> Boolean
+        
+instance MonadE Set.T where
+    set `bindE` f = runProc do
+        result = MSet.create ()
+        Set.iter (\x -> addAll' result $ f x) set
+        MSet.freeze result
+        
+instance MonadZero Set.T where
+    mzero = Set.empty
+    
+instance MonadZeroE Set.T where
+    filter p set = runProc do
+        result = MSet.create ()
+        Set.iter (\x ->
+            if p x
+            then ignore $ MSet.add result x
+            else ()
+        ) set
+        MSet.freeze result
+
+instance (Show a) => Show (Set.T a) where
+    sb <+ set = do
+        sb << "{"
+        Set.iterI (\i x -> (if i > 0 then sb << ", " else sb) <+ x) set
+        sb << "}"
+
+instance Additive (Set.T a) where
+    zero = Set.empty
+    a + b = runProc do
+        result = MSet.create ()
+        Set.iter (MSet.add result) a
+        Set.iter (MSet.add result) b
+        MSet.freeze result
+    sum sets = runProc do
+        result = MSet.create ()
+        iter (Set.iter (MSet.add result)) sets
+        MSet.freeze result
\ No newline at end of file