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=86d13fb6628e77401b7a7fd0be2866834216ffca;hp=907d6e00d74084dfc12dddedd205448624ecc2a8;hb=9a84d1d757f513d7b831140a40fc1905a843f3ef;hpb=82a87b8535628d47d9c381e1a3a2296fb67c7fd0 diff --git a/bundles/org.simantics.scl.runtime/scl/Prelude.scl b/bundles/org.simantics.scl.runtime/scl/Prelude.scl index 907d6e00d..86d13fb66 100644 --- a/bundles/org.simantics.scl.runtime/scl/Prelude.scl +++ b/bundles/org.simantics.scl.runtime/scl/Prelude.scl @@ -38,11 +38,16 @@ class Serializable a binding :: Serializable a => Binding a ***********************************************************/ +type BooleanArray = Vector Boolean +type ByteArray = Vector Byte +type CharacterArray = Vector Character +type ShortArray = Vector Short +type IntegerArray = Vector Integer +type LongArray = Vector Long +type FloatArray = Vector Float +type DoubleArray = Vector Double + importJava "java.util.Arrays" where - @private - @JavaName toString - showDoubleArray :: DoubleArray -> String - "Converts an array to a list." @JavaName asList arrayToList :: Array a -> [a] @@ -52,9 +57,6 @@ importJava "java.util.List" where @JavaName toArray listToArray :: [a] -> Array a -instance Show DoubleArray where - show = showDoubleArray - importJava "org.simantics.scl.runtime.Coercion" where "Converts a list of doubles to a double array." toDoubleArray :: [Double] -> DoubleArray @@ -73,7 +75,7 @@ infixl 6 (+), (-) infixl 5 (\\), (<<), (<+) infix 4 (!=), (<), (<=), (>=), (>) infixr 3 (&&), (&<&) -infixr 2 (||), orElse, morelse +infixr 2 (||), orElse, orElseM, morelse infixr 1 (>>=), (>>), (:=), (>=>) infixr 1 ($) infixl 1 catch @@ -961,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 () @@ -1081,16 +1086,17 @@ 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 + "An effectful version of the bind operator `(>>=)`" bindE :: m a -> (a -> m b) -> m b instance MonadE Maybe where @@ -1103,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." @@ -1162,6 +1187,16 @@ 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 :: [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 (!) = getList @@ -1278,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 @@ -1295,6 +1335,11 @@ orElse :: Maybe a -> ( a) -> a orElse (Just x) _ = x orElse Nothing def = def +@inline +orElseM :: Maybe a -> ( Maybe a) -> Maybe a +orElseM mx@(Just x) _ = mx +orElseM Nothing def = def + /// Either /// """ @@ -1413,6 +1458,11 @@ importJava "java.lang.String" where "Creates a string from a vector of characters." @JavaName "" string :: Vector Character -> String + + getBytes :: String -> String -> ByteArray + +getBytesUTF8 :: String -> ByteArray +getBytesUTF8 str = getBytes str "UTF-8" instance Ord String where compare = compareString @@ -1476,6 +1526,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 @@ -1806,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, @@ -1930,14 +1988,56 @@ 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 elements, the function produces its characteristic function. + """ + indexSet :: [a] -> a -> Boolean + + """ + 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] @@ -1958,6 +2058,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. """ @@ -1978,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]] @@ -2062,42 +2173,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 /// @@ -2184,6 +2262,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 @@ -2195,6 +2279,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 -> () @@ -2226,16 +2324,6 @@ instance Show TypeRep where isSpecialType (TApply a _) = isSpecialType a */ -// ByteArray - -importJava "java.util.Arrays" where - @private - @JavaName toString - byteArrayToString :: ByteArray -> String - -instance Show ByteArray where - show = byteArrayToString - // Type @private