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=c04cc8625aa0be2bceb1ab372f8f9fe5a7eca5c4;hp=6966b4489d0652c61b8cde57fc7d185b75a2dd08;hb=46ea0d713406fbd0a0d8a8e5f41b7fb8ea7001c3;hpb=0cbe7783b5f5297ab926fa742e023cfcbdcba43d diff --git a/bundles/org.simantics.scl.runtime/scl/Prelude.scl b/bundles/org.simantics.scl.runtime/scl/Prelude.scl index 6966b4489..c04cc8625 100644 --- a/bundles/org.simantics.scl.runtime/scl/Prelude.scl +++ b/bundles/org.simantics.scl.runtime/scl/Prelude.scl @@ -39,10 +39,6 @@ binding :: Serializable a => Binding a ***********************************************************/ importJava "java.util.Arrays" where - @private - @JavaName equals - equalsDoubleArray :: DoubleArray -> DoubleArray -> Boolean - @private @JavaName toString showDoubleArray :: DoubleArray -> String @@ -56,8 +52,6 @@ importJava "java.util.List" where @JavaName toArray listToArray :: [a] -> Array a -instance Eq DoubleArray where - (==) = equalsDoubleArray instance Show DoubleArray where show = showDoubleArray @@ -77,10 +71,10 @@ infixr 8 (^) infixl 7 (*), (/), div, mod infixl 6 (+), (-) infixl 5 (\\), (<<), (<+) -infix 4 (==), (!=), (<), (<=), (>=), (>) +infix 4 (!=), (<), (<=), (>=), (>) infixr 3 (&&), (&<&) infixr 2 (||), orElse, morelse -infixr 1 (>>=), (>>), (:=) +infixr 1 (>>=), (>>), (:=), (>=>) infixr 1 ($) infixl 1 catch @@ -129,28 +123,21 @@ uncurry3 f (x, y, z) = f x y z flip :: (a -> b -> c) -> b -> a -> c flip f x y = f y x +"Swaps the order of elements of a pair (2-tuple)." swap :: (a,b) -> (b,a) swap (x,y) = (y,x) /// Comparison /// -""" -The class of types whose elements can be compared for equality. -Method `(==)` must be implemented in instances. -""" -class Eq a where - "Equality" - (==) :: a -> a -> Boolean - "Inequality: `a != b = not (a == b)`" - (!=) :: a -> a -> Boolean - - a != b = not (a == b) +@inline +(!=) :: a -> a -> Boolean +a != b = not (a == b) """ The class of linearly ordered types. Method `compare` must be implemented in instances. """ -class (Eq a) => Ord a where +class Ord a where """ `compare x y` returns a negative number, if `x` is smaller than `y`, a positive number, if `x` is bigger than `y` and zero if they are equal. @@ -220,17 +207,6 @@ minimumBy f l = snd $ foldl1 minF $ map (\x -> (f x, x)) l where minF a b = if fst a <= fst b then a else b -""" -The class of types with method to compute hash codes. -""" -class (Eq a) => Hashable a where - "`hashP v seed` computes the hash code of `v` using `seed` as a seed." - hashP :: a -> Integer -> Integer - -"`hash v` computes the hash code of `v`" -hash :: Hashable a => a -> Integer -hash a = hashP a 1166136261 - /// Functions /// /* instance Functor ((->) a) where @@ -566,10 +542,6 @@ importJava "java.lang.Byte" where @JavaName parseByte readByte :: String -> Byte -instance Eq Byte where - (==) = Java.bcmpeq - (!=) = Java.bcmpne - instance Ord Byte where (<) = Java.bcmplt (<=) = Java.bcmple @@ -603,10 +575,6 @@ importJava "java.lang.Short" where @JavaName parseShort readShort :: String -> Short -instance Eq Short where - (==) = Java.scmpeq - (!=) = Java.scmpne - instance Ord Short where (<) = Java.scmplt (<=) = Java.scmple @@ -641,18 +609,11 @@ importJava "java.lang.Integer" where @JavaName parseInt readInteger :: String -> Integer -instance Eq Integer where - (==) = Java.icmpeq - (!=) = Java.icmpne - instance Ord Integer where (<) = Java.icmplt (<=) = Java.icmple (>) = Java.icmpgt (>=) = Java.icmpge - -instance Hashable Integer where - hashP v x = Java.ixor v (Java.imul x 16777619) // prime for FNV-1 hash instance Additive Integer where zero = Java.iconst_0 @@ -690,18 +651,11 @@ importJava "java.lang.Long" where @JavaName parseLong readLong :: String -> Long -instance Eq Long where - (==) = Java.lcmpeq - (!=) = Java.lcmpne - instance Ord Long where (<) = Java.lcmplt (<=) = Java.lcmple (>) = Java.lcmpgt (>=) = Java.lcmpge - -instance Hashable Long where - hashP v x = Java.l2i (Java.lxor v (Java.lushr v 32)) + x*16777619 instance Additive Long where zero = Java.lconst_0 @@ -747,10 +701,6 @@ importJava "java.lang.Float" where "Converts 32-bit floating point number to a 32-bit integer with the same byte level representation." floatToIntBits :: Float -> Integer -instance Eq Float where - (==) = Java.fcmpeq - (!=) = Java.fcmpne - instance Ord Float where compare = compareFloat (<) = Java.fcmplt @@ -758,9 +708,6 @@ instance Ord Float where (>) = Java.fcmpgt (>=) = Java.fcmpge -instance Hashable Float where - hashP v x = hashP (floatToIntBits v) x - instance Additive Float where zero = Java.fconst_0 (+) = Java.fadd @@ -828,19 +775,12 @@ importJava "java.lang.Double" where isNaN :: Double -> Boolean isInfinite :: Double -> Boolean -instance Eq Double where - (==) = Java.dcmpeq - (!=) = Java.dcmpne - instance Ord Double where compare = compareDouble (<) = Java.dcmplt (<=) = Java.dcmple (>) = Java.dcmpgt - (>=) = Java.dcmpge - -instance Hashable Double where - hashP v x = hashP (doubleToLongBits v) x + (>=) = Java.dcmpge instance Additive Double where zero = Java.dconst_0 @@ -899,10 +839,6 @@ importJava "java.lang.Character" where "Returns true, if the given character is a digit." isDigit :: Character -> Boolean -instance Eq Character where - (==) = Java.ccmpeq - (!=) = Java.ccmpne - instance Ord Character where (<) = Java.ccmplt (<=) = Java.ccmple @@ -985,6 +921,10 @@ Sequentially compose two actions, discarding any value produced by the first, li (>>) :: Monad m => m a -> m b -> m b a >> b = a >>= (\_ -> b) +"Left-to-right Kleisli composition of monads." +(>=>) :: Monad m => (a -> m b) -> (b -> m c) -> (a -> m c) +(f >=> g) x = (f x) >>= g + "While loop. `while cond body` executes the `body` while the `cond` is true." @inline while :: ( Boolean) -> ( a) -> () @@ -1130,15 +1070,40 @@ mapEither f list = runProc do Right v -> addArrayList r v) (Java.unsafeCoerce l, Java.unsafeCoerce r) +"`replicate n v` returns a list of length `n` such that each element is a copy of `v`." +@inline +replicate :: Integer -> a -> [a] +replicate n v = build (\empty cons -> + let aux 0 l = l + aux i l = aux (i-1) (cons l v) + in aux n empty + ) + /// 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." @@ -1197,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 @@ -1213,10 +1186,6 @@ guard patterns: otherwise :: Boolean otherwise = True -instance Eq Boolean where - a == b = if a then b else not b - a != b = if a then not b else b - instance Ord Boolean where compare False False = 0 compare False True = neg 1 @@ -1269,10 +1238,8 @@ not a = if a then False else True fromJust :: Maybe a -> a fromJust (Just a) = a -deriving instance (Eq a) => Eq (Maybe a) deriving instance (Ord a) => Ord (Maybe a) deriving instance (Show a) => Show (Maybe a) -deriving instance (Hashable a) => Hashable (Maybe a) instance Functor Maybe where fmap _ Nothing = Nothing @@ -1344,12 +1311,17 @@ The Either type represents values with two possibilities: a value of type `Eithe The `Either` type is sometimes used to represent a value which is either correct or an error; by convention, the `Left` constructor is used to hold an error value and the `Right` constructor is used to hold a correct value (mnemonic: "right" also means "correct"). """ -data Either a b = Left a | Right b +@JavaType "org.simantics.scl.runtime.either.Either" +data Either a b = + @JavaType "org.simantics.scl.runtime.either.Left" + @FieldNames [value] + Left a + | @JavaType "org.simantics.scl.runtime.either.Right" + @FieldNames [value] + Right b -deriving instance (Eq a, Eq b) => Eq (Either a b) deriving instance (Ord a, Ord b) => Ord (Either a b) deriving instance (Show a, Show b) => Show (Either a b) -deriving instance (Hashable a, Hashable b) => Hashable (Either a b) instance Functor (Either a) where fmap _ (Left x) = Left x @@ -1384,12 +1356,6 @@ importJava "java.lang.String" where @JavaName "compareTo" compareString :: String -> String -> Integer @private -// @JavaName "hashCode" -// hashString :: String -> Integer - @private - @JavaName "equals" - equalsString :: String -> String -> Boolean - @private @JavaName "length" lengthString :: String -> Integer @@ -1456,12 +1422,6 @@ importJava "java.lang.String" where @JavaName "" string :: Vector Character -> String -instance Eq String where - (==) = equalsString - -instance Hashable String where - hashP x v = Java.hashCode x + v*16777619 - instance Ord String where compare = compareString @@ -1481,24 +1441,30 @@ instance Show String where instance Read String where read str = str +@deprecated "Instead of 'splitString text pattern', write 'split pattern text' (note change in the parameter order)." "`splitString text pattern` splits the string into a list of string where the parts are sepratated in the original list by the given pattern." splitString :: String -> String -> [String] splitString source pattern = arrayToList $ splitString_ source pattern +""" +`split pattern text` splits `text` around matches of the given regular expression `pattern`. + +This function works as if by invoking the two-argument split method with the given expression and a limit argument of zero. Trailing empty strings are therefore not included in the resulting array. + +The string "boo:and:foo", for example, yields the following results with these expressions: + + Regex Result + : { "boo", "and", "foo" } + o { "b", "", ":and:f" } +""" split :: String -> String -> [String] split pattern text = arrayToList $ splitString_ text pattern /// Tuple0 /// -instance Eq () where - () == () = True - instance Ord () where compare () () = 0 -instance Hashable () where - hashP () x = x - instance Additive () where zero = () () + () = () @@ -1518,15 +1484,9 @@ fst (x,y) = x snd :: (a,b) -> b snd (x,y) = y -instance (Eq a, Eq b) => Eq (a, b) where - (a0, b0) == (a1, b1) = a0 == a1 && b0 == b1 - instance (Ord a, Ord b) => Ord (a, b) where compare (a0, b0) (a1, b1) = compare a0 a1 &<& compare b0 b1 -instance (Hashable a, Hashable b) => Hashable (a, b) where - hashP (a,b) x = hashP b $ hashP a x - instance (Additive a, Additive b) => Additive (a, b) where zero = (zero, zero) (a0, b0) + (a1, b1) = (a0+a1, b0+b1) @@ -1539,15 +1499,9 @@ instance (Show a, Show b) => Show (a, b) where /// Tuple3 /// -instance (Eq a, Eq b, Eq c) => Eq (a, b, c) where - (a0, b0, c0) == (a1, b1, c1) = a0 == a1 && b0 == b1 && c0 == c1 - instance (Ord a, Ord b, Ord c) => Ord (a, b, c) where compare (a0, b0, c0) (a1, b1, c1) = compare a0 a1 &<& compare b0 b1 &<& compare c0 c1 -instance (Hashable a, Hashable b, Hashable c) => Hashable (a, b, c) where - hashP (a,b,c) x = hashP c $ hashP b $ hashP a x - instance (Additive a, Additive b, Additive c) => Additive (a, b, c) where zero = (zero, zero, zero) (a0, b0, c0) + (a1, b1, c1) = (a0+a1, b0+b1, c0+c1) @@ -1560,16 +1514,10 @@ instance (Show a, Show b, Show c) => Show (a, b, c) where /// Tuple4 /// -instance (Eq a, Eq b, Eq c, Eq d) => Eq (a, b, c, d) where - (a0, b0, c0, d0) == (a1, b1, c1, d1) = a0 == a1 && b0 == b1 && c0 == c1 && d0 == d1 - instance (Ord a, Ord b, Ord c, Ord d) => Ord (a, b, c, d) where compare (a0, b0, c0, d0) (a1, b1, c1, d1) = compare a0 a1 &<& compare b0 b1 &<& compare c0 c1 &<& compare d0 d1 -instance (Hashable a, Hashable b, Hashable c, Hashable d) => Hashable (a, b, c, d) where - hashP (a,b,c,d) x = hashP d $ hashP c $ hashP b $ hashP a x - instance (Additive a, Additive b, Additive c, Additive d) => Additive (a, b, c, d) where zero = (zero, zero, zero, zero) (a0, b0, c0, d0) + (a1, b1, c1, d1) = (a0+a1, b0+b1, c0+c1, d0+d1) @@ -1582,17 +1530,9 @@ instance (Show a, Show b, Show c, Show d) => Show (a, b, c, d) where /// Tuple5 /// -instance (Eq a, Eq b, Eq c, Eq d, Eq e) => Eq (a, b, c, d, e) where - (a0, b0, c0, d0, e0) == (a1, b1, c1, d1, e1) = - a0 == a1 && b0 == b1 && c0 == c1 && d0 == d1 && e0 == e1 - instance (Ord a, Ord b, Ord c, Ord d, Ord e) => Ord (a, b, c, d, e) where compare (a0, b0, c0, d0, e0) (a1, b1, c1, d1, e1) = compare a0 a1 &<& compare b0 b1 &<& compare c0 c1 &<& compare d0 d1 &<& compare e0 e1 - -instance (Hashable a, Hashable b, Hashable c, Hashable d, Hashable e) - => Hashable (a, b, c, d, e) where - hashP (a,b,c,d,e) x = hashP e $ hashP d $ hashP c $ hashP b $ hashP a x instance (Additive a, Additive b, Additive c, Additive d, Additive e) => Additive (a, b, c, d, e) where zero = (zero, zero, zero, zero, zero) @@ -1603,13 +1543,6 @@ instance Functor ((,,,,) a b c d) where /// Lists /// -instance (Eq a) => Eq [a] where - a == b = lA == lB && loop 0 - where - lA = length a - lB = length b - loop i = i>=lA || (a!i == b!i && loop (i+1)) - instance (Ord a) => Ord [a] where compare a b = loop 0 where @@ -1621,14 +1554,6 @@ instance (Ord a) => Ord [a] where then 1 else compare (a!i) (b!i) &<& loop (i+1) -instance (Hashable a) => Hashable [a] where - hashP a x = loop 0 x - where - lA = length a - loop i x = if i == lA - then x - else loop (i+1) (hashP (a!i) x) - instance Functor [] where fmap = mapList @@ -1666,11 +1591,42 @@ printWithSeparator sb sep l = loop 0 (if i==0 then sb else sb << sep) <+ l!i loop (i+1) -"Joins the string representations of the list of values with the given separator." +""" +Joins the string representations of the list of values with the given separator. + +See [intercalate](#intercalate) for an alternative that works with Strings +and doesn't escape its arguments. +""" joinWithSeparator :: Show a => String -> [a] -> String joinWithSeparator separator values = runProc ( StringBuilder.toString $ printWithSeparator StringBuilder.new separator values) + +""" +The intercalate function takes a String and a list of Strings +and concatenates the list after interspersing the first argument +between each element of the list. + +See also more generic [joinWithSeparator](#joinWithSeparator) +which escapes its arguments using `show`. +""" +intercalate :: String -> [String] -> String +intercalate separator strings = do + l = length strings + if l == 0 + then "" + else if l == 1 + then strings!0 + else runProc do + sb = StringBuilder.new + sb << strings!0 + loop i | i == l = () + | otherwise = do + sb << separator << strings!i + loop (i+1) + loop 1 + StringBuilder.toString sb + instance (Show a) => Show [a] where sb <+ l = do len = length l @@ -1879,6 +1835,17 @@ maybeToList :: Maybe a -> [a] maybeToList (Just a) = [a] maybeToList _ = [] +""" +`takeWhile p l`, returns the longest prefix (possibly empty) of list `l` of elements that satisfy `p` +""" +takeWhile :: (a -> Boolean) -> [a] -> [a] +takeWhile f l = loop 0 + where + len = length l + loop i | i == len = l + | f (l!i) = loop (i+1) + | otherwise = take i l + partition :: (a -> Boolean) -> [a] -> ([a], [a]) partition p l = runProc do res1 = newArrayList @@ -1971,20 +1938,57 @@ 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] "`elem el lst` return true, if `el` occurs in the list `lst`." -elem :: Eq a => a -> [a] -> Boolean +elem :: a -> [a] -> Boolean elem el l = loop 0 where len = length l @@ -1994,15 +1998,25 @@ elem el l = loop 0 | otherwise = False "`elemMaybe v1 (Just v2)` returns true if `v1 == v2`. `elemMaybe v1 Nothing` is always false." -elemMaybe :: Eq a => a -> Maybe a -> Boolean +elemMaybe :: a -> Maybe a -> Boolean 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. """ -intersect :: Eq a => [a] -> [a] -> [a] +intersect :: [a] -> [a] -> [a] intersect a b = filter f a where f e = elem e b @@ -2033,7 +2047,7 @@ tail l = if len < 2 then emptyList else subList l 1 len len = length l "Tries to find the given key from the list of key-value pairs and returns the corresponding value." -lookup :: Eq a => a -> [(a, b)] -> Maybe b +lookup :: a -> [(a, b)] -> Maybe b lookup el l = do len = length l loop i = if i < len @@ -2103,42 +2117,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 :: Hashable a => [(a,b)] -> a -> Maybe b -index = indexWith hash (==) - -""" -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 :: Hashable b => (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 :: Hashable b => (a -> b) -> [a] -> [(b, [a])] -groupBy f l = groupWith hash (==) f id l - -"Groups a list of key-value pairs by the keys." -group :: Hashable a => [(a,b)] -> [(a, [b])] -group = groupWith hash (==) fst snd - -"Removes duplicates (all but the first occurrence) from the list but otherwise preserves the order of the elements." -unique :: Eq a => [a] -> [a] -unique = uniqueWith (==) - -"Like `unique`, but uses the given function for finding the key values used for uniqueness testing." -uniqueBy :: Eq b => (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`." -(\\) :: Eq a => [a] -> [a] -> [a] -(\\) = deleteAllBy (==) +(\\) :: [a] -> [a] -> [a] +(\\) = listDifference /// Dynamic /// @@ -2218,7 +2199,7 @@ importJava "org.simantics.scl.runtime.procedure.Procedures" where "Executes the given expression and catches certain class of exceptions (specified by the catch handler that is given as a second parameter.)" @JavaName catch_ - catch :: VecComp ex => ( a) -> (ex -> a) -> a + catch :: VecComp ex => ( a) -> (ex -> a) -> a importJava "java.lang.Throwable" where data Throwable