bundles/org.simantics.scl.runtime/scl/SList.scl

   1 import "Prelude"
   2
   3 data SList a = Nil | Cons a (SList a)
   4
   5 deriving instance (Eq a) => Eq (SList a)
   6 deriving instance (Ord a) => Ord (SList a)
   7 deriving instance (Hashable a) => Hashable (SList a)
   8 deriving instance (Show a) => Show (SList a)
   9
  10 @inline
  11 mapSList :: (a -> <e> b) -> SList a -> <e> SList b
  12 mapSList f l = loop l
  13   where
  14     loop (Cons h t) = Cons (f h) (loop t)
  15     loop _ = Nil
  16
  17 @inline
  18 mapFirstSList :: (a -> <e> Maybe b) -> SList a -> <e> Maybe b
  19 mapFirstSList f l = loop l
  20   where
  21     loop (Cons h t) = match f h with
  22         Nothing -> loop t
  23         r -> r
  24     loop _ = Nothing
  25
  26 @inline
  27 iterSList :: (a -> <e> dummy) -> SList a -> <e> ()
  28 iterSList f l = loop l
  29   where
  30     loop (Cons h t) = do
  31         f h
  32         loop t
  33     loop _ = ()
  34
  35 @inline
  36 anySList :: (a -> <e> Boolean) -> SList a -> <e> Boolean
  37 anySList f l = loop l
  38   where
  39     loop (Cons h t) = f h || loop t
  40     loop _ = False
  41
  42 @inline
  43 allSList :: (a -> <e> Boolean) -> SList a -> <e> Boolean
  44 allSList f l = loop l
  45   where
  46     loop (Cons h t) = f h && loop t
  47     loop _ = True
  48
  49 @inline
  50 foldlSList :: (a -> b -> <e> a) -> a -> SList b -> <e> a
  51 foldlSList f init l = loop init l
  52   where
  53     loop cur (Cons h t) = loop (f cur h) t
  54     loop cur _ = cur
  55
  56 @inline
  57 foldl1SList :: (a -> a -> <e> a) -> SList a -> <e> a
  58 foldl1SList f (Cons h t) = foldlSList f h t
  59
  60 foldrSList :: (b -> a -> <e> a) -> a -> SList b -> <e> a
  61 foldrSList f cur (Cons h t) = f h (foldrSList f cur t)
  62 foldrSList f cur _ = cur
  63
  64 dropSList :: Integer -> SList a -> SList a
  65 dropSList n l | n<=0 = l
  66 dropSList n (Cons h t) = dropSList (n-1) t
  67 dropSList n l = l /* = Nil */
  68
  69 takeSList :: Integer -> SList a -> SList a
  70 takeSList i _ | i <= 0 = Nil
  71 takeSList i (Cons h t) = Cons h (takeSList (i-1) t)
  72 takeSList i l = l
  73
  74 lengthSList :: SList a -> Integer
  75 lengthSList l = loop 0 l
  76   where
  77     loop accum (Cons _ t) = loop (accum+1) t
  78     loop accum _ = accum
  79
  80 isEmptySList :: SList a -> Boolean
  81 isEmptySList Nil = True
  82 isEmptySList _ = False
  83
  84 @inline
  85 singletonSList :: a -> SList a
  86 singletonSList e = Cons e Nil
  87
  88 reverseSList :: SList a -> SList a
  89 reverseSList l = loop Nil l
  90   where
  91     loop accum (Cons h t) = loop (Cons h accum) t
  92     loop accum _ = accum
  93
  94 sortSList :: Ord a => SList a -> SList a
  95 sortSList l = sortAux (lengthSList l) l
  96   where
  97     sortAux n l | n <= 1 = l
  98     sortAux n l = let half = n `div` 2
  99                       (left,right) = split half Nil l
 100                   in merge (sortAux half left) (sortAux (n-half) right)
 101     split n accum l | n<=0 = (accum, l)
 102     split n accum (Cons h t) = split (n-1) (Cons h accum) t
 103     merge l1@(Cons h1 t1) l2@(Cons h2 t2)
 104         | h1 <= h2  = Cons h1 (merge t1 l2)
 105         | otherwise = Cons h2 (merge l1 t2)
 106     merge Nil l2 = l2
 107     merge l1 Nil = l1
 108
 109 appendSList :: SList a -> SList a -> SList a
 110 appendSList (Cons h t) l = Cons h (appendSList t l)
 111 appendSList _ l = l
 112
 113 nthSList :: SList a -> Integer -> a
 114 nthSList Nil _ = fail "Index out of range"
 115 nthSList (Cons h _) 0 = h
 116 nthSList (Cons _ t) i = nthSList t (i-1)
 117
 118 @inline
 119 toListSList :: SList a -> [a]
 120 toListSList l = build (\empty cons ->
 121       let loop accum (Cons h t) = loop (cons accum h) t
 122           loop accum _ = accum
 123       in  loop empty l
 124   )
 125
 126 fromListSList :: [a] -> SList a
 127 fromListSList = foldr Cons Nil