X-Git-Url: https://gerrit.simantics.org/r/gitweb?p=simantics%2Fplatform.git;a=blobdiff_plain;f=bundles%2Forg.simantics.scl.runtime%2Fscl%2FPrelude.scl;h=f983251093272d2168cb9eacc05db4542660afa0;hp=32582affa867947fbac5167b94c4d8919c0bd91c;hb=bd78deb4759a49ed84200b95fddc9569438512f7;hpb=e65cd7676f6e843e34a8501afc57f56cbc8602d3 diff --git a/bundles/org.simantics.scl.runtime/scl/Prelude.scl b/bundles/org.simantics.scl.runtime/scl/Prelude.scl index 32582affa..f98325109 100644 --- a/bundles/org.simantics.scl.runtime/scl/Prelude.scl +++ b/bundles/org.simantics.scl.runtime/scl/Prelude.scl @@ -963,6 +963,9 @@ A class of monads with zero element satisfying """ class (Monad m) => MonadZero m where mzero :: m a + mfilter :: (a -> Boolean) -> m a -> m a + + mfilter p m = m >>= (\x -> if p x then return x else mzero) "Injects a boolean test to a type beloning to `MonadZero`." guard :: MonadZero m => Boolean -> m () @@ -1093,6 +1096,7 @@ class (FunctorE f) => FunctorM f where /// MonadE /// class (FunctorE m, Monad m) => MonadE m where + "An effectful version of the bind operator `(>>=)`" bindE :: m a -> (a -> m b) -> m b instance MonadE Maybe where @@ -1105,7 +1109,26 @@ instance MonadE (Either a) where instance MonadE [] where bindE l f = concatMap f l + +@inline +"An effectful version of the Kleisli composition operator `(>=>)`" +compE :: MonadE m => (a -> m b) -> (b -> m c) -> a -> m c +compE f g x = (f x) `bindE` g + +/// MZeroE /// + +class (MonadE m, MonadZero m) => MonadZeroE m where + filter :: (a -> Boolean) -> m a -> m a + + filter p m = m `bindE` (\x -> if p x then return x else mzero) +instance MonadZeroE [] where + filter = filterList + +instance MonadZeroE Maybe where + filter p (Just x) | not (p x) = Nothing + filter _ m = m + /// Category /// "Identity function." @@ -1166,10 +1189,12 @@ class IndexedSequence f where "Returns the first element of a sequence" @inline +first :: [a] -> a first l = l!0 "Returns the last element of a sequence" @inline +last :: [a] -> a last l = l!(length l-1) instance IndexedSequence [] where @@ -1288,8 +1313,13 @@ fromMaybe :: a -> Maybe a -> a fromMaybe default maybeValue = match maybeValue with Just v -> v _ -> default - - + +"`maybe def f v` returns `def` if `v=Nothing` and `f x` if `v=Just x`." +@inline +maybe :: b -> (a -> b) -> Maybe a -> b +maybe n _ Nothing = n +maybe _ f (Just x) = f x + """ Provides a default value if the first parameter is Nothing. The default value is evaluated only if needed. The function @@ -1497,11 +1527,11 @@ snd :: (a,b) -> b snd (x,y) = y @inline -mapFst :: (a -> b) -> (a,c) -> (b,c) +mapFst :: (a -> b) -> (a,c) -> (b,c) mapFst f (x,y) = (f x, y) @inline -mapSnd :: (a -> b) -> (c,a) -> (c,b) +mapSnd :: (a -> b) -> (c,a) -> (c,b) mapSnd f (x,y) = (x, f y) instance (Ord a, Ord b) => Ord (a, b) where @@ -1834,10 +1864,10 @@ foldr1 f l = loop (l!(len-1)) (len-2) `filter pred lst` returns those elements of `lst` that the predicate `pred` accepts. For example filter (> 3) [1, 2, 3, 4, 5, 6] = [4, 5, 6] -""" +""" @inline -filter :: (a -> Boolean) -> [a] -> [a] -filter p l = build (\empty cons -> foldl (\cur x -> if p x then cons cur x else cur) empty l) +filterList :: (a -> Boolean) -> [a] -> [a] +filterList p l = build (\empty cons -> foldl (\cur x -> if p x then cons cur x else cur) empty l) """ Takes those elements of the input list that match `(Just x)` and adds the contents to the resulting list. For example, @@ -1997,7 +2027,7 @@ importJava "org.simantics.scl.runtime.Lists" where unique :: [a] -> [a] "Like `unique`, but uses the given function for finding the key values used for uniqueness testing." - uniqueBy :: (a -> b) -> [a] -> [a] + uniqueBy :: (a -> b) -> [a] -> [a] "Works like `unique` but uses the given function for equality tests." uniqueWith :: (a -> a -> Boolean) -> [a] -> [a] @@ -2058,6 +2088,7 @@ Transposes the rows and columns of its argument. For example, transpose [[1,2,3],[4,5,6]] == [[1,4],[2,5],[3,6]] transpose [[1,2],[3,4,5]] == [[1,3],[2,4],[5]] """ +transpose :: [[a]] -> [[a]] transpose xss = [[xs!i | xs <- xss, i < length xs] | i <- [0..maximum [length xs | xs <- xss]-1]]