]> gerrit.simantics Code Review - simantics/platform.git/blob - bundles/org.simantics.scl.runtime/scl/SList.scl
Fix desktop product configuration
[simantics/platform.git] / 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