koneko-0.0.2: lib/prelude.knk
; -- ; {{{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 :