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.Byte" where
 563     @JavaName toString
 564     showByte :: Byte -> String
 565
 566     @JavaName parseByte
 567     readByte :: String -> Byte
 568
 569 instance Eq Byte where
 570     (==) = Java.bcmpeq
 571     (!=) = Java.bcmpne
 572
 573 instance Ord Byte where
 574     (<) = Java.bcmplt
 575     (<=) = Java.bcmple
 576     (>) = Java.bcmpgt
 577     (>=) = Java.bcmpge
 578
 579 instance Additive Byte where
 580     zero = Java.i2b Java.iconst_0
 581     (+) = Java.badd
 582
 583 instance Ring Byte where
 584     neg = Java.bneg
 585     (-) = Java.bsub
 586     one = Java.i2b Java.iconst_1
 587     (*) = Java.bmul
 588     fromInteger = Java.i2b
 589
 590 instance Show Byte where
 591     show = showByte
 592     precedence v = if v >= 0 then 0 else 100
 593
 594 instance Read Byte where
 595     read = readByte
 596
 597
 598 @private
 599 importJava "java.lang.Short" where
 600     @JavaName toString
 601     showShort :: Short -> String
 602
 603     @JavaName parseShort
 604     readShort :: String -> Short
 605
 606 instance Eq Short where
 607     (==) = Java.scmpeq
 608     (!=) = Java.scmpne
 609
 610 instance Ord Short where
 611     (<) = Java.scmplt
 612     (<=) = Java.scmple
 613     (>) = Java.scmpgt
 614     (>=) = Java.scmpge
 615
 616 instance Additive Short where
 617     zero = Java.sconst_0
 618     (+) = Java.sadd
 619
 620 instance Ring Short where
 621     neg = Java.sneg
 622     (-) = Java.ssub
 623     one = Java.sconst_1
 624     (*) = Java.smul
 625     fromInteger = Java.i2s
 626
 627 instance Show Short where
 628     show = showShort
 629     precedence v = if v >= 0 then 0 else 100
 630
 631 instance Read Short where
 632     read = readShort
 633
 634 /// Integer ///
 635
 636 @private
 637 importJava "java.lang.Integer" where
 638     @JavaName toString
 639     showInteger :: Integer -> String
 640
 641     @JavaName parseInt
 642     readInteger :: String -> Integer
 643
 644 instance Eq Integer where
 645     (==) = Java.icmpeq
 646     (!=) = Java.icmpne
 647
 648 instance Ord Integer where
 649     (<) = Java.icmplt
 650     (<=) = Java.icmple
 651     (>) = Java.icmpgt
 652     (>=) = Java.icmpge
 653
 654 instance Hashable Integer where
 655     hashP v x = Java.ixor v (Java.imul x 16777619) // prime for FNV-1 hash
 656
 657 instance Additive Integer where
 658     zero = Java.iconst_0
 659     (+) = Java.iadd
 660
 661 instance Ring Integer where
 662     neg = Java.ineg
 663     (-) = Java.isub
 664     one = Java.iconst_1
 665     (*) = Java.imul
 666     fromInteger x = x
 667
 668 instance OrderedRing Integer where
 669     abs = absInteger
 670     toInteger x = x
 671
 672 instance Integral Integer where
 673     div = Java.idiv
 674     mod = Java.irem
 675
 676 instance Show Integer where
 677     show = showInteger
 678     precedence v = if v >= 0 then 0 else 100
 679
 680 instance Read Integer where
 681     read = readInteger
 682
 683 /// Long ///
 684
 685 @private
 686 importJava "java.lang.Long" where
 687     @JavaName toString
 688     showLong :: Long -> String
 689
 690     @JavaName parseLong
 691     readLong :: String -> Long
 692
 693 instance Eq Long where
 694     (==) = Java.lcmpeq
 695     (!=) = Java.lcmpne
 696
 697 instance Ord Long where
 698     (<) = Java.lcmplt
 699     (<=) = Java.lcmple
 700     (>) = Java.lcmpgt
 701     (>=) = Java.lcmpge
 702
 703 instance Hashable Long where
 704     hashP v x = Java.l2i (Java.lxor v (Java.lushr v 32)) + x*16777619
 705
 706 instance Additive Long where
 707     zero = Java.lconst_0
 708     (+) = Java.ladd
 709
 710 instance Ring Long where
 711     neg = Java.lneg
 712     (-) = Java.lsub
 713     one = Java.lconst_1
 714     (*) = Java.lmul
 715     fromInteger = Java.i2l
 716
 717 instance OrderedRing Long where
 718     abs = absLong
 719     toInteger = Java.l2i
 720
 721 instance Integral Long where
 722     div = Java.ldiv
 723     mod = Java.lrem
 724
 725 instance Show Long where
 726     show = showLong
 727     precedence v = if v >= 0 then 0 else 100
 728
 729 instance Read Long where
 730     read = readLong
 731
 732 /// Float ///
 733
 734 importJava "java.lang.Float" where
 735     @private
 736     @JavaName compare
 737     compareFloat :: Float -> Float -> Integer
 738
 739     @private
 740     @JavaName toString
 741     showFloat :: Float -> String
 742
 743     @private
 744     @JavaName parseFloat
 745     readFloat :: String -> Float
 746
 747     "Converts 32-bit floating point number to a 32-bit integer with the same byte level representation."
 748     floatToIntBits :: Float -> Integer
 749
 750 instance Eq Float where
 751     (==) = Java.fcmpeq
 752     (!=) = Java.fcmpne
 753
 754 instance Ord Float where
 755     compare = compareFloat
 756     (<) = Java.fcmplt
 757     (<=) = Java.fcmple
 758     (>) = Java.fcmpgt
 759     (>=) = Java.fcmpge
 760
 761 instance Hashable Float where
 762     hashP v x = hashP (floatToIntBits v) x
 763
 764 instance Additive Float where
 765     zero = Java.fconst_0
 766     (+) = Java.fadd
 767
 768 instance Ring Float where
 769     neg = Java.fneg
 770     (-) = Java.fsub
 771     one = Java.fconst_1
 772     (*) = Java.fmul
 773     fromInteger = Java.i2f
 774
 775 instance OrderedRing Float where
 776     abs = absFloat
 777     toInteger = Java.f2i
 778
 779 instance Real Float where
 780     (/) = Java.fdiv
 781     x ^ y = Java.d2f (powDouble (Java.f2d x) (Java.f2d y))
 782     pi = fromDouble piDouble
 783     sqrt = Java.d2f . sqrtDouble . Java.f2d
 784     exp = Java.d2f . expDouble . Java.f2d
 785     log = Java.d2f . logDouble . Java.f2d
 786     sin = Java.d2f . sinDouble . Java.f2d
 787     cos = Java.d2f . cosDouble . Java.f2d
 788     tan = Java.d2f . tanDouble . Java.f2d
 789     asin = Java.d2f . asinDouble . Java.f2d
 790     acos = Java.d2f . acosDouble . Java.f2d
 791     atan = Java.d2f . atanDouble . Java.f2d
 792     sinh = Java.d2f . sinhDouble . Java.f2d
 793     cosh = Java.d2f . coshDouble . Java.f2d
 794     tanh = Java.d2f . tanhDouble . Java.f2d
 795     floor = Java.d2f . floorDouble . Java.f2d
 796     ceil = Java.d2f . ceilDouble . Java.f2d
 797     atan2 y x = Java.d2f (atan2Double (Java.f2d y) (Java.f2d x))
 798     round = roundDouble . Java.f2d
 799     fromDouble = Java.d2f
 800     toDouble = Java.f2d
 801
 802 instance Show Float where
 803     show = showFloat
 804     precedence v = if v >= 0 then 0 else 100
 805
 806 instance Read Float where
 807     read = readFloat
 808
 809 /// Double ///
 810
 811 importJava "java.lang.Double" where
 812     @private
 813     @JavaName compare
 814     compareDouble :: Double -> Double -> Integer
 815
 816     @private
 817     @JavaName toString
 818     showDouble :: Double -> String
 819
 820     @private
 821     @JavaName parseDouble
 822     readDouble :: String -> Double
 823
 824     "Converts 64-bit floating point number to a 64-bit integer with the same byte level representation."
 825     doubleToLongBits :: Double -> Long
 826
 827     isFinite :: Double -> Boolean
 828     isNaN :: Double -> Boolean
 829     isInfinite :: Double -> Boolean
 830
 831 instance Eq Double where
 832     (==) = Java.dcmpeq
 833     (!=) = Java.dcmpne
 834
 835 instance Ord Double where
 836     compare = compareDouble
 837     (<) = Java.dcmplt
 838     (<=) = Java.dcmple
 839     (>) = Java.dcmpgt
 840     (>=) = Java.dcmpge
 841
 842 instance Hashable Double where
 843     hashP v x = hashP (doubleToLongBits v) x
 844
 845 instance Additive Double where
 846     zero = Java.dconst_0
 847     (+) = Java.dadd
 848
 849 instance Ring Double where
 850     neg = Java.dneg
 851     (-) = Java.dsub
 852     one = Java.dconst_1
 853     (*) = Java.dmul
 854     fromInteger = Java.i2d
 855
 856 instance OrderedRing Double where
 857     abs = absDouble
 858     toInteger = Java.d2i
 859
 860 instance Real Double where
 861     (/) = Java.ddiv
 862     (^) = powDouble
 863     pi = piDouble
 864     sqrt = sqrtDouble
 865     exp = expDouble
 866     log = logDouble
 867     sin = sinDouble
 868     cos = cosDouble
 869     tan = tanDouble
 870     asin = asinDouble
 871     acos = acosDouble
 872     atan = atanDouble
 873     sinh = sinhDouble
 874     cosh = coshDouble
 875     tanh = tanhDouble
 876     floor = floorDouble
 877     ceil = ceilDouble
 878     atan2 = atan2Double
 879     round = roundDouble
 880     fromDouble x = x
 881     toDouble x = x
 882
 883 instance Show Double where
 884     show = showDouble
 885     precedence v = if v >= 0 then 0 else 100
 886
 887 instance Read Double where
 888     read = readDouble
 889
 890 /// Character ///
 891
 892 importJava "java.lang.Character" where
 893     @JavaName toString
 894     showCharacter :: Character -> String
 895
 896     "Returns true, if the given character is a letter."
 897     isLetter :: Character -> Boolean
 898
 899     "Returns true, if the given character is a digit."
 900     isDigit :: Character -> Boolean
 901
 902 instance Eq Character where
 903     (==) = Java.ccmpeq
 904     (!=) = Java.ccmpne
 905
 906 instance Ord Character where
 907     (<) = Java.ccmplt
 908     (<=) = Java.ccmple
 909     (>) = Java.ccmpgt
 910     (>=) = Java.ccmpge
 911
 912 instance Show Character where
 913     sb <+ c = sb << "'" << showCharacter c << "'"
 914
 915 "Adds a given integer to the character code."
 916 addChar :: Character -> Integer -> Character
 917 addChar = Java.cadd
 918
 919 "Subtracts a given integer from the character code."
 920 subChar :: Character -> Character -> Integer
 921 subChar = Java.csub
 922
 923 /// Functor ///
 924
 925 """
 926 The `Functor` class is used for types that can be mapped over. Instances of `Functor` should satisfy the following laws:
 927
 928     fmap id  ==  id
 929     fmap (f . g)  ==  fmap f . fmap g
 930 """
 931 class Functor f where
 932     "Lifts a pure function to the given functor."
 933     fmap :: (a -> b) -> f a -> f b
 934 /*
 935 class CoFunctor f where
 936     comap :: (a -> b) -> f b -> f a
 937 */
 938 /// Applicative ///
 939 /*
 940 class (Functor f) => Applicative f where
 941     return :: a -> f a
 942     (<*>) :: f (a -> b) -> f a -> f b
 943     (*>) :: f a -> f b -> f b
 944     (<*) :: f a -> f b -> f a
 945
 946     u *> v = pure (const id) <*> u <*> v
 947     u <* v = pure const <*> u <*> v
 948     fmap f x = pure f <*> x
 949 */
 950 /// Monad ///
 951
 952 """
 953 The `Monad` class defines the basic operations over a monad, a concept from a branch of mathematics known as category theory.
 954 From the perspective of a SCL programmer, however, it is best to think of a monad as an abstract datatype of actions.
 955 SCL's `mdo expressions provide a convenient syntax for writing monadic expressions.
 956
 957 Instances of `Monad` should satisfy the following laws:
 958
 959     return a >>= k  ==  k a
 960     m >>= return  ==  m
 961     m >>= (\x -> k x >>= h)  ==  (m >>= k) >>= h
 962     fmap f xs  ==  xs >>= return . f
 963 """
 964 class (Functor m) => Monad m where
 965     "Inject a value into the monadic type."
 966     return :: a -> m a
 967     "Sequentially compose two actions, passing any value produced by the first as an argument to the second."
 968     (>>=) :: m a -> (a -> m b) -> m b
 969     """
 970     The join function is the conventional monad join operator. It removes one level of monadic
 971     structure.
 972
 973     For lists, `join` concatenates a list of lists:
 974
 975         join [[1,2], [3,4]] = [1, 2, 3, 4]
 976     """
 977     join :: m (m a) -> m a
 978     join m = m >>= id
 979
 980 """
 981 Sequentially compose two actions, discarding any value produced by the first, like sequencing operators
 982 (such as the semicolon) in imperative languages."
 983 """
 984 @macro
 985 (>>) :: Monad m => m a -> m b -> m b
 986 a >> b = a >>= (\_ -> b)
 987
 988 "While loop. `while cond body` executes the `body` while the `cond` is true."
 989 @inline
 990 while :: (<e> Boolean) -> (<e> a) -> <e> ()
 991 while cond body = loop ()
 992   where loop _ = if cond
 993                  then do body ; loop ()
 994                  else ()
 995
 996 """
 997 Sequences the given monadic value infinitely:
 998
 999     repeatForever m = m >> m >> m >> ...
1000 """
1001 repeatForever m = m >> repeatForever m
1002
1003 replicateM :: Monad m => Integer -> m a -> m [a]
1004 replicateM count m = loop count emptyList
1005   where
1006     loop count l | count <= 0 = return l
1007                  | otherwise  = mdo
1008                      v <- m
1009                      loop (count-1) (addList l v)
1010
1011 replicateM_ :: Monad m => Integer -> m a -> m ()
1012 replicateM_ count m | count <= 0 = return ()
1013                     | otherwise  = m >> replicateM_ (count-1) m
1014
1015 /// MonadZero ///
1016
1017 """
1018 A class of monads with zero element satisfying
1019
1020     mzero >>= f = mzero
1021 """
1022 class (Monad m) => MonadZero m where
1023     mzero :: m a
1024
1025 "Injects a boolean test to a type beloning to `MonadZero`."
1026 guard :: MonadZero m => Boolean -> m ()
1027 guard True = return ()
1028 guard False = mzero
1029
1030 /// MonadPlus ///
1031
1032 """
1033 A class of monads with associative binary operator `mplus` satisfying the following laws:
1034
1035     mplus mzero b = b
1036     mplus a mzero = a
1037     mplus (mplus a b) c = mplus a (mplus b c)
1038     mplus a b >>= k = mplus (a >>= k) (b >>= k)
1039 """
1040 class (MonadZero m) => MonadPlus m where
1041     mplus :: m a -> m a -> m a
1042
1043 /// MonadOr ///
1044
1045 """
1046 A class of monads with associative binary operator `morelse` satisfying the following laws:
1047
1048     morelse mzero b = b
1049     morelse a mzero = a
1050     morelse (morelse a b) c = morelse a (morelse b c)
1051     morelse (return a) b = return a
1052 """
1053 class (MonadZero m) => MonadOr m where
1054     morelse :: m a -> m a -> m a
1055
1056 /// FunctorE ///
1057
1058 """
1059 A class of types that can be mapped over with effectful mapping functions.
1060 """
1061 class (Functor f) => FunctorE f where
1062     """
1063     Applies the function to all elements of the container and
1064     returns the similarly shaped container with the results:
1065
1066     For lists,
1067
1068         map f [e1, e2, ..., eN] = [f e1, f e2, ..., f eN]
1069
1070     for example
1071
1072         map (*2) [1..5] = [2, 4, 6, 8, 10]
1073     """
1074     map :: (a -> <e> b) -> f a -> <e> (f b)
1075     "Calls the given function with all elements of the given container."
1076     iter :: (a -> <e> b) -> f a -> <e> ()
1077     "Calls the given function with all elements of the given container giving also the index of the element as a parameter."
1078     iterI :: (Integer -> a -> <e> b) -> f a -> <e> ()
1079
1080 "Iterates the elements of the given collection. Same as `iter` but parameters flipped."
1081 for :: FunctorE f => f a -> (a -> <e> b) -> <e> ()
1082 @macro
1083 for l f = iter f l
1084
1085 "Iterates the elements of the given collection providing also the indices of the elements. Same as `iterI` but parameters flipped."
1086 forI :: FunctorE f => f a -> (Integer -> a -> <e> b) -> <e> ()
1087 @macro
1088 forI l f = iterI f l
1089
1090 "`forN n f` calls `f` for all integers `0`, ..., `n-1`"
1091 @inline
1092 forN :: Integer -> (Integer -> <e> b) -> <e> ()
1093 forN n f = loop 0
1094   where
1095     loop i = if i < n
1096              then do f i ; loop (i+1)
1097              else ()
1098
1099 @inline
1100 mapI :: (Integer -> a -> <e> b) -> [a] -> <e> [b]
1101 mapI f l = build (\empty cons -> let
1102     len = length l
1103     loop i accum = if i < len
1104                    then loop (i+1) (cons accum (f i (l!i)))
1105                    else accum
1106   in loop 0 empty)
1107
1108 """
1109 `mapMaybe` combines `map` and `filter` functions.
1110 It applies the given function to every element of the input list. If the result
1111 is `Just x`, then `x` is added to the resulting list.
1112
1113     mapMaybe f lst = [y | x <- lst, Just y = f x]
1114 """
1115 @inline
1116 mapMaybe :: (a -> <e> Maybe b) -> [a] -> <e> [b]
1117 mapMaybe f l = build (\empty cons -> foldl (\cur x -> match f x with Just v -> cons cur v ; _ -> cur) empty l)
1118
1119 """
1120 Applies the given function to all elements of the list. Produces two lists: the first contains all elements `x`
1121 for which the function returned `Left x` and the second list contains all elements `y` for which the function
1122 returned `Right y`.
1123 """
1124 mapEither :: (a -> <e> Either b c) -> [a] -> <e> ([b], [c])
1125 mapEither f list = runProc do
1126     l = newArrayList
1127     r = newArrayList
1128     for list (\x -> match f x with
1129         Left v -> addArrayList l v
1130         Right v -> addArrayList r v)
1131     (Java.unsafeCoerce l, Java.unsafeCoerce r)
1132
1133 /// FunctorM ///
1134
1135 class (Functor f) => FunctorM f where
1136     "`mapM f` is equivalent to `sequence . map f`."
1137     mapM :: Monad m => (a -> m b) -> f a -> m (f b)
1138     "Evaluate each action in the sequence from left to right, and collect the results."
1139     sequence :: Monad m => f (m a) -> m (f a)
1140     mapM f l = sequence (fmap f l)
1141
1142 /// Category ///
1143
1144 "Identity function."
1145 id :: a -> a
1146 id x = x
1147
1148 """
1149 Ignores the given value. This function is used in a situation where a function returns
1150 a value in a context where the value is not expected.
1151 """
1152 @inline
1153 ignore :: a -> ()
1154 ignore _ = ()
1155
1156 @inline
1157 ignoreM :: a -> Maybe b
1158 ignoreM _ = Nothing
1159
1160 """
1161 Composes two functions
1162     (f . g) x = f (g x)
1163 """
1164 (.) :: (b -> <e> c) -> (a -> <e> b) -> (a -> <e> c)
1165 (f . g) x = f (g x)
1166
1167 /// Sequence ///
1168
1169 "A type class for sequences. All sequences must support indexing by integers."
1170 class /*(Additive a) =>*/ Sequence a where
1171     "Length of the sequence"
1172     length :: a -> Integer
1173     "`take n s` returns the first `n` elements of the sequence `s`."
1174     take :: Integer -> a -> a
1175     "`drop n s` removes the first `n` elements of the sequence `s`."
1176     drop :: Integer -> a -> a
1177     """
1178     `sub s begin end` returns a subsequence of `s` starting from
1179     index `begin` and ending just before index `end`.
1180     """
1181     sub :: a -> Integer -> Integer -> a
1182
1183     take n v = sub v 0 (min n (length v))
1184     drop n v = sub v (min n len) len
1185       where
1186         len = length v
1187
1188 instance Sequence [a] where
1189     length = lengthList
1190     sub = subList
1191
1192 instance Sequence String where
1193     length = lengthString
1194     sub = subString
1195
1196 class IndexedSequence f where
1197     "`seq ! i` returns the `i`th element of the sequence `seq`. Indexing starts from zero."
1198     (!) :: f a -> Integer -> a
1199
1200 instance IndexedSequence [] where
1201     (!) = getList
1202
1203 /// Boolean ///
1204
1205 """
1206 Equivalent to the boolean value `True`. The value is meant to be used in
1207 guard patterns:
1208
1209     min a b | a < b     = a
1210             | otherwise = b
1211 """
1212 @inline
1213 otherwise :: Boolean
1214 otherwise = True
1215
1216 instance Eq Boolean where
1217     a == b = if a then b else not b
1218     a != b = if a then not b else b
1219
1220 instance Ord Boolean where
1221     compare False False = 0
1222     compare False True  = neg 1
1223     compare True  False = 1
1224     compare True  True  = 0
1225
1226 instance Show Boolean where
1227     show True = "True"
1228     show False = "False"
1229
1230 """
1231 Boolean conjunction (and). The function is a macro that evaluates the second parameter
1232 only if the first parameter is `True`.
1233
1234 <table>
1235 <tr><th>a</th><th>b</th><th>a && b</th></tr>
1236 <tr><td>True</td><td>True</td><td>True</td></tr>
1237 <tr><td>True</td><td>False</td><td>False</td></tr>
1238 <tr><td>False</td><td>not evaluated</td><td>False</td></tr>
1239 </table>
1240 """
1241 @macro
1242 (&&) :: Boolean -> Boolean ->  Boolean
1243 a && b = if a then b else False
1244
1245 """
1246 Boolean disjunction (or). The function is a macro that evaluates the second parameter
1247 only if the first parameter is `False`.
1248
1249 <table>
1250 <tr><th>a</th><th>b</th><th>a || b</th></tr>
1251 <tr><td>True</td><td>not evaluated</td><td>True</td></tr>
1252 <tr><td>False</td><td>True</td><td>True</td></tr>
1253 <tr><td>False</td><td>False</td><td>False</td></tr>
1254 </table>
1255 """
1256 @macro
1257 (||) :: Boolean -> Boolean -> Boolean
1258 a || b = if a then True else b
1259
1260 "Boolean negation"
1261 @inline
1262 not a = if a then False else True
1263
1264 /// Maybe ///
1265
1266 //data Maybe a = Nothing | Just a
1267
1268 "Given `Just x` this function returns `x`. If the parameter is `Nothing`, the function raises an exception."
1269 fromJust :: Maybe a -> a
1270 fromJust (Just a) = a
1271
1272 deriving instance (Eq a) => Eq (Maybe a)
1273 deriving instance (Ord a) => Ord (Maybe a)
1274 deriving instance (Show a) => Show (Maybe a)
1275 deriving instance (Hashable a) => Hashable (Maybe a)
1276
1277 instance Functor Maybe where
1278     fmap _ Nothing  = Nothing
1279     fmap f (Just x) = Just (f x)
1280
1281 instance FunctorE Maybe where
1282     map _ Nothing  = Nothing
1283     map f (Just x) = Just (f x)
1284
1285     iter _ Nothing = ()
1286     iter f (Just x) = ignore (f x)
1287
1288     iterI _ Nothing = ()
1289     iterI f (Just x) = ignore (f 0 x)
1290
1291 instance Monad Maybe where
1292     return x = Just x
1293
1294     @inline
1295     Nothing >>= _ = Nothing
1296     Just x  >>= f = f x
1297
1298     @inline
1299     join Nothing  = Nothing
1300     join (Just x) = x
1301
1302 instance MonadZero Maybe where
1303     mzero = Nothing
1304
1305 instance MonadOr Maybe where
1306     morelse a@(Just _) _ = a
1307     morelse _ b = b
1308
1309 "`execJust v f` executes the function `f` with parameter value `x`, if `v=Just x`. If `v=Nothing`, the function does nothing."
1310 @inline
1311 execJust :: Maybe a -> (a -> <e> b) -> <e> ()
1312 execJust maybeValue procedure = match maybeValue with
1313     Just v -> ignore $ procedure v
1314     _ -> ()
1315
1316 "`fromMaybe def v` returns `def` if `v=Nothing` and `x` if `v=Just x`."
1317 @inline
1318 fromMaybe :: a -> Maybe a -> a
1319 fromMaybe default maybeValue = match maybeValue with
1320     Just v -> v
1321     _ -> default
1322
1323
1324 """
1325 Provides a default value if the first parameter is Nothing.
1326 The default value is evaluated only if needed. The function
1327 can be used as an operator and is right associative so that
1328 the following is possible:
1329
1330     tryWithTheFirstMethod
1331         `orElse` tryWithTheSecondMethod
1332         `orElse` fail "Didn't succeed."
1333 """
1334 @inline
1335 orElse :: Maybe a -> (<e> a) -> <e> a
1336 orElse (Just x) _   = x
1337 orElse Nothing  def = def
1338
1339 /// Either ///
1340
1341 """
1342 The Either type represents values with two possibilities: a value of type `Either a b` is either `Left a` or `Right b`.
1343
1344 The `Either` type is sometimes used to represent a value which is either correct or an error; by convention, the `Left` constructor
1345 is used to hold an error value and the `Right` constructor is used to hold a correct value (mnemonic: "right" also means "correct").
1346 """
1347 data Either a b = Left a | Right b
1348
1349 deriving instance (Eq a, Eq b) => Eq (Either a b)
1350 deriving instance (Ord a, Ord b) => Ord (Either a b)
1351 deriving instance (Show a, Show b) => Show (Either a b)
1352 deriving instance (Hashable a, Hashable b) => Hashable (Either a b)
1353
1354 instance Functor (Either a) where
1355     fmap _ (Left x)  = Left x
1356     fmap f (Right y) = Right (f y)
1357
1358 instance FunctorE (Either a) where
1359     map _ (Left x)  = Left x
1360     map f (Right y) = Right (f y)
1361
1362     iter _ (Left x) = ()
1363     iter f (Right y) = ignore (f y)
1364
1365     iterI _ (Left x) = ()
1366     iterI f (Right y) = ignore (f 0 y)
1367
1368 instance Monad (Either b) where
1369     return y = Right y
1370
1371     Left x  >>= _ = Left x
1372     Right y >>= f = f y
1373
1374     join (Left x)  = Left x
1375     join (Right y) = y
1376
1377 /// String ///
1378
1379 importJava "java.lang.String" where
1380     @private
1381     @JavaName "concat"
1382     concatString :: String -> String -> String
1383     @private
1384     @JavaName "compareTo"
1385     compareString :: String -> String -> Integer
1386     @private
1387 //    @JavaName "hashCode"
1388 //    hashString :: String -> Integer
1389     @private
1390     @JavaName "equals"
1391     equalsString :: String -> String -> Boolean
1392     @private
1393     @JavaName "length"
1394     lengthString :: String -> Integer
1395
1396     """
1397     `replaceString original pattern replacement` replaces all occurrences of `pattern` in the string by `replacement`.
1398     """
1399     @JavaName replace
1400     replaceString :: String -> String -> String -> String
1401
1402     @private
1403     @JavaName split
1404     splitString_ :: String -> String -> Array String
1405
1406     """
1407     `indexOf string s` finds the first occurrence of `s` from `string` and returns its index.
1408     If the `s` does not occur in the string, return `-1`."
1409     """
1410     @JavaName indexOf
1411     indexOf :: String -> String -> Integer
1412
1413     "Works like `indexOf` but starts searching from the given index instead of the beginning of the string."
1414     @JavaName indexOf
1415     indexOfStartingFrom :: String -> String -> Integer -> Integer
1416
1417     "Works like `indexOf` but returns the index of the last occurrence."
1418     @JavaName lastIndexOf
1419     lastIndexOf :: String -> String -> Integer
1420
1421     "Works like `lastIndexOf` but starts searching from the given index instead of the end of the string."
1422     @JavaName lastIndexOf
1423     lastIndexOfStartingFrom :: String -> String -> Integer -> Integer
1424
1425     @private
1426     @JavaName substring
1427     subString :: String -> Integer -> Integer -> String
1428
1429     """
1430     `regionMatches str1 offset1 str2 offset2 len` tests whether
1431     `sub str1 offset1 (offset1+len) == sub str2 offset2 (offset2+len)`.
1432     """
1433     regionMatches :: String -> Integer -> String -> Integer -> Integer -> Boolean
1434
1435     "`startsWith string prefix` returns true if the string begins with the given prefix."
1436     startsWith :: String -> String -> Boolean
1437
1438     "`endsWith string suffix` returns true if the string ends with the given prefix."
1439     endsWith :: String -> String -> Boolean
1440
1441     "Removes leading and trailing whitespace from the string."
1442     trim :: String -> String
1443
1444     "`contains string s` returns true if `string` contains `s` as a substring."
1445     contains :: String -> String -> Boolean
1446
1447     "`charAt string i` returns the `i`th character of the string."
1448     charAt :: String -> Integer -> Character
1449
1450     "Converts all letters of the string to lower case."
1451     toLowerCase :: String -> String
1452     "Converts all letters of the string to upper case."
1453     toUpperCase :: String -> String
1454
1455     "Creates a string from a vector of characters."
1456     @JavaName "<init>"
1457     string :: Vector Character -> String
1458
1459 instance Eq String where
1460     (==) = equalsString
1461
1462 instance Hashable String where
1463     hashP x v = Java.hashCode x + v*16777619
1464
1465 instance Ord String where
1466     compare = compareString
1467
1468 instance Additive String where
1469     zero = ""
1470     (+) = concatString
1471     sum ss = runProc (StringBuilder.toString $ foldl StringBuilder.appendString StringBuilder.new ss)
1472
1473 @private
1474 importJava "org.simantics.scl.runtime.string.StringEscape" where
1475     appendEscapedString :: StringBuilder.T -> String -> <Proc> StringBuilder.T
1476
1477 instance Show String where
1478     showForPrinting = id
1479     sb <+ v = (appendEscapedString (sb << "\"") v) << "\""
1480
1481 instance Read String where
1482     read str = str
1483
1484 "`splitString text pattern` splits the string into a list of string where the parts are sepratated in the original list by the given pattern."
1485 splitString :: String -> String -> [String]
1486 splitString source pattern = arrayToList $ splitString_ source pattern
1487
1488 split :: String -> String -> [String]
1489 split pattern text = arrayToList $ splitString_ text pattern
1490
1491 /// Tuple0 ///
1492
1493 instance Eq () where
1494     () == () = True
1495
1496 instance Ord () where
1497     compare () () = 0
1498
1499 instance Hashable () where
1500     hashP () x = x
1501
1502 instance Additive () where
1503     zero = ()
1504     () + () = ()
1505
1506 instance Show () where
1507     show () = "()"
1508
1509 /// Tuple2 ///
1510
1511 "Gives the first element of a pair."
1512 @inline
1513 fst :: (a,b) -> a
1514 fst (x,y) = x
1515
1516 "Gives the second element of a pair."
1517 @inline
1518 snd :: (a,b) -> b
1519 snd (x,y) = y
1520
1521 instance (Eq a, Eq b) => Eq (a, b) where
1522     (a0, b0) == (a1, b1) = a0 == a1 && b0 == b1
1523
1524 instance (Ord a, Ord b) => Ord (a, b) where
1525     compare (a0, b0) (a1, b1) = compare a0 a1 &<& compare b0 b1
1526
1527 instance (Hashable a, Hashable b) => Hashable (a, b) where
1528     hashP (a,b) x = hashP b $ hashP a x
1529
1530 instance (Additive a, Additive b) => Additive (a, b) where
1531     zero = (zero, zero)
1532     (a0, b0) + (a1, b1) = (a0+a1, b0+b1)
1533
1534 instance Functor ((,) a) where
1535     fmap f (a,b) = (a, f b)
1536
1537 instance (Show a, Show b) => Show (a, b) where
1538     sb <+ (x, y) = sb << "(" <+ x << ", " <+ y << ")"
1539
1540 /// Tuple3 ///
1541
1542 instance (Eq a, Eq b, Eq c) => Eq (a, b, c) where
1543     (a0, b0, c0) == (a1, b1, c1) = a0 == a1 && b0 == b1 && c0 == c1
1544
1545 instance (Ord a, Ord b, Ord c) => Ord (a, b, c) where
1546     compare (a0, b0, c0) (a1, b1, c1) = compare a0 a1 &<& compare b0 b1 &<& compare c0 c1
1547
1548 instance (Hashable a, Hashable b, Hashable c) => Hashable (a, b, c) where
1549     hashP (a,b,c) x = hashP c $ hashP b $ hashP a x
1550
1551 instance (Additive a, Additive b, Additive c) => Additive (a, b, c) where
1552     zero = (zero, zero, zero)
1553     (a0, b0, c0) + (a1, b1, c1) = (a0+a1, b0+b1, c0+c1)
1554
1555 instance Functor ((,,) a b) where
1556     fmap f (a,b,c) = (a, b, f c)
1557
1558 instance (Show a, Show b, Show c) => Show (a, b, c) where
1559     sb <+ (x, y, z) = sb << "(" <+ x << ", " <+ y << ", " <+ z << ")"
1560
1561 /// Tuple4 ///
1562
1563 instance (Eq a, Eq b, Eq c, Eq d) => Eq (a, b, c, d) where
1564     (a0, b0, c0, d0) == (a1, b1, c1, d1) = a0 == a1 && b0 == b1 && c0 == c1 && d0 == d1
1565
1566 instance (Ord a, Ord b, Ord c, Ord d) => Ord (a, b, c, d) where
1567     compare (a0, b0, c0, d0) (a1, b1, c1, d1) =
1568         compare a0 a1 &<& compare b0 b1 &<& compare c0 c1 &<& compare d0 d1
1569
1570 instance (Hashable a, Hashable b, Hashable c, Hashable d) => Hashable (a, b, c, d) where
1571     hashP (a,b,c,d) x = hashP d $ hashP c $ hashP b $ hashP a x
1572
1573 instance (Additive a, Additive b, Additive c, Additive d) => Additive (a, b, c, d) where
1574     zero = (zero, zero, zero, zero)
1575     (a0, b0, c0, d0) + (a1, b1, c1, d1) = (a0+a1, b0+b1, c0+c1, d0+d1)
1576
1577 instance Functor ((,,,) a b c) where
1578     fmap f (a,b,c,d) = (a, b, c, f d)
1579
1580 instance (Show a, Show b, Show c, Show d) => Show (a, b, c, d) where
1581     sb <+ (x, y, z, w) = sb << "(" <+ x << ", " <+ y << ", " <+ z << ", " <+ w << ")"
1582
1583 /// Tuple5 ///
1584
1585 instance (Eq a, Eq b, Eq c, Eq d, Eq e) => Eq (a, b, c, d, e) where
1586     (a0, b0, c0, d0, e0) == (a1, b1, c1, d1, e1) =
1587         a0 == a1 && b0 == b1 && c0 == c1 && d0 == d1 && e0 == e1
1588
1589 instance (Ord a, Ord b, Ord c, Ord d, Ord e) => Ord (a, b, c, d, e) where
1590     compare (a0, b0, c0, d0, e0) (a1, b1, c1, d1, e1) =
1591         compare a0 a1 &<& compare b0 b1 &<& compare c0 c1 &<& compare d0 d1 &<& compare e0 e1
1592
1593 instance (Hashable a, Hashable b, Hashable c, Hashable d, Hashable e)
1594        => Hashable (a, b, c, d, e) where
1595     hashP (a,b,c,d,e) x = hashP e $ hashP d $ hashP c $ hashP b $ hashP a x
1596
1597 instance (Additive a, Additive b, Additive c, Additive d, Additive e) => Additive (a, b, c, d, e) where
1598     zero = (zero, zero, zero, zero, zero)
1599     (a0, b0, c0, d0, e0) + (a1, b1, c1, d1, e1) = (a0+a1, b0+b1, c0+c1, d0+d1, e0+e1)
1600
1601 instance Functor ((,,,,) a b c d) where
1602     fmap f (a,b,c,d,e) = (a, b, c, d, f e)
1603
1604 /// Lists ///
1605
1606 instance (Eq a) => Eq [a] where
1607     a == b = lA == lB && loop 0
1608       where
1609         lA = length a
1610         lB = length b
1611         loop i = i>=lA || (a!i == b!i && loop (i+1))
1612
1613 instance (Ord a) => Ord [a] where
1614     compare a b = loop 0
1615       where
1616         lA = length a
1617         lB = length b
1618         loop i = if i >= lA
1619                  then (if i >= lB then 0 else -1)
1620                  else if i >= lB
1621                  then 1
1622                  else compare (a!i) (b!i) &<& loop (i+1)
1623
1624 instance (Hashable a) => Hashable [a] where
1625     hashP a x = loop 0 x
1626       where
1627         lA = length a
1628         loop i x = if i == lA
1629                    then x
1630                    else loop (i+1) (hashP (a!i) x)
1631
1632 instance Functor [] where
1633     fmap = mapList
1634
1635 instance FunctorE [] where
1636     map = mapEList
1637     iter = iterList
1638     iterI = iterIList
1639
1640 instance Monad [] where
1641     return x = singletonList x
1642     l >>= f  = concatMap f l
1643     join l   = l >>= id
1644
1645 instance MonadZero [] where
1646     mzero = emptyList
1647
1648 instance MonadPlus [] where
1649     mplus = appendList
1650
1651 instance Additive [a] where
1652     zero = emptyList
1653     (+) = appendList
1654
1655 instance FunctorM [] where
1656     sequence = foldl (\m mel -> m >>= \l -> mel >>= \el -> return (addList l el)) (return emptyList)
1657     mapM f l = sequence (map f l)
1658
1659 "Appends the string representations of all elements of the list to the string builder and separates the values with the given separator."
1660 printWithSeparator :: Show a => StringBuilder.T -> String -> [a] -> <Proc> StringBuilder.T
1661 printWithSeparator sb sep l = loop 0
1662   where
1663     len = length l
1664     loop i = if i >= len then sb
1665              else do
1666                  (if i==0 then sb else sb << sep) <+ l!i
1667                  loop (i+1)
1668
1669 "Joins the string representations of the list of values with the given separator."
1670 joinWithSeparator :: Show a => String -> [a] -> String
1671 joinWithSeparator separator values = runProc (
1672     StringBuilder.toString $ printWithSeparator StringBuilder.new separator values)
1673
1674 instance (Show a) => Show [a] where
1675     sb <+ l = do
1676         len = length l
1677         loop i = if i < len
1678                  then do
1679                      if (i>0) then sb << ", " else sb
1680                      sb <+ l!i
1681                      loop (i+1)
1682                  else sb << "]"
1683         sb << "["
1684         loop 0
1685
1686 importJava "java.util.List" where
1687     "`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."
1688     @JavaName get
1689     getList :: [a] -> Integer -> a
1690
1691     @private
1692     @JavaName size
1693     lengthList :: [a] -> Integer
1694
1695     @private
1696     subList :: [a] -> Integer -> Integer -> [a]
1697
1698     @private
1699     isEmpty :: [a] -> Boolean
1700
1701 @private
1702 importJava "java.util.Collections" where
1703     emptyList :: [a]
1704     //singletonList :: a -> [a]
1705
1706 /*
1707 @inline
1708 emptyList :: [a]
1709 emptyList = build (\empty cons -> empty)
1710 */
1711
1712 "Creates a list with exectly one element."
1713 @inline
1714 singletonList :: a -> [a]
1715 singletonList v = build (\empty cons -> cons empty v)
1716
1717 /*
1718 // foldl f i (a + b) = foldl f (foldl f i a) b
1719
1720 appendList :: [a] -> [a] -> [a]
1721 appendList a b = build (\empty cons -> foldl cons (foldl cons empty a) b)
1722 */
1723
1724 importJava "org.simantics.scl.runtime.list.ShareableList" where
1725     "Concatenates two lists."
1726     @private
1727     @JavaName "concat"
1728     appendList :: [a] -> [a] -> [a]
1729
1730     "Adds the given value to the end of the list."
1731     @JavaName "add"
1732     addList :: [a] -> a -> [a]
1733
1734 @private
1735 importJava "java.util.ArrayList" where
1736     data ArrayList a
1737
1738     @JavaName "<init>"
1739     newArrayList :: <Proc> ArrayList a
1740
1741     @JavaName add
1742     addArrayList :: ArrayList a -> a -> <Proc> ()
1743
1744 """
1745 A primitive for constructing a list by `empty` and `cons` operations given to the function given as a parameter to this function.
1746 For example:
1747
1748     build (\empty cons -> cons (cons (cons empty 1) 2) 3)
1749
1750 produces
1751
1752     [1, 2, 3]
1753
1754 The SCL compiler makes the following optimization when encountering `build` and `foldl` functions after inlining:
1755
1756     foldl f i (build g) = g i f
1757 """
1758 @inline 2
1759 build :: forall b e2. (forall a e1. a -> (a -> b -> <e1> a) -> <e1,e2> a) -> <e2> [b]
1760 build f = runProc do
1761     l = newArrayList
1762     f () (\_ v -> addArrayList l v)
1763     Java.unsafeCoerce l
1764
1765 "A specific implementation of `map` for lists."
1766 @private
1767 @inline
1768 mapEList :: (a -> <e> b) -> [a] -> <e> [b]
1769 mapEList f l = build (\empty cons -> foldl (\cur x -> cons cur (f x)) empty l)
1770
1771 "A specific implementation of `fmap` for lists."
1772 @inline
1773 mapList :: (a -> b) -> [a] -> [b]
1774 mapList f l = build (\empty cons -> foldl (\cur x -> cons cur (f x)) empty l)
1775
1776 "`guardList v` returns a singleton `[()]` if `v=True` and the empty list if `v=False`."
1777 @inline
1778 guardList :: Boolean -> [()]
1779 guardList cond = build (\empty cons -> if cond then cons empty () else empty)
1780
1781 """
1782 `concatMap` combines `map` and `join` functions.
1783 It maps the elements of a given list to lists with the given function and concatenates the results.
1784
1785     concatMap f lst = join (map f lst) = [y | x <- lst, y <- f x]
1786 """
1787 @inline
1788 concatMap :: (a -> <e> [b]) -> [a] -> <e> [b]
1789 concatMap f l = build (\empty cons -> foldl (\cur le -> foldl cons cur (f le)) empty l)
1790
1791 """
1792 Applies the given function to the elements of the lists until the function returns something
1793 else than `Nothing`. This return value is also returned as a result of this function.
1794 """
1795 @inline
1796 mapFirst :: (a -> <e> Maybe b) -> [a] -> <e> Maybe b
1797 mapFirst f l = loop 0
1798   where
1799     len = length l
1800     loop i = if i == len
1801              then Nothing
1802              else match f (l!i) with
1803                  r @ (Just _) -> r
1804                  Nothing -> loop (i+1)
1805
1806 """
1807     foldl op initialValue list
1808
1809 applies a binary operator `op` to all elements of `list` from left to right
1810 starting with `initialValue`. For example,
1811
1812     foldl op init [x1, x2, x3, x4] = (((init `op` x1) `op` x2) `op` x3) `op` x4
1813 """
1814 @inline 2
1815 foldl :: forall a b e. (a -> b -> <e> a) -> a -> [b] -> <e> a
1816 foldl f initial l = loop initial 0
1817   where
1818     len = length l
1819     loop cur i = if i==len
1820                  then cur
1821                  else loop (f cur (l!i)) (i+1)
1822
1823 foldlI :: forall a b e. (Integer -> a -> b -> <e> a) -> a -> [b] -> <e> a
1824 foldlI f initial l = loop initial 0
1825   where
1826     len = length l
1827     loop cur i = if i==len
1828                  then cur
1829                  else loop (f i cur (l!i)) (i+1)
1830
1831 scanl :: (b -> a -> <e> b) -> b -> [a] -> <e> [b]
1832 scanl f initial l = build (\empty cons -> let
1833     len = length l
1834     loop cur i accum = let nl = cons accum cur
1835                            in if i==len
1836                            then nl
1837                             else loop (f cur (l!i)) (i+1) nl
1838   in loop initial 0 empty)
1839
1840 "`foldr` is defined like `foldl` but it process the list from right to left."
1841 @inline
1842 foldr :: (b -> a -> <e> a) -> a -> [b] -> <e> a
1843 foldr f initial l = loop initial (length l - 1)
1844   where
1845     loop cur i = if i < 0
1846                  then cur
1847                  else loop (f (l!i) cur) (i-1)
1848
1849 foldr1 :: (a -> a -> <e> a) -> [a] -> <e> a
1850 foldr1 f l = loop (l!(len-1)) (len-2)
1851   where
1852     len = length l
1853     loop cur i = if i < 0
1854                  then cur
1855                  else loop (f (l!i) cur) (i-1)
1856
1857 """
1858 `filter pred lst` returns those elements of `lst` that the predicate `pred` accepts. For example
1859
1860     filter (> 3) [1, 2, 3, 4, 5, 6] = [4, 5, 6]
1861 """
1862 @inline
1863 filter :: (a -> <e> Boolean) -> [a] -> <e> [a]
1864 filter p l = build (\empty cons -> foldl (\cur x -> if p x then cons cur x else cur) empty l)
1865
1866 """
1867 Takes those elements of the input list that match `(Just x)` and adds the contents to the resulting list. For example,
1868
1869     filterJust [Just 1, Nothing, Just 5] = [1, 5]
1870 """
1871 @inline
1872 filterJust :: [Maybe a] -> [a]
1873 filterJust l = build (\empty cons -> foldl (\cur x -> match x with Just v -> cons cur v ; _ -> cur) empty l)
1874
1875 listToMaybe :: [a] -> Maybe a
1876 listToMaybe l = if isEmpty l then Nothing else Just (l!0)
1877
1878 maybeToList :: Maybe a -> [a]
1879 maybeToList (Just a) = [a]
1880 maybeToList _ = []
1881
1882 partition :: (a -> <e> Boolean) -> [a] -> <e> ([a], [a])
1883 partition p l = runProc do
1884     res1 = newArrayList
1885     res2 = newArrayList
1886     for l (\el ->
1887         if p el
1888         then addArrayList res1 el
1889         else addArrayList res2 el
1890     )
1891     (Java.unsafeCoerce res1, Java.unsafeCoerce res2)
1892
1893 """
1894 `range begin end` produces a list of consecutive integers starting from `begin` and ending to `end` (including `end`).
1895 The compiler supports syntactic sugar `[begin..end]` for this function.
1896 """
1897 @inline
1898 range :: Integer -> Integer -> [Integer]
1899 range first last = build (\empty cons -> do
1900     loop i cur = if i > last then cur else loop (i+1) (cons cur i)
1901     loop first empty)
1902
1903 "A specific implementation of `iter` for lists."
1904 @inline
1905 iterList :: (a -> <e> b) -> [a] -> <e> ()
1906 iterList f l = foldl (\_ x -> ignore (f x)) () l
1907
1908 "A specific implementation of `iterI` for lists."
1909 @inline
1910 iterIList :: (Integer -> a -> <e> b) -> [a] -> <e> ()
1911 iterIList f l = do foldl (\i x -> do f i x ; i+1) 0 l ; ()
1912
1913 """
1914 Generates a list from a given starting state and iteration function.
1915 For example
1916
1917     let nextState 0 = Nothing
1918         nextState i = Just (i, i `div` 2)
1919     in  unfoldr nextState 30
1920
1921 produces
1922
1923     [30, 15, 7, 3, 1]
1924 """
1925 @inline
1926 unfoldr :: (b -> <e> Maybe (a, b)) -> b -> <e> [a]
1927 unfoldr f s = build (\empty cons -> do
1928     loop s cur =
1929         match f s with
1930             Just (el,newS) -> loop newS (cons cur el)
1931             _ -> cur
1932     loop s empty)
1933
1934 importJava "org.simantics.scl.runtime.Lists" where
1935     /*
1936     @private
1937     @JavaName map
1938     mapList :: (a -> b) -> [a] -> [b]
1939     @private
1940     @JavaName map
1941     mapEList :: (a -> <e> b) -> [a] -> <e> [b]
1942     @private
1943     @JavaName iter
1944     iterList :: (a -> <e> ()) -> [a] -> <e> ()
1945     concatMap :: (a -> <e> [b]) -> [a] -> <e> [b]
1946     */
1947     """
1948     Combines two lists into one list of pairs. The length of the resulting list is the length of the smallest input list.
1949
1950         zip [1, 2, 3, 4, 5] ['a', 'b', 'c'] = [(1, 'a'), (2, 'b'), (3, 'c')]
1951     """
1952     zip :: [a] -> [b] -> [(a,b)]
1953     "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."
1954     zipWith :: (a -> b -> <e> c) -> [a] -> [b] -> <e> [c]
1955     """
1956     Produces two lists from one list of pairs.
1957
1958         unzip [(1, 'a'), (2, 'b'), (3, 'c')] = ([1, 2, 3], ['a', 'b', 'c'])
1959     """
1960     unzip :: [(a,b)] -> ([a],[b])
1961
1962     //"@filter p l@ returns those elements of @l@ that the predicate @p@ accepts."
1963     //filter :: (a -> <e> Boolean) -> [a] -> <e> [a]
1964     //filterJust :: [Maybe a] -> [a]
1965     /*
1966     foldl :: (a -> b -> <e> a) -> a -> [b] -> <e> a
1967     */
1968     "Like `foldl` but assumes that the list is non-empty so the initial is not needed."
1969     foldl1 :: (a -> a -> <e> a) -> [a] -> <e> a
1970     //unfoldr :: (b -> <e> Maybe (a, b)) -> b -> <e> [a]
1971
1972     "Sorts the list using the given comparator."
1973     sortWith :: (a -> a -> <e> Integer) -> [a] -> <e> [a]
1974     "Works like `index` but uses the given functions as hash codes and equality."
1975     indexWith :: (a -> Integer) -> (a -> a -> Boolean) -> [(a,b)] -> a -> Maybe b
1976     groupWith :: (b -> Integer) -> (b -> b -> Boolean) -> (a -> <e> b) -> (a -> <e> c) -> [a] -> <e> [(b, [c])]
1977     "Works like `unique` but uses the given function for equality tests."
1978     uniqueWith :: (a -> a -> Boolean) -> [a] -> [a]
1979     "Works like `\\\\` but uses the given function for equality tests."
1980     deleteAllBy :: (a -> a -> Boolean) -> [a] -> [a] -> [a]
1981
1982     //range :: Integer -> Integer -> [Integer]
1983
1984     //build :: (forall a. a -> (a -> b -> <e> a) -> <e> a) -> <e> [b]
1985
1986 "`elem el lst` return true, if `el` occurs in the list `lst`."
1987 elem :: Eq a => a -> [a] -> Boolean
1988 elem el l = loop 0
1989   where
1990     len = length l
1991     loop i | i < len = if el == l!i
1992                        then True
1993                        else loop (i+1)
1994            | otherwise = False
1995
1996 "`elemMaybe v1 (Just v2)` returns true if `v1 == v2`. `elemMaybe v1 Nothing` is always false."
1997 elemMaybe :: Eq a => a -> Maybe a -> Boolean
1998 elemMaybe el m = match m with
1999     Just el2 -> el == el2
2000     Nothing -> False
2001
2002 """
2003 Computes a list that contains only elements that belongs to both input lists.
2004 """
2005 intersect :: Eq a => [a] -> [a] -> [a]
2006 intersect a b = filter f a
2007   where
2008     f e = elem e b
2009
2010 "Reverses a given list. For example, `reverse [1,2,3] = [3,2,1]`"
2011 reverse :: [a] -> [a]
2012 reverse l = [l!(len-i) | i <- [1..len]]
2013   where
2014     len = length l
2015
2016 """
2017 Transposes the rows and columns of its argument. For example,
2018
2019     transpose [[1,2,3],[4,5,6]] == [[1,4],[2,5],[3,6]]
2020     transpose [[1,2],[3,4,5]] == [[1,3],[2,4],[5]]
2021 """
2022 transpose xss = [[xs!i | xs <- xss, i < length xs]
2023                 | i <- [0..maximum [length xs | xs <- xss]-1]]
2024
2025 "Works like `unfoldr` but generates the list from right to left."
2026 unfoldl :: (b -> <e> Maybe (a, b)) -> b -> <e> [a]
2027 unfoldl f seed = reverse $ unfoldr f seed
2028
2029 "Removes the first element of the list, if the list is non-empty."
2030 tail :: [a] -> [a]
2031 tail l = if len < 2 then emptyList else subList l 1 len
2032   where
2033     len = length l
2034
2035 "Tries to find the given key from the list of key-value pairs and returns the corresponding value."
2036 lookup :: Eq a => a -> [(a, b)] -> Maybe b
2037 lookup el l = do
2038     len = length l
2039     loop i = if i < len
2040              then match l!i with
2041                (a,b) | a == el   -> Just b
2042                      | otherwise -> loop (i+1)
2043              else Nothing
2044     loop 0
2045
2046 "Conjunction over a list."
2047 @inline
2048 and :: [Boolean] -> Boolean
2049 and = foldl (&&) True
2050
2051 "Disjunction over a list."
2052 @inline
2053 or :: [Boolean] -> Boolean
2054 or  = foldl (||) False
2055
2056 """
2057 `any pred lst` tests whether the predicate `pred` holds some element of `lst`.
2058 It returns immediately when it encounters the first value satisfying the predicate.
2059 """
2060 any :: (a -> <e> Boolean) -> [a] -> <e> Boolean
2061 any p =  or . map p
2062
2063 """
2064 `all pred lst` tests whether the predicate `pred` holds for all elements of `lst`.
2065 It returns immediately when it encounters the first value not satisfying the predicate.
2066 """
2067 all :: (a -> <e> Boolean) -> [a] -> <e> Boolean
2068 all p =  and . map p
2069
2070 """
2071 Returns the first element of the list satisfying the given condition,
2072 or `Nothing` if there is no such element.
2073 """
2074 findFirst :: (a -> <e> Boolean) -> [a] -> <e> Maybe a
2075 findFirst p l = loop 0
2076   where
2077     len = length l
2078     loop i = if i < len
2079              then let el = l!i in
2080                   if p el
2081                   then Just el
2082                   else loop (i+1)
2083              else Nothing
2084     loop 0
2085
2086
2087 """
2088 Sorts the given list using its default order.
2089 """
2090 @inline
2091 sort :: Ord a => [a] -> [a]
2092 sort = sortWith compare
2093
2094 """
2095 Sorts the lists by the values computed by the first function.
2096 For example
2097
2098     sortBy snd [(1,5), (2,3), (3,4)] = [(2,3), (3,4), (1,5)]
2099 """
2100 @inline
2101 sortBy :: Ord b => (a -> <e> b) -> [a] -> <e> [a]
2102 sortBy f l = sortWith (\x y -> compare (f x) (f y)) l
2103 // This is faster if f is slow, but will generate more auxiliary structures
2104 //sortBy f l = map snd (sortWith (\(x,_) (y,_) -> compare x y) [(f x, x) | x <- l])
2105
2106 """
2107 Given a list of key-value pairs, the function produces a function that finds a value
2108 efficiently for the given key.
2109 """
2110 index :: Hashable a => [(a,b)] -> a -> Maybe b
2111 index = indexWith hash (==)
2112
2113 """
2114 Given a list of values and a function computing a key for each value, the function produces a function that finds a value
2115 effeciently for the given key.
2116 """
2117 indexBy :: Hashable b => (a -> b) -> [a] -> b -> Maybe a
2118 indexBy f l = index [(f x, x) | x <- l]
2119
2120 "Groups a list values by a key computed by the given function."
2121 groupBy :: Hashable b => (a -> <e> b) -> [a] -> <e> [(b, [a])]
2122 groupBy f l = groupWith hash (==) f id l
2123
2124 "Groups a list of key-value pairs by the keys."
2125 group :: Hashable a => [(a,b)] -> [(a, [b])]
2126 group = groupWith hash (==) fst snd
2127
2128 "Removes duplicates (all but the first occurrence) from the list but otherwise preserves the order of the elements."
2129 unique :: Eq a => [a] -> [a]
2130 unique = uniqueWith (==)
2131
2132 "Like `unique`, but uses the given function for finding the key values used for uniqueness testing."
2133 uniqueBy :: Eq b => (a -> b) -> [a] -> [a]
2134 uniqueBy f = uniqueWith (\a b -> f a == f b)
2135
2136 //sortAndUniqueBy :: Ord b => (a -> b) -> [a] -> [a]
2137 //sortAndUniqueBy f = map snd . uniqueWith (\a b -> fst a == fst b) . sortBy fst . map (\x -> (f x, x))
2138
2139 "`a \\\\ b` removes all elements of `b` from the list `a`."
2140 (\\) :: Eq a => [a] -> [a] -> [a]
2141 (\\) = deleteAllBy (==)
2142
2143 /// Dynamic ///
2144
2145 importJava "java.lang.Object" where
2146     "A data type that can represent any value."
2147     data Dynamic
2148
2149     @private
2150     @JavaName toString
2151     showDynamic :: Dynamic -> String
2152
2153 instance Show Dynamic where
2154     show = showDynamic
2155
2156 "Converts a value to `Dynamic` type."
2157 toDynamic :: a -> Dynamic
2158 toDynamic = Java.unsafeCoerce
2159
2160 "Converts a `Dynamic` value to a required value, or fails if the conversion is not possible."
2161 importJava "org.simantics.scl.compiler.runtime.ValueConversion" where
2162     fromDynamic :: Typeable a => Dynamic -> a
2163
2164 /// Procedures ///
2165
2166 importJava "org.simantics.scl.runtime.procedure.Ref" where
2167     "A mutable reference to a value of type `a`."
2168     data Ref a
2169
2170     "Creates a new reference with the given initial value."
2171     @JavaName "<init>"
2172     ref :: a -> <Proc> (Ref a)
2173
2174     "Returns the current value of the reference."
2175     @JavaName "value"
2176     getRef :: Ref a -> <Proc> a
2177
2178     "Sets a new value for the reference."
2179     @JavaName "<set>value"
2180     (:=) :: Ref a -> a -> <Proc> ()
2181
2182 instance Show (Ref a) where
2183     show _ = "<reference>"
2184
2185 importJava "org.simantics.scl.runtime.reporting.SCLReporting" where
2186     "Prints the given string to the console."
2187     @JavaName "print"
2188     printString :: String -> <Proc> ()
2189     "Prints an error message to the console."
2190     printError :: String -> <Proc> ()
2191     "Reports that certain amount of work has been done for the current task."
2192     didWork :: Double -> <Proc> ()
2193     """
2194     `printingToFile "fileName" expression` executes the `expression` so that all its console prints
2195     are written to the file given as a first parameter.
2196     """
2197     printingToFile :: String -> (<e> a) -> <e> a
2198     """
2199     `printErrorsAsNormalPrints expression` executes the `expression` so that all its error prints
2200     are printed as normal prints. This is useful mainly in testing scripts for checking that the implementations
2201     give proper error messages with invalid inputs.
2202     """
2203     printErrorsAsNormalPrints :: (<e> a) -> <e> a
2204     """
2205     `disablePrintingForCommand expression` executes the `expression` so that it does not print return values.
2206     Errors are printed normally.
2207     """
2208     disablePrintingForCommand :: (<e> a) -> <e> a
2209
2210
2211 importJava "org.simantics.scl.runtime.procedure.Procedures" where
2212     "Returns `True` if the current thread has been interrupted."
2213     isInterrupted :: <Proc> Boolean
2214     "Checks whether the current thread has been interrupted and throws an exception if it is."
2215     checkInterrupted :: <Proc> ()
2216     "Generates a random identifier."
2217     generateUID :: <Proc> String
2218
2219     "Executes the given expression and catches certain class of exceptions (specified by the catch handler that is given as a second parameter.)"
2220     @JavaName catch_
2221     catch :: VecComp ex => (<e> a) -> (ex -> <e> a) -> <e> a
2222
2223 importJava "java.lang.Throwable" where
2224     data Throwable
2225     @private
2226     @JavaName toString
2227     showThrowable :: Throwable -> String
2228 importJava "java.lang.Exception" where
2229     data Exception
2230     @private
2231     @JavaName toString
2232     showException :: Exception -> String
2233
2234 instance Show Throwable where
2235     show = showThrowable
2236 instance Show Exception where
2237     show = showException
2238
2239 "Prints the given value in the console."
2240 @inline
2241 print :: Show a => a -> <Proc> ()
2242 print v = printString (showForPrinting v)
2243 /*
2244 instance Show TypeRep where
2245     sb <+ (TApply (TCon "Builtin" "[]") b) =
2246         sb << "[" <+ b << "]"
2247     sb <+ (TApply (TApply (TCon "Builtin" "(,)") c1) c2) =
2248         sb << "(" <+ c1 << "," <+ c2 << ")"
2249     sb <+ (TApply (TApply (TApply (TCon "Builtin" "(,,)") c1) c2) c3) =
2250         sb << "(" <+ c1 << "," <+ c2 << "," <+ c3 << ")"
2251     sb <+ (TApply (TApply (TApply (TApply (TCon "Builtin" "(,,,)") c1) c2) c3) c4) =
2252         sb << "(" <+ c1 << "," <+ c2 << "," <+ c3 << "," <+ c4 << ")"
2253
2254     sb <+ (TCon _ name) = sb << name
2255     sb <+ (TApply a b) = sb <+ Par 1 a << " " <+ Par 2 b
2256     sb <+ (TFun a b) = sb <+ Par 1 a << " -> " <+ b
2257
2258     precedence (TCon _ _) = 0
2259     precedence (TFun _ _) = 2
2260     precedence (TApply a _) = if isSpecialType a then 0 else 1
2261       where
2262         isSpecialType (TCon "Builtin" "[]") = True
2263         isSpecialType (TCon "Builtin" "()") = True
2264         isSpecialType (TCon "Builtin" "(,)") = True
2265         isSpecialType (TCon "Builtin" "(,,)") = True
2266         isSpecialType (TCon "Builtin" "(,,,)") = True
2267         isSpecialType (TApply a _) = isSpecialType a
2268 */
2269
2270 // ByteArray
2271
2272 importJava "java.util.Arrays" where
2273     @private
2274     @JavaName toString
2275     byteArrayToString :: ByteArray -> String
2276
2277 instance Show ByteArray where
2278     show = byteArrayToString
2279
2280 // Type
2281
2282 @private
2283 importJava "org.simantics.scl.compiler.types.Type" where
2284     @JavaName toString
2285     showType :: Type -> String
2286
2287 importJava "org.simantics.scl.compiler.types.Types" where
2288     removeForAll :: Type -> Type
2289
2290 instance Show Type where
2291     show = showType