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=2c5966dc40f99a2b38a594b675dd8dc9588bf1bb;hp=84f8b91b6ef97751ea1f0a00b053ece6e2e8be63;hb=7045f0f516c243563976207abcec13a68891ff1d;hpb=35a513a86eb0e30c29ebf094cc778b08e5bbded4 diff --git a/bundles/org.simantics.scl.runtime/scl/Prelude.scl b/bundles/org.simantics.scl.runtime/scl/Prelude.scl index 84f8b91b6..2c5966dc4 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,7 +71,7 @@ infixr 8 (^) infixl 7 (*), (/), div, mod infixl 6 (+), (-) infixl 5 (\\), (<<), (<+) -infix 4 (==), (!=), (<), (<=), (>=), (>) +infix 4 (!=), (<), (<=), (>=), (>) infixr 3 (&&), (&<&) infixr 2 (||), orElse, morelse infixr 1 (>>=), (>>), (:=) @@ -134,23 +128,15 @@ 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 +206,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 @@ -558,6 +533,39 @@ importJava "java.lang.Math" where /// Integer /// +@private +importJava "java.lang.Byte" where + @JavaName toString + showByte :: Byte -> String + + @JavaName parseByte + readByte :: String -> Byte + +instance Ord Byte where + (<) = Java.bcmplt + (<=) = Java.bcmple + (>) = Java.bcmpgt + (>=) = Java.bcmpge + +instance Additive Byte where + zero = Java.i2b Java.iconst_0 + (+) = Java.badd + +instance Ring Byte where + neg = Java.bneg + (-) = Java.bsub + one = Java.i2b Java.iconst_1 + (*) = Java.bmul + fromInteger = Java.i2b + +instance Show Byte where + show = showByte + precedence v = if v >= 0 then 0 else 100 + +instance Read Byte where + read = readByte + + @private importJava "java.lang.Short" where @JavaName toString @@ -566,10 +574,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 @@ -604,18 +608,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 @@ -653,18 +650,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 @@ -710,10 +700,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 @@ -721,9 +707,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 @@ -791,19 +774,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 @@ -862,10 +838,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 @@ -1176,10 +1148,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 @@ -1232,10 +1200,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 @@ -1309,10 +1275,8 @@ is used to hold an error value and the `Right` constructor is used to hold a cor """ data Either a b = Left a | 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 @@ -1347,12 +1311,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 @@ -1419,12 +1377,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 @@ -1444,6 +1396,7 @@ instance Show String where instance Read String where read str = str +@deprecated "`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 @@ -1453,15 +1406,9 @@ 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 = () () + () = () @@ -1481,15 +1428,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) @@ -1502,15 +1443,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) @@ -1523,16 +1458,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) @@ -1545,17 +1474,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) @@ -1566,13 +1487,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 @@ -1584,14 +1498,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 @@ -1842,6 +1748,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 @@ -1947,7 +1864,7 @@ importJava "org.simantics.scl.runtime.Lists" where //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 @@ -1957,7 +1874,7 @@ 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 @@ -1965,7 +1882,7 @@ elemMaybe el m = match m with """ 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 @@ -1996,7 +1913,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 @@ -2070,37 +1987,37 @@ sortBy f l = sortWith (\x y -> compare (f x) (f y)) 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 (==) +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 :: Hashable b => (a -> b) -> [a] -> b -> Maybe a +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 :: Hashable b => (a -> b) -> [a] -> [(b, [a])] -groupBy f l = groupWith hash (==) f id l +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 :: Hashable a => [(a,b)] -> [(a, [b])] -group = groupWith hash (==) fst snd +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 :: Eq a => [a] -> [a] +unique :: [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 :: (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] +(\\) :: [a] -> [a] -> [a] (\\) = deleteAllBy (==) /// Dynamic /// @@ -2229,45 +2146,7 @@ instance Show TypeRep where isSpecialType (TCon "Builtin" "(,,,)") = True isSpecialType (TApply a _) = isSpecialType a */ -// Serializable - -importJava "org.simantics.databoard.serialization.Serializer" where - data Serializer a - - @private - @JavaName "serialize" - serialize_ :: Serializer a -> a -> ByteArray - - @private - @JavaName "deserialize" - deserialize_ :: Serializer a -> ByteArray -> a - -importJava "org.simantics.databoard.Bindings" where - @private - @JavaName "getSerializer" - serializerOf :: Binding a -> Serializer a - - @private - @JavaName toString - bindingToString :: Binding a -> String - - @JavaName adapt - adapt_ :: a -> Binding a -> Binding b -> b - -adapt :: Serializable a => Serializable b => a -> b -adapt x = adapt_ x binding binding - -instance Show (Binding a) where - show = bindingToString - -"Serializes a value to a byte array." -serialize :: Serializable a => a -> ByteArray -serialize v = serialize_ (serializerOf binding) v -"Deserializes a value from a byte array." -deserialize :: Serializable a => ByteArray -> a -deserialize ba = deserialize_ (serializerOf binding) ba - // ByteArray importJava "java.util.Arrays" where @@ -2278,53 +2157,6 @@ importJava "java.util.Arrays" where instance Show ByteArray where show = byteArrayToString -importJava "org.simantics.databoard.binding.mutable.Variant" where - // data Variant (in Builtins) - @JavaName getValue - rawVariantValue :: Variant -> a - @JavaName ofInstance - variantOf :: a -> Variant - @JavaName "" - variantOfWithBinding :: Binding a -> a -> Variant - @JavaName getValue - variantValue_ :: Variant -> Binding a -> a - @JavaName toString - showVariant :: Variant -> String - - @JavaName getComponent - variantComponent :: Variant -> ChildReference -> Variant - -variantValue :: Serializable a => Variant -> a -variantValue v = variantValue_ v binding - -instance Show Variant where - show = showVariant - -variantElement :: Serializable a => Variant -> Integer -> a -variantElement v i = variantValue (variantComponent v (indexReference i)) - -importJava "org.simantics.databoard.accessor.reference.ChildReference" where - data ChildReference - - @JavaName compile - compileReference :: [ChildReference] -> ChildReference - -importJava "org.simantics.databoard.accessor.reference.IndexReference" where - @JavaName "" - indexReference :: Integer -> ChildReference - -importJava "org.simantics.databoard.accessor.reference.KeyReference" where - @JavaName "" - keyReference :: Variant -> ChildReference - -importJava "org.simantics.databoard.accessor.reference.NameReference" where - @JavaName "" - nameReference :: String -> ChildReference - -importJava "org.simantics.databoard.accessor.reference.LabelReference" where - @JavaName "" - labelReference :: String -> ChildReference - // Type @private