import "JavaBuiltin" as Java import "StringBuilder" as StringBuilder /** The following types and names are builtin ************* data Boolean = True | False data Byte data Character data Short data Integer data Long data Float data Double data BooleanArray data ByteArray data CharacterArray data ShortArray data IntegerArray data LongArray data FloatArray data DoubleArray data Array a data String data a -> b data [a] = [] | [a] | [a,a] | [a,a,a] | ... data () = () data (a,b) = (a,b) data (a,b,c) = (a,b,c) data Maybe a = Nothing | Just a fail :: String -> a data TypeRep = TCon String | TApply TypeRep TypeRep class Typeable a typeOf :: Typeable a => a -> Type data Binding a class Serializable a binding :: Serializable a => Binding a ***********************************************************/ importJava "java.util.Arrays" where @private @JavaName toString showDoubleArray :: DoubleArray -> String "Converts an array to a list." @JavaName asList arrayToList :: Array a -> [a] importJava "java.util.List" where "Converts a list to an array." @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 "Converts a double array to a list of doubles." fromDoubleArray :: DoubleArray -> [Double] /* * Precedences and associativity of all operators defined in Prelude */ infixr 10 (!) infixr 9 (.) infixr 8 (^) infixl 7 (*), (/), div, mod infixl 6 (+), (-) infixl 5 (\\), (<<), (<+) infix 4 (!=), (<), (<=), (>=), (>) infixr 3 (&&), (&<&) infixr 2 (||), orElse, morelse infixr 1 (>>=), (>>), (:=) infixr 1 ($) infixl 1 catch "Creates a constant function. `const x` defines a function that always returns `x`." @inline const :: a -> b -> a const c x = c """ Function application. `f $ x` is equivalent with `f x`. The function has two uses. First is to remove parentheses from deeply nested expressions: f (g (h x)) == f $ g $ h x The second use is with higher order functions: map ($ parameter) functions """ @macro @inline ($) :: (a -> b) -> a -> b f $ x = f x "Transforms a function taking a pair as a parameter to a function taking two values as a parameter." @inline curry :: ((a, b) -> c) -> a -> b -> c curry f x y = f (x, y) "Transforms a function two values as a parameter to a function taking a pair as a parameter." @inline uncurry :: (a -> b -> c) -> ((a, b) -> c) uncurry f (x, y) = f x y "Transforms a function taking a triple as a parameter to a function taking three values as a parameter." @inline curry3 :: ((a, b, c) -> d) -> a -> b -> c -> d curry3 f x y z = f (x, y, z) "Transforms a function three values as a parameter to a function taking a priple as a parameter." @inline uncurry3 :: (a -> b -> c -> d) -> ((a, b, c) -> d) uncurry3 f (x, y, z) = f x y z "Flips the parameters of a binary function." @inline flip :: (a -> b -> c) -> b -> a -> c flip f x y = f y x swap :: (a,b) -> (b,a) swap (x,y) = (y,x) /// Comparison /// @inline (!=) :: a -> a -> Boolean a != b = not (a == b) """ The class of linearly ordered types. Method `compare` must be implemented in instances. """ 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. """ compare :: a -> a -> Integer compare a b = if a < b then -1 else if a > b then 1 else 0 "Less" (<) :: a -> a -> Boolean a < b = compare a b < 0 "Less or equal" (<=) :: a -> a -> Boolean a <= b = compare a b <= 0 "Greater" (>) :: a -> a -> Boolean a > b = compare a b > 0 "Greater or equal" (>=) :: a -> a -> Boolean a >= b = compare a b >= 0 "Minimum of the parameters" min :: a -> a -> a min a b = if a < b then a else b "Maximum of the parameters" max :: a -> a -> a max a b = if a > b then a else b """ Combines two integers such that if the first one is non-zero, it is returned, otherwise the second-one. The second parameter is not implemented, if it is not needed. The function is useful for implementing efficient recursive comparison of structures, for example: compare (x1,y1,z1) (x2,y2,z2) = compare x1 x2 &<& compare y1 y2 &<& compare z1 z2 """ @inline (&<&) :: Integer -> ( Integer) -> Integer a &<& b = if a == 0 then b else a "Maximum over a list" @inline maximum :: Ord a => [a] -> a maximum = foldl1 max "Minimum over a list" @inline minimum :: Ord a => [a] -> a minimum = foldl1 min "As `maximum` but compares the elements by the given projection." maximumBy :: Ord b => (a -> b) -> [a] -> a maximumBy f l = snd $ foldl1 maxF $ map (\x -> (f x, x)) l where maxF a b = if fst a >= fst b then a else b """ As `minimum` but compares the elements by the given projection. For example minimumBy snd l returns a pair with the smallest second component. """ minimumBy :: Ord b => (a -> b) -> [a] -> a 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 /// Functions /// /* instance Functor ((->) a) where map f g x = f (g x) instance Monad ((->) a) where return v x = v (m >>= f) x = f (m x) x join f x = f x x instance Category (->) where id x = x @inline (f . g) x = f (g x) */ instance (Additive b) => Additive (a -> b) where zero x = zero (f + g) x = f x + g x instance (Ring b) => Ring (a -> b) where one x = one (neg f) x = neg (f x) (f - g) x = f x - g x (f * g) x = f x * g x (fromInteger c) x = fromInteger c //instance Show (a -> b) where // show f = "" "Appends a string to the string builder." (<<) :: StringBuilder.T -> String -> StringBuilder.T (<<) = StringBuilder.appendString """ The class of types whose elements can be converted to a string representation. Method `show` or `(<+)` must be implemented. """ class Show a where "Converts a value to string." show :: a -> String "Appends the string representation of the value to the string builder." (<+) :: StringBuilder.T -> a -> StringBuilder.T """ Returns the precedence of the value. It is used to determine if parenteheses are needed around the string representation of the value. The default value is 0 and means that parentheses are never added. """ precedence :: a -> Integer "Converts a value to a string like `show` but does not put string literals in double quotes." showForPrinting :: a -> String show v = runProc (StringBuilder.toString (StringBuilder.new <+ v)) showForPrinting v = show v sb <+ v = StringBuilder.appendString sb (show v) precedence v = 0 """ `Par` data type is used to control the placement of parentheses when converting values to string. Value `Par prec val` is converted to string like `val` but parentheses are put around, if the precedence of the value is greater than `prec`. """ data Par a = Par Integer a instance (Show a) => Show (Par a) where sb <+ (Par outerPrec v) = if prec > outerPrec then sb << "(" <+ v << ")" else sb <+ v where prec = precedence v "Type class for parsing strings to values." class Read a where "Converts a string to a required type of value." read :: String -> a """ The `Additive` class is used for types that are additive monoids. The operations must satisfy the following laws (at least approximately, when implemented for floating point numbers): (a + b) + c = a + (b + c) a + 0 = 0 + a = a """ class Additive a where """ Neutral element of (+), i.e, x + zero == x zero + x == x """ zero :: a "Adds two objects (numbers, vectors, strings, etc.) together." (+) :: a -> a -> a """ Sum of the elements: sum [e1,e2,...,eN] = e1 + e2 + ... + eN Implemented usually more efficiently than with repetitive application of `(+)`. """ sum :: [a] -> a sum = foldl (+) zero /* class (Additive a) => AdditiveGroup a where neg :: a -> a (-) :: a -> a -> a x - y = x + (neg y) */ """ The `Ring` class is used for types that are algebraic rings. The operations must satisfy the following laws (at least approximately) in addition to the laws of Additive: a + b = b + a a - b = a + (neg b) a - a = 0 (a * b) * c = a * (b * c) a * 1 = 1 * a = a a * (b + c) = a * b + a * c (a + b) * c = a * c + b * c """ class (Additive a) => Ring a where """ Negation. Synonym for unary `-`. """ neg :: a -> a "Subtraction" (-) :: a -> a -> a "Neutral element of multiplication" one :: a "Multiplication" (*) :: a -> a -> a "Converts an integer to a desired numeric type." fromInteger :: Integer -> a x - y = x + (neg y) """ The `OrderedRing` class combines the Ring and Ord classes. It additionally supports absolute value function. """ class (Ring a, Ord a) => OrderedRing a where "Absolute value." abs :: a -> a abs x = if x < zero then neg x else x "Converts the given number to `Integer`" toInteger :: a -> Integer """ The `Integer` class is used for types that represent either all integers or some range of them. """ class (OrderedRing a) => Integral a where "Integer division truncated toward zero." div :: a -> a -> a "Integer remainder, satisfying ``(x `div` y)*y + (x `mod` y) = x``" mod :: a -> a -> a """ The `Real` class is used for types that represent some approximation of real numbers. """ class (OrderedRing a) => Real a where "Division" (/) :: a -> a -> a "Exponentation" (^) :: a -> a -> a "Pi (3.141592654...)" pi :: a "Square root" sqrt :: a -> a "Exponent function" exp :: a -> a "Natural logarithm" log :: a -> a "Sine" sin :: a -> a "Cosine" cos :: a -> a "Tangent" tan :: a -> a "Inverse sine" asin :: a -> a "Inverse cosine" acos :: a -> a "Inverse tangent." atan :: a -> a "Hyperbolic sine" sinh :: a -> a "Hyperbolic cosine" cosh :: a -> a "Hyperbolic tangent" tanh :: a -> a "Inverse hyberbolic sine" asinh :: a -> a "Inverse hyberbolic cosine" acosh :: a -> a "Inverse hyberbolic tangent" atanh :: a -> a "The largest integer not greater than the given number" floor :: a -> a "The smallest integer not smaller than the given number" ceil :: a -> a round :: a -> Long """ Two parameter version of `atan`. Its value is determined by the following equations when (x,y) is a unit vector: x = cos (atan2 y x) y = sin (atan2 y x) When x > 0, atan2 y x = atan (y/x) """ atan2 :: a -> a -> a "Converts a `Double` value to a desired numeric type." fromDouble :: Double -> a "Converts the given number to `Double`" toDouble :: a -> Double a ^ b = exp (b * log a) sinh x = 0.5 * (exp x - exp (neg x)) cosh x = 0.5 * (exp x + exp (neg x)) tanh x = (e2x - 1) / (e2x + 1) where e2x = exp (2*x) asinh x = log (x + sqrt (x*x + one)) acosh x = log (x + sqrt (x*x - one)) atanh x = 0.5 * log ((one+x)/(one-x)) /// Import mathematical functions /// @private importJava "java.lang.Math" where @JavaName PI piDouble :: Double @JavaName sin sinDouble :: Double -> Double @JavaName cos cosDouble :: Double -> Double @JavaName tan tanDouble :: Double -> Double @JavaName asin asinDouble :: Double -> Double @JavaName acos acosDouble :: Double -> Double @JavaName atan atanDouble :: Double -> Double @JavaName atan2 atan2Double :: Double -> Double -> Double @JavaName sinh sinhDouble :: Double -> Double @JavaName cosh coshDouble :: Double -> Double @JavaName tanh tanhDouble :: Double -> Double @JavaName exp expDouble :: Double -> Double @JavaName log logDouble :: Double -> Double @JavaName pow powDouble :: Double -> Double -> Double @JavaName sqrt sqrtDouble :: Double -> Double @JavaName ceil ceilDouble :: Double -> Double @JavaName floor floorDouble :: Double -> Double @JavaName round roundDouble :: Double -> Long @JavaName abs absInteger :: Integer -> Integer @JavaName abs absLong :: Long -> Long @JavaName abs absFloat :: Float -> Float @JavaName abs absDouble :: Double -> Double @JavaName min minInteger :: Integer -> Integer -> Integer @JavaName min minLong :: Long -> Long -> Long @JavaName min minFloat :: Float -> Float -> Float @JavaName min minDouble :: Double -> Double -> Double @JavaName max maxInteger :: Integer -> Integer -> Integer @JavaName max maxLong :: Long -> Long -> Long @JavaName max maxFloat :: Float -> Float -> Float @JavaName max maxDouble :: Double -> Double -> Double /// 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 showShort :: Short -> String @JavaName parseShort readShort :: String -> Short instance Ord Short where (<) = Java.scmplt (<=) = Java.scmple (>) = Java.scmpgt (>=) = Java.scmpge instance Additive Short where zero = Java.sconst_0 (+) = Java.sadd instance Ring Short where neg = Java.sneg (-) = Java.ssub one = Java.sconst_1 (*) = Java.smul fromInteger = Java.i2s instance Show Short where show = showShort precedence v = if v >= 0 then 0 else 100 instance Read Short where read = readShort /// Integer /// @private importJava "java.lang.Integer" where @JavaName toString showInteger :: Integer -> String @JavaName parseInt readInteger :: String -> Integer instance Ord Integer where (<) = Java.icmplt (<=) = Java.icmple (>) = Java.icmpgt (>=) = Java.icmpge instance Additive Integer where zero = Java.iconst_0 (+) = Java.iadd instance Ring Integer where neg = Java.ineg (-) = Java.isub one = Java.iconst_1 (*) = Java.imul fromInteger x = x instance OrderedRing Integer where abs = absInteger toInteger x = x instance Integral Integer where div = Java.idiv mod = Java.irem instance Show Integer where show = showInteger precedence v = if v >= 0 then 0 else 100 instance Read Integer where read = readInteger /// Long /// @private importJava "java.lang.Long" where @JavaName toString showLong :: Long -> String @JavaName parseLong readLong :: String -> Long instance Ord Long where (<) = Java.lcmplt (<=) = Java.lcmple (>) = Java.lcmpgt (>=) = Java.lcmpge instance Additive Long where zero = Java.lconst_0 (+) = Java.ladd instance Ring Long where neg = Java.lneg (-) = Java.lsub one = Java.lconst_1 (*) = Java.lmul fromInteger = Java.i2l instance OrderedRing Long where abs = absLong toInteger = Java.l2i instance Integral Long where div = Java.ldiv mod = Java.lrem instance Show Long where show = showLong precedence v = if v >= 0 then 0 else 100 instance Read Long where read = readLong /// Float /// importJava "java.lang.Float" where @private @JavaName compare compareFloat :: Float -> Float -> Integer @private @JavaName toString showFloat :: Float -> String @private @JavaName parseFloat readFloat :: String -> Float "Converts 32-bit floating point number to a 32-bit integer with the same byte level representation." floatToIntBits :: Float -> Integer instance Ord Float where compare = compareFloat (<) = Java.fcmplt (<=) = Java.fcmple (>) = Java.fcmpgt (>=) = Java.fcmpge instance Additive Float where zero = Java.fconst_0 (+) = Java.fadd instance Ring Float where neg = Java.fneg (-) = Java.fsub one = Java.fconst_1 (*) = Java.fmul fromInteger = Java.i2f instance OrderedRing Float where abs = absFloat toInteger = Java.f2i instance Real Float where (/) = Java.fdiv x ^ y = Java.d2f (powDouble (Java.f2d x) (Java.f2d y)) pi = fromDouble piDouble sqrt = Java.d2f . sqrtDouble . Java.f2d exp = Java.d2f . expDouble . Java.f2d log = Java.d2f . logDouble . Java.f2d sin = Java.d2f . sinDouble . Java.f2d cos = Java.d2f . cosDouble . Java.f2d tan = Java.d2f . tanDouble . Java.f2d asin = Java.d2f . asinDouble . Java.f2d acos = Java.d2f . acosDouble . Java.f2d atan = Java.d2f . atanDouble . Java.f2d sinh = Java.d2f . sinhDouble . Java.f2d cosh = Java.d2f . coshDouble . Java.f2d tanh = Java.d2f . tanhDouble . Java.f2d floor = Java.d2f . floorDouble . Java.f2d ceil = Java.d2f . ceilDouble . Java.f2d atan2 y x = Java.d2f (atan2Double (Java.f2d y) (Java.f2d x)) round = roundDouble . Java.f2d fromDouble = Java.d2f toDouble = Java.f2d instance Show Float where show = showFloat precedence v = if v >= 0 then 0 else 100 instance Read Float where read = readFloat /// Double /// importJava "java.lang.Double" where @private @JavaName compare compareDouble :: Double -> Double -> Integer @private @JavaName toString showDouble :: Double -> String @private @JavaName parseDouble readDouble :: String -> Double "Converts 64-bit floating point number to a 64-bit integer with the same byte level representation." doubleToLongBits :: Double -> Long isFinite :: Double -> Boolean isNaN :: Double -> Boolean isInfinite :: Double -> Boolean instance Ord Double where compare = compareDouble (<) = Java.dcmplt (<=) = Java.dcmple (>) = Java.dcmpgt (>=) = Java.dcmpge instance Additive Double where zero = Java.dconst_0 (+) = Java.dadd instance Ring Double where neg = Java.dneg (-) = Java.dsub one = Java.dconst_1 (*) = Java.dmul fromInteger = Java.i2d instance OrderedRing Double where abs = absDouble toInteger = Java.d2i instance Real Double where (/) = Java.ddiv (^) = powDouble pi = piDouble sqrt = sqrtDouble exp = expDouble log = logDouble sin = sinDouble cos = cosDouble tan = tanDouble asin = asinDouble acos = acosDouble atan = atanDouble sinh = sinhDouble cosh = coshDouble tanh = tanhDouble floor = floorDouble ceil = ceilDouble atan2 = atan2Double round = roundDouble fromDouble x = x toDouble x = x instance Show Double where show = showDouble precedence v = if v >= 0 then 0 else 100 instance Read Double where read = readDouble /// Character /// importJava "java.lang.Character" where @JavaName toString showCharacter :: Character -> String "Returns true, if the given character is a letter." isLetter :: Character -> Boolean "Returns true, if the given character is a digit." isDigit :: Character -> Boolean instance Ord Character where (<) = Java.ccmplt (<=) = Java.ccmple (>) = Java.ccmpgt (>=) = Java.ccmpge instance Show Character where sb <+ c = sb << "'" << showCharacter c << "'" "Adds a given integer to the character code." addChar :: Character -> Integer -> Character addChar = Java.cadd "Subtracts a given integer from the character code." subChar :: Character -> Character -> Integer subChar = Java.csub /// Functor /// """ The `Functor` class is used for types that can be mapped over. Instances of `Functor` should satisfy the following laws: fmap id == id fmap (f . g) == fmap f . fmap g """ class Functor f where "Lifts a pure function to the given functor." fmap :: (a -> b) -> f a -> f b /* class CoFunctor f where comap :: (a -> b) -> f b -> f a */ /// Applicative /// /* class (Functor f) => Applicative f where return :: a -> f a (<*>) :: f (a -> b) -> f a -> f b (*>) :: f a -> f b -> f b (<*) :: f a -> f b -> f a u *> v = pure (const id) <*> u <*> v u <* v = pure const <*> u <*> v fmap f x = pure f <*> x */ /// Monad /// """ The `Monad` class defines the basic operations over a monad, a concept from a branch of mathematics known as category theory. From the perspective of a SCL programmer, however, it is best to think of a monad as an abstract datatype of actions. SCL's `mdo expressions provide a convenient syntax for writing monadic expressions. Instances of `Monad` should satisfy the following laws: return a >>= k == k a m >>= return == m m >>= (\x -> k x >>= h) == (m >>= k) >>= h fmap f xs == xs >>= return . f """ class (Functor m) => Monad m where "Inject a value into the monadic type." return :: a -> m a "Sequentially compose two actions, passing any value produced by the first as an argument to the second." (>>=) :: m a -> (a -> m b) -> m b """ The join function is the conventional monad join operator. It removes one level of monadic structure. For lists, `join` concatenates a list of lists: join [[1,2], [3,4]] = [1, 2, 3, 4] """ join :: m (m a) -> m a join m = m >>= id """ Sequentially compose two actions, discarding any value produced by the first, like sequencing operators (such as the semicolon) in imperative languages." """ @macro (>>) :: Monad m => m a -> m b -> m b a >> b = a >>= (\_ -> b) "While loop. `while cond body` executes the `body` while the `cond` is true." @inline while :: ( Boolean) -> ( a) -> () while cond body = loop () where loop _ = if cond then do body ; loop () else () """ Sequences the given monadic value infinitely: repeatForever m = m >> m >> m >> ... """ repeatForever m = m >> repeatForever m replicateM :: Monad m => Integer -> m a -> m [a] replicateM count m = loop count emptyList where loop count l | count <= 0 = return l | otherwise = mdo v <- m loop (count-1) (addList l v) replicateM_ :: Monad m => Integer -> m a -> m () replicateM_ count m | count <= 0 = return () | otherwise = m >> replicateM_ (count-1) m /// MonadZero /// """ A class of monads with zero element satisfying mzero >>= f = mzero """ class (Monad m) => MonadZero m where mzero :: m a "Injects a boolean test to a type beloning to `MonadZero`." guard :: MonadZero m => Boolean -> m () guard True = return () guard False = mzero /// MonadPlus /// """ A class of monads with associative binary operator `mplus` satisfying the following laws: mplus mzero b = b mplus a mzero = a mplus (mplus a b) c = mplus a (mplus b c) mplus a b >>= k = mplus (a >>= k) (b >>= k) """ class (MonadZero m) => MonadPlus m where mplus :: m a -> m a -> m a /// MonadOr /// """ A class of monads with associative binary operator `morelse` satisfying the following laws: morelse mzero b = b morelse a mzero = a morelse (morelse a b) c = morelse a (morelse b c) morelse (return a) b = return a """ class (MonadZero m) => MonadOr m where morelse :: m a -> m a -> m a /// FunctorE /// """ A class of types that can be mapped over with effectful mapping functions. """ class (Functor f) => FunctorE f where """ Applies the function to all elements of the container and returns the similarly shaped container with the results: For lists, map f [e1, e2, ..., eN] = [f e1, f e2, ..., f eN] for example map (*2) [1..5] = [2, 4, 6, 8, 10] """ map :: (a -> b) -> f a -> (f b) "Calls the given function with all elements of the given container." iter :: (a -> b) -> f a -> () "Calls the given function with all elements of the given container giving also the index of the element as a parameter." iterI :: (Integer -> a -> b) -> f a -> () "Iterates the elements of the given collection. Same as `iter` but parameters flipped." for :: FunctorE f => f a -> (a -> b) -> () @macro for l f = iter f l "Iterates the elements of the given collection providing also the indices of the elements. Same as `iterI` but parameters flipped." forI :: FunctorE f => f a -> (Integer -> a -> b) -> () @macro forI l f = iterI f l "`forN n f` calls `f` for all integers `0`, ..., `n-1`" @inline forN :: Integer -> (Integer -> b) -> () forN n f = loop 0 where loop i = if i < n then do f i ; loop (i+1) else () @inline mapI :: (Integer -> a -> b) -> [a] -> [b] mapI f l = build (\empty cons -> let len = length l loop i accum = if i < len then loop (i+1) (cons accum (f i (l!i))) else accum in loop 0 empty) """ `mapMaybe` combines `map` and `filter` functions. It applies the given function to every element of the input list. If the result is `Just x`, then `x` is added to the resulting list. mapMaybe f lst = [y | x <- lst, Just y = f x] """ @inline mapMaybe :: (a -> Maybe b) -> [a] -> [b] mapMaybe f l = build (\empty cons -> foldl (\cur x -> match f x with Just v -> cons cur v ; _ -> cur) empty l) """ Applies the given function to all elements of the list. Produces two lists: the first contains all elements `x` for which the function returned `Left x` and the second list contains all elements `y` for which the function returned `Right y`. """ mapEither :: (a -> Either b c) -> [a] -> ([b], [c]) mapEither f list = runProc do l = newArrayList r = newArrayList for list (\x -> match f x with Left v -> addArrayList l v Right v -> addArrayList r v) (Java.unsafeCoerce l, Java.unsafeCoerce r) /// FunctorM /// class (Functor f) => FunctorM f where "`mapM f` is equivalent to `sequence . map f`." 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) /// Category /// "Identity function." id :: a -> a id x = x """ Ignores the given value. This function is used in a situation where a function returns a value in a context where the value is not expected. """ @inline ignore :: a -> () ignore _ = () @inline ignoreM :: a -> Maybe b ignoreM _ = Nothing """ Composes two functions (f . g) x = f (g x) """ (.) :: (b -> c) -> (a -> b) -> (a -> c) (f . g) x = f (g x) /// Sequence /// "A type class for sequences. All sequences must support indexing by integers." class /*(Additive a) =>*/ Sequence a where "Length of the sequence" length :: a -> Integer "`take n s` returns the first `n` elements of the sequence `s`." take :: Integer -> a -> a "`drop n s` removes the first `n` elements of the sequence `s`." drop :: Integer -> a -> a """ `sub s begin end` returns a subsequence of `s` starting from index `begin` and ending just before index `end`. """ sub :: a -> Integer -> Integer -> a take n v = sub v 0 (min n (length v)) drop n v = sub v (min n len) len where len = length v instance Sequence [a] where length = lengthList sub = subList instance Sequence String where length = lengthString sub = subString class IndexedSequence f where "`seq ! i` returns the `i`th element of the sequence `seq`. Indexing starts from zero." (!) :: f a -> Integer -> a instance IndexedSequence [] where (!) = getList /// Boolean /// """ Equivalent to the boolean value `True`. The value is meant to be used in guard patterns: min a b | a < b = a | otherwise = b """ @inline otherwise :: Boolean otherwise = True instance Ord Boolean where compare False False = 0 compare False True = neg 1 compare True False = 1 compare True True = 0 instance Show Boolean where show True = "True" show False = "False" """ Boolean conjunction (and). The function is a macro that evaluates the second parameter only if the first parameter is `True`.
aba && b
TrueTrueTrue
TrueFalseFalse
Falsenot evaluatedFalse
""" @macro (&&) :: Boolean -> Boolean -> Boolean a && b = if a then b else False """ Boolean disjunction (or). The function is a macro that evaluates the second parameter only if the first parameter is `False`.
aba || b
Truenot evaluatedTrue
FalseTrueTrue
FalseFalseFalse
""" @macro (||) :: Boolean -> Boolean -> Boolean a || b = if a then True else b "Boolean negation" @inline not a = if a then False else True /// Maybe /// //data Maybe a = Nothing | Just a "Given `Just x` this function returns `x`. If the parameter is `Nothing`, the function raises an exception." fromJust :: Maybe a -> a fromJust (Just a) = a deriving instance (Ord a) => Ord (Maybe a) deriving instance (Show a) => Show (Maybe a) instance Functor Maybe where fmap _ Nothing = Nothing fmap f (Just x) = Just (f x) instance FunctorE Maybe where map _ Nothing = Nothing map f (Just x) = Just (f x) iter _ Nothing = () iter f (Just x) = ignore (f x) iterI _ Nothing = () iterI f (Just x) = ignore (f 0 x) instance Monad Maybe where return x = Just x @inline Nothing >>= _ = Nothing Just x >>= f = f x @inline join Nothing = Nothing join (Just x) = x instance MonadZero Maybe where mzero = Nothing instance MonadOr Maybe where morelse a@(Just _) _ = a morelse _ b = b "`execJust v f` executes the function `f` with parameter value `x`, if `v=Just x`. If `v=Nothing`, the function does nothing." @inline execJust :: Maybe a -> (a -> b) -> () execJust maybeValue procedure = match maybeValue with Just v -> ignore $ procedure v _ -> () "`fromMaybe def v` returns `def` if `v=Nothing` and `x` if `v=Just x`." @inline fromMaybe :: a -> Maybe a -> a fromMaybe default maybeValue = match maybeValue with Just v -> v _ -> default """ Provides a default value if the first parameter is Nothing. The default value is evaluated only if needed. The function can be used as an operator and is right associative so that the following is possible: tryWithTheFirstMethod `orElse` tryWithTheSecondMethod `orElse` fail "Didn't succeed." """ @inline orElse :: Maybe a -> ( a) -> a orElse (Just x) _ = x orElse Nothing def = def /// Either /// """ The Either type represents values with two possibilities: a value of type `Either a b` is either `Left a` or `Right b`. 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 deriving instance (Ord a, Ord b) => Ord (Either a b) deriving instance (Show a, Show b) => Show (Either a b) instance Functor (Either a) where fmap _ (Left x) = Left x fmap f (Right y) = Right (f y) instance FunctorE (Either a) where map _ (Left x) = Left x map f (Right y) = Right (f y) iter _ (Left x) = () iter f (Right y) = ignore (f y) iterI _ (Left x) = () iterI f (Right y) = ignore (f 0 y) instance Monad (Either b) where return y = Right y Left x >>= _ = Left x Right y >>= f = f y join (Left x) = Left x join (Right y) = y /// String /// importJava "java.lang.String" where @private @JavaName "concat" concatString :: String -> String -> String @private @JavaName "compareTo" compareString :: String -> String -> Integer @private @JavaName "length" lengthString :: String -> Integer """ `replaceString original pattern replacement` replaces all occurrences of `pattern` in the string by `replacement`. """ @JavaName replace replaceString :: String -> String -> String -> String @private @JavaName split splitString_ :: String -> String -> Array String """ `indexOf string s` finds the first occurrence of `s` from `string` and returns its index. If the `s` does not occur in the string, return `-1`." """ @JavaName indexOf indexOf :: String -> String -> Integer "Works like `indexOf` but starts searching from the given index instead of the beginning of the string." @JavaName indexOf indexOfStartingFrom :: String -> String -> Integer -> Integer "Works like `indexOf` but returns the index of the last occurrence." @JavaName lastIndexOf lastIndexOf :: String -> String -> Integer "Works like `lastIndexOf` but starts searching from the given index instead of the end of the string." @JavaName lastIndexOf lastIndexOfStartingFrom :: String -> String -> Integer -> Integer @private @JavaName substring subString :: String -> Integer -> Integer -> String """ `regionMatches str1 offset1 str2 offset2 len` tests whether `sub str1 offset1 (offset1+len) == sub str2 offset2 (offset2+len)`. """ regionMatches :: String -> Integer -> String -> Integer -> Integer -> Boolean "`startsWith string prefix` returns true if the string begins with the given prefix." startsWith :: String -> String -> Boolean "`endsWith string suffix` returns true if the string ends with the given prefix." endsWith :: String -> String -> Boolean "Removes leading and trailing whitespace from the string." trim :: String -> String "`contains string s` returns true if `string` contains `s` as a substring." contains :: String -> String -> Boolean "`charAt string i` returns the `i`th character of the string." charAt :: String -> Integer -> Character "Converts all letters of the string to lower case." toLowerCase :: String -> String "Converts all letters of the string to upper case." toUpperCase :: String -> String "Creates a string from a vector of characters." @JavaName "" string :: Vector Character -> String instance Ord String where compare = compareString instance Additive String where zero = "" (+) = concatString sum ss = runProc (StringBuilder.toString $ foldl StringBuilder.appendString StringBuilder.new ss) @private importJava "org.simantics.scl.runtime.string.StringEscape" where appendEscapedString :: StringBuilder.T -> String -> StringBuilder.T instance Show String where showForPrinting = id sb <+ v = (appendEscapedString (sb << "\"") v) << "\"" instance Read String where read str = str "`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 :: String -> String -> [String] split pattern text = arrayToList $ splitString_ text pattern /// Tuple0 /// instance Ord () where compare () () = 0 instance Additive () where zero = () () + () = () instance Show () where show () = "()" /// Tuple2 /// "Gives the first element of a pair." @inline fst :: (a,b) -> a fst (x,y) = x "Gives the second element of a pair." @inline snd :: (a,b) -> b snd (x,y) = y instance (Ord a, Ord b) => Ord (a, b) where compare (a0, b0) (a1, b1) = compare a0 a1 &<& compare b0 b1 instance (Additive a, Additive b) => Additive (a, b) where zero = (zero, zero) (a0, b0) + (a1, b1) = (a0+a1, b0+b1) instance Functor ((,) a) where fmap f (a,b) = (a, f b) instance (Show a, Show b) => Show (a, b) where sb <+ (x, y) = sb << "(" <+ x << ", " <+ y << ")" /// Tuple3 /// 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 (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) instance Functor ((,,) a b) where fmap f (a,b,c) = (a, b, f c) instance (Show a, Show b, Show c) => Show (a, b, c) where sb <+ (x, y, z) = sb << "(" <+ x << ", " <+ y << ", " <+ z << ")" /// Tuple4 /// 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 (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) instance Functor ((,,,) a b c) where fmap f (a,b,c,d) = (a, b, c, f d) instance (Show a, Show b, Show c, Show d) => Show (a, b, c, d) where sb <+ (x, y, z, w) = sb << "(" <+ x << ", " <+ y << ", " <+ z << ", " <+ w << ")" /// Tuple5 /// 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 (Additive a, Additive b, Additive c, Additive d, Additive e) => Additive (a, b, c, d, e) where zero = (zero, zero, zero, zero, zero) (a0, b0, c0, d0, e0) + (a1, b1, c1, d1, e1) = (a0+a1, b0+b1, c0+c1, d0+d1, e0+e1) instance Functor ((,,,,) a b c d) where fmap f (a,b,c,d,e) = (a, b, c, d, f e) /// Lists /// instance (Ord a) => Ord [a] where compare a b = loop 0 where lA = length a lB = length b loop i = if i >= lA then (if i >= lB then 0 else -1) else if i >= lB then 1 else compare (a!i) (b!i) &<& loop (i+1) instance Functor [] where fmap = mapList instance FunctorE [] where map = mapEList iter = iterList iterI = iterIList instance Monad [] where return x = singletonList x l >>= f = concatMap f l join l = l >>= id instance MonadZero [] where mzero = emptyList instance MonadPlus [] where mplus = appendList instance Additive [a] where zero = emptyList (+) = appendList instance FunctorM [] where sequence = foldl (\m mel -> m >>= \l -> mel >>= \el -> return (addList l el)) (return emptyList) mapM f l = sequence (map f l) "Appends the string representations of all elements of the list to the string builder and separates the values with the given separator." printWithSeparator :: Show a => StringBuilder.T -> String -> [a] -> StringBuilder.T printWithSeparator sb sep l = loop 0 where len = length l loop i = if i >= len then sb else do (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." joinWithSeparator :: Show a => String -> [a] -> String joinWithSeparator separator values = runProc ( StringBuilder.toString $ printWithSeparator StringBuilder.new separator values) instance (Show a) => Show [a] where sb <+ l = do len = length l loop i = if i < len then do if (i>0) then sb << ", " else sb sb <+ l!i loop (i+1) else sb << "]" sb << "[" loop 0 importJava "java.util.List" where "`getList l i` returns the `i`th element of the list `l`. Indexing starts from zero. You can also use the `!` infix function for this purpose." @JavaName get getList :: [a] -> Integer -> a @private @JavaName size lengthList :: [a] -> Integer @private subList :: [a] -> Integer -> Integer -> [a] @private isEmpty :: [a] -> Boolean @private importJava "java.util.Collections" where emptyList :: [a] //singletonList :: a -> [a] /* @inline emptyList :: [a] emptyList = build (\empty cons -> empty) */ "Creates a list with exectly one element." @inline singletonList :: a -> [a] singletonList v = build (\empty cons -> cons empty v) /* // foldl f i (a + b) = foldl f (foldl f i a) b appendList :: [a] -> [a] -> [a] appendList a b = build (\empty cons -> foldl cons (foldl cons empty a) b) */ importJava "org.simantics.scl.runtime.list.ShareableList" where "Concatenates two lists." @private @JavaName "concat" appendList :: [a] -> [a] -> [a] "Adds the given value to the end of the list." @JavaName "add" addList :: [a] -> a -> [a] @private importJava "java.util.ArrayList" where data ArrayList a @JavaName "" newArrayList :: ArrayList a @JavaName add addArrayList :: ArrayList a -> a -> () """ A primitive for constructing a list by `empty` and `cons` operations given to the function given as a parameter to this function. For example: build (\empty cons -> cons (cons (cons empty 1) 2) 3) produces [1, 2, 3] The SCL compiler makes the following optimization when encountering `build` and `foldl` functions after inlining: foldl f i (build g) = g i f """ @inline 2 build :: forall b e2. (forall a e1. a -> (a -> b -> a) -> a) -> [b] build f = runProc do l = newArrayList f () (\_ v -> addArrayList l v) Java.unsafeCoerce l "A specific implementation of `map` for lists." @private @inline mapEList :: (a -> b) -> [a] -> [b] mapEList f l = build (\empty cons -> foldl (\cur x -> cons cur (f x)) empty l) "A specific implementation of `fmap` for lists." @inline mapList :: (a -> b) -> [a] -> [b] mapList f l = build (\empty cons -> foldl (\cur x -> cons cur (f x)) empty l) "`guardList v` returns a singleton `[()]` if `v=True` and the empty list if `v=False`." @inline guardList :: Boolean -> [()] guardList cond = build (\empty cons -> if cond then cons empty () else empty) """ `concatMap` combines `map` and `join` functions. It maps the elements of a given list to lists with the given function and concatenates the results. concatMap f lst = join (map f lst) = [y | x <- lst, y <- f x] """ @inline concatMap :: (a -> [b]) -> [a] -> [b] concatMap f l = build (\empty cons -> foldl (\cur le -> foldl cons cur (f le)) empty l) """ Applies the given function to the elements of the lists until the function returns something else than `Nothing`. This return value is also returned as a result of this function. """ @inline mapFirst :: (a -> Maybe b) -> [a] -> Maybe b mapFirst f l = loop 0 where len = length l loop i = if i == len then Nothing else match f (l!i) with r @ (Just _) -> r Nothing -> loop (i+1) """ foldl op initialValue list applies a binary operator `op` to all elements of `list` from left to right starting with `initialValue`. For example, foldl op init [x1, x2, x3, x4] = (((init `op` x1) `op` x2) `op` x3) `op` x4 """ @inline 2 foldl :: forall a b e. (a -> b -> a) -> a -> [b] -> a foldl f initial l = loop initial 0 where len = length l loop cur i = if i==len then cur else loop (f cur (l!i)) (i+1) foldlI :: forall a b e. (Integer -> a -> b -> a) -> a -> [b] -> a foldlI f initial l = loop initial 0 where len = length l loop cur i = if i==len then cur else loop (f i cur (l!i)) (i+1) scanl :: (b -> a -> b) -> b -> [a] -> [b] scanl f initial l = build (\empty cons -> let len = length l loop cur i accum = let nl = cons accum cur in if i==len then nl else loop (f cur (l!i)) (i+1) nl in loop initial 0 empty) "`foldr` is defined like `foldl` but it process the list from right to left." @inline foldr :: (b -> a -> a) -> a -> [b] -> a foldr f initial l = loop initial (length l - 1) where loop cur i = if i < 0 then cur else loop (f (l!i) cur) (i-1) foldr1 :: (a -> a -> a) -> [a] -> a foldr1 f l = loop (l!(len-1)) (len-2) where len = length l loop cur i = if i < 0 then cur else loop (f (l!i) cur) (i-1) """ `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) """ Takes those elements of the input list that match `(Just x)` and adds the contents to the resulting list. For example, filterJust [Just 1, Nothing, Just 5] = [1, 5] """ @inline filterJust :: [Maybe a] -> [a] filterJust l = build (\empty cons -> foldl (\cur x -> match x with Just v -> cons cur v ; _ -> cur) empty l) listToMaybe :: [a] -> Maybe a listToMaybe l = if isEmpty l then Nothing else Just (l!0) 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 res2 = newArrayList for l (\el -> if p el then addArrayList res1 el else addArrayList res2 el ) (Java.unsafeCoerce res1, Java.unsafeCoerce res2) """ `range begin end` produces a list of consecutive integers starting from `begin` and ending to `end` (including `end`). The compiler supports syntactic sugar `[begin..end]` for this function. """ @inline range :: Integer -> Integer -> [Integer] range first last = build (\empty cons -> do loop i cur = if i > last then cur else loop (i+1) (cons cur i) loop first empty) "A specific implementation of `iter` for lists." @inline iterList :: (a -> b) -> [a] -> () iterList f l = foldl (\_ x -> ignore (f x)) () l "A specific implementation of `iterI` for lists." @inline iterIList :: (Integer -> a -> b) -> [a] -> () iterIList f l = do foldl (\i x -> do f i x ; i+1) 0 l ; () """ Generates a list from a given starting state and iteration function. For example let nextState 0 = Nothing nextState i = Just (i, i `div` 2) in unfoldr nextState 30 produces [30, 15, 7, 3, 1] """ @inline unfoldr :: (b -> Maybe (a, b)) -> b -> [a] unfoldr f s = build (\empty cons -> do loop s cur = match f s with Just (el,newS) -> loop newS (cons cur el) _ -> cur loop s empty) importJava "org.simantics.scl.runtime.Lists" where /* @private @JavaName map mapList :: (a -> b) -> [a] -> [b] @private @JavaName map mapEList :: (a -> b) -> [a] -> [b] @private @JavaName iter iterList :: (a -> ()) -> [a] -> () concatMap :: (a -> [b]) -> [a] -> [b] */ """ Combines two lists into one list of pairs. The length of the resulting list is the length of the smallest input list. zip [1, 2, 3, 4, 5] ['a', 'b', 'c'] = [(1, 'a'), (2, 'b'), (3, 'c')] """ zip :: [a] -> [b] -> [(a,b)] "Combines two lists by using the given function for combining the elements. The length of the resulting list is the length of the smallest input list." zipWith :: (a -> b -> c) -> [a] -> [b] -> [c] """ Produces two lists from one list of pairs. unzip [(1, 'a'), (2, 'b'), (3, 'c')] = ([1, 2, 3], ['a', 'b', 'c']) """ unzip :: [(a,b)] -> ([a],[b]) //"@filter p l@ returns those elements of @l@ that the predicate @p@ accepts." //filter :: (a -> Boolean) -> [a] -> [a] //filterJust :: [Maybe a] -> [a] /* foldl :: (a -> b -> a) -> a -> [b] -> a */ "Like `foldl` but assumes that the list is non-empty so the initial is not needed." foldl1 :: (a -> a -> a) -> [a] -> a //unfoldr :: (b -> Maybe (a, b)) -> b -> [a] "Sorts the list using the given comparator." sortWith :: (a -> a -> Integer) -> [a] -> [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 groupWith :: (b -> Integer) -> (b -> b -> Boolean) -> (a -> b) -> (a -> c) -> [a] -> [(b, [c])] "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] //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 :: a -> [a] -> Boolean elem el l = loop 0 where len = length l loop i | i < len = if el == l!i then True else loop (i+1) | otherwise = False "`elemMaybe v1 (Just v2)` returns true if `v1 == v2`. `elemMaybe v1 Nothing` is always false." elemMaybe :: a -> Maybe a -> Boolean elemMaybe el m = match m with Just el2 -> el == el2 Nothing -> False """ Computes a list that contains only elements that belongs to both input lists. """ intersect :: [a] -> [a] -> [a] intersect a b = filter f a where f e = elem e b "Reverses a given list. For example, `reverse [1,2,3] = [3,2,1]`" reverse :: [a] -> [a] reverse l = [l!(len-i) | i <- [1..len]] where len = length l """ 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 xss = [[xs!i | xs <- xss, i < length xs] | i <- [0..maximum [length xs | xs <- xss]-1]] "Works like `unfoldr` but generates the list from right to left." unfoldl :: (b -> Maybe (a, b)) -> b -> [a] unfoldl f seed = reverse $ unfoldr f seed "Removes the first element of the list, if the list is non-empty." tail :: [a] -> [a] tail l = if len < 2 then emptyList else subList l 1 len where len = length l "Tries to find the given key from the list of key-value pairs and returns the corresponding value." lookup :: a -> [(a, b)] -> Maybe b lookup el l = do len = length l loop i = if i < len then match l!i with (a,b) | a == el -> Just b | otherwise -> loop (i+1) else Nothing loop 0 "Conjunction over a list." @inline and :: [Boolean] -> Boolean and = foldl (&&) True "Disjunction over a list." @inline or :: [Boolean] -> Boolean or = foldl (||) False """ `any pred lst` tests whether the predicate `pred` holds some element of `lst`. It returns immediately when it encounters the first value satisfying the predicate. """ any :: (a -> Boolean) -> [a] -> Boolean any p = or . map p """ `all pred lst` tests whether the predicate `pred` holds for all elements of `lst`. It returns immediately when it encounters the first value not satisfying the predicate. """ all :: (a -> Boolean) -> [a] -> Boolean all p = and . map p """ Returns the first element of the list satisfying the given condition, or `Nothing` if there is no such element. """ findFirst :: (a -> Boolean) -> [a] -> Maybe a findFirst p l = loop 0 where len = length l loop i = if i < len then let el = l!i in if p el then Just el else loop (i+1) else Nothing loop 0 """ Sorts the given list using its default order. """ @inline sort :: Ord a => [a] -> [a] sort = sortWith compare """ Sorts the lists by the values computed by the first function. For example sortBy snd [(1,5), (2,3), (3,4)] = [(2,3), (3,4), (1,5)] """ @inline sortBy :: Ord b => (a -> b) -> [a] -> [a] 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 (==) /// Dynamic /// importJava "java.lang.Object" where "A data type that can represent any value." data Dynamic @private @JavaName toString showDynamic :: Dynamic -> String instance Show Dynamic where show = showDynamic "Converts a value to `Dynamic` type." toDynamic :: a -> Dynamic toDynamic = Java.unsafeCoerce "Converts a `Dynamic` value to a required value, or fails if the conversion is not possible." importJava "org.simantics.scl.compiler.runtime.ValueConversion" where fromDynamic :: Typeable a => Dynamic -> a /// Procedures /// importJava "org.simantics.scl.runtime.procedure.Ref" where "A mutable reference to a value of type `a`." data Ref a "Creates a new reference with the given initial value." @JavaName "" ref :: a -> (Ref a) "Returns the current value of the reference." @JavaName "value" getRef :: Ref a -> a "Sets a new value for the reference." @JavaName "value" (:=) :: Ref a -> a -> () instance Show (Ref a) where show _ = "" importJava "org.simantics.scl.runtime.reporting.SCLReporting" where "Prints the given string to the console." @JavaName "print" printString :: String -> () "Prints an error message to the console." printError :: String -> () "Reports that certain amount of work has been done for the current task." didWork :: Double -> () """ `printingToFile "fileName" expression` executes the `expression` so that all its console prints are written to the file given as a first parameter. """ printingToFile :: String -> ( a) -> a """ `printErrorsAsNormalPrints expression` executes the `expression` so that all its error prints are printed as normal prints. This is useful mainly in testing scripts for checking that the implementations give proper error messages with invalid inputs. """ printErrorsAsNormalPrints :: ( a) -> a """ `disablePrintingForCommand expression` executes the `expression` so that it does not print return values. Errors are printed normally. """ disablePrintingForCommand :: ( a) -> a importJava "org.simantics.scl.runtime.procedure.Procedures" where "Returns `True` if the current thread has been interrupted." isInterrupted :: Boolean "Checks whether the current thread has been interrupted and throws an exception if it is." checkInterrupted :: () "Generates a random identifier." generateUID :: String "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 importJava "java.lang.Throwable" where data Throwable @private @JavaName toString showThrowable :: Throwable -> String importJava "java.lang.Exception" where data Exception @private @JavaName toString showException :: Exception -> String instance Show Throwable where show = showThrowable instance Show Exception where show = showException "Prints the given value in the console." @inline print :: Show a => a -> () print v = printString (showForPrinting v) /* instance Show TypeRep where sb <+ (TApply (TCon "Builtin" "[]") b) = sb << "[" <+ b << "]" sb <+ (TApply (TApply (TCon "Builtin" "(,)") c1) c2) = sb << "(" <+ c1 << "," <+ c2 << ")" sb <+ (TApply (TApply (TApply (TCon "Builtin" "(,,)") c1) c2) c3) = sb << "(" <+ c1 << "," <+ c2 << "," <+ c3 << ")" sb <+ (TApply (TApply (TApply (TApply (TCon "Builtin" "(,,,)") c1) c2) c3) c4) = sb << "(" <+ c1 << "," <+ c2 << "," <+ c3 << "," <+ c4 << ")" sb <+ (TCon _ name) = sb << name sb <+ (TApply a b) = sb <+ Par 1 a << " " <+ Par 2 b sb <+ (TFun a b) = sb <+ Par 1 a << " -> " <+ b precedence (TCon _ _) = 0 precedence (TFun _ _) = 2 precedence (TApply a _) = if isSpecialType a then 0 else 1 where isSpecialType (TCon "Builtin" "[]") = True isSpecialType (TCon "Builtin" "()") = True isSpecialType (TCon "Builtin" "(,)") = True isSpecialType (TCon "Builtin" "(,,)") = True isSpecialType (TCon "Builtin" "(,,,)") = True 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 importJava "org.simantics.scl.compiler.types.Type" where @JavaName toString showType :: Type -> String importJava "org.simantics.scl.compiler.types.Types" where removeForAll :: Type -> Type instance Show Type where show = showType