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