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