diff --git a/app/hall.hoon b/app/hall.hoon index af486f93f..69dd39d94 100644 --- a/app/hall.hoon +++ b/app/hall.hoon @@ -1931,7 +1931,7 @@ %^ circle-wire nom ~[%grams %config-l %group-l] [cir ran] - [0 %pull wir [hos.cir dap.bol] ~] + [ost.bol %pull wir [hos.cir dap.bol] ~] :: ++ sa-eject :> removes ships {sis} from {followers}. @@ -1996,7 +1996,7 @@ |= wir/wire ^- move =+ tar=(wire-to-target wir) - [0 %peer wir [p.tar dap.bol] q.tar] + [ost.bol %peer wir [p.tar dap.bol] q.tar] :: ++ wire-to-target :> ship+path from wire @@ -2091,12 +2091,12 @@ %+ turn ~(tap in ~(key by stories)) |= n/name ^- (list move) - :~ :^ 0 %poke / + :~ :^ ost.bol %poke / :+ [our.bol dap.bol] %hall-action :^ %source n | [[[our.bol nom.qer] ran.qer] ~ ~] :: - :^ 0 %pull + :^ ost.bol %pull %^ circle-wire n ~(tap in wat.qer) [[our.bol nom.qer] ran.qer] [[our.bol dap.bol] ~] @@ -2847,6 +2847,15 @@ lent=(lent grams.s) known=k mismatch=m + ?: =(a 'check subs') + ~& 'here are all incoming non-circle subs' + ~& ^- (list (pair ship path)) + %+ murn ~(tap by sup.bol) + |= {b/bone s/ship p/path} + ^- (unit (pair ship path)) + ?: ?=({$circle *} p) ~ + `[s p] + [~ +>] ?: =(a 'rebuild') ~& 'rebuilding message references...' =- [~ +>.$(stories -)] @@ -2867,7 +2876,7 @@ :_ +> =+ bov=(above our.bol) ?: =(bov our.bol) ~ - :~ [0 %pull /burden [bov dap.bol] ~] + :~ [ost.bol %pull /burden [bov dap.bol] ~] (wire-to-peer /burden) == ?: =(a 'incoming') @@ -2882,5 +2891,10 @@ |= {n/name s/story} [n src.shape.s] [~ +>] + ?: =(`0 (find "re-listen " (trip a))) + ~& 're-listening' + :_ +> + :_ ~ + (wire-to-peer /report/(crip (slag 10 (trip a)))) [~ +>] -- diff --git a/app/talk.hoon b/app/talk.hoon index c695479cd..28c007bf2 100644 --- a/app/talk.hoon +++ b/app/talk.hoon @@ -203,7 +203,7 @@ ++ peer-client :> ui state peer move ^- move - :* 0 + :* ost.bol %peer /server/client server @@ -212,7 +212,7 @@ :: ++ peer-inbox ^- move - :* 0 + :* ost.bol %peer /server/inbox server @@ -2438,16 +2438,16 @@ ?: =(a 'reconnect') ~& 'disconnecting and reconnecting to hall...' :_ +> - :~ [0 %pull /server/client server ~] - [0 %pull /server/inbox server ~] + :~ [ost.bol %pull /server/client server ~] + [ost.bol %pull /server/inbox server ~] peer-client peer-inbox == ?: =(a 'reset') ~& 'full reset incoming, hold on to your cli...' :_ +>(grams ~, known ~, count 0) - :~ [0 %pull /server/client server ~] - [0 %pull /server/inbox server ~] + :~ [ost.bol %pull /server/client server ~] + [ost.bol %pull /server/inbox server ~] peer-client peer-inbox == diff --git a/gen/capitalize.hoon b/gen/capitalize.hoon new file mode 100644 index 000000000..f5bff918d --- /dev/null +++ b/gen/capitalize.hoon @@ -0,0 +1,285 @@ +:: to use, download UnicdoeData.txt and place it in `%/lib/unicode-data/txt`. +:: +:::: +:: +:: part 1: parse the file into {uppers} +:: +/- unicode-data +/+ new-hoon +/= case-table + /; |= a=(list line:unicode-data) + =, new-hoon + |^ %- build-tree + %- flop + (build-case-nodes a) + :: + :> # + :> # %case-nodes + :> # + :> transforms raw unicode data into sequential case nodes. + +| + ++ build-case-nodes + :> raw list of unicode data lines to a compact list of chardata + |= a=(list line:unicode-data) + ^- (list case-node:unicode-data) + =< out + :: + :: todo: we don't have the final case range in the output of this + :: gate. this is because this algorithm doesn't work when the last + :: char is part of a range. this doesn't happen with the real one, + :: only the excerpts i was using for testing. + :: + %^ foldl:ls a *case-fold + |= [c=case-fold l=line:unicode-data] + ^+ c + =+ state=(line-to-case-state l) + ?: (is-adjacent state prev.c) + c(prev state) + =. c (add-range c) + %= c + start + ?: &(!=(case.state %missing) !=(case.state %none)) + `state + ~ + prev state + == + :: + ++ line-to-case-state + :> creates an easy to merge form. + |= line:unicode-data + ^- case-state + =/ out=case-state + [code %none [%none ~] [%none ~] [%none ~]] + ?: =(code `@c`0) + =. case.out %missing + out + =. case.out + ?+ gen %none + $lu %upper + $ll %lower + $lt %title + == + :: + :: several characters aren't described as $lu or $ll but have lower or + :: upper state, such as u+2161. detect this and fix it up. + :: + =? case.out &(=(case.out %none) !=(low ~)) %upper + =? case.out &(=(case.out %none) !=(up ~)) %lower + :: + :: calculate offsets + :: + =? upper.out !=(up ~) (calculate-offset (need up) code) + =? lower.out !=(low ~) + (calculate-offset (need low) code) + =? title.out !=(title ~) (calculate-offset (need title) code) + out + :: + ++ calculate-offset + |= [src=@c dst=@c] + ^- case-offset:unicode-data + ?: =(src dst) + [%none ~] + ?: (gth src dst) + [%add (sub src dst)] + [%sub (sub dst src)] + :: + ++ is-adjacent + :> is {rhs} a continuation of {lhs}? + |= [lhs=case-state rhs=case-state] + ^- ? + ?: (lth point.rhs point.lhs) + $(lhs rhs, rhs lhs) + ?: !=(point.rhs +(point.lhs)) + %.n + ?: !=(case.rhs case.lhs) + (upper-lower-adjacent lhs rhs) + ?: =(case.lhs %none) + %.n + ?: =(case.lhs %missing) + %.n + ?: !=(upper.lhs upper.rhs) + %.n + ?: !=(lower.lhs lower.rhs) + %.n + ?: !=(title.lhs title.rhs) + %.n + %.y + :: + ++ upper-lower-adjacent + :> detects %upper-lower spans. + :> + :> is {lhs} the same as {rhs}, but with opposite case? + |= [lhs=case-state rhs=case-state] + ?: &(=(case.lhs %upper) !=(case.rhs %lower)) + %.n + ?: &(=(case.lhs %lower) !=(case.rhs %upper)) + %.n + :: + :: to simplify detection, if things are in the opposite order, redo + :: things flipped. + :: + ?: =(case.lhs %lower) + $(lhs rhs, rhs lhs) + ?& (is-upper-lower lhs) + (is-lower-upper rhs) + == + :: + ++ is-upper-lower + |= i=case-state + =(+.+.i [[%none ~] [%add 1] [%none ~]]) + :: + ++ is-lower-upper + |= i=case-state + =(+.+.i [[%sub 1] [%none ~] [%sub 1]]) + :: + ++ is-none + |= i=case-state + =(+.+.i [[%none ~] [%none ~] [%none ~]]) + :: + ++ add-range + |= c=case-fold + ^+ c + ?~ start.c + c + ?: (is-none u.start.c) + c + ?: ?& (gth point.prev.c point.u.start.c) + (is-upper-lower u.start.c) + == + =/ node=case-node:unicode-data + [`@ux`point.u.start.c `@ux`point.prev.c [%uplo ~] [%uplo ~] [%uplo ~]] + c(out [node out.c]) + =/ node=case-node:unicode-data + [`@ux`point.u.start.c `@ux`point.prev.c +.+.u.start.c] + c(out [node out.c]) + :: + ++ case-fold + :> state that's part of the fold which generates the list of case-nodes + $: :> resulting data to pass to treeify. + out=(list case-node:unicode-data) + :> the start of a run of characters; ~ for not active. + start=(unit case-state) + :> previous character state + prev=case-state + == + :: + ++ case-state + :> a temporary model which we compress later in a second pass. + $: point=@c + case=case-class + upper=case-offset:unicode-data + lower=case-offset:unicode-data + title=case-offset:unicode-data + == + :: + ++ case-class + :> classification of an individual character. + $? $upper + $lower + $title + $none + $missing + == + :: + :> # + :> # %tree-building + :> # + :> builds a binary search tree out of the list + +| + ++ build-tree + |= a=(list case-node:unicode-data) + ^- case-tree:unicode-data + :: there's probably a bottom up approach that doesn't require walking + :: a list over and over again. + ?~ a + ~ + =+ len=(lent a) + =+ [lhs rhs]=(split-at:ls (div len 2) a) + ?~ rhs + ?~ lhs + ~ + [i.lhs ~ ~] + =+ x=[i.rhs $(a lhs) $(a t.rhs)] + x + -- + /: /===/lib/unicode-data /&unicode-data&/txt/ +:: +:: part 2: utility core +:: +|% +++ transform + |= [a=tape fun=$-(@c @c)] + %- tufa + (turn (tuba a) fun) +:: +++ to-upper + :> returns the uppercase of unicode codepoint {a} + |= a=@c + ^- @c + :: special case ascii to not perform map lookup. + ?: (lte a max-ascii) + ?: &((gte a 'a') (lte a 'z')) + (sub a 32) + a + (apply-table a case-table %upper) +:: +++ to-lower + :> returns the lowercase of unicode codepoint {a} + |= a=@c + ^- @c + ?: (lte a max-ascii) + ?: &((gte a 'A') (lte a 'Z')) + (add 32 a) + a + (apply-table a case-table %lower) +:: +++ apply-table + :> searches {table} and apples applies {type} to {a}. + :> + :> this recursively walks the case tree {table}. if it finds an entry which + :> matches on {a}, it will apply the offset. otherwise, returns {a}. + |= [a=@c table=case-tree:unicode-data type=?($upper $lower $title)] + ^- @c + ?~ table + a + ?: (lth a start.n.table) + $(table l.table) + ?: (gth a end.n.table) + $(table r.table) + ?. &((lte start.n.table a) (lte a end.n.table)) + a + %^ apply-offset a type + ?- type + $upper upper.n.table + $lower lower.n.table + $title title.n.table + == +:: +++ apply-offset + :> applies an character offset to {a}. + |= [a=@c type=?($upper $lower $title) offset=case-offset:unicode-data] + ^- @c + ?- offset + {$add *} (add a a.offset) + {$sub *} (sub a s.offset) + {$none *} a + :: + {$uplo *} + ?- type + $upper (sub a 1) + $lower (add a 1) + $title (sub a 1) + == + == +:: +++ max-ascii `@c`0x7f +-- +:: +:: part 3: generator +:: +:- %say +|= $: [now=@da eny=@uvJ bec=beak] + [n=tape $~] + $~ + == +:- %tape (transform n to-upper) diff --git a/gen/test.hoon b/gen/test.hoon new file mode 100644 index 000000000..df4c279ff --- /dev/null +++ b/gen/test.hoon @@ -0,0 +1,71 @@ +/+ new-hoon, tester +/= all-tests + /^ (map @ta tests:tester) + /: /===/tests + /_ /test-tree/ +:: +=, new-hoon +|% +:: +++ test-runner + :> run all tests in {a} with a filter. + =| pax=path + |= [filter=path eny=@uvJ a=tests:tester] + ^- tang + %- concat:ls + %+ turn a + |= b=instance:tester + ^- tang + =^ matches filter (match-filter filter p.b) + ?. matches + ~ + ?- -.q.b + %& (run-test [p.b pax] eny p.q.b) + %| ^$(pax [p.b pax], a p.q.b) + == +:: +++ run-test + :> executes an individual test. + |= [pax=path eny=@uvJ test=$-(@uvJ (list tape))] + ^- tang + =+ name=(spud (flop pax)) + =+ run=(mule |.((test eny))) + ?- -.run + $| :: the stack is already flopped for output? + ;: weld + p:run + `tang`[[%leaf (weld name " CRASHED")] ~] + == + $& ?: =(~ p:run) + [[%leaf (weld name " OK")] ~] + :: Create a welded list of all failures indented. + %- flop + ;: weld + `tang`[[%leaf (weld name " FAILED")] ~] + %+ turn p:run + |= {i/tape} + ^- tank + [%leaf (weld " " i)] + == + == +:: +++ match-filter + :> checks to see if {name} matches the head of {filter}. + |= [filter=path name=term] + ^- [? path] + ?~ filter + :: when there's no filter, we always match. + [%.y ~] + [=(i.filter name) t.filter] +-- +:: +:- %say +|= $: [now=@da eny=@uvJ bec=beak] + [filter=$?($~ [pax=path $~])] + $~ + == +:- %tang +%^ test-runner +?~ filter ~ pax.filter +eny +(test-map-to-test-list:tester all-tests) diff --git a/lib/new-hoon.hoon b/lib/new-hoon.hoon new file mode 100644 index 000000000..3354b7b49 --- /dev/null +++ b/lib/new-hoon.hoon @@ -0,0 +1,1557 @@ +:> basic containers +|% +:: +++ first + |* a=^ + -.a +:: +++ second + |* a=^ + +.a +:: +++ either |*([a=mold b=mold] $%({$& p/a} {$| p/b})) :: either +:: +++ thr + |% + ++ apply + :> applies {b} {a} is first, or {b} to {a} is second. + |* [a=(either) b=$-(* *) c=$-(* *)] + ?- -.a + $& (b p.a) + $| (c p.a) + == + :: + ++ firsts + :> returns a list of all first elements in {a}. + |* a=(list (either)) + => .(a (homo a)) + |- + ?~ a + ~ + ?- -.i.a + $& [p.i.a $(a t.a)] + $| $(a t.a) + == + :: + ++ seconds + :> returns a list of all second elements in {a}. + |* a=(list (either)) + => .(a (homo a)) + |- + ?~ a + ~ + ?- -.i.a + $& $(a t.a) + $| [p.i.a $(a t.a)] + == + :: + ++ partition + :> splits the list of eithers into two lists based on first or second. + |* a=(list (either)) + => .(a (homo a)) + |- + ^- {(list _?>(?=({{%& *} *} a) p.i.a)) (list _?>(?=({{%| *} *} a) p.i.a))} + ?~ a + [~ ~] + =+ ret=$(a t.a) + ?- -.i.a + $& [[p.i.a -.ret] +.ret] + $| [-.ret [p.i.a +.ret]] + == + -- +++ maybe |*(a=mold $@($~ {$~ u/a})) :: maybe +++ myb + |% + ++ is-null + :> returns %.y if maybe is null. + :> + :> corresponds to {isJust} in haskell. + |* a=(maybe) + :> whether {a} is null. + ?~ a %.y + %.n + :: + ++ exists + :> returns %.y if maybe contains a real value. + :> + :> corresponds to {isNothing} in haskell. + |* a=(maybe) + :> whether {a} is not null. + ?~ a %.n + %.y + :: + ++ need + :> returns the value or crashes. + :> + :> corresponds to {fromJust} in haskell. + |* a=(maybe) + ?~ a ~>(%mean.[%leaf "need"] !!) + :> the value from the maybe. + u.a + :: + ++ default + :> returns the value in the maybe, or a default value on null. + :> + :> corresponds to {fromMaybe} in haskell. + |* [a=(maybe) b=*] + ?~(a b u.a) + :: + ++ from-list + :> returns the first value of the list, or null on empty list. + :> + :> corresponds to {listToMaybe} in haskell. + |* a=(list) + ^- (maybe _i.a) + ?~ a ~ + [~ i.a] + :: + ++ to-list + :> converts the maybe to a list. + :> + :> corresponds to {maybeToList} in haskell. + |* a=(maybe) + ^- (list _u.a) + ?~ a ~ + [u.a ~] + :: + ++ concat + :> converts a list of maybes to a list of non-null values. + :> + :> corresponds to {catMaybes} in haskell. + |* a=(list (maybe)) + => .(a (homo a)) + |- + ^- (list _u.+.i.-.a) + ?~ a ~ + ?~ i.a + $(a t.a) + [u.i.a $(a t.a)] + :: + ++ map + :> a version of map that can throw out items. + :> + :> takes a list of items and a function of the type + :> + :> todo: while this was in Data.Maybe in haskell, this might better + :> logically be put in our list class? murn is. + :> + :> corresponds to {mapMaybes} in haskell. + |* [a=(list) b=$-(* (maybe))] + => .(a (homo a)) + |- + ^- (list _,.+:*b) + ?~ a ~ + =+ c=(b i.a) + ?~ c + $(a t.a) + :: todo: the span of c does not have the faces of a maybe. how do i either + :: force a resurface or act safely on the incoming? + [+.c $(a t.a)] + :: + ++ apply + :> applies {b} to {a}. + |* [a=(maybe) b=$-(* (maybe))] + ?~ a ~ + (b u.a) + :: + :: todo: bind, bond, both, flit, hunt, lift, mate, + :: + :: used in other files: bond, drop (but only once) + :: unusued: clap + -- +++ ls + :: we are back to a basic problem here: when we try to pass lists without + :: {i} and {t} faces, we have to use {-} and {+} to access the structure of + :: the list. but we then can't deal with incoming lists that do have faces, + :: as `+:[i="one" t=~]` is `t=~`, not `~`. + :: + :: what i really want is that the sapn outside a |* is `{"" 2 "" $~}`, but + :: inside, it is `(list $?(@ud tape))`. all of a sudden, you don't need + :: ++limo or ++homo, because you have the right span from the beginning! + :: those two functions really feel like they're working around the type + :: system instead of cooperating with it. + :: + :> list utilities + |% + :> # %basic + :> basic list manipulation + +| + :: + ++ head + :> returns the first item in the list, which must be non-empty. + |* a=(list) + => .(a (homo a)) + :> the first item in the list. + ?~ a ~>(%mean.[%leaf "head"] !!) + i.a + :: + ++ last + :> returns the final item in the list, which must be non-empty. + |* a=(list) + :> the last item in a list. + ?~ a ~>(%mean.[%leaf "last"] !!) + ?~ t.a + i.a + $(a t.a) + :: + ++ tail + :> returns all items after the head of the list, which must be non-empty. + |* a=(list) + ^+ a + ?~ a ~>(%mean.[%leaf "tail"] !!) + t.a + :: + ++ init + :> returns all items in the list except the last one. must be non-empty. + |* a=(list) + => .(a (homo a)) + |- + ^+ a + ?~ a ~>(%mean.[%leaf "init"] !!) + |- + ?~ t.a + ~ + [i.a $(a t.a)] +:: :: +:: :: ommitted: uncons, null +:: :: + ++ size + :> returns the number of items in {a}. + :> + :> corresponds to {length} in haskell. + |= a=(list) + =| b=@u + ^- @u + |- + ?~ a + b + $(a t.a, b +(b)) + :: + :> # %transformations + :> functions which change a list into another list + +| + :: + ++ map + :> applies a gate to each item in the list. + |* [a=(list) b=$-(* *)] + ^- (list _*b) + ?~ a ~ + [(b i.a) $(a t.a)] + :: + ++ reverse + :> reverses the order of the items in the list. + |* a=(list) + => .(a (homo a)) + ^+ a + =+ b=`_a`~ + |- + ?~ a b + $(a t.a, b [i.a b]) + :: + ++ intersperse + :> places {a} between each element in {b}. + |* [a=* b=(list)] + => .(b (homo b)) + |- + ^+ (homo [a b]) + ?~ b + ~ + =+ c=$(b t.b) + ?~ c + [i.b ~] + [i.b a c] + :: + ++ intercalate + :> places {a} between each list in {b}, and flatten to a single list. + |* [a=(list) b=(list (list))] + => .(a ^.(homo a), b ^.(homo b)) + |- + ^+ (concat [a b]) + ?~ b + ~ + =+ c=$(b t.b) + ?~ c + i.b + :(weld i.b a c) + :: + ++ transpose + :> transposes rows and columns of a 2d list structure. + |* input=(list (list)) + :: todo: this should homogenize with each sublist. + ^- (list (list)) + =/ items + %^ foldl input `{(list) (list (list))}`[~ ~] + |= :> current: the list of first items under construction. + :> remaining: the remaining item lists. + :> next: the next list in {input}. + {state/{current/(list) remaining/(list (list))} next/(list)} + ?~ next + state + ?~ t.next + [[i.next current.state] remaining.state] + [[i.next current.state] [t.next remaining.state]] + ?~ +.items + `(list (list))`[(reverse -.items) ~] + [(reverse -.items) $(input (reverse +.items))] + :: +:: :: ++ subsequences +:: :: |= a=(list) +:: :: ?~ a +:: :: ~ +:: :: :- -.a +:: :: %^ foldr +:: :: $(a +.a) +:: :: `(list)`~ +:: :: |= [ys=(list) r=(list)] +:: :: ~ ::[ys [-.a ys] r ~] +:: :: TODO: +:: :: ++subsequences +:: :: ++permutations + + :: + :> # %folds + :> functions which reduce a list to a value + +| + :: + ++ foldl + :> left associative fold + :> + :> this follows haskell giving an explicit starting value instead of {roll}. + |* [a=(list) b=* c=$-({* *} *)] + ^+ b + ?~ a + b + $(a t.a, b (c b i.a)) + :: + ++ foldr + :> right associative fold + |* [a=(list) b=* c=$-({* *} *)] + ^+ b + ?~ a + b + (c $(a t.a) i.a) + :: + ++ concat + :> concatenate a list of lists into a single level. + |* a=(list (list)) + => .(a ^.(homo a)) + |- ^+ (homo i:-.a) + ?~ a + ~ + (weld (homo i.a) $(a t.a)) + :: + ++ weld + :> combine two lists, possibly of different types. + |* [a=(list) b=(list)] + => .(a ^.(homo a), b ^.(homo b)) + |- ^- (list $?(_i.-.a _i.-.b)) + ?~ a b + [i.a $(a t.a)] + :: + ++ any + :> returns yes if any element satisfies the predicate + |* [a=(list) b=$-(* ?)] + ?~ a + %.n + ?|((b i.a) $(a t.a)) + :: + ++ all + :> returns yes if all elements satisfy the predicate + |* [a=(list) b=$-(* ?)] + ?~ a + %.y + ?&((b i.a) $(a t.a)) + :: + :: haskell has a bunch of methods like sum or maximum which leverage type + :: classes, but I don't think they can be written generically in hoon. + :: + :: + :> # %building + :> functions which build lists + +| + ++ scanl + :> returns a list of successive reduced values from the left. + |* [a=(list) b=* c=$-({* *} *)] + => .(a (homo a)) + |- + ?~ a + [b ~] + [b $(a t.a, b (c b i.a))] + :: + ++ scanl1 + :> a variant of ++scanl that has no starting value. + |* [a=(list) c=$-({* *} *)] + => .(a (homo a)) + |- + ?~ a + ~ + ?~ t.a + ~ + (scanl t.a i.a c) + :: + ++ scanr + :> the right-to-left version of scanl. + |* [a=(list) b=* c=$-({* *} *)] + => .(a (homo a)) + |- + ^- (list _b) + ?~ a + [b ~] + =+ rest=$(a t.a) + ?> ?=(^ rest) + [(c i.a i.rest) rest] + :: + ++ scanr1 + :> a variant of ++scanr that has no starting value. + |* [a=(list) c=$-({* *} *)] + => .(a (homo a)) + |- + ^+ a + ?~ a + ~ + ?~ t.a + [i.a ~] + =+ rest=$(a t.a) + ?> ?=(^ rest) + [(c i.a i.rest) rest] + :: + ++ map-foldl + :> performs both a ++map and a ++foldl in one pass. + :> + :> corresponds to {mapAccumL} in haskell. + |* [a=(list) b=* c=$-({* *} {* *})] + ^- {_b (list _+:*c)} + ?~ a + [b ~] + =+ d=(c b i.a) + =+ recurse=$(a t.a, b -.d) + [-.recurse [+.d +.recurse]] + :: + ++ map-foldr + :> performs both a ++map and a ++foldr in one pass. + :> + :> corresponds to {mapAccumR} in haskell. + |* [a=(list) b=* c=$-({* *} {* *})] + ^- {_b (list _+:*c)} + ?~ a + [b ~] + =+ recurse=$(a t.a) + =+ d=(c -.recurse i.a) + [-.d [+.d +.recurse]] + :: + ++ unfoldr + :> generates a list from a seed value and a function. + |* [b=* c=$-(* (maybe {* *}))] + |- + ^- (list _b) + =+ current=(c b) + ?~ current + ~ + :: todo: the span of {c} is resurfaced to have a u. this might do funky + :: things with faces. + [-.+.current $(b +.+.current)] + :: + :> # %sublists + :> functions which return a portion of the list + +| + :: + ++ take + :> returns the first {a} elements of {b}. + |* [a=@ b=(list)] + => .(b (homo b)) + |- + ^+ b + ?: =(0 a) + ~ + ?~ b + ~ + [i.b $(a (dec a), b +.b)] + :: + ++ drop + :> returns {b} without the first {a} elements. + |* [a=@ b=(list)] + ?: =(0 a) + b + ?~ b + b + $(a (dec a), b +.b) + :: + ++ split-at + :> returns {b} split into two lists at the {a}th element. + |* [a=@ b=(list)] + => .(b (homo b)) + |- + ^+ [b b] + ?: =(0 a) + [~ b] + ?~ b + [~ b] + =+ d=$(a (dec a), b t.b) + [[i.b -.d] +.d] + :: + ++ take-while + :> returns elements from {a} until {b} returns %.no. + |* [a=(list) b=$-(* ?)] + => .(a (homo a)) + |- + ^+ a + ?~ a + ~ + ?. (b -.a) + ~ + [i.a $(a t.a)] + :: + ++ drop-while + :> returns elements form {a} once {b} returns %.no. + |* [a=(list) b=$-(* ?)] + => .(a (homo a)) + |- + ?~ a + ~ + ?. (b i.a) + a + $(a t.a) + :: + ++ drop-while-end + :> drops the largest suffix of {a} which matches {b}. + |* [a=(list) b=$-(* ?)] + => .(a (homo a)) + |- + ?~ a + ~ + =+ r=$(a t.a) + ?: ?&(=(r ~) (b i.a)) + ~ + [i.a r] + :: + ++ split-on + :> returns [the longest prefix of {b}, the rest of the list]. + :> + :> corresponds to {span} in haskell. renamed to not conflict with hoon. + |* [a=(list) b=$-(* ?)] + => .(a (homo a)) + |- + ^+ [a a] + ?~ a + [~ ~] + ?. (b i.a) + [~ a] + =+ d=$(a +.a) + [[i.a -.d] +.d] + :: + ++ break + :> like {split-on}, but reverses the return code of {b}. + |* [a=(list) b=$-(* ?)] + => .(a (homo a)) + |- + ^+ [a a] + ?~ a + [~ ~] + ?: (b i.a) + [~ a] + =+ d=$(a t.a) + [[i.a -.d] +.d] + :: + ++ strip-prefix + :> returns a {maybe} of {b} with the prefix {a} removed, or ~ if no match. + |* [a=(list) b=(list)] + ^- (maybe _b) + ?~ a + `b + ?~ b + ~ + $(a +.a, b +.b) + :: + :: todo: ++group + :: + ++ inits + :> returns all initial segments in reverse order. + :> + :> unlike haskell, this does not return the empty list as the first + :> element, as hoon uses null as the list terminator. + |* a=(list) + => .(a (homo a)) + %- flop + |- + ?~ a ~ + [a $(a (init a))] + :: + ++ tails + :> returns all final segments, longest first. + |* a=(list) + => .(a (homo a)) + |- + ?~ a ~ + [a $(a t.a)] + :: + :> # %predicates + :> functions which compare lists + +| + :: + ++ is-prefix-of + :> returns %.y if the first list is a prefix of the second. + |* [a=(list) b=(list)] + => .(a (homo a), b (homo b)) + |- + ^- ? + ?~ a + %.y + ?~ b + %.n + ?. =(i.a i.b) + %.n + $(a t.a, b t.b) + :: + ++ is-suffix-of + :> returns %.y if the first list is the suffix of the second. + |* [a=(list) b=(list)] + => .(a (homo a), b (homo b)) + ^- ? + :: todo: this is performant in haskell because of laziness but may not be + :: adequate in hoon. + (is-prefix-of (reverse a) (reverse b)) + :: + ++ is-infix-of + :> returns %.y if the first list appears anywhere in the second. + |* [a=(list) b=(list)] + => .(a (homo a), b (homo b)) + |- + ^- ? + ?~ a + %.y + ?~ b + %.n + ?: (is-prefix-of a b) + %.y + $(b t.b) + :: + :: todo: ++is-subsequence-of + :: + :> # %searching + :> finding items in lists + :: + ++ elem + :> does {a} occur in list {b}? + |* [a=* b=(list)] + ?~ b + %.n + ?: =(a i.b) + %.y + $(b t.b) + :: + ++ lookup + :> looks up the key {a} in the association list {b} + |* [a=* b=(list (pair))] + ^- (maybe _+.-.b) + ?~ b + ~ + ?: =(a p.i.b) + [~ q.i.b] + $(b t.b) + :: + ++ find + :> returns the first element of {a} which matches predicate {b}. + |* [a=(list) b=$-(* ?)] + ^- (maybe _-.a) + ?~ a + ~ + ?: (b i.a) + [~ i.a] + $(a t.a) + :: + ++ filter + :> filter all items in {a} which match predicate {b}. + |* [a=(list) b=$-(* ?)] + => .(a (homo a)) + |- + ^+ a + ?~ a + ~ + ?. (b i.a) + [i.a $(a t.a)] + $(a t.a) + :: + ++ partition + :> returns two lists, one whose elements match {b}, the other which doesn't. + |* [a=(list) b=$-(* ?)] + => .(a (homo a)) + |- + ^+ [a a] + ?~ a + [~ ~] + =+ rest=$(a t.a) + ?: (b i.a) + [[i.a -.rest] +.rest] + [-.rest [i.a +.rest]] + :: + :> # %indexing + :> finding indices in lists + +| + :: + ++ elem-index + :> returns {maybe} the first occurrence of {a} occur in list {b}. + =| i=@u + |= [a=* b=(list)] + ^- (maybe @ud) + ?~ b + ~ + ?: =(a i.b) + `i + $(b t.b, i +(i)) + :: + ++ elem-indices + :> returns a list of indices of all occurrences of {a} in {b}. + =| i/@u + |= [a=* b=(list)] + ^- (list @ud) + ?~ b + ~ + ?: =(a i.b) + [i $(b t.b, i +(i))] + $(b t.b, i +(i)) + :: + ++ find-index + :> returns {maybe} the first occurrence which matches {b} in {a}. + =| i=@u + |* [a=(list) b=$-(* ?)] + ^- (maybe @ud) + ?~ a + ~ + ?: (b i.a) + `i + $(a t.a, i +(i)) + :: + ++ find-indices + :> returns a list of indices of all items in {a} which match {b}. + =| i=@u + |* [a=(list) b=$-(* ?)] + ^- (list @ud) + ?~ a + ~ + ?: (b i.a) + [i $(a t.a, i +(i))] + $(a t.a, i +(i)) + :: + ++ zip + :> takes a list of lists, returning a list of each first items. + |* a=(list (list)) + => .(a (multi-homo a)) + |^ ^+ a + ?~ a ~ + ?. valid + ~ + =+ h=heads + ?~ h ~ + [heads $(a tails)] + :: + ++ valid + %+ all a + |= next=(list) + ?~ a %.n + %.y + :: + ++ heads + ^+ (homo i:-.a) + |- + ?~ a ~ + ?~ i.a ~ + [i.i.a $(a t.a)] + :: + ++ tails + ^+ a + |- + ?~ a ~ + ?~ i.a ~ + [t.i.a $(a t.a)] + -- + ++ multi-homo + |* a=(list (list)) + ^+ =< $ + |% +- $ ?:(*? ~ [i=(homo (snag 0 a)) t=$]) + -- + a + :: + :> # %set + :> set operations on lists + +| + ++ unique + :> removes duplicates elements from {a} + :> + :> corresponds to {nub} in haskell. + |* a=(list) + => .(a (homo a)) + =| seen/(list) + ^+ a + |- + ?~ a + ~ + ?: (elem i.a seen) + $(a t.a) + [i.a $(seen [i.a seen], a t.a)] + :: + ++ delete + :> removes the first occurrence of {a} in {b} + |* [a=* b=(list)] + => .(b (homo b)) + ^+ b + |- + ?~ b + ~ + ?: =(a i.b) + t.b + [i.b $(b t.b)] + :: + ++ delete-firsts + :> deletes the first occurrence of each element in {b} from {a}. + |* [a=(list) b=(list)] + => .(a (homo a), b (homo b)) + |- + ^+ a + ?~ a + ~ + ?~ b + a + ?: (elem i.a b) + $(a t.a, b (delete i.a b)) + [i.a $(a t.a)] + :: + ++ union + :> the list union of {a} and {b}. + |* [a=(list) b=(list)] + => .(a (homo a), b (homo b)) + |- + ^+ (weld a b) + ?~ a + b + ?~ b + ~ + [i.a $(a t.a, b (delete i.a b))] + :: + ++ intersect + :> the intersection of {a} and {b}. + |* [a=(list) b=(list)] + => .(a (homo a), b (homo b)) + |- + ^+ a + ?~ a + ~ + ?: (elem i.a b) + [i.a $(a t.a)] + $(a t.a) + :: + :: todo: everything about ++sort and ++sort-on needs more thought. the + :: haskell implementation uses the Ord typeclass to sort things by + :: default. ++sort as is is probably the correct thing to do. + :: + -- +:: +++ dict + :> a dictionary mapping keys of {a} to values of {b}. + :> + :> a dictionary is treap ordered; it builds a treap out of the hashed key + :> values. + |* [a=mold b=mold] + %+ cork (tree (pair a b)) + |= c/(tree (pair a b)) ^+ c + ?.((valid:dct c) ~ c) +:: +++ dct + |% + :> # %query + :> looks up values in the dict. + +| + ++ empty + :> is the dict empty? + |* a=(dict) + ?~ a %.y + %.n + :: + ++ size + :> returns the number of elements in {a}. + |= a=(dict) + ^- @u + ?~ a 0 + :(add 1 $(a l.a) $(a r.a)) + :: + ++ member + :> returns %.y if {b} is a key in {a}. + |= [a=(dict) key=*] + ^- ? + ?~ a %.n + ?|(=(key p.n.a) $(a l.a) $(a r.a)) + :: + ++ get + :> grab value by key. + |* [a=(dict) key=*] + ^- (maybe _?>(?=(^ a) q.n.a)) + :: ^- {$@($~ {$~ u/_?>(?=(^ a) q.n.a)})} + ?~ a + ~ + ?: =(key p.n.a) + `q.n.a + ?: (gor key p.n.a) + $(a l.a) + $(a r.a) + :: +:: :: todo: is ++got the correct interface to have? Haskell has lookup which +:: :: returns a Maybe and a findWithDefault which passes in a default value. +:: ++ got +:: :> todo: move impl here. +:: :> todo: is there a way to make b/_<><>.a ? +:: |* [a=(dict) key=*] +:: (~(got by a) key) + :: + :: todo: skipping several methods which rely on the the Ord typeclass, like + :: lookupLT. + :: + :> # %insertion + +| + ++ put + :> inserts a new key/value pair, replacing the current value if it exists. + :> + :> corresponds to {insert} in haskell. + |* [a=(dict) key=* value=*] + |- ^+ a + ?~ a + [[key value] ~ ~] + ?: =(key p.n.a) + ?: =(value q.n.a) + a + [[key value] l.a r.a] + ?: (gor key p.n.a) + =+ d=$(a l.a) + ?> ?=(^ d) + ?: (vor p.n.a p.n.d) + [n.a d r.a] + [n.d l.d [n.a r.d r.a]] + =+ d=$(a r.a) + ?> ?=(^ d) + ?: (vor p.n.a p.n.d) + [n.a l.a d] + [n.d [n.a l.a l.d] r.d] + :: + ++ put-with + :> inserts {key}/{value}, applying {fun} if {key} already exists. + :> + :> corresponds to {insertWith} in haskell. + |* [a=(dict) key=* value=* fun=$-({* *} *)] + |- ^+ a + ?~ a + [[key value] ~ ~] + ?: =(key p.n.a) + :: key already exists; use {fun} to resolve. + [[key (fun q.n.a value)] l.a r.a] + ?: (gor key p.n.a) + =+ d=$(a l.a) + ?> ?=(^ d) + ?: (vor p.n.a p.n.d) + [n.a d r.a] + [n.d l.d [n.a r.d r.a]] + =+ d=$(a r.a) + ?> ?=(^ d) + ?: (vor p.n.a p.n.d) + [n.a l.a d] + [n.d [n.a l.a l.d] r.d] + :: + ++ put-with-key + :> inserts {key}/{value}, applying {fun} if {key} already exists. + :> + :> corresponds to {insertWithKey} in haskell. + |* [a=(dict) key=* value=* fun=$-({* * *} *)] + |- ^+ a + ?~ a + [[key value] ~ ~] + ?: =(key p.n.a) + :: key already exists; use {fun} to resolve. + [[key (fun p.n.a q.n.a value)] l.a r.a] + ?: (gor key p.n.a) + =+ d=$(a l.a) + ?> ?=(^ d) + ?: (vor p.n.a p.n.d) + [n.a d r.a] + [n.d l.d [n.a r.d r.a]] + =+ d=$(a r.a) + ?> ?=(^ d) + ?: (vor p.n.a p.n.d) + [n.a l.a d] + [n.d [n.a l.a l.d] r.d] + :: + ++ put-lookup-with-key + :> combines insertion with lookup in one pass. + :> + :> corresponds to {insertLookupWithKey} in haskell. + |* [a=(dict) key=* value=* fun=$-({* * *} *)] + |- ^- {(maybe _value) _a} + ?~ a + [~ [[key value] ~ ~]] + ?: =(key p.n.a) + :: key already exists; use {fun} to resolve. + [`q.n.a [[key (fun p.n.a q.n.a value)] l.a r.a]] + ?: (gor key p.n.a) + =+ rec=$(a l.a) + =+ d=+.rec + ?> ?=(^ d) + ?: (vor p.n.a p.n.d) + [-.rec [n.a d r.a]] + [-.rec [n.d l.d [n.a r.d r.a]]] + =+ rec=$(a r.a) + =+ d=+.rec + ?> ?=(^ d) + ?: (vor p.n.a p.n.d) + [-.rec [n.a l.a d]] + [-.rec [n.d [n.a l.a l.d] r.d]] + :: + :> # %delete-update + +| + :: + ++ delete + :> deletes entry at {key}. + |* [a=(dict) key=*] + |- ^+ a + ?~ a + ~ + ?. =(key p.n.a) + ?: (gor key p.n.a) + [n.a $(a l.a) r.a] + [n.a l.a $(a r.a)] + (pop-top a) + :: + ++ adjust + :> updates a value at {key} by passing the value to {fun}. + |* [a=(dict) key=* fun=$-(* *)] + %^ alter-with-key a key + |= [key=_p.-.n.-.a value=(maybe _q.+.n.-.a)] + ^- (maybe _q.+.n.-.a) + ?~ value ~ + [~ (fun u.value)] + :: + ++ adjust-with-key + :> updates a value at {key} by passing the key/value pair to {fun}. + |* [a=(dict) key=* fun=$-({* *} *)] + %^ alter-with-key a key + |= [key=_p.-.n.-.a value=(maybe _q.+.n.-.a)] + ^- (maybe _q.+.n.-.a) + ?~ value ~ + [~ (fun key u.value)] + :: + ++ update + :> adjusts or deletes the value at {key} by {fun}. + |* [a=(dict) key=* fun=$-(* (maybe *))] + %^ alter-with-key a key + |= [key=_p.-.n.-.a value=(maybe _q.+.n.-.a)] + ^- (maybe _q.+.n.-.a) + ?~ value ~ + (fun u.value) + :: + ++ update-with-key + :> adjusts or deletes the value at {key} by {fun}. + |* [a=(dict) key=* fun=$-({* *} (maybe *))] + %^ alter-with-key a key + |= [key=_p.-.n.-.a value=(maybe _q.+.n.-.a)] + ^- (maybe _q.+.n.-.a) + ?~ value ~ + (fun key u.value) + :: + :: todo: + :: ++update-lookup-with-key + :: + ++ alter + :> inserts, deletes, or updates a value by {fun}. + |* [a=(dict) key=* fun=$-((maybe *) (maybe *))] + %^ alter-with-key a key + |= [key=_p.-.n.-.a value=(maybe _q.+.n.-.a)] + (fun value) + :: + ++ alter-with-key + :> inserts, deletes, or updates a value by {fun}. + |* [a=(dict) key=* fun=$-({* (maybe *)} (maybe *))] + |- ^+ a + ?~ a + =+ ret=(fun key ~) + ?~ ret + ~ + [[key u.ret] ~ ~] + ?: =(key p.n.a) + =+ ret=(fun key `q.n.a) + ?~ ret + (pop-top a) + ?: =(u.ret q.n.a) + a + [[key u.ret] l.a r.a] + ?: (gor key p.n.a) + =+ d=$(a l.a) + ?~ d + [n.a ~ r.a] + ?: (vor p.n.a p.n.d) + [n.a d r.a] + [n.d l.d [n.a r.d r.a]] + =+ d=$(a r.a) + ?~ d + [n.a l.a ~] + ?: (vor p.n.a p.n.d) + [n.a l.a d] + [n.d [n.a l.a l.d] r.d] + :: + :> # %combine + +| + :: + ++ union + :> returns the union of {a} and {b}, preferring the value from {a} if dupe + |* [a=(dict) b=(dict)] + |- ^+ a + ?~ b + a + ?~ a + b + ?: (vor p.n.a p.n.b) + ?: =(p.n.b p.n.a) + [n.a $(a l.a, b l.b) $(a r.a, b r.b)] + ?: (gor p.n.b p.n.a) + $(a [n.a $(a l.a, b [n.b l.b ~]) r.a], b r.b) + $(a [n.a l.a $(a r.a, b [n.b ~ r.b])], b l.b) + ?: =(p.n.a p.n.b) + [n.b $(b l.b, a l.a) $(b r.b, a r.a)] + ?: (gor p.n.a p.n.b) + $(b [n.b $(b l.b, a [n.a l.a ~]) r.b], a r.a) + $(b [n.b l.b $(b r.b, a [n.a ~ r.a])], a l.a) + :: + ++ union-with + :> returns the union of {a} and {b}, running {fun} to resolve duplicates. + |* [a=(dict) b=(dict) fun=$-({* *} *)] + |- ^+ a + ?~ b + a + ?~ a + b + ?: (vor p.n.a p.n.b) + ?: =(p.n.b p.n.a) + [[p.n.a (fun q.n.a q.n.b)] $(a l.a, b l.b) $(a r.a, b r.b)] + ?: (gor p.n.b p.n.a) + $(a [n.a $(a l.a, b [n.b l.b ~]) r.a], b r.b) + $(a [n.a l.a $(a r.a, b [n.b ~ r.b])], b l.b) + ?: =(p.n.a p.n.b) + [n.b $(b l.b, a l.a) $(b r.b, a r.a)] + ?: (gor p.n.a p.n.b) + $(b [n.b $(b l.b, a [n.a l.a ~]) r.b], a r.a) + $(b [n.b l.b $(b r.b, a [n.a ~ r.a])], a l.a) + :: + ++ union-with-key + :> returns the union of {a} and {b}, running {fun} to resolve duplicates. + |* [a=(dict) b=(dict) fun=$-({* * *} *)] + |- ^+ a + ?~ b + a + ?~ a + b + ?: (vor p.n.a p.n.b) + ?: =(p.n.b p.n.a) + [[p.n.a (fun p.n.a q.n.a q.n.b)] $(a l.a, b l.b) $(a r.a, b r.b)] + ?: (gor p.n.b p.n.a) + $(a [n.a $(a l.a, b [n.b l.b ~]) r.a], b r.b) + $(a [n.a l.a $(a r.a, b [n.b ~ r.b])], b l.b) + ?: =(p.n.a p.n.b) + [n.b $(b l.b, a l.a) $(b r.b, a r.a)] + ?: (gor p.n.a p.n.b) + $(b [n.b $(b l.b, a [n.a l.a ~]) r.b], a r.a) + $(b [n.b l.b $(b r.b, a [n.a ~ r.a])], a l.a) + :: + :: TODO: this is untested; move it. +:: :: +:: ++ difference +:: :: todo: move real implementation here. +:: :> returns elements in {a} that don't exist in {b}. +:: |* [a=(dict) b=(dict)] +:: (~(dif by a) b) +:: :: +:: :: todo: +:: :: ++difference-with +:: :: ++difference-with-key +:: :: +:: ++ intersection +:: :: todo: move real implementation here. +:: :> returns elements in {a} that exist in {b}. +:: |* [a=(dict) b=(dict)] +:: (~(int by a) b) +:: :: +:: :: todo: +:: :: ++intersection-with +:: :: ++intersection-with-key + :: + :> # %traversal + +| + :: + ++ map + :> applies {fun} to each value in {a}. + |* [a=(dict) fun=$-(* *)] + ^- (dict _p.-.n.-.a fun) + ?~ a + ~ + [[p.n.a (fun q.n.a)] $(a l.a) $(a r.a)] + :: + ++ map-with-key + :> applies {fun} to each value in {a}. + |* [a=(dict) fun=$-({* *} *)] + ^- (dict _p.-.n.-.a _*fun) + ?~ a + ~ + [[p.n.a (fun p.n.a q.n.a)] $(a l.a) $(a r.a)] + :: + ++ map-fold + :> performs a fold on all the values in {a}. + :> + :> lists have an order, but dicts are treaps. this means there isn't a + :> horizontal ordering, and thus the distinction between left and right + :> folding isn't relevant. your accumulator function will be called in + :> treap order. + :> + :> corresponds to {mapAccum} in haskell. + |* [a=(dict) b=* fun=$-({* *} {* *})] + ^- {_b (dict _p.-.n.-.a _+:*fun)} + ?~ a + [b ~] + =+ d=(fun b q.n.a) + =. q.n.a +.d + =+ e=$(a l.a, b -.d) + =+ f=$(a r.a, b -.e) + [-.f [n.a +.e +.f]] + :: + ++ map-keys + :> applies {fun} to all keys. + :: todo: the haskell version specifies that the "greatest" original key + :: wins in case of duplicates. this is currently unhandled. maybe i just + :: shouldn't have this gate. + |* [a=(dict) fun=$-(* *)] + %- from-list + %+ map:ls (to-list a) + |= item/_n.-.a + [(fun p.item) q.item] + :: + ++ map-keys-with + :> applies {fun} to all keys, creating a new value with {combine} on dupes. + |* [a=(dict) fun=$-(* *) combine=$-({* *} *)] + ^- (dict _*fun _q.+.n.-.a) + =/ new-list + %+ map:ls (to-list a) + |= item/_n.-.a + [(fun p.item) q.item] + %^ foldl:ls new-list + `(dict _*fun _q.+.n.-.a)`~ + |= [m=(dict _*fun _q.+.n.-.a) p=_i.-.new-list] + (put-with m -.p +.p combine) + :: + ++ fold + :> performs a fold on all the values in {a}. + :> + :> lists have an order, but dicts are treaps. this means there isn't a + :> horizontal ordering, and thus the distinction between left and right + :> folding isn't relevant. your accumulator function will be called in + :> treap order. + |* [a=(dict) b=* fun=$-({* *} *)] + ^- _b + ?~ a + b + =+ d=(fun b q.n.a) + =+ e=$(a l.a, b d) + $(a r.a, b e) + :: + ++ fold-with-keys + :> performs a fold on all the values in {a}, passing keys too. + |* [a=(dict) b=* fun=$-({* * *} *)] + ^+ b + ?~ a + b + =+ d=(fun b p.n.a q.n.a) + =+ e=$(a l.a, b d) + $(a r.a, b e) + :: + ++ any + :> returns yes if any element satisfies the predicate + |* [a=(dict) b=$-(* ?)] + ^- ? + ?~ a + %.n + ?|((b q.n.a) $(a l.a) $(a r.a)) + :: + ++ any-with-key + :> returns yes if any element satisfies the predicate + |* [a=(dict) b=$-({* *} ?)] + ^- ? + ?~ a + %.n + ?|((b p.n.a q.n.a) $(a l.a) $(a r.a)) + :: + ++ all + :> returns yes if all elements satisfy the predicate + |* [a=(dict) b=$-(* ?)] + ^- ? + ?~ a + %.y + ?&((b q.n.a) $(a l.a) $(a r.a)) + :: + ++ all-with-key + :> returns yes if all elements satisfy the predicate + |* [a=(dict) b=$-({* *} ?)] + ^- ? + ?~ a + %.y + ?&((b p.n.a q.n.a) $(a l.a) $(a r.a)) + :: + :> # %conversion + +| + ++ elems + :> return all values in the dict. + |* a=(dict) + %+ turn (to-list a) second + :: + ++ keys + :> returns all keys in the dict. + |* a=(dict) + %+ turn (to-list a) first + :: + :: todo: ++assocs probably doesn't make sense when we have ++to-list and + :: when there's no general noun ordering. + :: + ++ keys-set + :> returns all keys as a set. + |* a=(dict) + (si:nl (keys a)) + :: + ++ from-set + :> computes a dict by running {fun} on every value in a set. + |* [a=(set) fun=$-(* *)] + ^- (dict _n.-.a _*fun) + ?~ a + ~ + [[n.a (fun n.a)] $(a l.a) $(a r.a)] + :: + :> # %lists + +| + :: + ++ to-list + :> creates a list of pairs from the tree. + |* a=(dict) + =| b=(list _n.-.a) + |- + ^+ b + ?~ a + b + $(a r.a, b [n.a $(a l.a)]) + :: + ++ from-list + :> creates a tree from a list. + |* a=(list (pair)) + |- + %^ foldl:ls a + `(dict _p.-.i.-.a _q.+.i.-.a)`~ + |= [m=(dict _p.-.i.-.a _q.+.i.-.a) p=_i.-.a] + (put m p) + :: + ++ from-list-with + :> creates a dict from a list, with {fun} resolving duplicates. + |* [a=(list (pair)) fun=$-(* *)] + %^ foldl:ls a + `(dict _*fun _q.+.i.-.a)`~ + |= [m=(dict _*fun _q.+.i.-.a) p=_i.-.a] + (put-with m -.p +.p fun) + :: + :: todo: without a natural ordering, association lists and gates to operate + :: on them probably don't make sense. i'm skipping them for now. + :: + :> # %filters + +| + ++ filter + :> filters a dict of all values that satisfy {fun}. + |* [a=(dict) fun=$-(* ?)] + %+ filter-with-key a + |= [key=* value=_q.+.n.-.a] + (fun value) + :: + ++ filter-with-key + :> filters a dict of all values that satisfy {fun}. + |* [a=(dict) fun=$-({* *} ?)] + |- + ^+ a + ?~ a ~ + ?: (fun n.a) + =. l.a $(a l.a) + =. r.a $(a r.a) + (pop-top a) + [n.a $(a l.a) $(a r.a)] + :: + ++ restrict-keys + :> returns a dict where the only allowable keys are {keys}. + |* [a=(dict) keys=(set)] + %+ filter-with-key a + |= [key=_p.-.n.-.a value=*] + :: todo: replace this with a call to our set library when we advance that + :: far. + !(~(has in keys) key) + :: + ++ without-keys + :> returns a dict where the only allowable keys are not in {keys}. + |* [a=(dict) keys=(set)] + %+ filter-with-key a + |= [key=_p.-.n.-.a value=*] + :: todo: replace this with a call to our set library when we advance that + :: far. + (~(has in keys) key) + :: + ++ partition + :> returns two lists, one whose elements match {fun}, the other doesn't. + |* [a=(dict) fun=$-(* ?)] + :: todo: is the runtime on this is bogus? + =/ data + %+ partition:ls (to-list a) + |= p/_n.-.a + (fun q.p) + [(from-list -.data) (from-list +.data)] + :: + :: todo: ++partition-with-key once ++partition works. + :: + :: i'm going to ignore all the Antitone functions; they don't seem to be + :: useful without ordering on the dict. + :: + ++ map-maybe + :> a version of map that can throw out items. + |* [a=(dict) fun=$-(* (maybe))] + %+ map-maybe-with-key a + |= [key=* value=_q.+.n.-.a] + (fun value) + :: + ++ map-maybe-with-key + :> a version of map that can throw out items. + |* [a=(dict) fun=$-({* *} (maybe))] + ^- (dict _p.-.n.-.a _+:*fun) + ?~ a ~ + =+ res=(fun n.a) + ?~ res + =. l.a $(a l.a) + =. r.a $(a r.a) + (pop-top a) + [[p.n.a +.res] $(a l.a) $(a r.a)] + :: + ++ map-either + :> splits the dict in two on a gate that returns an either. + |* [a=(dict) fun=$-(* (either))] + %+ map-either-with-key a + |= [key=* value=_q.+.n.-.a] + (fun value) + :: + ++ map-either-with-key + :> splits the dict in two on a gate that returns an either. + |* [a=(dict) fun=$-({* *} (either))] + |- + ^- $: (dict _p.-.n.-.a _?>(?=({{%& *} *} *fun) +:*fun)) + (dict _p.-.n.-.a _?>(?=({{%| *} *} *fun) +:*fun)) + == + ?~ a + [~ ~] + :: todo: runtime wise, can I do better than recursive unions? + =+ lr=$(a l.a) + =+ rr=$(a r.a) + =+ x=(fun n.a) + ~! x + ?- -.x + $& [(put (union -.lr -.rr) p.n.a +.x) (union +.lr +.rr)] + $| [(union -.lr -.rr) (put (union +.lr +.rr) p.n.a +.x)] + == + :: + :: ++split, ++split-lookup and ++split-root do not make sense without + :: ordinal keys. + :: + ++ is-subdict + :> returns %.y if every element in {a} exists in {b} with the same value. + |* [a=(dict) b=(dict)] + ^- ? + (is-subdict-by a b |=([a=* b=*] =(a b))) + :: + ++ is-subdict-by + :> returns %.y if every element in {a} exists in {b} with the same value. + |* [a=(dict) b=(dict) fun=$-({* *} ?)] + |- + ^- ? + ?~ a %.y + ?~ b %.n + ~! b + ~! p.n.a + =+ x=(get b p.n.a) + ?~ x %.n + |((fun q.n.a u.x) $(a l.a) $(a r.a)) + :: + :> # %impl + :> implementation details + +| + ++ pop-top + :> removes the head of the tree and rebalances the tree below. + |* a=(dict) + ^- {$?($~ _a)} + ?~ a ~ + |- + ?~ l.a r.a + ?~ r.a l.a + ?: (vor p.n.l.a p.n.r.a) + [n.l.a l.l.a $(l.a r.l.a)] + [n.r.a $(r.a l.r.a) r.r.a] + :: + ++ valid + :> returns %.y if {a} if this tree is a valid treap dict. + |* a=(tree (pair * *)) + =| [l=(maybe) r=(maybe)] + |- ^- ? + ?~ a & + ?& ?~(l & (gor p.n.a u.l)) + ?~(r & (gor u.r p.n.a)) + ?~(l.a & ?&((vor p.n.a p.n.l.a) $(a l.a, l `p.n.a))) + ?~(r.a & ?&((vor p.n.a p.n.r.a) $(a r.a, r `p.n.a))) + == + -- +++ random + :> produces a core which produces random numbers. + :> + :> random numbers are generated through repeated sha-256 operations. + :> + :> this design forces implementation details to be hidden, forces users to + :> go through =^. this should be less error prone for pulling out multiple + :> random numbers, at the cost of making getting a single random number + :> slightly more cumbersome. + :> + :> =+ gen=(random eny) + :> =^ first gen (range:gen 0 10) + :> =^ second gen (range:gen 0 10) + |= a=@ + => |% + ++ raw :: random bits + |= b=@ ^- @ + %+ can + 0 + =+ c=(shas %og-a (mix b a)) + |- ^- (list {@ @}) + ?: =(0 b) + ~ + =+ d=(shas %og-b (mix b (mix a c))) + ?: (lth b 256) + [[b (end 0 b d)] ~] + [[256 d] $(c d, b (sub b 256))] + :: + ++ rad :: random in range + |= b=@ ^- @ + =+ c=(raw (met 0 b)) + ?:((lth c b) c $(a +(a))) + -- + ^? |% + ++ range + :> returns a random number in the range [start, end], and generator. + |= [start=@ end=@] + ?: (gte start end) + ~_(leaf+"invalid range" !!) + =+ offset=(sub end start) + =+ r=(rad offset) + [(add start r) +>.$(a (shas %og-s (mix a r)))] + :: + ++ bits + :> returns {b} bits in the range, and generator. + |= b=@ + =+ r=(raw b) + [r +>.$(a (shas %og-s (mix a r)))] + -- +-- diff --git a/lib/tester.hoon b/lib/tester.hoon new file mode 100644 index 000000000..16ba5c21c --- /dev/null +++ b/lib/tester.hoon @@ -0,0 +1,165 @@ +/+ new-hoon +:: +:> testing utilities +|% +:> # %models ++| ++= tests + :> a hierarchical structure of tests + :> + :> a recursive association list mapping a part of a path + :> to either a test trap or a sublist of the same type. + (list instance) +:: ++= instance + :> a mapping between a term and part of a test tree. + (pair term (each $-(@uvJ (list tape)) tests)) +:: +:> # %generate +:> utilities for generating ++tests from files and directories. ++| +++ merge-base-and-recur + :> combine the current file and subdirectory. + :> + :> this merges the file {base} with its child files {recur}. + |= [base=vase recur=(map @ta tests:tester)] + ^- tests + =+ a=(gen-tests base) + =+ b=(test-map-to-test-list recur) + :: todo: why does ++weld not work here? {a} and {b} are cast and have the + :: correct faces. + (welp a b) +:: +++ test-map-to-test-list + :> translates ford output to something we can work with. + :> + :> ford gives us a `(map @ta tests:tester)`, but we actually + :> want something like ++tests. + |= a=(map @ta tests:tester) + :: todo: i'd like to sort this, but ++sort has -find.a problems much like + :: ++weld does above!? + ^- tests + %+ turn + (to-list:dct:new-hoon a) + |= {key/@ta value/tests:tester} + [key [%| value]] +:: +++ gen-tests + :> creates a {tests} list out of a vase of a test suite + |= v=vase + ^- tests + =+ arms=(sort (sloe p.v) aor) + %+ turn arms + |= arm/term + :- arm + :- %& + |= eny=@uvJ + =+ context=(slop !>((init-test eny)) v) + =/ r (slap context [%cnsg [arm ~] [%$ 3] [[%$ 2] ~]]) + ((hard (list tape)) q:(slap r [%limb %results])) +:: +:> # %per-test +:> data initialized on a per-test basis. +:: +++ init-test + |= {cookie/@uvJ} + ~(. tester `(list tape)`~ cookie 10 0) +:: +++ tester-type _(init-test `@uvJ`0) +:: +++ tester + |_ $: error-lines=(list tape) :< output messages + eny=@uvJ :< entropy + check-iterations=@u :< # of check trials + current-iteration=@u :< current iteration + == + :> # + :> # %check + :> # + :> gates for quick check style tests. + +| + +- check + |* [generator=$-(@uvJ *) test=$-(* ?)] + |- + ^+ +>.$ + ?: (gth current-iteration check-iterations) + +>.$ + :: todo: wrap generator in mule so it can crash. + =+ sample=(generator eny) + :: todo: wrap test in mule so it can crash. + =+ ret=(test sample) + ?: ret + %= $ + eny (shaf %huh eny) :: xxx: better random? + current-iteration (add current-iteration 1) + == + =+ case=(add 1 current-iteration) + =+ case-plural=?:(=(case 1) "case" "cases") + %= +>.$ + error-lines :* + "falsified after {(noah !>(case))} {case-plural} by '{(noah !>(sample))}'" + error-lines + == + == + :: + :: todo: a generate function that takes an arbitrary span. + :: + ++ generate-range + |= [min=@ max=@] + |= c=@uvJ + ^- @ + =+ gen=(random:new-hoon c) + =^ num gen (range:gen min max) + num + :: + ++ generate-dict + :> generator which will produce a dict with {count} random pairs. + |= count=@u + :> generate a dict with entropy {c}. + |= c=@uvJ + :> + :> gen: stateful random number generator + :> out: resulting map + :> i: loop counter + :> + =/ gen (random:new-hoon c) + =| out=(dict:new-hoon @ud @ud) + =| i=@u + |- + ^- (dict:new-hoon @ud @ud) + ?: =(i count) + out + =^ first gen (range:gen 0 100) + =^ second gen (range:gen 0 100) + $(out (put:dct:new-hoon out first second), i +(i)) + :> # + :> # %test + :> # + :> test expectation functions + +| + :: todo: unit testing libraries have a lot more to them than just eq. + ++ expect-eq + |* [a=* b=* c=tape] + ^+ +> + ?: =(a b) + +>.$ + %= +>.$ + error-lines :* + "failure: '{c}'" + " actual: '{(noah !>(a))}'" + " expected: '{(noah !>(b))}'" + error-lines + == + == + :: + :> # + :> # %output + :> # + :> called by the test harness + :: + ++ results + :> returns results. + ^- (list tape) + error-lines + -- +-- diff --git a/mar/unicode-data.hoon b/mar/unicode-data.hoon new file mode 100644 index 000000000..61564ffa7 --- /dev/null +++ b/mar/unicode-data.hoon @@ -0,0 +1,79 @@ +/- unicode-data +=, eyre +=, format +:: +|_ all/(list line:unicode-data) +++ grab + :> converts from mark to unicode-data. + |% + ++ mime |=([* a=octs] (txt (to-wain q.a))) :: XX mark translation + ++ txt + |^ |= a=wain + ^+ all + %+ murn a + |= b=cord + ^- (unit line:unicode-data) + ?~ b ~ + `(rash b line) + :: + :> parses a single character information line of the unicode data file. + ++ line + ;~ (glue sem) + hex :: code/@c codepoint in hex format + name-string :: name/tape character name + general-category :: gen/general type of character + (bass 10 (plus dit)) :: can/@ud canonical combining class + bidi-category :: bi/bidi bidirectional category + decomposition-mapping :: de/decomp decomposition mapping + :: + :: todo: decimal/digit/numeric need to be parsed. + :: + string-number :: decimal/tape decimal digit value (or ~) + string-number :: digit/tape digit value, even if non-decimal + string-number :: numeric/tape numeric value, including fractions + :: + (flag 'Y' 'N') :: mirrored/? is char mirrored in bidi text? + name-string :: old-name/tape unicode 1.0 compatibility name + name-string :: iso/tape iso 10646 comment field + (punt hex) :: up/(unit @c) uppercase mapping codepoint + (punt hex) :: low/(unit @c) lowercase mapping codepoint + (punt hex) :: title/(unit @c) titlecase mapping codepoint + == + :: + :> parses a single name or comment string. + ++ name-string + %+ cook + |=(a=tape a) + (star ;~(less sem prn)) + :: + :> parses a unicode general category abbreviation to symbol + ++ general-category + %+ sear (soft general:unicode-data) + :(cook crip cass ;~(plug hig low (easy ~))) + :: + :> parses a bidirectional category abbreviation to symbol. + ++ bidi-category + %+ sear (soft bidi:unicode-data) + :(cook crip cass (star hig)) + :: + ++ decomposition-mapping + %- punt :: optional + :: a tag and a list of characters to decompose to + ;~ plug + (punt (ifix [gal ;~(plug gar ace)] decomp-tag)) + (cook |=(a=(list @c) a) (most ace hex)) + == + :: + ++ decomp-tag + %+ sear (soft decomp-tag:unicode-data) + :(cook crip cass (star alf)) + :: + ++ string-number + %+ cook + |=(a=tape a) + (star ;~(pose nud fas hep)) + :: + -- + -- +++ grad %txt +-- diff --git a/ren/test-tree.hoon b/ren/test-tree.hoon new file mode 100644 index 000000000..57d0ec80d --- /dev/null +++ b/ren/test-tree.hoon @@ -0,0 +1,10 @@ +/+ tester +/= base /| /!noun/ + /~ ~ + == +/= recur /^ (map @ta tests:tester) + /| /_ /test-tree/ + /~ ~ + == +:: +(merge-base-and-recur:tester !>(base) recur) diff --git a/sur/unicode-data.hoon b/sur/unicode-data.hoon new file mode 100644 index 000000000..a333455c8 --- /dev/null +++ b/sur/unicode-data.hoon @@ -0,0 +1,150 @@ +|% +:> # %unicode-data +:> types to represent UnicdoeData.txt. ++| +++ line + :> an individual codepoint definition + :> + $: code=@c :< codepoint in hexadecimal format + name=tape :< character name + gen=general :< type of character this is + :> canonical combining class for ordering algorithms + can=@ud + bi=bidi :< bidirectional category of this character + de=decomp :< character decomposition mapping + :: todo: decimal/digit/numeric need to be parsed. + decimal=tape :< decimal digit value (or ~) + digit=tape :< digit value, covering non decimal radix forms + numeric=tape :< numeric value, including fractions + mirrored=? :< whether char is mirrored in bidirectional text + old-name=tape :< unicode 1.0 compatibility name + iso=tape :< iso 10646 comment field + up=(unit @c) :< uppercase mapping codepoint + low=(unit @c) :< lowercase mapping codepoint + title=(unit @c) :< titlecase mapping codepoint + == +:: +++ general + :> one of the normative or informative unicode general categories + :> + :> these abbreviations are as found in the unicode standard, except + :> lowercased as to be valid symbols. + $? $lu :< letter, uppercase + $ll :< letter, lowercase + $lt :< letter, titlecase + $mn :< mark, non-spacing + $mc :< mark, spacing combining + $me :< mark, enclosing + $nd :< number, decimal digit + $nl :< number, letter + $no :< number, other + $zs :< separator, space + $zl :< separator, line + $zp :< separator, paragraph + $cc :< other, control + $cf :< other, format + $cs :< other, surrogate + $co :< other, private use + $cn :< other, not assigned + :: + $lm :< letter, modifier + $lo :< letter, other + $pc :< punctuation, connector + $pd :< punctuation, dash + $ps :< punctuation, open + $pe :< punctuation, close + $pi :< punctuation, initial quote + $pf :< punctuation, final quote + $po :< punctuation, other + $sm :< symbol, math + $sc :< symbol, currency + $sk :< symbol, modifier + $so :< symbol, other + == +:: +++ bidi + :> bidirectional category of a unicode character + $? $l :< left-to-right + $lre :< left-to-right embedding + $lri :< left-to-right isolate + $lro :< left-to-right override + $fsi :< first strong isolate + $r :< right-to-left + $al :< right-to-left arabic + $rle :< right-to-left embedding + $rli :< right-to-left isolate + $rlo :< right-to-left override + $pdf :< pop directional format + $pdi :< pop directional isolate + $en :< european number + $es :< european number separator + $et :< european number terminator + $an :< arabic number + $cs :< common number separator + $nsm :< non-spacing mark + $bn :< boundary neutral + $b :< paragraph separator + $s :< segment separator + $ws :< whitespace + $on :< other neutrals + == +:: +++ decomp + :> character decomposition mapping. + :> + :> tag: type of decomposition. + :> c: a list of codepoints this decomposes into. + (unit {tag/(unit decomp-tag) c/(list @c)}) +:: +++ decomp-tag + :> tag that describes the type of a character decomposition. + $? $font :< a font variant + $nobreak :< a no-break version of a space or hyphen + $initial :< an initial presentation form (arabic) + $medial :< a medial presentation form (arabic) + $final :< a final presentation form (arabic) + $isolated :< an isolated presentation form (arabic) + $circle :< an encircled form + $super :< a superscript form + $sub :< a subscript form + $vertical :< a vertical layout presentation form + $wide :< a wide (or zenkaku) compatibility character + $narrow :< a narrow (or hankaku) compatibility character + $small :< a small variant form (cns compatibility) + $square :< a cjk squared font variant + $fraction :< a vulgar fraction form + $compat :< otherwise unspecified compatibility character + == +:: +:> # +:> # %case-map +:> # +:> types to represent fast lookups of case data ++| +++ case-offset + :> case offsets can be in either direction + $% :> add {a} to get the new character + [%add a=@u] + :> subtract {a} to get the new character + [%sub s=@u] + :> take no action; return self + [%none $~] + :> represents series of alternating uppercase/lowercase characters + [%uplo $~] + == +:: +++ case-node + :> a node in a case-tree. + :> + :> represents a range of + $: start=@ux + end=@ux + upper=case-offset + lower=case-offset + title=case-offset + == +:: +++ case-tree + :> a binary search tree of ++case-node items, sorted on span. + (tree case-node) +-- diff --git a/tests/new-hoon/ls.hoon b/tests/new-hoon/ls.hoon new file mode 100644 index 000000000..e334bc4c6 --- /dev/null +++ b/tests/new-hoon/ls.hoon @@ -0,0 +1,280 @@ +/+ new-hoon, tester +=, ls:new-hoon +|_ tester-type:tester +++ test-head + (expect-eq (head [1 ~]) 1 "head") +:: +++ test-last + (expect-eq (last:ls [1 2 ~]) 2 "last") +:: +++ test-tail + (expect-eq (tail [1 2 3 ~]) [2 3 ~] "tail") +:: +++ test-init + (expect-eq (init [1 2 3 ~]) [1 2 ~] "init") +:: +++ test-size + (expect-eq (size ['a' 'b' 'c' ~]) 3 "size") +:: +++ test-map + (expect-eq (map:ls [1 2 ~] |=(a/@ (add 1 a))) [2 3 ~] "map") +:: +++ test-reverse + (expect-eq (reverse [1 2 3 ~]) [3 2 1 ~] "reverse") +:: +++ test-intersperse + (expect-eq (intersperse 1 [5 5 5 ~]) [5 1 5 1 5 ~] "intersperse") +:: +++ test-intercalate + %^ expect-eq + (intercalate "," ["one" "two" "three" ~]) + ["one,two,three"] + "intercalate" +:: +++ test-transpose + %^ expect-eq + (transpose ~[~[1 2 3] ~[4 5 6]]) + ~[~[1 4] ~[2 5] ~[3 6]] + "transpose" +:: +++ test-foldl + (expect-eq (foldl [1 2 3 ~] 3 |=({a/@ b/@} (add a b))) 9 "foldl") +:: +++ test-foldr + (expect-eq (foldr [1 2 3 ~] 1 |=({a/@ b/@} (add a b))) 7 "foldr") +:: +++ test-concat + (expect-eq (concat ~[~[1 2] ~[3 4]]) ~[1 2 3 4] "concat") +:: +++ test-weld + (expect-eq (weld:ls ~[1 2 3] ~["one" "two"]) ~[1 2 3 "one" "two"] "weld") +:: +++ test-any-true + (expect-eq (any [1 2 3 ~] |=(a/@ =(a 2))) %.y "any true") +:: +++ test-any-false + (expect-eq (any [1 2 3 ~] |=(a/@ =(a 8))) %.n "any false") +:: +++ test-all-true + (expect-eq (all [1 1 1 ~] |=(a/@ =(a 1))) %.y "all true") +:: +++ test-all-false + (expect-eq (all [1 3 1 ~] |=(a/@ =(a 1))) %.n "all false") +:: +++ test-scanl + %^ expect-eq + (scanl ~[1 2 3] 0 |=({a/@ b/@} (add a b))) + ~[0 1 3 6] + "scanl" +:: +++ test-scanl1 + %^ expect-eq + (scanl1 ~[1 2 3] |=({a/@ b/@} (add a b))) + ~[1 3 6] + "scanl1" +:: +++ test-scanr + %^ expect-eq + (scanr ~[1 2 3] 0 |=({a/@ b/@} (add a b))) + ~[6 5 3 0] + "scanr" +:: +++ test-scanr1 + %^ expect-eq + (scanr1 ~[1 2 3] |=({a/@ b/@} (add a b))) + ~[6 5 3] + "scanr1" +:: +++ test-map-foldl + %^ expect-eq + (map-foldl ~[1 2 3] 1 |=({a/@ b/@} [(add a b) (add 1 a)])) + [7 ~[2 3 5]] + "map-foldl" +:: +++ test-map-foldr + %^ expect-eq + (map-foldr ~[1 2 3] 1 |=({a/@ b/@} [(add a b) (add 1 a)])) + [7 ~[7 5 2]] + "map-foldr" +:: +++ test-unfoldr + %^ expect-eq + (unfoldr 5 |=(a/@ ?:(=(a 0) ~ `[a (dec a)]))) + [5 4 3 2 1 ~] + "unfoldr" +:: +++ test-take + %^ expect-eq + (take 3 ~[1 2 3 4 5]) + [1 2 3 ~] + "take" +:: +++ test-drop + %^ expect-eq + (drop:ls 3 ~[1 2 3 4 5]) + [4 5 ~] + "drop" +:: +++ test-split-at + %^ expect-eq + (split-at 3 ~[1 2 3 4 5]) + [[1 2 3 ~] [4 5 ~]] + "split-at" +:: +++ test-take-while + %^ expect-eq + (take-while ~[1 2 3 4 5] |=(a/@ (lth a 3))) + [1 2 ~] + "take-while" +:: +++ test-drop-while + %^ expect-eq + (drop-while ~[1 2 3 4 5] |=(a/@ (lth a 3))) + [3 4 5 ~] + "drop-while" +:: +++ test-drop-while-end + %^ expect-eq + (drop-while-end ~[5 5 1 5 5] |=(a/@ =(a 5))) + [5 5 1 ~] + "drop-while-end" +:: +++ test-split-on + %^ expect-eq + (split-on ~[1 2 3 4 1 2 3 4] |=(a/@ (lth a 3))) + [[1 2 ~] [3 4 1 2 3 4 ~]] + "split-on" +:: +++ test-break + %^ expect-eq + (break ~[1 2 3 4 1 2 3 4] |=(a/@ (gth a 3))) + [[1 2 3 ~] [4 1 2 3 4 ~]] + "break" +:: +++ test-strip-prefix + %^ expect-eq + (strip-prefix "foo" "foobar") + [~ "bar"] + "break" +:: +++ test-inits + %^ expect-eq + (inits "abc") + ["a" "ab" "abc" ~] + "inits" +:: +++ test-tails + %^ expect-eq + (tails "abc") + ["abc" "bc" "c" ~] + "tails" +:: +++ test-is-prefix-of + %^ expect-eq + (is-prefix-of "foo" "foobar") + %.y + "is-prefix-of" +:: +++ test-is-suffix-of + %^ expect-eq + (is-suffix-of "bar" "foobar") + %.y + "is-suffix-of" +:: +++ test-is-infix-of + %^ expect-eq + (is-infix-of "ob" "foobar") + %.y + "is-infix-of" +:: +++ test-elem + %^ expect-eq + (elem 5 [1 2 3 4 5 ~]) + %.y + "elem" +:: +++ test-lookup + %^ expect-eq + (lookup "two" [["one" 1] ["two" 2] ["three" 3] ~]) + [~ 2] + "lookup" +:: +++ test-find + %^ expect-eq + (find:ls [3 2 1 5 1 2 3 ~] |=(a/@ (gth a 3))) + [~ 5] + "find" +:: +++ test-filter + %^ expect-eq + (filter [1 2 1 2 1 ~] |=(a/@ =(a 2))) + [1 1 1 ~] + "filter" +:: +++ test-partition + %^ expect-eq + (partition [1 2 1 2 1 ~] |=(a/@ =(a 2))) + [[2 2 ~] [1 1 1 ~]] + "partition" +:: +++ test-elem-index + %^ expect-eq + (elem-index 2 [1 2 3 4 ~]) + `1 + "elem-index" +:: +++ test-elem-indices + %^ expect-eq + (elem-indices 2 [1 2 1 2 ~]) + [1 3 ~] + "elem-indices" +:: +++ test-find-index + %^ expect-eq + (find-index [1 2 3 ~] |=(a/@ =(a 2))) + `1 + "find-index" +:: +++ test-find-indices + %^ expect-eq + (find-indices [1 2 1 2 ~] |=(a/@ =(a 2))) + [1 3 ~] + "find-indices" +:: +++ test-zip + %^ expect-eq + (zip [[1 2 3 ~] [4 5 6 ~] [7 8 9 ~] ~]) + [[1 4 7 ~] [2 5 8 ~] [3 6 9 ~] ~] + "zip" +:: +++ test-unique + %^ expect-eq + (unique [1 2 3 1 2 3 ~]) + [1 2 3 ~] + "unique" +:: +++ test-delete + %^ expect-eq + (delete 2 [1 2 3 2 ~]) + [1 3 2 ~] + "delete" +:: +++ test-delete-firsts + %^ expect-eq + (delete-firsts [1 2 2 2 3 4 5 ~] [2 2 5 ~]) + [1 2 3 4 ~] + "delete-firsts" +:: +++ test-union + %^ expect-eq + (union [1 2 3 ~] [4 2 5 ~]) + [1 2 3 4 5 ~] + "union" +:: +++ test-intersect + %^ expect-eq + (intersect [5 6 6 7 8 ~] [9 8 8 6 ~]) + [6 6 8 ~] + "intersect" +-- + diff --git a/tests/new-hoon/mp.hoon b/tests/new-hoon/mp.hoon new file mode 100644 index 000000000..af75fdb9e --- /dev/null +++ b/tests/new-hoon/mp.hoon @@ -0,0 +1,360 @@ +/+ new-hoon, tester +=, dct:new-hoon +=+ four=(from-list [[1 "one"] [2 "two"] [3 "three"] [4 "four"] ~]) +=+ three=(from-list [[1 "one"] [2 "two"] [3 "three"] ~]) +|_ tester-type:tester +++ test-empty + (expect-eq (empty four) %.n "empty") +:: +++ test-size + (expect-eq (size four) 4 "size") +:: +++ test-member + (expect-eq (member four 4) %.y "member") +:: +++ test-put-with + =+ ints=(from-list [["one" 1] ["two" 2] ["three" 3] ["four" 4] ~]) + %^ expect-eq + (put-with ints "three" 2 add) + (from-list [["one" 1] ["two" 2] ["three" 5] ["four" 4] ~]) + "put-with" +:: +++ test-put-with-key + %^ expect-eq + (put-with-key four 4 "four" |=({a/@ud b/tape c/tape} (weld (scow %ud a) b))) + (from-list [[1 "one"] [2 "two"] [3 "three"] [4 "4four"] ~]) + "put-with-key" +:: +++ test-put-lookup-with-key + %^ expect-eq + %- put-lookup-with-key :^ + four + 4 + "five" + |=({key/@ud old/tape new/tape} new) + :- `"four" + (from-list [[1 "one"] [2 "two"] [3 "three"] [4 "five"] ~]) + "put-lookup-with-key" +:: +++ test-delete + %^ expect-eq + (delete four 4) + three + "delete" +:: +++ test-adjust + %^ expect-eq + %^ adjust + four + 3 + |=(a/tape (weld "this" a)) + (from-list [[1 "one"] [2 "two"] [3 "thisthree"] [4 "four"] ~]) + "adjust" +:: +++ test-adjust-with-key + %^ expect-eq + %^ adjust-with-key + four + 3 + |=({a/@ud b/tape} (weld (scow %ud a) b)) + (from-list [[1 "one"] [2 "two"] [3 "3three"] [4 "four"] ~]) + "adjust-with-key" +:: +++ test-update + %^ expect-eq + %^ update + four + 3 + |=(a/tape `(maybe tape)`~) + (from-list [[1 "one"] [2 "two"] [4 "four"] ~]) + "update" +:: +++ test-update-with-key + %^ expect-eq + %^ update-with-key + four + 3 + |=({a/@u b/tape} `(maybe tape)`[~ (weld (scow %ud a) b)]) + (from-list [[1 "one"] [2 "two"] [3 "3three"] [4 "four"] ~]) + "update-with-key" +:: +++ test-alter-as-add + %^ expect-eq + %^ alter + four + 5 + |=(a/(maybe tape) `(maybe tape)`[~ "five"]) + (from-list [[1 "one"] [2 "two"] [3 "three"] [4 "four"] [5 "five"] ~]) + "alter (as add)" +:: +++ test-alter-as-delete + %^ expect-eq + %^ alter + four + 2 + |=(a/(maybe tape) `(maybe tape)`~) + (from-list [[1 "one"] [3 "three"] [4 "four"] ~]) + "alter (as delete)" +:: +++ test-alter-as-change + %^ expect-eq + %^ alter + four + 2 + |=(a/(maybe tape) `(maybe tape)`[~ "dos"]) + (from-list [[1 "one"] [2 "dos"] [3 "three"] [4 "four"] ~]) + "alter (as change)" +:: +++ check-alter + :: check random dicts of 50 items with 40 random operations done on them + :: for validity. + %+ check + (generate-dict 50) + |= a/(dict @ud @ud) + :: this is dumb, but use {a} as entropy? + =/ gen (random:new-hoon (jam a)) + =| i/@u + |- + ?: =(i 40) + %.y + =^ key gen (range:gen 0 100) + =^ value gen (range:gen 0 100) + =. a %^ alter-with-key a key + |= {key/@ud current/(maybe @ud)} + ^- (maybe @ud) + =+ action=(mod key 2) + ?: =(action 0) :: return nothing + ~ + ?: =(action 1) :: add/set value + `value + ~ :: impossible + ?. (valid a) + %.n + $(i +(i)) +:: +++ test-union + %^ expect-eq + %+ union + (from-list [[1 "left"] [2 "left"] ~]) + (from-list [[2 "right"] [3 "right"] ~]) + (from-list [[1 "left"] [2 "left"] [3 "right"] ~]) + "union" +:: +++ test-union-with + %^ expect-eq + %^ union-with + (from-list [[1 "left"] [2 "left"] ~]) + (from-list [[2 "right"] [3 "right"] ~]) + |=({a/tape b/tape} (weld a b)) + (from-list [[1 "left"] [2 "leftright"] [3 "right"] ~]) + "union-with" +:: +++ test-union-with-key + %^ expect-eq + %^ union-with-key + (from-list [[1 "left"] [2 "left"] ~]) + (from-list [[2 "right"] [3 "right"] ~]) + |=({a/@ud b/tape c/tape} :(weld `tape`(scow %ud a) b c)) + (from-list [[1 "left"] [2 "2leftright"] [3 "right"] ~]) + "union-with-key" +:: +++ test-map + %^ expect-eq + %+ map:dct + three + crip + (from-list [[1 'one'] [2 'two'] [3 'three'] ~]) + "map" +:: +++ test-map-with-key + %^ expect-eq + %+ map-with-key + three + |=({a/@u b/tape} (weld (scow %ud a) b)) + (from-list [[1 "1one"] [2 "2two"] [3 "3three"] ~]) + "map-with-key" +:: +++ test-map-fold + %^ expect-eq + %^ map-fold + three + "Everything: " + |= {accumulator/tape value/tape} + [(weld accumulator value) (weld value "X")] + :- "Everything: twoonethree" + (from-list [[1 "oneX"] [2 "twoX"] [3 "threeX"] ~]) + "map-fold" +:: +++ test-map-keys + %^ expect-eq + %+ map-keys + three + |= a/@u + (add a 10) + (from-list [[11 "one"] [12 "two"] [13 "three"] ~]) + "map-keys" +:: +++ test-map-keys-with + %^ expect-eq + %^ map-keys-with + three + |=(a/@u 42) + weld + (from-list [[42 "twothreeone"] ~]) + "map-keys-with" +:: +++ test-fold + %^ expect-eq + %^ fold + three + "Everything: " + :: todo: this works but replacing with just ++weld causes an out of loom. + |= {accumulator/tape value/tape} + ^- tape + (weld accumulator value) + "Everything: twoonethree" + "map-fold" +:: +++ test-fold-with-keys + %^ expect-eq + %^ fold-with-keys + three + "Everything: " + |= {accumulator/tape key/@u value/tape} + ^- tape + :(weld accumulator (scow %ud key) value) + "Everything: 2two1one3three" + "map-fold-with-keys" +:: +++ test-elems + %^ expect-eq + (elems three) + ["two" "three" "one" ~] + "elems" +:: +++ test-keys + %^ expect-eq + (keys three) + [2 3 1 ~] + "keys" +:: +++ test-keys-set + %^ expect-eq + (keys-set three) + (si:nl [2 3 1 ~]) + "keys-set" +:: +++ test-from-set + %^ expect-eq + %+ from-set + (si:nl [1 2 3 ~]) + |= a/@u + (scow %ud a) + (from-list [[1 "1"] [2 "2"] [3 "3"] ~]) + "from-set" +:: +++ test-from-list-with + %^ expect-eq + %+ from-list-with + [[1 1] [2 1] [2 1] [3 3] ~] + add + (from-list [[1 1] [2 2] [3 3] ~]) + "from-list-with" +:: +++ test-filter + %^ expect-eq + %+ filter + (from-list [[1 1] [2 1] [3 2] [4 1] ~]) + |=(a/@u !=(a 1)) + (from-list [[1 1] [2 1] [4 1] ~]) + "filter" +:: +++ test-filter-with-key + %^ expect-eq + %+ filter-with-key + (from-list [[1 1] [2 1] [3 2] [4 1] ~]) + |=({a/@u b/@u} =(a 2)) + (from-list [[1 1] [3 2] [4 1] ~]) + "filter-with-key" +:: +++ test-restrict-keys + %^ expect-eq + %+ restrict-keys + (from-list [[1 1] [2 2] [3 3] [4 4] [5 5] ~]) + (si:nl [1 3 5 ~]) + (from-list [[1 1] [3 3] [5 5] ~]) + "restrict-keys" +:: +++ test-without-keys + %^ expect-eq + %+ without-keys + (from-list [[1 1] [2 2] [3 3] [4 4] [5 5] ~]) + (si:nl [1 3 5 ~]) + (from-list [[2 2] [4 4] ~]) + "restrict-keys" +:: +++ test-partition + %^ expect-eq + %+ partition + (from-list [[1 1] [2 2] [3 3] [4 4] [5 5] ~]) + |=(a/@u |(=(a 1) =(a 3))) + :- (from-list [[1 1] [3 3] ~]) + (from-list [[2 2] [4 4] [5 5] ~]) + "partition" +:: +++ test-map-maybe + %^ expect-eq + %+ map-maybe + (from-list [[1 1] [2 2] [3 3] [4 4] [5 5] ~]) + |=(a/@u ?:(=(a 3) ~ `a)) + (from-list [[1 1] [2 2] [4 4] [5 5] ~]) + "map-maybe" +:: +++ test-map-maybe-with-key + %^ expect-eq + %+ map-maybe-with-key + (from-list [[1 2] [2 3] [3 4] [4 5] [5 6] ~]) + |=({k/@u v/@u} ?:(=(k 3) ~ `v)) + (from-list [[1 2] [2 3] [4 5] [5 6] ~]) + "map-maybe-with-key" +:: +++ test-map-either + %^ expect-eq + %+ map-either + (from-list [[1 1] [2 2] [3 3] [4 4] [5 5] ~]) + |= value/@u + ?: =(0 (mod value 2)) + [%& "even"] + [%| 1] + :- (from-list [[2 "even"] [4 "even"] ~]) + (from-list [[1 1] [3 1] [5 1] ~]) + "map-either" +:: +++ test-map-either-with-key + %^ expect-eq + %+ map-either-with-key + (from-list [[1 1] [2 1] [3 1] [4 1] [5 1] ~]) + |= {key/@u value/@u} + ?: =(0 (mod key 2)) + [%& "even"] + [%| 1] + :- (from-list [[2 "even"] [4 "even"] ~]) + (from-list [[1 1] [3 1] [5 1] ~]) + "map-either" +:: +++ test-is-subdict + %^ expect-eq + %^ is-subdict-by + (from-list [[1 1] [4 4] ~]) + (from-list [[1 1] [2 2] [3 3] [4 4] [5 5] ~]) + |=({a/* b/*} =(a b)) + %.y + "is-subdict" +:: +++ test-valid + %^ expect-eq + (valid (from-list [[1 1] [2 2] [3 3] [4 4] [5 5] [6 6] [7 7] [8 8] [9 9] ~])) + %.y + "valid" +-- + diff --git a/tests/new-hoon/myb.hoon b/tests/new-hoon/myb.hoon new file mode 100644 index 000000000..90ce805a3 --- /dev/null +++ b/tests/new-hoon/myb.hoon @@ -0,0 +1,32 @@ +/+ new-hoon, tester +=, myb:new-hoon +|_ tester-type:tester +++ test-from-list-null + (expect-eq (from-list ~) ~ "from-list") +:: +++ test-from-list-real + (expect-eq (from-list [5 ~]) [~ 5] "from-list") +:: +++ test-to-list-null + (expect-eq (to-list ~) ~ "to-list") +:: +++ test-to-list-real + (expect-eq (to-list [~ 5]) [5 ~] "to-list") +:: +++ test-concat-null + (expect-eq (concat ~) ~ "concat") +:: +++ test-concat-real + :: wait, if i pull the cast out from below, the concat implementation + :: doesn't compile anymore? + (expect-eq (concat `(list (maybe @ud))`[~ [~ 1] ~ [~ 2] ~]) [1 2 ~] "concat") +:: +++ test-map + %^ expect-eq + %+ map:myb + [1 2 3 2 ~] + |=(a/@u ?:(=(2 a) [~ 2] ~)) + [2 2 ~] + "map" +-- + diff --git a/tests/new-hoon/thr.hoon b/tests/new-hoon/thr.hoon new file mode 100644 index 000000000..a17cf67a9 --- /dev/null +++ b/tests/new-hoon/thr.hoon @@ -0,0 +1,32 @@ +:: tests for the either core. +/+ new-hoon, tester +=, thr:new-hoon +=/ data/(list (either @u tape)) [[%& 1] [%| "one"] [%& 2] [%| "two"] ~] +|_ tester-type:tester +++ test-apply + %^ expect-eq + %^ apply + `(either @u tape)`[%| "one"] + |=(a/@u "left") + |=(b/tape "right") + "right" + "apply" +:: +++ test-firsts + %^ expect-eq + (firsts data) + [1 2 ~] + "firsts" +:: +++ test-seconds + %^ expect-eq + (seconds data) + ["one" "two" ~] + "seconds" +:: +++ test-partition + %^ expect-eq + (partition data) + [[1 2 ~] ["one" "two" ~]] + "partition" +-- diff --git a/web/testing.umd b/web/testing.umd new file mode 100644 index 000000000..064c95dca --- /dev/null +++ b/web/testing.umd @@ -0,0 +1,58 @@ +:- ~[comments+&] +;> + +# Writing Unit Tests + +Urbit comes with a built in system for writing tests. Like hoon files with a +certain shape go in `%/app` or `%/gen` or `%/mar`, hoon files with a certain +shape can go in `%/tests` and then are exposed to a system wide test runner. + +Say you put a test suite in `%/tests/new-hoon/thr.hoon`: + +``` +> +ls %/tests +new-hoon/ +> +ls %/tests/new-hoon +ls/hoon mp/hoon myb/hoon thr/hoon +``` + +You can then just run that individual test suite (and not the ones that are beside it in the `%/tests/new-hoon` directory) with: + +``` +> +tests /new-hoon/thr +/new-hoon/thr/test-seconds OK +/new-hoon/thr/test-partition OK +/new-hoon/thr/test-firsts OK +/new-hoon/thr/test-apply OK +``` + +## The test file + +So what is the structure of these test files? They contain a door, with arms starting with `++test-` or `++check-`. At minimum: + +``` +/+ tester +|_ tester-type:tester +++ test-some-test + (expect-eq 4 4 "trivial") +-- +``` + +All of the utilities you need to write tests are in the tester library. Also, like other hoon files, you can stack cores for models and utility functions with only the final core being inspected for test arms. + +## Some Details + +So internally, how does this work? + +The `+test` generator depends on each file/directory in `%/tests/` through a renderer. Each node in the filesystem tree is rendered by `%/ren/test-tree.hoon`, which calls itself recursively for subdirectories. + +This means all compiling of test cases happens inside ford, which can cache work and not recompile tests whose dependencies haven't changed. At runtime, all the `+test` generator does is filter and execute tests from the tree. + +I would like to get to a place where any direct scrying of the filesystem is discouraged, and almost everything flows through the functional reactive build system. This is what it is here for. + +### Future distribution of hoon libraries + +Implicit in having a standard way to write tests and a standard `+test` runner is the idea that all functionality on the current desk should be tested. + +Let's say I'm shipping a program on Urbit and I use multiple third-party libraries. Each of those libraries should have their own test suites placed in `%/tests/`. When I `|merge` their desks into my application desk, having a standard test runner means that all their tests and all my application tests get run. If you're depending on a library, you want to make sure that the tests for your dependencies run when you test your application. +