bundles/org.simantics.scl.runtime/scl/Prelude.scl

   1 import "JavaBuiltin" as Java
   2 import "StringBuilder" as StringBuilder
   3
   4 /** The following types and names are builtin *************
   5 data Boolean = True | False
   6 data Byte
   7 data Character
   8 data Short
   9 data Integer
  10 data Long
  11 data Float
  12 data Double
  13 data BooleanArray
  14 data ByteArray
  15 data CharacterArray
  16 data ShortArray
  17 data IntegerArray
  18 data LongArray
  19 data FloatArray
  20 data DoubleArray
  21 data Array a
  22 data String
  23 data a -> b
  24 data [a] = [] | [a] | [a,a] | [a,a,a] | ...
  25 data () = ()
  26 data (a,b) = (a,b)
  27 data (a,b,c) = (a,b,c)
  28 data Maybe a = Nothing | Just a
  29
  30 fail :: String -> a
  31
  32 data TypeRep = TCon String | TApply TypeRep TypeRep
  33 class Typeable a
  34 typeOf :: Typeable a => a -> Type
  35
  36 data Binding a
  37 class Serializable a
  38 binding :: Serializable a => Binding a
  39 ***********************************************************/
  40
  41 importJava "java.util.Arrays" where
  42     @private
  43     @JavaName equals
  44     equalsDoubleArray :: DoubleArray -> DoubleArray -> Boolean
  45
  46     @private
  47     @JavaName toString
  48     showDoubleArray :: DoubleArray -> String
  49
  50     "Converts an array to a list."
  51     @JavaName asList
  52     arrayToList :: Array a -> [a]
  53
  54 importJava "java.util.List" where
  55     "Converts a list to an array."
  56     @JavaName toArray
  57     listToArray :: [a] -> Array a
  58
  59 instance Eq DoubleArray where
  60     (==) = equalsDoubleArray
  61 instance Show DoubleArray where
  62     show = showDoubleArray
  63
  64 importJava "org.simantics.scl.runtime.Coercion" where
  65     "Converts a list of doubles to a double array."
  66     toDoubleArray :: [Double] -> DoubleArray
  67     "Converts a double array to a list of doubles."
  68     fromDoubleArray :: DoubleArray -> [Double]
  69
  70 /*
  71  * Precedences and associativity of all operators defined in Prelude
  72  */
  73
  74 infixr 10 (!)
  75 infixr 9  (.)
  76 infixr 8  (^)
  77 infixl 7  (*), (/), div, mod
  78 infixl 6  (+), (-)
  79 infixl 5  (\\), (<<), (<+)
  80 infix  4  (==), (!=), (<), (<=), (>=), (>)
  81 infixr 3  (&&), (&<&)
  82 infixr 2  (||), orElse, morelse
  83 infixr 1  (>>=), (>>), (:=)
  84 infixr 1  ($)
  85 infixl 1  catch
  86
  87 "Creates a constant function. `const x` defines a function that always returns `x`."
  88 @inline
  89 const :: a -> b -> a
  90 const c x = c
  91
  92 """
  93 Function application. `f $ x` is equivalent with `f x`. The function has two uses.
  94 First is to remove parentheses from deeply nested expressions:
  95
  96     f (g (h x))  ==  f $ g $ h x
  97
  98 The second use is with higher order functions:
  99
 100     map ($ parameter) functions
 101 """
 102 @macro
 103 @inline
 104 ($) :: (a -> <e> b) -> a -> <e> b
 105 f $ x = f x
 106
 107 "Transforms a function taking a pair as a parameter to a function taking two values as a parameter."
 108 @inline
 109 curry :: ((a, b) -> <e> c) -> a -> b -> <e> c
 110 curry f x y =  f (x, y)
 111
 112 "Transforms a function two values as a parameter to a function taking a pair as a parameter."
 113 @inline
 114 uncurry :: (a -> b -> <e> c) -> ((a, b) -> <e> c)
 115 uncurry f (x, y) = f x y
 116
 117 "Transforms a function taking a triple as a parameter to a function taking three values as a parameter."
 118 @inline
 119 curry3 :: ((a, b, c) -> <e> d) -> a -> b -> c -> <e> d
 120 curry3 f x y z =  f (x, y, z)
 121
 122 "Transforms a function three values as a parameter to a function taking a priple as a parameter."
 123 @inline
 124 uncurry3 :: (a -> b -> c -> <e> d) -> ((a, b, c) -> <e> d)
 125 uncurry3 f (x, y, z) = f x y z
 126
 127 "Flips the parameters of a binary function."
 128 @inline
 129 flip :: (a -> b -> <e> c) -> b -> a -> <e> c
 130 flip f x y =  f y x
 131
 132 swap :: (a,b) -> (b,a)
 133 swap (x,y) = (y,x)
 134
 135 /// Comparison ///
 136
 137 """
 138 The class of types whose elements can be compared for equality.
 139 Method `(==)` must be implemented in instances.
 140 """
 141 class Eq a where
 142     "Equality"
 143     (==) :: a -> a -> Boolean
 144     "Inequality: `a != b = not (a == b)`"
 145     (!=) :: a -> a -> Boolean
 146
 147     a != b = not (a == b)
 148
 149 """
 150 The class of linearly ordered types.
 151 Method `compare` must be implemented in instances.
 152 """
 153 class (Eq a) => Ord a where
 154     """
 155     `compare x y` returns a negative number, if `x` is smaller than `y`,
 156     a positive number, if `x` is bigger than `y` and zero if they are equal.
 157     """
 158     compare :: a -> a -> Integer
 159     compare a b = if a < b then -1 else if a > b then 1 else 0
 160
 161     "Less"
 162     (<) :: a -> a -> Boolean
 163     a < b = compare a b < 0
 164     "Less or equal"
 165     (<=) :: a -> a -> Boolean
 166     a <= b = compare a b <= 0
 167     "Greater"
 168     (>) :: a -> a -> Boolean
 169     a > b = compare a b > 0
 170     "Greater or equal"
 171     (>=) :: a -> a -> Boolean
 172     a >= b = compare a b >= 0
 173
 174     "Minimum of the parameters"
 175     min :: a -> a -> a
 176     min a b = if a < b then a else b
 177     "Maximum of the parameters"
 178     max :: a -> a -> a
 179     max a b = if a > b then a else b
 180
 181 """
 182 Combines two integers such that if the first one is non-zero, it is returned, otherwise
 183 the second-one. The second parameter is not implemented, if it is not needed.
 184
 185 The function is useful for implementing efficient recursive comparison of structures,
 186 for example:
 187
 188     compare (x1,y1,z1) (x2,y2,z2) = compare x1 x2 &<& compare y1 y2 &<& compare z1 z2
 189 """
 190 @inline
 191 (&<&) :: Integer -> (<e> Integer) -> <e> Integer
 192 a &<& b = if a == 0 then b else a
 193
 194 "Maximum over a list"
 195 @inline
 196 maximum :: Ord a => [a] -> a
 197 maximum = foldl1 max
 198
 199 "Minimum over a list"
 200 @inline
 201 minimum :: Ord a => [a] -> a
 202 minimum = foldl1 min
 203
 204 "As `maximum` but compares the elements by the given projection."
 205 maximumBy :: Ord b => (a -> <e> b) -> [a] -> <e> a
 206 maximumBy f l = snd $ foldl1 maxF $ map (\x -> (f x, x)) l
 207   where
 208     maxF a b = if fst a >= fst b then a else b
 209
 210 """
 211 As `minimum` but compares the elements by the given projection.
 212 For example
 213
 214     minimumBy snd l
 215
 216 returns a pair with the smallest second component.
 217 """
 218 minimumBy :: Ord b => (a -> <e> b) -> [a] -> <e> a
 219 minimumBy f l = snd $ foldl1 minF $ map (\x -> (f x, x)) l
 220   where
 221     minF a b = if fst a <= fst b then a else b
 222
 223 """
 224 The class of types with method to compute hash codes.
 225 """
 226 class (Eq a) => Hashable a where
 227     "`hashP v seed` computes the hash code of `v` using `seed` as a seed."
 228     hashP :: a -> Integer -> Integer
 229
 230 "`hash v` computes the hash code of `v`"
 231 hash :: Hashable a => a -> Integer
 232 hash a = hashP a 1166136261
 233
 234 /// Functions ///
 235 /*
 236 instance Functor ((->) a) where
 237     map f g x = f (g x)
 238
 239 instance Monad ((->) a) where
 240     return v x = v
 241     (m >>= f) x = f (m x) x
 242     join f x = f x x
 243
 244 instance Category (->) where
 245     id x = x
 246     @inline
 247     (f . g) x = f (g x)
 248 */
 249 instance (Additive b) => Additive (a -> <e> b) where
 250     zero x = zero
 251     (f + g) x = f x + g x
 252
 253 instance (Ring b) => Ring (a -> <e> b) where
 254     one x = one
 255     (neg f) x = neg (f x)
 256     (f - g) x = f x - g x
 257     (f * g) x = f x * g x
 258     (fromInteger c) x = fromInteger c
 259
 260 //instance Show (a -> <e> b) where
 261 //    show f = "<function>"
 262
 263 "Appends a string to the string builder."
 264 (<<) :: StringBuilder.T -> String -> <Proc> StringBuilder.T
 265 (<<) =  StringBuilder.appendString
 266
 267 """
 268 The class of types whose elements can be converted to a string representation.
 269 Method `show` or `(<+)` must be implemented.
 270 """
 271 class Show a where
 272     "Converts a value to string."
 273     show :: a -> String
 274     "Appends the string representation of the value to the string builder."
 275     (<+) :: StringBuilder.T -> a -> <Proc> StringBuilder.T
 276     """
 277     Returns the precedence of the value. It is used to determine if parenteheses
 278     are needed around the string representation of the value. The default value is 0
 279     and means that parentheses are never added.
 280     """
 281     precedence :: a -> Integer
 282
 283     "Converts a value to a string like `show` but does not put string literals in double quotes."
 284     showForPrinting :: a -> String
 285
 286     show v = runProc (StringBuilder.toString (StringBuilder.new <+ v))
 287     showForPrinting v = show v
 288     sb <+ v = StringBuilder.appendString sb (show v)
 289     precedence v = 0
 290
 291 """
 292 `Par` data type is used to control the placement of parentheses when converting values to string.
 293 Value `Par prec val` is converted to string like `val` but parentheses are put around, if the
 294 precedence of the value is greater than `prec`.
 295 """
 296 data Par a = Par Integer a
 297
 298 instance (Show a) => Show (Par a) where
 299     sb <+ (Par outerPrec v) = if prec > outerPrec
 300                                  then sb << "(" <+ v << ")"
 301                                  else sb <+ v
 302                               where prec = precedence v
 303
 304 "Type class for parsing strings to values."
 305 class Read a where
 306     "Converts a string to a required type of value."
 307     read :: String -> a
 308 """
 309 The `Additive` class is used for types that are additive monoids. The operations
 310 must satisfy the following laws (at least approximately, when implemented for
 311 floating point numbers):
 312     (a + b) + c   = a + (b + c)
 313     a + 0 = 0 + a = a
 314 """
 315 class Additive a where
 316     """
 317     Neutral element of (+), i.e,
 318
 319         x + zero == x
 320         zero + x == x
 321     """
 322     zero :: a
 323     "Adds two objects (numbers, vectors, strings, etc.) together."
 324     (+)  :: a -> a -> a
 325     """
 326     Sum of the elements:
 327
 328         sum [e1,e2,...,eN] = e1 + e2 + ... + eN
 329
 330     Implemented usually more efficiently than with repetitive
 331     application of `(+)`.
 332     """
 333     sum  :: [a] -> a
 334     sum = foldl (+) zero
 335 /*
 336 class (Additive a) => AdditiveGroup a where
 337     neg :: a -> a
 338     (-) :: a -> a -> a
 339     x - y = x + (neg y)
 340 */
 341 """
 342 The `Ring` class is used for types that are algebraic rings. The operations
 343 must satisfy the following laws (at least approximately)
 344 in addition to the laws of Additive:
 345
 346     a + b         = b + a
 347     a - b         = a + (neg b)
 348     a - a         = 0
 349     (a * b) * c   = a * (b * c)
 350     a * 1 = 1 * a = a
 351     a * (b + c)   = a * b + a * c
 352     (a + b) * c   = a * c + b * c
 353 """
 354 class (Additive a) => Ring a where
 355     """
 356     Negation. Synonym for unary `-`.
 357     """
 358     neg :: a -> a
 359     "Subtraction"
 360     (-) :: a -> a -> a
 361     "Neutral element of multiplication"
 362     one :: a
 363     "Multiplication"
 364     (*) :: a -> a -> a
 365     "Converts an integer to a desired numeric type."
 366     fromInteger :: Integer -> a
 367     x - y = x + (neg y)
 368
 369
 370 """
 371 The `OrderedRing` class combines the Ring and Ord classes. It additionally
 372 supports absolute value function.
 373 """
 374 class (Ring a, Ord a) => OrderedRing a where
 375     "Absolute value."
 376     abs :: a -> a
 377     abs x = if x < zero then neg x else x
 378     "Converts the given number to `Integer`"
 379     toInteger :: a -> Integer
 380
 381 """
 382 The `Integer` class is used for types that represent either all integers or some
 383 range of them.
 384 """
 385 class (OrderedRing a) => Integral a where
 386     "Integer division truncated toward zero."
 387     div :: a -> a -> a
 388     "Integer remainder, satisfying ``(x `div` y)*y + (x `mod` y) = x``"
 389     mod :: a -> a -> a
 390
 391 """
 392 The `Real` class is used for types that represent some approximation of real numbers.
 393 """
 394 class (OrderedRing a) => Real a where
 395     "Division"
 396     (/) :: a -> a -> a
 397     "Exponentation"
 398     (^) :: a -> a -> a
 399     "Pi (3.141592654...)"
 400     pi  :: a
 401     "Square root"
 402     sqrt :: a -> a
 403     "Exponent function"
 404     exp :: a -> a
 405     "Natural logarithm"
 406     log :: a -> a
 407     "Sine"
 408     sin :: a -> a
 409     "Cosine"
 410     cos :: a -> a
 411     "Tangent"
 412     tan :: a -> a
 413     "Inverse sine"
 414     asin :: a -> a
 415     "Inverse cosine"
 416     acos :: a -> a
 417     "Inverse tangent."
 418     atan :: a -> a
 419     "Hyperbolic sine"
 420     sinh :: a -> a
 421     "Hyperbolic cosine"
 422     cosh :: a -> a
 423     "Hyperbolic tangent"
 424     tanh :: a -> a
 425     "Inverse hyberbolic sine"
 426     asinh :: a -> a
 427     "Inverse hyberbolic cosine"
 428     acosh :: a -> a
 429     "Inverse hyberbolic tangent"
 430     atanh :: a -> a
 431     "The largest integer not greater than the given number"
 432     floor :: a -> a
 433     "The smallest integer not smaller than the given number"
 434     ceil :: a -> a
 435     round :: a -> Long
 436     """
 437     Two parameter version of `atan`. Its value is determined by the following
 438     equations when (x,y) is a unit vector:
 439
 440         x = cos (atan2 y x)
 441         y = sin (atan2 y x)
 442
 443     When x > 0,
 444
 445         atan2 y x = atan (y/x)
 446     """
 447     atan2 :: a -> a -> a
 448     "Converts a `Double` value to a desired numeric type."
 449     fromDouble :: Double -> a
 450     "Converts the given number to `Double`"
 451     toDouble :: a -> Double
 452
 453     a ^ b = exp (b * log a)
 454
 455     sinh x = 0.5 * (exp x - exp (neg x))
 456     cosh x = 0.5 * (exp x + exp (neg x))
 457     tanh x = (e2x - 1) / (e2x + 1)
 458       where
 459         e2x = exp (2*x)
 460
 461     asinh x = log (x + sqrt (x*x + one))
 462     acosh x = log (x + sqrt (x*x - one))
 463     atanh x = 0.5 * log ((one+x)/(one-x))
 464
 465 /// Import mathematical functions ///
 466
 467 @private
 468 importJava "java.lang.Math" where
 469     @JavaName PI
 470     piDouble :: Double
 471
 472     @JavaName sin
 473     sinDouble :: Double -> Double
 474
 475     @JavaName cos
 476     cosDouble :: Double -> Double
 477
 478     @JavaName tan
 479     tanDouble :: Double -> Double
 480
 481     @JavaName asin
 482     asinDouble :: Double -> Double
 483
 484     @JavaName acos
 485     acosDouble :: Double -> Double
 486
 487     @JavaName atan
 488     atanDouble :: Double -> Double
 489
 490     @JavaName atan2
 491     atan2Double :: Double -> Double -> Double
 492
 493     @JavaName sinh
 494     sinhDouble :: Double -> Double
 495
 496     @JavaName cosh
 497     coshDouble :: Double -> Double
 498
 499     @JavaName tanh
 500     tanhDouble :: Double -> Double
 501
 502     @JavaName exp
 503     expDouble :: Double -> Double
 504
 505     @JavaName log
 506     logDouble :: Double -> Double
 507
 508     @JavaName pow
 509     powDouble :: Double -> Double -> Double
 510
 511     @JavaName sqrt
 512     sqrtDouble :: Double -> Double
 513
 514     @JavaName ceil
 515     ceilDouble :: Double -> Double
 516
 517     @JavaName floor
 518     floorDouble :: Double -> Double
 519
 520     @JavaName round
 521     roundDouble :: Double -> Long
 522
 523     @JavaName abs
 524     absInteger :: Integer -> Integer
 525
 526     @JavaName abs
 527     absLong :: Long -> Long
 528
 529     @JavaName abs
 530     absFloat :: Float -> Float
 531
 532     @JavaName abs
 533     absDouble :: Double -> Double
 534
 535     @JavaName min
 536     minInteger :: Integer -> Integer -> Integer
 537
 538     @JavaName min
 539     minLong :: Long -> Long -> Long
 540
 541     @JavaName min
 542     minFloat :: Float -> Float -> Float
 543
 544     @JavaName min
 545     minDouble :: Double -> Double -> Double
 546
 547     @JavaName max
 548     maxInteger :: Integer -> Integer -> Integer
 549
 550     @JavaName max
 551     maxLong :: Long -> Long -> Long
 552
 553     @JavaName max
 554     maxFloat :: Float -> Float -> Float
 555
 556     @JavaName max
 557     maxDouble :: Double -> Double -> Double
 558
 559 /// Integer ///
 560
 561 @private
 562 importJava "java.lang.Short" where
 563     @JavaName toString
 564     showShort :: Short -> String
 565
 566     @JavaName parseShort
 567     readShort :: String -> Short
 568
 569 instance Eq Short where
 570     (==) = Java.scmpeq
 571     (!=) = Java.scmpne
 572
 573 instance Ord Short where
 574     (<) = Java.scmplt
 575     (<=) = Java.scmple
 576     (>) = Java.scmpgt
 577     (>=) = Java.scmpge
 578
 579 instance Additive Short where
 580     zero = Java.sconst_0
 581     (+) = Java.sadd
 582
 583 instance Ring Short where
 584     neg = Java.sneg
 585     (-) = Java.ssub
 586     one = Java.sconst_1
 587     (*) = Java.smul
 588     fromInteger = Java.i2s
 589
 590 instance Show Short where
 591     show = showShort
 592     precedence v = if v >= 0 then 0 else 100
 593
 594 instance Read Short where
 595     read = readShort
 596
 597 /// Integer ///
 598
 599 @private
 600 importJava "java.lang.Integer" where
 601     @JavaName toString
 602     showInteger :: Integer -> String
 603
 604     @JavaName parseInt
 605     readInteger :: String -> Integer
 606
 607 instance Eq Integer where
 608     (==) = Java.icmpeq
 609     (!=) = Java.icmpne
 610
 611 instance Ord Integer where
 612     (<) = Java.icmplt
 613     (<=) = Java.icmple
 614     (>) = Java.icmpgt
 615     (>=) = Java.icmpge
 616
 617 instance Hashable Integer where
 618     hashP v x = Java.ixor v (Java.imul x 16777619) // prime for FNV-1 hash
 619
 620 instance Additive Integer where
 621     zero = Java.iconst_0
 622     (+) = Java.iadd
 623
 624 instance Ring Integer where
 625     neg = Java.ineg
 626     (-) = Java.isub
 627     one = Java.iconst_1
 628     (*) = Java.imul
 629     fromInteger x = x
 630
 631 instance OrderedRing Integer where
 632     abs = absInteger
 633     toInteger x = x
 634
 635 instance Integral Integer where
 636     div = Java.idiv
 637     mod = Java.irem
 638
 639 instance Show Integer where
 640     show = showInteger
 641     precedence v = if v >= 0 then 0 else 100
 642
 643 instance Read Integer where
 644     read = readInteger
 645
 646 /// Long ///
 647
 648 @private
 649 importJava "java.lang.Long" where
 650     @JavaName toString
 651     showLong :: Long -> String
 652
 653     @JavaName parseLong
 654     readLong :: String -> Long
 655
 656 instance Eq Long where
 657     (==) = Java.lcmpeq
 658     (!=) = Java.lcmpne
 659
 660 instance Ord Long where
 661     (<) = Java.lcmplt
 662     (<=) = Java.lcmple
 663     (>) = Java.lcmpgt
 664     (>=) = Java.lcmpge
 665
 666 instance Hashable Long where
 667     hashP v x = Java.l2i (Java.lxor v (Java.lushr v 32)) + x*16777619
 668
 669 instance Additive Long where
 670     zero = Java.lconst_0
 671     (+) = Java.ladd
 672
 673 instance Ring Long where
 674     neg = Java.lneg
 675     (-) = Java.lsub
 676     one = Java.lconst_1
 677     (*) = Java.lmul
 678     fromInteger = Java.i2l
 679
 680 instance OrderedRing Long where
 681     abs = absLong
 682     toInteger = Java.l2i
 683
 684 instance Integral Long where
 685     div = Java.ldiv
 686     mod = Java.lrem
 687
 688 instance Show Long where
 689     show = showLong
 690     precedence v = if v >= 0 then 0 else 100
 691
 692 instance Read Long where
 693     read = readLong
 694
 695 /// Float ///
 696
 697 importJava "java.lang.Float" where
 698     @private
 699     @JavaName compare
 700     compareFloat :: Float -> Float -> Integer
 701
 702     @private
 703     @JavaName toString
 704     showFloat :: Float -> String
 705
 706     @private
 707     @JavaName parseFloat
 708     readFloat :: String -> Float
 709
 710     "Converts 32-bit floating point number to a 32-bit integer with the same byte level representation."
 711     floatToIntBits :: Float -> Integer
 712
 713 instance Eq Float where
 714     (==) = Java.fcmpeq
 715     (!=) = Java.fcmpne
 716
 717 instance Ord Float where
 718     compare = compareFloat
 719     (<) = Java.fcmplt
 720     (<=) = Java.fcmple
 721     (>) = Java.fcmpgt
 722     (>=) = Java.fcmpge
 723
 724 instance Hashable Float where
 725     hashP v x = hashP (floatToIntBits v) x
 726
 727 instance Additive Float where
 728     zero = Java.fconst_0
 729     (+) = Java.fadd
 730
 731 instance Ring Float where
 732     neg = Java.fneg
 733     (-) = Java.fsub
 734     one = Java.fconst_1
 735     (*) = Java.fmul
 736     fromInteger = Java.i2f
 737
 738 instance OrderedRing Float where
 739     abs = absFloat
 740     toInteger = Java.f2i
 741
 742 instance Real Float where
 743     (/) = Java.fdiv
 744     x ^ y = Java.d2f (powDouble (Java.f2d x) (Java.f2d y))
 745     pi = fromDouble piDouble
 746     sqrt = Java.d2f . sqrtDouble . Java.f2d
 747     exp = Java.d2f . expDouble . Java.f2d
 748     log = Java.d2f . logDouble . Java.f2d
 749     sin = Java.d2f . sinDouble . Java.f2d
 750     cos = Java.d2f . cosDouble . Java.f2d
 751     tan = Java.d2f . tanDouble . Java.f2d
 752     asin = Java.d2f . asinDouble . Java.f2d
 753     acos = Java.d2f . acosDouble . Java.f2d
 754     atan = Java.d2f . atanDouble . Java.f2d
 755     sinh = Java.d2f . sinhDouble . Java.f2d
 756     cosh = Java.d2f . coshDouble . Java.f2d
 757     tanh = Java.d2f . tanhDouble . Java.f2d
 758     floor = Java.d2f . floorDouble . Java.f2d
 759     ceil = Java.d2f . ceilDouble . Java.f2d
 760     atan2 y x = Java.d2f (atan2Double (Java.f2d y) (Java.f2d x))
 761     round = roundDouble . Java.f2d
 762     fromDouble = Java.d2f
 763     toDouble = Java.f2d
 764
 765 instance Show Float where
 766     show = showFloat
 767     precedence v = if v >= 0 then 0 else 100
 768
 769 instance Read Float where
 770     read = readFloat
 771
 772 /// Double ///
 773
 774 importJava "java.lang.Double" where
 775     @private
 776     @JavaName compare
 777     compareDouble :: Double -> Double -> Integer
 778
 779     @private
 780     @JavaName toString
 781     showDouble :: Double -> String
 782
 783     @private
 784     @JavaName parseDouble
 785     readDouble :: String -> Double
 786
 787     "Converts 64-bit floating point number to a 64-bit integer with the same byte level representation."
 788     doubleToLongBits :: Double -> Long
 789
 790     isFinite :: Double -> Boolean
 791     isNaN :: Double -> Boolean
 792     isInfinite :: Double -> Boolean
 793
 794 instance Eq Double where
 795     (==) = Java.dcmpeq
 796     (!=) = Java.dcmpne
 797
 798 instance Ord Double where
 799     compare = compareDouble
 800     (<) = Java.dcmplt
 801     (<=) = Java.dcmple
 802     (>) = Java.dcmpgt
 803     (>=) = Java.dcmpge
 804
 805 instance Hashable Double where
 806     hashP v x = hashP (doubleToLongBits v) x
 807
 808 instance Additive Double where
 809     zero = Java.dconst_0
 810     (+) = Java.dadd
 811
 812 instance Ring Double where
 813     neg = Java.dneg
 814     (-) = Java.dsub
 815     one = Java.dconst_1
 816     (*) = Java.dmul
 817     fromInteger = Java.i2d
 818
 819 instance OrderedRing Double where
 820     abs = absDouble
 821     toInteger = Java.d2i
 822
 823 instance Real Double where
 824     (/) = Java.ddiv
 825     (^) = powDouble
 826     pi = piDouble
 827     sqrt = sqrtDouble
 828     exp = expDouble
 829     log = logDouble
 830     sin = sinDouble
 831     cos = cosDouble
 832     tan = tanDouble
 833     asin = asinDouble
 834     acos = acosDouble
 835     atan = atanDouble
 836     sinh = sinhDouble
 837     cosh = coshDouble
 838     tanh = tanhDouble
 839     floor = floorDouble
 840     ceil = ceilDouble
 841     atan2 = atan2Double
 842     round = roundDouble
 843     fromDouble x = x
 844     toDouble x = x
 845
 846 instance Show Double where
 847     show = showDouble
 848     precedence v = if v >= 0 then 0 else 100
 849
 850 instance Read Double where
 851     read = readDouble
 852
 853 /// Character ///
 854
 855 importJava "java.lang.Character" where
 856     @JavaName toString
 857     showCharacter :: Character -> String
 858
 859     "Returns true, if the given character is a letter."
 860     isLetter :: Character -> Boolean
 861
 862     "Returns true, if the given character is a digit."
 863     isDigit :: Character -> Boolean
 864
 865 instance Eq Character where
 866     (==) = Java.ccmpeq
 867     (!=) = Java.ccmpne
 868
 869 instance Ord Character where
 870     (<) = Java.ccmplt
 871     (<=) = Java.ccmple
 872     (>) = Java.ccmpgt
 873     (>=) = Java.ccmpge
 874
 875 instance Show Character where
 876     sb <+ c = sb << "'" << showCharacter c << "'"
 877
 878 "Adds a given integer to the character code."
 879 addChar :: Character -> Integer -> Character
 880 addChar = Java.cadd
 881
 882 "Subtracts a given integer from the character code."
 883 subChar :: Character -> Character -> Integer
 884 subChar = Java.csub
 885
 886 /// Functor ///
 887
 888 """
 889 The `Functor` class is used for types that can be mapped over. Instances of `Functor` should satisfy the following laws:
 890
 891     fmap id  ==  id
 892     fmap (f . g)  ==  fmap f . fmap g
 893 """
 894 class Functor f where
 895     "Lifts a pure function to the given functor."
 896     fmap :: (a -> b) -> f a -> f b
 897 /*
 898 class CoFunctor f where
 899     comap :: (a -> b) -> f b -> f a
 900 */
 901 /// Applicative ///
 902 /*
 903 class (Functor f) => Applicative f where
 904     return :: a -> f a
 905     (<*>) :: f (a -> b) -> f a -> f b
 906     (*>) :: f a -> f b -> f b
 907     (<*) :: f a -> f b -> f a
 908
 909     u *> v = pure (const id) <*> u <*> v
 910     u <* v = pure const <*> u <*> v
 911     fmap f x = pure f <*> x
 912 */
 913 /// Monad ///
 914
 915 """
 916 The `Monad` class defines the basic operations over a monad, a concept from a branch of mathematics known as category theory.
 917 From the perspective of a SCL programmer, however, it is best to think of a monad as an abstract datatype of actions.
 918 SCL's `mdo expressions provide a convenient syntax for writing monadic expressions.
 919
 920 Instances of `Monad` should satisfy the following laws:
 921
 922     return a >>= k  ==  k a
 923     m >>= return  ==  m
 924     m >>= (\x -> k x >>= h)  ==  (m >>= k) >>= h
 925     fmap f xs  ==  xs >>= return . f
 926 """
 927 class (Functor m) => Monad m where
 928     "Inject a value into the monadic type."
 929     return :: a -> m a
 930     "Sequentially compose two actions, passing any value produced by the first as an argument to the second."
 931     (>>=) :: m a -> (a -> m b) -> m b
 932     """
 933     The join function is the conventional monad join operator. It removes one level of monadic
 934     structure.
 935
 936     For lists, `join` concatenates a list of lists:
 937
 938         join [[1,2], [3,4]] = [1, 2, 3, 4]
 939     """
 940     join :: m (m a) -> m a
 941     join m = m >>= id
 942
 943 """
 944 Sequentially compose two actions, discarding any value produced by the first, like sequencing operators
 945 (such as the semicolon) in imperative languages."
 946 """
 947 @macro
 948 (>>) :: Monad m => m a -> m b -> m b
 949 a >> b = a >>= (\_ -> b)
 950
 951 "While loop. `while cond body` executes the `body` while the `cond` is true."
 952 @inline
 953 while :: (<e> Boolean) -> (<e> a) -> <e> ()
 954 while cond body = loop ()
 955   where loop _ = if cond
 956                  then do body ; loop ()
 957                  else ()
 958
 959 """
 960 Sequences the given monadic value infinitely:
 961
 962     repeatForever m = m >> m >> m >> ...
 963 """
 964 repeatForever m = m >> repeatForever m
 965
 966 replicateM :: Monad m => Integer -> m a -> m [a]
 967 replicateM count m = loop count emptyList
 968   where
 969     loop count l | count <= 0 = return l
 970                  | otherwise  = mdo
 971                      v <- m
 972                      loop (count-1) (addList l v)
 973
 974 replicateM_ :: Monad m => Integer -> m a -> m ()
 975 replicateM_ count m | count <= 0 = return ()
 976                     | otherwise  = m >> replicateM_ (count-1) m
 977
 978 /// MonadZero ///
 979
 980 """
 981 A class of monads with zero element satisfying
 982
 983     mzero >>= f = mzero
 984 """
 985 class (Monad m) => MonadZero m where
 986     mzero :: m a
 987
 988 "Injects a boolean test to a type beloning to `MonadZero`."
 989 guard :: MonadZero m => Boolean -> m ()
 990 guard True = return ()
 991 guard False = mzero
 992
 993 /// MonadPlus ///
 994
 995 """
 996 A class of monads with associative binary operator `mplus` satisfying the following laws:
 997
 998     mplus mzero b = b
 999     mplus a mzero = a
1000     mplus (mplus a b) c = mplus a (mplus b c)
1001     mplus a b >>= k = mplus (a >>= k) (b >>= k)
1002 """
1003 class (MonadZero m) => MonadPlus m where
1004     mplus :: m a -> m a -> m a
1005
1006 /// MonadOr ///
1007
1008 """
1009 A class of monads with associative binary operator `morelse` satisfying the following laws:
1010
1011     morelse mzero b = b
1012     morelse a mzero = a
1013     morelse (morelse a b) c = morelse a (morelse b c)
1014     morelse (return a) b = return a
1015 """
1016 class (MonadZero m) => MonadOr m where
1017     morelse :: m a -> m a -> m a
1018
1019 /// FunctorE ///
1020
1021 """
1022 A class of types that can be mapped over with effectful mapping functions.
1023 """
1024 class (Functor f) => FunctorE f where
1025     """
1026     Applies the function to all elements of the container and
1027     returns the similarly shaped container with the results:
1028
1029     For lists,
1030
1031         map f [e1, e2, ..., eN] = [f e1, f e2, ..., f eN]
1032
1033     for example
1034
1035         map (*2) [1..5] = [2, 4, 6, 8, 10]
1036     """
1037     map :: (a -> <e> b) -> f a -> <e> (f b)
1038     "Calls the given function with all elements of the given container."
1039     iter :: (a -> <e> b) -> f a -> <e> ()
1040     "Calls the given function with all elements of the given container giving also the index of the element as a parameter."
1041     iterI :: (Integer -> a -> <e> b) -> f a -> <e> ()
1042
1043 "Iterates the elements of the given collection. Same as `iter` but parameters flipped."
1044 for :: FunctorE f => f a -> (a -> <e> b) -> <e> ()
1045 @macro
1046 for l f = iter f l
1047
1048 "Iterates the elements of the given collection providing also the indices of the elements. Same as `iterI` but parameters flipped."
1049 forI :: FunctorE f => f a -> (Integer -> a -> <e> b) -> <e> ()
1050 @macro
1051 forI l f = iterI f l
1052
1053 "`forN n f` calls `f` for all integers `0`, ..., `n-1`"
1054 @inline
1055 forN :: Integer -> (Integer -> <e> b) -> <e> ()
1056 forN n f = loop 0
1057   where
1058     loop i = if i < n
1059              then do f i ; loop (i+1)
1060              else ()
1061
1062 @inline
1063 mapI :: (Integer -> a -> <e> b) -> [a] -> <e> [b]
1064 mapI f l = build (\empty cons -> let
1065     len = length l
1066     loop i accum = if i < len
1067                    then loop (i+1) (cons accum (f i (l!i)))
1068                    else accum
1069   in loop 0 empty)
1070
1071 """
1072 `mapMaybe` combines `map` and `filter` functions.
1073 It applies the given function to every element of the input list. If the result
1074 is `Just x`, then `x` is added to the resulting list.
1075
1076     mapMaybe f lst = [y | x <- lst, Just y = f x]
1077 """
1078 @inline
1079 mapMaybe :: (a -> <e> Maybe b) -> [a] -> <e> [b]
1080 mapMaybe f l = build (\empty cons -> foldl (\cur x -> match f x with Just v -> cons cur v ; _ -> cur) empty l)
1081
1082 """
1083 Applies the given function to all elements of the list. Produces two lists: the first contains all elements `x`
1084 for which the function returned `Left x` and the second list contains all elements `y` for which the function
1085 returned `Right y`.
1086 """
1087 mapEither :: (a -> <e> Either b c) -> [a] -> <e> ([b], [c])
1088 mapEither f list = runProc do
1089     l = newArrayList
1090     r = newArrayList
1091     for list (\x -> match f x with
1092         Left v -> addArrayList l v
1093         Right v -> addArrayList r v)
1094     (Java.unsafeCoerce l, Java.unsafeCoerce r)
1095
1096 /// FunctorM ///
1097
1098 class (Functor f) => FunctorM f where
1099     "`mapM f` is equivalent to `sequence . map f`."
1100     mapM :: Monad m => (a -> m b) -> f a -> m (f b)
1101     "Evaluate each action in the sequence from left to right, and collect the results."
1102     sequence :: Monad m => f (m a) -> m (f a)
1103     mapM f l = sequence (fmap f l)
1104
1105 /// Category ///
1106
1107 "Identity function."
1108 id :: a -> a
1109 id x = x
1110
1111 """
1112 Ignores the given value. This function is used in a situation where a function returns
1113 a value in a context where the value is not expected.
1114 """
1115 @inline
1116 ignore :: a -> ()
1117 ignore _ = ()
1118
1119 @inline
1120 ignoreM :: a -> Maybe b
1121 ignoreM _ = Nothing
1122
1123 """
1124 Composes two functions
1125     (f . g) x = f (g x)
1126 """
1127 (.) :: (b -> <e> c) -> (a -> <e> b) -> (a -> <e> c)
1128 (f . g) x = f (g x)
1129
1130 /// Sequence ///
1131
1132 "A type class for sequences. All sequences must support indexing by integers."
1133 class /*(Additive a) =>*/ Sequence a where
1134     "Length of the sequence"
1135     length :: a -> Integer
1136     "`take n s` returns the first `n` elements of the sequence `s`."
1137     take :: Integer -> a -> a
1138     "`drop n s` removes the first `n` elements of the sequence `s`."
1139     drop :: Integer -> a -> a
1140     """
1141     `sub s begin end` returns a subsequence of `s` starting from
1142     index `begin` and ending just before index `end`.
1143     """
1144     sub :: a -> Integer -> Integer -> a
1145
1146     take n v = sub v 0 (min n (length v))
1147     drop n v = sub v (min n len) len
1148       where
1149         len = length v
1150
1151 instance Sequence [a] where
1152     length = lengthList
1153     sub = subList
1154
1155 instance Sequence String where
1156     length = lengthString
1157     sub = subString
1158
1159 class IndexedSequence f where
1160     "`seq ! i` returns the `i`th element of the sequence `seq`. Indexing starts from zero."
1161     (!) :: f a -> Integer -> a
1162
1163 instance IndexedSequence [] where
1164     (!) = getList
1165
1166 /// Boolean ///
1167
1168 """
1169 Equivalent to the boolean value `True`. The value is meant to be used in
1170 guard patterns:
1171
1172     min a b | a < b     = a
1173             | otherwise = b
1174 """
1175 @inline
1176 otherwise :: Boolean
1177 otherwise = True
1178
1179 instance Eq Boolean where
1180     a == b = if a then b else not b
1181     a != b = if a then not b else b
1182
1183 instance Ord Boolean where
1184     compare False False = 0
1185     compare False True  = neg 1
1186     compare True  False = 1
1187     compare True  True  = 0
1188
1189 instance Show Boolean where
1190     show True = "True"
1191     show False = "False"
1192
1193 """
1194 Boolean conjunction (and). The function is a macro that evaluates the second parameter
1195 only if the first parameter is `True`.
1196
1197 <table>
1198 <tr><th>a</th><th>b</th><th>a && b</th></tr>
1199 <tr><td>True</td><td>True</td><td>True</td></tr>
1200 <tr><td>True</td><td>False</td><td>False</td></tr>
1201 <tr><td>False</td><td>not evaluated</td><td>False</td></tr>
1202 </table>
1203 """
1204 @macro
1205 (&&) :: Boolean -> Boolean ->  Boolean
1206 a && b = if a then b else False
1207
1208 """
1209 Boolean disjunction (or). The function is a macro that evaluates the second parameter
1210 only if the first parameter is `False`.
1211
1212 <table>
1213 <tr><th>a</th><th>b</th><th>a || b</th></tr>
1214 <tr><td>True</td><td>not evaluated</td><td>True</td></tr>
1215 <tr><td>False</td><td>True</td><td>True</td></tr>
1216 <tr><td>False</td><td>False</td><td>False</td></tr>
1217 </table>
1218 """
1219 @macro
1220 (||) :: Boolean -> Boolean -> Boolean
1221 a || b = if a then True else b
1222
1223 "Boolean negation"
1224 @inline
1225 not a = if a then False else True
1226
1227 /// Maybe ///
1228
1229 //data Maybe a = Nothing | Just a
1230
1231 "Given `Just x` this function returns `x`. If the parameter is `Nothing`, the function raises an exception."
1232 fromJust :: Maybe a -> a
1233 fromJust (Just a) = a
1234
1235 deriving instance (Eq a) => Eq (Maybe a)
1236 deriving instance (Ord a) => Ord (Maybe a)
1237 deriving instance (Show a) => Show (Maybe a)
1238 deriving instance (Hashable a) => Hashable (Maybe a)
1239
1240 instance Functor Maybe where
1241     fmap _ Nothing  = Nothing
1242     fmap f (Just x) = Just (f x)
1243
1244 instance FunctorE Maybe where
1245     map _ Nothing  = Nothing
1246     map f (Just x) = Just (f x)
1247
1248     iter _ Nothing = ()
1249     iter f (Just x) = ignore (f x)
1250
1251     iterI _ Nothing = ()
1252     iterI f (Just x) = ignore (f 0 x)
1253
1254 instance Monad Maybe where
1255     return x = Just x
1256
1257     @inline
1258     Nothing >>= _ = Nothing
1259     Just x  >>= f = f x
1260
1261     @inline
1262     join Nothing  = Nothing
1263     join (Just x) = x
1264
1265 instance MonadZero Maybe where
1266     mzero = Nothing
1267
1268 instance MonadOr Maybe where
1269     morelse a@(Just _) _ = a
1270     morelse _ b = b
1271
1272 "`execJust v f` executes the function `f` with parameter value `x`, if `v=Just x`. If `v=Nothing`, the function does nothing."
1273 @inline
1274 execJust :: Maybe a -> (a -> <e> b) -> <e> ()
1275 execJust maybeValue procedure = match maybeValue with
1276     Just v -> ignore $ procedure v
1277     _ -> ()
1278
1279 "`fromMaybe def v` returns `def` if `v=Nothing` and `x` if `v=Just x`."
1280 @inline
1281 fromMaybe :: a -> Maybe a -> a
1282 fromMaybe default maybeValue = match maybeValue with
1283     Just v -> v
1284     _ -> default
1285
1286
1287 """
1288 Provides a default value if the first parameter is Nothing.
1289 The default value is evaluated only if needed. The function
1290 can be used as an operator and is right associative so that
1291 the following is possible:
1292
1293     tryWithTheFirstMethod
1294         `orElse` tryWithTheSecondMethod
1295         `orElse` fail "Didn't succeed."
1296 """
1297 @inline
1298 orElse :: Maybe a -> (<e> a) -> <e> a
1299 orElse (Just x) _   = x
1300 orElse Nothing  def = def
1301
1302 /// Either ///
1303
1304 """
1305 The Either type represents values with two possibilities: a value of type `Either a b` is either `Left a` or `Right b`.
1306
1307 The `Either` type is sometimes used to represent a value which is either correct or an error; by convention, the `Left` constructor
1308 is used to hold an error value and the `Right` constructor is used to hold a correct value (mnemonic: "right" also means "correct").
1309 """
1310 data Either a b = Left a | Right b
1311
1312 deriving instance (Eq a, Eq b) => Eq (Either a b)
1313 deriving instance (Ord a, Ord b) => Ord (Either a b)
1314 deriving instance (Show a, Show b) => Show (Either a b)
1315 deriving instance (Hashable a, Hashable b) => Hashable (Either a b)
1316
1317 instance Functor (Either a) where
1318     fmap _ (Left x)  = Left x
1319     fmap f (Right y) = Right (f y)
1320
1321 instance FunctorE (Either a) where
1322     map _ (Left x)  = Left x
1323     map f (Right y) = Right (f y)
1324
1325     iter _ (Left x) = ()
1326     iter f (Right y) = ignore (f y)
1327
1328     iterI _ (Left x) = ()
1329     iterI f (Right y) = ignore (f 0 y)
1330
1331 instance Monad (Either b) where
1332     return y = Right y
1333
1334     Left x  >>= _ = Left x
1335     Right y >>= f = f y
1336
1337     join (Left x)  = Left x
1338     join (Right y) = y
1339
1340 /// String ///
1341
1342 importJava "java.lang.String" where
1343     @private
1344     @JavaName "concat"
1345     concatString :: String -> String -> String
1346     @private
1347     @JavaName "compareTo"
1348     compareString :: String -> String -> Integer
1349     @private
1350 //    @JavaName "hashCode"
1351 //    hashString :: String -> Integer
1352     @private
1353     @JavaName "equals"
1354     equalsString :: String -> String -> Boolean
1355     @private
1356     @JavaName "length"
1357     lengthString :: String -> Integer
1358
1359     """
1360     `replaceString original pattern replacement` replaces all occurrences of `pattern` in the string by `replacement`.
1361     """
1362     @JavaName replace
1363     replaceString :: String -> String -> String -> String
1364
1365     @private
1366     @JavaName split
1367     splitString_ :: String -> String -> Array String
1368
1369     """
1370     `indexOf string s` finds the first occurrence of `s` from `string` and returns its index.
1371     If the `s` does not occur in the string, return `-1`."
1372     """
1373     @JavaName indexOf
1374     indexOf :: String -> String -> Integer
1375
1376     "Works like `indexOf` but starts searching from the given index instead of the beginning of the string."
1377     @JavaName indexOf
1378     indexOfStartingFrom :: String -> String -> Integer -> Integer
1379
1380     "Works like `indexOf` but returns the index of the last occurrence."
1381     @JavaName lastIndexOf
1382     lastIndexOf :: String -> String -> Integer
1383
1384     "Works like `lastIndexOf` but starts searching from the given index instead of the end of the string."
1385     @JavaName lastIndexOf
1386     lastIndexOfStartingFrom :: String -> String -> Integer -> Integer
1387
1388     @private
1389     @JavaName substring
1390     subString :: String -> Integer -> Integer -> String
1391
1392     """
1393     `regionMatches str1 offset1 str2 offset2 len` tests whether
1394     `sub str1 offset1 (offset1+len) == sub str2 offset2 (offset2+len)`.
1395     """
1396     regionMatches :: String -> Integer -> String -> Integer -> Integer -> Boolean
1397
1398     "`startsWith string prefix` returns true if the string begins with the given prefix."
1399     startsWith :: String -> String -> Boolean
1400
1401     "`endsWith string suffix` returns true if the string ends with the given prefix."
1402     endsWith :: String -> String -> Boolean
1403
1404     "Removes leading and trailing whitespace from the string."
1405     trim :: String -> String
1406
1407     "`contains string s` returns true if `string` contains `s` as a substring."
1408     contains :: String -> String -> Boolean
1409
1410     "`charAt string i` returns the `i`th character of the string."
1411     charAt :: String -> Integer -> Character
1412
1413     "Converts all letters of the string to lower case."
1414     toLowerCase :: String -> String
1415     "Converts all letters of the string to upper case."
1416     toUpperCase :: String -> String
1417
1418     "Creates a string from a vector of characters."
1419     @JavaName "<init>"
1420     string :: Vector Character -> String
1421
1422 instance Eq String where
1423     (==) = equalsString
1424
1425 instance Hashable String where
1426     hashP x v = Java.hashCode x + v*16777619
1427
1428 instance Ord String where
1429     compare = compareString
1430
1431 instance Additive String where
1432     zero = ""
1433     (+) = concatString
1434     sum ss = runProc (StringBuilder.toString $ foldl StringBuilder.appendString StringBuilder.new ss)
1435
1436 @private
1437 importJava "org.simantics.scl.runtime.string.StringEscape" where
1438     appendEscapedString :: StringBuilder.T -> String -> <Proc> StringBuilder.T
1439
1440 instance Show String where
1441     showForPrinting = id
1442     sb <+ v = (appendEscapedString (sb << "\"") v) << "\""
1443
1444 instance Read String where
1445     read str = str
1446
1447 "`splitString text pattern` splits the string into a list of string where the parts are sepratated in the original list by the given pattern."
1448 splitString :: String -> String -> [String]
1449 splitString source pattern = arrayToList $ splitString_ source pattern
1450
1451 split :: String -> String -> [String]
1452 split pattern text = arrayToList $ splitString_ text pattern
1453
1454 /// Tuple0 ///
1455
1456 instance Eq () where
1457     () == () = True
1458
1459 instance Ord () where
1460     compare () () = 0
1461
1462 instance Hashable () where
1463     hashP () x = x
1464
1465 instance Additive () where
1466     zero = ()
1467     () + () = ()
1468
1469 instance Show () where
1470     show () = "()"
1471
1472 /// Tuple2 ///
1473
1474 "Gives the first element of a pair."
1475 @inline
1476 fst :: (a,b) -> a
1477 fst (x,y) = x
1478
1479 "Gives the second element of a pair."
1480 @inline
1481 snd :: (a,b) -> b
1482 snd (x,y) = y
1483
1484 instance (Eq a, Eq b) => Eq (a, b) where
1485     (a0, b0) == (a1, b1) = a0 == a1 && b0 == b1
1486
1487 instance (Ord a, Ord b) => Ord (a, b) where
1488     compare (a0, b0) (a1, b1) = compare a0 a1 &<& compare b0 b1
1489
1490 instance (Hashable a, Hashable b) => Hashable (a, b) where
1491     hashP (a,b) x = hashP b $ hashP a x
1492
1493 instance (Additive a, Additive b) => Additive (a, b) where
1494     zero = (zero, zero)
1495     (a0, b0) + (a1, b1) = (a0+a1, b0+b1)
1496
1497 instance Functor ((,) a) where
1498     fmap f (a,b) = (a, f b)
1499
1500 instance (Show a, Show b) => Show (a, b) where
1501     sb <+ (x, y) = sb << "(" <+ x << ", " <+ y << ")"
1502
1503 /// Tuple3 ///
1504
1505 instance (Eq a, Eq b, Eq c) => Eq (a, b, c) where
1506     (a0, b0, c0) == (a1, b1, c1) = a0 == a1 && b0 == b1 && c0 == c1
1507
1508 instance (Ord a, Ord b, Ord c) => Ord (a, b, c) where
1509     compare (a0, b0, c0) (a1, b1, c1) = compare a0 a1 &<& compare b0 b1 &<& compare c0 c1
1510
1511 instance (Hashable a, Hashable b, Hashable c) => Hashable (a, b, c) where
1512     hashP (a,b,c) x = hashP c $ hashP b $ hashP a x
1513
1514 instance (Additive a, Additive b, Additive c) => Additive (a, b, c) where
1515     zero = (zero, zero, zero)
1516     (a0, b0, c0) + (a1, b1, c1) = (a0+a1, b0+b1, c0+c1)
1517
1518 instance Functor ((,,) a b) where
1519     fmap f (a,b,c) = (a, b, f c)
1520
1521 instance (Show a, Show b, Show c) => Show (a, b, c) where
1522     sb <+ (x, y, z) = sb << "(" <+ x << ", " <+ y << ", " <+ z << ")"
1523
1524 /// Tuple4 ///
1525
1526 instance (Eq a, Eq b, Eq c, Eq d) => Eq (a, b, c, d) where
1527     (a0, b0, c0, d0) == (a1, b1, c1, d1) = a0 == a1 && b0 == b1 && c0 == c1 && d0 == d1
1528
1529 instance (Ord a, Ord b, Ord c, Ord d) => Ord (a, b, c, d) where
1530     compare (a0, b0, c0, d0) (a1, b1, c1, d1) =
1531         compare a0 a1 &<& compare b0 b1 &<& compare c0 c1 &<& compare d0 d1
1532
1533 instance (Hashable a, Hashable b, Hashable c, Hashable d) => Hashable (a, b, c, d) where
1534     hashP (a,b,c,d) x = hashP d $ hashP c $ hashP b $ hashP a x
1535
1536 instance (Additive a, Additive b, Additive c, Additive d) => Additive (a, b, c, d) where
1537     zero = (zero, zero, zero, zero)
1538     (a0, b0, c0, d0) + (a1, b1, c1, d1) = (a0+a1, b0+b1, c0+c1, d0+d1)
1539
1540 instance Functor ((,,,) a b c) where
1541     fmap f (a,b,c,d) = (a, b, c, f d)
1542
1543 instance (Show a, Show b, Show c, Show d) => Show (a, b, c, d) where
1544     sb <+ (x, y, z, w) = sb << "(" <+ x << ", " <+ y << ", " <+ z << ", " <+ w << ")"
1545
1546 /// Tuple5 ///
1547
1548 instance (Eq a, Eq b, Eq c, Eq d, Eq e) => Eq (a, b, c, d, e) where
1549     (a0, b0, c0, d0, e0) == (a1, b1, c1, d1, e1) =
1550         a0 == a1 && b0 == b1 && c0 == c1 && d0 == d1 && e0 == e1
1551
1552 instance (Ord a, Ord b, Ord c, Ord d, Ord e) => Ord (a, b, c, d, e) where
1553     compare (a0, b0, c0, d0, e0) (a1, b1, c1, d1, e1) =
1554         compare a0 a1 &<& compare b0 b1 &<& compare c0 c1 &<& compare d0 d1 &<& compare e0 e1
1555
1556 instance (Hashable a, Hashable b, Hashable c, Hashable d, Hashable e)
1557        => Hashable (a, b, c, d, e) where
1558     hashP (a,b,c,d,e) x = hashP e $ hashP d $ hashP c $ hashP b $ hashP a x
1559
1560 instance (Additive a, Additive b, Additive c, Additive d, Additive e) => Additive (a, b, c, d, e) where
1561     zero = (zero, zero, zero, zero, zero)
1562     (a0, b0, c0, d0, e0) + (a1, b1, c1, d1, e1) = (a0+a1, b0+b1, c0+c1, d0+d1, e0+e1)
1563
1564 instance Functor ((,,,,) a b c d) where
1565     fmap f (a,b,c,d,e) = (a, b, c, d, f e)
1566
1567 /// Lists ///
1568
1569 instance (Eq a) => Eq [a] where
1570     a == b = lA == lB && loop 0
1571       where
1572         lA = length a
1573         lB = length b
1574         loop i = i>=lA || (a!i == b!i && loop (i+1))
1575
1576 instance (Ord a) => Ord [a] where
1577     compare a b = loop 0
1578       where
1579         lA = length a
1580         lB = length b
1581         loop i = if i >= lA
1582                  then (if i >= lB then 0 else -1)
1583                  else if i >= lB
1584                  then 1
1585                  else compare (a!i) (b!i) &<& loop (i+1)
1586
1587 instance (Hashable a) => Hashable [a] where
1588     hashP a x = loop 0 x
1589       where
1590         lA = length a
1591         loop i x = if i == lA
1592                    then x
1593                    else loop (i+1) (hashP (a!i) x)
1594
1595 instance Functor [] where
1596     fmap = mapList
1597
1598 instance FunctorE [] where
1599     map = mapEList
1600     iter = iterList
1601     iterI = iterIList
1602
1603 instance Monad [] where
1604     return x = singletonList x
1605     l >>= f  = concatMap f l
1606     join l   = l >>= id
1607
1608 instance MonadZero [] where
1609     mzero = emptyList
1610
1611 instance MonadPlus [] where
1612     mplus = appendList
1613
1614 instance Additive [a] where
1615     zero = emptyList
1616     (+) = appendList
1617
1618 instance FunctorM [] where
1619     sequence = foldl (\m mel -> m >>= \l -> mel >>= \el -> return (addList l el)) (return emptyList)
1620     mapM f l = sequence (map f l)
1621
1622 "Appends the string representations of all elements of the list to the string builder and separates the values with the given separator."
1623 printWithSeparator :: Show a => StringBuilder.T -> String -> [a] -> <Proc> StringBuilder.T
1624 printWithSeparator sb sep l = loop 0
1625   where
1626     len = length l
1627     loop i = if i >= len then sb
1628              else do
1629                  (if i==0 then sb else sb << sep) <+ l!i
1630                  loop (i+1)
1631
1632 "Joins the string representations of the list of values with the given separator."
1633 joinWithSeparator :: Show a => String -> [a] -> String
1634 joinWithSeparator separator values = runProc (
1635     StringBuilder.toString $ printWithSeparator StringBuilder.new separator values)
1636
1637 instance (Show a) => Show [a] where
1638     sb <+ l = do
1639         len = length l
1640         loop i = if i < len
1641                  then do
1642                      if (i>0) then sb << ", " else sb
1643                      sb <+ l!i
1644                      loop (i+1)
1645                  else sb << "]"
1646         sb << "["
1647         loop 0
1648
1649 importJava "java.util.List" where
1650     "`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."
1651     @JavaName get
1652     getList :: [a] -> Integer -> a
1653
1654     @private
1655     @JavaName size
1656     lengthList :: [a] -> Integer
1657
1658     @private
1659     subList :: [a] -> Integer -> Integer -> [a]
1660
1661     @private
1662     isEmpty :: [a] -> Boolean
1663
1664 @private
1665 importJava "java.util.Collections" where
1666     emptyList :: [a]
1667     //singletonList :: a -> [a]
1668
1669 /*
1670 @inline
1671 emptyList :: [a]
1672 emptyList = build (\empty cons -> empty)
1673 */
1674
1675 "Creates a list with exectly one element."
1676 @inline
1677 singletonList :: a -> [a]
1678 singletonList v = build (\empty cons -> cons empty v)
1679
1680 /*
1681 // foldl f i (a + b) = foldl f (foldl f i a) b
1682
1683 appendList :: [a] -> [a] -> [a]
1684 appendList a b = build (\empty cons -> foldl cons (foldl cons empty a) b)
1685 */
1686
1687 importJava "org.simantics.scl.runtime.list.ShareableList" where
1688     "Concatenates two lists."
1689     @private
1690     @JavaName "concat"
1691     appendList :: [a] -> [a] -> [a]
1692
1693     "Adds the given value to the end of the list."
1694     @JavaName "add"
1695     addList :: [a] -> a -> [a]
1696
1697 @private
1698 importJava "java.util.ArrayList" where
1699     data ArrayList a
1700
1701     @JavaName "<init>"
1702     newArrayList :: <Proc> ArrayList a
1703
1704     @JavaName add
1705     addArrayList :: ArrayList a -> a -> <Proc> ()
1706
1707 """
1708 A primitive for constructing a list by `empty` and `cons` operations given to the function given as a parameter to this function.
1709 For example:
1710
1711     build (\empty cons -> cons (cons (cons empty 1) 2) 3)
1712
1713 produces
1714
1715     [1, 2, 3]
1716
1717 The SCL compiler makes the following optimization when encountering `build` and `foldl` functions after inlining:
1718
1719     foldl f i (build g) = g i f
1720 """
1721 @inline 2
1722 build :: forall b e2. (forall a e1. a -> (a -> b -> <e1> a) -> <e1,e2> a) -> <e2> [b]
1723 build f = runProc do
1724     l = newArrayList
1725     f () (\_ v -> addArrayList l v)
1726     Java.unsafeCoerce l
1727
1728 "A specific implementation of `map` for lists."
1729 @private
1730 @inline
1731 mapEList :: (a -> <e> b) -> [a] -> <e> [b]
1732 mapEList f l = build (\empty cons -> foldl (\cur x -> cons cur (f x)) empty l)
1733
1734 "A specific implementation of `fmap` for lists."
1735 @inline
1736 mapList :: (a -> b) -> [a] -> [b]
1737 mapList f l = build (\empty cons -> foldl (\cur x -> cons cur (f x)) empty l)
1738
1739 "`guardList v` returns a singleton `[()]` if `v=True` and the empty list if `v=False`."
1740 @inline
1741 guardList :: Boolean -> [()]
1742 guardList cond = build (\empty cons -> if cond then cons empty () else empty)
1743
1744 """
1745 `concatMap` combines `map` and `join` functions.
1746 It maps the elements of a given list to lists with the given function and concatenates the results.
1747
1748     concatMap f lst = join (map f lst) = [y | x <- lst, y <- f x]
1749 """
1750 @inline
1751 concatMap :: (a -> <e> [b]) -> [a] -> <e> [b]
1752 concatMap f l = build (\empty cons -> foldl (\cur le -> foldl cons cur (f le)) empty l)
1753
1754 """
1755 Applies the given function to the elements of the lists until the function returns something
1756 else than `Nothing`. This return value is also returned as a result of this function.
1757 """
1758 @inline
1759 mapFirst :: (a -> <e> Maybe b) -> [a] -> <e> Maybe b
1760 mapFirst f l = loop 0
1761   where
1762     len = length l
1763     loop i = if i == len
1764              then Nothing
1765              else match f (l!i) with
1766                  r @ (Just _) -> r
1767                  Nothing -> loop (i+1)
1768
1769 """
1770     foldl op initialValue list
1771
1772 applies a binary operator `op` to all elements of `list` from left to right
1773 starting with `initialValue`. For example,
1774
1775     foldl op init [x1, x2, x3, x4] = (((init `op` x1) `op` x2) `op` x3) `op` x4
1776 """
1777 @inline 2
1778 foldl :: forall a b e. (a -> b -> <e> a) -> a -> [b] -> <e> a
1779 foldl f initial l = loop initial 0
1780   where
1781     len = length l
1782     loop cur i = if i==len
1783                  then cur
1784                  else loop (f cur (l!i)) (i+1)
1785
1786 foldlI :: forall a b e. (Integer -> a -> b -> <e> a) -> a -> [b] -> <e> a
1787 foldlI f initial l = loop initial 0
1788   where
1789     len = length l
1790     loop cur i = if i==len
1791                  then cur
1792                  else loop (f i cur (l!i)) (i+1)
1793
1794 scanl :: (b -> a -> <e> b) -> b -> [a] -> <e> [b]
1795 scanl f initial l = build (\empty cons -> let
1796     len = length l
1797     loop cur i accum = let nl = cons accum cur
1798                            in if i==len
1799                            then nl
1800                             else loop (f cur (l!i)) (i+1) nl
1801   in loop initial 0 empty)
1802
1803 "`foldr` is defined like `foldl` but it process the list from right to left."
1804 @inline
1805 foldr :: (b -> a -> <e> a) -> a -> [b] -> <e> a
1806 foldr f initial l = loop initial (length l - 1)
1807   where
1808     loop cur i = if i < 0
1809                  then cur
1810                  else loop (f (l!i) cur) (i-1)
1811
1812 foldr1 :: (a -> a -> <e> a) -> [a] -> <e> a
1813 foldr1 f l = loop (l!(len-1)) (len-2)
1814   where
1815     len = length l
1816     loop cur i = if i < 0
1817                  then cur
1818                  else loop (f (l!i) cur) (i-1)
1819
1820 """
1821 `filter pred lst` returns those elements of `lst` that the predicate `pred` accepts. For example
1822
1823     filter (> 3) [1, 2, 3, 4, 5, 6] = [4, 5, 6]
1824 """
1825 @inline
1826 filter :: (a -> <e> Boolean) -> [a] -> <e> [a]
1827 filter p l = build (\empty cons -> foldl (\cur x -> if p x then cons cur x else cur) empty l)
1828
1829 """
1830 Takes those elements of the input list that match `(Just x)` and adds the contents to the resulting list. For example,
1831
1832     filterJust [Just 1, Nothing, Just 5] = [1, 5]
1833 """
1834 @inline
1835 filterJust :: [Maybe a] -> [a]
1836 filterJust l = build (\empty cons -> foldl (\cur x -> match x with Just v -> cons cur v ; _ -> cur) empty l)
1837
1838 listToMaybe :: [a] -> Maybe a
1839 listToMaybe l = if isEmpty l then Nothing else Just (l!0)
1840
1841 maybeToList :: Maybe a -> [a]
1842 maybeToList (Just a) = [a]
1843 maybeToList _ = []
1844
1845 partition :: (a -> <e> Boolean) -> [a] -> <e> ([a], [a])
1846 partition p l = runProc do
1847     res1 = newArrayList
1848     res2 = newArrayList
1849     for l (\el ->
1850         if p el
1851         then addArrayList res1 el
1852         else addArrayList res2 el
1853     )
1854     (Java.unsafeCoerce res1, Java.unsafeCoerce res2)
1855
1856 """
1857 `range begin end` produces a list of consecutive integers starting from `begin` and ending to `end` (including `end`).
1858 The compiler supports syntactic sugar `[begin..end]` for this function.
1859 """
1860 @inline
1861 range :: Integer -> Integer -> [Integer]
1862 range first last = build (\empty cons -> do
1863     loop i cur = if i > last then cur else loop (i+1) (cons cur i)
1864     loop first empty)
1865
1866 "A specific implementation of `iter` for lists."
1867 @inline
1868 iterList :: (a -> <e> b) -> [a] -> <e> ()
1869 iterList f l = foldl (\_ x -> ignore (f x)) () l
1870
1871 "A specific implementation of `iterI` for lists."
1872 @inline
1873 iterIList :: (Integer -> a -> <e> b) -> [a] -> <e> ()
1874 iterIList f l = do foldl (\i x -> do f i x ; i+1) 0 l ; ()
1875
1876 """
1877 Generates a list from a given starting state and iteration function.
1878 For example
1879
1880     let nextState 0 = Nothing
1881         nextState i = Just (i, i `div` 2)
1882     in  unfoldr nextState 30
1883
1884 produces
1885
1886     [30, 15, 7, 3, 1]
1887 """
1888 @inline
1889 unfoldr :: (b -> <e> Maybe (a, b)) -> b -> <e> [a]
1890 unfoldr f s = build (\empty cons -> do
1891     loop s cur =
1892         match f s with
1893             Just (el,newS) -> loop newS (cons cur el)
1894             _ -> cur
1895     loop s empty)
1896
1897 importJava "org.simantics.scl.runtime.Lists" where
1898     /*
1899     @private
1900     @JavaName map
1901     mapList :: (a -> b) -> [a] -> [b]
1902     @private
1903     @JavaName map
1904     mapEList :: (a -> <e> b) -> [a] -> <e> [b]
1905     @private
1906     @JavaName iter
1907     iterList :: (a -> <e> ()) -> [a] -> <e> ()
1908     concatMap :: (a -> <e> [b]) -> [a] -> <e> [b]
1909     */
1910     """
1911     Combines two lists into one list of pairs. The length of the resulting list is the length of the smallest input list.
1912
1913         zip [1, 2, 3, 4, 5] ['a', 'b', 'c'] = [(1, 'a'), (2, 'b'), (3, 'c')]
1914     """
1915     zip :: [a] -> [b] -> [(a,b)]
1916     "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."
1917     zipWith :: (a -> b -> <e> c) -> [a] -> [b] -> <e> [c]
1918     """
1919     Produces two lists from one list of pairs.
1920
1921         unzip [(1, 'a'), (2, 'b'), (3, 'c')] = ([1, 2, 3], ['a', 'b', 'c'])
1922     """
1923     unzip :: [(a,b)] -> ([a],[b])
1924
1925     //"@filter p l@ returns those elements of @l@ that the predicate @p@ accepts."
1926     //filter :: (a -> <e> Boolean) -> [a] -> <e> [a]
1927     //filterJust :: [Maybe a] -> [a]
1928     /*
1929     foldl :: (a -> b -> <e> a) -> a -> [b] -> <e> a
1930     */
1931     "Like `foldl` but assumes that the list is non-empty so the initial is not needed."
1932     foldl1 :: (a -> a -> <e> a) -> [a] -> <e> a
1933     //unfoldr :: (b -> <e> Maybe (a, b)) -> b -> <e> [a]
1934
1935     "Sorts the list using the given comparator."
1936     sortWith :: (a -> a -> <e> Integer) -> [a] -> <e> [a]
1937     "Works like `index` but uses the given functions as hash codes and equality."
1938     indexWith :: (a -> Integer) -> (a -> a -> Boolean) -> [(a,b)] -> a -> Maybe b
1939     groupWith :: (b -> Integer) -> (b -> b -> Boolean) -> (a -> <e> b) -> (a -> <e> c) -> [a] -> <e> [(b, [c])]
1940     "Works like `unique` but uses the given function for equality tests."
1941     uniqueWith :: (a -> a -> Boolean) -> [a] -> [a]
1942     "Works like `\\\\` but uses the given function for equality tests."
1943     deleteAllBy :: (a -> a -> Boolean) -> [a] -> [a] -> [a]
1944
1945     //range :: Integer -> Integer -> [Integer]
1946
1947     //build :: (forall a. a -> (a -> b -> <e> a) -> <e> a) -> <e> [b]
1948
1949 "`elem el lst` return true, if `el` occurs in the list `lst`."
1950 elem :: Eq a => a -> [a] -> Boolean
1951 elem el l = loop 0
1952   where
1953     len = length l
1954     loop i | i < len = if el == l!i
1955                        then True
1956                        else loop (i+1)
1957            | otherwise = False
1958
1959 "`elemMaybe v1 (Just v2)` returns true if `v1 == v2`. `elemMaybe v1 Nothing` is always false."
1960 elemMaybe :: Eq a => a -> Maybe a -> Boolean
1961 elemMaybe el m = match m with
1962     Just el2 -> el == el2
1963     Nothing -> False
1964
1965 """
1966 Computes a list that contains only elements that belongs to both input lists.
1967 """
1968 intersect :: Eq a => [a] -> [a] -> [a]
1969 intersect a b = filter f a
1970   where
1971     f e = elem e b
1972
1973 "Reverses a given list. For example, `reverse [1,2,3] = [3,2,1]`"
1974 reverse :: [a] -> [a]
1975 reverse l = [l!(len-i) | i <- [1..len]]
1976   where
1977     len = length l
1978
1979 """
1980 Transposes the rows and columns of its argument. For example,
1981
1982     transpose [[1,2,3],[4,5,6]] == [[1,4],[2,5],[3,6]]
1983     transpose [[1,2],[3,4,5]] == [[1,3],[2,4],[5]]
1984 """
1985 transpose xss = [[xs!i | xs <- xss, i < length xs]
1986                 | i <- [0..maximum [length xs | xs <- xss]-1]]
1987
1988 "Works like `unfoldr` but generates the list from right to left."
1989 unfoldl :: (b -> <e> Maybe (a, b)) -> b -> <e> [a]
1990 unfoldl f seed = reverse $ unfoldr f seed
1991
1992 "Removes the first element of the list, if the list is non-empty."
1993 tail :: [a] -> [a]
1994 tail l = if len < 2 then emptyList else subList l 1 len
1995   where
1996     len = length l
1997
1998 "Tries to find the given key from the list of key-value pairs and returns the corresponding value."
1999 lookup :: Eq a => a -> [(a, b)] -> Maybe b
2000 lookup el l = do
2001     len = length l
2002     loop i = if i < len
2003              then match l!i with
2004                (a,b) | a == el   -> Just b
2005                      | otherwise -> loop (i+1)
2006              else Nothing
2007     loop 0
2008
2009 "Conjunction over a list."
2010 @inline
2011 and :: [Boolean] -> Boolean
2012 and = foldl (&&) True
2013
2014 "Disjunction over a list."
2015 @inline
2016 or :: [Boolean] -> Boolean
2017 or  = foldl (||) False
2018
2019 """
2020 `any pred lst` tests whether the predicate `pred` holds some element of `lst`.
2021 It returns immediately when it encounters the first value satisfying the predicate.
2022 """
2023 any :: (a -> <e> Boolean) -> [a] -> <e> Boolean
2024 any p =  or . map p
2025
2026 """
2027 `all pred lst` tests whether the predicate `pred` holds for all elements of `lst`.
2028 It returns immediately when it encounters the first value not satisfying the predicate.
2029 """
2030 all :: (a -> <e> Boolean) -> [a] -> <e> Boolean
2031 all p =  and . map p
2032
2033 """
2034 Returns the first element of the list satisfying the given condition,
2035 or `Nothing` if there is no such element.
2036 """
2037 findFirst :: (a -> <e> Boolean) -> [a] -> <e> Maybe a
2038 findFirst p l = loop 0
2039   where
2040     len = length l
2041     loop i = if i < len
2042              then let el = l!i in
2043                   if p el
2044                   then Just el
2045                   else loop (i+1)
2046              else Nothing
2047     loop 0
2048
2049
2050 """
2051 Sorts the given list using its default order.
2052 """
2053 @inline
2054 sort :: Ord a => [a] -> [a]
2055 sort = sortWith compare
2056
2057 """
2058 Sorts the lists by the values computed by the first function.
2059 For example
2060
2061     sortBy snd [(1,5), (2,3), (3,4)] = [(2,3), (3,4), (1,5)]
2062 """
2063 @inline
2064 sortBy :: Ord b => (a -> <e> b) -> [a] -> <e> [a]
2065 sortBy f l = sortWith (\x y -> compare (f x) (f y)) l
2066 // This is faster if f is slow, but will generate more auxiliary structures
2067 //sortBy f l = map snd (sortWith (\(x,_) (y,_) -> compare x y) [(f x, x) | x <- l])
2068
2069 """
2070 Given a list of key-value pairs, the function produces a function that finds a value
2071 efficiently for the given key.
2072 """
2073 index :: Hashable a => [(a,b)] -> a -> Maybe b
2074 index = indexWith hash (==)
2075
2076 """
2077 Given a list of values and a function computing a key for each value, the function produces a function that finds a value
2078 effeciently for the given key.
2079 """
2080 indexBy :: Hashable b => (a -> b) -> [a] -> b -> Maybe a
2081 indexBy f l = index [(f x, x) | x <- l]
2082
2083 "Groups a list values by a key computed by the given function."
2084 groupBy :: Hashable b => (a -> <e> b) -> [a] -> <e> [(b, [a])]
2085 groupBy f l = groupWith hash (==) f id l
2086
2087 "Groups a list of key-value pairs by the keys."
2088 group :: Hashable a => [(a,b)] -> [(a, [b])]
2089 group = groupWith hash (==) fst snd
2090
2091 "Removes duplicates (all but the first occurrence) from the list but otherwise preserves the order of the elements."
2092 unique :: Eq a => [a] -> [a]
2093 unique = uniqueWith (==)
2094
2095 "Like `unique`, but uses the given function for finding the key values used for uniqueness testing."
2096 uniqueBy :: Eq b => (a -> b) -> [a] -> [a]
2097 uniqueBy f = uniqueWith (\a b -> f a == f b)
2098
2099 //sortAndUniqueBy :: Ord b => (a -> b) -> [a] -> [a]
2100 //sortAndUniqueBy f = map snd . uniqueWith (\a b -> fst a == fst b) . sortBy fst . map (\x -> (f x, x))
2101
2102 "`a \\\\ b` removes all elements of `b` from the list `a`."
2103 (\\) :: Eq a => [a] -> [a] -> [a]
2104 (\\) = deleteAllBy (==)
2105
2106 /// Dynamic ///
2107
2108 importJava "java.lang.Object" where
2109     "A data type that can represent any value."
2110     data Dynamic
2111
2112     @private
2113     @JavaName toString
2114     showDynamic :: Dynamic -> String
2115
2116 instance Show Dynamic where
2117     show = showDynamic
2118
2119 "Converts a value to `Dynamic` type."
2120 toDynamic :: a -> Dynamic
2121 toDynamic = Java.unsafeCoerce
2122
2123 "Converts a `Dynamic` value to a required value, or fails if the conversion is not possible."
2124 importJava "org.simantics.scl.compiler.runtime.ValueConversion" where
2125     fromDynamic :: Typeable a => Dynamic -> a
2126
2127 /// Procedures ///
2128
2129 importJava "org.simantics.scl.runtime.procedure.Ref" where
2130     "A mutable reference to a value of type `a`."
2131     data Ref a
2132
2133     "Creates a new reference with the given initial value."
2134     @JavaName "<init>"
2135     ref :: a -> <Proc> (Ref a)
2136
2137     "Returns the current value of the reference."
2138     @JavaName "value"
2139     getRef :: Ref a -> <Proc> a
2140
2141     "Sets a new value for the reference."
2142     @JavaName "<set>value"
2143     (:=) :: Ref a -> a -> <Proc> ()
2144
2145 instance Show (Ref a) where
2146     show _ = "<reference>"
2147
2148 importJava "org.simantics.scl.runtime.reporting.SCLReporting" where
2149     "Prints the given string to the console."
2150     @JavaName "print"
2151     printString :: String -> <Proc> ()
2152     "Prints an error message to the console."
2153     printError :: String -> <Proc> ()
2154     "Reports that certain amount of work has been done for the current task."
2155     didWork :: Double -> <Proc> ()
2156     """
2157     `printingToFile "fileName" expression` executes the `expression` so that all its console prints
2158     are written to the file given as a first parameter.
2159     """
2160     printingToFile :: String -> (<e> a) -> <e> a
2161     """
2162     `printErrorsAsNormalPrints expression` executes the `expression` so that all its error prints
2163     are printed as normal prints. This is useful mainly in testing scripts for checking that the implementations
2164     give proper error messages with invalid inputs.
2165     """
2166     printErrorsAsNormalPrints :: (<e> a) -> <e> a
2167     """
2168     `disablePrintingForCommand expression` executes the `expression` so that it does not print return values.
2169     Errors are printed normally.
2170     """
2171     disablePrintingForCommand :: (<e> a) -> <e> a
2172
2173
2174 importJava "org.simantics.scl.runtime.procedure.Procedures" where
2175     "Returns `True` if the current thread has been interrupted."
2176     isInterrupted :: <Proc> Boolean
2177     "Checks whether the current thread has been interrupted and throws an exception if it is."
2178     checkInterrupted :: <Proc> ()
2179     "Generates a random identifier."
2180     generateUID :: <Proc> String
2181
2182     "Executes the given expression and catches certain class of exceptions (specified by the catch handler that is given as a second parameter.)"
2183     @JavaName catch_
2184     catch :: VecComp ex => (<e> a) -> (ex -> <e> a) -> <e> a
2185
2186 importJava "java.lang.Throwable" where
2187     data Throwable
2188     @private
2189     @JavaName toString
2190     showThrowable :: Throwable -> String
2191 importJava "java.lang.Exception" where
2192     data Exception
2193     @private
2194     @JavaName toString
2195     showException :: Exception -> String
2196
2197 instance Show Throwable where
2198     show = showThrowable
2199 instance Show Exception where
2200     show = showException
2201
2202 "Prints the given value in the console."
2203 @inline
2204 print :: Show a => a -> <Proc> ()
2205 print v = printString (showForPrinting v)
2206 /*
2207 instance Show TypeRep where
2208     sb <+ (TApply (TCon "Builtin" "[]") b) =
2209         sb << "[" <+ b << "]"
2210     sb <+ (TApply (TApply (TCon "Builtin" "(,)") c1) c2) =
2211         sb << "(" <+ c1 << "," <+ c2 << ")"
2212     sb <+ (TApply (TApply (TApply (TCon "Builtin" "(,,)") c1) c2) c3) =
2213         sb << "(" <+ c1 << "," <+ c2 << "," <+ c3 << ")"
2214     sb <+ (TApply (TApply (TApply (TApply (TCon "Builtin" "(,,,)") c1) c2) c3) c4) =
2215         sb << "(" <+ c1 << "," <+ c2 << "," <+ c3 << "," <+ c4 << ")"
2216
2217     sb <+ (TCon _ name) = sb << name
2218     sb <+ (TApply a b) = sb <+ Par 1 a << " " <+ Par 2 b
2219     sb <+ (TFun a b) = sb <+ Par 1 a << " -> " <+ b
2220
2221     precedence (TCon _ _) = 0
2222     precedence (TFun _ _) = 2
2223     precedence (TApply a _) = if isSpecialType a then 0 else 1
2224       where
2225         isSpecialType (TCon "Builtin" "[]") = True
2226         isSpecialType (TCon "Builtin" "()") = True
2227         isSpecialType (TCon "Builtin" "(,)") = True
2228         isSpecialType (TCon "Builtin" "(,,)") = True
2229         isSpecialType (TCon "Builtin" "(,,,)") = True
2230         isSpecialType (TApply a _) = isSpecialType a
2231 */
2232 // Serializable
2233
2234 importJava "org.simantics.databoard.serialization.Serializer" where
2235     data Serializer a
2236
2237     @private
2238     @JavaName "serialize"
2239     serialize_ :: Serializer a -> a -> ByteArray
2240
2241     @private
2242     @JavaName "deserialize"
2243     deserialize_ :: Serializer a -> ByteArray -> a
2244
2245 importJava "org.simantics.databoard.Bindings" where
2246     @private
2247     @JavaName "getSerializer"
2248     serializerOf :: Binding a -> Serializer a
2249
2250     @private
2251     @JavaName toString
2252     bindingToString :: Binding a -> String
2253
2254     @JavaName adapt
2255     adapt_ :: a -> Binding a -> Binding b -> b
2256
2257 adapt :: Serializable a => Serializable b => a -> b
2258 adapt x = adapt_ x binding binding
2259
2260 instance Show (Binding a) where
2261     show = bindingToString
2262
2263 "Serializes a value to a byte array."
2264 serialize :: Serializable a => a -> ByteArray
2265 serialize v = serialize_ (serializerOf binding) v
2266
2267 "Deserializes a value from a byte array."
2268 deserialize :: Serializable a => ByteArray -> a
2269 deserialize ba = deserialize_ (serializerOf binding) ba
2270
2271 // ByteArray
2272
2273 importJava "java.util.Arrays" where
2274     @private
2275     @JavaName toString
2276     byteArrayToString :: ByteArray -> String
2277
2278 instance Show ByteArray where
2279     show = byteArrayToString
2280
2281 importJava "org.simantics.databoard.binding.mutable.Variant" where
2282     // data Variant (in Builtins)
2283     @JavaName getValue
2284     rawVariantValue :: Variant -> a
2285     @JavaName ofInstance
2286     variantOf :: a -> Variant\r
2287     @JavaName "<init>"
2288     variantOfWithBinding :: Binding a -> a -> Variant\r
2289     @JavaName getValue
2290     variantValue_ :: Variant -> Binding a -> a
2291     @JavaName toString
2292     showVariant :: Variant -> String
2293
2294     @JavaName getComponent
2295     variantComponent :: Variant -> ChildReference -> Variant
2296
2297 variantValue :: Serializable a => Variant -> a
2298 variantValue v = variantValue_ v binding
2299
2300 instance Show Variant where
2301     show = showVariant
2302
2303 variantElement :: Serializable a => Variant -> Integer -> a
2304 variantElement v i = variantValue (variantComponent v (indexReference i))
2305
2306 importJava "org.simantics.databoard.accessor.reference.ChildReference" where
2307     data ChildReference
2308
2309     @JavaName compile
2310     compileReference :: [ChildReference] -> ChildReference
2311
2312 importJava "org.simantics.databoard.accessor.reference.IndexReference" where
2313     @JavaName "<init>"
2314     indexReference :: Integer -> ChildReference
2315
2316 importJava "org.simantics.databoard.accessor.reference.KeyReference" where
2317     @JavaName "<init>"
2318     keyReference :: Variant -> ChildReference
2319
2320 importJava "org.simantics.databoard.accessor.reference.NameReference" where
2321     @JavaName "<init>"
2322     nameReference :: String -> ChildReference
2323
2324 importJava "org.simantics.databoard.accessor.reference.LabelReference" where
2325     @JavaName "<init>"
2326     labelReference :: String -> ChildReference
2327
2328 // Type
2329
2330 @private
2331 importJava "org.simantics.scl.compiler.types.Type" where
2332     @JavaName toString
2333     showType :: Type -> String
2334
2335 importJava "org.simantics.scl.compiler.types.Types" where
2336     removeForAll :: Type -> Type
2337
2338 instance Show Type where
2339     show = showType