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 -> <e> b) -> a -> <e> 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) -> <e> c) -> a -> b -> <e> 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 -> <e> c) -> ((a, b) -> <e> 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) -> <e> d) -> a -> b -> c -> <e> 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 -> <e> d) -> ((a, b, c) -> <e> d)
uncurry3 f (x, y, z) = f x y z

"Flips the parameters of a binary function."
@inline
flip :: (a -> b -> <e> c) -> b -> a -> <e> 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 -> (<e> Integer) -> <e> 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 -> <e> b) -> [a] -> <e> 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 -> <e> b) -> [a] -> <e> 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 -> <e> b) where
    zero x = zero
    (f + g) x = f x + g x

instance (Ring b) => Ring (a -> <e> 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 -> <e> b) where
//    show f = "<function>"

"Appends a string to the string builder."
(<<) :: StringBuilder.T -> String -> <Proc> 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 -> <Proc> 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 :: (<e> Boolean) -> (<e> a) -> <e> ()
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 -> <e> b) -> f a -> <e> (f b)
    "Calls the given function with all elements of the given container."
    iter :: (a -> <e> b) -> f a -> <e> ()
    "Calls the given function with all elements of the given container giving also the index of the element as a parameter."
    iterI :: (Integer -> a -> <e> b) -> f a -> <e> ()

"Iterates the elements of the given collection. Same as `iter` but parameters flipped." 
for :: FunctorE f => f a -> (a -> <e> b) -> <e> ()
@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 -> <e> b) -> <e> ()
@macro
forI l f = iterI f l

"`forN n f` calls `f` for all integers `0`, ..., `n-1`"
@inline
forN :: Integer -> (Integer -> <e> b) -> <e> ()
forN n f = loop 0
  where
    loop i = if i < n
             then do f i ; loop (i+1)
             else ()

@inline
mapI :: (Integer -> a -> <e> b) -> [a] -> <e> [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 -> <e> Maybe b) -> [a] -> <e> [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 -> <e> Either b c) -> [a] -> <e> ([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 -> <e> c) -> (a -> <e> b) -> (a -> <e> 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`.

<table>
<tr><th>a</th><th>b</th><th>a && b</th></tr>
<tr><td>True</td><td>True</td><td>True</td></tr>
<tr><td>True</td><td>False</td><td>False</td></tr>
<tr><td>False</td><td>not evaluated</td><td>False</td></tr>
</table> 
"""
@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`.

<table>
<tr><th>a</th><th>b</th><th>a || b</th></tr>
<tr><td>True</td><td>not evaluated</td><td>True</td></tr>
<tr><td>False</td><td>True</td><td>True</td></tr>
<tr><td>False</td><td>False</td><td>False</td></tr>
</table> 
"""
@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 -> <e> b) -> <e> ()
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 -> (<e> a) -> <e> 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 "<init>"
    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 -> <Proc> 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] -> <Proc> 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 "<init>"
    newArrayList :: <Proc> ArrayList a
    
    @JavaName add
    addArrayList :: ArrayList a -> a -> <Proc> ()

"""
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 -> <e1> a) -> <e1,e2> a) -> <e2> [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 -> <e> b) -> [a] -> <e> [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 -> <e> [b]) -> [a] -> <e> [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 -> <e> Maybe b) -> [a] -> <e> 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 -> <e> a) -> a -> [b] -> <e> 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 -> <e> a) -> a -> [b] -> <e> 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 -> <e> b) -> b -> [a] -> <e> [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 -> <e> a) -> a -> [b] -> <e> 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 -> <e> a) -> [a] -> <e> 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 -> <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)

"""
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 -> <e> Boolean) -> [a] -> <e> [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 -> <e> Boolean) -> [a] -> <e> ([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 -> <e> b) -> [a] -> <e> ()
iterList f l = foldl (\_ x -> ignore (f x)) () l

"A specific implementation of `iterI` for lists."
@inline
iterIList :: (Integer -> a -> <e> b) -> [a] -> <e> ()
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 -> <e> Maybe (a, b)) -> b -> <e> [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 -> <e> b) -> [a] -> <e> [b]
    @private
    @JavaName iter
    iterList :: (a -> <e> ()) -> [a] -> <e> ()
    concatMap :: (a -> <e> [b]) -> [a] -> <e> [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 -> <e> c) -> [a] -> [b] -> <e> [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 -> <e> Boolean) -> [a] -> <e> [a]
    //filterJust :: [Maybe a] -> [a]
    /*
    foldl :: (a -> b -> <e> a) -> a -> [b] -> <e> a
    */
    "Like `foldl` but assumes that the list is non-empty so the initial is not needed."
    foldl1 :: (a -> a -> <e> a) -> [a] -> <e> a
    //unfoldr :: (b -> <e> Maybe (a, b)) -> b -> <e> [a]
    
    "Sorts the list using the given comparator."
    sortWith :: (a -> a -> <e> Integer) -> [a] -> <e> [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 -> <e> b) -> (a -> <e> c) -> [a] -> <e> [(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 -> <e> a) -> <e> a) -> <e> [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 -> <e> Maybe (a, b)) -> b -> <e> [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 -> <e> Boolean) -> [a] -> <e> 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 -> <e> Boolean) -> [a] -> <e> 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 -> <e> Boolean) -> [a] -> <e> 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 -> <e> b) -> [a] -> <e> [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 -> <e> b) -> [a] -> <e> [(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 "<init>"
    ref :: a -> <Proc> (Ref a)
    
    "Returns the current value of the reference."
    @JavaName "value"
    getRef :: Ref a -> <Proc> a
    
    "Sets a new value for the reference."
    @JavaName "<set>value"
    (:=) :: Ref a -> a -> <Proc> ()

instance Show (Ref a) where
    show _ = "<reference>"

importJava "org.simantics.scl.runtime.reporting.SCLReporting" where
    "Prints the given string to the console."
    @JavaName "print"
    printString :: String -> <Proc> ()
    "Prints an error message to the console."
    printError :: String -> <Proc> ()
    "Reports that certain amount of work has been done for the current task."
    didWork :: Double -> <Proc> ()
    """
    `printingToFile "fileName" expression` executes the `expression` so that all its console prints
    are written to the file given as a first parameter.
    """
    printingToFile :: String -> (<e> a) -> <e> 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 :: (<e> a) -> <e> a
    """
    `disablePrintingForCommand expression` executes the `expression` so that it does not print return values.
    Errors are printed normally.
    """
    disablePrintingForCommand :: (<e> a) -> <e> a
    

importJava "org.simantics.scl.runtime.procedure.Procedures" where
    "Returns `True` if the current thread has been interrupted."
    isInterrupted :: <Proc> Boolean
    "Checks whether the current thread has been interrupted and throws an exception if it is."
    checkInterrupted :: <Proc> ()
    "Generates a random identifier."
    generateUID :: <Proc> 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 => (<e> a) -> (ex -> <e> a) -> <e> 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 -> <Proc> ()
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