+   -      1 +-- 11 lines: --
   1 ; --                                                            ; {{{1
|      2 ;
|      3 ; File        : prelude.knk
|      4 ; Maintainer  : FC Stegerman <flx@obfusk.net>
|      5 ; Date        : 2022-02-12
|      6 ;
|      7 ; Copyright   : Copyright (C) 2022  FC Stegerman
|      8 ; Version     : v0.0.1
|      9 ; License     : LGPLv3+
|     10 ;
|     11 ; --                                                            ; }}}1
      12 
      13 :__prld__ __defmodule__[
      14 
      15 ; -- TODO --
      16 ;
      17 ; * WIP: slicing, string formatting, functor, monad, tuples
      18 ; * more functions!
      19 ; * refactor!
      20 ;
      21 ; * (chunked) sequences; map, each, iterate, zip, ...
      22 ;
      23 ; * cond1, cond=, is-nan?
      24 ; * range-elem?'; seq str & dict; ++, ->list
      25 ; * unzip, scan*; split*; init; sort-by; update-with
      26 ; * I/O; math; ...
      27 ;
      28 ; * div/mod vs quot/rem
      29 ;
      30 ; * improve docs generation!
      31 ;
      32 ; --
      33 
+   -     34 +-- 68 lines: -- Aliases for Primitives --
  34 ; -- Aliases for Primitives --                                  ; {{{1
|     35 
|     36 :def                '__def__                __def__
|     37 
|     38 :call               '__call__                 def
|     39 :apply              '__apply__                def
|     40 :apply-dict         '__apply-dict__           def
|     41 
|     42 :if                 '__if__                   def
|     43 
|     44 :defmulti           '__defmulti__             def
|     45 :defrecord          '__defrecord__            def
|     46 
|     47 :=>                 '__=>__                   def
|     48 :dict               '__dict__                 def
|     49 
|     50 :puts!              '__puts!__                def
|     51 :ask!               '__ask!__                 def
|     52 
|     53 :type               '__type__                 def
|     54 :callable?          '__callable?__            def
|     55 :function?          '__function?__            def
|     56 
|     57 :defmodule          '__defmodule__            def
|     58 :import             '__import__               def
|     59 :import-from        '__import-from__          def
|     60 
|     61 :=                  '__=__                    def
|     62 :not=               '__not=__                 def
|     63 :<                  '__<__                    def
|     64 :<=                 '__<=__                   def
|     65 :>                  '__>__                    def
|     66 :>=                 '__>=__                   def
|     67 :<=>                '__<=>__                  def
|     68 
|     69 :eq                 '__eq__                   def
|     70 :neq                '__neq__                  def
|     71 :lt                 '__lt__                   def
|     72 :lte                '__lte__                  def
|     73 :gt                 '__gt__                   def
|     74 :gte                '__gte__                  def
|     75 :cmp                '__cmp__                  def
|     76 
|     77 :abs                '__abs__                  def
|     78 :trunc              '__trunc__                def
|     79 :round              '__round__                def
|     80 :ceil               '__ceil__                 def
|     81 :floor              '__floor__                def
|     82 
|     83 :int->float         '__int->float__           def
|     84 :record->dict       '__record->dict__         def
|     85 
|     86 :record-type        '__record-type__          def
|     87 :record-vals        '__record-values__        def
|     88 :record-values      '__record-values__        def
|     89 :record-type-name   '__record-type-name__     def
|     90 :record-type-fields '__record-type-fields__   def
|     91 
|     92 :fail               '__fail__                 def
|     93 :try                '__try__                  def
|     94 
|     95 :rx-match           '__rx-match__             def
|     96 :rx-sub             '__rx-sub__               def
|     97 
|     98 :par                '__par__                  def
|     99 :sleep              '__sleep__                def
|    100 
|    101                                                                 ; }}}1
     102 
+   -    103 +--137 lines: -- Stack Shuffling --
 103 ; -- Stack Shuffling --                                         ; {{{1
|    104 
|    105 ; swap top 2 values
|    106 ;
|    107 ; >>> , 1 2 s!
|    108 ; --- STACK ---
|    109 ; 2
|    110 ; 1
|    111 ; ---  END  ---
|    112 ; >>> , swap s!
|    113 ; --- STACK ---
|    114 ; 1
|    115 ; 2
|    116 ; ---  END  ---
|    117 
|    118 :swap   [ x y . 'y 'x ] def                   ; ⇔ '__swap__     ; bltn
|    119 :><     'swap           def
|    120 
|    121 ; rotate top 3 values
|    122 ;
|    123 ; >>> , 1 2 3 rot> s!
|    124 ; --- STACK ---
|    125 ; 2
|    126 ; 1
|    127 ; 3
|    128 ; ---  END  ---
|    129 ; >>> , <rot s!
|    130 ; --- STACK ---
|    131 ; 3
|    132 ; 2
|    133 ; 1
|    134 ; ---  END  ---
|    135 
|    136 :rot>   [ x y z . 'z 'x 'y  ] def             ; ⇔ [ [] $ 2dip ]
|    137 :<rot   [ x y z . 'y 'z 'x  ] def             ; ⇔ [ [] 2$ dip ]
|    138 
|    139 ; rotate top 4 values
|    140 ;
|    141 ; >>> , 1 2 3 4 rot4> s!
|    142 ; --- STACK ---
|    143 ; 3
|    144 ; 2
|    145 ; 1
|    146 ; 4
|    147 ; ---  END  ---
|    148 ; >>> , <rot4 s!
|    149 ; --- STACK ---
|    150 ; 4
|    151 ; 3
|    152 ; 2
|    153 ; 1
|    154 ; ---  END  ---
|    155 
|    156 :rot4>  [ w x y z . 'z 'w 'x 'y ] def
|    157 :<rot4  [ w x y z . 'x 'y 'z 'w ] def
|    158 
|    159 ; duplicate top value(s)
|    160 ;
|    161 ; >>> , 42 dup s!
|    162 ; --- STACK ---
|    163 ; 42
|    164 ; 42
|    165 ; ---  END  ---
|    166 ; >>> c!
|    167 ; *** STACK CLEARED ***
|    168 ; >>> , 1 2 2dup s!
|    169 ; --- STACK ---
|    170 ; 2
|    171 ; 1
|    172 ; 2
|    173 ; 1
|    174 ; ---  END  ---
|    175 ; >>> ( 1 2 3 3dup )
|    176 ; ( 1 2 3 1 2 3 )
|    177 
|    178  :dup   [ x   . 'x 'x       ] def                               ; bltn
|    179 :2dup   [ x y . 'x 'y 'x 'y ] def             ; ⇔ [ over over ]
|    180 :3dup   [ 2over over2 ] def
|    181 
|    182 ; remove top value(s)
|    183 ;
|    184 ; >>> nil
|    185 ; nil
|    186 ; >>> drop
|    187 ; >>> drop
|    188 ; *** ERROR: stack underflow
|    189 ; >>> 42 37 2drop
|    190 ; >>> 1 2 3 3drop
|    191 
|    192  :drop  [ _     . ] def                                         ; bltn
|    193 :2drop  [ _ _   . ] def                       ; ⇔ [ drop drop ]
|    194 :3drop  [ _ _ _ . ] def
|    195 
|    196 ; drop value immediately preceding the top
|    197 ;
|    198 ; >>> , 42 37 nip s!
|    199 ; --- STACK ---
|    200 ; 37
|    201 ; ---  END  ---
|    202 
|    203 :nip    [ _ y . 'y ] def                      ; ⇔ [ 'drop dip ]
|    204 
|    205 ; copy value(s) immediately preceding the top "over" the top
|    206 ;
|    207 ; >>> , 1 2 over s!
|    208 ; --- STACK ---
|    209 ; 1
|    210 ; 2
|    211 ; 1
|    212 ; ---  END  ---
|    213 ; >>> c!
|    214 ; *** STACK CLEARED ***
|    215 ; >>> , 1 2 3 2over s!
|    216 ; --- STACK ---
|    217 ; 2
|    218 ; 1
|    219 ; 3
|    220 ; 2
|    221 ; 1
|    222 ; ---  END  ---
|    223 
|    224  :over  [ x y   . 'x 'y 'x        ] def       ; ⇔ [ 'dup dip swap ]
|    225 :2over  [ x y z . 'x 'y 'z 'x 'y  ] def       ; ⇔ [ over2 over2 ]
|    226 
|    227 ; copy value "over" the topmost 2
|    228 ;
|    229 ; >>> , 1 2 3 over2 s!
|    230 ; --- STACK ---
|    231 ; 1
|    232 ; 3
|    233 ; 2
|    234 ; 1
|    235 ; ---  END  ---
|    236 
|    237 :over2  [ x y z . 'x 'y 'z 'x ] def           ; ⇔ [ 'over dip swap ]
|    238 
|    239                                                                 ; }}}1
     240 
+   -    241 +--285 lines: -- Combinators --
 241 ; -- Combinators --                                             ; {{{1
|    242 
|    243 ; partial application & function composition
|    244 ;
|    245 ; >>> , 1 '+ $                                        ; ⇔ [ 1 + ]
|    246 ; >>> 2 swap call
|    247 ; 3
|    248 ; >>> 2, 3 4 [ + * ] 2$, call
|    249 ; 14
|    250 ; >>> 1, 2 3 4 [ + + + ] 3$, call
|    251 ; 10
|    252 ; >>> :foo [] $ call                                  ; [] $ ⇔ .[ '1 ]
|    253 ; :foo
|    254 ;
|    255 ; >>> , [ 1 + ] [ 3 * ] @
|    256 ; >>> 2 swap call
|    257 ; 9
|    258 ; >>> [ 2 * ] [ 1 + ] % call                          ; % ⇔ swap @
|    259 ; 20
|    260 ;
|    261 ; >>> , 2 '-
|    262 ; >>> , 1 $$                                          ; ⇔ [ f . 1 f ]
|    263 ; >>> call
|    264 ; 1
|    265 ; >>> 2 [ + * ], 3 4 2$$, call
|    266 ; 14
|    267 ; >>> 1 [ + + + ], 2 3 4 3$$, call
|    268 ; 10
|    269 
|    270  :$     '[ '1 .2       ] def                                    ; bltn
|    271 :2$     '[ '1 '2 .3    ] def                                    ; TODO
|    272 :3$     '[ '1 '2 '3 .4 ] def
|    273 
|    274 :@      '[ .1 .2 ] def                                          ; bltn
|    275 :%      '[ .2 .1 ] def                                          ; bltn
|    276 
|    277  :$$    '[ f . '1 f       ] def
|    278 :2$$    '[ f . '1 '2 f    ] def
|    279 :3$$    '[ f . '1 '2 '3 f ] def
|    280 
|    281 ; remove top value(s), call function, restore value(s)
|    282 ;
|    283 ; >>> , 1 2 'dup dip s!
|    284 ; --- STACK ---
|    285 ; 2
|    286 ; 1
|    287 ; 1
|    288 ; ---  END  ---
|    289 ; >>> c!
|    290 ; *** STACK CLEARED ***
|    291 ; >>> , 1 2 3 4 '- 2dip s!
|    292 ; --- STACK ---
|    293 ; 4
|    294 ; 3
|    295 ; -1
|    296 ; ---  END  ---
|    297 ; >>> c!
|    298 ; *** STACK CLEARED ***
|    299 ; >>> , 1 2 3 4 'neg 3dip s!
|    300 ; --- STACK ---
|    301 ; 4
|    302 ; 3
|    303 ; 2
|    304 ; -1
|    305 ; ---  END  ---
|    306 
|    307  :dip   [ x f   . f 'x    ] def                                 ; bltn
|    308 :2dip   [ x y f . f 'x 'y ] def               ; ⇔ [ 'dip $ dip ]
|    309 :3dip   [ '2dip $ dip     ] def
|    310 
|    311 ; copy top value(s), call function, push value(s)
|    312 ;
|    313 ; >>> , 2 [ dup * ] keep s!
|    314 ; --- STACK ---
|    315 ; 2
|    316 ; 4
|    317 ; ---  END  ---
|    318 ; >>> c!
|    319 ; *** STACK CLEARED ***
|    320 ; >>> , 2 3 '* 2keep s!
|    321 ; --- STACK ---
|    322 ; 3
|    323 ; 2
|    324 ; 6
|    325 ; ---  END  ---
|    326 
|    327  :keep  [  over 'call  dip  ] def             ; ⇔ [ x f . 'x f 'x ]
|    328 :2keep  [ 2over 'call 2dip  ] def             ; ⇔ [ '2dup dip 2dip ]
|    329 
|    330 ; call multiple functions on one value
|    331 ;
|    332 ; >>> , 35 [ 2 + ] [ 7 + ] bi s!
|    333 ; --- STACK ---
|    334 ; 42
|    335 ; 37
|    336 ; ---  END  ---
|    337 ; >>> c!
|    338 ; *** STACK CLEARED ***
|    339 ; >>> , 2 [ 1 + ] [ 2 * ] [ 3 - ] tri s!
|    340 ; --- STACK ---
|    341 ; -1
|    342 ; 4
|    343 ; 3
|    344 ; ---  END  ---
|    345 ;
|    346 ; >>> ( 2 ( [ 1 + ] [ 2 * ] [ 3 - ] ) mlt )
|    347 ; ( 3 4 -1 )
|    348 ;
|    349 ;
|    350 ; >>> 42  'num? 'pos? bi-and
|    351 ; #t
|    352 ; >>> -1  'num? 'pos? bi-and
|    353 ; #f
|    354 ; >>> nil 'num? 'pos? bi-and                        ; "short-circuits"
|    355 ; #f
|    356 ; >>> nil 'num? 'pos? bi and                        ; oops
|    357 ; *** ERROR: types nil and int are not comparable
|    358 ; >>> nil 'nil? 'pos? bi-or
|    359 ; #t
|    360 ; >>> nil 'nil? 'pos? bi or
|    361 ; *** ERROR: types nil and int are not comparable
|    362 
|    363 :bi     [ x f g   . 'x f 'x g       ] def     ; ⇔ [ 'keep dip call ]
|    364 :tri    [ x f g h . 'x f 'x g 'x h  ] def     ; ⇔ [ 'keep 2dip bi ]
|    365 
|    366 :mlt    [ swap $$ each ] def
|    367 
|    368 :bi-and [ x p1? p2? . [ 'x p1? ] [ 'x p2? ] and' ] def
|    369 :bi-or  [ x p1? p2? . [ 'x p1? ] [ 'x p2? ] or'  ] def
|    370 
|    371 ; call one function on each of multiple values
|    372 ;
|    373 ; >>> 2 3 [ dup * ] bi$ +
|    374 ; 13
|    375 ; >>> c!
|    376 ; *** STACK CLEARED ***
|    377 ; >>> , 2 3 4 [ dup * ] tri$ s!
|    378 ; --- STACK ---
|    379 ; 16
|    380 ; 9
|    381 ; 4
|    382 ; ---  END  ---
|    383 ;
|    384 ; >>> ( ( 2 3 4 ) [ dup * ] mlt$ )                    ; mlt$ ⇔ each
|    385 ; ( 4 9 16 )
|    386 ;
|    387 ;
|    388 ; >>> ( 0 2 4 ) 'even? all?
|    389 ; #t
|    390 ; >>> ( 37 42 ) 'even? any?
|    391 ; #t
|    392 ;
|    393 ;
|    394 ; >>> -1 nil 'pos? bi$-and                          ; "short-circuits"
|    395 ; #f
|    396 ; >>> 42 nil 'pos? bi$-or
|    397 ; #t
|    398 ; >>> 42 nil 'pos? bi$ or                           ; oops
|    399 ; *** ERROR: types nil and int are not comparable
|    400 
|    401 :bi$    [ x y f   . 'x f 'y f       ] def     ; ⇔ [ dup bi~ ]
|    402 :tri$   [ x y z f . 'x f 'y f 'z f  ] def     ; ⇔ [ 2dup tri~ ]
|    403 
|    404 :mlt$   [ each ] def
|    405 
|    406 :all?   [ p? . [ #t ] [ >< p? dup [ drop 'p? all? ] 'nip if ] ^seq ] def
|    407 :any?   [ p? . [ #f ] [ >< p? dup 'nip [ drop 'p? any? ] if ] ^seq ] def
|    408 
|    409 :bi$-and  [ x y p? . [ 'x p? ] [ 'y p? ] and' ] def
|    410 :bi$-or   [ x y p? . [ 'x p? ] [ 'y p? ] or'  ] def
|    411 
|    412 ; call multiple functions on their "paired" value
|    413 ;
|    414 ; >>> , 4 9 [ 2 + ] [ 3 div ] bi~ s!
|    415 ; --- STACK ---
|    416 ; 3
|    417 ; 6
|    418 ; ---  END  ---
|    419 ; >>> c!
|    420 ; *** STACK CLEARED ***
|    421 ; >>> ( 1 2 3 :x :y :z '[ '1 swap => ] tri$ tri~ )
|    422 ; ( :x 1 => :y 2 => :z 3 => )
|    423 ;
|    424 ; >>> ( ( 1 2 3 ) ( :x :y :z ) '[ '1 swap => ] map mlt~ )
|    425 ; ( :x 1 => :y 2 => :z 3 => )
|    426 
|    427 :bi~    [ x y f g     . 'x f 'y g       ] def ; ⇔ [ 'dip dip call ]
|    428 :tri~   [ x y z f g h . 'x f 'y g 'z h  ] def
|    429 
|    430 :mlt~   [ 'call zip [] each ] def
|    431 
|    432 ; TODO: mlt*, 2mlt, 2mlt$, 2mlt~, ...
|    433 
|    434 ; call multiple functions on each of multiple values
|    435 ;
|    436 ; >>> , 2 3 [ dup * ] 'neg bi* s!
|    437 ; --- STACK ---
|    438 ; -3
|    439 ; -2
|    440 ; 9
|    441 ; 4
|    442 ; ---  END  ---
|    443 
|    444 :bi*    [ [ 'bi$ $ 2keep ] dip bi$ ] def
|    445 
|    446 ; call multiple functions on two values
|    447 ;
|    448 ; >>> , 1 2 '+ '- 2bi s!
|    449 ; --- STACK ---
|    450 ; -1
|    451 ; 3
|    452 ; ---  END  ---
|    453 ; >>> c!
|    454 ; *** STACK CLEARED ***
|    455 ; >>> , 7 2 '+ '- 'div 2tri s!
|    456 ; --- STACK ---
|    457 ; 3
|    458 ; 5
|    459 ; 9
|    460 ; ---  END  ---
|    461 
|    462 :2bi    [ '2keep dip call ] def
|    463 :2tri   [ '2keep 2dip 2bi ] def
|    464 
|    465 ; call one function on each of multiple pairs of values
|    466 ;
|    467 ; >>> , :x 1 :y 2 '=> 2bi$ s!
|    468 ; --- STACK ---
|    469 ; :y 2 =>
|    470 ; :x 1 =>
|    471 ; ---  END  ---
|    472 ; >>> c!
|    473 ; *** STACK CLEARED ***
|    474 ; >>> , :x :y 1 2 '=> 2bi$' s!
|    475 ; --- STACK ---
|    476 ; :y 2 =>
|    477 ; :x 1 =>
|    478 ; ---  END  ---
|    479 
|    480 :2bi$   [ dup 2bi~        ] def
|    481 :2bi$'  [ 'swap 2dip 2bi$ ] def
|    482 
|    483 ; call multiple functions on their "paired" pair of values
|    484 ;
|    485 ; >>> , 1 2 3 4 '+ '- 2bi~ s!
|    486 ; --- STACK ---
|    487 ; -1
|    488 ; 3
|    489 ; ---  END  ---
|    490 ; >>> c!
|    491 ; *** STACK CLEARED ***
|    492 ; >>> , 1 3 2 4 '+ '- 2bi~' s!
|    493 ; --- STACK ---
|    494 ; -1
|    495 ; 3
|    496 ; ---  END  ---
|    497 
|    498 :2bi~   [ '2dip dip call  ] def
|    499 :2bi~'  [ 'swap 3dip 2bi~ ] def
|    500 
|    501 ; partially apply multiple functions to one value
|    502 ;
|    503 ; >>> 5 [ 37 + ] [ 37 - ] ~pos
|    504 ; 42
|    505 ; >>> 5 37 '+ '- $bi ~pos
|    506 ; 42
|    507 
|    508 :$bi    [ x f g . 'x 'f $ 'x 'g $ ] def       ; ⇔ [ [ '$ $ ] bi$ bi ]
|    509 
|    510 ; partially apply "first" or "second" function to value
|    511 ;
|    512 ; >>> 5 'neg [ 37 + ] ~neg
|    513 ; 42
|    514 ; >>> 5 37 'neg '+ $snd ~neg
|    515 ; 42
|    516 ;
|    517 ; >>> 5 37 '+ 'neg '$ dip ~pos
|    518 ; 42
|    519 ; >>> 5 37 '+ 'neg $fst ~pos
|    520 ; 42
|    521 
|    522 :$fst   [ '$ dip ] def
|    523 :$snd   [ x f g . 'f 'x 'g $ ] def
|    524 
|    525                                                                 ; }}}1
     526 
+   -    527 +--233 lines: -- Conditionals, Logic & Order --
 527 ; -- Conditionals, Logic & Order --                             ; {{{1
|    528 
|    529 ; conditional expression that takes two values (instead of functions)
|    530 ;
|    531 ; foo bar ? ≈ [ foo ] [ bar ] if
|    532 ; foo bar ? ⇔ foo [] $ bar [] $ if
|    533 ;
|    534 ; NB: foo and bar are always evaluated.
|    535 ;
|    536 ; >>> #t 42 37 ?
|    537 ; 42
|    538 
|    539 :?      [ '[ '1 ] bi$ if ] def
|    540 
|    541 ; conditional w/ implicit "else branch" (that drops values -- if
|    542 ; necessary -- to match the arity of the "if branch")
|    543 ;
|    544 ; >>> 1 2 = [ "oh no!" say! ] when                    ; -0 +0 = 0
|    545 ; >>> 1 1 = [ "good!"  say! ] when
|    546 ; good!
|    547 ; >>> , 42 dup 2 mod 0 = [ 2 div ] when s!            ; -1 +1 = 0
|    548 ; --- STACK ---
|    549 ; 21
|    550 ; ---  END  ---
|    551 ; >>> c!
|    552 ; *** STACK CLEARED ***
|    553 ; >>> 1 2 2dup = '+ when1                             ; -2 +1 = 1
|    554 ; 1
|    555 ; >>> 2 2 2 2dup = [ + * ] when2                      ; -3 +1 = 2
|    556 ; 8
|    557 
|    558 :when   [ []     if ] def
|    559 :when1  [ 'drop  if ] def
|    560 :when2  [ '2drop if ] def
|    561 
|    562 ; [ ... ] unless ⇔ not [ ... ] when
|    563 ;
|    564 ; >>> 1 1 = [ "oh no!" say! ] unless                  ; -0 +0 = 0
|    565 ; >>> 1 2 = [ "good!"  say! ] unless
|    566 ; good!
|    567 ; >>> 2 2 2dup = '+ unless1                           ; -2 +1 = 1
|    568 ; 2
|    569 ; >>> 1 2 3 2dup = [ + * ] unless2                    ; -3 +1 = 2
|    570 ; 5
|    571 
|    572 :unless   [ []     swap if ] def
|    573 :unless1  [ 'drop  swap if ] def
|    574 :unless2  [ '2drop swap if ] def
|    575 
|    576 ; predicate "branch"
|    577 ;
|    578 ; dup p? [ foo ] [ bar ] if ⇔ [ foo ] [ bar ] 'p? ~?
|    579 ;
|    580 ; >>> , :collatz [
|    581 ; ...     [ [ 2 div ] [ 3 * 1 + ] 'even? ~? ]
|    582 ; ...     iterate [ 1 not= ] take-while ( 1 ) ++
|    583 ; ...   ] def
|    584 ; >>> 19 collatz ->list
|    585 ; ( 19 58 29 88 44 22 11 34 17 52 26 13 40 20 10 5 16 8 4 2 1 )
|    586 
|    587 :~?     [ 'dup % 2dip if ] def                                  ; bltn
|    588 
|    589 ; bool, logical inverse, conjunction & disjunction
|    590 ;
|    591 ; NB: see also bi-and, bi-or, bi$-and, bi$-or.
|    592 ;
|    593 ; NB: "and" and "or" return one of their operands (which are tested
|    594 ; for "truthyness", but do not need to be bools).  They also cannot
|    595 ; "short-circuit" because they operate on the stack, not on
|    596 ; expressions.
|    597 ;
|    598 ; >>> 5 bool
|    599 ; #t
|    600 ; >>> 5 not
|    601 ; #f
|    602 ; >>> nil not
|    603 ; #t
|    604 ; >>> nil 5 or
|    605 ; 5
|    606 ; >>> nil 5 and
|    607 ; nil
|    608 ; >>> 2 3 or
|    609 ; 2
|    610 ; >>> 2 3 and
|    611 ; 3
|    612 ;
|    613 ; >>> [ nil ] [ "oops" fail ] and'                  ; "short-circuits"
|    614 ; nil
|    615 ; >>> [ 42  ] [ "oops" fail ] or'
|    616 ; 42
|    617 
|    618 :bool   [ not not    ] def
|    619 :not    [ #f #t    ? ] def
|    620 :and    [ over     ? ] def
|    621 :or     [ 'dup dip ? ] def
|    622 
|    623 :and'   [ f g . f dup [ drop g ] [] if ] def
|    624 :or'    [ f g . f dup [] [ drop g ] if ] def
|    625 
|    626 ; comparison "branch"
|    627 ;
|    628 ; >>> 41 'inc 'dec 41 ~[=]
|    629 ; 42
|    630 ; >>> 41 'dec 'inc 41 ~[not=]
|    631 ; 42
|    632 ; >>> 41 'inc 'dec 99 ~[<]
|    633 ; 42
|    634 ; >>> 43 'inc 'dec 37 ~[<=]
|    635 ; 42
|    636 ; >>> 41 'inc 'dec 37 ~[>]
|    637 ; 42
|    638 ; >>> 41 'inc 'dec 41 ~[>=]
|    639 ; 42
|    640 ;
|    641 ; >>> 42 37 '- '* '+ ~<=>
|    642 ; 79
|    643 ; >>> 37 [ :< ] [ := ] [ :> ] 42 ~[<=>] nip
|    644 ; :<
|    645 ;
|    646 ; NB: ~<=> leaves both operands, ~[<=>] only the "left".
|    647 
|    648 :~[=]     [ '=    $ ~? ] def
|    649 :~[not=]  [ 'not= $ ~? ] def
|    650 :~[<]     [ '<    $ ~? ] def
|    651 :~[<=]    [ '<=   $ ~? ] def
|    652 :~[>]     [ '>    $ ~? ] def
|    653 :~[>=]    [ '>=   $ ~? ] def
|    654 
|    655 :~<=>   [ f g h . 2dup <=> [ drop g ] [ 0 < 'f 'h if ] 0 ~[=] ] def
|    656 :~[<=>] [ [] $ 3dip [ 'drop % ] tri$ ~<=> ] def
|    657 
|    658 ; alternative comparison "branch"
|    659 ;
|    660 ; >>> 41.0 'inc 'dec 41 ~[eq]
|    661 ; 42.0
|    662 ; >>> 41.0 'dec 'inc 41 ~[neq]
|    663 ; 42.0
|    664 ; >>> 41.0 'inc 'dec 99 ~[lt]
|    665 ; 42.0
|    666 ; >>> 43.0 'inc 'dec 37 ~[lte]
|    667 ; 42.0
|    668 ; >>> 41.0 'inc 'dec 37 ~[gt]
|    669 ; 42.0
|    670 ; >>> 41.0 'inc 'dec 41 ~[gte]
|    671 ; 42.0
|    672 ;
|    673 ; >>> 42 37.0 '- '* '+ ~cmp
|    674 ; 79.0
|    675 ; >>> 37 [ :< ] [ := ] [ :> ] 42.0 ~[cmp] nip
|    676 ; :<
|    677 ;
|    678 ; NB: ~cmp leaves both operands, ~[cmp] only the "left".
|    679 
|    680 :~[eq]    [ 'eq  $ ~? ] def
|    681 :~[neq]   [ 'neq $ ~? ] def
|    682 :~[lt]    [ 'lt  $ ~? ] def
|    683 :~[lte]   [ 'lte $ ~? ] def
|    684 :~[gt]    [ 'gt  $ ~? ] def
|    685 :~[gte]   [ 'gte $ ~? ] def
|    686 
|    687 :~cmp   [ f g h . 2dup cmp [ drop g ] [ neg? 'f 'h if ] 0 ~[eq] ] def
|    688 :~[cmp] [ [] $ 3dip [ 'drop % ] tri$ ~cmp ] def
|    689 
|    690 ; minimum & maximum
|    691 ;
|    692 ; >>> 1 2 min
|    693 ; 1
|    694 ; >>> -1 -2 max
|    695 ; -1
|    696 ;
|    697 ; >>> 2 1.0 min
|    698 ; 2
|    699 ; >>> 2 1.0 min'
|    700 ; 1.0
|    701 ; >>> 2 1.0 max'
|    702 ; 2
|    703 
|    704 :min    [ '<= min-by ] def
|    705 :max    [ '>= max-by ] def
|    706 
|    707 :min'   [ 'lte min-by ] def
|    708 :max'   [ 'gte max-by ] def
|    709 
|    710 :min-by [ f . 2dup f 'drop 'nip if ] def
|    711 :max-by [ f . 2dup f 'drop 'nip if ] def
|    712 
|    713 ; conditional expression
|    714 ;
|    715 ; Takes a value and a list of tests and exprs.  It evaluates each test
|    716 ; one at a time: functions are predicates and are called (with the
|    717 ; value pushed onto the stack); the result -- or the test itself if
|    718 ; not a function -- is tested for truthiness.  If the test passes, its
|    719 ; corresponding expr is returned and called (if it's a block).
|    720 ;
|    721 ; >>> , :temp [
|    722 ; ...     [ show " is " ++ ]
|    723 ; ...     [ ( [ 15 < ] "cold!" [ 25 > ] "warm!" :else "ok!" ) cond1 ]
|    724 ; ...     bi ++ say!
|    725 ; ...   ] def
|    726 ; >>> 10 temp
|    727 ; 10 is cold!
|    728 ; >>> 20 temp
|    729 ; 20 is ok!
|    730 ; >>> 30 temp
|    731 ; 30 is warm!
|    732 
|    733   :cond1  [ _cond1 dup block? 'call when ] def                  ; TODO
|    734  :_cond1  [ cons '_&cond1 apply ] def
|    735 :_&cond1  [ x p? f & .
|    736             'x 'p? 'call 'nip 'function? ~? [ 'f ] [ 'x '& _cond1 ] if
|    737           ] def
|    738 
|    739 ; TODO: cond=, ...
|    740 
|    741 ; combined "branch"
|    742 ;
|    743 ; >>> -1 [ :pos ] [ :neg ] [ :zero ] ( '~pos '~neg ) ~>> nip
|    744 ; :neg
|    745 ;
|    746 ; >>> , :~type [ .[ type '1 = ] ~? ] def
|    747 ; >>> , :~strint [ ( [ :str ~type ] [ :int ~type ] ) ~>> ] def
|    748 ; >>> , :f [ [ "bar" ++ ] [ 5 + ] [ drop :oops ] ~strint ] def
|    749 ; >>> "foo" f
|    750 ; "foobar"
|    751 ; >>> 37 f
|    752 ; 42
|    753 ; >>> nil f
|    754 ; :oops
|    755 
|    756 :~>>    [ reverse _~>> ] def
|    757 :_~>>   [ 'call [ f ft . .[ '1 '2 f ] 'ft _~>> ] ^seq ] def
|    758 
|    759                                                                 ; }}}1
     760 
+   -    761 +--109 lines: -- Arithmetic --
 761 ; -- Arithmetic --                                              ; {{{1
|    762 
|    763 ; NB: see also math.
|    764 
|    765 ; addition, subtraction & multiplication
|    766 ;
|    767 ; NB: when mixing ints and floats, ints are coerced to floats and may
|    768 ; lose precision.
|    769 ;
|    770 ; >>> 1 2 +
|    771 ; 3
|    772 ; >>> 4 3 -
|    773 ; 1
|    774 ; >>> 6 7 *
|    775 ; 42
|    776 ; >>> 1.0 2.0 +
|    777 ; 3.0
|    778 ; >>> 4.0 3 -
|    779 ; 1.0
|    780 ; >>> 6 7.0 *
|    781 ; 42.0
|    782 
|    783 :+ ( :int   :int    ) [ __int+__          ] defmulti
|    784 :+ ( :float :float  ) [ __float+__        ] defmulti
|    785 :+ ( :int   :float  ) [ 'int->float dip + ] defmulti
|    786 :+ ( :float :int    ) [  int->float     + ] defmulti
|    787 
|    788 :- ( :int   :int    ) [ __int-__          ] defmulti
|    789 :- ( :float :float  ) [ __float-__        ] defmulti
|    790 :- ( :int   :float  ) [ 'int->float dip - ] defmulti
|    791 :- ( :float :int    ) [  int->float     - ] defmulti
|    792 
|    793 :* ( :int   :int    ) [ __int*__          ] defmulti
|    794 :* ( :float :float  ) [ __float*__        ] defmulti
|    795 :* ( :int   :float  ) [ 'int->float dip * ] defmulti
|    796 :* ( :float :int    ) [  int->float     * ] defmulti
|    797 
|    798 ; negation (additive inverse)
|    799 ;
|    800 ; >>> 10 neg
|    801 ; -10
|    802 ; >>> -10 neg
|    803 ; 10
|    804 ; >>> 3.14 neg
|    805 ; -3.14
|    806 
|    807 :neg    '__neg__ def
|    808 
|    809 ; division & modulo
|    810 ;
|    811 ; >>> 1.0 2.0 /                                       ; float division
|    812 ; 0.5
|    813 ; >>> 8 3 div                                         ; int division
|    814 ; 2
|    815 ; >>> 8 3 mod
|    816 ; 2
|    817 ;
|    818 ; >>> 8.0 3 floor/                                    ; floor division
|    819 ; 2
|    820 ; >>> -8 3.0 floor/
|    821 ; -3
|    822 
|    823 :/      '__float/__ def
|    824 :div    '__div__    def
|    825 :mod    '__mod__    def
|    826 
|    827 :floor/ ( :int   :int   ) [ div                    ] defmulti
|    828 :floor/ ( :float :float ) [ / floor                ] defmulti
|    829 :floor/ ( :int   :float ) [ 'int->float dip floor/ ] defmulti
|    830 :floor/ ( :float :int   ) [  int->float     floor/ ] defmulti
|    831 
|    832 ; common predicates
|    833 ;
|    834 ; >>> 10 3 div?
|    835 ; #f
|    836 ; >>> 42 7 div?
|    837 ; #t
|    838 ; >>> ( 2 3 4 ) 'even? filterl
|    839 ; ( 2 4 )
|    840 ; >>> ( 1 2 3 ) 'odd? filterl
|    841 ; ( 1 3 )
|    842 ;
|    843 ; >>> , ( -1 -1.1 0 0.0 1 1.1 )
|    844 ; >>>      dup 'neg?  filterl
|    845 ; ( -1 -1.1 )
|    846 ; >>> drop dup 'zero? filterl
|    847 ; ( 0 0.0 )
|    848 ; >>> drop dup 'pos?  filterl
|    849 ; ( 1 1.1 )
|    850 
|    851 :div?   [ mod 0 =   ] def
|    852 :even?  [ 2 div?    ] def
|    853 :odd?   [ even? not ] def
|    854 
|    855 :neg?   [ 0 lt ] def
|    856 :zero?  [ 0 eq ] def
|    857 :pos?   [ 0 gt ] def
|    858 
|    859 ; increment & decrement
|    860 ;
|    861 ; >>> 41 inc
|    862 ; 42
|    863 ; >>> dec
|    864 ; 41
|    865 
|    866 :inc    [ 1 + ] def
|    867 :dec    [ 1 - ] def
|    868 
|    869                                                                 ; }}}1
     870 
+   -    871 +--121 lines: -- Strings & Characters --
 871 ; -- Strings & Characters --                                    ; {{{1
|    872 
|    873 ; NB: see also "Regexes".
|    874 
|    875 ; conversion between char (i.e. string of length 1) & int
|    876 ; (representing a unicode codepoint)
|    877 ;
|    878 ; >>> "猫" ord
|    879 ; 29483
|    880 ; >>> 0x732b chr
|    881 ; "猫"
|    882 
|    883 :ord    '.ord     def
|    884 :chr    '__chr__  def
|    885 
|    886 ; is char (i.e. str of length 1)
|    887 ;
|    888 ; >>> ( "猫" "foo" "" 42 ) 'char? filterl
|    889 ; ( "猫" )
|    890 
|    891 :char?  [ 'str? [ len 1 = ] bi-and ] def
|    892 
|    893 ; convert to readable str
|    894 ;
|    895 ; >>> 42 show
|    896 ; "42"
|    897 ; >>> 0x20 show
|    898 ; "32"
|    899 ; >>> "foo" show
|    900 ; "\"foo\""
|    901 ; >>> :foo show
|    902 ; ":foo"
|    903 ; >>> x: 42 show
|    904 ; ":x 42 =>"
|    905 ; >>> { x: [1-), y: ( 1 nil :x ) } show
|    906 ; "{ :x 1 [m-) =>, :y ( 1 nil :x ) => }"
|    907 
|    908 :show ( :pair   ) [ [ 'show bi$ " " ++sep++ " =>" ++ ] ^pair ] defmulti
|    909 :show ( :list   ) [ [ "()"  ] [ "( " " "  " )" _showseq ] ~seq ] defmulti
|    910 :show ( :dict   ) [ [ "{ }" ] [ "{ " ", " " }" _showseq ] ~seq ] defmulti
|    911 :show ( :_      ) [ '_showrec '__show__ 'record? ~? ] defmulti
|    912 
|    913 :_showrec [ [ record-type record-type-name __show__ 1 [i-) ]
|    914             [ record->dict show ] bi ++ ] def
|    915 :_showseq [ b d a . 'show map 'b swap 'd join-with 'a ++ ++ ] def
|    916 
|    917 ; convert to str
|    918 ;
|    919 ; >>> "foo" show
|    920 ; "\"foo\""
|    921 ; >>> "foo" ->str
|    922 ; "foo"
|    923 ;
|    924 ; >>> :foo show
|    925 ; ":foo"
|    926 ; >>> :foo ->str
|    927 ; ":foo"
|    928 ; >>> :foo kwd->str
|    929 ; "foo"
|    930 ;
|    931 ; >>> 42 ->str
|    932 ; "42"
|    933 
|    934 :->str  ( :str  ) [      ] defmulti
|    935 :->str  ( :_    ) [ show ] defmulti
|    936 
|    937 :kwd->str [ show [ 2 -1 ] [ 1 nil ] [ "\"" ends-with? ] ~? [i-j) ] def
|    938 
|    939 ; join a sequence of strings (separated by a separator)
|    940 ;
|    941 ; >>> "foobar" ->list
|    942 ; ( "f" "o" "o" "b" "a" "r" )
|    943 ; >>> join
|    944 ; "foobar"
|    945 ; >>> ( "Hello" "World" ) ", " join-with
|    946 ; "Hello, World"
|    947 ;
|    948 ; >>> "foo" "bar" " & " ++sep++
|    949 ; "foo & bar"
|    950 
|    951 :join       [ "" join-with ] def                                ; TODO
|    952 :join-with  [ s . [ "" ] [ >< [ 's ++sep++ ] foldl ] ^seq ] def
|    953 :++sep++    [ >< ++ ++ ] def
|    954 
|    955 ; case conversion
|    956 ;
|    957 ; >>> "foo" upper-case
|    958 ; "FOO"
|    959 ; >>> "BAR" lower-case
|    960 ; "bar"
|    961 
|    962 :lower-case '.lower def
|    963 :upper-case '.upper def
|    964 
|    965 ; trimming whitespace
|    966 ;
|    967 ; >>> " foo " trim
|    968 ; "foo"
|    969 ; >>> " foo " triml
|    970 ; "foo "
|    971 ; >>> " foo " trimr
|    972 ; " foo"
|    973 
|    974 :trim   '.trim  def
|    975 :triml  '.triml def
|    976 :trimr  '.trimr def
|    977 
|    978 ; prefix & suffix predicates
|    979 ;
|    980 ; >>> "foo" "f" starts-with?                          ; prefix
|    981 ; #t
|    982 ; >>> "bar" "ar" ends-with?                           ; suffix
|    983 ; #t
|    984 ;
|    985 ; >>> "foobar" "oba" elem?                            ; infix
|    986 ; #t
|    987 
|    988 :starts-with? [ swap !starts-with? ] def
|    989 :ends-with?   [ swap !ends-with?   ] def
|    990 
|    991                                                                 ; }}}1
     992 
+   -    993 +--133 lines: -- Nil, Num, Pair & Tuples --
 993 ; -- Nil, Num, Pair & Tuples --                                 ; {{{1
|    994 
|    995 ; nil "branch"
|    996 ;
|    997 ; >>> , :f [ [ "nil!" say! ] [ type show say! ] ~nil ] def
|    998 ; >>> nil f
|    999 ; nil!
|   1000 ; >>> 42 f
|   1001 ; :int
|   1002 ;
|   1003 ; >>> ( 1 ) 'rest ~> 'first ~> [ 1 + ] ~>
|   1004 ; nil
|   1005 ; >>> ( 1 2 ) 'rest ~> 'first ~> [ 1 + ] ~>
|   1006 ; 3
|   1007 ; >>> ( 3 4 ) ( 'rest 'first [ 1 + ] ) ~~>
|   1008 ; 5
|   1009 
|   1010 :~nil   [ [ 'drop % ] dip 'nil? ~? ] def                        ; bltn
|   1011 :~>     [ [ nil ] swap ~nil ] def
|   1012 :~~>    [ [ .[ .1 '2 ~~> ] ~> ] ^seq' ] def
|   1013 
|   1014 ; "convert" to nil: turn "empty"/"zero" values into (falsy) nil
|   1015 ;
|   1016 ; >>> ( "foo" "" 42 0 ( 1 2 3 ) () ) '->nil mapl
|   1017 ; ( "foo" nil 42 nil ( 1 2 3 ) nil )
|   1018 
|   1019 :->nil  ( :nil  )   [ ] defmulti
|   1020 :->nil  ( :bool )   [ #t nil ? ] defmulti
|   1021 
|   1022 :->nil  ( :int  )   [ [ drop nil ] [] ~zero  ] defmulti
|   1023 :->nil  ( :_    )   [ [      nil ] [] ~seq   ] defmulti
|   1024 
|   1025 ; is int or float?
|   1026 ;
|   1027 ; >>> 1 num?
|   1028 ; #t
|   1029 ; >>> 3.14 num?
|   1030 ; #t
|   1031 ; >>> () num?
|   1032 ; #f
|   1033 
|   1034 :num?   [ 'int? 'float? bi-or ] def
|   1035 
|   1036 ; TODO: is-nan?
|   1037 
|   1038 ; number "branch"
|   1039 ;
|   1040 ; >>> 0 [ " negative" ] [ " non-negative" ] ~neg  'show dip ++ say!
|   1041 ; 0 non-negative
|   1042 ; >>> 0 [ " zero"     ] [ " non-zero"     ] ~zero 'show dip ++ say!
|   1043 ; 0 zero
|   1044 ; >>> 0 [ " positive" ] [ " non-positive" ] ~pos  'show dip ++ say!
|   1045 ; 0 non-positive
|   1046 ;
|   1047 ; >>> 4 [ :neg ] [ :zero ] [ :pos ] ~num nip
|   1048 ; :pos
|   1049 
|   1050 :~neg   [ 0 ~[lt] ] def
|   1051 :~zero  [ 0 ~[eq] ] def
|   1052 :~pos   [ 0 ~[gt] ] def
|   1053 
|   1054 :~num   [ 0 ~[cmp] ] def
|   1055 
|   1056 ; pair "pattern match" & key/value
|   1057 ;
|   1058 ; >>> , x: 42 'swap ^pair, s!
|   1059 ; --- STACK ---
|   1060 ; :x
|   1061 ; 42
|   1062 ; ---  END  ---
|   1063 ; >>> c!
|   1064 ; *** STACK CLEARED ***
|   1065 ; >>> , y: 37 'val 'key bi, s!
|   1066 ; --- STACK ---
|   1067 ; :y
|   1068 ; 37
|   1069 ; ---  END  ---
|   1070 
|   1071 :^pair  [ [ 'key 'val bi ] dip call ] def
|   1072 
|   1073 :key    '.key   def
|   1074 :val    '.value def
|   1075 
|   1076 ; tuples (WIP)
|   1077 ;
|   1078 ; >>> 1 2 2T
|   1079 ; T( 1 2 )
|   1080 ; >>> dup .1st
|   1081 ; 1
|   1082 ; >>> drop .2nd
|   1083 ; 2
|   1084 ;
|   1085 ; >>> T( 1 2 3 4 5 )
|   1086 ; T( 1 2 3 4 5 )
|   1087 ; >>> .5th
|   1088 ; 5
|   1089 
|   1090 :T()  [ 0T ] def
|   1091 :T    [ & . '& '_T '& len get^ apply ] def                      ; TODO
|   1092 
|   1093 :0T (                           ) defrecord
|   1094 :1T ( :1st                      ) defrecord
|   1095 :2T ( :1st :2nd                 ) defrecord
|   1096 :3T ( :1st :2nd :3rd            ) defrecord
|   1097 :4T ( :1st :2nd :3rd :4th       ) defrecord
|   1098 :5T ( :1st :2nd :3rd :4th :5th  ) defrecord
|   1099 
|   1100 :_T ( '0T '1T '2T '3T '4T '5T ) def
|   1101 
|   1102 :show   ( :0T ) [ tuple-show ] defmulti
|   1103 :show   ( :1T ) [ tuple-show ] defmulti
|   1104 :show   ( :2T ) [ tuple-show ] defmulti
|   1105 :show   ( :3T ) [ tuple-show ] defmulti
|   1106 :show   ( :4T ) [ tuple-show ] defmulti
|   1107 :show   ( :5T ) [ tuple-show ] defmulti
|   1108 
|   1109 :len    ( :0T ) [ drop 0 ] defmulti
|   1110 :len    ( :1T ) [ drop 1 ] defmulti
|   1111 :len    ( :2T ) [ drop 2 ] defmulti
|   1112 :len    ( :3T ) [ drop 3 ] defmulti
|   1113 :len    ( :4T ) [ drop 4 ] defmulti
|   1114 :len    ( :5T ) [ drop 5 ] defmulti
|   1115 
|   1116 :->list ( :0T ) [ vals ] defmulti
|   1117 :->list ( :1T ) [ vals ] defmulti
|   1118 :->list ( :2T ) [ vals ] defmulti
|   1119 :->list ( :3T ) [ vals ] defmulti
|   1120 :->list ( :4T ) [ vals ] defmulti
|   1121 :->list ( :5T ) [ vals ] defmulti
|   1122 
|   1123 :tuple-show   [ vals show "T" swap ++ ] def
|   1124 
|   1125                                                                 ; }}}1
    1126 
+   -   1127 +--570 lines: -- Sequences, Lists & Ranges --
1127 ; -- Sequences, Lists & Ranges --                               ; {{{1
|   1128 
|   1129 ; NB: inclusive; infinite if stop is nil.
|   1130 :Range ( :start :stop :step ) defrecord
|   1131 
|   1132 :show ( :Range )  [ [ m n s . { f: [ show " " ++ ] } let[ (
|   1133                       'm f
|   1134                       'n [ "" "" ")"  ] [ f "n" "]" ] ~nil
|   1135                       's [ drop "" "" ] [ f ":s" ] 1 ~[eq]
|   1136                       <rot [ "[m-" <rot ] 2dip
|   1137                     ) ] join ] ^Range ] defmulti
|   1138 
|   1139 :range        [ 3dup 3list 'float? any? [ '_->float tri$ ] when
|   1140                 2dup float? and [ [ 2.0 / + ] keep ] when Range ] def
|   1141 
|   1142 :range-unseq  [ [ nil nil ]
|   1143                 [ [ dup [ over + ] $ 2dip Range ] ^Range ] ~seq ] def
|   1144 :range-empty? [ [ >< [ 2drop #f ] [ rot> _pos<> ] ~nil ] ^Range ] def
|   1145 :range-len    [ [ >< [ 2drop nil ] [ rot> '- dip floor/ inc 0 max ]
|   1146                   ~nil ] ^Range ] def
|   1147 
|   1148 :range-get^'  [ over 0 < [ 2drop nil ] [ [ i m n s .
|   1149                   'm 's 'i * + 'n
|   1150                   [] [ over 's _pos<> [ drop nil ] when ] ~nil
|   1151                 ] ^Range ] if ] def
|   1152 :range-has?'  [ range-get^' nil? not ] def
|   1153 :range-elem?' [ [ k m n s .
|   1154                   'k 'm 's _pos<>, 'n nil? not, 'n 'k 's _pos<>,
|   1155                   and or not
|   1156                   'k 'm - 's,       ; NB: be careful w/ elem? w/ float
|   1157                   'k float? [ / dup trunc eq ] 'div? if and
|   1158                 ] ^Range ] def                                  ; TODO
|   1159 
|   1160 :_->float [ dup int? 'int->float when ] def
|   1161 :_pos<>   [ pos? '< '> if ] def
|   1162 
|   1163 ; int ranges
|   1164 ;
|   1165 ; >>> 2 10 [m-n] ->list
|   1166 ; ( 2 3 4 5 6 7 8 9 10 )
|   1167 ; >>> 2 10 [m-n) ->list
|   1168 ; ( 2 3 4 5 6 7 8 9 )
|   1169 ; >>> 4 [m-) 10 take-first ->list
|   1170 ; ( 4 5 6 7 8 9 10 11 12 13 )
|   1171 ; >>> 10 [0-n] ->list
|   1172 ; ( 0 1 2 3 4 5 6 7 8 9 10 )
|   1173 ; >>> 10 [0-n) ->list
|   1174 ; ( 0 1 2 3 4 5 6 7 8 9 )
|   1175 ; >>> [0-) 10 take-first ->list
|   1176 ; ( 0 1 2 3 4 5 6 7 8 9 )
|   1177 ; >>> 10 [1-n] ->list
|   1178 ; ( 1 2 3 4 5 6 7 8 9 10 )
|   1179 ; >>> 10 [1-n) ->list
|   1180 ; ( 1 2 3 4 5 6 7 8 9 )
|   1181 ; >>> [1-) 10 take-first ->list
|   1182 ; ( 1 2 3 4 5 6 7 8 9 10 )
|   1183 ;
|   1184 ; float ranges
|   1185 ;
|   1186 ; >>> 2.1 10.1 [m-n] ->list
|   1187 ; ( 2.1 3.1 4.1 5.1 6.1 7.1 8.1 9.1 10.1 )
|   1188 ; >>> 2.1 10.1 [m-n) ->list
|   1189 ; ( 2.1 3.1 4.1 5.1 6.1 7.1 8.1 9.1 )
|   1190 ; >>> 4.1 [m-) 10 take-first ->list
|   1191 ; ( 4.1 5.1 6.1 7.1 8.1 9.1 10.1 11.1 12.1 13.1 )
|   1192 ; >>> 10.0 [0-n] ->list
|   1193 ; ( 0.0 1.0 2.0 3.0 4.0 5.0 6.0 7.0 8.0 9.0 10.0 )
|   1194 ; >>> 10.0 [0-n) ->list
|   1195 ; ( 0.0 1.0 2.0 3.0 4.0 5.0 6.0 7.0 8.0 9.0 )
|   1196 ; >>> 10.0 [1-n] ->list
|   1197 ; ( 1.0 2.0 3.0 4.0 5.0 6.0 7.0 8.0 9.0 10.0 )
|   1198 ; >>> 10.0 [1-n) ->list
|   1199 ; ( 1.0 2.0 3.0 4.0 5.0 6.0 7.0 8.0 9.0 )
|   1200 ;
|   1201 ; ranges with step
|   1202 ;
|   1203 ; >>> 2 10 2 [m-n:s] ->list
|   1204 ; ( 2 4 6 8 10 )
|   1205 ; >>> 2 11 2.0 [m-n:s) ->list
|   1206 ; ( 2.0 4.0 6.0 8.0 10.0 )
|   1207 ; >>> 4 2 [m-:s) 5 take-first ->list
|   1208 ; ( 4 6 8 10 12 )
|   1209 ; >>> 10.0 2 [0-n:s] ->list
|   1210 ; ( 0.0 2.0 4.0 6.0 8.0 10.0 )
|   1211 ; >>> 10 2 [0-n:s) ->list
|   1212 ; ( 0 2 4 6 8 )
|   1213 ; >>> 2.0 [0-:s) 5 take-first ->list
|   1214 ; ( 0.0 2.0 4.0 6.0 8.0 )
|   1215 ; >>> 10 3 [1-n:s] ->list
|   1216 ; ( 1 4 7 10 )
|   1217 ; >>> 10 3.0 [1-n:s) ->list
|   1218 ; ( 1.0 4.0 7.0 )
|   1219 ; >>> 2 [1-:s) 5 take-first ->list
|   1220 ; ( 1 3 5 7 9 )
|   1221 
|   1222 :[m-n]    [          1 range   ] def
|   1223 :[m-n)    [   dec      [m-n]   ] def
|   1224 :[m-)     [   nil      [m-n]   ] def
|   1225 :[0-n]    [ 0     swap [m-n]   ] def
|   1226 :[0-n)    [ 0     swap [m-n)   ] def
|   1227 :[0-)     [ 0 nil      [m-n]   ] def
|   1228 :[1-n]    [ 1     swap [m-n]   ] def
|   1229 :[1-n)    [ 1     swap [m-n)   ] def
|   1230 :[1-)     [ 1 nil      [m-n]   ] def
|   1231 
|   1232 :[m-n:s]  'range                 def
|   1233 :[m-n:s)  [   '- keep  [m-n:s] ] def
|   1234 :[m-:s)   [   nil ><   [m-n:s] ] def
|   1235 :[0-n:s]  [ 0     rot> [m-n:s] ] def
|   1236 :[0-n:s)  [ 0     rot> [m-n:s) ] def
|   1237 :[0-:s)   [ 0 nil <rot [m-n:s] ] def
|   1238 :[1-n:s]  [ 1     rot> [m-n:s] ] def
|   1239 :[1-n:s)  [ 1     rot> [m-n:s) ] def
|   1240 :[1-:s)   [ 1 nil <rot [m-n:s] ] def
|   1241 
|   1242 ; small lists
|   1243 ;
|   1244 ; >>> 42 1list
|   1245 ; ( 42 )
|   1246 ; >>> :x :y 2list
|   1247 ; ( :x :y )
|   1248 ; >>> :x :y :z 3list
|   1249 ; ( :x :y :z )
|   1250 
|   1251 :1list  [ () cons     ] def
|   1252 :2list  [ 1list cons  ] def
|   1253 :3list  [ 2list cons  ] def
|   1254 
|   1255 ; lazy sequences
|   1256 ;
|   1257 ;             list    block (lazy rest)         append
|   1258 ; >>> , :fibs ( 0 1 ) [ 'fibs dup rest '+ zip ] lseq def
|   1259 ; >>> 'fibs 10 take-first ->list
|   1260 ; ( 0 1 1 2 3 5 8 13 21 34 )
|   1261 ;
|   1262 ; >>> :head [ ( :tail :is :lazy ) ] lseq1 ->list      ; singleton
|   1263 ; ( :head :tail :is :lazy )
|   1264 ;
|   1265 ; NB: use of side-effects is for demonstration purposes only and
|   1266 ; should be avoided in most code.
|   1267 ;
|   1268 ; >>> , [ "evaluated once" say!, ( 1 2 3 ) ] lazy-seq ; completely lazy
|   1269 ; >>> dup !thunk
|   1270 ; evaluated once
|   1271 ; ( 1 2 3 )
|   1272 ; >>> drop !thunk
|   1273 ; ( 1 2 3 )
|   1274 
|   1275 :LSeq ( :chunk :thunk ) defrecord   ; NB: chunk must be a list
|   1276 
|   1277 :show ( :LSeq ) [ .chunk show "#<seq" swap "(...)>" ++ ++ ] defmulti
|   1278 
|   1279 :lseq     [ __thunk__  LSeq ] def
|   1280 :lseq1    [ '1list dip lseq ] def
|   1281 :lazy-seq [ () swap    lseq ] def
|   1282 
|   1283 ; "as sequence"
|   1284 ;
|   1285 ; * returns nil if empty
|   1286 ; * converts to a proper sequence type if needed
|   1287 ;   (e.g. strings & dicts to lists)
|   1288 ; * otherwise returns the sequence unmodified
|   1289 ;
|   1290 ; NB: whether conversion is performed and to what type may change; the
|   1291 ; only guarantee is that a "proper" sequence type is returned.
|   1292 ;
|   1293 ; >>> nil seq
|   1294 ; nil
|   1295 ; >>> "foo" seq                   ; str becomes a list
|   1296 ; ( "f" "o" "o" )
|   1297 ; >>> ( 1 2 3 ) seq
|   1298 ; ( 1 2 3 )
|   1299 ; >>> "" seq
|   1300 ; nil
|   1301 ; >>> () seq
|   1302 ; nil
|   1303 ; >>> { x: 1, y: 2 } seq          ; dict becomes a list
|   1304 ; ( :x 1 => :y 2 => )
|   1305 ; >>> 10 [1-n] seq ->list
|   1306 ; ( 1 2 3 4 5 6 7 8 9 10 )
|   1307 ; >>> [ ( 1 2 3 ) ] lazy-seq seq  ; checking emptiness forces evaluation
|   1308 ; ( 1 2 3 )
|   1309 ;
|   1310 ; >>> ( nil "foo" { x: 1 } ( 1 2 ) [1-), ( 1 2 ) 'inc map, 42 ) 'seq? mapl
|   1311 ; ( #t :partial :partial #t #t #t #f )
|   1312 
|   1313 :seq    ( :nil    ) [ ] defmulti
|   1314 :seq    ( :str    ) [ ->nil '->list ~>  ] defmulti              ; TODO
|   1315 :seq    ( :dict   ) [ ->nil '.pairs ~>  ] defmulti              ; TODO
|   1316 :seq    ( :list   ) [ ->nil             ] defmulti
|   1317 :seq    ( :Range  ) [ ->nil             ] defmulti
|   1318 :seq    ( :LSeq   ) [ lseq-seq          ] defmulti
|   1319 
|   1320 :lseq-seq [ dup .chunk empty? [ !thunk seq ] when ] def
|   1321 
|   1322 :seq?   ( :nil    ) [ drop #t       ] defmulti
|   1323 :seq?   ( :str    ) [ drop :partial ] defmulti
|   1324 :seq?   ( :dict   ) [ drop :partial ] defmulti
|   1325 :seq?   ( :list   ) [ drop #t       ] defmulti
|   1326 :seq?   ( :Range  ) [ drop #t       ] defmulti
|   1327 :seq?   ( :LSeq   ) [ drop #t       ] defmulti
|   1328 :seq?   ( :_      ) [ drop #f       ] defmulti
|   1329 
|   1330 ; generic "uncons"
|   1331 ;
|   1332 ; unseq ⇔ 'first 'rest bi
|   1333 ;
|   1334 ; >>> , ( 1 2 ) unseq s!
|   1335 ; --- STACK ---
|   1336 ; ( 2 )
|   1337 ; 1
|   1338 ; ---  END  ---
|   1339 ; >>> c!
|   1340 ; *** STACK CLEARED ***
|   1341 ; >>> , 3 10 [m-n] unseq ->list s!
|   1342 ; --- STACK ---
|   1343 ; ( 4 5 6 7 8 9 10 )
|   1344 ; 3
|   1345 ; ---  END  ---
|   1346 ; >>> c!
|   1347 ; *** STACK CLEARED ***
|   1348 ; >>> , [ ( 1 2 ) ] lazy-seq unseq s!
|   1349 ; --- STACK ---
|   1350 ; ( 2 )
|   1351 ; 1
|   1352 ; ---  END  ---
|   1353 
|   1354 :unseq  ( :nil    ) [ nil ] defmulti
|   1355 :unseq  ( :list   ) [ [ nil nil ] [] ^list ] defmulti
|   1356 :unseq  ( :Range  ) [ range-unseq ] defmulti
|   1357 :unseq  ( :LSeq   ) [ lseq-unseq  ] defmulti
|   1358 
|   1359 :lseq-unseq [ [ t . [ t unseq ] [ .uncons^ 't LSeq ] ~seq ] ^LSeq ] def
|   1360 
|   1361 ; generic "head" & "tail"
|   1362 ;
|   1363 ; 'first 'rest bi ⇔ unseq
|   1364 ;
|   1365 ; * first returns the first element
|   1366 ; * rest returns the rest of the sequence
|   1367 ; * both return nil if the sequence is empty
|   1368 ;
|   1369 ; >>> ( 1 2 3 ) first
|   1370 ; 1
|   1371 ; >>> 4 [1-n] rest ->list
|   1372 ; ( 2 3 4 )
|   1373 
|   1374 :first  ( :_ ) [ unseq drop ] defmulti
|   1375 :rest   ( :_ ) [ unseq nip  ] defmulti
|   1376 
|   1377 ; is the sequence empty?
|   1378 ;
|   1379 ; empty? ⇔ seq not
|   1380 ;
|   1381 ; >>> "foo" empty?
|   1382 ; #f
|   1383 ; >>> () empty?
|   1384 ; #t
|   1385 ; >>> { x: 1 } empty?
|   1386 ; #f
|   1387 ; >>> 1 [1-n] rest empty?
|   1388 ; #t
|   1389 ; >>> ( 1 2 3 ) [ 1 + ] map empty?
|   1390 ; #f
|   1391 
|   1392 :empty? ( :str    ) [ .empty?       ] defmulti
|   1393 :empty? ( :list   ) [ .empty?       ] defmulti
|   1394 :empty? ( :dict   ) [ .empty?       ] defmulti
|   1395 :empty? ( :Range  ) [ range-empty?  ] defmulti
|   1396 :empty? ( :_      ) [ seq not       ] defmulti
|   1397 
|   1398 ; sequence length
|   1399 ;
|   1400 ; NB: sequence must be finite (or a range).
|   1401 ;
|   1402 ; >>> "foo" len
|   1403 ; 3
|   1404 ; >>> ( 1 2 ) len
|   1405 ; 2
|   1406 ; >>> { x: 1 } len
|   1407 ; 1
|   1408 ; >>> 37 42 [m-n) len
|   1409 ; 5
|   1410 ; >>> 42 [m-) len                                     ; infinite
|   1411 ; nil
|   1412 ; >>> ( 1 2 3 ) [ 2 >= ] filter len
|   1413 ; 2
|   1414 
|   1415 :len    ( :str    ) [ .len      ] defmulti
|   1416 :len    ( :list   ) [ .len      ] defmulti
|   1417 :len    ( :dict   ) [ .len      ] defmulti
|   1418 :len    ( :Range  ) [ range-len ] defmulti
|   1419 :len    ( :_      ) [ seq-len   ] defmulti
|   1420 
|   1421 :seq-len [ 0 swap [ drop inc ] each ] def
|   1422 
|   1423 ; append two sequences
|   1424 ;
|   1425 ; NB: to merge two dicts, use update.
|   1426 ;
|   1427 ; >>> "foo" "bar" ++
|   1428 ; "foobar"
|   1429 ; >>> ( 1 2 3 ) ( 4 5 ) ++
|   1430 ; ( 1 2 3 4 5 )
|   1431 ;
|   1432 ; >>> ( 1 2 3 ) [ ( 4 5 ) ] lazy-seq ++ ->list
|   1433 ; ( 1 2 3 4 5 )
|   1434 ; >>> [ ( 1 2 3 ) ] lazy-seq ( 4 5 ) ++ ->list
|   1435 ; ( 1 2 3 4 5 )
|   1436 
|   1437 :++     ( :str  :str  ) [ !append ] defmulti
|   1438 :++     ( :list :list ) [ !append ] defmulti
|   1439 
|   1440 :++     ( :nil  :list ) [ nip ] defmulti                        ; TODO
|   1441 :++     ( :nil  :LSeq ) [ nip ] defmulti
|   1442 
|   1443 :++     ( :list :nil  ) [ drop ] defmulti                       ; TODO
|   1444 :++     ( :LSeq :nil  ) [ drop ] defmulti
|   1445 
|   1446 :++     ( :list :LSeq ) [ [ '++ dip LSeq ] ^LSeq ] defmulti
|   1447 :++     ( :LSeq :list ) [ _lseq++ ] defmulti
|   1448 :++     ( :LSeq :LSeq ) [ _lseq++ ] defmulti
|   1449 
|   1450 :_lseq++ [ .[ [ '1 ++ ] @ lseq ] ^LSeq ] def
|   1451 
|   1452 ; convert to list
|   1453 ;
|   1454 ; >>> "foo" ->list
|   1455 ; ( "f" "o" "o" )
|   1456 ; >>> ( 1 2 3 ) ->list
|   1457 ; ( 1 2 3 )
|   1458 ; >>> { x: 1, y: 2 } ->list
|   1459 ; ( :x 1 => :y 2 => )
|   1460 
|   1461 :->list ( :str  ) [ .->list ] defmulti
|   1462 :->list ( :list ) [         ] defmulti
|   1463 :->list ( :dict ) [ .pairs  ] defmulti
|   1464 
|   1465 :->list ( :_    ) [ xs . ( 'xs [] each ) ] defmulti             ; TODO
|   1466                 ; [ [ () ] [ ->list cons ] ^seq ]
|   1467 
|   1468 ; list & sequence "pattern match"
|   1469 ;
|   1470 ; * ^seq uses seq and "unseq"s the sequence when not empty
|   1471 ; * ~seq uses empty? and returns the original sequence when not empty
|   1472 ;
|   1473 ; >>> ( 1 2 3 ) [ "empty" ] [ hd tl . 'hd ] ^list     ; head or "empty"
|   1474 ; 1
|   1475 ; >>> () [ "empty" ] 'drop ^seq
|   1476 ; "empty"
|   1477 ; >>> ( 4 5 ) [ "empty" ] 'head^ ~seq
|   1478 ; 4
|   1479 ; >>> "foo" [ () ] 'nip ^seq
|   1480 ; ( "o" "o" )
|   1481 ; >>> "foo" [ "" ] [] ~seq
|   1482 ; "foo"
|   1483 
|   1484 :^list  [ [ 'drop % ] dip '.uncons^ % '.empty? ~? ] def
|   1485 :^seq   [ 'seq 2dip 'unseq % ~nil ] def
|   1486 :~seq   [ [ 'drop % ] dip 'empty? ~? ] def
|   1487 
|   1488 :^seq'  [ [] swap ^seq ] def
|   1489 
|   1490 ; sequence conditional & "pattern match"
|   1491 ;
|   1492 ; NB: the difference between when-seq and with-seq is that the latter
|   1493 ; "unseq"s the sequence when not empty.
|   1494 ;
|   1495 ; >>> () 'len when-seq
|   1496 ; nil
|   1497 ; >>> ( 1 2 3 ) 'len when-seq
|   1498 ; 3
|   1499 ; >>> ( 1 2 3 ) 'drop with-seq
|   1500 ; 1
|   1501 ; >>> () 'drop with-seq
|   1502 ; nil
|   1503 
|   1504 :when-seq [ [ seq dup ] dip when  ] def
|   1505 :with-seq [ [ nil ] swap ^seq     ] def
|   1506 
|   1507 ; "lazy" map & filter
|   1508 ;
|   1509 ; >>> ( 1 2 3 ) [ dup * ] map ->list
|   1510 ; ( 1 4 9 )
|   1511 ; >>> ( 1 2 3 ) 'dup map ->list         ; multiple return values is OK
|   1512 ; ( 1 1 2 2 3 3 )
|   1513 ; >>> ( 1 2 3 4 ) 'even? filterl
|   1514 ; ( 2 4 )
|   1515 
|   1516 :map    [ f . [ () swap [ [ x xt . ( 'x f ) !append 'xt ] with-seq ]
|   1517                 32 times .[ '1 'f map ] lseq ] when-seq ] def   ; TODO
|   1518       ; [ f . [ x xt . ( 'x f ) [ 'xt 'f map ] lseq ] with-seq ]
|   1519 :filter [ .[ [] 'drop '1 ~? ] map ] def
|   1520 
|   1521 :mapl     [ map    ->list ] def
|   1522 :filterl  [ filter ->list ] def
|   1523 
|   1524 ; zip(with)
|   1525 ;
|   1526 ; >>> ( :x :y ) ( 1 2 3 ) zip' ->list
|   1527 ; ( T( :x 1 ) T( :y 2 ) )
|   1528 ; >>> ( :x :y ) ( 1 2 3 ) [] zip ->list ; multiple return values is OK
|   1529 ; ( :x 1 :y 2 )
|   1530 ; >>> [1-) ( :x :y ) [ swap => ] zip ->list dict
|   1531 ; { :x 1 =>, :y 2 => }
|   1532 
|   1533 :zip    [ f . [ drop nil ] [ y yt . [ x xt .
|   1534           ( 'x 'y f ) [ 'xt 'yt 'f zip ] lseq
|   1535         ] with-seq ] ^seq ] def
|   1536 :zip'   [ '2T zip ] def
|   1537 
|   1538 ; TODO: unzip
|   1539 
|   1540 ; folding (left- and right-associative)
|   1541 ;
|   1542 ; NB: foldr' only partially applies the recursive step, allowing
|   1543 ; short-circuiting/laziness.
|   1544 ;
|   1545 ; >>> ( 2 3 4 ) 10 '- foldl                         ; ⇔ 10 2 - 3 - 4 -
|   1546 ; 1
|   1547 ; >>> ( 2 3 4 ) 10 '- foldr                         ; ⇔ 2 3 4 10 - - -
|   1548 ; -7
|   1549 ; >>> ( 2 3 4 ) () [ [ 1 + ] dip cons ] foldr       ; "strict"
|   1550 ; ( 3 4 5 )
|   1551 ; >>> ( 2 3 4 ) () [ [ 1 + ] dip call cons ] foldr' ; "lazy"
|   1552 ; ( 3 4 5 )
|   1553 
|   1554 :foldl  [ f . swap [ rot> f 'f foldl      ] ^seq' ] def
|   1555 :foldr  [ f . swap [ <rot 'f foldr f      ] ^seq' ] def
|   1556 :foldr' [ f . swap [ <rot 'f 'foldr' 3$ f ] ^seq' ] def
|   1557 
|   1558 ; TODO: scanl, scanr
|   1559 
|   1560 ; concatenation of all elements
|   1561 ;
|   1562 ; >>> ( ( 1 2 3 ) dup [ dup * ] map dup 'even? filter ) concat ->list
|   1563 ; ( 1 2 3 1 4 9 4 )
|   1564 
|   1565 :concat [ () [ lazy-seq ++ ] foldr' ] def
|   1566 
|   1567 ; reverse order of elements; "strict"
|   1568 ;
|   1569 ; NB: reversing a list or str is guaranteed to return a value of the
|   1570 ; same type; reversing (most) other sequences returns a list.
|   1571 ;
|   1572 ; >>> ( 1 2 3 ) reverse
|   1573 ; ( 3 2 1 )
|   1574 ; >>> ( 1 2 3 ) [ dup * ] map reverse
|   1575 ; ( 9 4 1 )
|   1576 ; >>> "foobar" reverse
|   1577 ; "raboof"
|   1578 ; >>> 10 20 [m-n] reverse ->list
|   1579 ; ( 20 19 18 17 16 15 14 13 12 11 10 )
|   1580 
|   1581 :reverse  ( :str    ) [ .reverse        ] defmulti
|   1582 :reverse  ( :Range  ) [ range-reverse   ] defmulti
|   1583 :reverse  ( :_      ) [ reverse-as-list ] defmulti
|   1584 
|   1585 :range-reverse    [ [ m n s . 'n [ "reverse: infinite range" fail ]
|   1586                       [ 'm 's neg Range ] ~nil ] ^Range ] def
|   1587 :reverse-as-list  [ () [ swap cons ] foldl ] def
|   1588 
|   1589 ; iterating over a sequence
|   1590 ;
|   1591 ; >>> , ( "Hello" "World" ) 'say! each
|   1592 ; Hello
|   1593 ; World
|   1594 ; >>> , ( 1 2 3 ) [] each s!
|   1595 ; --- STACK ---
|   1596 ; 3
|   1597 ; 2
|   1598 ; 1
|   1599 ; ---  END  ---
|   1600 ; >>> ( ( 1 2 ) 'dup each )
|   1601 ; ( 1 1 2 2 )
|   1602 
|   1603 :each   [ f . unseq dup [ 'f dip 'f each ] when2 ] def          ; TODO
|   1604       ; [ f . [ 'f dip 'f each ] ^seq' ]    ; currently 2x slower :(
|   1605 
|   1606 ; generating (infinite) sequences & taking subsequences
|   1607 ;
|   1608 ; >>> ( 1 2 3 ) cycle 10 take-first ->list
|   1609 ; ( 1 2 3 1 2 3 1 2 3 1 )
|   1610 ; >>> 0 'inc iterate 10 take-first 2 drop-first ->list
|   1611 ; ( 2 3 4 5 6 7 8 9 )
|   1612 ; >>> 1 [ 2 * ] iterate [ 10 < ] drop-while [ 80 < ] take-while ->list
|   1613 ; ( 16 32 64 )
|   1614 ; >>> 42 repeat 4 take-first ->list
|   1615 ; ( 42 42 42 42 )
|   1616 ; >>> :x 3 replicate ->list
|   1617 ; ( :x :x :x )
|   1618 ; >>> 10 [1-n] 2 take-nth ->list
|   1619 ; ( 1 3 5 7 9 )
|   1620 
|   1621 :iterate    [ x f . ( 'x [ dup f ] 31 times ) dup 31 swap !get^
|   1622               .[ '1 f 'f iterate ] lseq ] def                   ; TODO
|   1623           ; [ f . () swap [ [ 1list ++ ] keep f ] 32 times
|   1624           ;   .[ '1 'f iterate ] lseq ]                 ; slower :(
|   1625           ; [ x f . 'x [ 'x f 'f iterate ] lseq1 ]      ; w/o chunking
|   1626 
|   1627 :cycle      [ repeat concat ] def
|   1628 :repeat     [ dup 'repeat $ lseq1 ] def
|   1629 :replicate  [ 'repeat dip take-first ] def
|   1630 
|   1631 :take-first [ .[ '1 [ dec 'take-first 2$ lseq1 ] [ 3drop nil ] ~pos ]
|   1632               with-seq ] def
|   1633 :drop-first [ .[ '1 0 > [ rest '1 dec drop-first ] when ] when-seq ] def
|   1634 
|   1635 :take-while [ p? . nil [ over p? 'lseq1 [ 2drop nil ] if ] foldr' ] def
|   1636 :drop-while [ p? . [ dup first p? [ rest 'p? drop-while ] when ]
|   1637               when-seq ] def
|   1638 
|   1639 :take-nth   [ n . [ [ 'n dec drop-first 'n take-nth ] $ lseq1 ]
|   1640               with-seq ] def
|   1641 
|   1642 ; TODO: split-at, split-w/, ...
|   1643 ; TODO: init
|   1644 
|   1645 ; searching
|   1646 ;
|   1647 ; NB: see also elem?.
|   1648 ;
|   1649 ; >>> [1-) [ 4 > ] find
|   1650 ; 5
|   1651 ; >>> 10 [1-n] [ 0 < ] find
|   1652 ; nil
|   1653 
|   1654 :find   [ filter 'drop with-seq ] def
|   1655 
|   1656 ; partitioning a sequence (into a sequence of elements that do and one
|   1657 ; of elements that do not satisfy a predicate)
|   1658 ;
|   1659 ; NB: unlike Haskell, we can't do both results at the same time with
|   1660 ; foldr :(
|   1661 ;
|   1662 ; >>> , "Hello World!" [ "aeiou" elem?' ] partition 'join bi$ s!
|   1663 ; --- STACK ---
|   1664 ; "Hll Wrld!"
|   1665 ; "eoo"
|   1666 ; ---  END  ---
|   1667 
|   1668 :partition [ 'filter [ 'not @ filter ] 2bi ] def                ; TODO
|   1669 
|   1670 ; least & largest element of a non-empty sequence
|   1671 ;
|   1672 ; >>> ( 1 2 4 -1 7 3 ) minimum
|   1673 ; -1
|   1674 ; >>> ( 1 2 4 -1 7 3 ) maximum
|   1675 ; 7
|   1676 ; >>> () maximum
|   1677 ; *** ERROR: maximum: empty list
|   1678 
|   1679 :minimum [ [ "minimum: empty list" fail ] [ swap 'min foldl ] ^seq ] def
|   1680 :maximum [ [ "maximum: empty list" fail ] [ swap 'max foldl ] ^seq ] def
|   1681 
|   1682 ; sum & product of a sequence
|   1683 ;
|   1684 ; >>> ( 1 2 3 4 ) sum
|   1685 ; 10
|   1686 ; >>> ( 1 2 3 4 ) product
|   1687 ; 24
|   1688 ; >>> () sum
|   1689 ; 0
|   1690 ; >>> () product
|   1691 ; 1
|   1692 
|   1693 :sum      [ 0 '+ foldl ] def
|   1694 :product  [ 1 '* foldl ] def
|   1695 
|   1696                                                                 ; }}}1
    1697 
+   -   1698 +--378 lines: -- Lists, Dicts & Indexing --
1698 ; -- Lists, Dicts & Indexing --                                 ; {{{1
|   1699 
|   1700 ; lists: head & tail ("safe" & "unsafe"), (un)cons
|   1701 ;
|   1702 ; NB: ^seq/first/rest is usually a better choice than
|   1703 ; uncons^/head/tail.
|   1704 ;
|   1705 ; >>> ( 1 2 3 )
|   1706 ; ( 1 2 3 )
|   1707 ; >>> dup head^
|   1708 ; 1
|   1709 ; >>> drop dup tail^
|   1710 ; ( 2 3 )
|   1711 ; >>> , drop uncons^ s!
|   1712 ; --- STACK ---
|   1713 ; ( 2 3 )
|   1714 ; 1
|   1715 ; ---  END  ---
|   1716 ; >>> cons
|   1717 ; ( 1 2 3 )
|   1718 ;
|   1719 ; >>> () head^                                      ; partial function
|   1720 ; *** ERROR: list.head^: empty list
|   1721 ; >>> () tail^
|   1722 ; *** ERROR: list.tail^: empty list
|   1723 ; >>> () head
|   1724 ; nil
|   1725 ; >>> () tail
|   1726 ; nil
|   1727 
|   1728 :head^    '.head^ def
|   1729 :tail^    '.tail^ def
|   1730 
|   1731 :head     [ ->nil 'head^ ~> ] def
|   1732 :tail     [ ->nil 'tail^ ~> ] def
|   1733 
|   1734 :uncons^  '.uncons^ def
|   1735 :cons     '!cons    def
|   1736 
|   1737 ; sorted list
|   1738 ;
|   1739 ; >>> ( 4 2 1 3 ) sort
|   1740 ; ( 1 2 3 4 )
|   1741 ;
|   1742 ; >>> ( nil #f #t 0 10 -2.0 4.0 "foo" :bar ) dup sort =
|   1743 ; #t
|   1744 ;
|   1745 ; >>> ( 1 2.0 3 4.0 ) sort                            ; <=> :-(
|   1746 ; ( 1 3 2.0 4.0 )
|   1747 ; >>> ( 1 2.0 3 4.0 ) sort'                           ; cmp :-)
|   1748 ; ( 1 2.0 3 4.0 )
|   1749 
|   1750 :sort     [ ->list .sort  ] def
|   1751 :sort'    [ ->list .sort' ] def
|   1752 
|   1753 ; TODO: sort-by
|   1754 
|   1755 ; remove consecutive duplicates
|   1756 ;
|   1757 ; >>> ( 1 2 2 3 2 ) uniq ->list
|   1758 ; ( 1 2 3 2 )
|   1759 ; >>> ( 1 2 2 3 2 ) sort uniq ->list
|   1760 ; ( 1 2 3 )
|   1761 ;
|   1762 ; >>> ( 0.0 0.0 / dup ) uniq ->list
|   1763 ; ( NaN NaN )
|   1764 
|   1765 :uniq     [ '= uniq-by ] def
|   1766 :uniq-by  [ f . [ over .[ '1 [ '2 swap f ] drop-while 'f uniq-by ]
|   1767                   lseq1 ] with-seq ] def
|   1768 
|   1769 ; merge dicts & update record
|   1770 ;
|   1771 ; >>> { x: 1, y: 2 } { x: 99 } update
|   1772 ; { :x 99 =>, :y 2 => }
|   1773 ;
|   1774 ; >>> , :Point ( :x :y ) defrecord
|   1775 ; >>> Point( 1 2 )
|   1776 ; Point{ :x 1 =>, :y 2 => }
|   1777 ; >>> { y: 3 } update
|   1778 ; Point{ :x 1 =>, :y 3 => }
|   1779 
|   1780 :update ( :dict :dict ) [ !merge ] defmulti
|   1781 :update ( :_    :_    ) [ over [ 'record->dict dip !merge ] dip
|   1782                           record-type apply-dict ] defmulti     ; TODO
|   1783 
|   1784 ; TODO: update-with function
|   1785 
|   1786 ; keys & values
|   1787 ;
|   1788 ; >>> { x: 1, y: 2 } dup keys
|   1789 ; ( :x :y )
|   1790 ; >>> drop vals
|   1791 ; ( 1 2 )
|   1792 ;
|   1793 ; >>> c!
|   1794 ; *** STACK CLEARED ***
|   1795 ; >>> , :Point ( :x :y ) defrecord
|   1796 ; >>> , Point( 1 2 ) 'keys 'vals bi s!
|   1797 ; --- STACK ---
|   1798 ; ( 1 2 )
|   1799 ; ( :x :y )
|   1800 ; ---  END  ---
|   1801 
|   1802 :keys   ( :dict   ) [ .keys   ] defmulti
|   1803 :values ( :dict   ) [ .values ] defmulti
|   1804 
|   1805 :keys   ( :_      ) [ record-type record-type-fields  ] defmulti
|   1806 :values ( :_      ) [ record-values                   ] defmulti
|   1807 
|   1808 :vals 'values def
|   1809 
|   1810 ; slicing (WIP)
|   1811 ;
|   1812 ; * ranges support any step != 0;
|   1813 ; * lazy sequences support step >= 1;
|   1814 ; * (currently) other sequences -- e.g. list -- only support step = 1;
|   1815 ; * neither infinite ranges nor lazy sequences support negative indices.
|   1816 ;
|   1817 ; NB: see also take-first, drop-first, take-nth.
|   1818 ;
|   1819 ; >>> "0123456789" 5 [i-)
|   1820 ; "56789"
|   1821 ; >>> "0123456789" -5 [-j)
|   1822 ; "01234"
|   1823 ; >>> "0123456789" 3 -3 [i-j)
|   1824 ; "3456"
|   1825 ;
|   1826 ; >>> ( 0 1 2 3 4 5 6 7 8 9 ) -5 [i-)
|   1827 ; ( 5 6 7 8 9 )
|   1828 ; >>> ( 0 1 2 3 4 5 6 7 8 9 ) 5 [-j)
|   1829 ; ( 0 1 2 3 4 )
|   1830 ;
|   1831 ; >>> 10 20 [m-n] 2 -2 [i-j) ->list
|   1832 ; ( 12 13 14 15 16 17 18 )
|   1833 ; >>> [1-) 10 [-j) ->list
|   1834 ; ( 1 2 3 4 5 6 7 8 9 10 )
|   1835 ; >>> 10 -2 -2 [m-n:s] -2 0 -2 [i-j:s) ->list
|   1836 ; ( 0 4 8 )
|   1837 ; >>> 10 -2 -2 [m-n:s] -2 2 -1 [i-j:s) ->list
|   1838 ; ( 0 2 4 )
|   1839 ; >>> [1-) -2 [-j)
|   1840 ; *** ERROR: range-slice: infinite range w/ negative index
|   1841 ;
|   1842 ; >>> [1-) [ dup * ] map 2 10 2 [i-j:s) ->list
|   1843 ; ( 9 25 49 81 )
|   1844 
|   1845 :slice    [ <rot4 slice'          ] def
|   1846 
|   1847 :[i-j)    [            1 slice    ] def                         ; TODO
|   1848 :[i-)     [ nil          [i-j)    ] def
|   1849 :[-j)     [ nil     swap [i-j)    ] def
|   1850 
|   1851 :[i-j:s)  'slice                    def
|   1852 :[i-:s)   [ nil     swap [i-j:s)  ] def
|   1853 :[-j:s)   [ nil     rot> [i-j:s)  ] def
|   1854 :[:s)     [ nil nil <rot [i-j:s)  ] def
|   1855 
|   1856 :slice' ( :str    ) [ !slice            ] defmulti
|   1857 :slice' ( :list   ) [ !slice            ] defmulti
|   1858 :slice' ( :Range  ) [ rot4> range-slice ] defmulti
|   1859 :slice' ( :LSeq   ) [ rot4> seq-slice   ] defmulti
|   1860 
|   1861 :range-slice  [ i j t . [ m n s .
|   1862                 { :tn 't neg? =>,
|   1863                   f:  [ inc 's * 'n
|   1864                         [ "range-slice: infinite range w/ negative "
|   1865                           "index" ++ fail ] [] ~nil + ],
|   1866                   g:  [ 's * 'm + ] }
|   1867                 let[
|   1868                   'i [ 'tn 'n 'm ? ] [ 'f 'g ~neg ] ~nil,
|   1869                   'j [ 'tn 'm 'n ? ] [
|   1870                     'tn 'inc 'dec if
|   1871                     'f [ g 'n [] [ 's neg? 'max 'min if ] ~nil ] ~neg
|   1872                   ] ~nil, 's 't *
|   1873                 ] Range ] ^Range ] def                          ; TODO
|   1874 
|   1875 :seq-slice    [ i j s .
|   1876                 'i [] 'drop-first ~nil
|   1877                 'j [] [ 'i 0 or - take-first ] ~nil
|   1878                 's 1 = [ 's take-nth ] unless
|   1879               ] def                                             ; TODO
|   1880 
|   1881 ; get value at key/index & membership test
|   1882 ;
|   1883 ; >>> ( :one :two :three ) 1 get^
|   1884 ; :two
|   1885 ; >>> () 0 get^
|   1886 ; *** ERROR: list.get^: index 0 is out of range
|   1887 ; >>> ( 1 2 3 ) 1 get
|   1888 ; 2
|   1889 ; >>> () 0 get
|   1890 ; nil
|   1891 ;
|   1892 ; >>> { x: 1, y: 2 } dup :x get
|   1893 ; 1
|   1894 ; >>> drop :z get
|   1895 ; nil
|   1896 ; >>> "foobar" 3 get
|   1897 ; "b"
|   1898 ; >>> "foobar" 10 get
|   1899 ; nil
|   1900 ; >>> [1-) 10 get
|   1901 ; 11
|   1902 ; >>> 10 [1-n] 10 get
|   1903 ; nil
|   1904 ;
|   1905 ; >>> ( :one :two :three ) 1 has?                     ; valid index of
|   1906 ; #t
|   1907 ; >>> ( :one :two :three ) :two elem?                 ; element of
|   1908 ; #t
|   1909 ; >>> { x: 1, y: 2 } :y has?
|   1910 ; #t
|   1911 ; >>> "foobar" 3 has?
|   1912 ; #t
|   1913 ; >>> "hypotheekofferte" "theekoffer" elem?           ; is substring
|   1914 ; #t
|   1915 ;
|   1916 ; >>> [1-) 0 has?
|   1917 ; #t
|   1918 ; >>> [1-) 0 elem?
|   1919 ; #f
|   1920 ; >>> [1-) 99 elem?
|   1921 ; #t
|   1922 ; >>> 100 [1-n) 100 elem?
|   1923 ; #f
|   1924 
|   1925 :get    [ 2dup has? 'get^ [ 2drop nil ] if ] def
|   1926 
|   1927 :get^   [ swap get^'  ] def
|   1928 :has?   [ swap has?'  ] def
|   1929 :elem?  [ swap elem?' ] def
|   1930 
|   1931 :get^'  ( :_ ) [ !get^  ] defmulti
|   1932 :has?'  ( :_ ) [ !has?  ] defmulti
|   1933 :elem?' ( :_ ) [ !elem? ] defmulti
|   1934 
|   1935 :has?'  ( :nil    ) [ 2drop #f ] defmulti               ; for assoc-in
|   1936 
|   1937 :get^'  ( :Range  ) [ range-get^'  ] defmulti
|   1938 :has?'  ( :Range  ) [ range-has?'  ] defmulti
|   1939 :elem?' ( :Range  ) [ range-elem?' ] defmulti
|   1940 
|   1941 ; first, second & third element
|   1942 ;
|   1943 ; >>> :x :y 2list
|   1944 ; ( :x :y )
|   1945 ; >>> , '1st '2nd bi s!
|   1946 ; --- STACK ---
|   1947 ; :y
|   1948 ; :x
|   1949 ; ---  END  ---
|   1950 ; >>> ( 1 2 3 4 5 ) 3rd
|   1951 ; 3
|   1952 
|   1953 :1st    'first def
|   1954 :2nd    [ rest '1st ~> ] def
|   1955 :3rd    [ rest '2nd ~> ] def
|   1956 
|   1957 ; last element
|   1958 ;
|   1959 ; >>> () last
|   1960 ; nil
|   1961 ; >>> ( 1 2 3 ) last
|   1962 ; 3
|   1963 ; >>> ( 1 2 3 ) [ dup * ] map last
|   1964 ; 9
|   1965 ; >>> () last^
|   1966 ; *** ERROR: list.get^: index -1 is out of range
|   1967 ; >>> ( :x :y :z ) last
|   1968 ; :z
|   1969 
|   1970 :last   ( :LSeq ) [ :_ nil <rot [ 'nip dip unseq dup ] loop 2drop ] defmulti
|   1971 :last   ( :_    ) [ dup len dec nth ] defmulti
|   1972 
|   1973 :last^  ( :nil  ) [ drop "last^: nil" fail ] defmulti
|   1974 :last^  ( :LSeq ) [ [ "last^: empty list" fail ] 'last ~seq ] defmulti
|   1975 :last^  ( :_    ) [ dup len dec get^ ] defmulti                 ; TODO
|   1976 
|   1977 ; nth element
|   1978 ;
|   1979 ; >>> [1-) 10 nth
|   1980 ; 11
|   1981 ; >>> [1-) [ dup * ] map 10 nth
|   1982 ; 121
|   1983 
|   1984 :nth    [ swap nth' ] def                                       ; TODO
|   1985 
|   1986 :nth'   ( :_    ) [ swap get ] defmulti
|   1987 :nth'   ( :LSeq ) [ [ drop nil ]
|   1988                     [ x xt . [ dec 'xt nth' ] [ drop 'x ] ~pos ]
|   1989                     ^seq ] defmulti
|   1990 
|   1991 ; pair each element with its index
|   1992 ;
|   1993 ; >>> "foo" indexed ->list
|   1994 ; ( T( 0 "f" ) T( 1 "o" ) T( 2 "o" ) )
|   1995 ; >>> "foo" indexed' ->list
|   1996 ; ( T( "f" 0 ) T( "o" 1 ) T( "o" 2 ) )
|   1997 
|   1998 :indexed  [ [0-) swap zip' ] def
|   1999 :indexed' [ [0-)      zip' ] def
|   2000 
|   2001 ; get value in nested associative structure
|   2002 ;
|   2003 ; >>> , ( { x: 42 } { y: ( 37 ) } )
|   2004 ; >>> dup ( 0 :x ) get-in
|   2005 ; 42
|   2006 ; >>> drop ( 1 :y 0 ) get-in
|   2007 ; 37
|   2008 
|   2009 :get-in [ [ 'get $ ] map ~~> ] def
|   2010 
|   2011 ; associate value in (nested) associative structure
|   2012 ;
|   2013 ; >>> { x: 1, y: 2 } 3 :z assoc
|   2014 ; { :x 1 =>, :y 2 =>, :z 3 => }
|   2015 ;
|   2016 ; >>> , ( { x: 42 } { y: ( 37 ) } )
|   2017 ; >>> #t ( 1 :z ) assoc-in
|   2018 ; ( { :x 42 => } { :y ( 37 ) =>, :z #t => } )
|   2019 ; >>> nil "magic" ( :x :y :z ) assoc-in
|   2020 ; { :x { :y { :z "magic" => } => } => }
|   2021 ;
|   2022 ; >>> ( 1 2 ) :x 2 assoc
|   2023 ; ( 1 2 :x )
|   2024 ; >>> ( 1 2 ) :x 3 assoc
|   2025 ; *** ERROR: assoc: index 3 is out of range
|   2026 
|   2027 :assoc    [ <rot assoc' ] def
|   2028 :assoc-in [ [ [] [ v k kt . dup 'k get 'v 'kt assoc-in 'k ] ~seq
|   2029               assoc ] ^seq' ] def                               ; TODO
|   2030 
|   2031 :assoc' ( :nil  ) [ v k _ . { 'k 'v => } ] defmulti
|   2032 :assoc' ( :list ) [ v i l .
|   2033                     'l len inc 'i "assoc" assert-in-range
|   2034                     'l 'i [-j) ( 'v ) 'l 'i inc [i-) ++ ++
|   2035                   ] defmulti
|   2036 :assoc' ( :dict ) [ v k d . 'd { 'k 'v => } !merge ] defmulti
|   2037 
|   2038 :assert-in-range  [ l i s . 'i 0 < 'i 'l >= or [
|   2039                     ( 's 'i ) "${0}: index ${1} is out of range" fmt
|   2040                     fail
|   2041                   ] when ] def
|   2042 
|   2043 ; "update" value in (nested) associative structure
|   2044 ;
|   2045 ; >>> { x: 1, y: 2 } 'inc :x modify
|   2046 ; { :x 2 =>, :y 2 => }
|   2047 ;
|   2048 ; >>> { x: { y: 1 } } 'inc ( :x :y ) modify-in
|   2049 ; { :x { :y 2 => } => }
|   2050 ; >>> { x: { y: 1 } } [ [ 42 ] 'inc ~nil ] ( :x :z ) modify-in
|   2051 ; { :x { :y 1 =>, :z 42 => } => }
|   2052 ;
|   2053 ; >>> { x: 1, y: 2 } :x 'dec modify'
|   2054 ; { :x 0 =>, :y 2 => }
|   2055 ; >>> { x: { y: 1 } } ( :x :y ) 'dec modify-in'
|   2056 ; { :x { :y 0 => } => }
|   2057 
|   2058 :modify     [ f k  . dup 'k  get    f 'k  assoc    ] def
|   2059 :modify-in  [ f ks . dup 'ks get-in f 'ks assoc-in ] def        ; TODO
|   2060 
|   2061 :modify'    [ swap modify     ] def
|   2062 :modify-in' [ swap modify-in  ] def
|   2063 
|   2064 ; remove mapping for key from associative structure
|   2065 ;
|   2066 ; >>> { x: 1, y: 2, z: 3 } :y dissoc
|   2067 ; { :x 1 =>, :z 3 => }
|   2068 ; >>> :foo dissoc
|   2069 ; { :x 1 =>, :z 3 => }
|   2070 
|   2071 :dissoc [ swap dissoc' ] def
|   2072 
|   2073 :dissoc' ( :dict ) [ !delete ] defmulti
|   2074 
|   2075                                                                 ; }}}1
    2076 
+   -   2077 +-- 51 lines: -- Regexes & String Formatting --
2077 ; -- Regexes & String Formatting --                             ; {{{1
|   2078 
|   2079 ; match
|   2080 ;
|   2081 ; NB: see also rx-match.
|   2082 ;
|   2083 ; >>> "foo" "^f" =~                                   ; boolean
|   2084 ; #t
|   2085 ; >>> "bar" "^f" =~
|   2086 ; #f
|   2087 
|   2088 :=~ ( :str :str ) [ rx-match bool ] defmulti                    ; TODO
|   2089 
|   2090 ; filter using =~
|   2091 ;
|   2092 ; >>> ( "one" "two" "three" ) "^o|ee" grep ->list
|   2093 ; ( "one" "three" )
|   2094 
|   2095 :grep   [ '=~ $ filter ] def
|   2096 
|   2097 ; substitute/replace
|   2098 ;
|   2099 ; NB: see also rx-sub.
|   2100 ;
|   2101 ; >>> "1 2 3 4" "$2 $1" "(\w+) (\w+)" rx-sub1
|   2102 ; "2 1 3 4"
|   2103 ; >>> "1 2 3 4" "$2 $1" "(\w+) (\w+)" rx-suball
|   2104 ; "2 1 4 3"
|   2105 ;
|   2106 ; >>> "foo bar baz" [ reverse ] "\w+" s///            ; Perl-style alias
|   2107 ; "oof bar baz"
|   2108 ; >>> "foo bar baz" [ reverse ] "\w+" s///g
|   2109 ; "oof rab zab"
|   2110 
|   2111 :rx-sub1    [ #f rx-sub ] def
|   2112 :rx-suball  [ #t rx-sub ] def
|   2113 
|   2114 :s///       'rx-sub1      def
|   2115 :s///g      'rx-suball    def
|   2116 
|   2117 ; string formatting (WIP)
|   2118 ;
|   2119 ; >>> ( :x 42 "foo" ) "${2} ${1} ${0}" fmt
|   2120 ; "foo 42 :x"
|   2121 
|   2122 :fmt    [ >< .[ '1 >< str->int get ->str nip ]
|   2123           "\$\{(\d+)\}" s///g ] def                             ; TODO
|   2124 
|   2125 ; TODO: width, zero-fill, justify, dict key, ...
|   2126 
|   2127                                                                 ; }}}1
    2128 
+   -   2129 +-- 13 lines: -- "Quasi-Macros" --
2129 ; -- "Quasi-Macros" --                                          ; {{{1
|   2130 
|   2131 ; lexical bindings
|   2132 ;
|   2133 ; >>> { x: 1, y: 2 } [ 'y 'x + ] let
|   2134 ; 3
|   2135 ; >>> { x: 1, y: 2 } let[ 'y 'x + ]
|   2136 ; 3
|   2137 
|   2138 :let    [ [ 'vals 'keys bi ] dip '__block-code__ keep __block__
|   2139           apply ] def                                           ; TODO
|   2140 
|   2141                                                                 ; }}}1
    2142 
+   -   2143 +--122 lines: -- Miscellaneous: Looping, I/O, Exceptions, etc. --
2143 ; -- Miscellaneous: Looping, I/O, Exceptions, etc. --           ; {{{1
|   2144 
|   2145 ; identity function
|   2146 ;
|   2147 ; >>> id
|   2148 ; >>> []
|   2149 ; [ ]
|   2150 
|   2151 :id     [     ] def
|   2152 :[]     [ 'id ] def
|   2153 
|   2154 ; const
|   2155 ;
|   2156 ; >>> ( 1 2 3 ) 42 const mapl
|   2157 ; ( 42 42 42 )
|   2158 
|   2159 :const  '[ drop '1 ] def
|   2160 
|   2161 ; call n times
|   2162 ;
|   2163 ; >>> , [ "Hi!" say! ] 5 times
|   2164 ; Hi!
|   2165 ; Hi!
|   2166 ; Hi!
|   2167 ; Hi!
|   2168 ; Hi!
|   2169 ; >>> 0 1 [ '+ keep swap ] 5 times
|   2170 ; 8
|   2171 
|   2172 :times  [ f n . 'n 0 > [ f 'f 'n dec times ] when ] def
|   2173       ; [ [1-n] swap 'drop % each ]         ; currently 10x slower :(
|   2174 
|   2175 ; loop, while & until
|   2176 ;
|   2177 ; >>> , :next-collatz [ [ 2 div ] [ 3 * 1 + ] 'even? ~? ] def
|   2178 ;
|   2179 ; >>> ( 12 [ dup next-collatz dup 1 not= ] loop )
|   2180 ; ( 12 6 3 10 5 16 8 4 2 1 )
|   2181 ; >>> ( 12 [ dup 1 not= ] [ dup next-collatz ] while )
|   2182 ; ( 12 6 3 10 5 16 8 4 2 1 )
|   2183 ; >>> ( 12 [ dup 1 = ] [ dup next-collatz ] until )
|   2184 ; ( 12 6 3 10 5 16 8 4 2 1 )
|   2185 ;
|   2186 ; >>> ( 1 [ dup next-collatz dup 1 not= ] loop )
|   2187 ; ( 1 4 2 1 )
|   2188 ;
|   2189 ; >>> ( 1 [ dup 1 not= ] [ dup next-collatz ] while )     ; may run 0x
|   2190 ; ( 1 )
|   2191 ; >>> ( 1 [ dup 1 = ] [ dup next-collatz ] until )
|   2192 ; ( 1 )
|   2193 ;
|   2194 ; >>> ( 1 [ dup 1 not= ] [ dup next-collatz ] do- while ) ; run >= 1x
|   2195 ; ( 1 4 2 1 )
|   2196 ; >>> ( 1 [ dup 1 = ] [ dup next-collatz ] do- until )
|   2197 ; ( 1 4 2 1 )
|   2198 
|   2199 :loop     [ f . f [ 'f loop ] when ] def
|   2200 :while    [ p? f . p? [ f 'p? 'f while ] when ] def
|   2201 :until    [ [ 'not @ ] dip while ] def
|   2202 
|   2203 :do-      [ dup 2dip ] def
|   2204 :do-while [ do- while ] def
|   2205 :do-until [ do- until ] def
|   2206 
|   2207 ; print str or value to stdout
|   2208 ;
|   2209 ; >>> "Hello, World!" say!
|   2210 ; Hello, World!
|   2211 ;
|   2212 ; >>> 42 display!
|   2213 ; 42
|   2214 ; >>> "foo" ddisplay!                               ; ⇔ dup display!
|   2215 ; foo
|   2216 ; "foo"
|   2217 ;
|   2218 ; >>> , ( :x 42 "foo" ) "${2} ${1} ${0}\n" fmt!     ; ⇔ fmt puts!
|   2219 ; foo 42 :x
|   2220 
|   2221 :say!       [ "\n" !append puts! ] def
|   2222 :display!   [ ->str say! ] def
|   2223 :ddisplay!  [ dup display! ] def
|   2224 :fmt!       [ fmt puts! ] def
|   2225 
|   2226 ; output message & show stack (use for debugging only!)
|   2227 ;
|   2228 ; >>> , :foo [ 1 2, "foo" trace!, + ] def
|   2229 ; >>> foo
|   2230 ; --- TRACE: foo ---
|   2231 ; --- STACK ---
|   2232 ; 2
|   2233 ; 1
|   2234 ; ---  END  ---
|   2235 ; 3
|   2236 
|   2237 :trace! [ 1list "--- TRACE: ${0} ---" fmt say! __show-stack!__ ] def
|   2238 
|   2239 ; read lines from stdin
|   2240 ;
|   2241 ; NB: read-line! (like ask!) returns nil at EOF.
|   2242 
|   2243 :read-line! [ nil ask! ] def                                    ; TODO
|   2244 :lines!     [ read-line! [ 'lines! lseq1 ] ~> ] def
|   2245 
|   2246 ; try w/o finally/catch
|   2247 ;
|   2248 ; >>> [ ... ] [ _ _ _ . :caught #t ] try-catch
|   2249 ; :caught
|   2250 ; >>> [ ... ] [ :finally ] try-finally
|   2251 ; *** ERROR: name __ellipsis__ is not defined
|   2252 
|   2253 :try-catch    [ [] try        ] def
|   2254 :try-finally  [ nil swap try  ] def
|   2255 
|   2256 ; assertion
|   2257 ;
|   2258 ; >>> [ 1 1 = ] assert
|   2259 ; >>> [ 1 2 = ] assert
|   2260 ; *** ERROR: assert failed: [ 1 2 = ]
|   2261 
|   2262 :assert [ b . b [ "assert failed: " 'b ->str ++ fail ] unless ] def
|   2263 
|   2264                                                                 ; }}}1
    2265 
+   -   2266 +--132 lines: -- Either, Functor, Monad, etc. --
2266 ; -- Either, Functor, Monad, etc. --                            ; {{{1
|   2267 
|   2268 :Left   ( :val ) defrecord
|   2269 :Right  ( :val ) defrecord
|   2270 
|   2271 :left   'Left  def
|   2272 :right  'Right def
|   2273 
|   2274 :show   ( :Left   ) [ .val show "left( "  swap ++ " )" ++ ] defmulti
|   2275 :show   ( :Right  ) [ .val show "right( " swap ++ " )" ++ ] defmulti
|   2276 
|   2277 ; values with two possibilities
|   2278 ;
|   2279 ; NB: by convention, left is often for errors and right for "correct"
|   2280 ; values.
|   2281 ;
|   2282 ; >>> , :f [ [ 2 div ] [ 2.0 / ] ^either ] def
|   2283 ; >>> 5 left f
|   2284 ; 2
|   2285 ; >>> 7.0 right f
|   2286 ; 3.5
|   2287 ;
|   2288 ; >>> [ 1 0 div ] try->either
|   2289 ; left( ( :DivideByZero "divide by zero" () ) )
|   2290 ; >>> [ 5 2 div ] try->either
|   2291 ; right( 2 )
|   2292 ;
|   2293 ; >>> "oops" left either->fail
|   2294 ; *** ERROR: oops
|   2295 ; >>> 42 right either->fail
|   2296 ; 42
|   2297 
|   2298 :~either  [ <rot ~either'           ] def
|   2299 :^either  [ [ '.val % ] bi$ ~either ] def
|   2300 :either?  [ 'Left? 'Right? bi-or    ] def
|   2301 
|   2302 :~either' ( :Left   ) [ f _ x . 'x f ] defmulti
|   2303 :~either' ( :Right  ) [ _ g x . 'x g ] defmulti
|   2304 
|   2305 :try->either  [ f . [ Right( f ) ] [ 3list Left #t ] [] try ] def
|   2306 :either->fail [ 'fail [] ^either ] def
|   2307 
|   2308 ; functor (WIP)
|   2309 ;
|   2310 ; >>> , :f [ 'inc -> [ dup * ] -> ] def
|   2311 ; >>> nil f                           ; NB: using ~> for nil is better
|   2312 ; nil
|   2313 ; >>> x: 7 f
|   2314 ; :x 64 =>
|   2315 ; >>> ( 1 2 3 ) f ->list
|   2316 ; ( 4 9 16 )
|   2317 ; >>> ( 1 2 3 ) 'odd? filter f ->list
|   2318 ; ( 4 16 )
|   2319 ; >>> :oops left f
|   2320 ; left( :oops )
|   2321 ; >>> 7 right f
|   2322 ; right( 64 )
|   2323 
|   2324 :-> [ swap ->' ] def
|   2325 
|   2326 :->'  ( :nil      ) [ nip               ] defmulti
|   2327 ;     ( :bool     ) [ swap call         ] defmulti              ; TODO
|   2328 ;     ( :int      ) [ swap call         ] defmulti              ; TODO
|   2329 ;     ( :float    ) [ swap call         ] defmulti              ; TODO
|   2330 ;     ( :str      ) [ ...               ] defmulti              ; TODO
|   2331 ;     ( :kwd      ) [ swap call         ] defmulti              ; TODO
|   2332 :->'  ( :pair     ) [ swap ^pair =>     ] defmulti
|   2333 :->'  ( :list     ) [ swap map          ] defmulti
|   2334 ;     ( :dict     ) [ ...               ] defmulti              ; TODO
|   2335 :->'  ( :block    ) [ %                 ] defmulti              ; TODO
|   2336 :->'  ( :builtin  ) [ %                 ] defmulti              ; TODO
|   2337 :->'  ( :multi    ) [ %                 ] defmulti              ; TODO
|   2338 
|   2339 :->'  ( :LSeq     ) [ swap map          ] defmulti
|   2340 :->'  ( :Left     ) [ nip               ] defmulti
|   2341 :->'  ( :Right    ) [ swap ^Right Right ] defmulti
|   2342 
|   2343 ; monad (WIP)
|   2344 ;
|   2345 ; >>> ( 1 2 3 ) [ 'inc [ dup * ] bi 2list ] >>= ->list
|   2346 ; ( 2 1 3 4 4 9 )
|   2347 ; >>> ( 1 2 3 ) [ x ret . ( 4 5 ) [ y . T( 'x 'y ) ret ] bind ]
|   2348 ; ...   bind-with ->list
|   2349 ; ( T( 1 4 ) T( 1 5 ) T( 2 4 ) T( 2 5 ) T( 3 4 ) T( 3 5 ) )
|   2350 ;
|   2351 ; >>> do[ ( 1 2 3 ) :x <- ( 4 5 ) :y <- T( 'x 'y ) return ] ->list
|   2352 ; ( T( 1 4 ) T( 1 5 ) T( 2 4 ) T( 2 5 ) T( 3 4 ) T( 3 5 ) )
|   2353 ;
|   2354 ; >>> , :f [ [ drop "neg" left ] [ dup * right ] ~neg ] def
|   2355 ; >>> "oops" left 'f >>=
|   2356 ; left( "oops" )
|   2357 ; >>> -4 right 'f >>=
|   2358 ; left( "neg" )
|   2359 ; >>> 4 right 'f >>=
|   2360 ; right( 16 )
|   2361 ;
|   2362 ; >>> right( :x ) right( :y ) >>
|   2363 ; right( :y )
|   2364 ;
|   2365 ; >>> nil 4 replicate ( 1 2 ) >> '1list >>= ->list
|   2366 ; ( 1 2 1 2 1 2 1 2 )
|   2367 ; >>> do[ nil 4 replicate & ( 1 2 ) :x <- 'x return ] ->list
|   2368 ; ( 1 2 1 2 1 2 1 2 )
|   2369 
|   2370 :>>=  [ swap =<<  ] def
|   2371 :>>   [ const >>= ] def
|   2372 
|   2373 :=<<        ( :list   ) [ swap map concat ] defmulti
|   2374 :=<<        ( :LSeq   ) [ swap map concat ] defmulti
|   2375 :=<<        ( :Left   ) [ nip             ] defmulti
|   2376 :=<<        ( :Right  ) [ swap ^Right     ] defmulti
|   2377 
|   2378 :return-as  ( :list   ) [ drop 1list      ] defmulti
|   2379 :return-as  ( :LSeq   ) [ drop 1list      ] defmulti
|   2380 :return-as  ( :Left   ) [ drop Right      ] defmulti
|   2381 :return-as  ( :Right  ) [ drop Right      ] defmulti
|   2382 
|   2383 :bind       '>>= def
|   2384 :bind-with  [ x f . 'x [ [ 'x return-as ] f ] >>= ] def
|   2385 
|   2386 { :_& :& __ident__ =>, :_<- :<- __ident__ =>, blk: '__block__,
|   2387   ret: :return, :bw :bind-with __ident__ => } let[
|   2388 
|   2389 :do     [ b . () 'b __block-code__ _do& 'b _do 'b blk call ] def
|   2390 :_do&   [ [ dup '_& = [ drop :_ '_<- ] when ] mapl ] def
|   2391 :_do    [ b . [ () ] [ dup 1st '_<- =
|   2392           [ uncons^ nip [ 'ret 2list ] dip 'b _do 'b blk 'bw 2list ]
|   2393           [ 'b _do cons ] if ] ^list ] def                      ; TODO
|   2394 
|   2395 ]
|   2396 
|   2397                                                                 ; }}}1
    2398 
+   -   2399 +-- 25 lines: -- The Joy of Recursion --
2399 ; -- The Joy of Recursion --                                    ; {{{1
|   2400 
|   2401 ; linear & binary recursion combinators (inspired by Joy)
|   2402 ;
|   2403 ; >>> , :fac1 [ dup zero? 'inc [ dup dec fac1 * ] if ] def
|   2404 ; >>> 5 fac1
|   2405 ; 120
|   2406 ; >>> , :fac2 [ 'zero? 'inc [ dup dec ] '* linrec ] def
|   2407 ; >>> 5 fac2
|   2408 ; 120
|   2409 ;
|   2410 ; >>> , :qsort1 [ dup empty? [] [ unseq over '< $ partition
|   2411 ; ...             'qsort1 bi$ [ swap 1list ] dip ++ ++ ] if ] def
|   2412 ; >>> ( 5 2 7 2 -4 1 ) qsort1 ->list
|   2413 ; ( -4 1 2 2 5 7 )
|   2414 ; >>> , :qsort2 [ 'empty? [] [ unseq over '< $ partition ]
|   2415 ; ...             [ [ swap 1list ] dip ++ ++ ] binrec ] def
|   2416 ; >>> ( 5 2 7 2 -4 1 ) qsort2 ->list
|   2417 ; ( -4 1 2 2 5 7 )
|   2418 
|   2419 :linrec [ p? f g h . dup p? 'f [ g 'p? 'f 'g 'h linrec h ] if ] def
|   2420 :binrec [ p? f g h . dup p? 'f [ g [ 'p? 'f 'g 'h binrec ] bi$
|   2421                                  h ] if ] def                   ; TODO
|   2422 
|   2423                                                                 ; }}}1
    2424 
+   -   2425 +-- 23 lines: -- Conversion --
2425 ; -- Conversion --                                              ; {{{1
|   2426 
|   2427 ; conversion
|   2428 ;
|   2429 ; >>> ( 1 2 3 ) [ 'inc map ] as
|   2430 ; ( 2 3 4 )
|   2431 ; >>> "foo" [ 'upper-case map ] as
|   2432 ; "FOO"
|   2433 
|   2434 :as [ over convert-> 'call dip call ] def
|   2435 
|   2436 :convert->      ( :str  ) [ drop 'convert->str  ] defmulti      ; TODO
|   2437 :convert->      ( :list ) [ drop 'convert->list ] defmulti
|   2438 
|   2439 :convert->str   ( :str  ) [                     ] defmulti      ; TODO
|   2440 :convert->str   ( :list ) [ join                ] defmulti
|   2441 :convert->str   ( :LSeq ) [ join                ] defmulti
|   2442 
|   2443 :convert->list  ( :list ) [                     ] defmulti      ; TODO
|   2444 :convert->list  ( :str  ) [ ->list              ] defmulti
|   2445 :convert->list  ( :LSeq ) [ ->list              ] defmulti
|   2446 
|   2447                                                                 ; }}}1
    2448 
+   -   2449 +-- 28 lines: -- Modules --
2449 ; -- Modules --                                                 ; {{{1
|   2450 
|   2451 ; require module (loads from file if not defined)
|   2452 ;
|   2453 ; >>> , :no-such-module require
|   2454 ; *** ERROR: cannot load module no-such-module
|   2455 ; >>> , :no-such-module [] defmodule                  ; ^^'
|   2456 ; >>> , :no-such-module require
|   2457 
|   2458 :require [ dup __modules__ !elem? '__load-module__ unless1 ] def
|   2459 
|   2460 ; use module (require + import(-from))
|   2461 ;
|   2462 ; >>> , :_test use
|   2463 ; loading module _test...
|   2464 ; >>> 'x
|   2465 ; 1
|   2466 ;
|   2467 ; >>> , ( :x :y ) :_test use-from
|   2468 ; >>> 'y
|   2469 ; 2
|   2470 
|   2471 :use      [ __caller-module__ . 'require
|   2472             [ '__caller-module__ defmodule[ import      ] ] bi ] def
|   2473 :use-from [ __caller-module__ . 'require
|   2474             [ '__caller-module__ defmodule[ import-from ] ] bi ] def
|   2475 
|   2476                                                                 ; }}}1
    2477 
+   -   2478 +-- 22 lines: -- Unicode Aliases --
2478 ; -- Unicode Aliases --                                         ; {{{1
|   2479 
|   2480 :←      'def      def   ; ^k<- (vim digraph)
|   2481 
|   2482 :≠      'not=          ; ^k!=
|   2483 :≤      '<=            ; ^k=<
|   2484 :≥      '>=            ; ^k=>
|   2485 
|   2486 :∘      '%             ; ^kOb
|   2487 
|   2488       'not           ; ^kNO
|   2489 :∧      'and           ; ^kAN
|   2490 :∨      'or            ; ^kOR
|   2491 
|   2492 :~[≠]   '~[not=]  
|   2493 :~[≤]   '~[<=]    
|   2494 :~[≥]   '~[>=]    
|   2495 
|   2496 :∋      'elem?         ; ^k-)
|   2497 :∌      [  not ] 
|   2498 
|   2499                                                                 ; }}}1
    2500 
    2501 ; ...
    2502 
    2503 ; -- END --
    2504 
    2505 ] ; defmodule
    2506 
    2507 ; vim: set tw=70 sw=2 sts=2 et fdm=marker :