1 # coding: utf-8
2 # frozen_string_literal: true
3
4 module Umu
5
6 module Commander
7
8 module Prelude
9
10 FILE_NAME = '<prelude>'
11
12 START_LINE_NUM = __LINE__ + 2
13
14 SOURCE_TEXT = <<'___EOS___'
15 ######################################
16 ######## Umu Standard Library ########
17 ######################################
18
19 structure Umu = struct {
20 ######## Bool ########
21
22 # TRUE : Bool
23 val TRUE = &Bool.true
24
25 # FALSE : Bool
26 val FALSE = &Bool.false
27
28
29
30 ######## Option ########
31
32 structure Option = struct {
33 #### Constructor ####
34
35 # Some : 'a -> Some 'a
36 val Some = &Some.make
37
38 # NONE : None
39 val NONE = &None.make
40
41
42 #### Classifier ####
43
44 # Some? : Option 'a -> Bool
45 val Some? = &(Option.Some?)
46
47 # None? : Option 'a -> Bool
48 val None? = &(Option.None?)
49 }
50
51
52
53 ######## Result ########
54
55 structure Result = struct {
56 #### Constructor ####
57
58 # Ok : 'a -> Ok 'a
59 val Ok = &Ok.make
60
61 # Err : 'a -> Err 'a
62 val Err = &Err.make
63
64
65 #### Classifier ####
66
67 # Ok? : Result 'a -> Bool
68 val Ok? = &(Result.Ok?)
69
70 # Err? : Result 'a -> Bool
71 val Err? = &(Result.Err?)
72 }
73
74
75
76 #### Float ####
77
78 structure Float = struct {
79 # NAN : Float
80 val NAN = &Float.nan
81
82 # INFINITY : Float
83 val INFINITY = &Float.infinity
84
85 # nan? : Float -> Bool
86 val nan? = &(Float.nan?)
87
88 # infinite? : Float -> Bool
89 val infinite? = &(Float.infinite?)
90
91 # finite? : Float -> Bool
92 val finite? = &(Float.finite?)
93
94 # equal? : Float -> Float -> Int -> Bool
95 fun equal? = (x : Float) (y : Float) (n : Int) ->
96 x.truncate n.== (y.truncate n)
97
98 # truncate : Float -> Int -> Float
99 fun truncate = (x : Float) (n : Int) -> x.truncate n
100
101 # ceil : Float -> Int -> Float
102 fun ceil = (x : Float) (n : Int) -> x.ceil n
103
104 # floor : Float -> Int -> Float
105 fun floor = (x : Float) (n : Int) -> x.floor n
106 }
107
108
109
110 #### Math ####
111
112 structure Math = struct {
113 # PI : Float
114 val PI = &Math.pi
115
116 # E : Float
117 val E = &Math.e
118
119 # sin : Float -> Float
120 fun sin = x : Float -> &Math.sin x
121
122 # cos : Float -> Float
123 fun cos = x : Float -> &Math.cos x
124
125 # tan : Float -> Float
126 fun tan = x : Float -> &Math.tan x
127
128 # asin : Float -> Float
129 fun asin = x : Float -> &Math.asin x
130
131 # acos : Float -> Float
132 fun acos = x : Float -> &Math.acos x
133
134 # atan : Float -> Float
135 fun atan = x : Float -> &Math.atan x
136
137 # atan2 : Float -> Float -> Float
138 fun atan2 = (y : Float, x : Float) -> &Math.(atan2-y:y x:)
139
140 # sinh : Float -> Float
141 fun sinh = x : Float -> &Math.sinh x
142
143 # cosh : Float -> Float
144 fun cosh = x : Float -> &Math.cosh x
145
146 # tanh : Float -> Float
147 fun tanh = x : Float -> &Math.tanh x
148
149 # exp : Float -> Float
150 fun exp = x : Float -> &Math.exp x
151
152 # log : Float -> Float
153 fun log = x : Float -> &Math.log x
154
155 # log10 : Float -> Float
156 fun log10 = x : Float -> &Math.log10 x
157
158 # sqrt : Float -> Float
159 fun sqrt = x : Float -> &Math.sqrt x
160
161 # ldexp : Float -> Int -> Float
162 fun ldexp = (x : Float) (y : Int) -> x.ldexp y
163
164 # frexp : Float -> (Float, Float)
165 fun frexp = (x : Float) (y : Int) -> x.frexp y
166
167 # divmod : Float -> Float -> (Float, Float)
168 fun divmod = (x : Float) (y : Int) -> x.divmod y
169 }
170
171
172
173 #### I/O ####
174
175 structure IO = struct {
176 val STDIN : Input = &Device.stdin
177 val STDOUT : Output = &Device.stdout
178 val STDERR : Output = &Device.stderr
179
180
181 # see : String -> Input
182 fun see = file-path : String -> &Device.see file-path
183
184 # seen : Input -> ()
185 fun seen = io : Input -> io.seen
186
187 # see-with : String -> Fun -> ()
188 fun see-with = (file-path : String) (f : Fun) ->
189 &Device.see-with file-path f
190
191
192 # tell : String -> Output
193 fun tell = file-path : String -> &Device.tell file-path
194
195 # told : Output -> ()
196 fun told = io : Output -> io.told
197
198 # tell-with : String -> Fun -> ()
199 fun tell-with = (file-path : String) (f : Fun) ->
200 &Device.tell-with file-path f
201
202
203 # gets : () -> Option String
204 fun gets = () -> STDIN.gets
205
206 # fgets : Input -> Option String
207 fun fgets = io : Input -> io.gets
208
209 # each-line : Input -> Enum
210 fun each-line = io : Input -> io.each-line
211
212 # puts : String -> ()
213 fun puts = (s : String) -> STDOUT.puts s
214
215 # fputs : Output -> String -> ()
216 fun fputs = (io : Output) (s : String) -> io.puts s
217
218 # flush : Output -> ()
219 fun flush = (io : Output) -> io.flush
220
221 # display : 'a -> ()
222 fun display = x -> do (
223 ! STDOUT.puts (x.to-s)
224 ! STDOUT.flush
225 )
226
227 # tab : Int -> ()
228 fun rec tab = n ->
229 if 0.< n then
230 do (
231 ! [1 .. n].for-each { _ -> STDOUT.puts " " }
232 ! STDOUT.flush
233 )
234 else
235 ()
236
237 # nl : () -> ()
238 fun nl = () -> do (
239 ! STDOUT.puts "\n"
240 ! STDOUT.flush
241 )
242
243 # print : 'a -> ()
244 fun print = x -> do (
245 ! STDOUT.puts (x.to-s.^ "\n")
246 ! STDOUT.flush
247 )
248
249 # p : 'a -> ()
250 fun p = x -> do (
251 ! STDOUT.puts (x.show.^ "\n")
252 ! STDOUT.flush
253 )
254
255 # pp : 'a -> ()
256 fun pp = x -> STDOUT.pp x
257
258 # msgout : 'a -> ()
259 fun msgout = x -> do (
260 ! STDERR.puts (x.to-s.^ "\n")
261 ! STDERR.flush
262 )
263
264 # random : 'a -> 'a where { 'a <- Number }
265 fun random = x : Number -> x.random
266 }
267
268
269
270 #### Reference ####
271
272 structure Ref = struct {
273 # ref : Top -> Ref
274 val ref = &Ref.make
275
276 # peek! : Ref -> Top
277 fun peek! = r : Ref -> r.peek!
278
279 # poke! : Ref -> Top -> Unit
280 fun poke! = (r : Ref) x -> r.poke! x
281 }
282
283
284
285 ######## Morph ########
286
287 structure Morph = struct {
288 # cons : 'a -> %['a] -> %['a]
289 fun cons = x (xs : Morph) -> xs.cons x
290
291
292 # empty? : %['a] -> Bool
293 val empty? = &(Morph.empty?)
294
295
296 # exists? : %['a] -> Bool
297 val exists? = &(Morph.exists?)
298
299
300 # dest : %['a] -> Option ('a, %['a])
301 val dest = &(Morph.dest)
302
303
304 # head : %['a] -> 'a or EmptyError
305 fun head = xs : Morph -> xs.head
306
307
308 # tail : %['a] -> %['a] or EmptyError
309 fun tail = xs : Morph -> xs.tail
310
311
312 # to-list : %['a] -> ['a]
313 fun to-list = xs : Morph -> xs.to-list
314
315
316 # susp : %['a] -> <Stream> 'a
317 fun susp = xs : Morph -> xs.susp
318
319
320 # to-s-expr : %['a] -> %s('a)
321 fun to-s-expr = xs : Morph -> xs.to-s-expr
322
323
324 # equal-with? : ('a -> 'b -> Bool) -> %['a] -> %['b] -> Bool
325 fun rec equal-with? = eq? xs ys ->
326 if xs kind-of? Morph then
327 if ys kind-of? Morph then
328 case xs of {
329 [x|xs'] -> case ys of {
330 [y|ys'] -> equal-with? eq? x y &&
331 equal-with? eq? xs' ys'
332 else -> FALSE
333 }
334 else -> empty? ys
335 }
336 else
337 FALSE
338 else
339 if ys kind-of? Morph then
340 FALSE
341 else
342 eq? xs ys
343
344
345 # equal? : %['a] -> %['b] -> Bool
346 val equal? = equal-with? { x y -> x.== y }
347
348
349 # foldr : 'b -> ('a -> 'b -> 'b) -> %['a] -> 'b
350 (#
351 fun rec foldr = a f xs -> case xs of {
352 [x|xs'] -> f x (foldr a f xs')
353 else -> a
354 }
355 #)
356 fun foldr = a (f : Fun) (xs : Morph) -> xs.foldr a f
357
358
359 # foldl : 'b -> ('a -> 'b -> 'b) -> %['a] -> 'b
360 (#
361 fun rec foldl = a f xs -> case xs of {
362 [x|xs'] -> foldl (f x a) f xs'
363 else -> a
364 }
365 #)
366 fun foldl = a (f : Fun) (xs : Morph) -> xs.foldl a f
367
368
369 # count : %['a] -> Int
370 # val count = foldl 0 { _ len -> len.+ 1 }
371 # fun count = xs : Morph -> xs.foldl 0 { _ len -> len.+ 1 }
372 fun count = xs : Morph -> xs.count
373
374
375 # sum : %['a] -> 'a where { 'a <- Number }
376 fun sum = xs : Morph -> xs.sum
377
378
379 # avg : %['a] -> 'a where { 'a <- Number }
380 fun avg = xs : Morph -> xs.avg
381
382
383 # max : %['a] -> 'a where { 'a <- Number } or EmptyError
384 (#
385 fun max = xs : Morph -> case xs of {
386 [init|xs'] -> xs'.foldl init { x y -> if y.< x then x else y }
387 else -> "max: Empty Error".panic!
388 }
389 #)
390 fun max = xs : Morph -> xs.max
391
392
393 # min : %['a] -> 'a where { 'a <- Number } or EmptyError
394 (#
395 fun min = xs : Morph -> case xs of {
396 [init|xs'] -> xs'.foldl init { x y -> if x.< y then x else y }
397 else -> "min: Empty Error".panic!
398 }
399 #)
400 fun min = xs : Morph -> xs.min
401
402
403 # all? : ('a -> Bool) -> %['a] -> Bool
404 fun all? = (f : Fun) (xs : Morph) -> xs.all? f
405
406
407 # any? : ('a -> Bool) -> %['a] -> Bool
408 fun any? = (f : Fun) (xs : Morph) -> xs.any? f
409
410
411 # include? : 'a -> %['a] -> Bool
412 fun include? = x (xs : Morph) -> xs.include? x
413
414
415 # reverse : %['a] -> %['a]
416 # val reverse = foldl [] cons
417 fun reverse = xs : Morph -> xs.reverse
418
419
420 # nth : Int -> %['a] -> 'a or ArgumentError or IndexError
421 fun nth = (i : Int) (xs : Morph) -> xs.[i]
422
423
424 # for-each : ('a -> 'b) -> %['a] -> ()
425 fun for-each = (f : Fun) (xs : Morph) -> xs.for-each f
426
427
428 # map : ('a -> 'b) -> %['a] -> %['b]
429 # fun map = f -> foldr [] { x xs -> [f x | xs] }
430 fun map = (f : Fun) (xs : Morph) -> xs.map f
431
432
433 # filter : ('a -> Bool) -> %['a] -> %['a]
434 # fun filter = f -> foldr [] { x xs -> if f x then [x|xs] else xs }
435 fun filter = (f : Fun) (xs : Morph) -> xs.select f
436
437
438 # concat : %[%['a]] -> %['a]
439 # val concat = foldl [] { xs xss -> xss ++ xs }
440 val concat = &(Morph.concat)
441
442
443 # concat-map : ('a -> %['b]) -> %['a] -> %['b]
444 fun concat-map = (f : Fun) (xs : Morph) -> xs.concat-map f
445
446
447 # zip-with : ('a -> 'b -> 'c) -> %['a] -> %['b] -> %['c]
448 fun zip-with = f -> foldr e g
449 where {
450 fun e = _ -> []
451
452 fun g = x h ys -> case ys of {
453 [y|ys'] -> [f x y | h ys']
454 else -> []
455 }
456 }
457
458
459 # zip : %['a] -> %['b] -> %[('a, 'b)]
460 # val zip = zip-with { x y -> (x, y) }
461 fun zip = (xs : Morph) (ys : Morph) -> xs.zip ys
462
463
464 # unzip : %[('a, 'b)] -> (%['a], %['b])
465 # val unzip = foldr ([], []) { (y, z) (ys, zs) -> ([y|ys], [z|zs]) }
466 val unzip = &(Morph.unzip)
467
468
469 # uniq : %['a] -> %['a]
470 val uniq = &(Morph.uniq)
471
472
473 # partition : ('a -> Bool) -> %['a] -> (%['a], %['a])
474 (#
475 fun partition = (f : Fun) (xs : Morph) -> foldr ([], []) {
476 x (ys, zs)
477 ->
478 if f x then
479 ([x|ys], zs)
480 else
481 ( ys, [x|zs])
482 } xs
483 #)
484 fun partition = (f : Fun) (xs : Morph) -> xs.partition f
485
486
487 # sort : %['a] -> %['a]
488 (#
489 fun rec sort = xs -> case xs of {
490 [pivot|xs'] ->
491 concat [sort littles, [pivot], sort bigs]
492
493 where val (littles, bigs) = partition (< pivot) xs'
494 else -> []
495 }
496 #)
497 val sort = &(Morph.sort)
498
499
500 # sort-with : ('a -> Int) -> %['a] -> %['a]
501 fun sort-with = (f : Fun) (xs : Morph) -> xs.sort-with f
502 }
503
504
505
506 ######## List ########
507
508 structure List = struct {
509 # unfold : 'b -> ('b -> Option (['a], 'b)) -> ['a]
510 fun unfold = x (f : Fun) -> &List.unfold x f
511 }
512
513
514
515 ######## Stream ########
516
517 structure Stream = struct {
518 # map : ('a -> 'b) -> <Stream> 'a -> <Stream> 'b
519 fun map = (f : Fun) (xs : Stream) -> xs.map f
520
521
522 # filter : ('a -> Bool) -> <Stream> 'a -> <Stream> 'a
523 fun filter = (f : Fun) (xs : Stream) -> xs.select f
524
525
526 # append : <Stream> 'a -> <Stream> 'a -> <Stream> 'a
527 fun append = (xs : Stream) (ys : Stream) -> xs.++ ys
528
529
530 # concat-map : ('a -> <Stream> 'b) -> <Stream> 'a -> <Stream> 'b
531 fun concat-map = (f : Fun) (xs : Stream) -> xs.concat-map f
532
533
534 # take-to-list : Int -> <Stream> 'a -> ['a]
535 fun take-to-list = (n : Int) (xs : Stream) -> xs.take-to-list n
536
537
538 # to-list : <Stream> 'a -> ['a]
539 fun to-list = xs : Stream -> xs.to-list
540 }
541
542
543
544 ######## S-Expression ########
545
546 structure SExpr = struct {
547 #### Constructor
548
549 # NIL : SExprNil
550 val NIL = &SExpr.nil
551
552 # Value : 'a -> SExprValue
553 fun Value = x -> &SExpr.value x
554
555 # Cons : SExpr -> SExpr -> SExpr
556 fun Cons = (car : SExpr) (cdr : SExpr) -> &SExpr.cons car cdr
557
558 # list : %[SExpr] -> SExpr
559 fun list = xs : Morph -> &SExpr.make xs
560
561
562 #### Classifier
563
564 # Nil? : SExpr -> Bool
565 fun Nil? = this : SExpr -> this.nil?
566
567 # Value? : SExpr -> Bool
568 fun Value? = this : SExpr -> this.value?
569
570 # Cons? : SExpr -> Bool
571 fun Cons? = this : SExpr -> this.cons?
572
573
574 #### Selector
575
576 # car : SExprCons -> SExpr
577 fun car = this : SExprCons -> this.car
578
579 # cdr : SExprCons -> SExpr
580 fun cdr = this : SExprCons -> this.cdr
581
582
583 #### Mutator
584
585 # set-car! : SExprCons -> SExpr -> Unit
586 fun set-car! = (this : SExprCons) (car : SExpr) ->
587 this.set-car! car
588
589 # set-cdr! : SExprCons -> SExpr -> Unit
590 fun set-cdr! = (this : SExprCons) (cdr : SExpr) ->
591 this.set-cdr! cdr
592 }
593
594
595
596 ######## String ########
597
598 structure String = struct {
599 # panic! : String -> ()
600 val panic! = &(String.panic!)
601
602
603 # join : %[String] -> String
604 fun join = (sep : String) (xs : Morph) -> xs.join
605
606
607 # join-by : String -> %[String] -> String
608 (#
609 fun join-by = j xs -> case xs of {
610 [x|xs'] -> case xs' of {
611 [] -> x
612 else -> x.^ (xs'.foldl "" { x' s -> s.^ j.^ x' })
613 }
614 else -> ""
615 }
616 #)
617 fun join-by = (sep : String) (xs : Morph) -> xs.join-by sep
618 }
619
620
621
622 ######## Prelude ########
623
624 structure Prelude = struct {
625 #### Top ####
626
627 # show : 'a -> String
628 val show = &(show)
629
630 # to-s : 'a -> String
631 val to-s = &(to-s)
632
633 # val-of : 'a -> Top
634 fun val-of = x -> x.contents
635
636 # (==) : 'a -> 'b -> Bool
637 fun (==) = x y -> x.== y
638
639 # (<>) : 'a -> 'b -> Bool
640 fun (<>) = x y -> x.<> y
641
642 # (<) : 'a -> 'a -> Bool
643 fun (<) = x y -> x.< y
644
645 # (>) : 'a -> 'a -> Bool
646 fun (>) = x y -> x.> y
647
648 # (<=) : 'a -> 'a -> Bool
649 fun (<=) = x y -> x.<= y
650
651 # (>=) : 'a -> 'a -> Bool
652 fun (>=) = x y -> x.>= y
653
654 # (<=>) : 'a -> 'a -> Int
655 fun (<=>) = x y -> x.<=> y
656
657 # force : 'a -> 'a
658 val force = &(force)
659
660
661 #### Bool ####
662
663 # TRUE : Bool
664 val TRUE = TRUE
665
666 # FALSE : Bool
667 val FALSE = FALSE
668
669 # not : Bool -> Bool
670 val not = &(Bool.not)
671
672
673 #### Number ####
674
675 # zero : Number -> Number
676 val zero = &(Number.zero)
677
678 # zero? : Number -> Bool
679 val zero? = &(Number.zero?)
680
681 # positive? : Number -> Bool
682 val positive? = &(Number.positive?)
683
684 # negative? : Number -> Bool
685 val negative? = &(Number.negative?)
686
687 # odd? : Int -> Bool
688 val odd? = &(Int.odd?)
689
690 # even? : Int -> Bool
691 val even? = &(Int.even?)
692
693 # abs : 'a -> 'a where { 'a <- Number }
694 val abs = &(Number.abs)
695
696 # negate : 'a -> 'a where { 'a <- Number }
697 val negate = &(Number.negate)
698
699 # to-i : Number -> Int
700 val to-i = &(Number.to-i)
701
702 # to-f : Number -> Float
703 val to-f = &(Number.to-f)
704
705 # succ : Number -> Number
706 val succ = &(Number.succ)
707
708 # pred : Number -> Number
709 val pred = &(Number.pred)
710
711 # (+) : 'a -> 'a -> 'a where { 'a <- Number }
712 fun (+) = (x : Number) (y : Number) -> x.+ y
713
714 # (-) : 'a -> 'a -> 'a where { 'a <- Number }
715 fun (-) = (x : Number) (y : Number) -> x.- y
716
717 # (*) : 'a -> 'a -> 'a where { 'a <- Number }
718 fun (*) = (x : Number) (y : Number) -> x.* y
719
720 # (/) : 'a -> 'a -> 'a where { 'a <- Number }
721 fun (/) = (x : Number) (y : Number) -> x./ y
722
723 # (mod) : 'a -> 'a -> 'a where { 'a <- Number }
724 fun (mod) = (x : Number) (y : Number) -> x.mod y
725
726 # (pow) : 'a -> 'a -> 'a where { 'a <- Number }
727 fun (pow) = (x : Number) (y : Number) -> x.pow y
728
729
730 #### Float ####
731
732 # NAN : Float
733 val NAN = Float::NAN
734
735 # INFINITY : Float
736 val INFINITY = Float::INFINITY
737
738 # nan? : Float -> Bool
739 val nan? = Float::nan?
740
741 # infinite? : Float -> Bool
742 val infinite? = Float::infinite?
743
744 # finite? : Float -> Bool
745 val finite? = Float::finite?
746
747
748 #### String ####
749
750 # panic! : String -> ()
751 val panic! = String::panic!
752
753 # (^) : String -> String -> String
754 fun (^) = (x : String) (y : String) -> x.^ y
755
756 # join : [String] -> String
757 val join = String::join
758
759 # join-by : String -> [String] -> String
760 val join-by = String::join-by
761
762
763 #### I/O ####
764
765 val STDIN = IO::STDIN
766 val STDOUT = IO::STDOUT
767 val STDERR = IO::STDERR
768
769
770 # see : String -> Input
771 val see = IO::see
772
773 # seen : Input -> ()
774 val seen = IO::seen
775
776 # see-with : String -> Fun -> ()
777 val see-with = IO::see-with
778
779
780 # tell : String -> Output
781 val tell = IO::tell
782
783 # told : Output -> ()
784 val told = IO::told
785
786 # tell-with : String -> Fun -> ()
787 val tell-with = IO::tell-with
788
789
790 # gets : () -> Option String
791 val gets = IO::gets
792
793 # fgets : Input -> Option String
794 val fgets = IO::fgets
795
796 # each-line : Input -> Enum
797 val each-line = IO::each-line
798
799 # puts : String -> ()
800 val puts = IO::puts
801
802 # fputs : Output -> String -> ()
803 val fputs = IO::fputs
804
805 # flush : Output -> ()
806 val flush = IO::flush
807
808 # display : 'a -> ()
809 val display = IO::display
810
811 # tab : Int -> ()
812 val tab = IO::tab
813
814 # nl : () -> ()
815 val nl = IO::nl
816
817 # print : 'a -> ()
818 val print = IO::print
819
820 # p : 'a -> ()
821 val p = IO::p
822
823 # pp : 'a -> ()
824 val pp = IO::pp
825
826
827 #### Reference ####
828
829 # ref : Top -> Ref
830 val ref = Ref::ref
831
832 # !! : Ref -> Top
833 val !! = Ref::peek!
834
835 # (:=) : Ref -> Top -> Unit
836 val (:=) = Ref::poke!
837
838
839 #### Tuple ####
840
841 # (,) : 'a -> 'b -> ('a, 'b)
842 fun (,) = x y -> (x, y)
843
844 # fst : ('a, 'b) -> 'a
845 fun fst = (f, _) -> f
846
847 # snd : ('a, 'b) -> 'b
848 fun snd = (_, s) -> s
849
850
851 #### Datum ####
852 # See SICP(Wizard Book), 2.4.2 Tagged data
853
854 # Datum : Symbol -> 'a -> Datum 'a
855 fun Datum = (t : Symbol) x -> &Datum.(tag:t contents:x)
856
857 # tag-of : Datum 'a -> Symbol
858 val tag-of = &(Datum.tag)
859
860
861 #### Option ####
862
863 # Some : 'a -> Some 'a
864 val Some = Option::Some
865
866 # NONE : None 'a
867 val NONE = Option::NONE
868
869 # Some? : Option 'a -> Bool
870 val Some? = Option::Some?
871
872 # None? : Option 'a -> Bool
873 val None? = Option::None?
874
875
876 #### Result ####
877
878 # Ok : 'a -> Ok 'a
879 val Ok = Result::Ok
880
881 # Err : 'a -> Err 'a
882 val Err = Result::Err
883
884 # Ok? : Result 'a -> Bool
885 val Ok? = Result::Ok?
886
887 # Err? : Result 'a -> Bool
888 val Err? = Result::Err?
889
890
891 #### Morph ####
892
893 # (|) : 'a -> %['a] -> %['a]
894 val (|) = Morph::cons
895
896 # (++) : %['a] -> %['a] -> %['a]
897 fun (++) = (xs : Morph) (ys : Morph) -> xs.++ ys
898
899 # cons : 'a -> %['a] -> %['a]
900 val cons = Morph::cons
901
902 # empty? : %['a] -> Bool
903 val empty? = Morph::empty?
904
905 # exists? : %['a] -> Bool
906 val exists? = Morph::exists?
907
908 # head : %['a] -> 'a
909 val head = Morph::head
910
911 # tail : %['a] -> ['a]
912 val tail = Morph::tail
913
914 # to-list : %['a] -> ['a]
915 val to-list = Morph::to-list
916
917 # susp : %['a] -> <Stream> 'a
918 val susp = Morph::susp
919
920 # to-s-expr : %['a] -> %s('a)
921 val to-s-expr = Morph::to-s-expr
922
923 # equal? : 'a -> 'b -> Bool
924 val equal? = Morph::equal?
925
926 # foldr : 'b -> ('a -> 'b -> 'b) -> %['a] -> 'b
927 val foldr = Morph::foldr
928
929 # foldl : 'b -> ('a -> 'b -> 'b) -> %['a] -> 'b
930 val foldl = Morph::foldl
931
932 # length : %['a] -> Int
933 val length = Morph::count
934
935 # sum : %['a] -> 'a where { 'a <- Number }
936 val sum = Morph::sum
937
938 # avg : %['a] -> 'a where { 'a <- Number }
939 val avg = Morph::avg
940
941 # max : %['a] -> 'a where { 'a <- Number }
942 val max = Morph::max
943
944 # min : %['a] -> 'a where { 'a <- Number }
945 val min = Morph::min
946
947 # all? : ('a -> Bool) -> %['a] -> Bool
948 val all? = Morph::all?
949
950 # any? : ('a -> Bool) -> %['a] -> Bool
951 val any? = Morph::any?
952
953 # include? : 'a -> %['a] -> Bool
954 val include? = Morph::include?
955
956 # reverse : %['a] -> ['a]
957 val reverse = Morph::reverse
958
959 # nth : Int -> %['a] -> 'a or IndexError
960 val nth = Morph::nth
961
962 # for-each : ('a -> 'b) -> %['a] -> ()
963 val for-each = Morph::for-each
964
965 # map : ('a -> 'b) -> %['a] -> %['b]
966 val map = Morph::map
967
968 # filter : ('a -> Bool) -> %['a] -> %['a]
969 val filter = Morph::filter
970
971 # concat : %[%['a]] -> %['a]
972 val concat = Morph::concat
973
974 # concat-map : ('a -> %['b]) -> %['a] -> %['b]
975 val concat-map = Morph::concat-map
976
977 # zip : %['a] -> %['b] -> (%['a, 'b])
978 val zip = Morph::zip
979
980 # unzip : %[('a, 'b)] -> (%['a], %['b])
981 val unzip = Morph::unzip
982
983 # uniq : %['a] -> %['a]
984 val uniq = Morph::uniq
985
986 # partition : ('a -> Bool) -> %['a] -> (%['a], %['a])
987 val partition = Morph::partition
988
989 # sort : %['a] -> %['a]
990 val sort = Morph::sort
991
992 # sort-with : ('a -> Int) -> %['a] -> %['a]
993 val sort-with = Morph::sort-with
994
995
996 #### List ####
997
998 # unfold : 'b -> ('b -> Option (['a], 'b)) -> ['a]
999 val unfold = List::unfold
1000
1001
1002 #### High order Function ####
1003
1004 ## id : 'a -> 'a
1005 fun id = x -> x
1006
1007 ## const : 'a -> 'b -> 'a
1008 fun const = x _ -> x
1009
1010 ## tee : ('a -> 'b) -> 'a -> 'a
1011 fun tee = (f : Fun) x -> let { val _ = f x in x }
1012
1013 ## curry : (('a, 'b) -> 'c) -> ('a -> 'b -> 'c)
1014 fun curry = (f : Fun) x y -> f (x, y)
1015
1016 ## uncurry : ('a -> 'b -> 'c) -> (('a, 'b) -> 'c)
1017 fun uncurry = (f : Fun) (x, y) -> f x y
1018
1019 ## swap : (('a, 'b) -> 'c) -> (('b, 'a) -> 'c)
1020 fun swap = (f : Fun) (x, y) -> f (y, x)
1021
1022 ## flip : ('a -> 'b -> 'c) -> ('b -> 'a -> 'c)
1023 fun flip = (f : Fun) x y -> f y x
1024
1025 ## pair : ('a -> 'b, 'a -> 'c) -> ('a -> ('b, 'c))
1026 fun pair = (f : Fun, g : Fun) x -> (f x, g x)
1027
1028 ## cross : ('a -> 'b, 'c -> 'd) -> (('a, 'c) -> ('b, 'd))
1029 fun cross = (f : Fun, g : Fun) ->
1030 pair (fst >> f, snd >> g)
1031 }
1032
1033
1034
1035 ######## Assertion ########
1036
1037 structure Assert = struct {
1038 # unit : 'a -> ()
1039 fun unit = actual -> let {
1040 assert actual kind-of? Unit -> msg () actual
1041 in
1042 ()
1043 }
1044
1045
1046 # bool : 'a -> Bool -> Bool
1047 fun bool =
1048 actual
1049 (expect : Bool)
1050 -> let {
1051 assert actual kind-of? Bool -> "Bool"
1052 assert actual == expect -> msg expect actual
1053 in
1054 actual
1055 }
1056
1057
1058 # bools : ['a] -> ('a -> 'b) -> [Bool] -> [Bool]
1059 fun bools =
1060 (sources : List)
1061 (f : Fun)
1062 (expects : List)
1063 -> let {
1064 val results = sources |> map f
1065 in
1066 results |> zip expects |> map { (result, expect) ->
1067 bool result expect
1068 }
1069 }
1070
1071
1072 # true : 'a -> Bool
1073 fun true = actual -> bool actual TRUE
1074
1075
1076 # false : 'a -> Bool
1077 fun false = actual -> bool actual FALSE
1078
1079
1080 # integer : 'a -> Int -> Int
1081 fun integer =
1082 actual
1083 (expect : Int)
1084 -> let {
1085 assert actual kind-of? Int -> "Int"
1086 assert actual == expect -> msg expect actual
1087 in
1088 actual
1089 }
1090
1091
1092 # integers : ['a] -> ('a -> 'b) -> [Int] -> [Int]
1093 fun integers =
1094 (sources : List)
1095 (f : Fun)
1096 (expects : List)
1097 -> let {
1098 val results = sources |> map f
1099 in
1100 results |> zip expects |> map { (result, expect) ->
1101 integer result expect
1102 }
1103 }
1104
1105
1106 # float : 'a -> Float -> Int -> Float
1107 fun float =
1108 actual
1109 (expect : Float)
1110 (n : Int)
1111 -> let {
1112 assert actual kind-of? Float -> "Float"
1113 assert Float::equal? actual expect n -> msg expect actual
1114 in
1115 actual
1116 }
1117
1118
1119 # symbol : 'a -> Symbol -> Symbol
1120 fun symbol =
1121 actual
1122 (expect : Symbol)
1123 -> let {
1124 assert actual kind-of? Symbol -> "Symbol"
1125 assert actual == expect -> msg expect actual
1126 in
1127 actual
1128 }
1129
1130
1131 # string : 'a -> String -> String
1132 fun string =
1133 actual
1134 (expect : String)
1135 -> let {
1136 assert actual kind-of? String -> "String"
1137 assert actual == expect -> msg expect actual
1138 in
1139 actual
1140 }
1141 } where {
1142 import Prelude { fun (==) fun (^) }
1143 import Morph { fun map fun zip }
1144
1145 fun msg = expect actual ->
1146 "Expected: " ^ expect.show ^ ", but: " ^ actual.show
1147 }
1148
1149
1150
1151 ######## SICP ########
1152 (#
1153 # Structure and Implementation of Computer Programs -- 2nd ed.
1154 #
1155 # - Original (English)
1156 # https://web.mit.edu/6.001/6.037/
1157 # - Japanease translated
1158 # https://sicp.iijlab.net/
1159 #)
1160
1161 structure SICP = struct {
1162 val get = operation-table @lookup-proc
1163
1164 val put = operation-table @insert-proc!
1165
1166 val pp = operation-table @pp-proc
1167
1168 val print = operation-table @print-proc
1169 } where {
1170 import Prelude
1171 structure SE = SExpr
1172
1173
1174 ### assoc : Symbol -> SExpr -> Option SExpr
1175 fun rec assoc = (target-key : Symbol) (records : SExpr) ->
1176 case records of {
1177 | &SExprNil -> NONE
1178 | &SExprValue -> NONE
1179 | &SExprCons (
1180 car:record-cons : SExprCons
1181 cdr:next-records
1182 ) -> let {
1183 val (
1184 car:record-key-value : SExprValue
1185 ) = val-of record-cons
1186 in
1187 if (val-of record-key-value) == target-key
1188 then Some record-cons
1189 else assoc target-key next-records
1190 }
1191 }
1192
1193
1194 fun make-table = records : List -> %S(
1195 ("*table*" . ())
1196 .
1197 %{records |>
1198 Morph::foldr SE::NIL {
1199 (k : Symbol, v : SExpr) (se : SExpr)
1200 ->
1201 %S(
1202 (%{SE::Value k} . %{v})
1203 .
1204 %{se}
1205 )
1206 }
1207 }
1208 )
1209
1210
1211 fun make-table' = records -> let {
1212 val local-table = make-table records
1213
1214
1215 fun lookup = (key-1 : Symbol) (key-2 : Symbol) -> let {
1216 val opt-subtable = assoc key-1 <| SE::cdr local-table
1217 in
1218 case opt-subtable of {
1219 | &Some subtable -> let {
1220 val opt-record = assoc key-2 <| SE::cdr subtable
1221 in
1222 case opt-record of {
1223 | &Some (record-cons : SExprCons) ->
1224 (Some << val-of << SE::cdr) record-cons
1225 | &None ->
1226 NONE
1227 }
1228 }
1229 | &None -> NONE
1230 }
1231 }
1232
1233
1234 fun insert! = (key-1 : Symbol) (key-2 : Symbol)
1235 (value : Object) -> let {
1236 val opt-subtable = assoc key-1 <| SE::cdr local-table
1237 in
1238 case opt-subtable of {
1239 | &Some subtable -> let {
1240 val opt-record = assoc key-2 <| SE::cdr subtable
1241 in
1242 case opt-record of {
1243 | &Some record -> SE::set-cdr!
1244 record
1245 (SE::Value value)
1246 | &None -> SE::set-cdr! subtable %S(
1247 (
1248 %{SE::Value key-2}
1249 .
1250 %{SE::Value value}
1251 )
1252 .
1253 %{SE::cdr subtable}
1254 )
1255 }
1256 }
1257 | &None -> SE::set-cdr! local-table %S(
1258 (
1259 %{SE::Value key-1}
1260 (
1261 %{SE::Value key-2}
1262 .
1263 %{SE::Value value}
1264 )
1265 )
1266 .
1267 %{SE::cdr local-table}
1268 )
1269 }
1270 }
1271
1272
1273 fun pp-table = () -> pp local-table
1274
1275
1276 fun print-table = () -> (
1277 print-table' local-table
1278 ) where {
1279 fun print-entry = cons : SExprCons -> let {
1280 val (
1281 car:key-1-value : SExprValue
1282 cdr:
1283 ) = val-of cons
1284 val key-1-sym = val-of key-1-value
1285 in
1286 case cdr of {
1287 | &SExprNil ->
1288 ()
1289 | &SExprValue v ->
1290 panic! <| "Unexpectd value: " ^ v.show
1291 | &SExprCons (car:entry cdr:) -> let {
1292 val (
1293 car:key-2-value : SExprValue
1294 cdr:
1295 ) = val-of entry
1296 val key-2-sym = val-of key-2-value
1297 in
1298 do (
1299 ! print <| "- key-1:" ^ key-1-sym.show
1300 ! print <| " key-2:" ^ key-2-sym.show
1301 )
1302 }
1303 }
1304 }
1305
1306 fun rec print-table' = table : SExpr -> (
1307 case table of {
1308 | &SExprNil -> NONE
1309 | &SExprValue v -> do (
1310 #! print "== Value(1) =="
1311 ! print-table' v
1312 ! NONE
1313 )
1314 | &SExprCons (car: cdr: records) -> do (
1315 #! print "== Cons(1) =="
1316 ! print-entry car
1317 #! pp car
1318 ! &List.unfold records { cell : SExpr ->
1319 case cell of {
1320 | &SExprNil -> NONE
1321 | &SExprValue v -> do (
1322 #! print "== Value(2) =="
1323 ! print-table' v
1324 ! NONE
1325 )
1326 | &SExprCons (car: cdr:) -> do (
1327 #! print "== Cons(2) =="
1328 ! print-entry car
1329 #! pp car
1330 ! Some ([()], cdr)
1331 )
1332 }
1333 }
1334 )
1335 }
1336 )
1337 }
1338
1339
1340 fun dispatch = m -> case m of {
1341 | @lookup-proc -> lookup
1342 | @insert-proc! -> insert!
1343 | @pp-proc -> pp-table
1344 | @print-proc -> print-table
1345 else -> panic! <|
1346 "Unknown operation -- TABLE: " ^ show m
1347 }
1348 in
1349 dispatch
1350 }
1351
1352 val operation-table = make-table' []
1353 }
1354 }
1355
1356
1357 import Umu::Prelude
1358 ___EOS___
1359
1360 end # Umu::Commander::Prelude
1361
1362 end # Umu::Commander
1363
1364 end # Umu