Migrated source code from Simantics SVN

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

diff --git a/bundles/org.simantics.scl.runtime/scl/SList.scl b/bundles/org.simantics.scl.runtime/scl/SList.scl
new file mode 100644 (file)
index 0000000..6622598
--- /dev/null
+++ b/bundles/org.simantics.scl.runtime/scl/SList.scl
@@ -0,0 +1,127 @@
+import "Prelude"
+
+data SList a = Nil | Cons a (SList a)
+
+deriving instance (Eq a) => Eq (SList a)
+deriving instance (Ord a) => Ord (SList a)
+deriving instance (Hashable a) => Hashable (SList a)
+deriving instance (Show a) => Show (SList a)
+
+@inline
+mapSList :: (a -> <e> b) -> SList a -> <e> SList b
+mapSList f l = loop l
+  where
+    loop (Cons h t) = Cons (f h) (loop t)
+    loop _ = Nil
+
+@inline
+mapFirstSList :: (a -> <e> Maybe b) -> SList a -> <e> Maybe b
+mapFirstSList f l = loop l
+  where
+    loop (Cons h t) = match f h with
+        Nothing -> loop t
+        r -> r
+    loop _ = Nothing
+
+@inline
+iterSList :: (a -> <e> dummy) -> SList a -> <e> ()
+iterSList f l = loop l
+  where
+    loop (Cons h t) = do
+        f h
+        loop t
+    loop _ = ()
+
+@inline
+anySList :: (a -> <e> Boolean) -> SList a -> <e> Boolean
+anySList f l = loop l
+  where
+    loop (Cons h t) = f h || loop t
+    loop _ = False
+
+@inline
+allSList :: (a -> <e> Boolean) -> SList a -> <e> Boolean
+allSList f l = loop l
+  where
+    loop (Cons h t) = f h && loop t
+    loop _ = True
+
+@inline
+foldlSList :: (a -> b -> <e> a) -> a -> SList b -> <e> a
+foldlSList f init l = loop init l
+  where
+    loop cur (Cons h t) = loop (f cur h) t
+    loop cur _ = cur
+
+@inline
+foldl1SList :: (a -> a -> <e> a) -> SList a -> <e> a
+foldl1SList f (Cons h t) = foldlSList f h t
+
+foldrSList :: (b -> a -> <e> a) -> a -> SList b -> <e> a
+foldrSList f cur (Cons h t) = f h (foldrSList f cur t)  
+foldrSList f cur _ = cur
+
+dropSList :: Integer -> SList a -> SList a
+dropSList n l | n<=0 = l
+dropSList n (Cons h t) = dropSList (n-1) t
+dropSList n l = l /* = Nil */
+
+takeSList :: Integer -> SList a -> SList a
+takeSList i _ | i <= 0 = Nil
+takeSList i (Cons h t) = Cons h (takeSList (i-1) t)
+takeSList i l = l 
+
+lengthSList :: SList a -> Integer
+lengthSList l = loop 0 l
+  where
+    loop accum (Cons _ t) = loop (accum+1) t
+    loop accum _ = accum
+
+isEmptySList :: SList a -> Boolean
+isEmptySList Nil = True
+isEmptySList _ = False
+
+@inline 
+singletonSList :: a -> SList a
+singletonSList e = Cons e Nil
+
+reverseSList :: SList a -> SList a
+reverseSList l = loop Nil l
+  where
+    loop accum (Cons h t) = loop (Cons h accum) t
+    loop accum _ = accum 
+
+sortSList :: Ord a => SList a -> SList a
+sortSList l = sortAux (lengthSList l) l
+  where
+    sortAux n l | n <= 1 = l
+    sortAux n l = let half = n `div` 2
+                      (left,right) = split half Nil l
+                  in merge (sortAux half left) (sortAux (n-half) right)
+    split n accum l | n<=0 = (accum, l)
+    split n accum (Cons h t) = split (n-1) (Cons h accum) t 
+    merge l1@(Cons h1 t1) l2@(Cons h2 t2)
+        | h1 <= h2  = Cons h1 (merge t1 l2)
+        | otherwise = Cons h2 (merge l1 t2)
+    merge Nil l2 = l2
+    merge l1 Nil = l1
+
+appendSList :: SList a -> SList a -> SList a
+appendSList (Cons h t) l = Cons h (appendSList t l)
+appendSList _ l = l
+
+nthSList :: SList a -> Integer -> a
+nthSList Nil _ = fail "Index out of range"
+nthSList (Cons h _) 0 = h
+nthSList (Cons _ t) i = nthSList t (i-1) 
+
+@inline
+toListSList :: SList a -> [a]
+toListSList l = build (\empty cons ->
+      let loop accum (Cons h t) = loop (cons accum h) t
+          loop accum _ = accum 
+      in  loop empty l
+  )
+
+fromListSList :: [a] -> SList a
+fromListSList = foldr Cons Nil
\ No newline at end of file