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=5e5bd858b8b65e2a30210e388fd6de72ef1a747f;hb=HEAD;hpb=5624bd4adbed726047cc677eee7d86420f7097f3

diff --git a/bundles/org.simantics.scl.runtime/scl/Prelude.scl b/bundles/org.simantics.scl.runtime/scl/Prelude.scl
index 5e5bd858b..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 ()
@@ -1091,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 -> <e> m b) -> <e> 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 -> <e> m b) -> (b -> <f> m c) -> a -> <e,f> m c
+compE f g x = (f x) `bindE` g
+
+/// MZeroE ///
+
+class (MonadE m, MonadZero m) => MonadZeroE m where
+    filter :: (a -> <e> Boolean) -> m a -> <e> 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."
@@ -1164,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
@@ -1286,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 -> <e> b) -> Maybe a -> <e> 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
@@ -1303,6 +1335,11 @@ orElse :: Maybe a -> (<e> a) -> <e> a
 orElse (Just x) _   = x
 orElse Nothing  def = def
 
+@inline
+orElseM :: Maybe a -> (<e> Maybe a) -> <e> Maybe a
+orElseM mx@(Just x) _   = mx
+orElseM Nothing     def = def
+
 /// Either ///
 
 """
@@ -1421,6 +1458,11 @@ importJava "java.lang.String" where
     "Creates a string from a vector of characters."
     @JavaName "<init>"
     string :: Vector Character -> String
+    
+    getBytes :: String -> String -> ByteArray
+
+getBytesUTF8 :: String -> ByteArray
+getBytesUTF8 str = getBytes str "UTF-8"
 
 instance Ord String where
     compare = compareString
@@ -1484,6 +1526,14 @@ fst (x,y) = x
 snd :: (a,b) -> b
 snd (x,y) = y
 
+@inline
+mapFst :: (a -> <e> b) -> (a,c) -> <e> (b,c)
+mapFst f (x,y) = (f x, y)
+
+@inline
+mapSnd :: (a -> <e> b) -> (c,a) -> <e> (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
 
@@ -1814,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 -> <e> Boolean) -> [a] -> <e> [a]
-filter p l = build (\empty cons -> foldl (\cur x -> if p x then cons cur x else cur) empty l)
+filterList :: (a -> <e> Boolean) -> [a] -> <e> [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,
@@ -1945,11 +1995,16 @@ importJava "org.simantics.scl.runtime.Lists" where
     """
     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
+    indexBy ::  (a -> <e> b) -> [a] -> <e> (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
@@ -1972,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 -> <e> b) -> [a] -> <e> [a]
 
     "Works like `unique` but uses the given function for equality tests."
     uniqueWith :: (a -> a -> Boolean) -> [a] -> [a]
@@ -2003,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.
 """
@@ -2023,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]]
 
@@ -2196,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
@@ -2207,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 -> <Proc> ()
@@ -2238,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