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=eb8026de910e15f2b8900c2e0fce6a6d6a0d0d6e;hp=05b5f2785675c6da8738e28287a465b6f8c22d4f;hb=e9757cdfe5996d87738cabad84bff0343f56e4e3;hpb=8cd3ef9676a44b623c7d5d30345fa21f4a5aef35 diff --git a/bundles/org.simantics.scl.runtime/scl/Prelude.scl b/bundles/org.simantics.scl.runtime/scl/Prelude.scl index 05b5f2785..eb8026de9 100644 --- a/bundles/org.simantics.scl.runtime/scl/Prelude.scl +++ b/bundles/org.simantics.scl.runtime/scl/Prelude.scl @@ -1081,13 +1081,29 @@ replicate n v = build (\empty cons -> /// FunctorM /// -class (Functor f) => FunctorM f where +class (FunctorE f) => FunctorM f where "`mapM f` is equivalent to `sequence . map f`." - mapM :: Monad m => (a -> m b) -> f a -> m (f b) + mapM :: Monad m => (a -> m b) -> f a -> m (f b) "Evaluate each action in the sequence from left to right, and collect the results." sequence :: Monad m => f (m a) -> m (f a) - mapM f l = sequence (fmap f l) + mapM f l = sequence (map f l) + +/// MonadE /// +class (FunctorE m, Monad m) => MonadE m where + bindE :: m a -> (a -> m b) -> m b + +instance MonadE Maybe where + bindE Nothing _ = Nothing + bindE (Just v) f = f v + +instance MonadE (Either a) where + bindE (Left v) _ = Left v + bindE (Right v) f = f v + +instance MonadE [] where + bindE l f = concatMap f l + /// Category /// "Identity function." @@ -1146,6 +1162,14 @@ class IndexedSequence f where "`seq ! i` returns the `i`th element of the sequence `seq`. Indexing starts from zero." (!) :: f a -> Integer -> a +"Returns the first element of a sequence" +@inline +first l = l!0 + +"Returns the last element of a sequence" +@inline +last l = l!(length l-1) + instance IndexedSequence [] where (!) = getList @@ -1460,6 +1484,14 @@ fst (x,y) = x snd :: (a,b) -> b snd (x,y) = y +@inline +mapFst :: (a -> b) -> (a,c) -> (b,c) +mapFst f (x,y) = (f x, y) + +@inline +mapSnd :: (a -> b) -> (c,a) -> (c,b) +mapSnd f (x,y) = (x, f y) + instance (Ord a, Ord b) => Ord (a, b) where compare (a0, b0) (a1, b1) = compare a0 a1 &<& compare b0 b1 @@ -1914,14 +1946,51 @@ importJava "org.simantics.scl.runtime.Lists" where "Sorts the list using the given comparator." sortWith :: (a -> a -> Integer) -> [a] -> [a] + + """ + Given a list of key-value pairs, the function produces a function that finds a value + efficiently for the given key. + """ + index :: [(a,b)] -> a -> Maybe b + + """ + Given a list of values and a function computing a key for each value, the function produces a function that finds a value + effeciently for the given key. + """ + indexBy :: (a -> b) -> [a] -> (b -> Maybe a) + "Works like `index` but uses the given functions as hash codes and equality." indexWith :: (a -> Integer) -> (a -> a -> Boolean) -> [(a,b)] -> a -> Maybe b + + "Groups a list values by a key computed by the given function." + groupBy :: (a -> b) -> [a] -> [(b, [a])] + + "Groups a list of key-value pairs by the keys." + group :: [(a,b)] -> [(a, [b])] + + "Composition of index and groupBy." + indexGroupBy :: (a -> b) -> [a] -> (b -> [a]) + + "Composition of index and group." + indexGroup :: [(a,b)] -> a -> [b] + groupWith :: (b -> Integer) -> (b -> b -> Boolean) -> (a -> b) -> (a -> c) -> [a] -> [(b, [c])] + + "Removes duplicates (all but the first occurrence) from the list but otherwise preserves the order of the elements." + unique :: [a] -> [a] + + "Like `unique`, but uses the given function for finding the key values used for uniqueness testing." + uniqueBy :: (a -> b) -> [a] -> [a] + "Works like `unique` but uses the given function for equality tests." uniqueWith :: (a -> a -> Boolean) -> [a] -> [a] + "Works like `\\\\` but uses the given function for equality tests." deleteAllBy :: (a -> a -> Boolean) -> [a] -> [a] -> [a] + @private + listDifference :: [a] -> [a] -> [a] + //range :: Integer -> Integer -> [Integer] //build :: (forall a. a -> (a -> b -> a) -> a) -> [b] @@ -1942,6 +2011,16 @@ elemMaybe el m = match m with Just el2 -> el == el2 Nothing -> False +"`elemIndex el lst` returns the index of the first element in the given list `lst` which is equal (by ==) to the query element, or Nothing if there is no such element." +elemIndex :: a -> [a] -> Maybe Integer +elemIndex el l = loop 0 + where + len = length l + loop i | i < len = if el == l!i + then Just i + else loop (i+1) + | otherwise = Nothing + """ Computes a list that contains only elements that belongs to both input lists. """ @@ -2046,42 +2125,9 @@ sortBy f l = sortWith (\x y -> compare (f x) (f y)) l // This is faster if f is slow, but will generate more auxiliary structures //sortBy f l = map snd (sortWith (\(x,_) (y,_) -> compare x y) [(f x, x) | x <- l]) -""" -Given a list of key-value pairs, the function produces a function that finds a value -efficiently for the given key. -""" -index :: [(a,b)] -> a -> Maybe b -index = indexWith hashCode (==) - -""" -Given a list of values and a function computing a key for each value, the function produces a function that finds a value -effeciently for the given key. -""" -indexBy :: (a -> b) -> [a] -> b -> Maybe a -indexBy f l = index [(f x, x) | x <- l] - -"Groups a list values by a key computed by the given function." -groupBy :: (a -> b) -> [a] -> [(b, [a])] -groupBy f l = groupWith hashCode (==) f id l - -"Groups a list of key-value pairs by the keys." -group :: [(a,b)] -> [(a, [b])] -group = groupWith hashCode (==) fst snd - -"Removes duplicates (all but the first occurrence) from the list but otherwise preserves the order of the elements." -unique :: [a] -> [a] -unique = uniqueWith (==) - -"Like `unique`, but uses the given function for finding the key values used for uniqueness testing." -uniqueBy :: (a -> b) -> [a] -> [a] -uniqueBy f = uniqueWith (\a b -> f a == f b) - -//sortAndUniqueBy :: Ord b => (a -> b) -> [a] -> [a] -//sortAndUniqueBy f = map snd . uniqueWith (\a b -> fst a == fst b) . sortBy fst . map (\x -> (f x, x)) - "`a \\\\ b` removes all elements of `b` from the list `a`." (\\) :: [a] -> [a] -> [a] -(\\) = deleteAllBy (==) +(\\) = listDifference /// Dynamic /// @@ -2168,6 +2214,12 @@ importJava "java.lang.Throwable" where @private @JavaName toString showThrowable :: Throwable -> String + @private + @JavaName getMessage + getMessageThrowable :: Throwable -> String + @private + @JavaName getCause + getCauseThrowable :: Throwable -> Maybe Throwable importJava "java.lang.Exception" where data Exception @private @@ -2179,6 +2231,20 @@ instance Show Throwable where instance Show Exception where show = showException +class Throwable e where + toThrowable :: e -> Throwable + +messageOfException :: Throwable e => e -> String +messageOfException = getMessageThrowable . toThrowable + +causeOfException :: Throwable e => e -> Maybe Throwable +causeOfException = getCauseThrowable . toThrowable + +instance Throwable Throwable where + toThrowable = id +instance Throwable Exception where + toThrowable = Java.unsafeCoerce + "Prints the given value in the console." @inline print :: Show a => a -> ()