From 326b602aaeb3a6e81e053ac99bd1d6b6774992f3 Mon Sep 17 00:00:00 2001 From: Elliot Glaysher Date: Sun, 24 Sep 2017 22:44:45 -0700 Subject: [PATCH 01/27] Port new-hoon.hoon and tests to master. --- gen/test.hoon | 838 +++++++++++++++++++++++++++ lib/new-hoon.hoon | 1406 +++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 2244 insertions(+) create mode 100644 gen/test.hoon create mode 100644 lib/new-hoon.hoon diff --git a/gen/test.hoon b/gen/test.hoon new file mode 100644 index 000000000..845107275 --- /dev/null +++ b/gen/test.hoon @@ -0,0 +1,838 @@ +/+ new-hoon +|% +:: ---------------------------------------------------------------------- +:: Eventually should be in %/lib/tester/hoon. +:: ---------------------------------------------------------------------- +++ test-lib + |% + ++ 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 + == + :: + :: || %examples + :: + :: +| + ++ example !. + :: TODO: this doesn't deal with |*. + :: + :: specifies an example and its expected value. + :: + :: the examples in the hoon documentation used to go out of date very + :: quickly, since they were never compiled. so make compiling them a + :: test. + :: + :: source: a hoon expression + :: expected: the expected result of {source}. + |= {source/cord expected/cord} + ^+ +> + :: todo: deal with expected not compiling. + =+ exp=(slap !>(.) (ream expected)) + =+ run=(mule |.((slap !>(.) (ream source)))) + =/ result/vase ?- -.run + $| !>(p.run) + $& p.run + == + ?: =(q.result q.exp) + +>.$ + %= +>.$ + error-lines :* + "failure in '{(trip source)}':" + " actual: '{(noah result)}'" + " expected: '{(noah exp)}'" + error-lines + == + == + ++ examples + :: + |= a/(list {cord cord}) + ?~ a + +>.$ + =. +>.$ (example i.a) + $(a t.a) + :: + :: || %check + :: + :: +| + +- check + |* {generator/$-(@uvJ *) test/$-(* ?)} + |- :: why do i have to |-? + ^+ +>.$ + ?: (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. + =+ test=(test sample) + ?: test + %= $ + 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 + ^- @ + (add min (~(rad og c) (sub max min))) + :: + :: || %test + :: + :: +| + :: 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 + == + == + :: + ++ results + :: returns results. + :: + :: returns the test run's identity cookie and the list of failures. + |. + ^- {@uvJ (list tape)} + [eny error-lines] + -- + -- +:: ---------------------------------------------------------------------- +:: Eventually should be in %/test/basic/hoon. +:: ---------------------------------------------------------------------- +++ test-core + |_ tester-type:test-lib + ++ example-add + %- examples :~ + ['(add 2 2)' '4'] + ['(add 1 1.000.000)' '1.000.001'] + ['(add 1.333 (mul 2 2))' '1.337'] + == + ++ example-dec + %- examples :~ + ['(dec 7)' '6'] + ['(dec 0)' '~[[%leaf p="decrement-underflow"]]'] + == + ++ check-decrement + %+ check + (generate-range 0 100) + |=(a/@ =(a (dec (add 2 a)))) + ++ test-decrement + (expect-eq (dec 5) 4 "decrement failure") + ++ test-freedom + (expect-eq (add 2 2) 4 "freedom is the freedom to say...") + ++ test-a-failure + (expect-eq (add 2 2) 5 "freedom is the freedom to say...") + ++ test-crash + !! + -- +:: ---------------------------------------------------------------------- +:: Eventually should be in %/test/basic/hoon. +:: ---------------------------------------------------------------------- +++ test-thr + =, thr:new-hoon + =/ data/(list (either @u tape)) [[%& 1] [%| "one"] [%& 2] [%| "two"] ~] + |_ tester-type:test-lib + ++ 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" + -- +++ test-myb + =, myb:new-hoon + |_ tester-type:test-lib + ++ 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-transform + %^ expect-eq + %+ transform + [1 2 3 2 ~] + |=(a/@u ?:(=(2 a) [~ 2] ~)) + [2 2 ~] + "transform" + -- +++ test-ls + =, ls:new-hoon + |_ tester-type:test-lib + ++ 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-transform + (expect-eq (transform [1 2 ~] |=(a/@ (add 1 a))) [2 3 ~] "transform") + :: + ++ 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") + :: todo: ++concat goes here + ++ 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-transform-foldl + %^ expect-eq + (transform-foldl ~[1 2 3] 1 |=({a/@ b/@} [(add a b) (add 1 a)])) + [7 ~[2 3 5]] + "transform-foldl" + :: + ++ test-transform-foldr + %^ expect-eq + (transform-foldr ~[1 2 3] 1 |=({a/@ b/@} [(add a b) (add 1 a)])) + [7 ~[7 5 2]] + "transform-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-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" + :: TODO: Figure out why ++is-infix-of never terminates, but only on the + :: master branch. + :: ++ 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))) + [2 2 ~] + "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-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" + -- +++ test-mp + =, mp:new-hoon + =+ four=(from-list [[1 "one"] [2 "two"] [3 "three"] [4 "four"] ~]) + =+ three=(from-list [[1 "one"] [2 "two"] [3 "three"] ~]) + |_ tester-type:test-lib + ++ 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-insert-with + =+ ints=(from-list [["one" 1] ["two" 2] ["three" 3] ["four" 4] ~]) + %^ expect-eq + (insert-with ints "three" 2 add) + (from-list [["one" 1] ["two" 2] ["three" 5] ["four" 4] ~]) + "insert-with" + :: + ++ test-insert-with-key + %^ expect-eq + (insert-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"] ~]) + "insert-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-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-transform + %^ expect-eq + %+ transform + three + crip + (from-list [[1 'one'] [2 'two'] [3 'three'] ~]) + "transform" + :: + ++ test-transform-with-key + %^ expect-eq + %+ transform-with-key + three + |=({a/@u b/tape} (weld (scow %ud a) b)) + (from-list [[1 "1one"] [2 "2two"] [3 "3three"] ~]) + "transform-with-key" + :: + ++ test-transform-fold + %^ expect-eq + %^ transform-fold + three + "Everything: " + |= {accumulator/tape value/tape} + [(weld accumulator value) (weld value "X")] + :- "Everything: twoonethree" + (from-list [[1 "oneX"] [2 "twoX"] [3 "threeX"] ~]) + "transform-fold" + :: + ++ test-transform-keys + %^ expect-eq + %+ transform-keys + three + |= a/@u + (add a 10) + (from-list [[11 "one"] [12 "two"] [13 "three"] ~]) + "transform-keys" + :: + ++ test-transform-keys-with + %^ expect-eq + %^ transform-keys-with + three + |=(a/@u 42) + weld + (from-list [[42 "twothreeone"] ~]) + "transform-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" + "transform-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" + "transform-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-transform-maybe + %^ expect-eq + %+ transform-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] ~]) + "transform-maybe" + :: + ++ test-transform-maybe-with-key + %^ expect-eq + %+ transform-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] ~]) + "transform-maybe-with-key" + :: + :: ++ test-is-submap + :: %^ expect-eq + :: %^ is-submap-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-submap" + -- +:: ---------------------------------------------------------------------- +:: Stays in the generator. +:: ---------------------------------------------------------------------- +++ local + |% + ++ perform-test-suite + :: takes a testing core and executes all tests in it. + |= {name/tape v/vase eny/@uvJ} + ^- tang + =+ core-arms=(sort (sloe p.v) aor) + :: todo: work around mint-vain + =+ null-check=core-arms + ?~ null-check + [[%leaf :(weld "error: " name " is not a valid testing core.")] ~] + =| out/tang + |- + ?~ core-arms + out + %= $ + out (weld (perform-test-arm name i.core-arms v eny) out) + core-arms t.core-arms + == + :: + ++ perform-test-arm + :: performs a single test. + |= {suite-name/tape arm-name/term v/vase eny/@uvJ} + :: todo: terminal color on the output + ^- tang + =+ run=(run-arm-in-test-core arm-name v eny) + =+ full-name=:(weld suite-name "/" (trip arm-name)) + ?- -.run + $| :: the stack is already flopped for output? + ;: weld + p:run + `tang`[[%leaf (weld full-name " CRASHED")] ~] + == + $& :: todo: test the cookie to make sure it returned the same core. + ?: =(~ +.p:run) + [[%leaf (weld full-name " OK")] ~] + :: Create a welded list of all failures indented. + %- flop + ;: weld + `tang`[[%leaf (weld full-name " FAILED")] ~] + %+ turn +.p:run + |= {i/tape} + ^- tank + [%leaf (weld " " i)] + == + == + :: + ++ run-arm-in-test-core + :: runs a single arm. + :: + :: returns the output of `++mule` so that we can react to crashes + :: appropriately. + |= {arm-name/term v/vase eny/@uvJ} + ^- (each {@uvJ (list tape)} (list tank)) + =/ t (init-test:test-lib eny) + :: run the tests in the interpreter so we catch crashes. + %- mule |. + :: ~(t v arm-name) + =/ r (slap (slop !>(t) v) [%cnsg [arm-name ~] [%$ 3] [[%$ 2] ~]]) + :: return just the results or we will be here forever while we try to copy + :: the entire kernel. + ((hard {@uvJ (list tape)}) q:(slym (slap r [%limb %results]) r)) + -- +:: ---------------------------------------------------------------------- +-- +:- %say +|= $: {now/@da eny/@uvJ bec/beak} + $~ + $~ + == +:- %tang +:: todo: right now, we hard code ++test-core. but eventually, we must instead +:: scry ford for the core from the hoon file. that doesn't exist yet. +::(perform-test-suite:local "test-core" !>(test-core) eny) + +:: (perform-test-suite:local "test-thr" !>(test-thr) eny) +:: (perform-test-suite:local "test-myb" !>(test-myb) eny) +::(perform-test-suite:local "test-ls" !>(test-ls) eny) +(perform-test-suite:local "test-mp" !>(test-mp) eny) diff --git a/lib/new-hoon.hoon b/lib/new-hoon.hoon new file mode 100644 index 000000000..086a97c95 --- /dev/null +++ b/lib/new-hoon.hoon @@ -0,0 +1,1406 @@ +:> 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)) + |- + :: todo: this cast is bad. how do i make it a list with the internal types + ^- {(list) (list)} + ?~ 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) + ^- (list _,.+.,.-.a) + ?~ a ~ + ?~ i.a + $(a t.a) + [u.i.a $(a t.a)] + :: + ++ transform + :> a version of transform 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 +.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) + :> 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 ~>(%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 + +| + :: + ++ transform + :> 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))} +:: => .(b ^.(homo b)) + :: todo: this should homogenize with each sub-list in {b}, but right now, + :: i can't get the ++concat/++zang gate working. + ^+ (homo a) + ?~ 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) + + +:: This is even worse; cgy's ++zang doesn't do concat on master either. +:: +:: ++ zang :: new promote +:: |* a/(list (list)) +:: => .(a ^.(homo a)) +:: |- ^+ i:-.a +:: ?~ a +:: ~ +:: (weld i.a $(a t.a)) +:: :: TODO: this hits the |* span issue. +:: :: +:: :: :> concatenate a list of lists into a single level. +:: :: ++ concat +:: :: |* a/(list (list)) +:: :: ?~ a +:: :: ~ +:: :: ?~ +.a +:: :: -.a +:: :: (homo (weld -.a $(a +.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] + :: + ++ transform-foldl + :> performs both a ++transform 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]] + :: + ++ transform-foldr + :> performs both a ++transform 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 + :: todo: ++inits + :: todo: ++tails + :: + + :> # %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 + %.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)} + :: todo: this is performant in haskell because of laziness but may not be + :: adequate in hoon. + (is-prefix-of (reverse a) (reverse b)) + :: + :: todo: figure out why ++is-infix-of never terminates, but only on the + :: master branch. + :: + :: ++ is-infix-of + :: :> returns %.y if the first list appears anywhere in the second. + :: |* {a/(list) b/(list)} + :: ?~ 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 + :> returns 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)) + :: + :: can we do a full general zip without doing haskellesque zip3, zip4, etc? + :: todo: ++zip + :: + :> # %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)) + :: todo: this doesn't work on (weld [1 2 ~] ["one" "two" ~]) + :: ^+ (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. + :: + -- +++ mp + :: todo: why do hoon maps use double hash ordering? does this matter? + |% + :> # %query + :> looks up values in the map. + +| + ++ empty + :> is the map empty? + |* a/(map) + ?~ a %.y + %.n + :: + ++ size + :> returns the number of elements in {a}. + |= a/(map) + ^- @u + ?~ a 0 + :(add 1 $(a l.a) $(a r.a)) + :: + ++ member + :> returns %.y if {b} is a key in {a}. + |= {a/(map) key/*} + ^- ? + ?~ a %.n + ?|(=(key p.n.a) $(a l.a) $(a r.a)) + :: + ++ get + :> grab value by key. + |* {a/(map) 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/(map) key/*} +:: (~(got by a) key) + :: + :: todo: skipping several methods which rely on the the Ord typeclass, like + :: lookupLT. + :: + :> # %insertion + +| + ++ insert + :> inserts a new key/value pair, replacing the current value if it exists. + |* {a/(map) 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] + :: + ++ insert-with + :> inserts {key}/{value}, applying {fun} if {key} already exists. + |* {a/(map) 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] + :: + ++ insert-with-key + :> inserts {key}/{value}, applying {fun} if {key} already exists. + |* {a/(map) 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] + :: + :: todo: there's something wrong with the span here. + :: +:: ++ insert-lookup-with-key +:: :> combines insertion with lookup in one pass. +:: |* {a/(map) key/* value/* fun/$-({* * *} *)} +:: :: todo: type should reference a. +:: |- ^+ {*(unit value) a} +:: :: |- ^+ a ::{*(unit 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) +:: =+ d=$(a l.a) +:: ~! d +:: ?> ?=(^ 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 +:: ?> ?=(^ d) +:: ?: (vor p.n.a p.n.d) +:: [~ [n.a l.a d]] +:: [~ [n.d [n.a l.a l.d] r.d]] + :: + :> # %delete-update + +| + :: + ++ delete + :> deletes entry at {key}. + |* {a/(map) 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)] + |- ^- {$?($~ _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] + :: + ++ adjust + :> updates a value at {key} by passing the value to {fun}. + |* {a/(map) key/* fun/$-(* *)} + |- ^+ a + ?~ a + ~ + ?: =(key p.n.a) + [[key (fun q.n.a)] 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] + :: + ++ adjust-with-key + :> updates a value at {key} by passing the key/value pair to {fun}. + |* {a/(map) key/* fun/$-({* *} *)} + |- ^+ a + ?~ a + ~ + ?: =(key p.n.a) + [[key (fun key q.n.a)] 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] + :: + ++ update + :> adjusts or deletes the value at {key} by {fun}. + |* {a/(map) key/* fun/$-(* (maybe *))} + |- ^+ a + :: todo: this implementation is inefficient and traverses the tree multiple + :: times, when it can be done in O(log n). this should be solved in a jet? + =+ val=(get a key) + ?~ val + a + =+ ret=(fun u.val) + ?~ ret + (delete a key) + (insert a key u.ret) + :: + ++ update-with-key + :> adjusts or deletes the value at {key} by {fun}. + |* {a/(map) key/* fun/$-({* *} (maybe *))} + |- ^+ a + :: todo: this implementation is inefficient and traverses the tree multiple + :: times, when it can be done in O(log n). this should be solved in a jet? + =+ val=(get a key) + ?~ val + a + =+ ret=(fun key u.val) + ?~ ret + (delete a key) + (insert a key u.ret) + :: todo: + :: ++update-lookup-with-key + :: + ++ alter + :> inserts, deletes, or updates a value by {fun}. + |* {a/(map) key/* fun/$-(* (maybe *))} + :: todo: this implementation is inefficient and traverses the tree multiple + :: times, when it can be done in O(log n). this should be solved in a jet? + =+ ret=(fun (get a key)) + ?~ ret + (delete a key) + (insert a key u.ret) + :: + :> # %combine + +| + :: + ++ union + :> returns the union of {a} and {b}, preferring the value from {a} if dupe + |* {a/(map) b/(map)} + |- ^+ 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/(map) b/(map) 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/(map) b/(map) 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/(map) b/(map)} +:: (~(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/(map) b/(map)} +:: (~(int by a) b) +:: :: +:: :: todo: +:: :: ++intersection-with +:: :: ++intersection-with-key + :: + :> # %traversal + +| + :: + ++ transform + :> applies {fun} to each value in {a}. + |* {a/(map) fun/$-(* *)} + ^- (map _,.-.,.-.a fun) + ?~ a + ~ + [[p.n.a (fun q.n.a)] $(a l.a) $(a r.a)] + :: + ++ transform-with-key + :> applies {fun} to each value in {a}. + |* {a/(map) fun/$-({* *} *)} + ^- (map _,.-.,.-.a _*fun) + ?~ a + ~ + [[p.n.a (fun p.n.a q.n.a)] $(a l.a) $(a r.a)] + :: + ++ transform-fold + :> performs a fold on all the values in {a}. + :> + :> lists have an order, but maps 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/(map) b/* fun/$-({* *} {* *})} + ^- {_b (map _,.-.,.-.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]] + :: + ++ transform-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/(map) fun/$-(* *)} + =+ l=(to-list a) + %- from-list + %+ transform:ls l + |= item/_,.-.a + [(fun p.item) q.item] + :: + ++ transform-keys-with + :> applies {fun} to all keys, creating a new value with {combine} on dupes. + |* {a/(map) fun/$-(* *) combine/$-({* *} *)} + ^- (map _*fun _,.+.,.-.a) + =+ l=(to-list a) + =/ new-list + %+ transform:ls l + |= item/_,.-.a + [(fun p.item) q.item] + %^ foldl:ls new-list + `(map _*fun _,.+.,.-.a)`~ + |= {m/(map _*fun _,.+.,.-.a) p/_,.-.new-list} + (insert-with m -.p +.p combine) + :: + ++ fold + :> performs a fold on all the values in {a}. + :> + :> lists have an order, but maps 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/(map) 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/(map) 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/(map) 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/(map) 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/(map) 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/(map) b/$-({* *} ?)} + ^- ? + ?~ a + %.y + ?&((b p.n.a q.n.a) $(a l.a) $(a r.a)) + :: + :> # %conversion + +| + ++ elems + :> return all values in the map. + |* a/(map) + %+ turn (to-list a) second + :: + ++ keys + :> returns all keys in the map. + |* a/(map) + %+ 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/(map) + (si:nl (keys a)) + :: + ++ from-set + :> computes a map by running {fun} on every value in a set. + |* {a/(set) fun/$-(* *)} + ^- (map _,.-.a _*fun) + ?~ a + ~ + [[n.a (fun n.a)] $(a l.a) $(a r.a)] + :: + :> # %lists + +| + :: + ++ to-list + :> todo: copy over or something. + |* a/(map) + ~(tap by a) + :: + ++ from-list + :> todo: name or something + malt + :: + ++ from-list-with + :> creates a map from a list, with {fun} resolving duplicates. + |* {a/(list (pair)) fun/$-(* *)} + %^ foldl:ls a + `(map _*fun _,.+.,.-.a)`~ + |* {m/(map _*fun _,.+.,.-.a) p/_,.-.a} + (insert-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 + :> returns a map of all values that satisfy {fun}. + |* {a/(map) fun/$-(* ?)} + :: todo: the runtime on this is bogus. does a better version go here or a + :: jet? + %- from-list + %+ filter:ls (to-list a) + |= p/_,.-.a + (fun q.p) + :: + ++ filter-with-key + :> returns a map of all values that satisfy {fun}. + :: todo: the runtime on this is bogus. does a better version go here or a + :: jet? + |* {a/(map) fun/$-({* *} ?)} + %- from-list + %+ filter:ls (to-list a) fun + :: + ++ restrict-keys + :> returns a map where the only allowable keys are {keys}. + |* {a/(map) keys/(set)} + :: todo: the runtime on this is bogus. does a better version go here or a + :: jet? + %- from-list + %+ filter:ls (to-list a) + |= p/_,.-.a + :: todo: replace this with a call to our set library when we advance that + :: far. + (~(has in keys) p.p) + :: + ++ without-keys + :> returns a map where the only allowable keys are not in {keys}. + |* {a/(map) keys/(set)} + :: todo: the runtime on this is bogus. does a better version go here or a + :: jet? + %- from-list + %+ filter:ls (to-list a) + |= p/_,.-.a + :: todo: replace this with a call to our set library when we advance that + :: far. + !(~(has in keys) p.p) + :: + ++ partition + :> returns two lists, one whose elements match {fun}, the other doesn't. + |* {a/(map) fun/$-(* ?)} + =/ data + %+ partition:ls (to-list a) + |= p/_,.-.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 map. + :: + ++ transform-maybe + :> a version of transform that can throw out items. + |* {a/(map) fun/$-(* (maybe))} + ^- (map _,.-.,.-.a _+:*fun) + ?~ a ~ + =+ res=(fun q.n.a) + ?~ res + :: todo: runtime wise, I can do better than a union on delete? + (union $(a l.a) $(a r.a)) + [[p.n.a +.res] $(a l.a) $(a r.a)] + :: + ++ transform-maybe-with-key + :> a version of transform that can throw out items. + |* {a/(map) fun/$-({* *} (maybe))} + ^- (map _,.-.,.-.a _+:*fun) + ?~ a ~ + =+ res=(fun n.a) + ?~ res + :: todo: runtime wise, I can do better than a union on delete? + (union $(a l.a) $(a r.a)) + [[p.n.a +.res] $(a l.a) $(a r.a)] + :: + :: todo: ++transform-either is another case where the inability to decompose + :: doesn't work. same with ++transform-either-with-key + :: + :: ++split, ++split-lookup and ++split-root do not make sense without + :: ordinal keys. + :: + :: todo: is-submap no longer nest fails. it now goes into an infinite loop + :: like ++is-infix-of does. + :: ++ is-submap + :: :> returns %.y if every element in {a} exists in {b} with the same value. + :: |* {a/(map) b/(map)} + :: (is-submap-by a b |=({a/* b/*} =(a b))) + :: :: + :: ++ is-submap-by + :: :> returns %.y if every element in {a} exists in {b} with the same value. + :: |* {a/(map) b/(map) 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)) + :: + :: all indexed methods do not make sense when keys aren't ordered. + :: + :: all the -min, -max methods are O(log n) on ordered keys, but would be + :: O(n) with treaps. i can't think of what they're useful for, either. + -- +-- From 21926968aeb0e56fbba5cbfc239c65ab61ada512 Mon Sep 17 00:00:00 2001 From: Elliot Glaysher Date: Mon, 25 Sep 2017 15:54:41 -0700 Subject: [PATCH 02/27] Clean out lots of todos. --- gen/test.hoon | 79 ++++++++++++++----- lib/new-hoon.hoon | 196 +++++++++++++++++++++++++--------------------- 2 files changed, 166 insertions(+), 109 deletions(-) diff --git a/gen/test.hoon b/gen/test.hoon index 845107275..e5342e816 100644 --- a/gen/test.hoon +++ b/gen/test.hoon @@ -259,7 +259,10 @@ :: ++ test-foldr (expect-eq (foldr [1 2 3 ~] 1 |=({a/@ b/@} (add a b))) 7 "foldr") - :: todo: ++concat goes here + :: + ++ test-concat + (expect-eq (concat ~[~[1 2] ~[3 4]]) ~[1 2 3 4] "concat") + :: ++ test-any-true (expect-eq (any [1 2 3 ~] |=(a/@ =(a 2))) %.y "any true") :: @@ -379,13 +382,12 @@ (is-suffix-of "bar" "foobar") %.y "is-suffix-of" - :: TODO: Figure out why ++is-infix-of never terminates, but only on the - :: master branch. - :: ++ test-is-infix-of - :: %^ expect-eq - :: (is-infix-of "ob" "foobar") - :: %.y - :: "is-infix-of" + :: + ++ test-is-infix-of + %^ expect-eq + (is-infix-of "ob" "foobar") + %.y + "is-infix-of" :: ++ test-elem %^ expect-eq @@ -497,7 +499,17 @@ (insert-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"] ~]) "insert-with-key" - + :: + ++ test-insert-lookup-with-key + %^ expect-eq + %- insert-lookup-with-key :^ + four + 4 + "five" + |=({key/@ud old/tape new/tape} new) + :- `"four" + (from-list [[1 "one"] [2 "two"] [3 "three"] [4 "five"] ~]) + "insert-lookup-with-key" :: ++ test-delete %^ expect-eq @@ -687,7 +699,7 @@ add (from-list [[1 1] [2 2] [3 3] ~]) "from-list-with" - + :: ++ test-filter %^ expect-eq %+ filter @@ -745,14 +757,38 @@ (from-list [[1 2] [2 3] [4 5] [5 6] ~]) "transform-maybe-with-key" :: - :: ++ test-is-submap - :: %^ expect-eq - :: %^ is-submap-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-submap" + ++ test-transform-either + %^ expect-eq + %+ transform-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] ~]) + "transform-either" + :: + ++ test-transform-either-with-key + %^ expect-eq + %+ transform-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] ~]) + "transform-either" + :: + ++ test-is-submap + %^ expect-eq + %^ is-submap-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-submap" -- :: ---------------------------------------------------------------------- :: Stays in the generator. @@ -822,6 +858,7 @@ -- :: ---------------------------------------------------------------------- -- + :- %say |= $: {now/@da eny/@uvJ bec/beak} $~ @@ -832,7 +869,7 @@ :: scry ford for the core from the hoon file. that doesn't exist yet. ::(perform-test-suite:local "test-core" !>(test-core) eny) -:: (perform-test-suite:local "test-thr" !>(test-thr) eny) +:: (perform-test-suite:local "test-thr" !>(test-thr) eny) :: (perform-test-suite:local "test-myb" !>(test-myb) eny) -::(perform-test-suite:local "test-ls" !>(test-ls) eny) -(perform-test-suite:local "test-mp" !>(test-mp) eny) +(perform-test-suite:local "test-ls" !>(test-ls) eny) +::(perform-test-suite:local "test-mp" !>(test-mp) eny) diff --git a/lib/new-hoon.hoon b/lib/new-hoon.hoon index 086a97c95..8561303e6 100644 --- a/lib/new-hoon.hoon +++ b/lib/new-hoon.hoon @@ -10,6 +10,7 @@ +.a :: ++ either |*({a/mold b/mold} $%({$& p/a} {$| p/b})) :: either +:: ++ thr |% ++ apply @@ -49,8 +50,7 @@ |* a/(list (either)) => .(a (homo a)) |- - :: todo: this cast is bad. how do i make it a list with the internal types - ^- {(list) (list)} + ^- {(list _?>(?=({{%& *} *} a) p.i.a)) (list _?>(?=({{%| *} *} a) p.i.a))} ?~ a [~ ~] =+ ret=$(a t.a) @@ -263,10 +263,9 @@ ++ intercalate :> places {a} between each list in {b}, and flatten to a single list. |* {a/(list) b/(list (list))} -:: => .(b ^.(homo b)) - :: todo: this should homogenize with each sub-list in {b}, but right now, - :: i can't get the ++concat/++zang gate working. - ^+ (homo a) + => .(a ^.(homo a), b ^.(homo b)) + |- + ^+ (concat [a b]) ?~ b ~ =+ c=$(b t.b) @@ -330,28 +329,15 @@ ?~ a b (c $(a t.a) i.a) - - -:: This is even worse; cgy's ++zang doesn't do concat on master either. -:: -:: ++ zang :: new promote -:: |* a/(list (list)) -:: => .(a ^.(homo a)) -:: |- ^+ i:-.a -:: ?~ a -:: ~ -:: (weld i.a $(a t.a)) -:: :: TODO: this hits the |* span issue. -:: :: -:: :: :> concatenate a list of lists into a single level. -:: :: ++ concat -:: :: |* a/(list (list)) -:: :: ?~ a -:: :: ~ -:: :: ?~ +.a -:: :: -.a -:: :: (homo (weld -.a $(a +.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)) :: ++ any :> returns yes if any element satisfies the predicate @@ -579,6 +565,9 @@ ++ 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 @@ -590,23 +579,25 @@ ++ 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)) :: - :: todo: figure out why ++is-infix-of never terminates, but only on the - :: master branch. - :: - :: ++ is-infix-of - :: :> returns %.y if the first list appears anywhere in the second. - :: |* {a/(list) b/(list)} - :: ?~ a - :: %.y - :: ?~ b - :: %.n - :: ?: (is-prefix-of a b) - :: %.y - :: $(b t.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 :: @@ -908,33 +899,28 @@ [n.a l.a d] [n.d [n.a l.a l.d] r.d] :: - :: todo: there's something wrong with the span here. - :: -:: ++ insert-lookup-with-key -:: :> combines insertion with lookup in one pass. -:: |* {a/(map) key/* value/* fun/$-({* * *} *)} -:: :: todo: type should reference a. -:: |- ^+ {*(unit value) a} -:: :: |- ^+ a ::{*(unit 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) -:: =+ d=$(a l.a) -:: ~! d -:: ?> ?=(^ 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 -:: ?> ?=(^ d) -:: ?: (vor p.n.a p.n.d) -:: [~ [n.a l.a d]] -:: [~ [n.d [n.a l.a l.d] r.d]] + ++ insert-lookup-with-key + :> combines insertion with lookup in one pass. + |* {a/(map) 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 +| @@ -1373,30 +1359,64 @@ (union $(a l.a) $(a r.a)) [[p.n.a +.res] $(a l.a) $(a r.a)] :: - :: todo: ++transform-either is another case where the inability to decompose - :: doesn't work. same with ++transform-either-with-key + ++ transform-either + :> splits the map in two on a gate that returns an either. + |* {a/(map) fun/$-(* (either))} + |- + ^- $: (map _,.-.,.-.a _?>(?=({{%& *} *} *fun) +:*fun)) + (map _,.-.,.-.a _?>(?=({{%| *} *} *fun) +:*fun)) + == + ?~ a + [~ ~] + :: todo: runtime wise, can I do better than recursive unions? + =+ lr=$(a l.a) + =+ rr=$(a r.a) + =+ x=(fun q.n.a) + ?- -.x + $& [(insert (union -.lr -.rr) p.n.a +.x) (union +.lr +.rr)] + $| [(union -.lr -.rr) (insert (union +.lr +.rr) p.n.a +.x)] + == + :: + ++ transform-either-with-key + :> splits the map in two on a gate that returns an either. + |* {a/(map) fun/$-({* *} (either))} + |- + ^- $: (map _,.-.,.-.a _?>(?=({{%& *} *} *fun) +:*fun)) + (map _,.-.,.-.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 + $& [(insert (union -.lr -.rr) p.n.a +.x) (union +.lr +.rr)] + $| [(union -.lr -.rr) (insert (union +.lr +.rr) p.n.a +.x)] + == :: :: ++split, ++split-lookup and ++split-root do not make sense without :: ordinal keys. :: - :: todo: is-submap no longer nest fails. it now goes into an infinite loop - :: like ++is-infix-of does. - :: ++ is-submap - :: :> returns %.y if every element in {a} exists in {b} with the same value. - :: |* {a/(map) b/(map)} - :: (is-submap-by a b |=({a/* b/*} =(a b))) - :: :: - :: ++ is-submap-by - :: :> returns %.y if every element in {a} exists in {b} with the same value. - :: |* {a/(map) b/(map) 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)) + ++ is-submap + :> returns %.y if every element in {a} exists in {b} with the same value. + |* {a/(map) b/(map)} + ^- ? + (is-submap-by a b |=({a/* b/*} =(a b))) + :: + ++ is-submap-by + :> returns %.y if every element in {a} exists in {b} with the same value. + |* {a/(map) b/(map) 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)) :: :: all indexed methods do not make sense when keys aren't ordered. :: From 843c902bf288d86d951b885d34767c912e5fdc8a Mon Sep 17 00:00:00 2001 From: Elliot Glaysher Date: Mon, 25 Sep 2017 23:25:58 -0700 Subject: [PATCH 03/27] Remove most usage of , to strip faces. Use the face itself instead. --- lib/new-hoon.hoon | 62 ++++++++++++++++++++++++----------------------- 1 file changed, 32 insertions(+), 30 deletions(-) diff --git a/lib/new-hoon.hoon b/lib/new-hoon.hoon index 8561303e6..65dff7362 100644 --- a/lib/new-hoon.hoon +++ b/lib/new-hoon.hoon @@ -121,8 +121,7 @@ |* a/(list (maybe)) => .(a (homo a)) |- -:: ^- (list _u.i.a) - ^- (list _,.+.,.-.a) + ^- (list _u.+.i.-.a) ?~ a ~ ?~ i.a $(a t.a) @@ -153,7 +152,7 @@ :> applies {b} to {a}. |* {a/(maybe) b/$-(* (maybe))} ?~ a ~ - (b +.a) + (b u.a) :: :: todo: bind, bond, both, flit, hunt, lift, mate, :: @@ -1113,7 +1112,7 @@ ++ transform :> applies {fun} to each value in {a}. |* {a/(map) fun/$-(* *)} - ^- (map _,.-.,.-.a fun) + ^- (map _p.-.n.-.a fun) ?~ a ~ [[p.n.a (fun q.n.a)] $(a l.a) $(a r.a)] @@ -1121,7 +1120,7 @@ ++ transform-with-key :> applies {fun} to each value in {a}. |* {a/(map) fun/$-({* *} *)} - ^- (map _,.-.,.-.a _*fun) + ^- (map _p.-.n.-.a _*fun) ?~ a ~ [[p.n.a (fun p.n.a q.n.a)] $(a l.a) $(a r.a)] @@ -1136,7 +1135,7 @@ :> :> corresponds to {mapAccum} in haskell. |* {a/(map) b/* fun/$-({* *} {* *})} - ^- {_b (map _,.-.,.-.a _+:*fun)} + ^- {_b (map _p.-.n.-.a _+:*fun)} ?~ a [b ~] =+ d=(fun b q.n.a) @@ -1151,24 +1150,22 @@ :: wins in case of duplicates. this is currently unhandled. maybe i just :: shouldn't have this gate. |* {a/(map) fun/$-(* *)} - =+ l=(to-list a) %- from-list - %+ transform:ls l - |= item/_,.-.a + %+ transform:ls (to-list a) + |= item/_n.-.a [(fun p.item) q.item] :: ++ transform-keys-with :> applies {fun} to all keys, creating a new value with {combine} on dupes. |* {a/(map) fun/$-(* *) combine/$-({* *} *)} - ^- (map _*fun _,.+.,.-.a) - =+ l=(to-list a) + ^- (map _*fun _q.+.n.-.a) =/ new-list - %+ transform:ls l - |= item/_,.-.a + %+ transform:ls (to-list a) + |= item/_n.-.a [(fun p.item) q.item] %^ foldl:ls new-list - `(map _*fun _,.+.,.-.a)`~ - |= {m/(map _*fun _,.+.,.-.a) p/_,.-.new-list} + `(map _*fun _q.+.n.-.a)`~ + |= {m/(map _*fun _q.+.n.-.a) p/_i.-.new-list} (insert-with m -.p +.p combine) :: ++ fold @@ -1251,7 +1248,7 @@ ++ from-set :> computes a map by running {fun} on every value in a set. |* {a/(set) fun/$-(* *)} - ^- (map _,.-.a _*fun) + ^- (map _n.-.a _*fun) ?~ a ~ [[n.a (fun n.a)] $(a l.a) $(a r.a)] @@ -1265,15 +1262,20 @@ ~(tap by a) :: ++ from-list - :> todo: name or something - malt + :> creates a tree from a list. + |* a/(list (pair)) + |- + %^ foldl:ls a + `(map _p.-.i.-.a _q.+.i.-.a)`~ + |= {m/(map _p.-.i.-.a _q.+.i.-.a) p/_i.-.a} + (insert m p) :: ++ from-list-with :> creates a map from a list, with {fun} resolving duplicates. |* {a/(list (pair)) fun/$-(* *)} %^ foldl:ls a - `(map _*fun _,.+.,.-.a)`~ - |* {m/(map _*fun _,.+.,.-.a) p/_,.-.a} + `(map _*fun _q.+.i.-.a)`~ + |= {m/(map _*fun _q.+.i.-.a) p/_i.-.a} (insert-with m -.p +.p fun) :: :: todo: without a natural ordering, association lists and gates to operate @@ -1288,7 +1290,7 @@ :: jet? %- from-list %+ filter:ls (to-list a) - |= p/_,.-.a + |= p/_n.-.a (fun q.p) :: ++ filter-with-key @@ -1306,7 +1308,7 @@ :: jet? %- from-list %+ filter:ls (to-list a) - |= p/_,.-.a + |= p/_n.-.a :: todo: replace this with a call to our set library when we advance that :: far. (~(has in keys) p.p) @@ -1318,7 +1320,7 @@ :: jet? %- from-list %+ filter:ls (to-list a) - |= p/_,.-.a + |= p/_n.-.a :: todo: replace this with a call to our set library when we advance that :: far. !(~(has in keys) p.p) @@ -1328,7 +1330,7 @@ |* {a/(map) fun/$-(* ?)} =/ data %+ partition:ls (to-list a) - |= p/_,.-.a + |= p/_n.-.a (fun q.p) [(from-list -.data) (from-list +.data)] :: @@ -1340,7 +1342,7 @@ ++ transform-maybe :> a version of transform that can throw out items. |* {a/(map) fun/$-(* (maybe))} - ^- (map _,.-.,.-.a _+:*fun) + ^- (map _p.-.n.-.a _+:*fun) ?~ a ~ =+ res=(fun q.n.a) ?~ res @@ -1351,7 +1353,7 @@ ++ transform-maybe-with-key :> a version of transform that can throw out items. |* {a/(map) fun/$-({* *} (maybe))} - ^- (map _,.-.,.-.a _+:*fun) + ^- (map _p.-.n.-.a _+:*fun) ?~ a ~ =+ res=(fun n.a) ?~ res @@ -1363,8 +1365,8 @@ :> splits the map in two on a gate that returns an either. |* {a/(map) fun/$-(* (either))} |- - ^- $: (map _,.-.,.-.a _?>(?=({{%& *} *} *fun) +:*fun)) - (map _,.-.,.-.a _?>(?=({{%| *} *} *fun) +:*fun)) + ^- $: (map _p.-.n.-.a _?>(?=({{%& *} *} *fun) +:*fun)) + (map _p.-.n.-.a _?>(?=({{%| *} *} *fun) +:*fun)) == ?~ a [~ ~] @@ -1381,8 +1383,8 @@ :> splits the map in two on a gate that returns an either. |* {a/(map) fun/$-({* *} (either))} |- - ^- $: (map _,.-.,.-.a _?>(?=({{%& *} *} *fun) +:*fun)) - (map _,.-.,.-.a _?>(?=({{%| *} *} *fun) +:*fun)) + ^- $: (map _p.-.n.-.a _?>(?=({{%& *} *} *fun) +:*fun)) + (map _p.-.n.-.a _?>(?=({{%| *} *} *fun) +:*fun)) == ?~ a [~ ~] From 0d2b14f4b7f94556b6f4c147cfcfd87b1576115b Mon Sep 17 00:00:00 2001 From: Elliot Glaysher Date: Wed, 27 Sep 2017 21:18:02 -0700 Subject: [PATCH 04/27] Weld should work on differently typed lists. --- gen/test.hoon | 3 +++ lib/new-hoon.hoon | 13 ++++++++++--- 2 files changed, 13 insertions(+), 3 deletions(-) diff --git a/gen/test.hoon b/gen/test.hoon index e5342e816..715bfe8b6 100644 --- a/gen/test.hoon +++ b/gen/test.hoon @@ -263,6 +263,9 @@ ++ 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") :: diff --git a/lib/new-hoon.hoon b/lib/new-hoon.hoon index 65dff7362..47b3246a0 100644 --- a/lib/new-hoon.hoon +++ b/lib/new-hoon.hoon @@ -338,6 +338,14 @@ ~ (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/$-(* ?)} @@ -756,9 +764,8 @@ :> the list union of {a} and {b}. |* {a/(list) b/(list)} => .(a (homo a), b (homo b)) - :: todo: this doesn't work on (weld [1 2 ~] ["one" "two" ~]) - :: ^+ (weld a b) |- + ^+ (weld a b) ?~ a b ?~ b @@ -769,8 +776,8 @@ :> the intersection of {a} and {b}. |* {a/(list) b/(list)} => .(a (homo a), b (homo b)) - ^+ a |- + ^+ a ?~ a ~ ?: (elem i.a b) From 3b007e389cec623e452d1ba0aeb969fc60659c02 Mon Sep 17 00:00:00 2001 From: Elliot Glaysher Date: Wed, 27 Sep 2017 21:20:32 -0700 Subject: [PATCH 05/27] Fix the runtime of ++alter and family. Previous runtime was pretty nutty and walked the tree multiple times. --- gen/test.hoon | 14 ++++- lib/new-hoon.hoon | 140 +++++++++++++++++++++++----------------------- 2 files changed, 81 insertions(+), 73 deletions(-) diff --git a/gen/test.hoon b/gen/test.hoon index 715bfe8b6..539f07d6f 100644 --- a/gen/test.hoon +++ b/gen/test.hoon @@ -574,6 +574,15 @@ (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)" + :: ++ test-union %^ expect-eq %+ union @@ -861,7 +870,6 @@ -- :: ---------------------------------------------------------------------- -- - :- %say |= $: {now/@da eny/@uvJ bec/beak} $~ @@ -874,5 +882,5 @@ :: (perform-test-suite:local "test-thr" !>(test-thr) eny) :: (perform-test-suite:local "test-myb" !>(test-myb) eny) -(perform-test-suite:local "test-ls" !>(test-ls) eny) -::(perform-test-suite:local "test-mp" !>(test-mp) eny) +::(perform-test-suite:local "test-ls" !>(test-ls) eny) +(perform-test-suite:local "test-mp" !>(test-mp) eny) diff --git a/lib/new-hoon.hoon b/lib/new-hoon.hoon index 47b3246a0..152eff2fe 100644 --- a/lib/new-hoon.hoon +++ b/lib/new-hoon.hoon @@ -790,7 +790,6 @@ :: -- ++ mp - :: todo: why do hoon maps use double hash ordering? does this matter? |% :> # %query :> looks up values in the map. @@ -941,92 +940,83 @@ ?: (gor key p.n.a) [n.a $(a l.a) r.a] [n.a l.a $(a r.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] + (pop-top a) :: ++ adjust :> updates a value at {key} by passing the value to {fun}. |* {a/(map) key/* fun/$-(* *)} - |- ^+ a - ?~ a - ~ - ?: =(key p.n.a) - [[key (fun q.n.a)] 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] + %^ 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/(map) key/* fun/$-({* *} *)} - |- ^+ a - ?~ a - ~ - ?: =(key p.n.a) - [[key (fun key q.n.a)] 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] + %^ 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/(map) key/* fun/$-(* (maybe *))} - |- ^+ a - :: todo: this implementation is inefficient and traverses the tree multiple - :: times, when it can be done in O(log n). this should be solved in a jet? - =+ val=(get a key) - ?~ val - a - =+ ret=(fun u.val) - ?~ ret - (delete a key) - (insert a key u.ret) + %^ 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/(map) key/* fun/$-({* *} (maybe *))} - |- ^+ a - :: todo: this implementation is inefficient and traverses the tree multiple - :: times, when it can be done in O(log n). this should be solved in a jet? - =+ val=(get a key) - ?~ val - a - =+ ret=(fun key u.val) - ?~ ret - (delete a key) - (insert a key u.ret) + %^ 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/(map) key/* fun/$-(* (maybe *))} - :: todo: this implementation is inefficient and traverses the tree multiple - :: times, when it can be done in O(log n). this should be solved in a jet? - =+ ret=(fun (get a key)) - ?~ ret - (delete a key) - (insert a key u.ret) + |* {a/(map) 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/(map) 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 +| @@ -1427,9 +1417,19 @@ ?~ x %.n |((fun q.n.a u.x) $(a l.a) $(a r.a)) :: - :: all indexed methods do not make sense when keys aren't ordered. - :: - :: all the -min, -max methods are O(log n) on ordered keys, but would be - :: O(n) with treaps. i can't think of what they're useful for, either. + :> # %impl + :> implementation details + +| + ++ pop-top + :> removes the head of the tree and rebalances the tree below. + |* a/(map) + ^- {$?($~ _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] -- -- From 1d8614f2ee40b9bb2931c925dc11e6d0a4ec0231 Mon Sep 17 00:00:00 2001 From: Elliot Glaysher Date: Wed, 27 Sep 2017 21:55:35 -0700 Subject: [PATCH 06/27] Don't repeat ++transform-either's implementation. --- lib/new-hoon.hoon | 17 +++-------------- 1 file changed, 3 insertions(+), 14 deletions(-) diff --git a/lib/new-hoon.hoon b/lib/new-hoon.hoon index 152eff2fe..4c6c4d01c 100644 --- a/lib/new-hoon.hoon +++ b/lib/new-hoon.hoon @@ -1361,20 +1361,9 @@ ++ transform-either :> splits the map in two on a gate that returns an either. |* {a/(map) fun/$-(* (either))} - |- - ^- $: (map _p.-.n.-.a _?>(?=({{%& *} *} *fun) +:*fun)) - (map _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 q.n.a) - ?- -.x - $& [(insert (union -.lr -.rr) p.n.a +.x) (union +.lr +.rr)] - $| [(union -.lr -.rr) (insert (union +.lr +.rr) p.n.a +.x)] - == + %+ transform-either-with-key a + |= {key/* value/_q.+.n.-.a} + (fun value) :: ++ transform-either-with-key :> splits the map in two on a gate that returns an either. From 37f65c099da4c1d6a861930099cf57d573513c3b Mon Sep 17 00:00:00 2001 From: Elliot Glaysher Date: Wed, 27 Sep 2017 22:08:40 -0700 Subject: [PATCH 07/27] Inline ++to-list. --- lib/new-hoon.hoon | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/lib/new-hoon.hoon b/lib/new-hoon.hoon index 4c6c4d01c..ccf6e7fee 100644 --- a/lib/new-hoon.hoon +++ b/lib/new-hoon.hoon @@ -1254,9 +1254,14 @@ +| :: ++ to-list - :> todo: copy over or something. + :> creates a list of pairs from the tree. |* a/(map) - ~(tap by a) + =| b/(list _n.-.a) + |- + ^+ b + ?~ a + b + $(a r.a, b [n.a $(a l.a)]) :: ++ from-list :> creates a tree from a list. From 1157710c743d890293d8ee4fcb848f27bbe4507d Mon Sep 17 00:00:00 2001 From: Elliot Glaysher Date: Wed, 27 Sep 2017 23:10:45 -0700 Subject: [PATCH 08/27] Fix the semantics and runtime of ++filter. --- gen/test.hoon | 10 +++++----- lib/new-hoon.hoon | 48 ++++++++++++++++++++++------------------------- 2 files changed, 27 insertions(+), 31 deletions(-) diff --git a/gen/test.hoon b/gen/test.hoon index 539f07d6f..2d8cf869f 100644 --- a/gen/test.hoon +++ b/gen/test.hoon @@ -413,7 +413,7 @@ ++ test-filter %^ expect-eq (filter [1 2 1 2 1 ~] |=(a/@ =(a 2))) - [2 2 ~] + [1 1 1 ~] "filter" :: ++ test-partition @@ -716,7 +716,7 @@ %^ expect-eq %+ filter (from-list [[1 1] [2 1] [3 2] [4 1] ~]) - |=(a/@u =(a 1)) + |=(a/@u !=(a 1)) (from-list [[1 1] [2 1] [4 1] ~]) "filter" :: @@ -724,7 +724,7 @@ %^ expect-eq %+ filter-with-key (from-list [[1 1] [2 1] [3 2] [4 1] ~]) - |=({a/@u b/@u} !=(a 2)) + |=({a/@u b/@u} =(a 2)) (from-list [[1 1] [3 2] [4 1] ~]) "filter-with-key" :: @@ -882,5 +882,5 @@ :: (perform-test-suite:local "test-thr" !>(test-thr) eny) :: (perform-test-suite:local "test-myb" !>(test-myb) eny) -::(perform-test-suite:local "test-ls" !>(test-ls) eny) -(perform-test-suite:local "test-mp" !>(test-mp) eny) +(perform-test-suite:local "test-ls" !>(test-ls) eny) +::(perform-test-suite:local "test-mp" !>(test-mp) eny) diff --git a/lib/new-hoon.hoon b/lib/new-hoon.hoon index ccf6e7fee..3487bb57b 100644 --- a/lib/new-hoon.hoon +++ b/lib/new-hoon.hoon @@ -641,14 +641,14 @@ $(a t.a) :: ++ filter - :> returns all items in {a} which match predicate {b}. + :> filter all items in {a} which match predicate {b}. |* {a/(list) b/$-(* ?)} => .(a (homo a)) |- ^+ a ?~ a ~ - ?: (b i.a) + ?. (b i.a) [i.a $(a t.a)] $(a t.a) :: @@ -1286,50 +1286,46 @@ :> # %filters +| ++ filter - :> returns a map of all values that satisfy {fun}. + :> filters a map of all values that satisfy {fun}. |* {a/(map) fun/$-(* ?)} - :: todo: the runtime on this is bogus. does a better version go here or a - :: jet? - %- from-list - %+ filter:ls (to-list a) - |= p/_n.-.a - (fun q.p) + %+ filter-with-key a + |= {key/* value/_q.+.n.-.a} + (fun value) :: ++ filter-with-key - :> returns a map of all values that satisfy {fun}. - :: todo: the runtime on this is bogus. does a better version go here or a - :: jet? + :> filters a map of all values that satisfy {fun}. |* {a/(map) fun/$-({* *} ?)} - %- from-list - %+ filter:ls (to-list a) 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 map where the only allowable keys are {keys}. |* {a/(map) keys/(set)} - :: todo: the runtime on this is bogus. does a better version go here or a - :: jet? - %- from-list - %+ filter:ls (to-list a) - |= p/_n.-.a + %+ 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) p.p) + !(~(has in keys) key) :: ++ without-keys :> returns a map where the only allowable keys are not in {keys}. |* {a/(map) keys/(set)} - :: todo: the runtime on this is bogus. does a better version go here or a - :: jet? - %- from-list - %+ filter:ls (to-list a) - |= p/_n.-.a + %+ 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) p.p) + (~(has in keys) key) :: ++ partition :> returns two lists, one whose elements match {fun}, the other doesn't. |* {a/(map) fun/$-(* ?)} + :: todo: is the runtime on this is bogus? =/ data %+ partition:ls (to-list a) |= p/_n.-.a From fc651af8aa26dca2d9a71492dbb392e3109a7950 Mon Sep 17 00:00:00 2001 From: Elliot Glaysher Date: Wed, 27 Sep 2017 23:23:12 -0700 Subject: [PATCH 09/27] Minor runtime fix to ++transform-maybe. --- lib/new-hoon.hoon | 15 ++++++--------- 1 file changed, 6 insertions(+), 9 deletions(-) diff --git a/lib/new-hoon.hoon b/lib/new-hoon.hoon index 3487bb57b..278b6d54f 100644 --- a/lib/new-hoon.hoon +++ b/lib/new-hoon.hoon @@ -1340,13 +1340,9 @@ ++ transform-maybe :> a version of transform that can throw out items. |* {a/(map) fun/$-(* (maybe))} - ^- (map _p.-.n.-.a _+:*fun) - ?~ a ~ - =+ res=(fun q.n.a) - ?~ res - :: todo: runtime wise, I can do better than a union on delete? - (union $(a l.a) $(a r.a)) - [[p.n.a +.res] $(a l.a) $(a r.a)] + %+ transform-maybe-with-key a + |= {key/* value/_q.+.n.-.a} + (fun value) :: ++ transform-maybe-with-key :> a version of transform that can throw out items. @@ -1355,8 +1351,9 @@ ?~ a ~ =+ res=(fun n.a) ?~ res - :: todo: runtime wise, I can do better than a union on delete? - (union $(a l.a) $(a r.a)) + =. l.a $(a l.a) + =. r.a $(a r.a) + (pop-top a) [[p.n.a +.res] $(a l.a) $(a r.a)] :: ++ transform-either From 08962cfd63c0b9109e6c43da8b7dedc8573d0192 Mon Sep 17 00:00:00 2001 From: Elliot Glaysher Date: Thu, 28 Sep 2017 23:05:23 -0700 Subject: [PATCH 10/27] First quickcheck test. Test that the ++alter:mp family is a ++valid treap after a large number of random actions. --- gen/test.hoon | 57 +++++++++++++++++++++++++++++++++++++++++++---- lib/new-hoon.hoon | 48 +++++++++++++++++++++++++++++++++++++++ 2 files changed, 101 insertions(+), 4 deletions(-) diff --git a/gen/test.hoon b/gen/test.hoon index 2d8cf869f..ea7a49f77 100644 --- a/gen/test.hoon +++ b/gen/test.hoon @@ -71,8 +71,8 @@ :: todo: wrap generator in mule so it can crash. =+ sample=(generator eny) :: todo: wrap test in mule so it can crash. - =+ test=(test sample) - ?: test + =+ ret=(test sample) + ?: ret %= $ eny (shaf %huh eny) :: xxx: better random? current-iteration (add current-iteration 1) @@ -94,6 +94,22 @@ ^- @ (add min (~(rad og c) (sub max min))) :: + ++ generate-map + :> generator which will produce a map with {count} random pairs. + |= count/@u + :> generate a map with entropy {c}. + |= c/@uvJ + =/ gen (random:new-hoon c) + =| i/@u + =| m/(map @ud @ud) + |- + ^- (map @ud @ud) + ?: =(i count) + m + =^ first gen (rads:gen 100) + =^ second gen (rads:gen 100) + $(m (insert:mp:new-hoon m first second), i +(i)) + :: :: || %test :: :: +| @@ -583,6 +599,33 @@ (from-list [[1 "one"] [2 "dos"] [3 "three"] [4 "four"] ~]) "alter (as change)" :: + ++ check-alter + :: check random maps of 50 items with 40 random operations done on them + :: for validity. + %+ check + (generate-map 50) + |= a/(map @ud @ud) + :: this is dumb, but use {a} as entropy? + =/ gen (random:new-hoon (jam a)) + =| i/@u + |- + ?: =(i 40) + %.y + =^ key gen (rads:gen 100) + =^ value gen (rads:gen 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 @@ -801,6 +844,12 @@ |=({a/* b/*} =(a b)) %.y "is-submap" + :: + ++ 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" -- :: ---------------------------------------------------------------------- :: Stays in the generator. @@ -882,5 +931,5 @@ :: (perform-test-suite:local "test-thr" !>(test-thr) eny) :: (perform-test-suite:local "test-myb" !>(test-myb) eny) -(perform-test-suite:local "test-ls" !>(test-ls) eny) -::(perform-test-suite:local "test-mp" !>(test-mp) eny) +::(perform-test-suite:local "test-ls" !>(test-ls) eny) +(perform-test-suite:local "test-mp" !>(test-mp) eny) diff --git a/lib/new-hoon.hoon b/lib/new-hoon.hoon index 278b6d54f..3d086eead 100644 --- a/lib/new-hoon.hoon +++ b/lib/new-hoon.hoon @@ -1418,5 +1418,53 @@ ?: (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} is a valid treap map. + |* a/(map) + =| {l/(unit) r/(unit)} + |- ^- ? + ?~ 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. + :: todo: think hard about whether this interface really makes any sense; + :: this is marginally better than ++og for rads usage, but still isn't good. + |= a/@ + :: note: interior was copied verbatim from ++og. + |% + ++ rad :: random in range + |= b/@ ^- @ + =+ c=(raw (met 0 b)) + ?:((lth c b) c $(a +(a))) + :: + ++ rads :: random continuation + |= b/@ + =+ r=(rad b) + [r +>.$(a (shas %og-s (mix a r)))] + :: + ++ raw :: random bits + :: ~/ %raw + |= 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))] + :: + ++ raws :: random bits + |= b/@ :: continuation + =+ r=(raw b) + [r +>.$(a (shas %og-s (mix a r)))] -- -- From 7d46bccdfc7cbcaaaf1dd5a8abb90ab76d16712a Mon Sep 17 00:00:00 2001 From: Elliot Glaysher Date: Fri, 29 Sep 2017 21:26:50 -0700 Subject: [PATCH 11/27] Change the interface for random numbers. --- gen/test.hoon | 12 ++++---- lib/new-hoon.hoon | 71 ++++++++++++++++++++++++++++------------------- 2 files changed, 49 insertions(+), 34 deletions(-) diff --git a/gen/test.hoon b/gen/test.hoon index ea7a49f77..476393f2d 100644 --- a/gen/test.hoon +++ b/gen/test.hoon @@ -92,7 +92,9 @@ |= {min/@ max/@} |= c/@uvJ ^- @ - (add min (~(rad og c) (sub max min))) + =+ gen=(random:new-hoon c) + =^ num gen (range:gen min max) + num :: ++ generate-map :> generator which will produce a map with {count} random pairs. @@ -106,8 +108,8 @@ ^- (map @ud @ud) ?: =(i count) m - =^ first gen (rads:gen 100) - =^ second gen (rads:gen 100) + =^ first gen (range:gen 0 100) + =^ second gen (range:gen 0 100) $(m (insert:mp:new-hoon m first second), i +(i)) :: :: || %test @@ -611,8 +613,8 @@ |- ?: =(i 40) %.y - =^ key gen (rads:gen 100) - =^ value gen (rads:gen 100) + =^ 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) diff --git a/lib/new-hoon.hoon b/lib/new-hoon.hoon index 3d086eead..e12957e43 100644 --- a/lib/new-hoon.hoon +++ b/lib/new-hoon.hoon @@ -1432,38 +1432,51 @@ == -- ++ random - :> produces a core which produces random numbers. - :: todo: think hard about whether this interface really makes any sense; - :: this is marginally better than ++og for rads usage, but still isn't good. + :> 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/@ - :: note: interior was copied verbatim from ++og. - |% - ++ rad :: random in range - |= b/@ ^- @ - =+ c=(raw (met 0 b)) - ?:((lth c b) c $(a +(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)))] :: - ++ rads :: random continuation + ++ bits + :> returns {b} bits in the range, and generator. |= b/@ - =+ r=(rad b) - [r +>.$(a (shas %og-s (mix a r)))] - :: - ++ raw :: random bits - :: ~/ %raw - |= 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))] - :: - ++ raws :: random bits - |= b/@ :: continuation =+ r=(raw b) [r +>.$(a (shas %og-s (mix a r)))] -- From 5e2f544a13eba09915336c90fa5234457b76c973 Mon Sep 17 00:00:00 2001 From: Elliot Glaysher Date: Fri, 13 Oct 2017 23:09:01 -0700 Subject: [PATCH 12/27] Change the name of ++map to ++dict so 'map' can be used for 'transform'. --- gen/test.hoon | 26 +++---- lib/new-hoon.hoon | 177 ++++++++++++++++++++++++---------------------- 2 files changed, 107 insertions(+), 96 deletions(-) diff --git a/gen/test.hoon b/gen/test.hoon index 476393f2d..95be5afe8 100644 --- a/gen/test.hoon +++ b/gen/test.hoon @@ -96,21 +96,21 @@ =^ num gen (range:gen min max) num :: - ++ generate-map - :> generator which will produce a map with {count} random pairs. + ++ generate-dict + :> generator which will produce a dict with {count} random pairs. |= count/@u - :> generate a map with entropy {c}. + :> generate a dict with entropy {c}. |= c/@uvJ =/ gen (random:new-hoon c) =| i/@u - =| m/(map @ud @ud) + =| m/(dict:new-hoon @ud @ud) |- - ^- (map @ud @ud) + ^- (dict:new-hoon @ud @ud) ?: =(i count) m =^ first gen (range:gen 0 100) =^ second gen (range:gen 0 100) - $(m (insert:mp:new-hoon m first second), i +(i)) + $(m (insert:dct:new-hoon m first second), i +(i)) :: :: || %test :: @@ -495,7 +495,7 @@ "intersect" -- ++ test-mp - =, mp:new-hoon + =, 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:test-lib @@ -602,11 +602,11 @@ "alter (as change)" :: ++ check-alter - :: check random maps of 50 items with 40 random operations done on them + :: check random dicts of 50 items with 40 random operations done on them :: for validity. %+ check - (generate-map 50) - |= a/(map @ud @ud) + (generate-dict 50) + |= a/(dict @ud @ud) :: this is dumb, but use {a} as entropy? =/ gen (random:new-hoon (jam a)) =| i/@u @@ -838,14 +838,14 @@ (from-list [[1 1] [3 1] [5 1] ~]) "transform-either" :: - ++ test-is-submap + ++ test-is-subdict %^ expect-eq - %^ is-submap-by + %^ 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-submap" + "is-subdict" :: ++ test-valid %^ expect-eq diff --git a/lib/new-hoon.hoon b/lib/new-hoon.hoon index e12957e43..72129e5a4 100644 --- a/lib/new-hoon.hoon +++ b/lib/new-hoon.hoon @@ -789,34 +789,45 @@ :: default. ++sort as is is probably the correct thing to do. :: -- -++ mp +:: +++ 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 map. + :> looks up values in the dict. +| ++ empty - :> is the map empty? - |* a/(map) + :> is the dict empty? + |* a/(dict) ?~ a %.y %.n :: ++ size :> returns the number of elements in {a}. - |= a/(map) + |= a/(dict) ^- @u ?~ a 0 :(add 1 $(a l.a) $(a r.a)) :: ++ member :> returns %.y if {b} is a key in {a}. - |= {a/(map) key/*} + |= {a/(dict) key/*} ^- ? ?~ a %.n ?|(=(key p.n.a) $(a l.a) $(a r.a)) :: ++ get :> grab value by key. - |* {a/(map) key/*} + |* {a/(dict) key/*} ^- (maybe _?>(?=(^ a) q.n.a)) :: ^- {$@($~ {$~ u/_?>(?=(^ a) q.n.a)})} ?~ a @@ -832,7 +843,7 @@ :: ++ got :: :> todo: move impl here. :: :> todo: is there a way to make b/_<><>.a ? -:: |* {a/(map) key/*} +:: |* {a/(dict) key/*} :: (~(got by a) key) :: :: todo: skipping several methods which rely on the the Ord typeclass, like @@ -842,7 +853,7 @@ +| ++ insert :> inserts a new key/value pair, replacing the current value if it exists. - |* {a/(map) key/* value/*} + |* {a/(dict) key/* value/*} |- ^+ a ?~ a [[key value] ~ ~] @@ -864,7 +875,7 @@ :: ++ insert-with :> inserts {key}/{value}, applying {fun} if {key} already exists. - |* {a/(map) key/* value/* fun/$-({* *} *)} + |* {a/(dict) key/* value/* fun/$-({* *} *)} |- ^+ a ?~ a [[key value] ~ ~] @@ -885,7 +896,7 @@ :: ++ insert-with-key :> inserts {key}/{value}, applying {fun} if {key} already exists. - |* {a/(map) key/* value/* fun/$-({* * *} *)} + |* {a/(dict) key/* value/* fun/$-({* * *} *)} |- ^+ a ?~ a [[key value] ~ ~] @@ -906,7 +917,7 @@ :: ++ insert-lookup-with-key :> combines insertion with lookup in one pass. - |* {a/(map) key/* value/* fun/$-({* * *} *)} + |* {a/(dict) key/* value/* fun/$-({* * *} *)} |- ^- {(maybe _value) _a} ?~ a [~ [[key value] ~ ~]] @@ -932,7 +943,7 @@ :: ++ delete :> deletes entry at {key}. - |* {a/(map) key/*} + |* {a/(dict) key/*} |- ^+ a ?~ a ~ @@ -944,7 +955,7 @@ :: ++ adjust :> updates a value at {key} by passing the value to {fun}. - |* {a/(map) key/* fun/$-(* *)} + |* {a/(dict) key/* fun/$-(* *)} %^ alter-with-key a key |= {key/_p.-.n.-.a value/(maybe _q.+.n.-.a)} ^- (maybe _q.+.n.-.a) @@ -953,7 +964,7 @@ :: ++ adjust-with-key :> updates a value at {key} by passing the key/value pair to {fun}. - |* {a/(map) key/* fun/$-({* *} *)} + |* {a/(dict) key/* fun/$-({* *} *)} %^ alter-with-key a key |= {key/_p.-.n.-.a value/(maybe _q.+.n.-.a)} ^- (maybe _q.+.n.-.a) @@ -962,7 +973,7 @@ :: ++ update :> adjusts or deletes the value at {key} by {fun}. - |* {a/(map) key/* fun/$-(* (maybe *))} + |* {a/(dict) key/* fun/$-(* (maybe *))} %^ alter-with-key a key |= {key/_p.-.n.-.a value/(maybe _q.+.n.-.a)} ^- (maybe _q.+.n.-.a) @@ -971,7 +982,7 @@ :: ++ update-with-key :> adjusts or deletes the value at {key} by {fun}. - |* {a/(map) key/* fun/$-({* *} (maybe *))} + |* {a/(dict) key/* fun/$-({* *} (maybe *))} %^ alter-with-key a key |= {key/_p.-.n.-.a value/(maybe _q.+.n.-.a)} ^- (maybe _q.+.n.-.a) @@ -983,14 +994,14 @@ :: ++ alter :> inserts, deletes, or updates a value by {fun}. - |* {a/(map) key/* fun/$-((maybe *) (maybe *))} + |* {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/(map) key/* fun/$-({* (maybe *)} (maybe *))} + |* {a/(dict) key/* fun/$-({* (maybe *)} (maybe *))} |- ^+ a ?~ a =+ ret=(fun key ~) @@ -1023,7 +1034,7 @@ :: ++ union :> returns the union of {a} and {b}, preferring the value from {a} if dupe - |* {a/(map) b/(map)} + |* {a/(dict) b/(dict)} |- ^+ a ?~ b a @@ -1043,7 +1054,7 @@ :: ++ union-with :> returns the union of {a} and {b}, running {fun} to resolve duplicates. - |* {a/(map) b/(map) fun/$-({* *} *)} + |* {a/(dict) b/(dict) fun/$-({* *} *)} |- ^+ a ?~ b a @@ -1063,7 +1074,7 @@ :: ++ union-with-key :> returns the union of {a} and {b}, running {fun} to resolve duplicates. - |* {a/(map) b/(map) fun/$-({* * *} *)} + |* {a/(dict) b/(dict) fun/$-({* * *} *)} |- ^+ a ?~ b a @@ -1086,7 +1097,7 @@ :: ++ difference :: :: todo: move real implementation here. :: :> returns elements in {a} that don't exist in {b}. -:: |* {a/(map) b/(map)} +:: |* {a/(dict) b/(dict)} :: (~(dif by a) b) :: :: :: :: todo: @@ -1096,7 +1107,7 @@ :: ++ intersection :: :: todo: move real implementation here. :: :> returns elements in {a} that exist in {b}. -:: |* {a/(map) b/(map)} +:: |* {a/(dict) b/(dict)} :: (~(int by a) b) :: :: :: :: todo: @@ -1108,16 +1119,16 @@ :: ++ transform :> applies {fun} to each value in {a}. - |* {a/(map) fun/$-(* *)} - ^- (map _p.-.n.-.a fun) + |* {a/(dict) fun/$-(* *)} + ^- (dict _p.-.n.-.a fun) ?~ a ~ [[p.n.a (fun q.n.a)] $(a l.a) $(a r.a)] :: ++ transform-with-key :> applies {fun} to each value in {a}. - |* {a/(map) fun/$-({* *} *)} - ^- (map _p.-.n.-.a _*fun) + |* {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)] @@ -1125,14 +1136,14 @@ ++ transform-fold :> performs a fold on all the values in {a}. :> - :> lists have an order, but maps are treaps. this means there isn't 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/(map) b/* fun/$-({* *} {* *})} - ^- {_b (map _p.-.n.-.a _+:*fun)} + |* {a/(dict) b/* fun/$-({* *} {* *})} + ^- {_b (dict _p.-.n.-.a _+:*fun)} ?~ a [b ~] =+ d=(fun b q.n.a) @@ -1146,7 +1157,7 @@ :: 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/(map) fun/$-(* *)} + |* {a/(dict) fun/$-(* *)} %- from-list %+ transform:ls (to-list a) |= item/_n.-.a @@ -1154,25 +1165,25 @@ :: ++ transform-keys-with :> applies {fun} to all keys, creating a new value with {combine} on dupes. - |* {a/(map) fun/$-(* *) combine/$-({* *} *)} - ^- (map _*fun _q.+.n.-.a) + |* {a/(dict) fun/$-(* *) combine/$-({* *} *)} + ^- (dict _*fun _q.+.n.-.a) =/ new-list %+ transform:ls (to-list a) |= item/_n.-.a [(fun p.item) q.item] %^ foldl:ls new-list - `(map _*fun _q.+.n.-.a)`~ - |= {m/(map _*fun _q.+.n.-.a) p/_i.-.new-list} + `(dict _*fun _q.+.n.-.a)`~ + |= {m/(dict _*fun _q.+.n.-.a) p/_i.-.new-list} (insert-with m -.p +.p combine) :: ++ fold :> performs a fold on all the values in {a}. :> - :> lists have an order, but maps are treaps. this means there isn't 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/(map) b/* fun/$-({* *} *)} + |* {a/(dict) b/* fun/$-({* *} *)} ^- _b ?~ a b @@ -1182,7 +1193,7 @@ :: ++ fold-with-keys :> performs a fold on all the values in {a}, passing keys too. - |* {a/(map) b/* fun/$-({* * *} *)} + |* {a/(dict) b/* fun/$-({* * *} *)} ^+ b ?~ a b @@ -1192,7 +1203,7 @@ :: ++ any :> returns yes if any element satisfies the predicate - |* {a/(map) b/$-(* ?)} + |* {a/(dict) b/$-(* ?)} ^- ? ?~ a %.n @@ -1200,7 +1211,7 @@ :: ++ any-with-key :> returns yes if any element satisfies the predicate - |* {a/(map) b/$-({* *} ?)} + |* {a/(dict) b/$-({* *} ?)} ^- ? ?~ a %.n @@ -1208,7 +1219,7 @@ :: ++ all :> returns yes if all elements satisfy the predicate - |* {a/(map) b/$-(* ?)} + |* {a/(dict) b/$-(* ?)} ^- ? ?~ a %.y @@ -1216,7 +1227,7 @@ :: ++ all-with-key :> returns yes if all elements satisfy the predicate - |* {a/(map) b/$-({* *} ?)} + |* {a/(dict) b/$-({* *} ?)} ^- ? ?~ a %.y @@ -1225,13 +1236,13 @@ :> # %conversion +| ++ elems - :> return all values in the map. - |* a/(map) + :> return all values in the dict. + |* a/(dict) %+ turn (to-list a) second :: ++ keys - :> returns all keys in the map. - |* a/(map) + :> 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 @@ -1239,13 +1250,13 @@ :: ++ keys-set :> returns all keys as a set. - |* a/(map) + |* a/(dict) (si:nl (keys a)) :: ++ from-set - :> computes a map by running {fun} on every value in a set. + :> computes a dict by running {fun} on every value in a set. |* {a/(set) fun/$-(* *)} - ^- (map _n.-.a _*fun) + ^- (dict _n.-.a _*fun) ?~ a ~ [[n.a (fun n.a)] $(a l.a) $(a r.a)] @@ -1255,7 +1266,7 @@ :: ++ to-list :> creates a list of pairs from the tree. - |* a/(map) + |* a/(dict) =| b/(list _n.-.a) |- ^+ b @@ -1268,16 +1279,16 @@ |* a/(list (pair)) |- %^ foldl:ls a - `(map _p.-.i.-.a _q.+.i.-.a)`~ - |= {m/(map _p.-.i.-.a _q.+.i.-.a) p/_i.-.a} + `(dict _p.-.i.-.a _q.+.i.-.a)`~ + |= {m/(dict _p.-.i.-.a _q.+.i.-.a) p/_i.-.a} (insert m p) :: ++ from-list-with - :> creates a map from a list, with {fun} resolving duplicates. + :> creates a dict from a list, with {fun} resolving duplicates. |* {a/(list (pair)) fun/$-(* *)} %^ foldl:ls a - `(map _*fun _q.+.i.-.a)`~ - |= {m/(map _*fun _q.+.i.-.a) p/_i.-.a} + `(dict _*fun _q.+.i.-.a)`~ + |= {m/(dict _*fun _q.+.i.-.a) p/_i.-.a} (insert-with m -.p +.p fun) :: :: todo: without a natural ordering, association lists and gates to operate @@ -1286,15 +1297,15 @@ :> # %filters +| ++ filter - :> filters a map of all values that satisfy {fun}. - |* {a/(map) fun/$-(* ?)} + :> 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 map of all values that satisfy {fun}. - |* {a/(map) fun/$-({* *} ?)} + :> filters a dict of all values that satisfy {fun}. + |* {a/(dict) fun/$-({* *} ?)} |- ^+ a ?~ a ~ @@ -1305,8 +1316,8 @@ [n.a $(a l.a) $(a r.a)] :: ++ restrict-keys - :> returns a map where the only allowable keys are {keys}. - |* {a/(map) keys/(set)} + :> 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 @@ -1314,8 +1325,8 @@ !(~(has in keys) key) :: ++ without-keys - :> returns a map where the only allowable keys are not in {keys}. - |* {a/(map) keys/(set)} + :> 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 @@ -1324,7 +1335,7 @@ :: ++ partition :> returns two lists, one whose elements match {fun}, the other doesn't. - |* {a/(map) fun/$-(* ?)} + |* {a/(dict) fun/$-(* ?)} :: todo: is the runtime on this is bogus? =/ data %+ partition:ls (to-list a) @@ -1335,19 +1346,19 @@ :: 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 map. + :: useful without ordering on the dict. :: ++ transform-maybe :> a version of transform that can throw out items. - |* {a/(map) fun/$-(* (maybe))} + |* {a/(dict) fun/$-(* (maybe))} %+ transform-maybe-with-key a |= {key/* value/_q.+.n.-.a} (fun value) :: ++ transform-maybe-with-key :> a version of transform that can throw out items. - |* {a/(map) fun/$-({* *} (maybe))} - ^- (map _p.-.n.-.a _+:*fun) + |* {a/(dict) fun/$-({* *} (maybe))} + ^- (dict _p.-.n.-.a _+:*fun) ?~ a ~ =+ res=(fun n.a) ?~ res @@ -1357,18 +1368,18 @@ [[p.n.a +.res] $(a l.a) $(a r.a)] :: ++ transform-either - :> splits the map in two on a gate that returns an either. - |* {a/(map) fun/$-(* (either))} + :> splits the dict in two on a gate that returns an either. + |* {a/(dict) fun/$-(* (either))} %+ transform-either-with-key a |= {key/* value/_q.+.n.-.a} (fun value) :: ++ transform-either-with-key - :> splits the map in two on a gate that returns an either. - |* {a/(map) fun/$-({* *} (either))} + :> splits the dict in two on a gate that returns an either. + |* {a/(dict) fun/$-({* *} (either))} |- - ^- $: (map _p.-.n.-.a _?>(?=({{%& *} *} *fun) +:*fun)) - (map _p.-.n.-.a _?>(?=({{%| *} *} *fun) +:*fun)) + ^- $: (dict _p.-.n.-.a _?>(?=({{%& *} *} *fun) +:*fun)) + (dict _p.-.n.-.a _?>(?=({{%| *} *} *fun) +:*fun)) == ?~ a [~ ~] @@ -1385,15 +1396,15 @@ :: ++split, ++split-lookup and ++split-root do not make sense without :: ordinal keys. :: - ++ is-submap + ++ is-subdict :> returns %.y if every element in {a} exists in {b} with the same value. - |* {a/(map) b/(map)} + |* {a/(dict) b/(dict)} ^- ? - (is-submap-by a b |=({a/* b/*} =(a b))) + (is-subdict-by a b |=({a/* b/*} =(a b))) :: - ++ is-submap-by + ++ is-subdict-by :> returns %.y if every element in {a} exists in {b} with the same value. - |* {a/(map) b/(map) fun/$-({* *} ?)} + |* {a/(dict) b/(dict) fun/$-({* *} ?)} |- ^- ? ?~ a %.y @@ -1409,7 +1420,7 @@ +| ++ pop-top :> removes the head of the tree and rebalances the tree below. - |* a/(map) + |* a/(dict) ^- {$?($~ _a)} ?~ a ~ |- @@ -1420,8 +1431,8 @@ [n.r.a $(r.a l.r.a) r.r.a] :: ++ valid - :> returns %.y if {a} is a valid treap map. - |* a/(map) + :> returns %.y if {a} if this tree is a valid treap dict. + |* a/(tree (pair * *)) =| {l/(unit) r/(unit)} |- ^- ? ?~ a & From 22dca3032f5b1c743bd4b7514665cccc5c6d27d8 Mon Sep 17 00:00:00 2001 From: Elliot Glaysher Date: Fri, 13 Oct 2017 23:13:15 -0700 Subject: [PATCH 13/27] Remove 'transform' and use 'map'. --- gen/test.hoon | 80 +++++++++++++++++++++++------------------------ lib/new-hoon.hoon | 46 +++++++++++++-------------- 2 files changed, 63 insertions(+), 63 deletions(-) diff --git a/gen/test.hoon b/gen/test.hoon index 95be5afe8..c7ed8baa9 100644 --- a/gen/test.hoon +++ b/gen/test.hoon @@ -225,13 +225,13 @@ :: doesn't compile anymore? (expect-eq (concat `(list (maybe @ud))`[~ [~ 1] ~ [~ 2] ~]) [1 2 ~] "concat") :: - ++ test-transform + ++ test-map %^ expect-eq - %+ transform + %+ map:myb [1 2 3 2 ~] |=(a/@u ?:(=(2 a) [~ 2] ~)) [2 2 ~] - "transform" + "map" -- ++ test-ls =, ls:new-hoon @@ -251,8 +251,8 @@ ++ test-size (expect-eq (size ['a' 'b' 'c' ~]) 3 "size") :: - ++ test-transform - (expect-eq (transform [1 2 ~] |=(a/@ (add 1 a))) [2 3 ~] "transform") + ++ 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") @@ -320,17 +320,17 @@ ~[6 5 3] "scanr1" :: - ++ test-transform-foldl + ++ test-map-foldl %^ expect-eq - (transform-foldl ~[1 2 3] 1 |=({a/@ b/@} [(add a b) (add 1 a)])) + (map-foldl ~[1 2 3] 1 |=({a/@ b/@} [(add a b) (add 1 a)])) [7 ~[2 3 5]] - "transform-foldl" + "map-foldl" :: - ++ test-transform-foldr + ++ test-map-foldr %^ expect-eq - (transform-foldr ~[1 2 3] 1 |=({a/@ b/@} [(add a b) (add 1 a)])) + (map-foldr ~[1 2 3] 1 |=({a/@ b/@} [(add a b) (add 1 a)])) [7 ~[7 5 2]] - "transform-foldr" + "map-foldr" :: ++ test-unfoldr %^ expect-eq @@ -654,50 +654,50 @@ (from-list [[1 "left"] [2 "2leftright"] [3 "right"] ~]) "union-with-key" :: - ++ test-transform + ++ test-map %^ expect-eq - %+ transform + %+ map:dct three crip (from-list [[1 'one'] [2 'two'] [3 'three'] ~]) - "transform" + "map" :: - ++ test-transform-with-key + ++ test-map-with-key %^ expect-eq - %+ transform-with-key + %+ map-with-key three |=({a/@u b/tape} (weld (scow %ud a) b)) (from-list [[1 "1one"] [2 "2two"] [3 "3three"] ~]) - "transform-with-key" + "map-with-key" :: - ++ test-transform-fold + ++ test-map-fold %^ expect-eq - %^ transform-fold + %^ map-fold three "Everything: " |= {accumulator/tape value/tape} [(weld accumulator value) (weld value "X")] :- "Everything: twoonethree" (from-list [[1 "oneX"] [2 "twoX"] [3 "threeX"] ~]) - "transform-fold" + "map-fold" :: - ++ test-transform-keys + ++ test-map-keys %^ expect-eq - %+ transform-keys + %+ map-keys three |= a/@u (add a 10) (from-list [[11 "one"] [12 "two"] [13 "three"] ~]) - "transform-keys" + "map-keys" :: - ++ test-transform-keys-with + ++ test-map-keys-with %^ expect-eq - %^ transform-keys-with + %^ map-keys-with three |=(a/@u 42) weld (from-list [[42 "twothreeone"] ~]) - "transform-keys-with" + "map-keys-with" :: ++ test-fold %^ expect-eq @@ -709,7 +709,7 @@ ^- tape (weld accumulator value) "Everything: twoonethree" - "transform-fold" + "map-fold" :: ++ test-fold-with-keys %^ expect-eq @@ -720,7 +720,7 @@ ^- tape :(weld accumulator (scow %ud key) value) "Everything: 2two1one3three" - "transform-fold-with-keys" + "map-fold-with-keys" :: ++ test-elems %^ expect-eq @@ -798,25 +798,25 @@ (from-list [[2 2] [4 4] [5 5] ~]) "partition" :: - ++ test-transform-maybe + ++ test-map-maybe %^ expect-eq - %+ transform-maybe + %+ 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] ~]) - "transform-maybe" + "map-maybe" :: - ++ test-transform-maybe-with-key + ++ test-map-maybe-with-key %^ expect-eq - %+ transform-maybe-with-key + %+ 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] ~]) - "transform-maybe-with-key" + "map-maybe-with-key" :: - ++ test-transform-either + ++ test-map-either %^ expect-eq - %+ transform-either + %+ map-either (from-list [[1 1] [2 2] [3 3] [4 4] [5 5] ~]) |= value/@u ?: =(0 (mod value 2)) @@ -824,11 +824,11 @@ [%| 1] :- (from-list [[2 "even"] [4 "even"] ~]) (from-list [[1 1] [3 1] [5 1] ~]) - "transform-either" + "map-either" :: - ++ test-transform-either-with-key + ++ test-map-either-with-key %^ expect-eq - %+ transform-either-with-key + %+ map-either-with-key (from-list [[1 1] [2 1] [3 1] [4 1] [5 1] ~]) |= {key/@u value/@u} ?: =(0 (mod key 2)) @@ -836,7 +836,7 @@ [%| 1] :- (from-list [[2 "even"] [4 "even"] ~]) (from-list [[1 1] [3 1] [5 1] ~]) - "transform-either" + "map-either" :: ++ test-is-subdict %^ expect-eq diff --git a/lib/new-hoon.hoon b/lib/new-hoon.hoon index 72129e5a4..9fb2cd582 100644 --- a/lib/new-hoon.hoon +++ b/lib/new-hoon.hoon @@ -127,8 +127,8 @@ $(a t.a) [u.i.a $(a t.a)] :: - ++ transform - :> a version of transform that can throw out items. + ++ map + :> a version of map that can throw out items. :> :> takes a list of items and a function of the type :> @@ -225,11 +225,11 @@ b $(a t.a, b +(b)) :: - :> # %transformations + :> # %mappings :> functions which change a list into another list +| :: - ++ transform + ++ map :> applies a gate to each item in the list. |* {a/(list) b/$-(* *)} ^- (list _*b) @@ -413,8 +413,8 @@ ?> ?=(^ rest) [(c i.a i.rest) rest] :: - ++ transform-foldl - :> performs both a ++transform and a ++foldl in one pass. + ++ map-foldl + :> performs both a ++map and a ++foldl in one pass. :> :> corresponds to {mapAccumL} in haskell. |* {a/(list) b/* c/$-({* *} {* *})} @@ -425,8 +425,8 @@ =+ recurse=$(a t.a, b -.d) [-.recurse [+.d +.recurse]] :: - ++ transform-foldr - :> performs both a ++transform and a ++foldr in one pass. + ++ map-foldr + :> performs both a ++map and a ++foldr in one pass. :> :> corresponds to {mapAccumR} in haskell. |* {a/(list) b/* c/$-({* *} {* *})} @@ -1117,7 +1117,7 @@ :> # %traversal +| :: - ++ transform + ++ map :> applies {fun} to each value in {a}. |* {a/(dict) fun/$-(* *)} ^- (dict _p.-.n.-.a fun) @@ -1125,7 +1125,7 @@ ~ [[p.n.a (fun q.n.a)] $(a l.a) $(a r.a)] :: - ++ transform-with-key + ++ map-with-key :> applies {fun} to each value in {a}. |* {a/(dict) fun/$-({* *} *)} ^- (dict _p.-.n.-.a _*fun) @@ -1133,7 +1133,7 @@ ~ [[p.n.a (fun p.n.a q.n.a)] $(a l.a) $(a r.a)] :: - ++ transform-fold + ++ 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 @@ -1152,23 +1152,23 @@ =+ f=$(a r.a, b -.e) [-.f [n.a +.e +.f]] :: - ++ transform-keys + ++ 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 - %+ transform:ls (to-list a) + %+ map:ls (to-list a) |= item/_n.-.a [(fun p.item) q.item] :: - ++ transform-keys-with + ++ 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 - %+ transform:ls (to-list a) + %+ map:ls (to-list a) |= item/_n.-.a [(fun p.item) q.item] %^ foldl:ls new-list @@ -1348,15 +1348,15 @@ :: i'm going to ignore all the Antitone functions; they don't seem to be :: useful without ordering on the dict. :: - ++ transform-maybe - :> a version of transform that can throw out items. + ++ map-maybe + :> a version of map that can throw out items. |* {a/(dict) fun/$-(* (maybe))} - %+ transform-maybe-with-key a + %+ map-maybe-with-key a |= {key/* value/_q.+.n.-.a} (fun value) :: - ++ transform-maybe-with-key - :> a version of transform that can throw out items. + ++ map-maybe-with-key + :> a version of map that can throw out items. |* {a/(dict) fun/$-({* *} (maybe))} ^- (dict _p.-.n.-.a _+:*fun) ?~ a ~ @@ -1367,14 +1367,14 @@ (pop-top a) [[p.n.a +.res] $(a l.a) $(a r.a)] :: - ++ transform-either + ++ map-either :> splits the dict in two on a gate that returns an either. |* {a/(dict) fun/$-(* (either))} - %+ transform-either-with-key a + %+ map-either-with-key a |= {key/* value/_q.+.n.-.a} (fun value) :: - ++ transform-either-with-key + ++ map-either-with-key :> splits the dict in two on a gate that returns an either. |* {a/(dict) fun/$-({* *} (either))} |- From c2b8d61fa2350af58ae02b461c0e4d25427c7ce1 Mon Sep 17 00:00:00 2001 From: Elliot Glaysher Date: Fri, 13 Oct 2017 23:28:11 -0700 Subject: [PATCH 14/27] insert -> put --- gen/test.hoon | 20 ++++++++++---------- lib/new-hoon.hoon | 18 +++++++++--------- 2 files changed, 19 insertions(+), 19 deletions(-) diff --git a/gen/test.hoon b/gen/test.hoon index c7ed8baa9..2e54e4b55 100644 --- a/gen/test.hoon +++ b/gen/test.hoon @@ -110,7 +110,7 @@ m =^ first gen (range:gen 0 100) =^ second gen (range:gen 0 100) - $(m (insert:dct:new-hoon m first second), i +(i)) + $(m (put:dct:new-hoon m first second), i +(i)) :: :: || %test :: @@ -508,29 +508,29 @@ ++ test-member (expect-eq (member four 4) %.y "member") :: - ++ test-insert-with + ++ test-put-with =+ ints=(from-list [["one" 1] ["two" 2] ["three" 3] ["four" 4] ~]) %^ expect-eq - (insert-with ints "three" 2 add) + (put-with ints "three" 2 add) (from-list [["one" 1] ["two" 2] ["three" 5] ["four" 4] ~]) - "insert-with" + "put-with" :: - ++ test-insert-with-key + ++ test-put-with-key %^ expect-eq - (insert-with-key four 4 "four" |=({a/@ud b/tape c/tape} (weld (scow %ud a) b))) + (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"] ~]) - "insert-with-key" + "put-with-key" :: - ++ test-insert-lookup-with-key + ++ test-put-lookup-with-key %^ expect-eq - %- insert-lookup-with-key :^ + %- 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"] ~]) - "insert-lookup-with-key" + "put-lookup-with-key" :: ++ test-delete %^ expect-eq diff --git a/lib/new-hoon.hoon b/lib/new-hoon.hoon index 9fb2cd582..3c253cb71 100644 --- a/lib/new-hoon.hoon +++ b/lib/new-hoon.hoon @@ -851,7 +851,7 @@ :: :> # %insertion +| - ++ insert + ++ put :> inserts a new key/value pair, replacing the current value if it exists. |* {a/(dict) key/* value/*} |- ^+ a @@ -873,7 +873,7 @@ [n.a l.a d] [n.d [n.a l.a l.d] r.d] :: - ++ insert-with + ++ put-with :> inserts {key}/{value}, applying {fun} if {key} already exists. |* {a/(dict) key/* value/* fun/$-({* *} *)} |- ^+ a @@ -894,7 +894,7 @@ [n.a l.a d] [n.d [n.a l.a l.d] r.d] :: - ++ insert-with-key + ++ put-with-key :> inserts {key}/{value}, applying {fun} if {key} already exists. |* {a/(dict) key/* value/* fun/$-({* * *} *)} |- ^+ a @@ -915,7 +915,7 @@ [n.a l.a d] [n.d [n.a l.a l.d] r.d] :: - ++ insert-lookup-with-key + ++ put-lookup-with-key :> combines insertion with lookup in one pass. |* {a/(dict) key/* value/* fun/$-({* * *} *)} |- ^- {(maybe _value) _a} @@ -1174,7 +1174,7 @@ %^ foldl:ls new-list `(dict _*fun _q.+.n.-.a)`~ |= {m/(dict _*fun _q.+.n.-.a) p/_i.-.new-list} - (insert-with m -.p +.p combine) + (put-with m -.p +.p combine) :: ++ fold :> performs a fold on all the values in {a}. @@ -1281,7 +1281,7 @@ %^ foldl:ls a `(dict _p.-.i.-.a _q.+.i.-.a)`~ |= {m/(dict _p.-.i.-.a _q.+.i.-.a) p/_i.-.a} - (insert m p) + (put m p) :: ++ from-list-with :> creates a dict from a list, with {fun} resolving duplicates. @@ -1289,7 +1289,7 @@ %^ foldl:ls a `(dict _*fun _q.+.i.-.a)`~ |= {m/(dict _*fun _q.+.i.-.a) p/_i.-.a} - (insert-with m -.p +.p fun) + (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. @@ -1389,8 +1389,8 @@ =+ x=(fun n.a) ~! x ?- -.x - $& [(insert (union -.lr -.rr) p.n.a +.x) (union +.lr +.rr)] - $| [(union -.lr -.rr) (insert (union +.lr +.rr) p.n.a +.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 From 1541a8df752450c5dad6b2c0b314620a0e56df80 Mon Sep 17 00:00:00 2001 From: Elliot Glaysher Date: Sun, 5 Nov 2017 15:44:37 -0800 Subject: [PATCH 15/27] A few more gates / minor changes. --- gen/test.hoon | 27 ++++++++++++--- lib/new-hoon.hoon | 87 ++++++++++++++++++++++++++++++++++++++++------- 2 files changed, 97 insertions(+), 17 deletions(-) diff --git a/gen/test.hoon b/gen/test.hoon index 2e54e4b55..bcc933095 100644 --- a/gen/test.hoon +++ b/gen/test.hoon @@ -392,6 +392,18 @@ [~ "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") @@ -464,6 +476,12 @@ [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 ~]) @@ -930,8 +948,7 @@ :: todo: right now, we hard code ++test-core. but eventually, we must instead :: scry ford for the core from the hoon file. that doesn't exist yet. ::(perform-test-suite:local "test-core" !>(test-core) eny) - -:: (perform-test-suite:local "test-thr" !>(test-thr) eny) -:: (perform-test-suite:local "test-myb" !>(test-myb) eny) -::(perform-test-suite:local "test-ls" !>(test-ls) eny) -(perform-test-suite:local "test-mp" !>(test-mp) eny) +::(perform-test-suite:local "test-thr" !>(test-thr) eny) +::(perform-test-suite:local "test-myb" !>(test-myb) eny) +(perform-test-suite:local "test-ls" !>(test-ls) eny) +::(perform-test-suite:local "test-mp" !>(test-mp) eny) diff --git a/lib/new-hoon.hoon b/lib/new-hoon.hoon index 3c253cb71..4a6215d0d 100644 --- a/lib/new-hoon.hoon +++ b/lib/new-hoon.hoon @@ -180,6 +180,7 @@ ++ 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 @@ -196,12 +197,13 @@ ++ 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/(list) => .(a (homo a)) |- ^+ a @@ -225,7 +227,7 @@ b $(a t.a, b +(b)) :: - :> # %mappings + :> # %transformations :> functions which change a list into another list +| :: @@ -561,10 +563,27 @@ $(a +.a, b +.b) :: :: todo: ++group - :: todo: ++inits - :: todo: ++tails :: - + ++ 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 +| @@ -713,8 +732,44 @@ [i $(a t.a, i +(i))] $(a t.a, i +(i)) :: - :: can we do a full general zip without doing haskellesque zip3, zip4, etc? - :: todo: ++zip + ++ 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 @@ -852,7 +907,9 @@ :> # %insertion +| ++ put - :> inserts a new key/value pair, replacing the current value if it exists. + :> inserts a new key/value pair, replacing the current value if it exists. + :> + :> corresponds to {insert} in haskell. |* {a/(dict) key/* value/*} |- ^+ a ?~ a @@ -874,7 +931,9 @@ [n.d [n.a l.a l.d] r.d] :: ++ put-with - :> inserts {key}/{value}, applying {fun} if {key} already exists. + :> inserts {key}/{value}, applying {fun} if {key} already exists. + :> + :> corresponds to {insertWith} in haskell. |* {a/(dict) key/* value/* fun/$-({* *} *)} |- ^+ a ?~ a @@ -895,7 +954,9 @@ [n.d [n.a l.a l.d] r.d] :: ++ put-with-key - :> inserts {key}/{value}, applying {fun} if {key} already exists. + :> inserts {key}/{value}, applying {fun} if {key} already exists. + :> + :> corresponds to {insertWithKey} in haskell. |* {a/(dict) key/* value/* fun/$-({* * *} *)} |- ^+ a ?~ a @@ -916,7 +977,9 @@ [n.d [n.a l.a l.d] r.d] :: ++ put-lookup-with-key - :> combines insertion with lookup in one pass. + :> combines insertion with lookup in one pass. + :> + :> corresponds to {insertLookupWithKey} in haskell. |* {a/(dict) key/* value/* fun/$-({* * *} *)} |- ^- {(maybe _value) _a} ?~ a @@ -1433,7 +1496,7 @@ ++ valid :> returns %.y if {a} if this tree is a valid treap dict. |* a/(tree (pair * *)) - =| {l/(unit) r/(unit)} + =| {l/(maybe) r/(maybe)} |- ^- ? ?~ a & ?& ?~(l & (gor p.n.a u.l)) From 8976775ff0e7521a396c69ca037fcbf790ae5ed9 Mon Sep 17 00:00:00 2001 From: Elliot Glaysher Date: Thu, 9 Nov 2017 22:34:27 -0800 Subject: [PATCH 16/27] Update |= and |* twigs to %143 format. --- lib/new-hoon.hoon | 302 +++++++++++++++++++++++----------------------- 1 file changed, 151 insertions(+), 151 deletions(-) diff --git a/lib/new-hoon.hoon b/lib/new-hoon.hoon index 4a6215d0d..3354b7b49 100644 --- a/lib/new-hoon.hoon +++ b/lib/new-hoon.hoon @@ -2,20 +2,20 @@ |% :: ++ first - |* a/^ + |* a=^ -.a :: ++ second - |* a/^ + |* a=^ +.a :: -++ either |*({a/mold b/mold} $%({$& p/a} {$| p/b})) :: either +++ 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=(either) b=$-(* *) c=$-(* *)] ?- -.a $& (b p.a) $| (c p.a) @@ -23,7 +23,7 @@ :: ++ firsts :> returns a list of all first elements in {a}. - |* a/(list (either)) + |* a=(list (either)) => .(a (homo a)) |- ?~ a @@ -35,7 +35,7 @@ :: ++ seconds :> returns a list of all second elements in {a}. - |* a/(list (either)) + |* a=(list (either)) => .(a (homo a)) |- ?~ a @@ -47,7 +47,7 @@ :: ++ partition :> splits the list of eithers into two lists based on first or second. - |* a/(list (either)) + |* a=(list (either)) => .(a (homo a)) |- ^- {(list _?>(?=({{%& *} *} a) p.i.a)) (list _?>(?=({{%| *} *} a) p.i.a))} @@ -59,14 +59,14 @@ $| [-.ret [p.i.a +.ret]] == -- -++ maybe |*(a/mold $@($~ {$~ u/a})) :: maybe +++ maybe |*(a=mold $@($~ {$~ u/a})) :: maybe ++ myb |% ++ is-null :> returns %.y if maybe is null. :> :> corresponds to {isJust} in haskell. - |* a/(maybe) + |* a=(maybe) :> whether {a} is null. ?~ a %.y %.n @@ -75,7 +75,7 @@ :> returns %.y if maybe contains a real value. :> :> corresponds to {isNothing} in haskell. - |* a/(maybe) + |* a=(maybe) :> whether {a} is not null. ?~ a %.n %.y @@ -84,7 +84,7 @@ :> returns the value or crashes. :> :> corresponds to {fromJust} in haskell. - |* a/(maybe) + |* a=(maybe) ?~ a ~>(%mean.[%leaf "need"] !!) :> the value from the maybe. u.a @@ -93,14 +93,14 @@ :> returns the value in the maybe, or a default value on null. :> :> corresponds to {fromMaybe} in haskell. - |* {a/(maybe) b/*} + |* [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) + |* a=(list) ^- (maybe _i.a) ?~ a ~ [~ i.a] @@ -109,7 +109,7 @@ :> converts the maybe to a list. :> :> corresponds to {maybeToList} in haskell. - |* a/(maybe) + |* a=(maybe) ^- (list _u.a) ?~ a ~ [u.a ~] @@ -118,7 +118,7 @@ :> converts a list of maybes to a list of non-null values. :> :> corresponds to {catMaybes} in haskell. - |* a/(list (maybe)) + |* a=(list (maybe)) => .(a (homo a)) |- ^- (list _u.+.i.-.a) @@ -136,7 +136,7 @@ :> logically be put in our list class? murn is. :> :> corresponds to {mapMaybes} in haskell. - |* {a/(list) b/$-(* (maybe))} + |* [a=(list) b=$-(* (maybe))] => .(a (homo a)) |- ^- (list _,.+:*b) @@ -150,7 +150,7 @@ :: ++ apply :> applies {b} to {a}. - |* {a/(maybe) b/$-(* (maybe))} + |* [a=(maybe) b=$-(* (maybe))] ?~ a ~ (b u.a) :: @@ -179,7 +179,7 @@ :: ++ head :> returns the first item in the list, which must be non-empty. - |* a/(list) + |* a=(list) => .(a (homo a)) :> the first item in the list. ?~ a ~>(%mean.[%leaf "head"] !!) @@ -187,7 +187,7 @@ :: ++ last :> returns the final item in the list, which must be non-empty. - |* a/(list) + |* a=(list) :> the last item in a list. ?~ a ~>(%mean.[%leaf "last"] !!) ?~ t.a @@ -196,14 +196,14 @@ :: ++ tail :> returns all items after the head of the list, which must be non-empty. - |* a/(list) + |* 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=(list) => .(a (homo a)) |- ^+ a @@ -219,8 +219,8 @@ :> returns the number of items in {a}. :> :> corresponds to {length} in haskell. - |= a/(list) - =| b/@u + |= a=(list) + =| b=@u ^- @u |- ?~ a @@ -233,14 +233,14 @@ :: ++ map :> applies a gate to each item in the list. - |* {a/(list) b/$-(* *)} + |* [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=(list) => .(a (homo a)) ^+ a =+ b=`_a`~ @@ -250,7 +250,7 @@ :: ++ intersperse :> places {a} between each element in {b}. - |* {a/* b/(list)} + |* [a=* b=(list)] => .(b (homo b)) |- ^+ (homo [a b]) @@ -263,7 +263,7 @@ :: ++ intercalate :> places {a} between each list in {b}, and flatten to a single list. - |* {a/(list) b/(list (list))} + |* [a=(list) b=(list (list))] => .(a ^.(homo a), b ^.(homo b)) |- ^+ (concat [a b]) @@ -276,7 +276,7 @@ :: ++ transpose :> transposes rows and columns of a 2d list structure. - |* input/(list (list)) + |* input=(list (list)) :: todo: this should homogenize with each sublist. ^- (list (list)) =/ items @@ -295,14 +295,14 @@ [(reverse -.items) $(input (reverse +.items))] :: :: :: ++ subsequences -:: :: |= a/(list) +:: :: |= a=(list) :: :: ?~ a :: :: ~ :: :: :- -.a :: :: %^ foldr :: :: $(a +.a) :: :: `(list)`~ -:: :: |= {ys/(list) r/(list)} +:: :: |= [ys=(list) r=(list)] :: :: ~ ::[ys [-.a ys] r ~] :: :: TODO: :: :: ++subsequences @@ -317,7 +317,7 @@ :> left associative fold :> :> this follows haskell giving an explicit starting value instead of {roll}. - |* {a/(list) b/* c/$-({* *} *)} + |* [a=(list) b=* c=$-({* *} *)] ^+ b ?~ a b @@ -325,7 +325,7 @@ :: ++ foldr :> right associative fold - |* {a/(list) b/* c/$-({* *} *)} + |* [a=(list) b=* c=$-({* *} *)] ^+ b ?~ a b @@ -333,7 +333,7 @@ :: ++ concat :> concatenate a list of lists into a single level. - |* a/(list (list)) + |* a=(list (list)) => .(a ^.(homo a)) |- ^+ (homo i:-.a) ?~ a @@ -342,7 +342,7 @@ :: ++ weld :> combine two lists, possibly of different types. - |* {a/(list) b/(list)} + |* [a=(list) b=(list)] => .(a ^.(homo a), b ^.(homo b)) |- ^- (list $?(_i.-.a _i.-.b)) ?~ a b @@ -350,14 +350,14 @@ :: ++ any :> returns yes if any element satisfies the predicate - |* {a/(list) b/$-(* ?)} + |* [a=(list) b=$-(* ?)] ?~ a %.n ?|((b i.a) $(a t.a)) :: ++ all :> returns yes if all elements satisfy the predicate - |* {a/(list) b/$-(* ?)} + |* [a=(list) b=$-(* ?)] ?~ a %.y ?&((b i.a) $(a t.a)) @@ -371,7 +371,7 @@ +| ++ scanl :> returns a list of successive reduced values from the left. - |* {a/(list) b/* c/$-({* *} *)} + |* [a=(list) b=* c=$-({* *} *)] => .(a (homo a)) |- ?~ a @@ -380,7 +380,7 @@ :: ++ scanl1 :> a variant of ++scanl that has no starting value. - |* {a/(list) c/$-({* *} *)} + |* [a=(list) c=$-({* *} *)] => .(a (homo a)) |- ?~ a @@ -391,7 +391,7 @@ :: ++ scanr :> the right-to-left version of scanl. - |* {a/(list) b/* c/$-({* *} *)} + |* [a=(list) b=* c=$-({* *} *)] => .(a (homo a)) |- ^- (list _b) @@ -403,7 +403,7 @@ :: ++ scanr1 :> a variant of ++scanr that has no starting value. - |* {a/(list) c/$-({* *} *)} + |* [a=(list) c=$-({* *} *)] => .(a (homo a)) |- ^+ a @@ -419,7 +419,7 @@ :> performs both a ++map and a ++foldl in one pass. :> :> corresponds to {mapAccumL} in haskell. - |* {a/(list) b/* c/$-({* *} {* *})} + |* [a=(list) b=* c=$-({* *} {* *})] ^- {_b (list _+:*c)} ?~ a [b ~] @@ -431,7 +431,7 @@ :> performs both a ++map and a ++foldr in one pass. :> :> corresponds to {mapAccumR} in haskell. - |* {a/(list) b/* c/$-({* *} {* *})} + |* [a=(list) b=* c=$-({* *} {* *})] ^- {_b (list _+:*c)} ?~ a [b ~] @@ -441,7 +441,7 @@ :: ++ unfoldr :> generates a list from a seed value and a function. - |* {b/* c/$-(* (maybe {* *}))} + |* [b=* c=$-(* (maybe {* *}))] |- ^- (list _b) =+ current=(c b) @@ -457,7 +457,7 @@ :: ++ take :> returns the first {a} elements of {b}. - |* {a/@ b/(list)} + |* [a=@ b=(list)] => .(b (homo b)) |- ^+ b @@ -469,7 +469,7 @@ :: ++ drop :> returns {b} without the first {a} elements. - |* {a/@ b/(list)} + |* [a=@ b=(list)] ?: =(0 a) b ?~ b @@ -478,7 +478,7 @@ :: ++ split-at :> returns {b} split into two lists at the {a}th element. - |* {a/@ b/(list)} + |* [a=@ b=(list)] => .(b (homo b)) |- ^+ [b b] @@ -491,7 +491,7 @@ :: ++ take-while :> returns elements from {a} until {b} returns %.no. - |* {a/(list) b/$-(* ?)} + |* [a=(list) b=$-(* ?)] => .(a (homo a)) |- ^+ a @@ -503,7 +503,7 @@ :: ++ drop-while :> returns elements form {a} once {b} returns %.no. - |* {a/(list) b/$-(* ?)} + |* [a=(list) b=$-(* ?)] => .(a (homo a)) |- ?~ a @@ -514,7 +514,7 @@ :: ++ drop-while-end :> drops the largest suffix of {a} which matches {b}. - |* {a/(list) b/$-(* ?)} + |* [a=(list) b=$-(* ?)] => .(a (homo a)) |- ?~ a @@ -528,7 +528,7 @@ :> 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=(list) b=$-(* ?)] => .(a (homo a)) |- ^+ [a a] @@ -541,7 +541,7 @@ :: ++ break :> like {split-on}, but reverses the return code of {b}. - |* {a/(list) b/$-(* ?)} + |* [a=(list) b=$-(* ?)] => .(a (homo a)) |- ^+ [a a] @@ -554,7 +554,7 @@ :: ++ strip-prefix :> returns a {maybe} of {b} with the prefix {a} removed, or ~ if no match. - |* {a/(list) b/(list)} + |* [a=(list) b=(list)] ^- (maybe _b) ?~ a `b @@ -569,7 +569,7 @@ :> :> unlike haskell, this does not return the empty list as the first :> element, as hoon uses null as the list terminator. - |* a/(list) + |* a=(list) => .(a (homo a)) %- flop |- @@ -578,7 +578,7 @@ :: ++ tails :> returns all final segments, longest first. - |* a/(list) + |* a=(list) => .(a (homo a)) |- ?~ a ~ @@ -590,7 +590,7 @@ :: ++ is-prefix-of :> returns %.y if the first list is a prefix of the second. - |* {a/(list) b/(list)} + |* [a=(list) b=(list)] => .(a (homo a), b (homo b)) |- ^- ? @@ -604,7 +604,7 @@ :: ++ is-suffix-of :> returns %.y if the first list is the suffix of the second. - |* {a/(list) b/(list)} + |* [a=(list) b=(list)] => .(a (homo a), b (homo b)) ^- ? :: todo: this is performant in haskell because of laziness but may not be @@ -613,7 +613,7 @@ :: ++ is-infix-of :> returns %.y if the first list appears anywhere in the second. - |* {a/(list) b/(list)} + |* [a=(list) b=(list)] => .(a (homo a), b (homo b)) |- ^- ? @@ -632,7 +632,7 @@ :: ++ elem :> does {a} occur in list {b}? - |* {a/* b/(list)} + |* [a=* b=(list)] ?~ b %.n ?: =(a i.b) @@ -641,7 +641,7 @@ :: ++ lookup :> looks up the key {a} in the association list {b} - |* {a/* b/(list (pair))} + |* [a=* b=(list (pair))] ^- (maybe _+.-.b) ?~ b ~ @@ -651,7 +651,7 @@ :: ++ find :> returns the first element of {a} which matches predicate {b}. - |* {a/(list) b/$-(* ?)} + |* [a=(list) b=$-(* ?)] ^- (maybe _-.a) ?~ a ~ @@ -661,7 +661,7 @@ :: ++ filter :> filter all items in {a} which match predicate {b}. - |* {a/(list) b/$-(* ?)} + |* [a=(list) b=$-(* ?)] => .(a (homo a)) |- ^+ a @@ -673,7 +673,7 @@ :: ++ partition :> returns two lists, one whose elements match {b}, the other which doesn't. - |* {a/(list) b/$-(* ?)} + |* [a=(list) b=$-(* ?)] => .(a (homo a)) |- ^+ [a a] @@ -690,8 +690,8 @@ :: ++ elem-index :> returns {maybe} the first occurrence of {a} occur in list {b}. - =| i/@u - |= {a/* b/(list)} + =| i=@u + |= [a=* b=(list)] ^- (maybe @ud) ?~ b ~ @@ -702,7 +702,7 @@ ++ elem-indices :> returns a list of indices of all occurrences of {a} in {b}. =| i/@u - |= {a/* b/(list)} + |= [a=* b=(list)] ^- (list @ud) ?~ b ~ @@ -712,8 +712,8 @@ :: ++ find-index :> returns {maybe} the first occurrence which matches {b} in {a}. - =| i/@u - |* {a/(list) b/$-(* ?)} + =| i=@u + |* [a=(list) b=$-(* ?)] ^- (maybe @ud) ?~ a ~ @@ -723,8 +723,8 @@ :: ++ find-indices :> returns a list of indices of all items in {a} which match {b}. - =| i/@u - |* {a/(list) b/$-(* ?)} + =| i=@u + |* [a=(list) b=$-(* ?)] ^- (list @ud) ?~ a ~ @@ -734,7 +734,7 @@ :: ++ zip :> takes a list of lists, returning a list of each first items. - |* a/(list (list)) + |* a=(list (list)) => .(a (multi-homo a)) |^ ^+ a ?~ a ~ @@ -746,7 +746,7 @@ :: ++ valid %+ all a - |= {next/(list)} + |= next=(list) ?~ a %.n %.y :: @@ -765,7 +765,7 @@ [t.i.a $(a t.a)] -- ++ multi-homo - |* a/(list (list)) + |* a=(list (list)) ^+ =< $ |% +- $ ?:(*? ~ [i=(homo (snag 0 a)) t=$]) -- @@ -778,7 +778,7 @@ :> removes duplicates elements from {a} :> :> corresponds to {nub} in haskell. - |* a/(list) + |* a=(list) => .(a (homo a)) =| seen/(list) ^+ a @@ -791,7 +791,7 @@ :: ++ delete :> removes the first occurrence of {a} in {b} - |* {a/* b/(list)} + |* [a=* b=(list)] => .(b (homo b)) ^+ b |- @@ -803,7 +803,7 @@ :: ++ delete-firsts :> deletes the first occurrence of each element in {b} from {a}. - |* {a/(list) b/(list)} + |* [a=(list) b=(list)] => .(a (homo a), b (homo b)) |- ^+ a @@ -817,7 +817,7 @@ :: ++ union :> the list union of {a} and {b}. - |* {a/(list) b/(list)} + |* [a=(list) b=(list)] => .(a (homo a), b (homo b)) |- ^+ (weld a b) @@ -829,7 +829,7 @@ :: ++ intersect :> the intersection of {a} and {b}. - |* {a/(list) b/(list)} + |* [a=(list) b=(list)] => .(a (homo a), b (homo b)) |- ^+ a @@ -850,7 +850,7 @@ :> :> a dictionary is treap ordered; it builds a treap out of the hashed key :> values. - |* {a/mold b/mold} + |* [a=mold b=mold] %+ cork (tree (pair a b)) |= c/(tree (pair a b)) ^+ c ?.((valid:dct c) ~ c) @@ -862,27 +862,27 @@ +| ++ empty :> is the dict empty? - |* a/(dict) + |* a=(dict) ?~ a %.y %.n :: ++ size :> returns the number of elements in {a}. - |= a/(dict) + |= 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=(dict) key=*] ^- ? ?~ a %.n ?|(=(key p.n.a) $(a l.a) $(a r.a)) :: ++ get :> grab value by key. - |* {a/(dict) key/*} + |* [a=(dict) key=*] ^- (maybe _?>(?=(^ a) q.n.a)) :: ^- {$@($~ {$~ u/_?>(?=(^ a) q.n.a)})} ?~ a @@ -898,7 +898,7 @@ :: ++ got :: :> todo: move impl here. :: :> todo: is there a way to make b/_<><>.a ? -:: |* {a/(dict) key/*} +:: |* [a=(dict) key=*] :: (~(got by a) key) :: :: todo: skipping several methods which rely on the the Ord typeclass, like @@ -910,7 +910,7 @@ :> inserts a new key/value pair, replacing the current value if it exists. :> :> corresponds to {insert} in haskell. - |* {a/(dict) key/* value/*} + |* [a=(dict) key=* value=*] |- ^+ a ?~ a [[key value] ~ ~] @@ -934,7 +934,7 @@ :> inserts {key}/{value}, applying {fun} if {key} already exists. :> :> corresponds to {insertWith} in haskell. - |* {a/(dict) key/* value/* fun/$-({* *} *)} + |* [a=(dict) key=* value=* fun=$-({* *} *)] |- ^+ a ?~ a [[key value] ~ ~] @@ -957,7 +957,7 @@ :> inserts {key}/{value}, applying {fun} if {key} already exists. :> :> corresponds to {insertWithKey} in haskell. - |* {a/(dict) key/* value/* fun/$-({* * *} *)} + |* [a=(dict) key=* value=* fun=$-({* * *} *)] |- ^+ a ?~ a [[key value] ~ ~] @@ -980,7 +980,7 @@ :> combines insertion with lookup in one pass. :> :> corresponds to {insertLookupWithKey} in haskell. - |* {a/(dict) key/* value/* fun/$-({* * *} *)} + |* [a=(dict) key=* value=* fun=$-({* * *} *)] |- ^- {(maybe _value) _a} ?~ a [~ [[key value] ~ ~]] @@ -1006,7 +1006,7 @@ :: ++ delete :> deletes entry at {key}. - |* {a/(dict) key/*} + |* [a=(dict) key=*] |- ^+ a ?~ a ~ @@ -1018,36 +1018,36 @@ :: ++ adjust :> updates a value at {key} by passing the value to {fun}. - |* {a/(dict) key/* fun/$-(* *)} + |* [a=(dict) key=* fun=$-(* *)] %^ alter-with-key a key - |= {key/_p.-.n.-.a value/(maybe _q.+.n.-.a)} + |= [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/$-({* *} *)} + |* [a=(dict) key=* fun=$-({* *} *)] %^ alter-with-key a key - |= {key/_p.-.n.-.a value/(maybe _q.+.n.-.a)} + |= [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 *))} + |* [a=(dict) key=* fun=$-(* (maybe *))] %^ alter-with-key a key - |= {key/_p.-.n.-.a value/(maybe _q.+.n.-.a)} + |= [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 *))} + |* [a=(dict) key=* fun=$-({* *} (maybe *))] %^ alter-with-key a key - |= {key/_p.-.n.-.a value/(maybe _q.+.n.-.a)} + |= [key=_p.-.n.-.a value=(maybe _q.+.n.-.a)] ^- (maybe _q.+.n.-.a) ?~ value ~ (fun key u.value) @@ -1057,14 +1057,14 @@ :: ++ alter :> inserts, deletes, or updates a value by {fun}. - |* {a/(dict) key/* fun/$-((maybe *) (maybe *))} + |* [a=(dict) key=* fun=$-((maybe *) (maybe *))] %^ alter-with-key a key - |= {key/_p.-.n.-.a value/(maybe _q.+.n.-.a)} + |= [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=(dict) key=* fun=$-({* (maybe *)} (maybe *))] |- ^+ a ?~ a =+ ret=(fun key ~) @@ -1097,7 +1097,7 @@ :: ++ union :> returns the union of {a} and {b}, preferring the value from {a} if dupe - |* {a/(dict) b/(dict)} + |* [a=(dict) b=(dict)] |- ^+ a ?~ b a @@ -1117,7 +1117,7 @@ :: ++ union-with :> returns the union of {a} and {b}, running {fun} to resolve duplicates. - |* {a/(dict) b/(dict) fun/$-({* *} *)} + |* [a=(dict) b=(dict) fun=$-({* *} *)] |- ^+ a ?~ b a @@ -1137,7 +1137,7 @@ :: ++ union-with-key :> returns the union of {a} and {b}, running {fun} to resolve duplicates. - |* {a/(dict) b/(dict) fun/$-({* * *} *)} + |* [a=(dict) b=(dict) fun=$-({* * *} *)] |- ^+ a ?~ b a @@ -1160,7 +1160,7 @@ :: ++ difference :: :: todo: move real implementation here. :: :> returns elements in {a} that don't exist in {b}. -:: |* {a/(dict) b/(dict)} +:: |* [a=(dict) b=(dict)] :: (~(dif by a) b) :: :: :: :: todo: @@ -1170,7 +1170,7 @@ :: ++ intersection :: :: todo: move real implementation here. :: :> returns elements in {a} that exist in {b}. -:: |* {a/(dict) b/(dict)} +:: |* [a=(dict) b=(dict)] :: (~(int by a) b) :: :: :: :: todo: @@ -1182,7 +1182,7 @@ :: ++ map :> applies {fun} to each value in {a}. - |* {a/(dict) fun/$-(* *)} + |* [a=(dict) fun=$-(* *)] ^- (dict _p.-.n.-.a fun) ?~ a ~ @@ -1190,7 +1190,7 @@ :: ++ map-with-key :> applies {fun} to each value in {a}. - |* {a/(dict) fun/$-({* *} *)} + |* [a=(dict) fun=$-({* *} *)] ^- (dict _p.-.n.-.a _*fun) ?~ a ~ @@ -1205,7 +1205,7 @@ :> treap order. :> :> corresponds to {mapAccum} in haskell. - |* {a/(dict) b/* fun/$-({* *} {* *})} + |* [a=(dict) b=* fun=$-({* *} {* *})] ^- {_b (dict _p.-.n.-.a _+:*fun)} ?~ a [b ~] @@ -1220,7 +1220,7 @@ :: 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/$-(* *)} + |* [a=(dict) fun=$-(* *)] %- from-list %+ map:ls (to-list a) |= item/_n.-.a @@ -1228,7 +1228,7 @@ :: ++ map-keys-with :> applies {fun} to all keys, creating a new value with {combine} on dupes. - |* {a/(dict) fun/$-(* *) combine/$-({* *} *)} + |* [a=(dict) fun=$-(* *) combine=$-({* *} *)] ^- (dict _*fun _q.+.n.-.a) =/ new-list %+ map:ls (to-list a) @@ -1236,7 +1236,7 @@ [(fun p.item) q.item] %^ foldl:ls new-list `(dict _*fun _q.+.n.-.a)`~ - |= {m/(dict _*fun _q.+.n.-.a) p/_i.-.new-list} + |= [m=(dict _*fun _q.+.n.-.a) p=_i.-.new-list] (put-with m -.p +.p combine) :: ++ fold @@ -1246,7 +1246,7 @@ :> 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/$-({* *} *)} + |* [a=(dict) b=* fun=$-({* *} *)] ^- _b ?~ a b @@ -1256,7 +1256,7 @@ :: ++ fold-with-keys :> performs a fold on all the values in {a}, passing keys too. - |* {a/(dict) b/* fun/$-({* * *} *)} + |* [a=(dict) b=* fun=$-({* * *} *)] ^+ b ?~ a b @@ -1266,7 +1266,7 @@ :: ++ any :> returns yes if any element satisfies the predicate - |* {a/(dict) b/$-(* ?)} + |* [a=(dict) b=$-(* ?)] ^- ? ?~ a %.n @@ -1274,7 +1274,7 @@ :: ++ any-with-key :> returns yes if any element satisfies the predicate - |* {a/(dict) b/$-({* *} ?)} + |* [a=(dict) b=$-({* *} ?)] ^- ? ?~ a %.n @@ -1282,7 +1282,7 @@ :: ++ all :> returns yes if all elements satisfy the predicate - |* {a/(dict) b/$-(* ?)} + |* [a=(dict) b=$-(* ?)] ^- ? ?~ a %.y @@ -1290,7 +1290,7 @@ :: ++ all-with-key :> returns yes if all elements satisfy the predicate - |* {a/(dict) b/$-({* *} ?)} + |* [a=(dict) b=$-({* *} ?)] ^- ? ?~ a %.y @@ -1300,12 +1300,12 @@ +| ++ elems :> return all values in the dict. - |* a/(dict) + |* a=(dict) %+ turn (to-list a) second :: ++ keys :> returns all keys in the dict. - |* a/(dict) + |* a=(dict) %+ turn (to-list a) first :: :: todo: ++assocs probably doesn't make sense when we have ++to-list and @@ -1313,12 +1313,12 @@ :: ++ keys-set :> returns all keys as a set. - |* a/(dict) + |* a=(dict) (si:nl (keys a)) :: ++ from-set :> computes a dict by running {fun} on every value in a set. - |* {a/(set) fun/$-(* *)} + |* [a=(set) fun=$-(* *)] ^- (dict _n.-.a _*fun) ?~ a ~ @@ -1329,8 +1329,8 @@ :: ++ to-list :> creates a list of pairs from the tree. - |* a/(dict) - =| b/(list _n.-.a) + |* a=(dict) + =| b=(list _n.-.a) |- ^+ b ?~ a @@ -1339,19 +1339,19 @@ :: ++ from-list :> creates a tree from a list. - |* a/(list (pair)) + |* a=(list (pair)) |- %^ foldl:ls a `(dict _p.-.i.-.a _q.+.i.-.a)`~ - |= {m/(dict _p.-.i.-.a _q.+.i.-.a) p/_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/$-(* *)} + |* [a=(list (pair)) fun=$-(* *)] %^ foldl:ls a `(dict _*fun _q.+.i.-.a)`~ - |= {m/(dict _*fun _q.+.i.-.a) p/_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 @@ -1361,14 +1361,14 @@ +| ++ filter :> filters a dict of all values that satisfy {fun}. - |* {a/(dict) fun/$-(* ?)} + |* [a=(dict) fun=$-(* ?)] %+ filter-with-key a - |= {key/* value/_q.+.n.-.a} + |= [key=* value=_q.+.n.-.a] (fun value) :: ++ filter-with-key :> filters a dict of all values that satisfy {fun}. - |* {a/(dict) fun/$-({* *} ?)} + |* [a=(dict) fun=$-({* *} ?)] |- ^+ a ?~ a ~ @@ -1380,25 +1380,25 @@ :: ++ restrict-keys :> returns a dict where the only allowable keys are {keys}. - |* {a/(dict) keys/(set)} + |* [a=(dict) keys=(set)] %+ filter-with-key a - |= {key/_p.-.n.-.a value/*} + |= [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)} + |* [a=(dict) keys=(set)] %+ filter-with-key a - |= {key/_p.-.n.-.a value/*} + |= [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/$-(* ?)} + |* [a=(dict) fun=$-(* ?)] :: todo: is the runtime on this is bogus? =/ data %+ partition:ls (to-list a) @@ -1413,14 +1413,14 @@ :: ++ map-maybe :> a version of map that can throw out items. - |* {a/(dict) fun/$-(* (maybe))} + |* [a=(dict) fun=$-(* (maybe))] %+ map-maybe-with-key a - |= {key/* value/_q.+.n.-.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))} + |* [a=(dict) fun=$-({* *} (maybe))] ^- (dict _p.-.n.-.a _+:*fun) ?~ a ~ =+ res=(fun n.a) @@ -1432,14 +1432,14 @@ :: ++ map-either :> splits the dict in two on a gate that returns an either. - |* {a/(dict) fun/$-(* (either))} + |* [a=(dict) fun=$-(* (either))] %+ map-either-with-key a - |= {key/* value/_q.+.n.-.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))} + |* [a=(dict) fun=$-({* *} (either))] |- ^- $: (dict _p.-.n.-.a _?>(?=({{%& *} *} *fun) +:*fun)) (dict _p.-.n.-.a _?>(?=({{%| *} *} *fun) +:*fun)) @@ -1461,13 +1461,13 @@ :: ++ is-subdict :> returns %.y if every element in {a} exists in {b} with the same value. - |* {a/(dict) b/(dict)} + |* [a=(dict) b=(dict)] ^- ? - (is-subdict-by a b |=({a/* b/*} =(a b))) + (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=(dict) b=(dict) fun=$-({* *} ?)] |- ^- ? ?~ a %.y @@ -1483,7 +1483,7 @@ +| ++ pop-top :> removes the head of the tree and rebalances the tree below. - |* a/(dict) + |* a=(dict) ^- {$?($~ _a)} ?~ a ~ |- @@ -1495,8 +1495,8 @@ :: ++ valid :> returns %.y if {a} if this tree is a valid treap dict. - |* a/(tree (pair * *)) - =| {l/(maybe) r/(maybe)} + |* a=(tree (pair * *)) + =| [l=(maybe) r=(maybe)] |- ^- ? ?~ a & ?& ?~(l & (gor p.n.a u.l)) @@ -1518,10 +1518,10 @@ :> =+ gen=(random eny) :> =^ first gen (range:gen 0 10) :> =^ second gen (range:gen 0 10) - |= a/@ + |= a=@ => |% ++ raw :: random bits - |= b/@ ^- @ + |= b=@ ^- @ %+ can 0 =+ c=(shas %og-a (mix b a)) @@ -1534,14 +1534,14 @@ [[256 d] $(c d, b (sub b 256))] :: ++ rad :: random in range - |= b/@ ^- @ + |= 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/@} + |= [start=@ end=@] ?: (gte start end) ~_(leaf+"invalid range" !!) =+ offset=(sub end start) @@ -1550,7 +1550,7 @@ :: ++ bits :> returns {b} bits in the range, and generator. - |= b/@ + |= b=@ =+ r=(raw b) [r +>.$(a (shas %og-s (mix a r)))] -- From fa10e2fdb217bd61ab615674f821089c476eed0a Mon Sep 17 00:00:00 2001 From: Elliot Glaysher Date: Mon, 13 Nov 2017 16:43:39 -0800 Subject: [PATCH 17/27] Code review on test stuff with Anton. - Deletes old unused example stuff - Nicer null check - Make dynamic compiling an order of magnitude faster - Lift the !> out of mule. - Make it a stack of cores instead of one core. --- gen/test.hoon | 85 ++++++++++++++------------------------------------- 1 file changed, 23 insertions(+), 62 deletions(-) diff --git a/gen/test.hoon b/gen/test.hoon index bcc933095..c8b2bbf7b 100644 --- a/gen/test.hoon +++ b/gen/test.hoon @@ -1,3 +1,4 @@ +:: todo: think about using horns to import all tests in %/tests? /+ new-hoon |% :: ---------------------------------------------------------------------- @@ -5,6 +6,11 @@ :: ---------------------------------------------------------------------- ++ test-lib |% + ++ init-test-vase + |= {cookie/@uvJ} + ^- vase + !>((init-test cookie)) + :: ++ init-test |= {cookie/@uvJ} ~(. tester `(list tape)`~ cookie 10 0) @@ -17,48 +23,6 @@ check-iterations/@u :: # of check trials current-iteration/@u :: current iteration == - :: - :: || %examples - :: - :: +| - ++ example !. - :: TODO: this doesn't deal with |*. - :: - :: specifies an example and its expected value. - :: - :: the examples in the hoon documentation used to go out of date very - :: quickly, since they were never compiled. so make compiling them a - :: test. - :: - :: source: a hoon expression - :: expected: the expected result of {source}. - |= {source/cord expected/cord} - ^+ +> - :: todo: deal with expected not compiling. - =+ exp=(slap !>(.) (ream expected)) - =+ run=(mule |.((slap !>(.) (ream source)))) - =/ result/vase ?- -.run - $| !>(p.run) - $& p.run - == - ?: =(q.result q.exp) - +>.$ - %= +>.$ - error-lines :* - "failure in '{(trip source)}':" - " actual: '{(noah result)}'" - " expected: '{(noah exp)}'" - error-lines - == - == - ++ examples - :: - |= a/(list {cord cord}) - ?~ a - +>.$ - =. +>.$ (example i.a) - $(a t.a) - :: :: || %check :: :: +| @@ -134,27 +98,17 @@ :: returns results. :: :: returns the test run's identity cookie and the list of failures. - |. ^- {@uvJ (list tape)} [eny error-lines] -- -- +-- +|% :: ---------------------------------------------------------------------- :: Eventually should be in %/test/basic/hoon. :: ---------------------------------------------------------------------- ++ test-core |_ tester-type:test-lib - ++ example-add - %- examples :~ - ['(add 2 2)' '4'] - ['(add 1 1.000.000)' '1.000.001'] - ['(add 1.333 (mul 2 2))' '1.337'] - == - ++ example-dec - %- examples :~ - ['(dec 7)' '6'] - ['(dec 0)' '~[[%leaf p="decrement-underflow"]]'] - == ++ check-decrement %+ check (generate-range 0 100) @@ -168,6 +122,8 @@ ++ test-crash !! -- +-- +|% :: ---------------------------------------------------------------------- :: Eventually should be in %/test/basic/hoon. :: ---------------------------------------------------------------------- @@ -202,6 +158,8 @@ [[1 2 ~] ["one" "two" ~]] "partition" -- +-- +|% ++ test-myb =, myb:new-hoon |_ tester-type:test-lib @@ -233,6 +191,8 @@ [2 2 ~] "map" -- +-- +|% ++ test-ls =, ls:new-hoon |_ tester-type:test-lib @@ -512,6 +472,8 @@ [6 6 8 ~] "intersect" -- +-- +|% ++ test-mp =, dct:new-hoon =+ four=(from-list [[1 "one"] [2 "two"] [3 "three"] [4 "four"] ~]) @@ -623,7 +585,7 @@ :: check random dicts of 50 items with 40 random operations done on them :: for validity. %+ check - (generate-dict 50) + (generate-dict 50) |= a/(dict @ud @ud) :: this is dumb, but use {a} as entropy? =/ gen (random:new-hoon (jam a)) @@ -871,6 +833,8 @@ %.y "valid" -- +-- +|% :: ---------------------------------------------------------------------- :: Stays in the generator. :: ---------------------------------------------------------------------- @@ -881,9 +845,7 @@ |= {name/tape v/vase eny/@uvJ} ^- tang =+ core-arms=(sort (sloe p.v) aor) - :: todo: work around mint-vain - =+ null-check=core-arms - ?~ null-check + ?: =(~ core-arms) [[%leaf :(weld "error: " name " is not a valid testing core.")] ~] =| out/tang |- @@ -928,14 +890,13 @@ :: appropriately. |= {arm-name/term v/vase eny/@uvJ} ^- (each {@uvJ (list tape)} (list tank)) - =/ t (init-test:test-lib eny) + =/ t (init-test-vase:test-lib eny) :: run the tests in the interpreter so we catch crashes. %- mule |. - :: ~(t v arm-name) - =/ r (slap (slop !>(t) v) [%cnsg [arm-name ~] [%$ 3] [[%$ 2] ~]]) + =/ r (slap (slop t v) [%cnsg [arm-name ~] [%$ 3] [[%$ 2] ~]]) :: return just the results or we will be here forever while we try to copy :: the entire kernel. - ((hard {@uvJ (list tape)}) q:(slym (slap r [%limb %results]) r)) + ((hard {@uvJ (list tape)}) q:(slap r [%limb %results])) -- :: ---------------------------------------------------------------------- -- From 4029cc0bb132ffcea65fcbd1c865e659177eb0fd Mon Sep 17 00:00:00 2001 From: Elliot Glaysher Date: Sun, 26 Nov 2017 15:41:49 -0800 Subject: [PATCH 18/27] Experiment moving the tests and tester into their own file. --- gen/test.hoon | 182 +++++------------------------------------------- lib/tester.hoon | 98 ++++++++++++++++++++++++++ tests/thr.hoon | 32 +++++++++ 3 files changed, 148 insertions(+), 164 deletions(-) create mode 100644 lib/tester.hoon create mode 100644 tests/thr.hoon diff --git a/gen/test.hoon b/gen/test.hoon index c8b2bbf7b..4f779aa1c 100644 --- a/gen/test.hoon +++ b/gen/test.hoon @@ -1,168 +1,22 @@ :: todo: think about using horns to import all tests in %/tests? -/+ new-hoon -|% -:: ---------------------------------------------------------------------- -:: Eventually should be in %/lib/tester/hoon. -:: ---------------------------------------------------------------------- -++ test-lib - |% - ++ init-test-vase - |= {cookie/@uvJ} - ^- vase - !>((init-test cookie)) - :: - ++ 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 - :: - :: +| - +- check - |* {generator/$-(@uvJ *) test/$-(* ?)} - |- :: why do i have to |-? - ^+ +>.$ - ?: (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 (random:new-hoon c) - =| i/@u - =| m/(dict:new-hoon @ud @ud) - |- - ^- (dict:new-hoon @ud @ud) - ?: =(i count) - m - =^ first gen (range:gen 0 100) - =^ second gen (range:gen 0 100) - $(m (put:dct:new-hoon m first second), i +(i)) - :: - :: || %test - :: - :: +| - :: 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 - == - == - :: - ++ results - :: returns results. - :: - :: returns the test run's identity cookie and the list of failures. - ^- {@uvJ (list tape)} - [eny error-lines] - -- - -- --- -|% +:: +:: i should be able to use /: ? +/+ new-hoon, tester + +:: random thought: should I lift most of test execution into the build system? +:: trade off: if you do a wide ranging change and then only want to run one +:: test, you must pay the execution time for all tests, while otherwise, you +:: only pay the compile time. +// /===/tests/thr +[test-thr=. +] + :: ---------------------------------------------------------------------- :: Eventually should be in %/test/basic/hoon. :: ---------------------------------------------------------------------- -++ test-core - |_ tester-type:test-lib - ++ check-decrement - %+ check - (generate-range 0 100) - |=(a/@ =(a (dec (add 2 a)))) - ++ test-decrement - (expect-eq (dec 5) 4 "decrement failure") - ++ test-freedom - (expect-eq (add 2 2) 4 "freedom is the freedom to say...") - ++ test-a-failure - (expect-eq (add 2 2) 5 "freedom is the freedom to say...") - ++ test-crash - !! - -- --- -|% -:: ---------------------------------------------------------------------- -:: Eventually should be in %/test/basic/hoon. -:: ---------------------------------------------------------------------- -++ test-thr - =, thr:new-hoon - =/ data/(list (either @u tape)) [[%& 1] [%| "one"] [%& 2] [%| "two"] ~] - |_ tester-type:test-lib - ++ 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" - -- --- |% ++ test-myb =, myb:new-hoon - |_ tester-type:test-lib + |_ tester-type:tester ++ test-from-list-null (expect-eq (from-list ~) ~ "from-list") :: @@ -195,7 +49,7 @@ |% ++ test-ls =, ls:new-hoon - |_ tester-type:test-lib + |_ tester-type:tester ++ test-head (expect-eq (head [1 ~]) 1 "head") :: @@ -478,7 +332,7 @@ =, 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:test-lib + |_ tester-type:tester ++ test-empty (expect-eq (empty four) %.n "empty") :: @@ -846,6 +700,7 @@ ^- tang =+ core-arms=(sort (sloe p.v) aor) ?: =(~ core-arms) + ~& p.v [[%leaf :(weld "error: " name " is not a valid testing core.")] ~] =| out/tang |- @@ -890,7 +745,7 @@ :: appropriately. |= {arm-name/term v/vase eny/@uvJ} ^- (each {@uvJ (list tape)} (list tank)) - =/ t (init-test-vase:test-lib eny) + =/ t (init-test-vase:tester eny) :: run the tests in the interpreter so we catch crashes. %- mule |. =/ r (slap (slop t v) [%cnsg [arm-name ~] [%$ 3] [[%$ 2] ~]]) @@ -908,8 +763,7 @@ :- %tang :: todo: right now, we hard code ++test-core. but eventually, we must instead :: scry ford for the core from the hoon file. that doesn't exist yet. -::(perform-test-suite:local "test-core" !>(test-core) eny) -::(perform-test-suite:local "test-thr" !>(test-thr) eny) +(perform-test-suite:local "test-thr" !>(test-thr) eny) ::(perform-test-suite:local "test-myb" !>(test-myb) eny) -(perform-test-suite:local "test-ls" !>(test-ls) eny) +::(perform-test-suite:local "test-ls" !>(test-ls) eny) ::(perform-test-suite:local "test-mp" !>(test-mp) eny) diff --git a/lib/tester.hoon b/lib/tester.hoon new file mode 100644 index 000000000..5dd0e2138 --- /dev/null +++ b/lib/tester.hoon @@ -0,0 +1,98 @@ +:: common testing library. +|% +++ init-test-vase + |= {cookie/@uvJ} + ^- vase + !>((init-test cookie)) +:: +++ 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 + :: + :: +| + +- check + |* {generator/$-(@uvJ *) test/$-(* ?)} + |- :: why do i have to |-? + ^+ +>.$ + ?: (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 (random:new-hoon c) + =| i/@u + =| m/(dict:new-hoon @ud @ud) + |- + ^- (dict:new-hoon @ud @ud) + ?: =(i count) + m + =^ first gen (range:gen 0 100) + =^ second gen (range:gen 0 100) + $(m (put:dct:new-hoon m first second), i +(i)) + :: + :: || %test + :: + :: +| + :: 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 + == + == + :: + ++ results + :: returns results. + :: + :: returns the test run's identity cookie and the list of failures. + ^- {@uvJ (list tape)} + [eny error-lines] + -- +-- diff --git a/tests/thr.hoon b/tests/thr.hoon new file mode 100644 index 000000000..a17cf67a9 --- /dev/null +++ b/tests/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" +-- From e6dc49a4d2324f61037bf1f6669557d4274870dd Mon Sep 17 00:00:00 2001 From: Elliot Glaysher Date: Tue, 26 Dec 2017 13:03:47 -0800 Subject: [PATCH 19/27] Separate out all tests into files. This moves the remaining test suites into their own test files, however, we are still not autogenerating a list of tests. --- gen/test.hoon | 820 ++++--------------------------------------------- tests/ls.hoon | 280 +++++++++++++++++ tests/mp.hoon | 360 ++++++++++++++++++++++ tests/myb.hoon | 32 ++ 4 files changed, 740 insertions(+), 752 deletions(-) create mode 100644 tests/ls.hoon create mode 100644 tests/mp.hoon create mode 100644 tests/myb.hoon diff --git a/gen/test.hoon b/gen/test.hoon index 4f779aa1c..ec215e3a6 100644 --- a/gen/test.hoon +++ b/gen/test.hoon @@ -3,758 +3,74 @@ :: i should be able to use /: ? /+ new-hoon, tester -:: random thought: should I lift most of test execution into the build system? -:: trade off: if you do a wide ranging change and then only want to run one -:: test, you must pay the execution time for all tests, while otherwise, you -:: only pay the compile time. -// /===/tests/thr -[test-thr=. +] +:: ok, doing this as a list first. then do it automated. is there an equivalent +:: to /_ which works on an arbitrary directory? +/= test-thr /: /===/tests/thr /!noun/ +/= test-myb /: /===/tests/myb /!noun/ +/= test-ls /: /===/tests/ls /!noun/ +/= test-mp /: /===/tests/mp /!noun/ -:: ---------------------------------------------------------------------- -:: Eventually should be in %/test/basic/hoon. -:: ---------------------------------------------------------------------- |% -++ test-myb - =, myb:new-hoon - |_ tester-type:tester - ++ test-from-list-null - (expect-eq (from-list ~) ~ "from-list") +++ perform-test-suite + :: takes a testing core and executes all tests in it. + |= {name/tape v/vase eny/@uvJ} + ^- tang + =+ core-arms=(sort (sloe p.v) aor) + ?: =(~ core-arms) + ~& p.v + [[%leaf :(weld "error: " name " is not a valid testing core.")] ~] + =| out/tang + |- + ?~ core-arms + out + %= $ + out (weld (perform-test-arm name i.core-arms v eny) out) + core-arms t.core-arms + == +:: +++ perform-test-arm + :: performs a single test. + |= {suite-name/tape arm-name/term v/vase eny/@uvJ} + :: todo: terminal color on the output + ^- tang + =+ run=(run-arm-in-test-core arm-name v eny) + =+ full-name=:(weld suite-name "/" (trip arm-name)) + ?- -.run + $| :: the stack is already flopped for output? + ;: weld + p:run + `tang`[[%leaf (weld full-name " CRASHED")] ~] + == + $& :: todo: test the cookie to make sure it returned the same core. + ?: =(~ +.p:run) + [[%leaf (weld full-name " OK")] ~] + :: Create a welded list of all failures indented. + %- flop + ;: weld + `tang`[[%leaf (weld full-name " FAILED")] ~] + %+ turn +.p:run + |= {i/tape} + ^- tank + [%leaf (weld " " i)] + == + == +:: +++ run-arm-in-test-core + :: runs a single arm. :: - ++ 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" - -- --- -|% -++ test-ls - =, 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" - -- --- -|% -++ test-mp - =, 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" - -- --- -|% -:: ---------------------------------------------------------------------- -:: Stays in the generator. -:: ---------------------------------------------------------------------- -++ local - |% - ++ perform-test-suite - :: takes a testing core and executes all tests in it. - |= {name/tape v/vase eny/@uvJ} - ^- tang - =+ core-arms=(sort (sloe p.v) aor) - ?: =(~ core-arms) - ~& p.v - [[%leaf :(weld "error: " name " is not a valid testing core.")] ~] - =| out/tang - |- - ?~ core-arms - out - %= $ - out (weld (perform-test-arm name i.core-arms v eny) out) - core-arms t.core-arms - == - :: - ++ perform-test-arm - :: performs a single test. - |= {suite-name/tape arm-name/term v/vase eny/@uvJ} - :: todo: terminal color on the output - ^- tang - =+ run=(run-arm-in-test-core arm-name v eny) - =+ full-name=:(weld suite-name "/" (trip arm-name)) - ?- -.run - $| :: the stack is already flopped for output? - ;: weld - p:run - `tang`[[%leaf (weld full-name " CRASHED")] ~] - == - $& :: todo: test the cookie to make sure it returned the same core. - ?: =(~ +.p:run) - [[%leaf (weld full-name " OK")] ~] - :: Create a welded list of all failures indented. - %- flop - ;: weld - `tang`[[%leaf (weld full-name " FAILED")] ~] - %+ turn +.p:run - |= {i/tape} - ^- tank - [%leaf (weld " " i)] - == - == - :: - ++ run-arm-in-test-core - :: runs a single arm. - :: - :: returns the output of `++mule` so that we can react to crashes - :: appropriately. - |= {arm-name/term v/vase eny/@uvJ} - ^- (each {@uvJ (list tape)} (list tank)) - =/ t (init-test-vase:tester eny) - :: run the tests in the interpreter so we catch crashes. - %- mule |. - =/ r (slap (slop t v) [%cnsg [arm-name ~] [%$ 3] [[%$ 2] ~]]) - :: return just the results or we will be here forever while we try to copy - :: the entire kernel. - ((hard {@uvJ (list tape)}) q:(slap r [%limb %results])) - -- -:: ---------------------------------------------------------------------- + :: returns the output of `++mule` so that we can react to crashes + :: appropriately. + |= {arm-name/term v/vase eny/@uvJ} + ^- (each {@uvJ (list tape)} (list tank)) + =/ t (init-test-vase:tester eny) + :: run the tests in the interpreter so we catch crashes. + %- mule |. + =/ r (slap (slop t v) [%cnsg [arm-name ~] [%$ 3] [[%$ 2] ~]]) + :: return just the results or we will be here forever while we try to copy + :: the entire kernel. + ((hard {@uvJ (list tape)}) q:(slap r [%limb %results])) -- +:: :- %say |= $: {now/@da eny/@uvJ bec/beak} $~ @@ -763,7 +79,7 @@ :- %tang :: todo: right now, we hard code ++test-core. but eventually, we must instead :: scry ford for the core from the hoon file. that doesn't exist yet. -(perform-test-suite:local "test-thr" !>(test-thr) eny) -::(perform-test-suite:local "test-myb" !>(test-myb) eny) -::(perform-test-suite:local "test-ls" !>(test-ls) eny) -::(perform-test-suite:local "test-mp" !>(test-mp) eny) +::(perform-test-suite "test-thr" !>(test-thr) eny) +::(perform-test-suite "test-myb" !>(test-myb) eny) +::(perform-test-suite "test-ls" !>(test-ls) eny) +(perform-test-suite "test-mp" !>(test-mp) eny) diff --git a/tests/ls.hoon b/tests/ls.hoon new file mode 100644 index 000000000..e334bc4c6 --- /dev/null +++ b/tests/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/mp.hoon b/tests/mp.hoon new file mode 100644 index 000000000..af75fdb9e --- /dev/null +++ b/tests/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/myb.hoon b/tests/myb.hoon new file mode 100644 index 000000000..90ce805a3 --- /dev/null +++ b/tests/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" +-- + From bd6736b6cf50a1610193e05d7da7b53e4c5cdfab Mon Sep 17 00:00:00 2001 From: Elliot Glaysher Date: Sat, 30 Dec 2017 22:37:49 -0800 Subject: [PATCH 20/27] Rebuild the test runner. The test runner now has a notion of tests being part of a hierarchical path, and allows running what were multiple suites in one run. --- gen/test.hoon | 111 +++++++++++++++++++++++++++++--------------------- 1 file changed, 64 insertions(+), 47 deletions(-) diff --git a/gen/test.hoon b/gen/test.hoon index ec215e3a6..4b385d651 100644 --- a/gen/test.hoon +++ b/gen/test.hoon @@ -10,65 +10,76 @@ /= test-ls /: /===/tests/ls /!noun/ /= test-mp /: /===/tests/mp /!noun/ +=, new-hoon |% -++ perform-test-suite - :: takes a testing core and executes all tests in it. - |= {name/tape v/vase eny/@uvJ} +:> # %models ++| ++= tests + :> a hierarchical structure of tests + :> + :> an alphabetically sorted recursive association list + :> mapping a part of a path to either a test trap or a + :> sublist of the same type. + (list (pair term (either (trap (list tape)) tests))) +:: +:> # %traps ++| +++ gen-tests + :> creates a {tests} list out of a vase of a test suite + |= [v=vase eny=@uvJ] + ^- tests + =+ arms=(sort (sloe p.v) aor) + =+ context=(slop (init-test-vase:tester eny) v) + %+ map:ls arms + |= arm/term + :- arm + :- %& + |. + :: todo: pull out the entropy from the result interface. + =/ r (slap context [%cnsg [arm ~] [%$ 3] [[%$ 2] ~]]) + +:((hard {@uvJ (list tape)}) q:(slap r [%limb %results])) +:: +++ test-runner + :> run all tests in {a}. + :: + :: todo: pass in a path to filter on. + =| pax/path + |= a/tests ^- tang + %- concat:ls + %+ map:ls a + |= b/(pair term (either (trap (list tape)) tests)) ^- tang - =+ core-arms=(sort (sloe p.v) aor) - ?: =(~ core-arms) - ~& p.v - [[%leaf :(weld "error: " name " is not a valid testing core.")] ~] - =| out/tang - |- - ?~ core-arms - out - %= $ - out (weld (perform-test-arm name i.core-arms v eny) out) - core-arms t.core-arms + ?- -.q.b + %& (run-test [p.b pax] p.q.b) + %| ^$(pax [p.b pax], a p.q.b) == :: -++ perform-test-arm - :: performs a single test. - |= {suite-name/tape arm-name/term v/vase eny/@uvJ} - :: todo: terminal color on the output +++ run-test + :> executes an individual test. + |= {pax/path test/(trap (list tape))} ^- tang - =+ run=(run-arm-in-test-core arm-name v eny) - =+ full-name=:(weld suite-name "/" (trip arm-name)) + =+ name=(spud (reverse:ls pax)) + =+ run=(mule test) + ~! run ?- -.run $| :: the stack is already flopped for output? ;: weld p:run - `tang`[[%leaf (weld full-name " CRASHED")] ~] + `tang`[[%leaf (weld name " CRASHED")] ~] == - $& :: todo: test the cookie to make sure it returned the same core. - ?: =(~ +.p:run) - [[%leaf (weld full-name " OK")] ~] + $& ?: =(~ p:run) + [[%leaf (weld name " OK")] ~] :: Create a welded list of all failures indented. %- flop ;: weld - `tang`[[%leaf (weld full-name " FAILED")] ~] - %+ turn +.p:run + `tang`[[%leaf (weld name " FAILED")] ~] + ~! p:run + %+ turn p:run |= {i/tape} ^- tank [%leaf (weld " " i)] == == -:: -++ run-arm-in-test-core - :: runs a single arm. - :: - :: returns the output of `++mule` so that we can react to crashes - :: appropriately. - |= {arm-name/term v/vase eny/@uvJ} - ^- (each {@uvJ (list tape)} (list tank)) - =/ t (init-test-vase:tester eny) - :: run the tests in the interpreter so we catch crashes. - %- mule |. - =/ r (slap (slop t v) [%cnsg [arm-name ~] [%$ 3] [[%$ 2] ~]]) - :: return just the results or we will be here forever while we try to copy - :: the entire kernel. - ((hard {@uvJ (list tape)}) q:(slap r [%limb %results])) -- :: :- %say @@ -77,9 +88,15 @@ $~ == :- %tang -:: todo: right now, we hard code ++test-core. but eventually, we must instead -:: scry ford for the core from the hoon file. that doesn't exist yet. -::(perform-test-suite "test-thr" !>(test-thr) eny) -::(perform-test-suite "test-myb" !>(test-myb) eny) -::(perform-test-suite "test-ls" !>(test-ls) eny) -(perform-test-suite "test-mp" !>(test-mp) eny) +%- test-runner +^- tests +:~ + :: todo: for now, this is manually constructed. later, this should + :: be generated from the contents of %/tests, without addressing the + :: files individually. if possible, lift the call to ++gen-tests into + :: the build steps for caching. + ['ls' [%| (gen-tests !>(test-ls) eny)]] + ['mp' [%| (gen-tests !>(test-mp) eny)]] + ['myb' [%| (gen-tests !>(test-myb) eny)]] + ['thr' [%| (gen-tests !>(test-thr) eny)]] +== From f764db7145f652b16b24ac9cbf83bf1f75fcbdb3 Mon Sep 17 00:00:00 2001 From: Elliot Glaysher Date: Sat, 30 Dec 2017 22:41:01 -0800 Subject: [PATCH 21/27] Don't pass the entropy back as part of the results. --- gen/test.hoon | 3 +-- lib/tester.hoon | 6 ++---- 2 files changed, 3 insertions(+), 6 deletions(-) diff --git a/gen/test.hoon b/gen/test.hoon index 4b385d651..bff86ea8f 100644 --- a/gen/test.hoon +++ b/gen/test.hoon @@ -35,9 +35,8 @@ :- arm :- %& |. - :: todo: pull out the entropy from the result interface. =/ r (slap context [%cnsg [arm ~] [%$ 3] [[%$ 2] ~]]) - +:((hard {@uvJ (list tape)}) q:(slap r [%limb %results])) + ((hard (list tape)) q:(slap r [%limb %results])) :: ++ test-runner :> run all tests in {a}. diff --git a/lib/tester.hoon b/lib/tester.hoon index 5dd0e2138..2edded433 100644 --- a/lib/tester.hoon +++ b/lib/tester.hoon @@ -90,9 +90,7 @@ :: ++ results :: returns results. - :: - :: returns the test run's identity cookie and the list of failures. - ^- {@uvJ (list tape)} - [eny error-lines] + ^- (list tape) + error-lines -- -- From 4e5e48d0b2ee2a843d16af05ad6e8d720c85a595 Mon Sep 17 00:00:00 2001 From: Elliot Glaysher Date: Sat, 30 Dec 2017 23:23:54 -0800 Subject: [PATCH 22/27] Add an optional filter to the +test generator. Now that we are running multiple suites, make the generator take an optional path so you can run just a single suite or even a single test. --- gen/test.hoon | 26 +++++++++++++++++++------- 1 file changed, 19 insertions(+), 7 deletions(-) diff --git a/gen/test.hoon b/gen/test.hoon index bff86ea8f..a2be7380e 100644 --- a/gen/test.hoon +++ b/gen/test.hoon @@ -22,7 +22,7 @@ :> sublist of the same type. (list (pair term (either (trap (list tape)) tests))) :: -:> # %traps +:> # %test +| ++ gen-tests :> creates a {tests} list out of a vase of a test suite @@ -39,15 +39,17 @@ ((hard (list tape)) q:(slap r [%limb %results])) :: ++ test-runner - :> run all tests in {a}. - :: - :: todo: pass in a path to filter on. + :> run all tests in {a} with a filter. =| pax/path - |= a/tests ^- tang + |= {filter/path a/tests} + ^- tang %- concat:ls %+ map:ls a |= b/(pair term (either (trap (list tape)) tests)) ^- tang + =^ matches filter (match-filter filter p.b) + ?. matches + ~ ?- -.q.b %& (run-test [p.b pax] p.q.b) %| ^$(pax [p.b pax], a p.q.b) @@ -79,15 +81,25 @@ [%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 +%+ test-runner +?~ filter ~ pax.filter ^- tests :~ :: todo: for now, this is manually constructed. later, this should From 437f205ef76f5b23913ab360162db5032e4c1c7e Mon Sep 17 00:00:00 2001 From: Elliot Glaysher Date: Sun, 31 Dec 2017 10:41:01 -0800 Subject: [PATCH 23/27] %143-ification. --- gen/test.hoon | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/gen/test.hoon b/gen/test.hoon index a2be7380e..4991c7aac 100644 --- a/gen/test.hoon +++ b/gen/test.hoon @@ -40,12 +40,12 @@ :: ++ test-runner :> run all tests in {a} with a filter. - =| pax/path - |= {filter/path a/tests} + =| pax=path + |= [filter=path a=tests] ^- tang %- concat:ls %+ map:ls a - |= b/(pair term (either (trap (list tape)) tests)) + |= b=(pair term (either (trap (list tape)) tests)) ^- tang =^ matches filter (match-filter filter p.b) ?. matches @@ -57,7 +57,7 @@ :: ++ run-test :> executes an individual test. - |= {pax/path test/(trap (list tape))} + |= [pax=path test=(trap (list tape))] ^- tang =+ name=(spud (reverse:ls pax)) =+ run=(mule test) @@ -84,8 +84,8 @@ :: ++ match-filter :> checks to see if {name} matches the head of {filter}. - |= {filter/path name/term} - ^- {? path} + |= [filter=path name=term] + ^- [? path] ?~ filter :: when there's no filter, we always match. [%.y ~] @@ -93,8 +93,8 @@ -- :: :- %say -|= $: {now/@da eny/@uvJ bec/beak} - {filter/$?($~ {pax/path $~})} +|= $: [now=@da eny=@uvJ bec=beak] + [filter=$?($~ [pax=path $~])] $~ == :- %tang From 625959a004595db26c335cbec68993a57681e0b0 Mon Sep 17 00:00:00 2001 From: Elliot Glaysher Date: Mon, 1 Jan 2018 11:03:40 -0800 Subject: [PATCH 24/27] Minor cleanup and %143-ization to tester.hoon --- lib/tester.hoon | 59 ++++++++++++++++++++++++++++++------------------- 1 file changed, 36 insertions(+), 23 deletions(-) diff --git a/lib/tester.hoon b/lib/tester.hoon index 2edded433..cc1723e2b 100644 --- a/lib/tester.hoon +++ b/lib/tester.hoon @@ -12,17 +12,19 @@ ++ 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 + |_ $: error-lines=(list tape) :< output messages + eny=@uvJ :< entropy + check-iterations=@u :< # of check trials + current-iteration=@u :< current iteration == - :: || %check - :: - :: +| + :> # + :> # %check + :> # + :> gates for quick check style tests. + +| +- check - |* {generator/$-(@uvJ *) test/$-(* ?)} - |- :: why do i have to |-? + |* [generator=$-(@uvJ *) test=$-(* ?)] + |- ^+ +>.$ ?: (gth current-iteration check-iterations) +>.$ @@ -47,8 +49,8 @@ :: todo: a generate function that takes an arbitrary span. :: ++ generate-range - |= {min/@ max/@} - |= c/@uvJ + |= [min=@ max=@] + |= c=@uvJ ^- @ =+ gen=(random:new-hoon c) =^ num gen (range:gen min max) @@ -56,26 +58,32 @@ :: ++ generate-dict :> generator which will produce a dict with {count} random pairs. - |= count/@u + |= count=@u :> generate a dict with entropy {c}. - |= c/@uvJ + |= c=@uvJ + :> + :> gen: stateful random number generator + :> out: resulting map + :> i: loop counter + :> =/ gen (random:new-hoon c) - =| i/@u - =| m/(dict:new-hoon @ud @ud) + =| out=(dict:new-hoon @ud @ud) + =| i=@u |- ^- (dict:new-hoon @ud @ud) ?: =(i count) - m + out =^ first gen (range:gen 0 100) =^ second gen (range:gen 0 100) - $(m (put:dct:new-hoon m first second), i +(i)) - :: - :: || %test - :: - :: +| + $(out (put:dct:new-hoon out first second), i +(i)) + :> # + :> # %test + :> # + :> assertions on state + +| :: todo: unit testing libraries have a lot more to them than just eq. ++ expect-eq - |* {a/* b/* c/tape} + |* [a=* b=* c=tape] ^+ +> ?: =(a b) +>.$ @@ -88,8 +96,13 @@ == == :: + :> # + :> # %output + :> # + :> called by the test harness after test completion + :: ++ results - :: returns results. + :> returns results. ^- (list tape) error-lines -- From 48585d2b2f56d6cffec9c8e1f92f7835e017dba0 Mon Sep 17 00:00:00 2001 From: Elliot Glaysher Date: Sat, 6 Jan 2018 22:51:52 -0800 Subject: [PATCH 25/27] +test now deals with recursive directory structures. +test now offloads creation of the test tree into a renderer. this should help with caching. using a renderer also lets us deal with hierarchical directory structures, leading to better organization. --- gen/test.hoon | 72 ++++++++--------------------------- lib/tester.hoon | 64 ++++++++++++++++++++++++++++++- ren/test-tree.hoon | 10 +++++ tests/{ => new-hoon}/ls.hoon | 0 tests/{ => new-hoon}/mp.hoon | 0 tests/{ => new-hoon}/myb.hoon | 0 tests/{ => new-hoon}/thr.hoon | 0 7 files changed, 87 insertions(+), 59 deletions(-) create mode 100644 ren/test-tree.hoon rename tests/{ => new-hoon}/ls.hoon (100%) rename tests/{ => new-hoon}/mp.hoon (100%) rename tests/{ => new-hoon}/myb.hoon (100%) rename tests/{ => new-hoon}/thr.hoon (100%) diff --git a/gen/test.hoon b/gen/test.hoon index 4991c7aac..df4c279ff 100644 --- a/gen/test.hoon +++ b/gen/test.hoon @@ -1,67 +1,35 @@ -:: todo: think about using horns to import all tests in %/tests? -:: -:: i should be able to use /: ? /+ new-hoon, tester - -:: ok, doing this as a list first. then do it automated. is there an equivalent -:: to /_ which works on an arbitrary directory? -/= test-thr /: /===/tests/thr /!noun/ -/= test-myb /: /===/tests/myb /!noun/ -/= test-ls /: /===/tests/ls /!noun/ -/= test-mp /: /===/tests/mp /!noun/ - +/= all-tests + /^ (map @ta tests:tester) + /: /===/tests + /_ /test-tree/ +:: =, new-hoon |% -:> # %models -+| -+= tests - :> a hierarchical structure of tests - :> - :> an alphabetically sorted recursive association list - :> mapping a part of a path to either a test trap or a - :> sublist of the same type. - (list (pair term (either (trap (list tape)) tests))) -:: -:> # %test -+| -++ gen-tests - :> creates a {tests} list out of a vase of a test suite - |= [v=vase eny=@uvJ] - ^- tests - =+ arms=(sort (sloe p.v) aor) - =+ context=(slop (init-test-vase:tester eny) v) - %+ map:ls arms - |= arm/term - :- arm - :- %& - |. - =/ r (slap context [%cnsg [arm ~] [%$ 3] [[%$ 2] ~]]) - ((hard (list tape)) q:(slap r [%limb %results])) :: ++ test-runner :> run all tests in {a} with a filter. =| pax=path - |= [filter=path a=tests] + |= [filter=path eny=@uvJ a=tests:tester] ^- tang %- concat:ls - %+ map:ls a - |= b=(pair term (either (trap (list tape)) tests)) + %+ turn a + |= b=instance:tester ^- tang =^ matches filter (match-filter filter p.b) ?. matches ~ ?- -.q.b - %& (run-test [p.b pax] p.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 test=(trap (list tape))] + |= [pax=path eny=@uvJ test=$-(@uvJ (list tape))] ^- tang - =+ name=(spud (reverse:ls pax)) - =+ run=(mule test) - ~! run + =+ name=(spud (flop pax)) + =+ run=(mule |.((test eny))) ?- -.run $| :: the stack is already flopped for output? ;: weld @@ -74,7 +42,6 @@ %- flop ;: weld `tang`[[%leaf (weld name " FAILED")] ~] - ~! p:run %+ turn p:run |= {i/tape} ^- tank @@ -98,16 +65,7 @@ $~ == :- %tang -%+ test-runner +%^ test-runner ?~ filter ~ pax.filter -^- tests -:~ - :: todo: for now, this is manually constructed. later, this should - :: be generated from the contents of %/tests, without addressing the - :: files individually. if possible, lift the call to ++gen-tests into - :: the build steps for caching. - ['ls' [%| (gen-tests !>(test-ls) eny)]] - ['mp' [%| (gen-tests !>(test-mp) eny)]] - ['myb' [%| (gen-tests !>(test-myb) eny)]] - ['thr' [%| (gen-tests !>(test-thr) eny)]] -== +eny +(test-map-to-test-list:tester all-tests) diff --git a/lib/tester.hoon b/lib/tester.hoon index cc1723e2b..80714ba84 100644 --- a/lib/tester.hoon +++ b/lib/tester.hoon @@ -1,5 +1,65 @@ +/+ new-hoon :: common testing library. |% +:> # %models ++| ++= tests + :> a hierarchical structure of tests + :> + :> an alphabetically sorted 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 models. ++| +++ 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 :: eny=@uvJ] + ^- tests + =+ arms=(sort (sloe p.v) aor) + %+ turn arms + |= arm/term + :- arm + :- %& + |= eny=@uvJ + =+ context=(slop (init-test-vase:tester eny) v) + =/ r (slap context [%cnsg [arm ~] [%$ 3] [[%$ 2] ~]]) + ((hard (list tape)) q:(slap r [%limb %results])) +:: ++ init-test-vase |= {cookie/@uvJ} ^- vase @@ -79,7 +139,7 @@ :> # :> # %test :> # - :> assertions on state + :> test expectation functions +| :: todo: unit testing libraries have a lot more to them than just eq. ++ expect-eq @@ -99,7 +159,7 @@ :> # :> # %output :> # - :> called by the test harness after test completion + :> called by the test harness :: ++ results :> returns results. 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/tests/ls.hoon b/tests/new-hoon/ls.hoon similarity index 100% rename from tests/ls.hoon rename to tests/new-hoon/ls.hoon diff --git a/tests/mp.hoon b/tests/new-hoon/mp.hoon similarity index 100% rename from tests/mp.hoon rename to tests/new-hoon/mp.hoon diff --git a/tests/myb.hoon b/tests/new-hoon/myb.hoon similarity index 100% rename from tests/myb.hoon rename to tests/new-hoon/myb.hoon diff --git a/tests/thr.hoon b/tests/new-hoon/thr.hoon similarity index 100% rename from tests/thr.hoon rename to tests/new-hoon/thr.hoon From b772818ef30c37dc1c87728cf85cdd26a9688f82 Mon Sep 17 00:00:00 2001 From: Elliot Glaysher Date: Sun, 7 Jan 2018 15:55:44 -0800 Subject: [PATCH 26/27] Minor cleanups. --- lib/tester.hoon | 24 ++++++++++-------------- 1 file changed, 10 insertions(+), 14 deletions(-) diff --git a/lib/tester.hoon b/lib/tester.hoon index 80714ba84..16ba5c21c 100644 --- a/lib/tester.hoon +++ b/lib/tester.hoon @@ -1,23 +1,22 @@ /+ new-hoon -:: common testing library. +:: +:> testing utilities |% :> # %models +| += tests :> a hierarchical structure of tests :> - :> an alphabetically sorted recursive association list - :> mapping a part of a path to either a test trap or a - :> sublist of the same type. + :> 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. - :> + :> a mapping between a term and part of a test tree. (pair term (each $-(@uvJ (list tape)) tests)) :: :> # %generate -:> utilities for generating models. +:> utilities for generating ++tests from files and directories. +| ++ merge-base-and-recur :> combine the current file and subdirectory. @@ -44,11 +43,10 @@ (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 :: eny=@uvJ] + |= v=vase ^- tests =+ arms=(sort (sloe p.v) aor) %+ turn arms @@ -56,14 +54,12 @@ :- arm :- %& |= eny=@uvJ - =+ context=(slop (init-test-vase:tester eny) v) + =+ context=(slop !>((init-test eny)) v) =/ r (slap context [%cnsg [arm ~] [%$ 3] [[%$ 2] ~]]) ((hard (list tape)) q:(slap r [%limb %results])) :: -++ init-test-vase - |= {cookie/@uvJ} - ^- vase - !>((init-test cookie)) +:> # %per-test +:> data initialized on a per-test basis. :: ++ init-test |= {cookie/@uvJ} From 2b35142c79987babc1e00be94703f5d6f66ac5be Mon Sep 17 00:00:00 2001 From: Elliot Glaysher Date: Thu, 18 Jan 2018 21:19:53 -0800 Subject: [PATCH 27/27] Add documentation for testing. --- web/testing.umd | 52 +++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 52 insertions(+) create mode 100644 web/testing.umd diff --git a/web/testing.umd b/web/testing.umd new file mode 100644 index 000000000..d7bf405ca --- /dev/null +++ b/web/testing.umd @@ -0,0 +1,52 @@ +:- ~[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. +