]> gerrit.simantics Code Review - simantics/platform.git/blob - bundles/org.simantics.scl.runtime/scl/SList.scl
Replaced use of deprecated BinaryFunction et al with BiFunction et al
[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 (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