; --                                                            ; {{{1
;
; File        : prelude.knk
; Maintainer  : Felix C. Stegerman <flx@obfusk.net>
; Date        : 2022-02-12
;
; Copyright   : Copyright (C) 2022  Felix C. Stegerman
; Version     : v0.0.1
; License     : LGPLv3+
;
; --                                                            ; }}}1

:__prld__ __defmodule__[

; -- TODO --
;
; * WIP: slicing, string formatting, functor, monad, tuples
; * more functions!
; * refactor!
;
; * (chunked) sequences; map, each, iterate, zip, ...
;
; * cond1, cond=, is-nan?
; * range-elem?'; seq str & dict; ++, ->list
; * unzip, scan*; split*; init; sort-by; update-with
; * I/O; math; ...
;
; * div/mod vs quot/rem
;
; * improve docs generation!
;
; --

; -- Aliases for Primitives --                                  ; {{{1

:def                '__def__                __def__

:call               '__call__                 def
:apply              '__apply__                def
:apply-dict         '__apply-dict__           def

:if                 '__if__                   def

:defmulti           '__defmulti__             def
:defrecord          '__defrecord__            def

:=>                 '__=>__                   def
:dict               '__dict__                 def

:puts!              '__puts!__                def
:ask!               '__ask!__                 def

:type               '__type__                 def
:callable?          '__callable?__            def
:function?          '__function?__            def

:defmodule          '__defmodule__            def
:import             '__import__               def
:import-from        '__import-from__          def

:=                  '__=__                    def
:not=               '__not=__                 def
:<                  '__<__                    def
:<=                 '__<=__                   def
:>                  '__>__                    def
:>=                 '__>=__                   def
:<=>                '__<=>__                  def

:eq                 '__eq__                   def
:neq                '__neq__                  def
:lt                 '__lt__                   def
:lte                '__lte__                  def
:gt                 '__gt__                   def
:gte                '__gte__                  def
:cmp                '__cmp__                  def

:abs                '__abs__                  def
:trunc              '__trunc__                def
:round              '__round__                def
:ceil               '__ceil__                 def
:floor              '__floor__                def

:int->float         '__int->float__           def
:record->dict       '__record->dict__         def

:record-type        '__record-type__          def
:record-vals        '__record-values__        def
:record-values      '__record-values__        def
:record-type-name   '__record-type-name__     def
:record-type-fields '__record-type-fields__   def

:fail               '__fail__                 def
:try                '__try__                  def

:rx-match           '__rx-match__             def
:rx-sub             '__rx-sub__               def

:par                '__par__                  def
:sleep              '__sleep__                def

                                                                ; }}}1

; -- Stack Shuffling --                                         ; {{{1

; swap top 2 values
;
; >>> , 1 2 s!
; --- STACK ---
; 2
; 1
; ---  END  ---
; >>> , swap s!
; --- STACK ---
; 1
; 2
; ---  END  ---

:swap   [ x y . 'y 'x ] def                   ; ⇔ '__swap__     ; bltn
:><     'swap           def

; rotate top 3 values
;
; >>> , 1 2 3 rot> s!
; --- STACK ---
; 2
; 1
; 3
; ---  END  ---
; >>> , <rot s!
; --- STACK ---
; 3
; 2
; 1
; ---  END  ---

:rot>   [ x y z . 'z 'x 'y  ] def             ; ⇔ [ [] $ 2dip ]
:<rot   [ x y z . 'y 'z 'x  ] def             ; ⇔ [ [] 2$ dip ]

; rotate top 4 values
;
; >>> , 1 2 3 4 rot4> s!
; --- STACK ---
; 3
; 2
; 1
; 4
; ---  END  ---
; >>> , <rot4 s!
; --- STACK ---
; 4
; 3
; 2
; 1
; ---  END  ---

:rot4>  [ w x y z . 'z 'w 'x 'y ] def
:<rot4  [ w x y z . 'x 'y 'z 'w ] def

; duplicate top value(s)
;
; >>> , 42 dup s!
; --- STACK ---
; 42
; 42
; ---  END  ---
; >>> c!
; *** STACK CLEARED ***
; >>> , 1 2 2dup s!
; --- STACK ---
; 2
; 1
; 2
; 1
; ---  END  ---
; >>> ( 1 2 3 3dup )
; ( 1 2 3 1 2 3 )

 :dup   [ x   . 'x 'x       ] def                               ; bltn
:2dup   [ x y . 'x 'y 'x 'y ] def             ; ⇔ [ over over ]
:3dup   [ 2over over2 ] def

; remove top value(s)
;
; >>> nil
; nil
; >>> drop
; >>> drop
; *** ERROR: stack underflow
; >>> 42 37 2drop
; >>> 1 2 3 3drop

 :drop  [ _     . ] def                                         ; bltn
:2drop  [ _ _   . ] def                       ; ⇔ [ drop drop ]
:3drop  [ _ _ _ . ] def

; drop value immediately preceding the top
;
; >>> , 42 37 nip s!
; --- STACK ---
; 37
; ---  END  ---

:nip    [ _ y . 'y ] def                      ; ⇔ [ 'drop dip ]

; copy value(s) immediately preceding the top "over" the top
;
; >>> , 1 2 over s!
; --- STACK ---
; 1
; 2
; 1
; ---  END  ---
; >>> c!
; *** STACK CLEARED ***
; >>> , 1 2 3 2over s!
; --- STACK ---
; 2
; 1
; 3
; 2
; 1
; ---  END  ---

 :over  [ x y   . 'x 'y 'x        ] def       ; ⇔ [ 'dup dip swap ]
:2over  [ x y z . 'x 'y 'z 'x 'y  ] def       ; ⇔ [ over2 over2 ]

; copy value "over" the topmost 2
;
; >>> , 1 2 3 over2 s!
; --- STACK ---
; 1
; 3
; 2
; 1
; ---  END  ---

:over2  [ x y z . 'x 'y 'z 'x ] def           ; ⇔ [ 'over dip swap ]

                                                                ; }}}1

; -- Combinators --                                             ; {{{1

; partial application & function composition
;
; >>> , 1 '+ $                                        ; ⇔ [ 1 + ]
; >>> 2 swap call
; 3
; >>> 2, 3 4 [ + * ] 2$, call
; 14
; >>> 1, 2 3 4 [ + + + ] 3$, call
; 10
; >>> :foo [] $ call                                  ; [] $ ⇔ .[ '1 ]
; :foo
;
; >>> , [ 1 + ] [ 3 * ] @
; >>> 2 swap call
; 9
; >>> [ 2 * ] [ 1 + ] % call                          ; % ⇔ swap @
; 20
;
; >>> , 2 '-
; >>> , 1 $$                                          ; ⇔ [ f . 1 f ]
; >>> call
; 1
; >>> 2 [ + * ], 3 4 2$$, call
; 14
; >>> 1 [ + + + ], 2 3 4 3$$, call
; 10

 :$     '[ '1 .2       ] def                                    ; bltn
:2$     '[ '1 '2 .3    ] def                                    ; TODO
:3$     '[ '1 '2 '3 .4 ] def

:@      '[ .1 .2 ] def                                          ; bltn
:%      '[ .2 .1 ] def                                          ; bltn

 :$$    '[ f . '1 f       ] def
:2$$    '[ f . '1 '2 f    ] def
:3$$    '[ f . '1 '2 '3 f ] def

; remove top value(s), call function, restore value(s)
;
; >>> , 1 2 'dup dip s!
; --- STACK ---
; 2
; 1
; 1
; ---  END  ---
; >>> c!
; *** STACK CLEARED ***
; >>> , 1 2 3 4 '- 2dip s!
; --- STACK ---
; 4
; 3
; -1
; ---  END  ---
; >>> c!
; *** STACK CLEARED ***
; >>> , 1 2 3 4 'neg 3dip s!
; --- STACK ---
; 4
; 3
; 2
; -1
; ---  END  ---

 :dip   [ x f   . f 'x    ] def                                 ; bltn
:2dip   [ x y f . f 'x 'y ] def               ; ⇔ [ 'dip $ dip ]
:3dip   [ '2dip $ dip     ] def

; copy top value(s), call function, push value(s)
;
; >>> , 2 [ dup * ] keep s!
; --- STACK ---
; 2
; 4
; ---  END  ---
; >>> c!
; *** STACK CLEARED ***
; >>> , 2 3 '* 2keep s!
; --- STACK ---
; 3
; 2
; 6
; ---  END  ---

 :keep  [  over 'call  dip  ] def             ; ⇔ [ x f . 'x f 'x ]
:2keep  [ 2over 'call 2dip  ] def             ; ⇔ [ '2dup dip 2dip ]

; call multiple functions on one value
;
; >>> , 35 [ 2 + ] [ 7 + ] bi s!
; --- STACK ---
; 42
; 37
; ---  END  ---
; >>> c!
; *** STACK CLEARED ***
; >>> , 2 [ 1 + ] [ 2 * ] [ 3 - ] tri s!
; --- STACK ---
; -1
; 4
; 3
; ---  END  ---
;
; >>> ( 2 ( [ 1 + ] [ 2 * ] [ 3 - ] ) mlt )
; ( 3 4 -1 )
;
;
; >>> 42  'num? 'pos? bi-and
; #t
; >>> -1  'num? 'pos? bi-and
; #f
; >>> nil 'num? 'pos? bi-and                        ; "short-circuits"
; #f
; >>> nil 'num? 'pos? bi and                        ; oops
; *** ERROR: types nil and int are not comparable
; >>> nil 'nil? 'pos? bi-or
; #t
; >>> nil 'nil? 'pos? bi or
; *** ERROR: types nil and int are not comparable

:bi     [ x f g   . 'x f 'x g       ] def     ; ⇔ [ 'keep dip call ]
:tri    [ x f g h . 'x f 'x g 'x h  ] def     ; ⇔ [ 'keep 2dip bi ]

:mlt    [ swap $$ each ] def

:bi-and [ x p1? p2? . [ 'x p1? ] [ 'x p2? ] and' ] def
:bi-or  [ x p1? p2? . [ 'x p1? ] [ 'x p2? ] or'  ] def

; call one function on each of multiple values
;
; >>> 2 3 [ dup * ] bi$ +
; 13
; >>> c!
; *** STACK CLEARED ***
; >>> , 2 3 4 [ dup * ] tri$ s!
; --- STACK ---
; 16
; 9
; 4
; ---  END  ---
;
; >>> ( ( 2 3 4 ) [ dup * ] mlt$ )                    ; mlt$ ⇔ each
; ( 4 9 16 )
;
;
; >>> ( 0 2 4 ) 'even? all?
; #t
; >>> ( 37 42 ) 'even? any?
; #t
;
;
; >>> -1 nil 'pos? bi$-and                          ; "short-circuits"
; #f
; >>> 42 nil 'pos? bi$-or
; #t
; >>> 42 nil 'pos? bi$ or                           ; oops
; *** ERROR: types nil and int are not comparable

:bi$    [ x y f   . 'x f 'y f       ] def     ; ⇔ [ dup bi~ ]
:tri$   [ x y z f . 'x f 'y f 'z f  ] def     ; ⇔ [ 2dup tri~ ]

:mlt$   [ each ] def

:all?   [ p? . [ #t ] [ >< p? dup [ drop 'p? all? ] 'nip if ] ^seq ] def
:any?   [ p? . [ #f ] [ >< p? dup 'nip [ drop 'p? any? ] if ] ^seq ] def

:bi$-and  [ x y p? . [ 'x p? ] [ 'y p? ] and' ] def
:bi$-or   [ x y p? . [ 'x p? ] [ 'y p? ] or'  ] def

; call multiple functions on their "paired" value
;
; >>> , 4 9 [ 2 + ] [ 3 div ] bi~ s!
; --- STACK ---
; 3
; 6
; ---  END  ---
; >>> c!
; *** STACK CLEARED ***
; >>> ( 1 2 3 :x :y :z '[ '1 swap => ] tri$ tri~ )
; ( :x 1 => :y 2 => :z 3 => )
;
; >>> ( ( 1 2 3 ) ( :x :y :z ) '[ '1 swap => ] map mlt~ )
; ( :x 1 => :y 2 => :z 3 => )

:bi~    [ x y f g     . 'x f 'y g       ] def ; ⇔ [ 'dip dip call ]
:tri~   [ x y z f g h . 'x f 'y g 'z h  ] def

:mlt~   [ 'call zip [] each ] def

; TODO: mlt*, 2mlt, 2mlt$, 2mlt~, ...

; call multiple functions on each of multiple values
;
; >>> , 2 3 [ dup * ] 'neg bi* s!
; --- STACK ---
; -3
; -2
; 9
; 4
; ---  END  ---

:bi*    [ [ 'bi$ $ 2keep ] dip bi$ ] def

; call multiple functions on two values
;
; >>> , 1 2 '+ '- 2bi s!
; --- STACK ---
; -1
; 3
; ---  END  ---
; >>> c!
; *** STACK CLEARED ***
; >>> , 7 2 '+ '- 'div 2tri s!
; --- STACK ---
; 3
; 5
; 9
; ---  END  ---

:2bi    [ '2keep dip call ] def
:2tri   [ '2keep 2dip 2bi ] def

; call one function on each of multiple pairs of values
;
; >>> , :x 1 :y 2 '=> 2bi$ s!
; --- STACK ---
; :y 2 =>
; :x 1 =>
; ---  END  ---
; >>> c!
; *** STACK CLEARED ***
; >>> , :x :y 1 2 '=> 2bi$' s!
; --- STACK ---
; :y 2 =>
; :x 1 =>
; ---  END  ---

:2bi$   [ dup 2bi~        ] def
:2bi$'  [ 'swap 2dip 2bi$ ] def

; call multiple functions on their "paired" pair of values
;
; >>> , 1 2 3 4 '+ '- 2bi~ s!
; --- STACK ---
; -1
; 3
; ---  END  ---
; >>> c!
; *** STACK CLEARED ***
; >>> , 1 3 2 4 '+ '- 2bi~' s!
; --- STACK ---
; -1
; 3
; ---  END  ---

:2bi~   [ '2dip dip call  ] def
:2bi~'  [ 'swap 3dip 2bi~ ] def

; partially apply multiple functions to one value
;
; >>> 5 [ 37 + ] [ 37 - ] ~pos
; 42
; >>> 5 37 '+ '- $bi ~pos
; 42

:$bi    [ x f g . 'x 'f $ 'x 'g $ ] def       ; ⇔ [ [ '$ $ ] bi$ bi ]

; partially apply "first" or "second" function to value
;
; >>> 5 'neg [ 37 + ] ~neg
; 42
; >>> 5 37 'neg '+ $snd ~neg
; 42
;
; >>> 5 37 '+ 'neg '$ dip ~pos
; 42
; >>> 5 37 '+ 'neg $fst ~pos
; 42

:$fst   [ '$ dip ] def
:$snd   [ x f g . 'f 'x 'g $ ] def

                                                                ; }}}1

; -- Conditionals, Logic & Order --                             ; {{{1

; conditional expression that takes two values (instead of functions)
;
; foo bar ? ≈ [ foo ] [ bar ] if
; foo bar ? ⇔ foo [] $ bar [] $ if
;
; NB: foo and bar are always evaluated.
;
; >>> #t 42 37 ?
; 42

:?      [ '[ '1 ] bi$ if ] def

; conditional w/ implicit "else branch" (that drops values -- if
; necessary -- to match the arity of the "if branch")
;
; >>> 1 2 = [ "oh no!" say! ] when                    ; -0 +0 = 0
; >>> 1 1 = [ "good!"  say! ] when
; good!
; >>> , 42 dup 2 mod 0 = [ 2 div ] when s!            ; -1 +1 = 0
; --- STACK ---
; 21
; ---  END  ---
; >>> c!
; *** STACK CLEARED ***
; >>> 1 2 2dup = '+ when1                             ; -2 +1 = 1
; 1
; >>> 2 2 2 2dup = [ + * ] when2                      ; -3 +1 = 2
; 8

:when   [ []     if ] def
:when1  [ 'drop  if ] def
:when2  [ '2drop if ] def

; [ ... ] unless ⇔ not [ ... ] when
;
; >>> 1 1 = [ "oh no!" say! ] unless                  ; -0 +0 = 0
; >>> 1 2 = [ "good!"  say! ] unless
; good!
; >>> 2 2 2dup = '+ unless1                           ; -2 +1 = 1
; 2
; >>> 1 2 3 2dup = [ + * ] unless2                    ; -3 +1 = 2
; 5

:unless   [ []     swap if ] def
:unless1  [ 'drop  swap if ] def
:unless2  [ '2drop swap if ] def

; predicate "branch"
;
; dup p? [ foo ] [ bar ] if ⇔ [ foo ] [ bar ] 'p? ~?
;
; >>> , :collatz [
; ...     [ [ 2 div ] [ 3 * 1 + ] 'even? ~? ]
; ...     iterate [ 1 not= ] take-while ( 1 ) ++
; ...   ] def
; >>> 19 collatz ->list
; ( 19 58 29 88 44 22 11 34 17 52 26 13 40 20 10 5 16 8 4 2 1 )

:~?     [ 'dup % 2dip if ] def                                  ; bltn

; bool, logical inverse, conjunction & disjunction
;
; NB: see also bi-and, bi-or, bi$-and, bi$-or.
;
; NB: "and" and "or" return one of their operands (which are tested
; for "truthyness", but do not need to be bools).  They also cannot
; "short-circuit" because they operate on the stack, not on
; expressions.
;
; >>> 5 bool
; #t
; >>> 5 not
; #f
; >>> nil not
; #t
; >>> nil 5 or
; 5
; >>> nil 5 and
; nil
; >>> 2 3 or
; 2
; >>> 2 3 and
; 3
;
; >>> [ nil ] [ "oops" fail ] and'                  ; "short-circuits"
; nil
; >>> [ 42  ] [ "oops" fail ] or'
; 42

:bool   [ not not    ] def
:not    [ #f #t    ? ] def
:and    [ over     ? ] def
:or     [ 'dup dip ? ] def

:and'   [ f g . f dup [ drop g ] [] if ] def
:or'    [ f g . f dup [] [ drop g ] if ] def

; comparison "branch"
;
; >>> 41 'inc 'dec 41 ~[=]
; 42
; >>> 41 'dec 'inc 41 ~[not=]
; 42
; >>> 41 'inc 'dec 99 ~[<]
; 42
; >>> 43 'inc 'dec 37 ~[<=]
; 42
; >>> 41 'inc 'dec 37 ~[>]
; 42
; >>> 41 'inc 'dec 41 ~[>=]
; 42
;
; >>> 42 37 '- '* '+ ~<=>
; 79
; >>> 37 [ :< ] [ := ] [ :> ] 42 ~[<=>] nip
; :<
;
; NB: ~<=> leaves both operands, ~[<=>] only the "left".

:~[=]     [ '=    $ ~? ] def
:~[not=]  [ 'not= $ ~? ] def
:~[<]     [ '<    $ ~? ] def
:~[<=]    [ '<=   $ ~? ] def
:~[>]     [ '>    $ ~? ] def
:~[>=]    [ '>=   $ ~? ] def

:~<=>   [ f g h . 2dup <=> [ drop g ] [ 0 < 'f 'h if ] 0 ~[=] ] def
:~[<=>] [ [] $ 3dip [ 'drop % ] tri$ ~<=> ] def

; alternative comparison "branch"
;
; >>> 41.0 'inc 'dec 41 ~[eq]
; 42.0
; >>> 41.0 'dec 'inc 41 ~[neq]
; 42.0
; >>> 41.0 'inc 'dec 99 ~[lt]
; 42.0
; >>> 43.0 'inc 'dec 37 ~[lte]
; 42.0
; >>> 41.0 'inc 'dec 37 ~[gt]
; 42.0
; >>> 41.0 'inc 'dec 41 ~[gte]
; 42.0
;
; >>> 42 37.0 '- '* '+ ~cmp
; 79.0
; >>> 37 [ :< ] [ := ] [ :> ] 42.0 ~[cmp] nip
; :<
;
; NB: ~cmp leaves both operands, ~[cmp] only the "left".

:~[eq]    [ 'eq  $ ~? ] def
:~[neq]   [ 'neq $ ~? ] def
:~[lt]    [ 'lt  $ ~? ] def
:~[lte]   [ 'lte $ ~? ] def
:~[gt]    [ 'gt  $ ~? ] def
:~[gte]   [ 'gte $ ~? ] def

:~cmp   [ f g h . 2dup cmp [ drop g ] [ neg? 'f 'h if ] 0 ~[eq] ] def
:~[cmp] [ [] $ 3dip [ 'drop % ] tri$ ~cmp ] def

; minimum & maximum
;
; >>> 1 2 min
; 1
; >>> -1 -2 max
; -1
;
; >>> 2 1.0 min
; 2
; >>> 2 1.0 min'
; 1.0
; >>> 2 1.0 max'
; 2

:min    [ '<= min-by ] def
:max    [ '>= max-by ] def

:min'   [ 'lte min-by ] def
:max'   [ 'gte max-by ] def

:min-by [ f . 2dup f 'drop 'nip if ] def
:max-by [ f . 2dup f 'drop 'nip if ] def

; conditional expression
;
; Takes a value and a list of tests and exprs.  It evaluates each test
; one at a time: functions are predicates and are called (with the
; value pushed onto the stack); the result -- or the test itself if
; not a function -- is tested for truthiness.  If the test passes, its
; corresponding expr is returned and called (if it's a block).
;
; >>> , :temp [
; ...     [ show " is " ++ ]
; ...     [ ( [ 15 < ] "cold!" [ 25 > ] "warm!" :else "ok!" ) cond1 ]
; ...     bi ++ say!
; ...   ] def
; >>> 10 temp
; 10 is cold!
; >>> 20 temp
; 20 is ok!
; >>> 30 temp
; 30 is warm!

  :cond1  [ _cond1 dup block? 'call when ] def                  ; TODO
 :_cond1  [ cons '_&cond1 apply ] def
:_&cond1  [ x p? f & .
            'x 'p? 'call 'nip 'function? ~? [ 'f ] [ 'x '& _cond1 ] if
          ] def

; TODO: cond=, ...

; combined "branch"
;
; >>> -1 [ :pos ] [ :neg ] [ :zero ] ( '~pos '~neg ) ~>> nip
; :neg
;
; >>> , :~type [ .[ type '1 = ] ~? ] def
; >>> , :~strint [ ( [ :str ~type ] [ :int ~type ] ) ~>> ] def
; >>> , :f [ [ "bar" ++ ] [ 5 + ] [ drop :oops ] ~strint ] def
; >>> "foo" f
; "foobar"
; >>> 37 f
; 42
; >>> nil f
; :oops

:~>>    [ reverse _~>> ] def
:_~>>   [ 'call [ f ft . .[ '1 '2 f ] 'ft _~>> ] ^seq ] def

                                                                ; }}}1

; -- Arithmetic --                                              ; {{{1

; NB: see also math.

; addition, subtraction & multiplication
;
; NB: when mixing ints and floats, ints are coerced to floats and may
; lose precision.
;
; >>> 1 2 +
; 3
; >>> 4 3 -
; 1
; >>> 6 7 *
; 42
; >>> 1.0 2.0 +
; 3.0
; >>> 4.0 3 -
; 1.0
; >>> 6 7.0 *
; 42.0

:+ ( :int   :int    ) [ __int+__          ] defmulti
:+ ( :float :float  ) [ __float+__        ] defmulti
:+ ( :int   :float  ) [ 'int->float dip + ] defmulti
:+ ( :float :int    ) [  int->float     + ] defmulti

:- ( :int   :int    ) [ __int-__          ] defmulti
:- ( :float :float  ) [ __float-__        ] defmulti
:- ( :int   :float  ) [ 'int->float dip - ] defmulti
:- ( :float :int    ) [  int->float     - ] defmulti

:* ( :int   :int    ) [ __int*__          ] defmulti
:* ( :float :float  ) [ __float*__        ] defmulti
:* ( :int   :float  ) [ 'int->float dip * ] defmulti
:* ( :float :int    ) [  int->float     * ] defmulti

; negation (additive inverse)
;
; >>> 10 neg
; -10
; >>> -10 neg
; 10
; >>> 3.14 neg
; -3.14

:neg    '__neg__ def

; division & modulo
;
; >>> 1.0 2.0 /                                       ; float division
; 0.5
; >>> 8 3 div                                         ; int division
; 2
; >>> 8 3 mod
; 2
;
; >>> 8.0 3 floor/                                    ; floor division
; 2
; >>> -8 3.0 floor/
; -3

:/      '__float/__ def
:div    '__div__    def
:mod    '__mod__    def

:floor/ ( :int   :int   ) [ div                    ] defmulti
:floor/ ( :float :float ) [ / floor                ] defmulti
:floor/ ( :int   :float ) [ 'int->float dip floor/ ] defmulti
:floor/ ( :float :int   ) [  int->float     floor/ ] defmulti

; common predicates
;
; >>> 10 3 div?
; #f
; >>> 42 7 div?
; #t
; >>> ( 2 3 4 ) 'even? filterl
; ( 2 4 )
; >>> ( 1 2 3 ) 'odd? filterl
; ( 1 3 )
;
; >>> , ( -1 -1.1 0 0.0 1 1.1 )
; >>>      dup 'neg?  filterl
; ( -1 -1.1 )
; >>> drop dup 'zero? filterl
; ( 0 0.0 )
; >>> drop dup 'pos?  filterl
; ( 1 1.1 )

:div?   [ mod 0 =   ] def
:even?  [ 2 div?    ] def
:odd?   [ even? not ] def

:neg?   [ 0 lt ] def
:zero?  [ 0 eq ] def
:pos?   [ 0 gt ] def

; increment & decrement
;
; >>> 41 inc
; 42
; >>> dec
; 41

:inc    [ 1 + ] def
:dec    [ 1 - ] def

                                                                ; }}}1

; -- Strings & Characters --                                    ; {{{1

; NB: see also "Regexes".

; conversion between char (i.e. string of length 1) & int
; (representing a unicode codepoint)
;
; >>> "猫" ord
; 29483
; >>> 0x732b chr
; "猫"

:ord    '.ord     def
:chr    '__chr__  def

; is char (i.e. str of length 1)
;
; >>> ( "猫" "foo" "" 42 ) 'char? filterl
; ( "猫" )

:char?  [ 'str? [ len 1 = ] bi-and ] def

; convert to readable str
;
; >>> 42 show
; "42"
; >>> 0x20 show
; "32"
; >>> "foo" show
; "\"foo\""
; >>> :foo show
; ":foo"
; >>> x: 42 show
; ":x 42 =>"
; >>> { x: [1-), y: ( 1 nil :x ) } show
; "{ :x 1 [m-) =>, :y ( 1 nil :x ) => }"

:show ( :pair   ) [ [ 'show bi$ " " ++sep++ " =>" ++ ] ^pair ] defmulti
:show ( :list   ) [ [ "()"  ] [ "( " " "  " )" _showseq ] ~seq ] defmulti
:show ( :dict   ) [ [ "{ }" ] [ "{ " ", " " }" _showseq ] ~seq ] defmulti
:show ( :_      ) [ '_showrec '__show__ 'record? ~? ] defmulti

:_showrec [ [ record-type record-type-name __show__ 1 [i-) ]
            [ record->dict show ] bi ++ ] def
:_showseq [ b d a . 'show map 'b swap 'd join-with 'a ++ ++ ] def

; convert to str
;
; >>> "foo" show
; "\"foo\""
; >>> "foo" ->str
; "foo"
;
; >>> :foo show
; ":foo"
; >>> :foo ->str
; ":foo"
; >>> :foo kwd->str
; "foo"
;
; >>> 42 ->str
; "42"

:->str  ( :str  ) [      ] defmulti
:->str  ( :_    ) [ show ] defmulti

:kwd->str [ show [ 2 -1 ] [ 1 nil ] [ "\"" ends-with? ] ~? [i-j) ] def

; join a sequence of strings (separated by a separator)
;
; >>> "foobar" ->list
; ( "f" "o" "o" "b" "a" "r" )
; >>> join
; "foobar"
; >>> ( "Hello" "World" ) ", " join-with
; "Hello, World"
;
; >>> "foo" "bar" " & " ++sep++
; "foo & bar"

:join       [ "" join-with ] def                                ; TODO
:join-with  [ s . [ "" ] [ >< [ 's ++sep++ ] foldl ] ^seq ] def
:++sep++    [ >< ++ ++ ] def

; case conversion
;
; >>> "foo" upper-case
; "FOO"
; >>> "BAR" lower-case
; "bar"

:lower-case '.lower def
:upper-case '.upper def

; trimming whitespace
;
; >>> " foo " trim
; "foo"
; >>> " foo " triml
; "foo "
; >>> " foo " trimr
; " foo"

:trim   '.trim  def
:triml  '.triml def
:trimr  '.trimr def

; prefix & suffix predicates
;
; >>> "foo" "f" starts-with?                          ; prefix
; #t
; >>> "bar" "ar" ends-with?                           ; suffix
; #t
;
; >>> "foobar" "oba" elem?                            ; infix
; #t

:starts-with? [ swap !starts-with? ] def
:ends-with?   [ swap !ends-with?   ] def

                                                                ; }}}1

; -- Nil, Num, Pair & Tuples --                                 ; {{{1

; nil "branch"
;
; >>> , :f [ [ "nil!" say! ] [ type show say! ] ~nil ] def
; >>> nil f
; nil!
; >>> 42 f
; :int
;
; >>> ( 1 ) 'rest ~> 'first ~> [ 1 + ] ~>
; nil
; >>> ( 1 2 ) 'rest ~> 'first ~> [ 1 + ] ~>
; 3
; >>> ( 3 4 ) ( 'rest 'first [ 1 + ] ) ~~>
; 5

:~nil   [ [ 'drop % ] dip 'nil? ~? ] def                        ; bltn
:~>     [ [ nil ] swap ~nil ] def
:~~>    [ [ .[ .1 '2 ~~> ] ~> ] ^seq' ] def

; "convert" to nil: turn "empty"/"zero" values into (falsy) nil
;
; >>> ( "foo" "" 42 0 ( 1 2 3 ) () ) '->nil mapl
; ( "foo" nil 42 nil ( 1 2 3 ) nil )

:->nil  ( :nil  )   [ ] defmulti
:->nil  ( :bool )   [ #t nil ? ] defmulti

:->nil  ( :int  )   [ [ drop nil ] [] ~zero  ] defmulti
:->nil  ( :_    )   [ [      nil ] [] ~seq   ] defmulti

; is int or float?
;
; >>> 1 num?
; #t
; >>> 3.14 num?
; #t
; >>> () num?
; #f

:num?   [ 'int? 'float? bi-or ] def

; TODO: is-nan?

; number "branch"
;
; >>> 0 [ " negative" ] [ " non-negative" ] ~neg  'show dip ++ say!
; 0 non-negative
; >>> 0 [ " zero"     ] [ " non-zero"     ] ~zero 'show dip ++ say!
; 0 zero
; >>> 0 [ " positive" ] [ " non-positive" ] ~pos  'show dip ++ say!
; 0 non-positive
;
; >>> 4 [ :neg ] [ :zero ] [ :pos ] ~num nip
; :pos

:~neg   [ 0 ~[lt] ] def
:~zero  [ 0 ~[eq] ] def
:~pos   [ 0 ~[gt] ] def

:~num   [ 0 ~[cmp] ] def

; pair "pattern match" & key/value
;
; >>> , x: 42 'swap ^pair, s!
; --- STACK ---
; :x
; 42
; ---  END  ---
; >>> c!
; *** STACK CLEARED ***
; >>> , y: 37 'val 'key bi, s!
; --- STACK ---
; :y
; 37
; ---  END  ---

:^pair  [ [ 'key 'val bi ] dip call ] def

:key    '.key   def
:val    '.value def

; tuples (WIP)
;
; >>> 1 2 2T
; T( 1 2 )
; >>> dup .1st
; 1
; >>> drop .2nd
; 2
;
; >>> T( 1 2 3 4 5 )
; T( 1 2 3 4 5 )
; >>> .5th
; 5

:T()  [ 0T ] def
:T    [ & . '& '_T '& len get^ apply ] def                      ; TODO

:0T (                           ) defrecord
:1T ( :1st                      ) defrecord
:2T ( :1st :2nd                 ) defrecord
:3T ( :1st :2nd :3rd            ) defrecord
:4T ( :1st :2nd :3rd :4th       ) defrecord
:5T ( :1st :2nd :3rd :4th :5th  ) defrecord

:_T ( '0T '1T '2T '3T '4T '5T ) def

:show   ( :0T ) [ tuple-show ] defmulti
:show   ( :1T ) [ tuple-show ] defmulti
:show   ( :2T ) [ tuple-show ] defmulti
:show   ( :3T ) [ tuple-show ] defmulti
:show   ( :4T ) [ tuple-show ] defmulti
:show   ( :5T ) [ tuple-show ] defmulti

:len    ( :0T ) [ drop 0 ] defmulti
:len    ( :1T ) [ drop 1 ] defmulti
:len    ( :2T ) [ drop 2 ] defmulti
:len    ( :3T ) [ drop 3 ] defmulti
:len    ( :4T ) [ drop 4 ] defmulti
:len    ( :5T ) [ drop 5 ] defmulti

:->list ( :0T ) [ vals ] defmulti
:->list ( :1T ) [ vals ] defmulti
:->list ( :2T ) [ vals ] defmulti
:->list ( :3T ) [ vals ] defmulti
:->list ( :4T ) [ vals ] defmulti
:->list ( :5T ) [ vals ] defmulti

:tuple-show   [ vals show "T" swap ++ ] def

                                                                ; }}}1

; -- Sequences, Lists & Ranges --                               ; {{{1

; NB: inclusive; infinite if stop is nil.
:Range ( :start :stop :step ) defrecord

:show ( :Range )  [ [ m n s . { f: [ show " " ++ ] } let[ (
                      'm f
                      'n [ "" "" ")"  ] [ f "n" "]" ] ~nil
                      's [ drop "" "" ] [ f ":s" ] 1 ~[eq]
                      <rot [ "[m-" <rot ] 2dip
                    ) ] join ] ^Range ] defmulti

:range        [ 3dup 3list 'float? any? [ '_->float tri$ ] when
                2dup float? and [ [ 2.0 / + ] keep ] when Range ] def

:range-unseq  [ [ nil nil ]
                [ [ dup [ over + ] $ 2dip Range ] ^Range ] ~seq ] def
:range-empty? [ [ >< [ 2drop #f ] [ rot> _pos<> ] ~nil ] ^Range ] def
:range-len    [ [ >< [ 2drop nil ] [ rot> '- dip floor/ inc 0 max ]
                  ~nil ] ^Range ] def

:range-get^'  [ over 0 < [ 2drop nil ] [ [ i m n s .
                  'm 's 'i * + 'n
                  [] [ over 's _pos<> [ drop nil ] when ] ~nil
                ] ^Range ] if ] def
:range-has?'  [ range-get^' nil? not ] def
:range-elem?' [ [ k m n s .
                  'k 'm 's _pos<>, 'n nil? not, 'n 'k 's _pos<>,
                  and or not
                  'k 'm - 's,       ; NB: be careful w/ elem? w/ float
                  'k float? [ / dup trunc eq ] 'div? if and
                ] ^Range ] def                                  ; TODO

:_->float [ dup int? 'int->float when ] def
:_pos<>   [ pos? '< '> if ] def

; int ranges
;
; >>> 2 10 [m-n] ->list
; ( 2 3 4 5 6 7 8 9 10 )
; >>> 2 10 [m-n) ->list
; ( 2 3 4 5 6 7 8 9 )
; >>> 4 [m-) 10 take-first ->list
; ( 4 5 6 7 8 9 10 11 12 13 )
; >>> 10 [0-n] ->list
; ( 0 1 2 3 4 5 6 7 8 9 10 )
; >>> 10 [0-n) ->list
; ( 0 1 2 3 4 5 6 7 8 9 )
; >>> [0-) 10 take-first ->list
; ( 0 1 2 3 4 5 6 7 8 9 )
; >>> 10 [1-n] ->list
; ( 1 2 3 4 5 6 7 8 9 10 )
; >>> 10 [1-n) ->list
; ( 1 2 3 4 5 6 7 8 9 )
; >>> [1-) 10 take-first ->list
; ( 1 2 3 4 5 6 7 8 9 10 )
;
; float ranges
;
; >>> 2.1 10.1 [m-n] ->list
; ( 2.1 3.1 4.1 5.1 6.1 7.1 8.1 9.1 10.1 )
; >>> 2.1 10.1 [m-n) ->list
; ( 2.1 3.1 4.1 5.1 6.1 7.1 8.1 9.1 )
; >>> 4.1 [m-) 10 take-first ->list
; ( 4.1 5.1 6.1 7.1 8.1 9.1 10.1 11.1 12.1 13.1 )
; >>> 10.0 [0-n] ->list
; ( 0.0 1.0 2.0 3.0 4.0 5.0 6.0 7.0 8.0 9.0 10.0 )
; >>> 10.0 [0-n) ->list
; ( 0.0 1.0 2.0 3.0 4.0 5.0 6.0 7.0 8.0 9.0 )
; >>> 10.0 [1-n] ->list
; ( 1.0 2.0 3.0 4.0 5.0 6.0 7.0 8.0 9.0 10.0 )
; >>> 10.0 [1-n) ->list
; ( 1.0 2.0 3.0 4.0 5.0 6.0 7.0 8.0 9.0 )
;
; ranges with step
;
; >>> 2 10 2 [m-n:s] ->list
; ( 2 4 6 8 10 )
; >>> 2 11 2.0 [m-n:s) ->list
; ( 2.0 4.0 6.0 8.0 10.0 )
; >>> 4 2 [m-:s) 5 take-first ->list
; ( 4 6 8 10 12 )
; >>> 10.0 2 [0-n:s] ->list
; ( 0.0 2.0 4.0 6.0 8.0 10.0 )
; >>> 10 2 [0-n:s) ->list
; ( 0 2 4 6 8 )
; >>> 2.0 [0-:s) 5 take-first ->list
; ( 0.0 2.0 4.0 6.0 8.0 )
; >>> 10 3 [1-n:s] ->list
; ( 1 4 7 10 )
; >>> 10 3.0 [1-n:s) ->list
; ( 1.0 4.0 7.0 )
; >>> 2 [1-:s) 5 take-first ->list
; ( 1 3 5 7 9 )

:[m-n]    [          1 range   ] def
:[m-n)    [   dec      [m-n]   ] def
:[m-)     [   nil      [m-n]   ] def
:[0-n]    [ 0     swap [m-n]   ] def
:[0-n)    [ 0     swap [m-n)   ] def
:[0-)     [ 0 nil      [m-n]   ] def
:[1-n]    [ 1     swap [m-n]   ] def
:[1-n)    [ 1     swap [m-n)   ] def
:[1-)     [ 1 nil      [m-n]   ] def

:[m-n:s]  'range                 def
:[m-n:s)  [   '- keep  [m-n:s] ] def
:[m-:s)   [   nil ><   [m-n:s] ] def
:[0-n:s]  [ 0     rot> [m-n:s] ] def
:[0-n:s)  [ 0     rot> [m-n:s) ] def
:[0-:s)   [ 0 nil <rot [m-n:s] ] def
:[1-n:s]  [ 1     rot> [m-n:s] ] def
:[1-n:s)  [ 1     rot> [m-n:s) ] def
:[1-:s)   [ 1 nil <rot [m-n:s] ] def

; small lists
;
; >>> 42 1list
; ( 42 )
; >>> :x :y 2list
; ( :x :y )
; >>> :x :y :z 3list
; ( :x :y :z )

:1list  [ () cons     ] def
:2list  [ 1list cons  ] def
:3list  [ 2list cons  ] def

; lazy sequences
;
;             list    block (lazy rest)         append
; >>> , :fibs ( 0 1 ) [ 'fibs dup rest '+ zip ] lseq def
; >>> 'fibs 10 take-first ->list
; ( 0 1 1 2 3 5 8 13 21 34 )
;
; >>> :head [ ( :tail :is :lazy ) ] lseq1 ->list      ; singleton
; ( :head :tail :is :lazy )
;
; NB: use of side-effects is for demonstration purposes only and
; should be avoided in most code.
;
; >>> , [ "evaluated once" say!, ( 1 2 3 ) ] lazy-seq ; completely lazy
; >>> dup !thunk
; evaluated once
; ( 1 2 3 )
; >>> drop !thunk
; ( 1 2 3 )

:LSeq ( :chunk :thunk ) defrecord   ; NB: chunk must be a list

:show ( :LSeq ) [ .chunk show "#<seq" swap "(...)>" ++ ++ ] defmulti

:lseq     [ __thunk__  LSeq ] def
:lseq1    [ '1list dip lseq ] def
:lazy-seq [ () swap    lseq ] def

; "as sequence"
;
; * returns nil if empty
; * converts to a proper sequence type if needed
;   (e.g. strings & dicts to lists)
; * otherwise returns the sequence unmodified
;
; NB: whether conversion is performed and to what type may change; the
; only guarantee is that a "proper" sequence type is returned.
;
; >>> nil seq
; nil
; >>> "foo" seq                   ; str becomes a list
; ( "f" "o" "o" )
; >>> ( 1 2 3 ) seq
; ( 1 2 3 )
; >>> "" seq
; nil
; >>> () seq
; nil
; >>> { x: 1, y: 2 } seq          ; dict becomes a list
; ( :x 1 => :y 2 => )
; >>> 10 [1-n] seq ->list
; ( 1 2 3 4 5 6 7 8 9 10 )
; >>> [ ( 1 2 3 ) ] lazy-seq seq  ; checking emptiness forces evaluation
; ( 1 2 3 )
;
; >>> ( nil "foo" { x: 1 } ( 1 2 ) [1-), ( 1 2 ) 'inc map, 42 ) 'seq? mapl
; ( #t :partial :partial #t #t #t #f )

:seq    ( :nil    ) [ ] defmulti
:seq    ( :str    ) [ ->nil '->list ~>  ] defmulti              ; TODO
:seq    ( :dict   ) [ ->nil '.pairs ~>  ] defmulti              ; TODO
:seq    ( :list   ) [ ->nil             ] defmulti
:seq    ( :Range  ) [ ->nil             ] defmulti
:seq    ( :LSeq   ) [ lseq-seq          ] defmulti

:lseq-seq [ dup .chunk empty? [ !thunk seq ] when ] def

:seq?   ( :nil    ) [ drop #t       ] defmulti
:seq?   ( :str    ) [ drop :partial ] defmulti
:seq?   ( :dict   ) [ drop :partial ] defmulti
:seq?   ( :list   ) [ drop #t       ] defmulti
:seq?   ( :Range  ) [ drop #t       ] defmulti
:seq?   ( :LSeq   ) [ drop #t       ] defmulti
:seq?   ( :_      ) [ drop #f       ] defmulti

; generic "uncons"
;
; unseq ⇔ 'first 'rest bi
;
; >>> , ( 1 2 ) unseq s!
; --- STACK ---
; ( 2 )
; 1
; ---  END  ---
; >>> c!
; *** STACK CLEARED ***
; >>> , 3 10 [m-n] unseq ->list s!
; --- STACK ---
; ( 4 5 6 7 8 9 10 )
; 3
; ---  END  ---
; >>> c!
; *** STACK CLEARED ***
; >>> , [ ( 1 2 ) ] lazy-seq unseq s!
; --- STACK ---
; ( 2 )
; 1
; ---  END  ---

:unseq  ( :nil    ) [ nil ] defmulti
:unseq  ( :list   ) [ [ nil nil ] [] ^list ] defmulti
:unseq  ( :Range  ) [ range-unseq ] defmulti
:unseq  ( :LSeq   ) [ lseq-unseq  ] defmulti

:lseq-unseq [ [ t . [ t unseq ] [ .uncons^ 't LSeq ] ~seq ] ^LSeq ] def

; generic "head" & "tail"
;
; 'first 'rest bi ⇔ unseq
;
; * first returns the first element
; * rest returns the rest of the sequence
; * both return nil if the sequence is empty
;
; >>> ( 1 2 3 ) first
; 1
; >>> 4 [1-n] rest ->list
; ( 2 3 4 )

:first  ( :_ ) [ unseq drop ] defmulti
:rest   ( :_ ) [ unseq nip  ] defmulti

; is the sequence empty?
;
; empty? ⇔ seq not
;
; >>> "foo" empty?
; #f
; >>> () empty?
; #t
; >>> { x: 1 } empty?
; #f
; >>> 1 [1-n] rest empty?
; #t
; >>> ( 1 2 3 ) [ 1 + ] map empty?
; #f

:empty? ( :str    ) [ .empty?       ] defmulti
:empty? ( :list   ) [ .empty?       ] defmulti
:empty? ( :dict   ) [ .empty?       ] defmulti
:empty? ( :Range  ) [ range-empty?  ] defmulti
:empty? ( :_      ) [ seq not       ] defmulti

; sequence length
;
; NB: sequence must be finite (or a range).
;
; >>> "foo" len
; 3
; >>> ( 1 2 ) len
; 2
; >>> { x: 1 } len
; 1
; >>> 37 42 [m-n) len
; 5
; >>> 42 [m-) len                                     ; infinite
; nil
; >>> ( 1 2 3 ) [ 2 >= ] filter len
; 2

:len    ( :str    ) [ .len      ] defmulti
:len    ( :list   ) [ .len      ] defmulti
:len    ( :dict   ) [ .len      ] defmulti
:len    ( :Range  ) [ range-len ] defmulti
:len    ( :_      ) [ seq-len   ] defmulti

:seq-len [ 0 swap [ drop inc ] each ] def

; append two sequences
;
; NB: to merge two dicts, use update.
;
; >>> "foo" "bar" ++
; "foobar"
; >>> ( 1 2 3 ) ( 4 5 ) ++
; ( 1 2 3 4 5 )
;
; >>> ( 1 2 3 ) [ ( 4 5 ) ] lazy-seq ++ ->list
; ( 1 2 3 4 5 )
; >>> [ ( 1 2 3 ) ] lazy-seq ( 4 5 ) ++ ->list
; ( 1 2 3 4 5 )

:++     ( :str  :str  ) [ !append ] defmulti
:++     ( :list :list ) [ !append ] defmulti

:++     ( :nil  :list ) [ nip ] defmulti                        ; TODO
:++     ( :nil  :LSeq ) [ nip ] defmulti

:++     ( :list :nil  ) [ drop ] defmulti                       ; TODO
:++     ( :LSeq :nil  ) [ drop ] defmulti

:++     ( :list :LSeq ) [ [ '++ dip LSeq ] ^LSeq ] defmulti
:++     ( :LSeq :list ) [ _lseq++ ] defmulti
:++     ( :LSeq :LSeq ) [ _lseq++ ] defmulti

:_lseq++ [ .[ [ '1 ++ ] @ lseq ] ^LSeq ] def

; convert to list
;
; >>> "foo" ->list
; ( "f" "o" "o" )
; >>> ( 1 2 3 ) ->list
; ( 1 2 3 )
; >>> { x: 1, y: 2 } ->list
; ( :x 1 => :y 2 => )

:->list ( :str  ) [ .->list ] defmulti
:->list ( :list ) [         ] defmulti
:->list ( :dict ) [ .pairs  ] defmulti

:->list ( :_    ) [ xs . ( 'xs [] each ) ] defmulti             ; TODO
                ; [ [ () ] [ ->list cons ] ^seq ]

; list & sequence "pattern match"
;
; * ^seq uses seq and "unseq"s the sequence when not empty
; * ~seq uses empty? and returns the original sequence when not empty
;
; >>> ( 1 2 3 ) [ "empty" ] [ hd tl . 'hd ] ^list     ; head or "empty"
; 1
; >>> () [ "empty" ] 'drop ^seq
; "empty"
; >>> ( 4 5 ) [ "empty" ] 'head^ ~seq
; 4
; >>> "foo" [ () ] 'nip ^seq
; ( "o" "o" )
; >>> "foo" [ "" ] [] ~seq
; "foo"

:^list  [ [ 'drop % ] dip '.uncons^ % '.empty? ~? ] def
:^seq   [ 'seq 2dip 'unseq % ~nil ] def
:~seq   [ [ 'drop % ] dip 'empty? ~? ] def

:^seq'  [ [] swap ^seq ] def

; sequence conditional & "pattern match"
;
; NB: the difference between when-seq and with-seq is that the latter
; "unseq"s the sequence when not empty.
;
; >>> () 'len when-seq
; nil
; >>> ( 1 2 3 ) 'len when-seq
; 3
; >>> ( 1 2 3 ) 'drop with-seq
; 1
; >>> () 'drop with-seq
; nil

:when-seq [ [ seq dup ] dip when  ] def
:with-seq [ [ nil ] swap ^seq     ] def

; "lazy" map & filter
;
; >>> ( 1 2 3 ) [ dup * ] map ->list
; ( 1 4 9 )
; >>> ( 1 2 3 ) 'dup map ->list         ; multiple return values is OK
; ( 1 1 2 2 3 3 )
; >>> ( 1 2 3 4 ) 'even? filterl
; ( 2 4 )

:map    [ f . [ () swap [ [ x xt . ( 'x f ) !append 'xt ] with-seq ]
                32 times .[ '1 'f map ] lseq ] when-seq ] def   ; TODO
      ; [ f . [ x xt . ( 'x f ) [ 'xt 'f map ] lseq ] with-seq ]
:filter [ .[ [] 'drop '1 ~? ] map ] def

:mapl     [ map    ->list ] def
:filterl  [ filter ->list ] def

; zip(with)
;
; >>> ( :x :y ) ( 1 2 3 ) zip' ->list
; ( T( :x 1 ) T( :y 2 ) )
; >>> ( :x :y ) ( 1 2 3 ) [] zip ->list ; multiple return values is OK
; ( :x 1 :y 2 )
; >>> [1-) ( :x :y ) [ swap => ] zip ->list dict
; { :x 1 =>, :y 2 => }

:zip    [ f . [ drop nil ] [ y yt . [ x xt .
          ( 'x 'y f ) [ 'xt 'yt 'f zip ] lseq
        ] with-seq ] ^seq ] def
:zip'   [ '2T zip ] def

; TODO: unzip

; folding (left- and right-associative)
;
; NB: foldr' only partially applies the recursive step, allowing
; short-circuiting/laziness.
;
; >>> ( 2 3 4 ) 10 '- foldl                         ; ⇔ 10 2 - 3 - 4 -
; 1
; >>> ( 2 3 4 ) 10 '- foldr                         ; ⇔ 2 3 4 10 - - -
; -7
; >>> ( 2 3 4 ) () [ [ 1 + ] dip cons ] foldr       ; "strict"
; ( 3 4 5 )
; >>> ( 2 3 4 ) () [ [ 1 + ] dip call cons ] foldr' ; "lazy"
; ( 3 4 5 )

:foldl  [ f . swap [ rot> f 'f foldl      ] ^seq' ] def
:foldr  [ f . swap [ <rot 'f foldr f      ] ^seq' ] def
:foldr' [ f . swap [ <rot 'f 'foldr' 3$ f ] ^seq' ] def

; TODO: scanl, scanr

; concatenation of all elements
;
; >>> ( ( 1 2 3 ) dup [ dup * ] map dup 'even? filter ) concat ->list
; ( 1 2 3 1 4 9 4 )

:concat [ () [ lazy-seq ++ ] foldr' ] def

; reverse order of elements; "strict"
;
; NB: reversing a list or str is guaranteed to return a value of the
; same type; reversing (most) other sequences returns a list.
;
; >>> ( 1 2 3 ) reverse
; ( 3 2 1 )
; >>> ( 1 2 3 ) [ dup * ] map reverse
; ( 9 4 1 )
; >>> "foobar" reverse
; "raboof"
; >>> 10 20 [m-n] reverse ->list
; ( 20 19 18 17 16 15 14 13 12 11 10 )

:reverse  ( :str    ) [ .reverse        ] defmulti
:reverse  ( :Range  ) [ range-reverse   ] defmulti
:reverse  ( :_      ) [ reverse-as-list ] defmulti

:range-reverse    [ [ m n s . 'n [ "reverse: infinite range" fail ]
                      [ 'm 's neg Range ] ~nil ] ^Range ] def
:reverse-as-list  [ () [ swap cons ] foldl ] def

; iterating over a sequence
;
; >>> , ( "Hello" "World" ) 'say! each
; Hello
; World
; >>> , ( 1 2 3 ) [] each s!
; --- STACK ---
; 3
; 2
; 1
; ---  END  ---
; >>> ( ( 1 2 ) 'dup each )
; ( 1 1 2 2 )

:each   [ f . unseq dup [ 'f dip 'f each ] when2 ] def          ; TODO
      ; [ f . [ 'f dip 'f each ] ^seq' ]    ; currently 2x slower :(

; generating (infinite) sequences & taking subsequences
;
; >>> ( 1 2 3 ) cycle 10 take-first ->list
; ( 1 2 3 1 2 3 1 2 3 1 )
; >>> 0 'inc iterate 10 take-first 2 drop-first ->list
; ( 2 3 4 5 6 7 8 9 )
; >>> 1 [ 2 * ] iterate [ 10 < ] drop-while [ 80 < ] take-while ->list
; ( 16 32 64 )
; >>> 42 repeat 4 take-first ->list
; ( 42 42 42 42 )
; >>> :x 3 replicate ->list
; ( :x :x :x )
; >>> 10 [1-n] 2 take-nth ->list
; ( 1 3 5 7 9 )

:iterate    [ x f . ( 'x [ dup f ] 31 times ) dup 31 swap !get^
              .[ '1 f 'f iterate ] lseq ] def                   ; TODO
          ; [ f . () swap [ [ 1list ++ ] keep f ] 32 times
          ;   .[ '1 'f iterate ] lseq ]                 ; slower :(
          ; [ x f . 'x [ 'x f 'f iterate ] lseq1 ]      ; w/o chunking

:cycle      [ repeat concat ] def
:repeat     [ dup 'repeat $ lseq1 ] def
:replicate  [ 'repeat dip take-first ] def

:take-first [ .[ '1 [ dec 'take-first 2$ lseq1 ] [ 3drop nil ] ~pos ]
              with-seq ] def
:drop-first [ .[ '1 0 > [ rest '1 dec drop-first ] when ] when-seq ] def

:take-while [ p? . nil [ over p? 'lseq1 [ 2drop nil ] if ] foldr' ] def
:drop-while [ p? . [ dup first p? [ rest 'p? drop-while ] when ]
              when-seq ] def

:take-nth   [ n . [ [ 'n dec drop-first 'n take-nth ] $ lseq1 ]
              with-seq ] def

; TODO: split-at, split-w/, ...
; TODO: init

; searching
;
; NB: see also elem?.
;
; >>> [1-) [ 4 > ] find
; 5
; >>> 10 [1-n] [ 0 < ] find
; nil

:find   [ filter 'drop with-seq ] def

; partitioning a sequence (into a sequence of elements that do and one
; of elements that do not satisfy a predicate)
;
; NB: unlike Haskell, we can't do both results at the same time with
; foldr :(
;
; >>> , "Hello World!" [ "aeiou" elem?' ] partition 'join bi$ s!
; --- STACK ---
; "Hll Wrld!"
; "eoo"
; ---  END  ---

:partition [ 'filter [ 'not @ filter ] 2bi ] def                ; TODO

; least & largest element of a non-empty sequence
;
; >>> ( 1 2 4 -1 7 3 ) minimum
; -1
; >>> ( 1 2 4 -1 7 3 ) maximum
; 7
; >>> () maximum
; *** ERROR: maximum: empty list

:minimum [ [ "minimum: empty list" fail ] [ swap 'min foldl ] ^seq ] def
:maximum [ [ "maximum: empty list" fail ] [ swap 'max foldl ] ^seq ] def

; sum & product of a sequence
;
; >>> ( 1 2 3 4 ) sum
; 10
; >>> ( 1 2 3 4 ) product
; 24
; >>> () sum
; 0
; >>> () product
; 1

:sum      [ 0 '+ foldl ] def
:product  [ 1 '* foldl ] def

                                                                ; }}}1

; -- Lists, Dicts & Indexing --                                 ; {{{1

; lists: head & tail ("safe" & "unsafe"), (un)cons
;
; NB: ^seq/first/rest is usually a better choice than
; uncons^/head/tail.
;
; >>> ( 1 2 3 )
; ( 1 2 3 )
; >>> dup head^
; 1
; >>> drop dup tail^
; ( 2 3 )
; >>> , drop uncons^ s!
; --- STACK ---
; ( 2 3 )
; 1
; ---  END  ---
; >>> cons
; ( 1 2 3 )
;
; >>> () head^                                      ; partial function
; *** ERROR: list.head^: empty list
; >>> () tail^
; *** ERROR: list.tail^: empty list
; >>> () head
; nil
; >>> () tail
; nil

:head^    '.head^ def
:tail^    '.tail^ def

:head     [ ->nil 'head^ ~> ] def
:tail     [ ->nil 'tail^ ~> ] def

:uncons^  '.uncons^ def
:cons     '!cons    def

; sorted list
;
; >>> ( 4 2 1 3 ) sort
; ( 1 2 3 4 )
;
; >>> ( nil #f #t 0 10 -2.0 4.0 "foo" :bar ) dup sort =
; #t
;
; >>> ( 1 2.0 3 4.0 ) sort                            ; <=> :-(
; ( 1 3 2.0 4.0 )
; >>> ( 1 2.0 3 4.0 ) sort'                           ; cmp :-)
; ( 1 2.0 3 4.0 )

:sort     [ ->list .sort  ] def
:sort'    [ ->list .sort' ] def

; TODO: sort-by

; remove consecutive duplicates
;
; >>> ( 1 2 2 3 2 ) uniq ->list
; ( 1 2 3 2 )
; >>> ( 1 2 2 3 2 ) sort uniq ->list
; ( 1 2 3 )
;
; >>> ( 0.0 0.0 / dup ) uniq ->list
; ( NaN NaN )

:uniq     [ '= uniq-by ] def
:uniq-by  [ f . [ over .[ '1 [ '2 swap f ] drop-while 'f uniq-by ]
                  lseq1 ] with-seq ] def

; merge dicts & update record
;
; >>> { x: 1, y: 2 } { x: 99 } update
; { :x 99 =>, :y 2 => }
;
; >>> , :Point ( :x :y ) defrecord
; >>> Point( 1 2 )
; Point{ :x 1 =>, :y 2 => }
; >>> { y: 3 } update
; Point{ :x 1 =>, :y 3 => }

:update ( :dict :dict ) [ !merge ] defmulti
:update ( :_    :_    ) [ over [ 'record->dict dip !merge ] dip
                          record-type apply-dict ] defmulti     ; TODO

; TODO: update-with function

; keys & values
;
; >>> { x: 1, y: 2 } dup keys
; ( :x :y )
; >>> drop vals
; ( 1 2 )
;
; >>> c!
; *** STACK CLEARED ***
; >>> , :Point ( :x :y ) defrecord
; >>> , Point( 1 2 ) 'keys 'vals bi s!
; --- STACK ---
; ( 1 2 )
; ( :x :y )
; ---  END  ---

:keys   ( :dict   ) [ .keys   ] defmulti
:values ( :dict   ) [ .values ] defmulti

:keys   ( :_      ) [ record-type record-type-fields  ] defmulti
:values ( :_      ) [ record-values                   ] defmulti

:vals 'values def

; slicing (WIP)
;
; * ranges support any step != 0;
; * lazy sequences support step >= 1;
; * (currently) other sequences -- e.g. list -- only support step = 1;
; * neither infinite ranges nor lazy sequences support negative indices.
;
; NB: see also take-first, drop-first, take-nth.
;
; >>> "0123456789" 5 [i-)
; "56789"
; >>> "0123456789" -5 [-j)
; "01234"
; >>> "0123456789" 3 -3 [i-j)
; "3456"
;
; >>> ( 0 1 2 3 4 5 6 7 8 9 ) -5 [i-)
; ( 5 6 7 8 9 )
; >>> ( 0 1 2 3 4 5 6 7 8 9 ) 5 [-j)
; ( 0 1 2 3 4 )
;
; >>> 10 20 [m-n] 2 -2 [i-j) ->list
; ( 12 13 14 15 16 17 18 )
; >>> [1-) 10 [-j) ->list
; ( 1 2 3 4 5 6 7 8 9 10 )
; >>> 10 -2 -2 [m-n:s] -2 0 -2 [i-j:s) ->list
; ( 0 4 8 )
; >>> 10 -2 -2 [m-n:s] -2 2 -1 [i-j:s) ->list
; ( 0 2 4 )
; >>> [1-) -2 [-j)
; *** ERROR: range-slice: infinite range w/ negative index
;
; >>> [1-) [ dup * ] map 2 10 2 [i-j:s) ->list
; ( 9 25 49 81 )

:slice    [ <rot4 slice'          ] def

:[i-j)    [            1 slice    ] def                         ; TODO
:[i-)     [ nil          [i-j)    ] def
:[-j)     [ nil     swap [i-j)    ] def

:[i-j:s)  'slice                    def
:[i-:s)   [ nil     swap [i-j:s)  ] def
:[-j:s)   [ nil     rot> [i-j:s)  ] def
:[:s)     [ nil nil <rot [i-j:s)  ] def

:slice' ( :str    ) [ !slice            ] defmulti
:slice' ( :list   ) [ !slice            ] defmulti
:slice' ( :Range  ) [ rot4> range-slice ] defmulti
:slice' ( :LSeq   ) [ rot4> seq-slice   ] defmulti

:range-slice  [ i j t . [ m n s .
                { :tn 't neg? =>,
                  f:  [ inc 's * 'n
                        [ "range-slice: infinite range w/ negative "
                          "index" ++ fail ] [] ~nil + ],
                  g:  [ 's * 'm + ] }
                let[
                  'i [ 'tn 'n 'm ? ] [ 'f 'g ~neg ] ~nil,
                  'j [ 'tn 'm 'n ? ] [
                    'tn 'inc 'dec if
                    'f [ g 'n [] [ 's neg? 'max 'min if ] ~nil ] ~neg
                  ] ~nil, 's 't *
                ] Range ] ^Range ] def                          ; TODO

:seq-slice    [ i j s .
                'i [] 'drop-first ~nil
                'j [] [ 'i 0 or - take-first ] ~nil
                's 1 = [ 's take-nth ] unless
              ] def                                             ; TODO

; get value at key/index & membership test
;
; >>> ( :one :two :three ) 1 get^
; :two
; >>> () 0 get^
; *** ERROR: list.get^: index 0 is out of range
; >>> ( 1 2 3 ) 1 get
; 2
; >>> () 0 get
; nil
;
; >>> { x: 1, y: 2 } dup :x get
; 1
; >>> drop :z get
; nil
; >>> "foobar" 3 get
; "b"
; >>> "foobar" 10 get
; nil
; >>> [1-) 10 get
; 11
; >>> 10 [1-n] 10 get
; nil
;
; >>> ( :one :two :three ) 1 has?                     ; valid index of
; #t
; >>> ( :one :two :three ) :two elem?                 ; element of
; #t
; >>> { x: 1, y: 2 } :y has?
; #t
; >>> "foobar" 3 has?
; #t
; >>> "hypotheekofferte" "theekoffer" elem?           ; is substring
; #t
;
; >>> [1-) 0 has?
; #t
; >>> [1-) 0 elem?
; #f
; >>> [1-) 99 elem?
; #t
; >>> 100 [1-n) 100 elem?
; #f

:get    [ 2dup has? 'get^ [ 2drop nil ] if ] def

:get^   [ swap get^'  ] def
:has?   [ swap has?'  ] def
:elem?  [ swap elem?' ] def

:get^'  ( :_ ) [ !get^  ] defmulti
:has?'  ( :_ ) [ !has?  ] defmulti
:elem?' ( :_ ) [ !elem? ] defmulti

:has?'  ( :nil    ) [ 2drop #f ] defmulti               ; for assoc-in

:get^'  ( :Range  ) [ range-get^'  ] defmulti
:has?'  ( :Range  ) [ range-has?'  ] defmulti
:elem?' ( :Range  ) [ range-elem?' ] defmulti

; first, second & third element
;
; >>> :x :y 2list
; ( :x :y )
; >>> , '1st '2nd bi s!
; --- STACK ---
; :y
; :x
; ---  END  ---
; >>> ( 1 2 3 4 5 ) 3rd
; 3

:1st    'first def
:2nd    [ rest '1st ~> ] def
:3rd    [ rest '2nd ~> ] def

; last element
;
; >>> () last
; nil
; >>> ( 1 2 3 ) last
; 3
; >>> ( 1 2 3 ) [ dup * ] map last
; 9
; >>> () last^
; *** ERROR: list.get^: index -1 is out of range
; >>> ( :x :y :z ) last
; :z

:last   ( :LSeq ) [ :_ nil <rot [ 'nip dip unseq dup ] loop 2drop ] defmulti
:last   ( :_    ) [ dup len dec nth ] defmulti

:last^  ( :nil  ) [ drop "last^: nil" fail ] defmulti
:last^  ( :LSeq ) [ [ "last^: empty list" fail ] 'last ~seq ] defmulti
:last^  ( :_    ) [ dup len dec get^ ] defmulti                 ; TODO

; nth element
;
; >>> [1-) 10 nth
; 11
; >>> [1-) [ dup * ] map 10 nth
; 121

:nth    [ swap nth' ] def                                       ; TODO

:nth'   ( :_    ) [ swap get ] defmulti
:nth'   ( :LSeq ) [ [ drop nil ]
                    [ x xt . [ dec 'xt nth' ] [ drop 'x ] ~pos ]
                    ^seq ] defmulti

; pair each element with its index
;
; >>> "foo" indexed ->list
; ( T( 0 "f" ) T( 1 "o" ) T( 2 "o" ) )
; >>> "foo" indexed' ->list
; ( T( "f" 0 ) T( "o" 1 ) T( "o" 2 ) )

:indexed  [ [0-) swap zip' ] def
:indexed' [ [0-)      zip' ] def

; get value in nested associative structure
;
; >>> , ( { x: 42 } { y: ( 37 ) } )
; >>> dup ( 0 :x ) get-in
; 42
; >>> drop ( 1 :y 0 ) get-in
; 37

:get-in [ [ 'get $ ] map ~~> ] def

; associate value in (nested) associative structure
;
; >>> { x: 1, y: 2 } 3 :z assoc
; { :x 1 =>, :y 2 =>, :z 3 => }
;
; >>> , ( { x: 42 } { y: ( 37 ) } )
; >>> #t ( 1 :z ) assoc-in
; ( { :x 42 => } { :y ( 37 ) =>, :z #t => } )
; >>> nil "magic" ( :x :y :z ) assoc-in
; { :x { :y { :z "magic" => } => } => }
;
; >>> ( 1 2 ) :x 2 assoc
; ( 1 2 :x )
; >>> ( 1 2 ) :x 3 assoc
; *** ERROR: assoc: index 3 is out of range

:assoc    [ <rot assoc' ] def
:assoc-in [ [ [] [ v k kt . dup 'k get 'v 'kt assoc-in 'k ] ~seq
              assoc ] ^seq' ] def                               ; TODO

:assoc' ( :nil  ) [ v k _ . { 'k 'v => } ] defmulti
:assoc' ( :list ) [ v i l .
                    'l len inc 'i "assoc" assert-in-range
                    'l 'i [-j) ( 'v ) 'l 'i inc [i-) ++ ++
                  ] defmulti
:assoc' ( :dict ) [ v k d . 'd { 'k 'v => } !merge ] defmulti

:assert-in-range  [ l i s . 'i 0 < 'i 'l >= or [
                    ( 's 'i ) "${0}: index ${1} is out of range" fmt
                    fail
                  ] when ] def

; "update" value in (nested) associative structure
;
; >>> { x: 1, y: 2 } 'inc :x modify
; { :x 2 =>, :y 2 => }
;
; >>> { x: { y: 1 } } 'inc ( :x :y ) modify-in
; { :x { :y 2 => } => }
; >>> { x: { y: 1 } } [ [ 42 ] 'inc ~nil ] ( :x :z ) modify-in
; { :x { :y 1 =>, :z 42 => } => }
;
; >>> { x: 1, y: 2 } :x 'dec modify'
; { :x 0 =>, :y 2 => }
; >>> { x: { y: 1 } } ( :x :y ) 'dec modify-in'
; { :x { :y 0 => } => }

:modify     [ f k  . dup 'k  get    f 'k  assoc    ] def
:modify-in  [ f ks . dup 'ks get-in f 'ks assoc-in ] def        ; TODO

:modify'    [ swap modify     ] def
:modify-in' [ swap modify-in  ] def

; remove mapping for key from associative structure
;
; >>> { x: 1, y: 2, z: 3 } :y dissoc
; { :x 1 =>, :z 3 => }
; >>> :foo dissoc
; { :x 1 =>, :z 3 => }

:dissoc [ swap dissoc' ] def

:dissoc' ( :dict ) [ !delete ] defmulti

                                                                ; }}}1

; -- Regexes & String Formatting --                             ; {{{1

; match
;
; NB: see also rx-match.
;
; >>> "foo" "^f" =~                                   ; boolean
; #t
; >>> "bar" "^f" =~
; #f

:=~ ( :str :str ) [ rx-match bool ] defmulti                    ; TODO

; filter using =~
;
; >>> ( "one" "two" "three" ) "^o|ee" grep ->list
; ( "one" "three" )

:grep   [ '=~ $ filter ] def

; substitute/replace
;
; NB: see also rx-sub.
;
; >>> "1 2 3 4" "$2 $1" "(\w+) (\w+)" rx-sub1
; "2 1 3 4"
; >>> "1 2 3 4" "$2 $1" "(\w+) (\w+)" rx-suball
; "2 1 4 3"
;
; >>> "foo bar baz" [ reverse ] "\w+" s///            ; Perl-style alias
; "oof bar baz"
; >>> "foo bar baz" [ reverse ] "\w+" s///g
; "oof rab zab"

:rx-sub1    [ #f rx-sub ] def
:rx-suball  [ #t rx-sub ] def

:s///       'rx-sub1      def
:s///g      'rx-suball    def

; string formatting (WIP)
;
; >>> ( :x 42 "foo" ) "${2} ${1} ${0}" fmt
; "foo 42 :x"

:fmt    [ >< .[ '1 >< str->int get ->str nip ]
          "\$\{(\d+)\}" s///g ] def                             ; TODO

; TODO: width, zero-fill, justify, dict key, ...

                                                                ; }}}1

; -- "Quasi-Macros" --                                          ; {{{1

; lexical bindings
;
; >>> { x: 1, y: 2 } [ 'y 'x + ] let
; 3
; >>> { x: 1, y: 2 } let[ 'y 'x + ]
; 3

:let    [ [ 'vals 'keys bi ] dip '__block-code__ keep __block__
          apply ] def                                           ; TODO

                                                                ; }}}1

; -- Miscellaneous: Looping, I/O, Exceptions, etc. --           ; {{{1

; identity function
;
; >>> id
; >>> []
; [ ]

:id     [     ] def
:[]     [ 'id ] def

; const
;
; >>> ( 1 2 3 ) 42 const mapl
; ( 42 42 42 )

:const  '[ drop '1 ] def

; call n times
;
; >>> , [ "Hi!" say! ] 5 times
; Hi!
; Hi!
; Hi!
; Hi!
; Hi!
; >>> 0 1 [ '+ keep swap ] 5 times
; 8

:times  [ f n . 'n 0 > [ f 'f 'n dec times ] when ] def
      ; [ [1-n] swap 'drop % each ]         ; currently 10x slower :(

; loop, while & until
;
; >>> , :next-collatz [ [ 2 div ] [ 3 * 1 + ] 'even? ~? ] def
;
; >>> ( 12 [ dup next-collatz dup 1 not= ] loop )
; ( 12 6 3 10 5 16 8 4 2 1 )
; >>> ( 12 [ dup 1 not= ] [ dup next-collatz ] while )
; ( 12 6 3 10 5 16 8 4 2 1 )
; >>> ( 12 [ dup 1 = ] [ dup next-collatz ] until )
; ( 12 6 3 10 5 16 8 4 2 1 )
;
; >>> ( 1 [ dup next-collatz dup 1 not= ] loop )
; ( 1 4 2 1 )
;
; >>> ( 1 [ dup 1 not= ] [ dup next-collatz ] while )     ; may run 0x
; ( 1 )
; >>> ( 1 [ dup 1 = ] [ dup next-collatz ] until )
; ( 1 )
;
; >>> ( 1 [ dup 1 not= ] [ dup next-collatz ] do- while ) ; run >= 1x
; ( 1 4 2 1 )
; >>> ( 1 [ dup 1 = ] [ dup next-collatz ] do- until )
; ( 1 4 2 1 )

:loop     [ f . f [ 'f loop ] when ] def
:while    [ p? f . p? [ f 'p? 'f while ] when ] def
:until    [ [ 'not @ ] dip while ] def

:do-      [ dup 2dip ] def
:do-while [ do- while ] def
:do-until [ do- until ] def

; print str or value to stdout
;
; >>> "Hello, World!" say!
; Hello, World!
;
; >>> 42 display!
; 42
; >>> "foo" ddisplay!                               ; ⇔ dup display!
; foo
; "foo"
;
; >>> , ( :x 42 "foo" ) "${2} ${1} ${0}\n" fmt!     ; ⇔ fmt puts!
; foo 42 :x

:say!       [ "\n" !append puts! ] def
:display!   [ ->str say! ] def
:ddisplay!  [ dup display! ] def
:fmt!       [ fmt puts! ] def

; output message & show stack (use for debugging only!)
;
; >>> , :foo [ 1 2, "foo" trace!, + ] def
; >>> foo
; --- TRACE: foo ---
; --- STACK ---
; 2
; 1
; ---  END  ---
; 3

:trace! [ 1list "--- TRACE: ${0} ---" fmt say! __show-stack!__ ] def

; read lines from stdin
;
; NB: read-line! (like ask!) returns nil at EOF.

:read-line! [ nil ask! ] def                                    ; TODO
:lines!     [ read-line! [ 'lines! lseq1 ] ~> ] def

; try w/o finally/catch
;
; >>> [ ... ] [ _ _ _ . :caught #t ] try-catch
; :caught
; >>> [ ... ] [ :finally ] try-finally
; *** ERROR: name __ellipsis__ is not defined

:try-catch    [ [] try        ] def
:try-finally  [ nil swap try  ] def

; assertion
;
; >>> [ 1 1 = ] assert
; >>> [ 1 2 = ] assert
; *** ERROR: assert failed: [ 1 2 = ]

:assert [ b . b [ "assert failed: " 'b ->str ++ fail ] unless ] def

                                                                ; }}}1

; -- Either, Functor, Monad, etc. --                            ; {{{1

:Left   ( :val ) defrecord
:Right  ( :val ) defrecord

:left   'Left  def
:right  'Right def

:show   ( :Left   ) [ .val show "left( "  swap ++ " )" ++ ] defmulti
:show   ( :Right  ) [ .val show "right( " swap ++ " )" ++ ] defmulti

; values with two possibilities
;
; NB: by convention, left is often for errors and right for "correct"
; values.
;
; >>> , :f [ [ 2 div ] [ 2.0 / ] ^either ] def
; >>> 5 left f
; 2
; >>> 7.0 right f
; 3.5
;
; >>> [ 1 0 div ] try->either
; left( ( :DivideByZero "divide by zero" () ) )
; >>> [ 5 2 div ] try->either
; right( 2 )
;
; >>> "oops" left either->fail
; *** ERROR: oops
; >>> 42 right either->fail
; 42

:~either  [ <rot ~either'           ] def
:^either  [ [ '.val % ] bi$ ~either ] def
:either?  [ 'Left? 'Right? bi-or    ] def

:~either' ( :Left   ) [ f _ x . 'x f ] defmulti
:~either' ( :Right  ) [ _ g x . 'x g ] defmulti

:try->either  [ f . [ Right( f ) ] [ 3list Left #t ] [] try ] def
:either->fail [ 'fail [] ^either ] def

; functor (WIP)
;
; >>> , :f [ 'inc -> [ dup * ] -> ] def
; >>> nil f                           ; NB: using ~> for nil is better
; nil
; >>> x: 7 f
; :x 64 =>
; >>> ( 1 2 3 ) f ->list
; ( 4 9 16 )
; >>> ( 1 2 3 ) 'odd? filter f ->list
; ( 4 16 )
; >>> :oops left f
; left( :oops )
; >>> 7 right f
; right( 64 )

:-> [ swap ->' ] def

:->'  ( :nil      ) [ nip               ] defmulti
;     ( :bool     ) [ swap call         ] defmulti              ; TODO
;     ( :int      ) [ swap call         ] defmulti              ; TODO
;     ( :float    ) [ swap call         ] defmulti              ; TODO
;     ( :str      ) [ ...               ] defmulti              ; TODO
;     ( :kwd      ) [ swap call         ] defmulti              ; TODO
:->'  ( :pair     ) [ swap ^pair =>     ] defmulti
:->'  ( :list     ) [ swap map          ] defmulti
;     ( :dict     ) [ ...               ] defmulti              ; TODO
:->'  ( :block    ) [ %                 ] defmulti              ; TODO
:->'  ( :builtin  ) [ %                 ] defmulti              ; TODO
:->'  ( :multi    ) [ %                 ] defmulti              ; TODO

:->'  ( :LSeq     ) [ swap map          ] defmulti
:->'  ( :Left     ) [ nip               ] defmulti
:->'  ( :Right    ) [ swap ^Right Right ] defmulti

; monad (WIP)
;
; >>> ( 1 2 3 ) [ 'inc [ dup * ] bi 2list ] >>= ->list
; ( 2 1 3 4 4 9 )
; >>> ( 1 2 3 ) [ x ret . ( 4 5 ) [ y . T( 'x 'y ) ret ] bind ]
; ...   bind-with ->list
; ( T( 1 4 ) T( 1 5 ) T( 2 4 ) T( 2 5 ) T( 3 4 ) T( 3 5 ) )
;
; >>> do[ ( 1 2 3 ) :x <- ( 4 5 ) :y <- T( 'x 'y ) return ] ->list
; ( T( 1 4 ) T( 1 5 ) T( 2 4 ) T( 2 5 ) T( 3 4 ) T( 3 5 ) )
;
; >>> , :f [ [ drop "neg" left ] [ dup * right ] ~neg ] def
; >>> "oops" left 'f >>=
; left( "oops" )
; >>> -4 right 'f >>=
; left( "neg" )
; >>> 4 right 'f >>=
; right( 16 )
;
; >>> right( :x ) right( :y ) >>
; right( :y )
;
; >>> nil 4 replicate ( 1 2 ) >> '1list >>= ->list
; ( 1 2 1 2 1 2 1 2 )
; >>> do[ nil 4 replicate & ( 1 2 ) :x <- 'x return ] ->list
; ( 1 2 1 2 1 2 1 2 )

:>>=  [ swap =<<  ] def
:>>   [ const >>= ] def

:=<<        ( :list   ) [ swap map concat ] defmulti
:=<<        ( :LSeq   ) [ swap map concat ] defmulti
:=<<        ( :Left   ) [ nip             ] defmulti
:=<<        ( :Right  ) [ swap ^Right     ] defmulti

:return-as  ( :list   ) [ drop 1list      ] defmulti
:return-as  ( :LSeq   ) [ drop 1list      ] defmulti
:return-as  ( :Left   ) [ drop Right      ] defmulti
:return-as  ( :Right  ) [ drop Right      ] defmulti

:bind       '>>= def
:bind-with  [ x f . 'x [ [ 'x return-as ] f ] >>= ] def

{ :_& :& __ident__ =>, :_<- :<- __ident__ =>, blk: '__block__,
  ret: :return, :bw :bind-with __ident__ => } let[

:do     [ b . () 'b __block-code__ _do& 'b _do 'b blk call ] def
:_do&   [ [ dup '_& = [ drop :_ '_<- ] when ] mapl ] def
:_do    [ b . [ () ] [ dup 1st '_<- =
          [ uncons^ nip [ 'ret 2list ] dip 'b _do 'b blk 'bw 2list ]
          [ 'b _do cons ] if ] ^list ] def                      ; TODO

]

                                                                ; }}}1

; -- The Joy of Recursion --                                    ; {{{1

; linear & binary recursion combinators (inspired by Joy)
;
; >>> , :fac1 [ dup zero? 'inc [ dup dec fac1 * ] if ] def
; >>> 5 fac1
; 120
; >>> , :fac2 [ 'zero? 'inc [ dup dec ] '* linrec ] def
; >>> 5 fac2
; 120
;
; >>> , :qsort1 [ dup empty? [] [ unseq over '< $ partition
; ...             'qsort1 bi$ [ swap 1list ] dip ++ ++ ] if ] def
; >>> ( 5 2 7 2 -4 1 ) qsort1 ->list
; ( -4 1 2 2 5 7 )
; >>> , :qsort2 [ 'empty? [] [ unseq over '< $ partition ]
; ...             [ [ swap 1list ] dip ++ ++ ] binrec ] def
; >>> ( 5 2 7 2 -4 1 ) qsort2 ->list
; ( -4 1 2 2 5 7 )

:linrec [ p? f g h . dup p? 'f [ g 'p? 'f 'g 'h linrec h ] if ] def
:binrec [ p? f g h . dup p? 'f [ g [ 'p? 'f 'g 'h binrec ] bi$
                                 h ] if ] def                   ; TODO

                                                                ; }}}1

; -- Conversion --                                              ; {{{1

; conversion
;
; >>> ( 1 2 3 ) [ 'inc map ] as
; ( 2 3 4 )
; >>> "foo" [ 'upper-case map ] as
; "FOO"

:as [ over convert-> 'call dip call ] def

:convert->      ( :str  ) [ drop 'convert->str  ] defmulti      ; TODO
:convert->      ( :list ) [ drop 'convert->list ] defmulti

:convert->str   ( :str  ) [                     ] defmulti      ; TODO
:convert->str   ( :list ) [ join                ] defmulti
:convert->str   ( :LSeq ) [ join                ] defmulti

:convert->list  ( :list ) [                     ] defmulti      ; TODO
:convert->list  ( :str  ) [ ->list              ] defmulti
:convert->list  ( :LSeq ) [ ->list              ] defmulti

                                                                ; }}}1

; -- Modules --                                                 ; {{{1

; require module (loads from file if not defined)
;
; >>> , :no-such-module require
; *** ERROR: cannot load module no-such-module
; >>> , :no-such-module [] defmodule                  ; ^^'
; >>> , :no-such-module require

:require [ dup __modules__ !elem? '__load-module__ unless1 ] def

; use module (require + import(-from))
;
; >>> , :_test use
; loading module _test...
; >>> 'x
; 1
;
; >>> , ( :x :y ) :_test use-from
; >>> 'y
; 2

:use      [ __caller-module__ . 'require
            [ '__caller-module__ defmodule[ import      ] ] bi ] def
:use-from [ __caller-module__ . 'require
            [ '__caller-module__ defmodule[ import-from ] ] bi ] def

                                                                ; }}}1

; -- Unicode Aliases --                                         ; {{{1

:←      'def      def   ; ^k<- (vim digraph)

:≠      'not=     ←     ; ^k!=
:≤      '<=       ←     ; ^k=<
:≥      '>=       ←     ; ^k=>

:∘      '%        ←     ; ^kOb

:¬      'not      ←     ; ^kNO
:∧      'and      ←     ; ^kAN
:∨      'or       ←     ; ^kOR

:~[≠]   '~[not=]  ←
:~[≤]   '~[<=]    ←
:~[≥]   '~[>=]    ←

:∋      'elem?    ←     ; ^k-)
:∌      [ ∋ not ] ←

                                                                ; }}}1

; ...

; -- END --

] ; defmodule

; vim: set tw=70 sw=2 sts=2 et fdm=marker :