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