-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathasPrelude.json
3071 lines (3071 loc) · 218 KB
/
asPrelude.json
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
{
"Just": {
"code": "-- Just :: a -> Maybe a\non Just(x)\n -- Constructor for an inhabited Maybe (option type) value.\n -- Wrapper containing the result of a computation.\n {type:\"Maybe\", Nothing:false, Just:x}\nend Just",
"tags": [
"AS Prelude"
]
},
"Left": {
"code": "-- Left :: a -> Either a b\non |Left|(x)\n {type:\"Either\", |Left|:x, |Right|:missing value}\nend |Left|",
"tags": [
"AS Prelude"
]
},
"Node": {
"code": "-- Node :: a -> [Tree a] -> Tree a\non Node(v, xs)\n {type:\"Node\", root:v, nest:xs}\nend Node",
"tags": [
"AS Prelude",
"tree"
]
},
"Nothing": {
"code": "-- Nothing :: Maybe a\non Nothing()\n -- Constructor for an empty Maybe (option type) value.\n -- Empty wrapper returned where a computation is not possible.\n {type: \"Maybe\", Nothing: true}\nend Nothing",
"tags": [
"AS Prelude"
]
},
"Right": {
"code": "-- Right :: b -> Either a b\non |Right|(x)\n {type:\"Either\", |Left|:missing value, |Right|:x}\nend |Right|",
"tags": [
"AS Prelude"
]
},
"Tuple": {
"code": "-- Tuple (,) :: a -> b -> (a, b)\non Tuple(a, b)\n -- Constructor for a pair of values, possibly of two different types.\n {type:\"Tuple\", |1|:a, |2|:b, length:2}\nend Tuple",
"tags": [
"AS Prelude"
]
},
"Tuple3": {
"code": "-- Tuple3 (,,) :: a -> b -> c -> (a, b, c)\non Tuple3(x, y, z)\n {type:\"Tuple3\", |1|:x, |2|:y, |3|:z, length:3}\nend Tuple3",
"tags": [
"AS Prelude"
]
},
"TupleN": {
"code": "-- Requires N arguments to be wrapped as one list in AS \n-- (the JS version accepts N separate arguments)\n-- TupleN :: a -> b ... -> (a, b ... )\non TupleN(argv)\n tupleFromList(argv)\nend TupleN",
"tags": [
"AS Prelude"
]
},
"abs": {
"code": "-- abs :: Num -> Num\non abs(x)\n -- Absolute value.\n if 0 > x then\n -x\n else\n x\n end if\nend abs",
"tags": [
"AS Prelude",
"tree"
]
},
"add": {
"code": "-- add (+) :: Num a => a -> a -> a\non add(a)\n -- Curried addition.\n script\n on |λ|(b)\n a + b\n end |λ|\n end script\nend add",
"tags": [
"AS Prelude"
]
},
"all": {
"code": "-- all :: (a -> Bool) -> [a] -> Bool\non all(p, xs)\n -- True if p holds for every value in xs\n tell mReturn(p)\n set lng to length of xs\n repeat with i from 1 to lng\n if not |λ|(item i of xs, i, xs) then return false\n end repeat\n true\n end tell\nend all",
"tags": [
"AS Prelude"
]
},
"allSame": {
"code": "-- allSame :: [a] -> Bool\non allSame(xs)\n if 2 > length of xs then\n true\n else\n script p\n property h : item 1 of xs\n on |λ|(x)\n h = x\n end |λ|\n end script\n all(p, rest of xs)\n end if\nend allSame",
"tags": [
"AS Prelude"
]
},
"allTree": {
"code": "-- allTree :: (a -> Bool) -> Tree a -> Bool\non allTree(p, tree)\n -- True if p holds for the value of every node in tree\n script go\n property mp : mReturn(p)'s |λ|\n on |λ|(oNode)\n if mp(root of oNode) then\n repeat with v in nest of oNode\n if not (contents of |λ|(v)) then return false\n end repeat\n true\n else\n false\n end if\n end |λ|\n end script\n |λ|(tree) of go\nend allTree",
"tags": [
"AS Prelude",
"tree"
]
},
"and": {
"code": "-- and :: [Bool] -> Bool\non |and|(xs)\n -- True if every value in the list is true.\n repeat with x in xs\n if not (contents of x) then return false\n end repeat\n return true\nend |and|",
"tags": [
"AS Prelude"
]
},
"any": {
"code": "-- any :: (a -> Bool) -> [a] -> Bool\non any(p, xs)\n -- Applied to a predicate and a list, \n -- |any| returns true if at least one element of the \n -- list satisfies the predicate.\n tell mReturn(p)\n set lng to length of xs\n repeat with i from 1 to lng\n if |λ|(item i of xs) then return true\n end repeat\n false\n end tell\nend any",
"tags": [
"AS Prelude"
]
},
"anyTree": {
"code": "-- anyTree :: (a -> Bool) -> Tree a -> Bool\non anyTree(p, tree)\n -- True if p holds for the value of any node in the tree.\n script go\n property mp : mReturn(p)'s |λ|\n on |λ|(oNode)\n if mp(root of oNode) then\n true\n else\n repeat with v in nest of oNode\n if contents of |λ|(v) then return true\n end repeat\n false\n end if\n end |λ|\n end script\n |λ|(tree) of go\nend anyTree",
"tags": [
"AS Prelude",
"tree"
]
},
"ap (<*>)": {
"code": "-- ap (<*>) :: Monad m => m (a -> b) -> m a -> m b\non ap(mf, mx)\n -- Applies wrapped functions to wrapped values, \n -- for example applying a list of functions to a list of values\n -- or applying Just(f) to Just(x), Right(f) to Right(x), etc\n if class of mx is list then\n apList(mf, mx)\n else\n set t to typeName(mf)\n if \"(a -> b)\" = t then\n apFn(mf, mx)\n else if \"Either\" = t then\n apLR(mf, mx)\n else if \"Maybe\" = t then\n apMay(mf, mx)\n else if \"Node\" = t then\n apTree(mf, mx)\n else if \"Tuple\" = t then\n apTuple(mf, mx)\n else\n missing value\n end if\n end if\nend ap",
"tags": [
"AS Prelude"
]
},
"apFn (<*>)": {
"code": "-- apFn :: (a -> b -> c) -> (a -> b) -> (a -> c)\non apFn(f, g)\n script go\n property mf : |λ| of mReturn(f)\n property mg : |λ| of mReturn(g)\n on |λ|(x)\n mf(x, mg(x))\n end |λ|\n end script\nend apFn",
"tags": [
"AS Prelude"
]
},
"apLR (<*>)": {
"code": "-- apLR (<*>) :: Either e (a -> b) -> Either e a -> Either e b\non apLR(flr, lr)\n if missing value is |Left| of flr then\n if missing value is |Left| of lr then\n |Right|(|λ|(|Right| of lr) of mReturn(|Right| of flr))\n else\n lr\n end if\n else\n flr\n end if\nend apLR",
"tags": [
"AS Prelude"
]
},
"apList (<*>)": {
"code": "-- apList (<*>) :: [(a -> b)] -> [a] -> [b]\non apList(fs, xs)\n -- e.g. [(*2),(/2), sqrt] <*> [1,2,3]\n -- --> ap([dbl, hlf, root], [1, 2, 3])\n -- --> [2,4,6,0.5,1,1.5,1,1.4142135623730951,1.7320508075688772]\n -- Each member of a list of functions applied to\n -- each of a list of arguments, deriving a list of new values\n set lst to {}\n repeat with f in fs\n tell mReturn(contents of f)\n repeat with x in xs\n set end of lst to |λ|(contents of x)\n end repeat\n end tell\n end repeat\n return lst\nend apList",
"tags": [
"AS Prelude"
]
},
"apMay (<*>)": {
"code": "-- apMay (<*>) :: Maybe (a -> b) -> Maybe a -> Maybe b\non apMay(mf, mx)\n -- Maybe f applied to Maybe x, deriving a Maybe y\n if Nothing of mf or Nothing of mx then\n Nothing()\n else\n Just(|λ|(Just of mx) of mReturn(Just of mf))\n end if\nend apMay",
"tags": [
"AS Prelude"
]
},
"apTree (<*>)": {
"code": "-- apTree (<*>) :: Tree (a -> b) -> Tree a -> Tree b\non apTree(tf, tx)\n set fmap to curry(my fmapTree)\n script go\n on |λ|(t)\n set f to root of t\n Node(mReturn(f)'s |λ|(root of tx), ¬\n map(fmap's |λ|(f), nest of tx) & ¬\n map(go, nest of t))\n end |λ|\n end script\n \n return go's |λ|(tf)\nend apTree",
"tags": [
"AS Prelude",
"tree"
]
},
"apTuple (<*>)": {
"code": "-- apTuple (<*>) :: Monoid m => (m, (a -> b)) -> (m, a) -> (m, b)\non apTuple(tf, tx)\n Tuple(mappend(|1| of tf, |1| of tx), |λ|(|2| of tx) of mReturn(|2| of tf))\nend apTuple",
"tags": [
"AS Prelude"
]
},
"append (<>)": {
"code": "-- append (<>) :: [a] -> [a] -> [a]\n-- append (<>) :: String -> String -> String\non append(xs, ys)\n -- Append two lists.\n xs & ys\nend append",
"tags": [
"AS Prelude"
]
},
"appendFile": {
"code": "-- appendFile :: FilePath -> String -> IO Bool\non appendFile(strPath, txt)\n -- Write a string to the end of a file. \n -- Returns true if the path exists \n -- and the write succeeded. \n -- Otherwise returns false.\n set ca to current application\n set oFullPath to (ca's NSString's stringWithString:strPath)'s ¬\n stringByStandardizingPath\n set {blnExists, intFolder} to (ca's NSFileManager's defaultManager()'s ¬\n fileExistsAtPath:oFullPath isDirectory:(reference))\n \n if blnExists then\n if 0 = intFolder then\n set oData to (ca's NSString's stringWithString:txt)'s ¬\n dataUsingEncoding:(ca's NSUTF8StringEncoding)\n set h to ca's NSFileHandle's fileHandleForWritingAtPath:oFullPath\n h's seekToEndOfFile\n h's writeData:oData\n h's closeFile()\n true\n else\n -- text appended to folder is undefined\n false\n end if\n else\n if doesDirectoryExist(takeDirectory(oFullPath as string)) then\n writeFile(oFullPath, txt)\n true\n else\n false\n end if\n end if\nend appendFile",
"tags": [
"AS Prelude"
]
},
"appendFileMay": {
"code": "-- appendFileMay :: FilePath -> String -> Maybe IO FilePath\non appendFileMay(strPath, txt)\n -- Write a string to the end of a file. \n -- Returns a Just FilePath value if the \n -- path exists and the write succeeded. \n -- Otherwise returns Nothing.\n set ca to current application\n set oFullPath to (ca's NSString's stringWithString:strPath)'s ¬\n stringByStandardizingPath\n set strFullPath to oFullPath as string\n set {blnExists, intFolder} to (ca's NSFileManager's defaultManager()'s ¬\n fileExistsAtPath:oFullPath isDirectory:(reference))\n if blnExists then\n if 0 = intFolder then -- Not a directory\n set oData to (ca's NSString's stringWithString:txt)'s ¬\n dataUsingEncoding:(ca's NSUTF8StringEncoding)\n set h to ca's NSFileHandle's fileHandleForWritingAtPath:oFullPath\n h's seekToEndOfFile\n h's writeData:oData\n h's closeFile()\n Just(strFullPath)\n else\n Nothing()\n end if\n else\n if doesDirectoryExist(takeDirectory(strFullPath)) then\n writeFile(oFullPath, txt)\n Just(strFullPath)\n else\n Nothing()\n end if\n end if\nend appendFileMay",
"tags": [
"AS Prelude"
]
},
"appendGen": {
"code": "-- appendGen (++) :: Gen [a] -> Gen [a] -> Gen [a]\non appendGen(xs, ys)\n script\n property vs : xs\n on |λ|()\n set v to |λ|() of vs\n if missing value is not v then\n v\n else\n set vs to ys\n |λ|() of ys\n end if\n end |λ|\n end script\nend appendGen",
"tags": [
"AS Prelude"
]
},
"apply ($)": {
"code": "-- apply ($) :: (a -> b) -> a -> b\non apply(f, x)\n mReturn(f)'s |λ|(x)\nend apply",
"tags": [
"AS Prelude"
]
},
"applyN": {
"code": "-- applyN :: Int -> (a -> a) -> a -> a\non applyN(n, f, x)\n script go\n on |λ|(a, g)\n |λ|(a) of mReturn(g)\n end |λ|\n end script\n foldl(go, x, replicate(n, f))\nend applyN",
"tags": [
"AS Prelude"
]
},
"approxRatio": {
"code": "-- approxRatio :: Float -> Float -> Ratio\non approxRatio(epsilon, n)\n if {real, integer} contains (class of epsilon) and 0 < epsilon then\n set e to epsilon\n else\n set e to 1 / 10000\n end if\n \n script gcde\n on |λ|(e, x, y)\n script _gcd\n on |λ|(a, b)\n if b < e then\n a\n else\n |λ|(b, a mod b)\n end if\n end |λ|\n end script\n |λ|(abs(x), abs(y)) of _gcd\n end |λ|\n end script\n \n set c to |λ|(e, 1, n) of gcde\n Ratio((n div c), (1 div c))\nend approxRatio",
"tags": [
"AS Prelude"
]
},
"argvLength": {
"code": "-- argvLength :: Function -> Int\non argvLength(h)\n try\n mReturn(h)'s |λ|()\n 0\n on error errMsg\n set {dlm, my text item delimiters} to {my text item delimiters, \",\"}\n set xs to text items of errMsg\n set my text item delimiters to dlm\n length of xs\n end try\nend argvLength",
"tags": [
"AS Prelude"
]
},
"assocs": {
"code": "-- assocs :: Map k a -> [(k, a)]\non assocs(m)\n script go\n on |λ|(k)\n set mb to lookupDict(k, m)\n if true = |Nothing| of mb then\n {}\n else\n {{k, |Just| of mb}}\n end if\n end |λ|\n end script\n concatMap(go, keys(m))\nend assocs",
"tags": [
"AS Prelude"
]
},
"base64decode": {
"code": "-- base64decode :: String -> String\non base64decode(s)\n tell current application\n set encoding to its NSUTF8StringEncoding\n set ignore to its NSDataBase64DecodingIgnoreUnknownCharacters\n \n (((alloc() of its NSString)'s initWithData:((its (NSData's alloc()'s ¬\n initWithBase64EncodedString:s ¬\n options:(ignore)))) encoding:encoding)) as text\n end tell\nend base64decode",
"tags": [
"AS Prelude"
]
},
"base64encode": {
"code": "-- base64encode :: String -> String\non base64encode(s)\n tell current application\n set encodingOption to its NSUTF8StringEncoding\n base64EncodedStringWithOptions_(0) of ¬\n dataUsingEncoding_(encodingOption) of ¬\n (stringWithString_(s) of its NSString) as string\n end tell\nend base64encode",
"tags": [
"AS Prelude"
]
},
"bimap": {
"code": "-- bimap :: (a -> b) -> (c -> d) -> (a, c) -> (b, d)\non bimap(f, g)\n -- Tuple instance of bimap.\n -- A tuple of the application of f and g to the\n -- first and second values of tpl respectively.\n script\n on |λ|(x)\n {|λ|(fst(x)) of mReturn(f), ¬\n |λ|(snd(x)) of mReturn(g)}\n end |λ|\n end script\nend bimap",
"tags": [
"AS Prelude"
]
},
"bimapLR": {
"code": "-- bimapLR :: (a -> b) -> (c -> d) -> ֵEither ֵֵa c -> Either b d\non bimapLR(f, g)\n script go\n on |λ|(e)\n if missing value is |Left| of e then\n tell mReturn(g) to |Right|(|λ|(|Right| of e))\n else\n tell mReturn(f) to |Left|(|λ|(|Left| of e))\n end if\n end |λ|\n end script\nend bimapLR",
"tags": [
"AS Prelude"
]
},
"bimapN": {
"code": "-- bimapN :: (a -> b) -> (c -> d) -> TupleN -> TupleN\non bimapN(f, g, tplN)\n set z to length of tplN\n set k1 to (z - 1) as string\n set k2 to z as string\n \n insertDict(k2, mReturn(g)'s |λ|(Just of lookupDict(k2, tplN)), ¬\n insertDict(k1, mReturn(f)'s |λ|(Just of lookupDict(k1, tplN)), tplN))\nend bimapN",
"tags": [
"AS Prelude"
]
},
"bind (>>=)": {
"code": "-- bind (>>=) :: Monad m => m a -> (a -> m b) -> m b\non bind(m, mf)\n set c to class of m\n if list = c then\n bindList(m, mf)\n else if record = c then\n set ks to keys(m)\n if ks contains \"type\" then\n set t to type of m\n if \"Maybe\" = t then\n bindMay(m, mf)\n else if \"Either\" = t then\n bindLR(m, mf)\n else if \"Tuple\" = t then\n bindTuple(m, mf)\n else\n missing value\n end if\n else\n missing value\n end if\n else if handler is c or script is c then\n bindFn(m, mf)\n else\n missing value\n end if\nend bind",
"tags": [
"AS Prelude"
]
},
"bindFn (>>=)": {
"code": "-- bindFn (>>=) :: (a -> b) -> (b -> a -> c) -> a -> c\non bindFn(f, bop)\n -- Where either bop or f is a binary operator.\n script\n property mf : mReturn(f)\n property mop : mReturn(bop)\n on |λ|(x)\n try\n curry(mop)'s |λ|(mf's |λ|(x))'s |λ|(x)\n on error\n mop's |λ|(curry(mf)'s |λ|(x))'s |λ|(x)\n end try\n end |λ|\n end script\nend bindFn",
"tags": [
"AS Prelude"
]
},
"bindLR (>>=)": {
"code": "-- bindLR (>>=) :: Either a -> (a -> Either b) -> Either b\non bindLR(m, mf)\n if missing value is not |Left| of m then\n m\n else\n mReturn(mf)'s |λ|(|Right| of m)\n end if\nend bindLR",
"tags": [
"AS Prelude"
]
},
"bindList (>>=)": {
"code": "-- bindList (>>=) :: [a] -> (a -> [b]) -> [b]\non bindList(xs, f)\n set acc to {}\n tell mReturn(f)\n repeat with x in xs\n set acc to acc & |λ|(contents of x)\n end repeat\n end tell\n return acc\nend bindList",
"tags": [
"AS Prelude"
]
},
"bindMay (>>=)": {
"code": "-- bindMay (>>=) :: Maybe a -> (a -> Maybe b) -> Maybe b\non bindMay(mb, mf)\n -- bindMay provides the mechanism for composing a\n -- sequence of (a -> Maybe b) functions.\n -- If m is Nothing, it is passed straight through.\n -- If m is Just(x), the result is an application\n -- of the (a -> Maybe b) function (mf) to x.\n if Nothing of mb then\n mb\n else\n tell mReturn(mf) to |λ|(Just of mb)\n end if\nend bindMay",
"tags": [
"AS Prelude"
]
},
"bindTuple (>>=)": {
"code": "-- bindTuple (>>=) :: Monoid a => (a, a) -> (a -> (a, b)) -> (a, b)\non bindTuple(tpl, f)\n set t2 to mReturn(f)'s |λ|(|2| of tpl)\n Tuple(mappend(|1| of tpl, |1| of t2), |2| of t2)\nend bindTuple",
"tags": [
"AS Prelude"
]
},
"bool": {
"code": "-- bool :: a -> a -> Bool -> a\non bool(ff, tf)\n -- The evaluation of either tf or ff, \n -- depending on a boolean value.\n script\n on |λ|(bln)\n if bln then\n set e to tf\n else\n set e to ff\n end if\n set c to class of e\n if {script, handler} contains c then\n |λ|() of mReturn(e)\n else\n e\n end if\n end |λ|\n end script\nend bool",
"tags": [
"AS Prelude"
]
},
"break": {
"code": "-- break :: (a -> Bool) -> [a] -> ([a], [a])\non break(p, xs)\n set bln to false\n tell mReturn(p)\n set lng to length of xs\n repeat with i from 1 to lng\n if |λ|(item i of xs) then\n set bln to true\n exit repeat\n end if\n end repeat\n end tell\n if bln then\n if 1 < i then\n {items 1 thru (i - 1) of xs, items i thru -1 of xs}\n else\n {{}, xs}\n end if\n else\n {xs, {}}\n end if\nend break",
"tags": [
"AS Prelude"
]
},
"breakOn": {
"code": "-- breakOn :: String -> String -> (String, String)\non breakOn(pat, src)\n -- non null needle -> haystack -> (prefix before match, match + rest)\n if pat ≠ \"\" then\n set {dlm, my text item delimiters} to {my text item delimiters, pat}\n \n set lstParts to text items of src\n set lngParts to length of lstParts\n \n if 1 < lngParts then\n set tpl to {item 1 of lstParts, pat & ¬\n ((items 2 thru -1 of lstParts) as text)}\n else\n set tpl to Tuple(src, \"\")\n end if\n \n set my text item delimiters to dlm\n return tpl\n else\n missing value\n end if\nend breakOn",
"tags": [
"AS Prelude"
]
},
"breakOnAll": {
"code": "-- breakOnAll :: String -> String -> [(String, String)]\non breakOnAll(pat, src)\n -- breakOnAll \"/\" \"a/b/c/\"\n -- ==> [(\"a\", \"/b/c/\"), (\"a/b\", \"/c/\"), (\"a/b/c\", \"/\")]\n if \"\" ≠ pat then\n script\n on |λ|(a, _, i, xs)\n if 1 < i then\n a & {{intercalate(pat, take(i - 1, xs)), ¬\n pat & intercalate(pat, drop(i - 1, xs))}}\n else\n a\n end if\n end |λ|\n end script\n foldl(result, {}, splitOn(pat, src))\n else\n missing value\n end if\nend breakOnAll",
"tags": [
"AS Prelude"
]
},
"breakOnMay": {
"code": "-- breakOnMay :: String -> String -> Maybe (String, String)\non breakOnMay(pat, src)\n -- needle -> haystack -> maybe (prefix before match, match + rest)\n if pat ≠ \"\" then\n set {dlm, my text item delimiters} to {my text item delimiters, pat}\n \n set lstParts to text items of src\n if length of lstParts > 1 then\n set mbTuple to Just({item 1 of lstParts, pat & ¬\n ((items 2 thru -1 of lstParts) as text)})\n else\n set mbTuple to Just({src, \"\"})\n end if\n \n set my text item delimiters to dlm\n return mbTuple\n else\n Nothing()\n end if\nend breakOnMay",
"tags": [
"AS Prelude"
]
},
"bulleted": {
"code": "-- bulleted :: String -> String -> String\non bulleted(strIndent, s)\n script go\n on |λ|(x)\n if \"\" ≠ x then\n strIndent & \"- \" & x\n else\n x\n end if\n end |λ|\n end script\n unlines(map(go, paragraphs of s))\nend bulleted",
"tags": [
"AS Prelude"
]
},
"cartesianProduct": {
"code": "-- cartesianProduct :: [a] -> [b] -> [[a, b]]\non cartesianProduct(xs, ys)\n script\n on |λ|(x)\n script\n on |λ|(y)\n {x, y}\n end |λ|\n end script\n concatMap(result, ys)\n end |λ|\n end script\n concatMap(result, xs)\nend cartesianProduct",
"tags": [
"AS Prelude"
]
},
"caseOf": {
"code": "-- caseOf :: [(a -> Bool, b)] -> b -> a -> b\non caseOf (pvs, otherwise, x)\n -- List of (Predicate, value) tuples -> Default value -> Value to test -> Output value\n repeat with tpl in pvs\n if mReturn(|1| of tpl)'s |λ|(x) then return |2| of tpl\n end repeat\n return otherwise\nend caseOf",
"tags": [
"AS Prelude"
]
},
"catMaybes": {
"code": "-- catMaybes :: [Maybe a] -> [a]\non catMaybes(mbs)\n script emptyOrListed\n on |λ|(m)\n if Nothing of m then\n {}\n else\n {Just of m}\n end if\n end |λ|\n end script\n concatMap(emptyOrListed, mbs)\nend catMaybes",
"tags": [
"AS Prelude"
]
},
"ceiling": {
"code": "-- ceiling :: Num -> Int\non ceiling(x)\n set nr to properFraction(x)\n set n to |1| of nr\n if 0 < (|2| of nr) then\n n + 1\n else\n n\n end if\nend ceiling",
"tags": [
"AS Prelude"
]
},
"center": {
"code": "-- center :: Int -> Char -> String -> String\non |center|(n, cFiller, strText)\n set lngFill to n - (length of strText)\n if lngFill > 0 then\n set strPad to replicate(lngFill div 2, cFiller) as text\n set strCenter to strPad & strText & strPad\n if lngFill mod 2 > 0 then\n cFiller & strCenter\n else\n strCenter\n end if\n else\n strText\n end if\nend |center|",
"tags": [
"AS Prelude"
]
},
"chars": {
"code": "-- chars :: String -> [Char]\non chars(s)\n characters of s\nend chars",
"tags": [
"AS Prelude"
]
},
"chop": {
"code": "-- chop :: ([a] -> (b, [a])) -> [a] -> [b]\non chop(f, xs)\n script go\n property g : mReturn(f)\n on |λ|(xs)\n if 0 < length of xs then\n set {b, ys} to g's |λ|(xs)\n {b} & |λ|(ys)\n else\n {}\n end if\n end |λ|\n end script\n go's |λ|(xs)\nend chop",
"tags": [
"AS Prelude"
]
},
"chr": {
"code": "-- chr :: Int -> Char\non chr(n)\n character id n\nend chr",
"tags": [
"AS Prelude"
]
},
"chunksOf": {
"code": "-- chunksOf :: Int -> [a] -> [[a]]\non chunksOf(k, xs)\n script\n on go(ys)\n set ab to splitAt(k, ys)\n set a to item 1 of ab\n if {} ≠ a then\n {a} & go(item 2 of ab)\n else\n a\n end if\n end go\n end script\n result's go(xs)\nend chunksOf",
"tags": [
"AS Prelude"
]
},
"combine": {
"code": "-- combine (</>) :: FilePath -> FilePath -> FilePath\non combine(fp, fp1)\n -- The concatenation of two filePath segments,\n -- without omission or duplication of \"/\".\n if \"\" = fp or \"\" = fp1 then\n fp & fp1\n else if \"/\" = item 1 of fp1 then\n fp1\n else if \"/\" = item -1 of fp then\n fp & fp1\n else\n fp & \"/\" & fp1\n end if\nend combine",
"tags": [
"AS Prelude"
]
},
"compare": {
"code": "-- compare :: a -> a -> Ordering\non compare(a, b)\n if a < b then\n -1\n else if a > b then\n 1\n else\n 0\n end if\nend compare",
"tags": [
"AS Prelude"
]
},
"comparing": {
"code": "-- comparing :: (a -> b) -> (a -> a -> Ordering)\non comparing(f)\n script\n on |λ|(a, b)\n tell mReturn(f)\n set fa to |λ|(a)\n set fb to |λ|(b)\n if fa < fb then\n -1\n else if fa > fb then\n 1\n else\n 0\n end if\n end tell\n end |λ|\n end script\nend comparing",
"tags": [
"AS Prelude"
]
},
"compose (<<<)": {
"code": "-- compose (<<<) :: (b -> c) -> (a -> b) -> a -> c\non compose(f, g)\n script\n property mf : mReturn(f)\n property mg : mReturn(g)\n on |λ|(x)\n mf's |λ|(mg's |λ|(x))\n end |λ|\n end script\nend compose",
"tags": [
"AS Prelude"
]
},
"composeList": {
"code": "-- composeList :: [(a -> a)] -> (a -> a)\non composeList(fs)\n script\n on |λ|(x)\n script go\n on |λ|(f, a)\n mReturn(f)'s |λ|(a)\n end |λ|\n end script\n foldr(go, x, fs)\n end |λ|\n end script\nend composeList",
"tags": [
"AS Prelude"
]
},
"composeListR": {
"code": "-- composeListR :: [(a -> a)] -> (a -> a)\non composeListR(fs)\n script\n on |λ|(x)\n script go\n on |λ|(a, f)\n mReturn(f)'s |λ|(a)\n end |λ|\n end script\n \n foldl(go, x, fs)\n end |λ|\n end script\nend composeListLR",
"tags": [
"AS Prelude"
]
},
"composeR (>>>)": {
"code": "-- composeR (>>>) :: (a -> b) -> (b -> c) -> a -> c\non composeR(f, g)\n script\n on |λ|(x)\n |λ|(|λ|(x) of mReturn(f)) of mReturn(g)\n end |λ|\n end script\nend composeR",
"tags": [
"AS Prelude"
]
},
"concat": {
"code": "-- concat :: [[a]] -> [a]\non concat(xs)\n ((current application's NSArray's arrayWithArray:xs)'s ¬\n valueForKeyPath:\"@unionOfArrays.self\") as list\nend concat",
"tags": [
"AS Prelude"
]
},
"concatMap": {
"code": "-- concatMap :: (a -> [b]) -> [a] -> [b]\ron concatMap(f, xs)\r set lng to length of xs\r set acc to {}\r \r tell mReturn(f)\r repeat with i from 1 to lng\r set acc to acc & (|λ|(item i of xs, i, xs))\r end repeat\r end tell\r acc\rend concatMap",
"tags": [
"AS Prelude"
]
},
"cons": {
"code": "-- cons :: a -> [a] -> [a]\non cons(x, xs)\n set c to class of xs\n if list is c then\n {x} & xs\n else if script is c then\n script\n property pRead : false\n on |λ|()\n if pRead then\n |λ|() of xs\n else\n set pRead to true\n return x\n end if\n end |λ|\n end script\n else\n x & xs\n end if\nend cons",
"tags": [
"AS Prelude"
]
},
"constant": {
"code": "-- constant :: a -> b -> a\non |constant|(k)\n script\n on |λ|(_)\n k\n end |λ|\n end script\nend |constant|",
"tags": [
"AS Prelude"
]
},
"createDirectoryIfMissingLR": {
"code": "-- createDirectoryIfMissingLR :: Bool -> FilePath -> Either String FilePath\non createDirectoryIfMissingLR(blnParents, fp)\n if doesPathExist(fp) then\n |Right|(fp)\n else\n set e to reference\n set ca to current application\n set oPath to (ca's NSString's stringWithString:(fp))'s ¬\n stringByStandardizingPath\n set {blnOK, e} to ca's NSFileManager's ¬\n defaultManager's createDirectoryAtPath:(oPath) ¬\n withIntermediateDirectories:(blnParents) ¬\n attributes:(missing value) |error|:(e)\n if blnOK then\n |Right|(fp)\n else\n |Left|((localizedDescription of e) as string)\n end if\n end if\nend createDirectoryIfMissingLR",
"tags": [
"AS Prelude"
]
},
"curry": {
"code": "-- curry :: ((a, b) -> c) -> a -> b -> c\non curry(f)\n script\n on |λ|(a)\n script\n on |λ|(b)\n |λ|(a, b) of mReturn(f)\n end |λ|\n end script\n end |λ|\n end script\nend curry",
"tags": [
"AS Prelude"
]
},
"cycle": {
"code": "-- cycle :: [a] -> Generator [a]\non cycle(xs)\n script\n property lng : 1 + (length of xs)\n property i : missing value\n on |λ|()\n if missing value is i then\n set i to 1\n else\n set nxt to (1 + i) mod lng\n if 0 = ((1 + i) mod lng) then\n set i to 1\n else\n set i to nxt\n end if\n end if\n return item i of xs\n end |λ|\n end script\nend cycle",
"tags": [
"AS Prelude"
]
},
"decodedPath": {
"code": "-- decodedPath :: Percent Encoded String -> FilePath\non decodedPath(fp)\n -- use framework \"Foundation\"\n tell current application to ¬\n (stringByRemovingPercentEncoding ¬\n of stringWithString_(fp) ¬\n of its NSString) as string\nend decodedPath",
"tags": [
"AS Prelude"
]
},
"degrees": {
"code": "-- degrees :: Float x => Radians x -> Degrees x\non degrees(r)\n (180 / pi) * r\nend degrees",
"tags": [
"AS Prelude"
]
},
"delete": {
"code": "-- delete :: Eq a => a -> [a] -> [a]\non |delete|(x, xs)\n set mbIndex to elemIndex(x, xs)\n set lng to length of xs\n \n if Nothing of mbIndex then\n xs\n else\n if 1 < lng then\n set i to Just of mbIndex\n if 1 = i then\n items 2 thru -1 of xs\n else if lng = i then\n items 1 thru -2 of xs\n else\n tell xs to items 1 thru (i - 1) & items (i + 1) thru -1\n end if\n else\n {}\n end if\n end if\nend |delete|",
"tags": [
"AS Prelude"
]
},
"deleteAt": {
"code": "-- deleteAt :: Int -> [a] -> [a]\non deleteAt(i, xs)\n set lr to splitAt(i, xs)\n set {l, r} to {|1| of lr, |2| of lr}\n if 1 < length of r then\n l & items 2 thru -1 of r\n else\n l\n end if\nend deleteAt",
"tags": [
"AS Prelude"
]
},
"deleteBy": {
"code": "-- deleteBy :: (a -> a -> Bool) -> a -> [a] -> [a]\non deleteBy(fnEq, x, xs)\n script go\n property eq : mReturn(fnEq)'s |λ|\n on |λ|(xs)\n if 0 < length of xs then\n tell xs to set {h, t} to {item 1, rest}\n if eq(x, h) then\n t\n else\n {h} & |λ|(t)\n end if\n else\n {}\n end if\n end |λ|\n end script\n go's |λ|(xs)\nend deleteBy",
"tags": [
"AS Prelude"
]
},
"deleteFirst": {
"code": "-- deleteFirst :: a -> [a] -> [a]\non deleteFirst(x, xs)\n script go\n on |λ|(xs)\n if 0 < length of xs then\n tell xs to set {h, t} to {item 1, rest}\n if x = h then\n t\n else\n {h} & |λ|(t)\n end if\n else\n {}\n end if\n end |λ|\n end script\n go's |λ|(xs)\nend deleteFirst",
"tags": [
"AS Prelude"
]
},
"deleteFirstsBy": {
"code": "-- deleteFirstsBy :: (a -> a -> Bool) -> [a] -> [a] -> [a]\non deleteFirstsBy(fnEq, xs, ys)\n script\n on |λ|(x, y)\n deleteBy(fnEq, y, x)\n end |λ|\n end script\n foldl(result, xs, ys)\nend deleteFirstsBy",
"tags": [
"AS Prelude"
]
},
"deleteKey": {
"code": "-- deleteKey :: String -> Dict -> Dict\non deleteKey(k, rec)\n tell current application to set nsDct to ¬\n dictionaryWithDictionary_(rec) of its NSMutableDictionary\n removeObjectForKey_(k) of nsDct\n nsDct as record\nend deleteKey",
"tags": [
"AS Prelude"
]
},
"dictFromList": {
"code": "-- dictFromList :: [(k, v)] -> Dict\non dictFromList(kvs)\n set tpl to unzip(kvs)\n script go\n on |λ|(x)\n x as string\n end |λ|\n end script\n tell current application\n (its (NSDictionary's dictionaryWithObjects:(my snd(tpl)) ¬\n forKeys:(my map(go, my fst(tpl))))) as record\n end tell\nend dictFromList",
"tags": [
"AS Prelude"
]
},
"difference": {
"code": "-- difference :: Eq a => [a] -> [a] -> [a]\non difference(xs, ys)\n script p\n on |λ|(x)\n x is not in ys\n end |λ|\n end script\n filter(p, xs)\nend difference",
"tags": [
"AS Prelude"
]
},
"differenceGen": {
"code": "-- differenceGen :: Gen [a] -> Gen [a] -> Gen [a]\non differenceGen(ga, gb)\n -- All values of ga except any\n -- already seen in gb.\n script\n property g : zipGen(ga, gb)\n property bs : {}\n property xy : missing value\n on |λ|()\n set xy to g's |λ|()\n if missing value is xy then\n xy\n else\n set x to |1| of xy\n set y to |2| of xy\n set bs to {y} & bs\n if bs contains x then\n |λ|() -- Next in series.\n else\n x\n end if\n end if\n end |λ|\n end script\nend differenceGen",
"tags": [
"AS Prelude"
]
},
"digitToInt": {
"code": "-- digitToInt :: Char -> Int\non digitToInt(c)\n set oc to id of c\n if 48 > oc or 102 < oc then\n missing value\n else\n set dec to oc - (id of \"0\")\n set hexu to oc - (id of \"A\")\n set hexl to oc - (id of \"a\")\n if 9 ≥ dec then\n dec\n else if 0 ≤ hexu and 5 ≥ hexu then\n 10 + hexu\n else if 0 ≤ hexl and 5 ≥ hexl then\n 10 + hexl\n else\n missing value\n end if\n end if\nend digitToInt",
"tags": [
"AS Prelude"
]
},
"div": {
"code": "-- div :: Int -> Int -> Int\non |div|(a, b)\n set v to (a / b)\n set i to round (v)\n if 0 < (i - v) then\n i - 1\n else\n i\n end if\nend |div|",
"tags": [
"AS Prelude"
]
},
"divMod": {
"code": "-- divMod :: Int -> Int -> (Int, Int)\non divMod(n, d)\n -- Integer division, truncated toward negative infinity,\n -- and integer modulus such that:\n -- (x `div` y)*y + (x `mod` y) == x\n set {q, r} to {n div d, n mod d}\n if signum(r) = signum(-d) then\n {q - 1, r + d}\n else\n {q, r}\n end if\nend divMod",
"tags": [
"AS Prelude"
]
},
"doesDirectoryExist": {
"code": "-- doesDirectoryExist :: FilePath -> IO Bool\ron doesDirectoryExist(strPath)\r set ca to current application\r set oPath to (ca's NSString's stringWithString:strPath)'s ¬\r stringByStandardizingPath\r set {bln, v} to (ca's NSFileManager's defaultManager's ¬\r fileExistsAtPath:oPath isDirectory:(reference))\r bln and v\rend doesDirectoryExist",
"tags": [
"AS Prelude"
]
},
"doesFileExist": {
"code": "-- doesFileExist :: FilePath -> IO Bool\non doesFileExist(strPath)\n set ca to current application\n set oPath to (ca's NSString's stringWithString:strPath)'s ¬\n stringByStandardizingPath\n set {bln, int} to (ca's NSFileManager's defaultManager's ¬\n fileExistsAtPath:oPath isDirectory:(reference))\n bln and (1 ≠ int)\nend doesFileExist",
"tags": [
"AS Prelude"
]
},
"doesPathExist": {
"code": "-- doesPathExist :: FilePath -> IO Bool\non doesPathExist(strPath)\n set ca to current application\n ca's NSFileManager's defaultManager's ¬\n fileExistsAtPath:((ca's NSString's ¬\n stringWithString:strPath)'s ¬\n stringByStandardizingPath)\nend doesPathExist",
"tags": [
"AS Prelude"
]
},
"draw": {
"code": "-- draw :: Tree String -> [String]\non draw(tree)\n \n -- shift :: String -> String -> [String] -> [String]\n script shift\n on |λ|(strFirst, strOther, xs)\n zipWith(my append, ¬\n cons(strFirst, replicate((length of xs) - 1, strOther)), xs)\n end |λ|\n end script\n \n -- drawSubTrees :: [Tree String] -> [String]\n script drawSubTrees\n on |λ|(xs)\n set lng to length of xs\n if 0 < lng then\n if 1 < lng then\n cons(\"│\", append(shift's |λ|(\"├─ \", \"│ \", draw(item 1 of xs)), ¬\n |λ|(items 2 thru -1 of xs)))\n else\n cons(\"│\", shift's |λ|(\"└─ \", \" \", draw(item 1 of xs)))\n end if\n else\n {}\n end if\n end |λ|\n end script\n \n paragraphs of (root of tree) & |λ|(nest of tree) of drawSubTrees\nend draw",
"tags": [
"AS Prelude",
"tree"
]
},
"drawForest": {
"code": "-- drawForest :: [Tree String] -> String\non drawForest(trees)\n intercalate(\"\\n\\n\", map(my drawTree, trees))\nend drawForest",
"tags": [
"AS Prelude",
"tree"
]
},
"drawTree": {
"code": "-- drawTree :: Tree String -> String\non drawTree(tree)\n unlines(draw(tree))\nend drawTree",
"tags": [
"AS Prelude",
"tree"
]
},
"drawTree2": {
"code": "-- drawTree2 :: Bool -> Bool -> Tree String -> String\non drawTree2(blnCompressed, blnPruned, tree)\n -- Tree design and algorithm inspired by the Haskell snippet at:\n -- https://doisinkidney.com/snippets/drawing-trees.html\n script measured\n on |λ|(t)\n script go\n on |λ|(x)\n set s to \" \" & x & \" \"\n Tuple(length of s, s)\n end |λ|\n end script\n fmapTree(go, t)\n end |λ|\n end script\n set measuredTree to |λ|(tree) of measured\n \n script levelMax\n on |λ|(a, level)\n a & maximum(map(my fst, level))\n end |λ|\n end script\n set levelWidths to foldl(levelMax, {}, ¬\n init(levels(measuredTree)))\n \n -- Lefts, Mid, Rights\n script lmrFromStrings\n on |λ|(xs)\n set {ls, rs} to items 2 thru -2 of ¬\n (splitAt((length of xs) div 2, xs) as list)\n Tuple3(ls, item 1 of rs, rest of rs)\n end |λ|\n end script\n \n script stringsFromLMR\n on |λ|(lmr)\n script add\n on |λ|(a, x)\n a & x\n end |λ|\n end script\n foldl(add, {}, items 2 thru -2 of (lmr as list))\n end |λ|\n end script\n \n script fghOverLMR\n on |λ|(f, g, h)\n script\n property mg : mReturn(g)\n on |λ|(lmr)\n set {ls, m, rs} to items 2 thru -2 of (lmr as list)\n Tuple3(map(f, ls), |λ|(m) of mg, map(h, rs))\n end |λ|\n end script\n end |λ|\n end script\n \n script treeFix\n on cFix(x)\n script\n on |λ|(xs)\n x & xs\n end |λ|\n end script\n end cFix\n \n on |λ|(l, m, r)\n compose(stringsFromLMR, ¬\n |λ|(cFix(l), cFix(m), cFix(r)) of ¬\n fghOverLMR)\n end |λ|\n end script\n\n script lmrBuild\n on leftPad(n)\n script\n on |λ|(s)\n replicateString(n, space) & s\n end |λ|\n end script\n end leftPad\n \n -- lmrBuild main\n on |λ|(w, f)\n script\n property mf : mReturn(f)\n on |λ|(wsTree)\n set xs to nest of wsTree\n set lng to length of xs\n set {nChars, x} to items 2 thru -2 of ¬\n ((root of wsTree) as list)\n set _x to replicateString(w - nChars, \"─\") & x\n \n script linked\n on |λ|(s)\n set c to text 1 of s\n set t to tail(s)\n if \"┌\" = c then\n _x & \"┬\" & t\n else if \"│\" = c then\n _x & \"┤\" & t\n else if \"├\" = c then\n _x & \"┼\" & t\n else\n _x & \"┴\" & t\n end if\n end |λ|\n end script\n \n -- LEAF NODE --------------------------------------\n if 0 = lng then\n Tuple3({}, _x, {})\n \n else if 1 = lng then\n -- NODE WITH SINGLE CHILD ---------------------\n set indented to leftPad(1 + w)\n script lineLinked\n on |λ|(z)\n _x & \"─\" & z\n end |λ|\n end script\n |λ|(|λ|(item 1 of xs) of mf) of ¬\n (|λ|(indented, lineLinked, indented) of ¬\n fghOverLMR)\n else\n -- NODE WITH CHILDREN -------------------------\n set indented to leftPad(w)\n set lmrs to map(f, xs)\n if blnCompressed then\n set sep to {}\n else\n set sep to {\"│\"}\n end if\n \n tell lmrFromStrings\n set tupleLMR to |λ|(intercalate(sep, ¬\n {|λ|(item 1 of lmrs) of ¬\n (|λ|(\" \", \"┌\", \"│\") of treeFix)} & ¬\n map(|λ|(\"│\", \"├\", \"│\") of treeFix, ¬\n init(tail(lmrs))) & ¬\n {|λ|(item -1 of lmrs) of ¬\n (|λ|(\"│\", \"└\", \" \") of treeFix)}))\n end tell\n \n |λ|(tupleLMR) of ¬\n (|λ|(indented, linked, indented) of fghOverLMR)\n end if\n end |λ|\n end script\n end |λ|\n end script\n \n set treeLines to |λ|(|λ|(measuredTree) of ¬\n foldr(lmrBuild, 0, levelWidths)) of stringsFromLMR\n if blnPruned then\n script notEmpty\n on |λ|(s)\n script isData\n on |λ|(c)\n \"│ \" does not contain c\n end |λ|\n end script\n any(isData, characters of s)\n end |λ|\n end script\n set xs to filter(notEmpty, treeLines)\n else\n set xs to treeLines\n end if\n unlines(xs)\nend drawTree2",
"tags": [
"AS Prelude",
"tree"
]
},
"drop": {
"code": "-- drop :: Int -> [a] -> [a]\n-- drop :: Int -> String -> String\non drop(n, xs)\n set c to class of xs\n if script is not c then\n if string is not c then\n if n < length of xs then\n items (1 + n) thru -1 of xs\n else\n {}\n end if\n else\n if n < length of xs then\n text (1 + n) thru -1 of xs\n else\n \"\"\n end if\n end if\n else\n take(n, xs) -- consumed\n return xs\n end if\nend drop",
"tags": [
"AS Prelude"
]
},
"dropAround": {
"code": "-- dropAround :: (a -> Bool) -> [a] -> [a]\n-- dropAround :: (Char -> Bool) -> String -> String\non dropAround(p, xs)\n dropWhile(p, dropWhileEnd(p, xs))\nend dropAround",
"tags": [
"AS Prelude"
]
},
"dropFileName": {
"code": "-- dropFileName :: FilePath -> FilePath\non dropFileName(strPath)\n if strPath ≠ \"\" then\n if character -1 of strPath = \"/\" then\n strPath\n else\n set xs to init(splitOn(\"/\", strPath))\n if xs ≠ {} then\n intercalate(\"/\", xs) & \"/\"\n else\n \"./\"\n end if\n end if\n else\n \"./\"\n end if\nend dropFileName",
"tags": [
"AS Prelude"
]
},
"dropLength": {
"code": "-- dropLength :: [a] -> [b] -> [b]\non dropLength(xs, ys)\n script go\n on |λ|(x, y)\n if 0 < length of x then\n if 0 < length of y then\n |λ|(tail(x), tail(y))\n else\n {}\n end if\n else\n y\n end if\n end |λ|\n end script\n go's |λ|(xs, ys)\nend dropLength",
"tags": [
"AS Prelude"
]
},
"dropLengthMaybe": {
"code": "-- dropLengthMaybe :: [a] -> [b] -> Maybe [b]\non dropLengthMaybe(xs, ys)\n script go\n on |λ|(x, y)\n if 0 < length of x then\n if 0 < length of y then\n |λ|(tail(x), tail(y))\n else\n Nothing()\n end if\n else\n Just(y)\n end if\n end |λ|\n end script\n go's |λ|(xs, ys)\nend dropLengthMaybe",
"tags": [
"AS Prelude"
]
},
"dropWhile": {
"code": "-- dropWhile :: (a -> Bool) -> [a] -> [a]\n-- dropWhile :: (Char -> Bool) -> String -> String\non dropWhile(p, xs)\n set lng to length of xs\n set i to 1\n tell mReturn(p)\n repeat while i ≤ lng and |λ|(item i of xs)\n set i to i + 1\n end repeat\n end tell\n if {} ≠ xs then\n items i thru -1 of xs\n else\n xs\n end if\nend dropWhile",
"tags": [
"AS Prelude"
]
},
"dropWhileEnd": {
"code": "-- dropWhileEnd :: (a -> Bool) -> [a] -> [a]\n-- dropWhileEnd :: (Char -> Bool) -> String -> String\non dropWhileEnd(p, xs)\n set i to length of xs\n tell mReturn(p)\n repeat while i > 0 and |λ|(item i of xs)\n set i to i - 1\n end repeat\n end tell\n take(i, xs)\nend dropWhileEnd",
"tags": [
"AS Prelude"
]
},
"dropWhileGen": {
"code": "-- dropWhileGen :: (a -> Bool) -> Gen [a] -> [a]\non dropWhileGen(p, xs)\n set v to |λ|() of xs\n tell mReturn(p)\n repeat while (|λ|(v))\n set v to xs's |λ|()\n end repeat\n end tell\n return cons(v, xs)\nend dropWhileGen",
"tags": [
"AS Prelude"
]
},
"either": {
"code": "-- either :: (a -> c) -> (b -> c) -> Either a b -> c\non either(lf, rf, e)\n if missing value is |Left| of e then\n tell mReturn(rf) to |λ|(|Right| of e)\n else\n tell mReturn(lf) to |λ|(|Left| of e)\n end if\nend either",
"tags": [
"AS Prelude"
]
},
"elem": {
"code": "-- elem :: Eq a => a -> [a] -> Bool\non elem(x, xs)\n considering case\n xs contains x\n end considering\nend elem",
"tags": [
"AS Prelude"
]
},
"elemAtMay": {
"code": "-- elemAtMay :: Int -> Dict -> Maybe (String, a)\n-- elemAtMay :: Int -> [a] -> Maybe a\non elemAtMay(i, x)\n -- If x is a Dictionary then reads the Int as an index\n -- into the lexically sorted keys of the Dict, \n -- returning a Maybe (Key, Value) pair.\n -- If x is a list, then return a Maybe a \n -- (In either case, returns Nothing for an Int out of range)\n set bln to class of x is record\n if bln then\n set ks to keys(x)\n if i ≤ |length|(ks) then\n set k to item i of sort(ks)\n script pair\n on |λ|(v)\n Just(Tuple(k, v))\n end |λ|\n end script\n bindMay(lookup(k, x), pair)\n end if\n else\n if i ≤ |length|(x) then\n Just(item i of x)\n else\n Nothing()\n end if\n end if\nend elemAtMay",
"tags": [
"AS Prelude"
]
},
"elemIndex": {
"code": "-- elemIndex :: Eq a => a -> [a] -> Maybe Int\ron elemIndex(x, xs)\r -- Just the zero-based index of x in xs,\r -- or Nothing if x is not found in xs.\r\tset lng to length of xs\r\trepeat with i from 1 to lng\r\t\tif x = (item i of xs) then return Just(i - 1)\r\tend repeat\r\treturn Nothing()\rend elemIndex",
"tags": [
"AS Prelude"
]
},
"elemIndices": {
"code": "-- elemIndices :: Eq a => a -> [a] -> [Int]\non elemIndices(x, xs)\n script\n on |λ|(y, i)\n if y = x then\n {i}\n else\n {}\n end if\n end |λ|\n end script\n concatMap(result, xs)\nend elemIndices",
"tags": [
"AS Prelude"
]
},
"elems": {
"code": "-- elems :: Map k a -> [a]\n-- elems :: Set a -> [a]\non elems(x)\n if record is class of x then -- Dict\n tell current application to allValues() ¬\n of dictionaryWithDictionary_(x) ¬\n of its NSDictionary as list\n else -- Set\n (allObjects() of x) as list\n end if\nend elems",
"tags": [
"AS Prelude"
]
},
"encodedPath": {
"code": "-- encodedPath :: FilePath -> Percent Encoded String\non encodedPath(fp)\n tell current application\n set charSet to URLPathAllowedCharacterSet of its NSCharacterSet\n (stringByAddingPercentEncodingWithAllowedCharacters_(charSet) of ¬\n stringWithString_(fp) of its NSString) as string\n end tell\nend encodedPath",
"tags": [
"AS Prelude"
]
},
"enumFrom": {
"code": "-- enumFrom :: Enum a => a -> [a]\non enumFrom(x)\n script\n property v : missing value\n property blnNum : class of x is not text\n on |λ|()\n if missing value is not v then\n if blnNum then\n set v to 1 + v\n else\n set v to succ(v)\n end if\n else\n set v to x\n end if\n return v\n end |λ|\n end script\nend enumFrom",
"tags": [
"AS Prelude"
]
},
"enumFromPairs": {
"code": "-- enumFromPairs :: String -> [(String, Int)] -> Dict\non enumFromPairs(strName, kvs)\n set iMax to item 1 of item -1 of kvs\n set iMin to item 1 of item 1 of kvs\n script go\n on |λ|(a, kv)\n set {k, v} to kv\n insertMap(insertMap(a, k, ¬\n {type:\"enum\", |name|:¬\n strName, |key|:k, min:iMin, max:iMax, value:v}), v, k)\n end |λ|\n end script\n foldl(go, {|name|:strName, min:iMin, max:iMax}, kvs)\nend enumFromPairs",
"tags": [
"AS Prelude"
]
},
"enumFromThen": {
"code": "-- enumFromThen :: Int -> Int -> Gen [Int]\non enumFromThen(m, n)\n -- A non-finite stream of integers,\n -- starting with m and n, and continuing\n -- with the same interval.\n script\n property d : n - m\n property v : m\n on |λ|()\n set x to v\n set v to d + v\n return x\n end |λ|\n end script\nend enumFromThen",
"tags": [
"AS Prelude"
]
},
"enumFromThenTo": {
"code": "-- enumFromThenTo :: Int -> Int -> Int -> [Int]\non enumFromThenTo(x1, x2, y)\n set xs to {}\n set gap to x2 - x1\n set d to max(1, abs(gap)) * (signum(gap))\n repeat with i from x1 to y by d\n set end of xs to i\n end repeat\n return xs\nend enumFromThenTo",
"tags": [
"AS Prelude"
]
},
"enumFromThenToChar": {
"code": "-- enumFromThenToChar :: Char -> Char -> Char -> [Char]\non enumFromThenToChar(x1, x2, y)\n set {int1, int2, intY} to {id of x1, id of x2, id of y}\n set xs to {}\n repeat with i from int1 to intY by (int2 - int1)\n set end of xs to character id i\n end repeat\n return xs\nend enumFromThenToChar",
"tags": [
"AS Prelude"
]
},
"enumFromTo": {
"code": "-- enumFromTo :: Int -> Int -> [Int]\ron enumFromTo(m, n)\r if m ≤ n then\r set xs to {}\r repeat with i from m to n\r set end of xs to i\r end repeat\r xs\r else\r {}\r end if\rend enumFromTo",
"tags": [
"AS Prelude"
]
},
"enumFromToChar": {
"code": "-- enumFromToChar :: Char -> Char -> [Char]\non enumFromToChar(m, n)\n set {intM, intN} to {id of m, id of n}\n if intM ≤ intN then\n set xs to {}\n repeat with i from intM to intN\n set end of xs to character id i\n end repeat\n return xs\n else\n {}\n end if\nend enumFromToChar",
"tags": [
"AS Prelude"
]
},
"enumFromTo_": {
"code": "-- enumFromTo_ :: Enum a => a -> a -> [a]\non enumFromTo_(m, n)\n if m ≤ n then\n set x to fromEnum(m)\n set y to fromEnum(n)\n set xs to {}\n repeat with i from x to y\n set end of xs to i\n end repeat\n map(toEnum(m), xs)\n else\n return {}\n end if\nend enumFromTo",
"tags": [
"AS Prelude"
]
},
"eq (==)": {
"code": "-- eq (==) :: Eq a => a -> a -> Bool\non eq(a, b)\n a = b\nend eq",
"tags": [
"AS Prelude"
]
},
"eqDate": {
"code": "-- eqDate :: Date -> Date -> Bool\non eqDate(dte, dte1)\n -- True if the date parts of two date-time objects\n -- (ignoring the time parts) are the same.\n tell dte\n its year = year of dte1 ¬\n and its month = month of dte1 ¬\n and its day = day of dte1\n end tell\nend eqDate",
"tags": [
"AS Prelude"
]
},
"evalJSLR": {
"code": "-- evalJSLR :: String -> Either String a\non evalJSLR(strJS)\n -- gJSC can be declared in the global namespace,\n -- but unless the reference is released before the \n -- end of the script (e.g. `set gJSC to null`)\n -- it will persist, and\n -- Script Editor will be unable to save a .scpt file\n set gJSC to current application's JSContext's new()\n set v to unwrap((gJSC's evaluateScript:(strJS))'s toObject())\n if v is missing value then\n |Left|(\"JS evaluation error\")\n else\n |Right|(v)\n end if\nend evalJSLR",
"tags": [
"AS Prelude"
]
},
"evalJSMay": {
"code": "-- evalJSMay :: String -> Maybe a\non evalJSMay(strJS)\n -- use framework \"Foundation\"\n -- use framework \"JavaScriptCore\"\n -- gJSC can be declared in the global namespace,\n -- but unless the reference is released before the \n -- end of the script (e.g. `set gJSC to null`)\n -- it will persist, and\n -- Script Editor will be unable to save a .scpt file\n try -- NB if gJSC is global it must be released \n -- (e.g. set to null) at end of script\n gJSC's evaluateScript\n on error\n set gJSC to current application's JSContext's new()\n log (\"new JSC\")\n end try\n set v to unwrap((gJSC's evaluateScript:(strJS))'s toObject())\n if v is missing value then\n Nothing()\n else\n Just(v)\n end if\nend evalJSMay",
"tags": [
"AS Prelude"
]
},
"even": {
"code": "-- even :: Int -> Bool\non even(x)\n 0 = x mod 2\nend even",
"tags": [
"AS Prelude"
]
},
"exp": {
"code": "-- exp :: Float -> Float\non exp(n)\n Just of evalJSMay((\"Math.exp(\" & n as string) & \")\")\nend exp",
"tags": [
"AS Prelude"
]
},
"fTable": {
"code": "-- fTable :: String -> (a -> String) -> (b -> String) -> (a -> b) -> [a] -> String\non fTable(s, xShow, fxShow, f, xs)\n set ys to map(xShow, xs)\n set w to maximum(map(my |length|, ys))\n script arrowed\n on |λ|(a, b)\n justifyRight(w, space, a) & \" -> \" & b\n end |λ|\n end script\n s & linefeed & unlines(zipWith(arrowed, ¬\n ys, map(compose(fxShow, f), xs)))\nend fTable",
"tags": [
"AS Prelude"
]
},
"fanArrow (&&&)": {
"code": "-- fanArrow (&&&) :: (a -> b) -> (a -> c) -> (a -> (b, c))\non fanArrow(f, g)\n -- Compose a function from a simple value to a tuple of\n -- the separate outputs of two different functions\n script\n on |λ|(x)\n Tuple(mReturn(f)'s |λ|(x), mReturn(g)'s |λ|(x))\n end |λ|\n end script\nend fanArrow",
"tags": [
"AS Prelude"
]
},
"filePath": {
"code": "-- filePath :: String -> FilePath\non filePath(s)\n ((current application's ¬\n NSString's stringWithString:s)'s ¬\n stringByStandardizingPath()) as string\nend filePath",
"tags": [
"AS Prelude"
]
},
"filePathTree": {
"code": "-- filePathTree :: filePath -> [Tree String] -> Tree FilePath\non filePathTree(fpAnchor, trees)\n script go\n on |λ|(fp)\n script\n on |λ|(tree)\n set strPath to fp & \"/\" & (root of tree)\n \n Node(strPath, map(go's |λ|(strPath), nest of tree))\n end |λ|\n end script\n end |λ|\n end script\n \n Node(fpAnchor, map(go's |λ|(fpAnchor), trees))\nend filePathTree",
"tags": [
"AS Prelude"
]
},
"fileSize": {
"code": "-- fileSize :: FilePath -> Either String Int\non fileSize(fp)\n script fs\n on |λ|(rec)\n |Right|(NSFileSize of rec)\n end |λ|\n end script\n\n bindLR(my fileStatus(fp), fs)\nend fileSize",
"tags": [
"AS Prelude"
]
},
"fileStatus": {
"code": "-- fileStatus :: FilePath -> Either String Dict\non fileStatus(fp)\n set e to reference\n set {v, e} to current application's NSFileManager's defaultManager's ¬\n attributesOfItemAtPath:fp |error|:e\n\n if v is not missing value then\n |Right|(v as record)\n else\n |Left|((localizedDescription of e) as string)\n end if\nend fileStatus",
"tags": [
"AS Prelude"
]
},
"fileUTI": {
"code": "-- fileUTI :: FilePath -> Either String String\non fileUTI(fp)\n set {uti, e} to (current application's ¬\n NSWorkspace's sharedWorkspace()'s ¬\n typeOfFile:fp |error|:(reference)) as list\n \n if uti is missing value then\n |Left|(e's localizedDescription() as text)\n else\n |Right|(uti as text)\n end if\nend fileUTI",
"tags": [
"AS Prelude",
"jxa"
]
},
"filter": {
"code": "-- filter :: (a -> Bool) -> [a] -> [a]\ron filter(p, xs)\r tell mReturn(p)\r set n to length of xs\r set ys to {}\r \r repeat with i from 1 to n\r set v to item i of xs\r if |λ|(v, i, xs) then set end of ys to v\r end repeat\r ys\r end tell\rend filter",
"tags": [
"AS Prelude"
]
},
"filterGen": {
"code": "-- filterGen :: (a -> Bool) -> Gen [a] -> Gen [a]\non filterGen(p, gen)\n -- Non-finite stream of values which are \n -- drawn from gen, and satisfy p\n script\n property mp : mReturn(p)'s |λ|\n on |λ|()\n set v to gen's |λ|()\n repeat until mp(v)\n set v to gen's |λ|()\n end repeat\n return v\n end |λ|\n end script\nend filterGen",
"tags": [
"AS Prelude"
]
},
"filterTree": {
"code": "-- filterTree (a -> Bool) -> Tree a -> [a]\non filterTree(p, tree)\n -- List of all values in the tree\n -- which match the predicate p.\n \n script go\n property q : mReturn(p)'s |λ|\n on |λ|(x, xs)\n if q(x) then\n {x} & concat(xs)\n else\n concat(xs)\n end if\n end |λ|\n end script\n \n foldTree(go, tree)\nend filterTree",
"tags": [
"AS Prelude"
]
},
"filteredTree": {
"code": "-- filteredTree (a -> Bool) -> Tree a -> Tree a\non filteredTree(p, tree)\n -- A tree including only those children\n -- which either match the predicate p, or have\n -- descendants which match the predicate p.\n \n script go\n property q : mReturn(p)\n on |λ|(x, xs)\n script test\n on |λ|(subTree)\n {} ≠ (nest of subTree) or (|λ|(root of subTree) of q)\n end |λ|\n end script\n Node(x, filter(test, xs))\n end |λ|\n end script\n \n foldTree(go, tree)\nend filteredTree",
"tags": [
"AS Prelude"
]
},
"find": {
"code": "-- find :: (a -> Bool) -> [a] -> (missing value | a)\non find(p, xs)\n tell mReturn(p)\n set lng to length of xs\n repeat with i from 1 to lng\n if |λ|(item i of xs) then return item i of xs\n end repeat\n missing value\n end tell\nend find",
"tags": [
"AS Prelude"
]
},
"findGen": {
"code": "-- findGen :: (a -> Bool) -> Gen [a] -> Maybe a\non findGen(p, gen)\n -- Just the first match for the predicate p\n -- in the generator stream gen, or Nothing\n -- if no match is found.\n set mp to mReturn(p)\n set v to gen's |λ|()\n repeat until missing value is v or (|λ|(v) of mp)\n set v to (|λ|() of gen)\n end repeat\n if missing value is v then\n Nothing()\n else\n Just(v)\n end if\nend findGen",
"tags": [
"AS Prelude"
]
},
"findIndex": {
"code": "-- findIndex :: (a -> Bool) -> [a] -> Maybe Int\non findIndex(p, xs)\n -- Just the zero-based index of the first\n -- (left-to-right match) for for the predicate p in xs, \n -- or Nothing if no match is found.\n tell mReturn(p)\n set lng to length of xs\n repeat with i from 1 to lng\n if |λ|(item i of xs) then return Just(i - 1)\n end repeat\n return Nothing()\n end tell\nend findIndex",
"tags": [
"AS Prelude"
]
},
"findIndexR": {
"code": "-- findIndexR :: (a -> Bool) -> [a] -> Maybe Int\non findIndexR(p, xs)\n -- Just the zero-based index of the first\n -- (right-to-left match) for for the predicate p in xs, \n -- or Nothing if no match is found.\n tell mReturn(p)\n set lng to length of xs\n repeat with i from lng to 1 by -1\n if |λ|(item i of xs) then return Just(i - 1)\n end repeat\n return Nothing()\n end tell\nend findIndexR",
"tags": [
"AS Prelude"
]
},
"findIndices": {
"code": "-- findIndices :: (a -> Bool) -> [a] -> [Int]\non findIndices(p, xs)\n -- List of zero-based indices of \n -- any matches for p in xs.\n script\n property f : mReturn(p)\n on |λ|(x, i, xs)\n if f's |λ|(x, i, xs) then\n {i - 1}\n else\n {}\n end if\n end |λ|\n end script\n concatMap(result, xs)\nend findIndices",
"tags": [
"AS Prelude"
]
},
"findTree": {
"code": "-- findTree :: (a -> Bool) -> Tree a -> Maybe Tree a\non findTree(p, tree)\n -- The first of any nodes in the tree which match the predicate p\n -- (For all matches, see treeMatches)\n script go\n property pf : mReturn(p)'s |λ|\n on |λ|(oNode)\n if pf(root of oNode) then\n Just(oNode)\n else\n set xs to nest of oNode\n set lng to length of xs\n \n script inNest\n on |λ|(tpl)\n lng < fst(tpl) or (not (Nothing of snd(tpl)))\n end |λ|\n end script\n \n script nextPeer\n on |λ|(tpl)\n Tuple(1 + fst(tpl), go's |λ|(item (fst(tpl)) of xs))\n end |λ|\n end script\n \n if 0 < lng then\n snd(|until|(inNest, nextPeer, Tuple(1, Nothing())))\n else\n Nothing()\n end if\n end if\n end |λ|\n end script\n \n go's |λ|(tree)\nend findTree",
"tags": [
"AS Prelude",
"tree"
]
},
"first": {
"code": "-- first :: (a -> b) -> ((a, c) -> (b, c))\non |first|(f)\n -- A simple function lifted to one which applies to a tuple, \n -- transforming only the first item of that tuple\n script\n on |λ|(xy)\n Tuple(mReturn(f)'s |λ|(|1| of xy), |2| of xy)\n end |λ|\n end script\nend |first|",
"tags": [
"AS Prelude"
]
},
"flatten": {
"code": "-- flatten :: NestedList a -> [a]\non flatten(t)\n -- A flat list derived from a nested list.\n if list is class of t then\n concatMap(my flatten, t)\n else\n t\n end if\nend flatten",
"tags": [
"AS Prelude"
]
},
"flattenTree": {
"code": "-- flattenTree :: Tree a -> [a]\non flattenTree(node)\n -- The root elements of a tree in pre-order.\n script go\n on |λ|(x, xs)\n {root of x} & foldr(go, xs, nest of x)\n end |λ|\n end script\n go's |λ|(node, {})\nend flattenTree",
"tags": [
"AS Prelude",
"tree"
]
},
"flip": {
"code": "-- flip :: (a -> b -> c) -> b -> a -> c\non flip(f)\n script\n property g : mReturn(f)\n on |λ|(x, y)\n g's |λ|(y, x)\n end |λ|\n end script\nend flip",
"tags": [
"AS Prelude"
]
},
"floor": {
"code": "-- floor :: Num -> Int\non floor(x)\n if class of x is record then\n set nr to properFracRatio(x)\n else\n set nr to properFraction(x)\n end if\n set n to fst(nr)\n if 0 > snd(nr) then\n n - 1\n else\n n\n end if\nend floor",
"tags": [
"AS Prelude"
]
},
"fmap (<$>)": {
"code": "-- fmap (<$>) :: Functor f => (a -> b) -> f a -> f b\non fmap(f, fa)\n set c to class of fa\n if c is record and keys(fa) contains \"type\" then\n set t to |type| of fa\n if \"Either\" = t then\n set fm to my fmapLR\n else if \"Maybe\" = t then\n set fm to my fmapMay\n else if \"Node\" = t then\n set fm to my fmapTree\n else if \"Tuple\" = t then\n set fm to my fmapTuple\n else\n set fm to my map\n end if\n |λ|(f, fa) of mReturn(fm)\n else if c is text then\n map(f, characters of fa)\n else if c is list then\n map(f, fa)\n else\n missing value\n end if\nend fmap",
"tags": [
"AS Prelude"
]
},
"fmapGen (<$>)": {
"code": "-- fmapGen <$> :: (a -> b) -> Gen [a] -> Gen [b]\non fmapGen(f, gen)\n script\n property g : mReturn(f)\n on |λ|()\n set v to gen's |λ|()\n if v is missing value then\n v\n else\n g's |λ|(v)\n end if\n end |λ|\n end script\nend fmapGen",
"tags": [
"AS Prelude"
]
},
"fmapLR (<$>)": {
"code": "-- fmapLR (<$>) :: (a -> b) -> Either a a -> Either a b\non fmapLR(f, lr)\n if |Left| of lr is missing value then\n |Right|(|λ|(|Right| of lr) of mReturn(f))\n else\n lr\n end if\nend fmapLR",
"tags": [
"AS Prelude"
]
},
"fmapMay (<$>)": {
"code": "-- fmapMay (<$>) :: (a -> b) -> Maybe a -> Maybe b\non fmapMay(f, mb)\n if Nothing of mb then\n mb\n else\n Just(|λ|(Just of mb) of mReturn(f))\n end if\nend fmapMay",
"tags": [
"AS Prelude"
]
},
"fmapTree (<$>)": {
"code": "-- fmapTree :: (a -> b) -> Tree a -> Tree b\non fmapTree(f, tree)\n script go\n property g : |λ| of mReturn(f)\n on |λ|(x)\n set xs to nest of x\n if xs ≠ {} then\n set ys to map(go, xs)\n else\n set ys to xs\n end if\n Node(g(root of x), ys)\n end |λ|\n end script\n |λ|(tree) of go\nend fmapTree",
"tags": [
"AS Prelude",
"tree"
]
},
"fmapTuple (<$>)": {
"code": "-- fmapTuple (<$>) :: (a -> b) -> (a, a) -> (a, b)\non fmapTuple(f, tpl)\n Tuple(|1| of tpl, |λ|(|2| of tpl) of mReturn(f))\nend fmapTuple",
"tags": [
"AS Prelude"
]
},
"foldMapTree": {
"code": "-- foldMapTree :: Monoid m => (a -> m) -> Tree a -> m\non foldMapTree(f, tree)\n script go\n property g : mReturn(f)'s |λ|\n on |λ|(x)\n if length of (nest of x) > 0 then\n mappend(g(root of x), ¬\n foldl1(my mappend, (map(go, nest of x))))\n else\n g(root of x)\n end if\n end |λ|\n end script\n |λ|(tree) of go\nend foldMapTree",
"tags": [
"AS Prelude",
"tree"
]
},
"foldTree": {
"code": "-- foldTree :: (a -> [b] -> b) -> Tree a -> b\non foldTree(f, tree)\n script go\n property g : mReturn(f)\n on |λ|(oNode)\n tell g to |λ|(root of oNode, map(go, nest of oNode))\n end |λ|\n end script\n |λ|(tree) of go\nend foldTree",
"tags": [
"AS Prelude",
"tree"
]
},
"foldl": {
"code": "-- foldl :: (a -> b -> a) -> a -> [b] -> a\non foldl(f, startValue, xs)\n tell mReturn(f)\n set v to startValue\n set lng to length of xs\n repeat with i from 1 to lng\n set v to |λ|(v, item i of xs, i, xs)\n end repeat\n return v\n end tell\nend foldl",
"tags": [
"AS Prelude"
]
},
"foldl1": {
"code": "-- foldl1 :: (a -> a -> a) -> [a] -> a\non foldl1(f, xs)\n if length of xs > 1 then\n tell mReturn(f)\n set v to {item 1 of xs}\n set lng to length of xs\n repeat with i from 2 to lng\n set v to |λ|(v, item i of xs, i, xs)\n end repeat\n return v\n end tell\n else\n item 1 of xs\n end if\nend foldl1",
"tags": [
"AS Prelude"
]
},
"foldl1May": {
"code": "-- foldl1May :: (a -> a -> a) -> [a] -> Maybe a\non foldl1May(f, xs)\n set lng to length of xs\n if lng > 0 then\n if lng > 1 then\n tell mReturn(f)\n set v to {item 1 of xs}\n set lng to length of xs\n repeat with i from 2 to lng\n set v to |λ|(v, item i of xs, i, xs)\n end repeat\n return Just(v)\n end tell\n else\n Just(item 1 of xs)\n end if\n else\n Nothing()\n end if\nend foldl1May",
"tags": [
"AS Prelude"
]
},
"foldlTree": {
"code": "-- foldlTree :: (b -> a -> b) -> b -> Tree a -> b\non foldlTree(f, acc, tree)\n script go\n property mf : mReturn(f)\n on |λ|(a, x)\n foldl(go, |λ|(a, root of x) of mf, nest of x)\n end |λ|\n end script\n |λ|(acc, tree) of go\nend foldlTree",
"tags": [
"AS Prelude",
"tree"
]
},
"foldr": {
"code": "-- foldr :: (a -> b -> b) -> b -> [a] -> b\non foldr(f, startValue, xs)\n tell mReturn(f)\n set v to startValue\n set lng to length of xs\n repeat with i from lng to 1 by -1\n set v to |λ|(item i of xs, v, i, xs)\n end repeat\n return v\n end tell\nend foldr",
"tags": [
"AS Prelude"
]
},
"foldr1": {
"code": "-- foldr1 :: (a -> a -> a) -> [a] -> a\non foldr1(f, xs)\n if length of xs > 1 then\n tell mReturn(f)\n set v to item -1 of xs\n set lng to length of xs\n repeat with i from lng - 1 to 1 by -1\n set v to |λ|(item i of xs, v, i, xs)\n end repeat\n return v\n end tell\n else\n xs\n end if\nend foldr1",
"tags": [
"AS Prelude"
]
},
"foldr1May": {
"code": "-- foldr1May :: (a -> a -> a) -> [a] -> Maybe a\non foldr1May(f, xs)\n set lng to length of xs\n if lng > 0 then\n tell mReturn(f)\n set v to item -1 of xs\n repeat with i from lng - 1 to 1 by -1\n set v to |λ|(item i of xs, v, i, xs)\n end repeat\n return Just(v)\n end tell\n else\n Nothing()\n end if\nend foldr1May",
"tags": [
"AS Prelude"
]
},
"foldrTree": {
"code": "-- foldrTree :: (a -> b -> b) -> b -> Tree a -> b\non foldrTree(f, acc, tree)\n script go\n property mf : mReturn(f)\n on |λ|(x, a)\n foldr(go, |λ|(root of x, a) of mf, nest of x)\n end |λ|\n end script\n |λ|(tree, acc) of go\nend foldrTree",
"tags": [
"AS Prelude",
"tree"
]
},
"forestFromJSON": {
"code": "-- forestFromJSON :: String -> [Tree a]\non forestFromJSON(strJSON)\n set lr to jsonParseLR(strJSON)\n if missing value is |Left| of lr then\n map(my treeFromNestedList, |Right| of lr)\n else\n {}\n end if\nend forestFromJSON\n",
"tags": [
"AS Prelude"
]
},
"fromEnum": {
"code": "-- fromEnum :: Enum a => a -> Int\non fromEnum(x)\n set c to class of x\n if c is boolean then\n if x then\n 1\n else\n 0\n end if\n else if c is text then\n if x ≠ \"\" then\n id of x\n else\n missing value\n end if\n else\n x as integer\n end if\nend fromEnum",
"tags": [
"AS Prelude"
]
},
"fromLeft": {
"code": "-- fromLeft :: a -> Either a b -> a\non fromLeft(def, lr)\n if isLeft(lr) then\n |Left| of lr\n else\n def\n end if\nend fromLeft",
"tags": [
"AS Prelude"
]
},
"fromMaybe": {
"code": "-- fromMaybe :: a -> Maybe a -> a\non fromMaybe(default, mb)\n if Nothing of mb then\n default\n else\n Just of mb\n end if\nend fromMaybe",
"tags": [
"AS Prelude"