mirror of
https://github.com/urbit/shrub.git
synced 2024-11-23 20:26:54 +03:00
Merge branch 'm/contdist-and-behn' into i/5788/remote-scry
This commit is contained in:
yosoyubik
commit
dd0f35c8ad
3
.husky/post-checkout
Executable file
3
.husky/post-checkout
Executable file
@ -0,0 +1,3 @@
|
||||
#!/bin/sh
|
||||
command -v git-lfs >/dev/null 2>&1 || { echo >&2 "\nThis repository is configured for Git LFS but 'git-lfs' was not found on your path. If you no longer wish to use Git LFS, remove this hook by deleting .git/hooks/post-checkout.\n"; exit 2; }
|
||||
git lfs post-checkout "$@"
|
||||
3
.husky/post-commit
Executable file
3
.husky/post-commit
Executable file
@ -0,0 +1,3 @@
|
||||
#!/bin/sh
|
||||
command -v git-lfs >/dev/null 2>&1 || { echo >&2 "\nThis repository is configured for Git LFS but 'git-lfs' was not found on your path. If you no longer wish to use Git LFS, remove this hook by deleting .git/hooks/post-commit.\n"; exit 2; }
|
||||
git lfs post-commit "$@"
|
||||
3
.husky/post-merge
Executable file
3
.husky/post-merge
Executable file
@ -0,0 +1,3 @@
|
||||
#!/bin/sh
|
||||
command -v git-lfs >/dev/null 2>&1 || { echo >&2 "\nThis repository is configured for Git LFS but 'git-lfs' was not found on your path. If you no longer wish to use Git LFS, remove this hook by deleting .git/hooks/post-merge.\n"; exit 2; }
|
||||
git lfs post-merge "$@"
|
||||
3
.husky/pre-push
Executable file
3
.husky/pre-push
Executable file
@ -0,0 +1,3 @@
|
||||
#!/bin/sh
|
||||
command -v git-lfs >/dev/null 2>&1 || { echo >&2 "\nThis repository is configured for Git LFS but 'git-lfs' was not found on your path. If you no longer wish to use Git LFS, remove this hook by deleting .git/hooks/pre-push.\n"; exit 2; }
|
||||
git lfs pre-push "$@"
|
||||
@ -47,6 +47,7 @@
|
||||
event-log=(list unix-timed-event)
|
||||
next-events=(qeu unix-event)
|
||||
processing-events=?
|
||||
namespace=(map path song:ames)
|
||||
==
|
||||
--
|
||||
::
|
||||
@ -224,6 +225,16 @@
|
||||
::
|
||||
:: Peek
|
||||
::
|
||||
++ peek-once
|
||||
|= [=view =desk =spur]
|
||||
=/ res (mox +22.snap)
|
||||
?> ?=(%0 -.res)
|
||||
=/ peek p.res
|
||||
=/ pek (slum peek [[~ ~] %| %once view desk spur])
|
||||
=+ ;;(res=(unit (cask [path (cask)])) pek)
|
||||
::NOTE it's an %omen, so we unpack a little bit deeper
|
||||
(bind res (cork tail (cork tail tail)))
|
||||
::
|
||||
++ peek
|
||||
|= p=*
|
||||
=/ res (mox +22.snap)
|
||||
@ -650,6 +661,37 @@
|
||||
=. this thus
|
||||
(publish-effect:(pe who) [/ %restore ~])
|
||||
(pe ~bud) :: XX why ~bud? need an example
|
||||
::
|
||||
%read
|
||||
?~ pier=(~(get by ships.piers) from.ae)
|
||||
(pe from.ae)
|
||||
=/ cash (~(get by namespace.u.pier) path.ae)
|
||||
|-
|
||||
?^ cash
|
||||
?: (gth num.ae (lent u.cash))
|
||||
(pe from.ae)
|
||||
::TODO depends on /ted/aqua/ames behavior in a weird indirect way
|
||||
=/ for=@p `@`(tail for.ae) ::NOTE moons & comets not supported
|
||||
=; task=task-arvo
|
||||
^$(ae [%event for /a/aqua/fine-response task], thus this)
|
||||
:+ %hear `lane:ames`[%| `@`from.ae]
|
||||
^- blob:ames
|
||||
=/ [amp=? =packet:ames]
|
||||
::NOTE dec is important! so dumb!!
|
||||
(decode-packet:ames `@`(snag (dec num.ae) u.cash))
|
||||
::TODO runtime needs to update rcvr field also
|
||||
::NOTE rcvr life is allowed to be wrong
|
||||
(encode-packet:ames amp packet(sndr from.ae, rcvr for))
|
||||
=/ pacs=(unit song:ames)
|
||||
%+ biff
|
||||
(peek-once:(pe from.ae) %ax %$ [%fine %message path.ae])
|
||||
(soft song:ames)
|
||||
?~ pacs (pe from.ae)
|
||||
=. namespace.u.pier
|
||||
(~(put by namespace.u.pier) path.ae u.pacs)
|
||||
=. ships.piers
|
||||
(~(put by ships.piers) from.ae u.pier)
|
||||
$(cash pacs, thus this)
|
||||
::
|
||||
%event
|
||||
~? &(aqua-debug=| !?=(?(%belt %hear) -.q.ue.ae))
|
||||
|
||||
@ -445,8 +445,8 @@
|
||||
=/ =pass
|
||||
(pass-from-eth:azimuth [32^crypt 32^auth suite]:keys.net)
|
||||
^- (list [@p udiff:point])
|
||||
:* [ship id %rift rift.net %.y]
|
||||
[ship id %keys [life.keys.net suite.keys.net pass] %.y]
|
||||
:* [ship id %keys [life.keys.net suite.keys.net pass] %.y]
|
||||
[ship id %rift rift.net %.y]
|
||||
[ship id %spon ?:(has.sponsor.net `who.sponsor.net ~)]
|
||||
udiffs
|
||||
==
|
||||
|
||||
@ -524,6 +524,7 @@
|
||||
:~ 'messages'^(numb (lent messages))
|
||||
'packets'^(numb ~(wyt in packets))
|
||||
'heeds'^(set-array heeds from-duct)
|
||||
'keens'^(set-array ~(key by keens) path)
|
||||
==
|
||||
::
|
||||
:: json for known peer is structured to closely match the peer-state type.
|
||||
@ -705,7 +706,7 @@
|
||||
'fragment-num'^(numb fragment-num)
|
||||
'num-fragments'^(numb num-fragments)
|
||||
'last-sent'^(time last-sent)
|
||||
'retries'^(numb retries)
|
||||
'tries'^(numb tries)
|
||||
'skips'^(numb skips)
|
||||
==
|
||||
::
|
||||
|
||||
6
pkg/arvo/gen/hood/keen.hoon
Normal file
6
pkg/arvo/gen/hood/keen.hoon
Normal file
@ -0,0 +1,6 @@
|
||||
:- %say
|
||||
|= [^ [=ship pax=$@(~ [path ~])] ~]
|
||||
=/ =path
|
||||
?^ pax -.pax
|
||||
/c/x/1/kids/sys/hoon/hoon
|
||||
[%helm-pass %a %keen ship path]
|
||||
6
pkg/arvo/gen/hood/pine.hoon
Normal file
6
pkg/arvo/gen/hood/pine.hoon
Normal file
@ -0,0 +1,6 @@
|
||||
:- %say
|
||||
|= [^ [=ship pax=$@(~ [path ~])] ~]
|
||||
=/ =path
|
||||
?^ pax -.pax
|
||||
/c/x/1/kids/sys/hoon/hoon
|
||||
[%helm-pass %a %pine ship path]
|
||||
8
pkg/arvo/gen/hood/yawn.hoon
Normal file
8
pkg/arvo/gen/hood/yawn.hoon
Normal file
@ -0,0 +1,8 @@
|
||||
:- %say
|
||||
|= [^ [=ship pax=$@(~ [=path ~])] ~]
|
||||
=/ =path
|
||||
?~ pax /cz/(scot %p ship)/kids/1/sys
|
||||
?> ?=([@ *] path.pax)
|
||||
=, pax
|
||||
[i.path (scot %p ship) t.path]
|
||||
[%helm-pass %a %yawn path]
|
||||
286
pkg/arvo/lib/deq.hoon
Normal file
286
pkg/arvo/lib/deq.hoon
Normal file
@ -0,0 +1,286 @@
|
||||
|%
|
||||
::
|
||||
++ welt
|
||||
~/ %welt
|
||||
|* [a=(list) b=(list)]
|
||||
=> .(a ^.(homo a), b ^.(homo b))
|
||||
|- ^+ b
|
||||
?~ a b
|
||||
$(a t.a, b [i.a b])
|
||||
++ afx
|
||||
|$ [val]
|
||||
$% [%1 p=val ~]
|
||||
[%2 p=val q=val ~]
|
||||
[%3 p=val q=val r=val ~]
|
||||
[%4 p=val q=val r=val s=val ~]
|
||||
==
|
||||
++ pha
|
||||
|$ [val]
|
||||
$~ [%nul ~]
|
||||
$% [%nul ~]
|
||||
[%one p=val]
|
||||
[%big p=(afx val) q=(pha val) r=(afx val)]
|
||||
==
|
||||
::
|
||||
++ deq
|
||||
|* val=mold
|
||||
|%
|
||||
::
|
||||
:: +| %utilities
|
||||
::
|
||||
++ make-afx
|
||||
|= ls=(list val)
|
||||
?+ ls ~|(bad-finger/(lent ls) !!)
|
||||
[* ~] [%1 ls]
|
||||
[* * ~] [%2 ls]
|
||||
[* * * ~] [%3 ls]
|
||||
[* * * * ~] [%4 ls]
|
||||
==
|
||||
::
|
||||
++ afx-to-pha
|
||||
|= =(afx val)
|
||||
^- (pha val)
|
||||
(apl *(pha val) +.afx)
|
||||
::
|
||||
:: +| %left-biased-operations
|
||||
::
|
||||
:: +pop-left: remove leftmost value from tree
|
||||
::
|
||||
++ pop-left
|
||||
|= a=(pha val)
|
||||
^- [val=(unit val) pha=(pha val)]
|
||||
?- -.a
|
||||
%nul ~^a
|
||||
::
|
||||
%one [`p.a nul/~]
|
||||
::
|
||||
%big
|
||||
[`p.p.a (big-left +.+.p.a q.a r.a)]
|
||||
==
|
||||
::
|
||||
++ apl
|
||||
|= [a=(pha val) vals=(list val)]
|
||||
^- (pha val)
|
||||
=. vals (flop vals)
|
||||
|-
|
||||
?~ vals a
|
||||
$(a (cons a i.vals), vals t.vals)
|
||||
::
|
||||
::
|
||||
++ dip-left
|
||||
|* state=mold
|
||||
|= $: a=(pha val)
|
||||
=state
|
||||
f=$-([state val] [(unit val) ? state])
|
||||
==
|
||||
^+ [state a]
|
||||
=/ acc [stop=`?`%.n state=state]
|
||||
=| new=(pha val)
|
||||
|-
|
||||
?: stop.acc
|
||||
:: cat new and old
|
||||
[state.acc (weld a new)]
|
||||
=^ val=(unit val) a
|
||||
(pop-left a)
|
||||
?~ val
|
||||
[state.acc new]
|
||||
=^ res=(unit ^val) acc
|
||||
(f state.acc u.val)
|
||||
?~ res $
|
||||
$(new (snoc new u.res))
|
||||
::
|
||||
++ big-left
|
||||
|= [ls=(list val) a=(pha val) sf=(afx val)]
|
||||
^- (pha val)
|
||||
?. =(~ ls)
|
||||
[%big (make-afx ls) a sf]
|
||||
=/ [val=(unit val) inner=_a]
|
||||
(pop-left a)
|
||||
?~ val
|
||||
(afx-to-pha sf)
|
||||
[%big [%1 u.val ~] inner sf]
|
||||
::
|
||||
++ cons
|
||||
=| b=(list val)
|
||||
|= [a=(pha val) c=val]
|
||||
^- (pha val)
|
||||
=. b [c b]
|
||||
|-
|
||||
?~ b a
|
||||
?- -.a
|
||||
::
|
||||
%nul
|
||||
$(a [%one i.b], b t.b)
|
||||
::
|
||||
%one
|
||||
%= $
|
||||
b t.b
|
||||
a [%big [%1 i.b ~] [%nul ~] [%1 p.a ~]]
|
||||
==
|
||||
::
|
||||
%big
|
||||
?. ?=(%4 -.p.a)
|
||||
%= $
|
||||
b t.b
|
||||
::
|
||||
a
|
||||
?- -.p.a
|
||||
%1 big/[[%2 i.b p.p.a ~] q.a r.a]
|
||||
%2 big/[[%3 i.b p.p.a q.p.a ~] q.a r.a]
|
||||
%3 big/[[%4 i.b p.p.a q.p.a r.p.a ~] q.a r.a]
|
||||
==
|
||||
==
|
||||
=/ inner
|
||||
$(a q.a, b ~[s.p.a r.p.a q.p.a])
|
||||
=. inner
|
||||
$(a inner, b t.b)
|
||||
big/[[%2 i.b p.p.a ~] inner r.a]
|
||||
==
|
||||
::
|
||||
:: +| %right-biased-operations
|
||||
::
|
||||
:: +snoc: append to end (right) of tree
|
||||
::
|
||||
++ snoc
|
||||
|= [a=(pha val) b=val]
|
||||
^+ a
|
||||
?- -.a
|
||||
%nul [%one b]
|
||||
::
|
||||
%one
|
||||
:- %big
|
||||
:* [%1 p.a ~]
|
||||
[%nul ~]
|
||||
[%1 b ~]
|
||||
==
|
||||
::
|
||||
%big
|
||||
?- -.r.a
|
||||
::
|
||||
%1
|
||||
:- %big
|
||||
[p.a q.a [%2 p.r.a b ~]]
|
||||
::
|
||||
%2
|
||||
:- %big
|
||||
[p.a q.a [%3 p.r.a q.r.a b ~]]
|
||||
::
|
||||
%3
|
||||
:- %big
|
||||
[p.a q.a [%4 p.r.a q.r.a r.r.a b ~]]
|
||||
::
|
||||
%4
|
||||
=/ inner
|
||||
$(a q.a, b p.r.a)
|
||||
=. inner
|
||||
$(a inner, b q.r.a)
|
||||
=. inner
|
||||
$(a inner, b r.r.a)
|
||||
:- %big
|
||||
:* p.a
|
||||
inner
|
||||
[%2 s.r.a b ~]
|
||||
==
|
||||
==
|
||||
==
|
||||
:: +apr: append list to end (right) of tree
|
||||
::
|
||||
++ apr
|
||||
|= [a=(pha val) vals=(list val)]
|
||||
^- (pha val)
|
||||
?~ vals a
|
||||
$(a (snoc a i.vals), vals t.vals)
|
||||
::
|
||||
:: +big-right: construct a tree, automatically balancing the right
|
||||
:: side
|
||||
++ big-right
|
||||
|= [pf=(afx val) a=(pha val) ls=(list val)]
|
||||
^- (pha val)
|
||||
?. =(~ ls)
|
||||
[%big pf a (make-afx ls)]
|
||||
=/ [val=(unit val) inner=_a]
|
||||
(pop-right a)
|
||||
?~ val
|
||||
(afx-to-pha pf)
|
||||
[%big pf inner [%1 u.val ~]]
|
||||
::
|
||||
:: +pop-right: remove rightmost value from tree
|
||||
::
|
||||
++ pop-right
|
||||
|= a=(pha val)
|
||||
^- [val=(unit val) pha=(pha val)]
|
||||
?- -.a
|
||||
%nul ~^a
|
||||
::
|
||||
%one [`p.a nul/~]
|
||||
::
|
||||
%big
|
||||
=/ ls=(list val) +.r.a
|
||||
=^ item ls (flop ls)
|
||||
[`item (big-right p.a q.a (flop ls))]
|
||||
==
|
||||
::
|
||||
++ peek-right
|
||||
|= a=(pha val)
|
||||
?- -.a
|
||||
%nul ~
|
||||
%one `p.a
|
||||
%big (rear +.r.a)
|
||||
==
|
||||
::
|
||||
:: +| %manipulation
|
||||
::
|
||||
:: +weld: concatenate two trees
|
||||
::
|
||||
:: O(log n)
|
||||
++ weld
|
||||
=| c=(list val)
|
||||
|= [a=(pha val) b=(pha val)]
|
||||
^- (pha val)
|
||||
?- -.b
|
||||
%nul (apr a c)
|
||||
%one (snoc (apr a c) p.b)
|
||||
::
|
||||
%big
|
||||
?- -.a
|
||||
%nul (apl b c)
|
||||
%one (cons (apl b c) p.a)
|
||||
::
|
||||
%big
|
||||
:- %big
|
||||
=- [p.a - r.b]
|
||||
$(a q.a, b q.b, c :(welp +.r.a c +.p.b))
|
||||
==
|
||||
==
|
||||
:: +tap: transform tree to list
|
||||
::
|
||||
++ tap
|
||||
=| res=(list val)
|
||||
|= a=(pha val)
|
||||
!.
|
||||
|^ ^+ res
|
||||
?- -.a
|
||||
%nul ~
|
||||
%one ~[p.a]
|
||||
::
|
||||
%big
|
||||
=/ fst=_res
|
||||
(tap-afx p.a)
|
||||
=/ lst=_res
|
||||
(tap-afx r.a)
|
||||
=/ mid=_res
|
||||
$(a q.a)
|
||||
:(welp fst mid lst)
|
||||
==
|
||||
++ tap-afx
|
||||
|= ax=(afx val)
|
||||
^+ res
|
||||
?- -.ax
|
||||
%1 +.ax
|
||||
%2 +.ax
|
||||
%3 +.ax
|
||||
%4 +.ax
|
||||
==
|
||||
--
|
||||
--
|
||||
--
|
||||
@ -39,10 +39,12 @@
|
||||
$% :: %da: date
|
||||
:: %tas: label
|
||||
:: %ud: sequence
|
||||
:: %uv: hash
|
||||
::
|
||||
[%da p=@da]
|
||||
[%tas p=@tas]
|
||||
[%ud p=@ud]
|
||||
[%uv p=@uv]
|
||||
==
|
||||
+$ cage (cask vase)
|
||||
++ cask |$ [a] (pair mark a)
|
||||
@ -313,6 +315,7 @@
|
||||
^- (unit case)
|
||||
?^ num=(slaw %ud knot) `[%ud u.num]
|
||||
?^ wen=(slaw %da knot) `[%da u.wen]
|
||||
?^ hax=(slaw %uv knot) `[%uv u.hax]
|
||||
?~ lab=(slaw %tas knot) ~
|
||||
`[%tas u.lab]
|
||||
::
|
||||
@ -1719,7 +1722,6 @@
|
||||
%c %clay
|
||||
%d %dill
|
||||
%e %eyre
|
||||
%f %ford
|
||||
%g %gall
|
||||
%i %iris
|
||||
%j %jael
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
@ -1448,17 +1448,27 @@
|
||||
|%
|
||||
:: :: ++sign:as:crub:
|
||||
++ sign ::
|
||||
|= msg=@
|
||||
^- @ux
|
||||
(jam [(sigh msg) msg])
|
||||
:: :: ++sigh:as:crub:
|
||||
++ sigh ::
|
||||
|= msg=@
|
||||
^- @ux
|
||||
?~ sek ~| %pubkey-only !!
|
||||
(jam [(sign:ed msg sgn.u.sek) msg])
|
||||
(sign:ed msg sgn.u.sek)
|
||||
:: :: ++sure:as:crub:
|
||||
++ sure ::
|
||||
|= txt=@
|
||||
^- (unit @ux)
|
||||
=+ ;;([sig=@ msg=@] (cue txt))
|
||||
?. (veri:ed sig msg sgn.pub) ~
|
||||
?. (safe sig msg) ~
|
||||
(some msg)
|
||||
:: :: ++safe:as:crub:
|
||||
++ safe
|
||||
|= [sig=@ msg=@]
|
||||
^- ?
|
||||
(veri:ed sig msg sgn.pub)
|
||||
:: :: ++seal:as:crub:
|
||||
++ seal ::
|
||||
|= [bpk=pass msg=@]
|
||||
@ -5347,412 +5357,6 @@
|
||||
$(pops [oldest pops])
|
||||
--
|
||||
--
|
||||
::
|
||||
:: +mop: constructs and validates ordered ordered map based on key,
|
||||
:: val, and comparator gate
|
||||
::
|
||||
++ mop
|
||||
|* [key=mold value=mold]
|
||||
|= ord=$-([key key] ?)
|
||||
|= a=*
|
||||
=/ b ;;((tree [key=key val=value]) a)
|
||||
?> (apt:((on key value) ord) b)
|
||||
b
|
||||
::
|
||||
::
|
||||
++ ordered-map on
|
||||
:: +on: treap with user-specified horizontal order, ordered-map
|
||||
::
|
||||
:: WARNING: ordered-map will not work properly if two keys can be
|
||||
:: unequal under noun equality but equal via the compare gate
|
||||
::
|
||||
++ on
|
||||
~/ %on
|
||||
|* [key=mold val=mold]
|
||||
=> |%
|
||||
+$ item [key=key val=val]
|
||||
--
|
||||
:: +compare: item comparator for horizontal order
|
||||
::
|
||||
~% %comp +>+ ~
|
||||
|= compare=$-([key key] ?)
|
||||
~% %core + ~
|
||||
|%
|
||||
:: +all: apply logical AND boolean test on all values
|
||||
::
|
||||
++ all
|
||||
~/ %all
|
||||
|= [a=(tree item) b=$-(item ?)]
|
||||
^- ?
|
||||
|-
|
||||
?~ a
|
||||
&
|
||||
?&((b n.a) $(a l.a) $(a r.a))
|
||||
:: +any: apply logical OR boolean test on all values
|
||||
::
|
||||
++ any
|
||||
~/ %any
|
||||
|= [a=(tree item) b=$-(item ?)]
|
||||
|- ^- ?
|
||||
?~ a
|
||||
|
|
||||
?|((b n.a) $(a l.a) $(a r.a))
|
||||
:: +apt: verify horizontal and vertical orderings
|
||||
::
|
||||
++ apt
|
||||
~/ %apt
|
||||
|= a=(tree item)
|
||||
=| [l=(unit key) r=(unit key)]
|
||||
|- ^- ?
|
||||
:: empty tree is valid
|
||||
::
|
||||
?~ a %.y
|
||||
:: nonempty trees must maintain several criteria
|
||||
::
|
||||
?& :: if .n.a is left of .u.l, assert horizontal comparator
|
||||
::
|
||||
?~(l %.y (compare key.n.a u.l))
|
||||
:: if .n.a is right of .u.r, assert horizontal comparator
|
||||
::
|
||||
?~(r %.y (compare u.r key.n.a))
|
||||
:: if .a is not leftmost element, assert vertical order between
|
||||
:: .l.a and .n.a and recurse to the left with .n.a as right
|
||||
:: neighbor
|
||||
::
|
||||
?~(l.a %.y &((mor key.n.a key.n.l.a) $(a l.a, l `key.n.a)))
|
||||
:: if .a is not rightmost element, assert vertical order
|
||||
:: between .r.a and .n.a and recurse to the right with .n.a as
|
||||
:: left neighbor
|
||||
::
|
||||
?~(r.a %.y &((mor key.n.a key.n.r.a) $(a r.a, r `key.n.a)))
|
||||
==
|
||||
:: +bap: convert to list, right to left
|
||||
::
|
||||
++ bap
|
||||
~/ %bap
|
||||
|= a=(tree item)
|
||||
^- (list item)
|
||||
=| b=(list item)
|
||||
|- ^+ b
|
||||
?~ a b
|
||||
$(a r.a, b [n.a $(a l.a)])
|
||||
:: +del: delete .key from .a if it exists, producing value iff deleted
|
||||
::
|
||||
++ del
|
||||
~/ %del
|
||||
|= [a=(tree item) =key]
|
||||
^- [(unit val) (tree item)]
|
||||
?~ a [~ ~]
|
||||
:: we found .key at the root; delete and rebalance
|
||||
::
|
||||
?: =(key key.n.a)
|
||||
[`val.n.a (nip a)]
|
||||
:: recurse left or right to find .key
|
||||
::
|
||||
?: (compare key key.n.a)
|
||||
=+ [found lef]=$(a l.a)
|
||||
[found a(l lef)]
|
||||
=+ [found rig]=$(a r.a)
|
||||
[found a(r rig)]
|
||||
:: +dip: stateful partial inorder traversal
|
||||
::
|
||||
:: Mutates .state on each run of .f. Starts at .start key, or if
|
||||
:: .start is ~, starts at the head. Stops when .f produces .stop=%.y.
|
||||
:: Traverses from left to right keys.
|
||||
:: Each run of .f can replace an item's value or delete the item.
|
||||
::
|
||||
++ dip
|
||||
~/ %dip
|
||||
|* state=mold
|
||||
|= $: a=(tree item)
|
||||
=state
|
||||
f=$-([state item] [(unit val) ? state])
|
||||
==
|
||||
^+ [state a]
|
||||
:: acc: accumulator
|
||||
::
|
||||
:: .stop: set to %.y by .f when done traversing
|
||||
:: .state: threaded through each run of .f and produced by +abet
|
||||
::
|
||||
=/ acc [stop=`?`%.n state=state]
|
||||
=< abet =< main
|
||||
|%
|
||||
++ this .
|
||||
++ abet [state.acc a]
|
||||
:: +main: main recursive loop; performs a partial inorder traversal
|
||||
::
|
||||
++ main
|
||||
^+ this
|
||||
:: stop if empty or we've been told to stop
|
||||
::
|
||||
?: =(~ a) this
|
||||
?: stop.acc this
|
||||
:: inorder traversal: left -> node -> right, until .f sets .stop
|
||||
::
|
||||
=. this left
|
||||
?: stop.acc this
|
||||
=^ del this node
|
||||
=? this !stop.acc right
|
||||
=? a del (nip a)
|
||||
this
|
||||
:: +node: run .f on .n.a, updating .a, .state, and .stop
|
||||
::
|
||||
++ node
|
||||
^+ [del=*? this]
|
||||
:: run .f on node, updating .stop.acc and .state.acc
|
||||
::
|
||||
?> ?=(^ a)
|
||||
=^ res acc (f state.acc n.a)
|
||||
?~ res
|
||||
[del=& this]
|
||||
[del=| this(val.n.a u.res)]
|
||||
:: +left: recurse on left subtree, copying mutant back into .l.a
|
||||
::
|
||||
++ left
|
||||
^+ this
|
||||
?~ a this
|
||||
=/ lef main(a l.a)
|
||||
lef(a a(l a.lef))
|
||||
:: +right: recurse on right subtree, copying mutant back into .r.a
|
||||
::
|
||||
++ right
|
||||
^+ this
|
||||
?~ a this
|
||||
=/ rig main(a r.a)
|
||||
rig(a a(r a.rig))
|
||||
--
|
||||
:: +gas: put a list of items
|
||||
::
|
||||
++ gas
|
||||
~/ %gas
|
||||
|= [a=(tree item) b=(list item)]
|
||||
^- (tree item)
|
||||
?~ b a
|
||||
$(b t.b, a (put a i.b))
|
||||
:: +get: get val at key or return ~
|
||||
::
|
||||
++ get
|
||||
~/ %get
|
||||
|= [a=(tree item) b=key]
|
||||
^- (unit val)
|
||||
?~ a ~
|
||||
?: =(b key.n.a)
|
||||
`val.n.a
|
||||
?: (compare b key.n.a)
|
||||
$(a l.a)
|
||||
$(a r.a)
|
||||
:: +got: need value at key
|
||||
::
|
||||
++ got
|
||||
|= [a=(tree item) b=key]
|
||||
^- val
|
||||
(need (get a b))
|
||||
:: +has: check for key existence
|
||||
::
|
||||
++ has
|
||||
~/ %has
|
||||
|= [a=(tree item) b=key]
|
||||
^- ?
|
||||
!=(~ (get a b))
|
||||
:: +lot: take a subset range excluding start and/or end and all elements
|
||||
:: outside the range
|
||||
::
|
||||
++ lot
|
||||
~/ %lot
|
||||
|= $: tre=(tree item)
|
||||
start=(unit key)
|
||||
end=(unit key)
|
||||
==
|
||||
^- (tree item)
|
||||
|^
|
||||
?: ?&(?=(~ start) ?=(~ end))
|
||||
tre
|
||||
?~ start
|
||||
(del-span tre %end end)
|
||||
?~ end
|
||||
(del-span tre %start start)
|
||||
?> (compare u.start u.end)
|
||||
=. tre (del-span tre %start start)
|
||||
(del-span tre %end end)
|
||||
::
|
||||
++ del-span
|
||||
|= [a=(tree item) b=?(%start %end) c=(unit key)]
|
||||
^- (tree item)
|
||||
?~ a a
|
||||
?~ c a
|
||||
?- b
|
||||
%start
|
||||
:: found key
|
||||
?: =(key.n.a u.c)
|
||||
(nip a(l ~))
|
||||
:: traverse to find key
|
||||
?: (compare key.n.a u.c)
|
||||
:: found key to the left of start
|
||||
$(a (nip a(l ~)))
|
||||
:: found key to the right of start
|
||||
a(l $(a l.a))
|
||||
::
|
||||
%end
|
||||
:: found key
|
||||
?: =(u.c key.n.a)
|
||||
(nip a(r ~))
|
||||
:: traverse to find key
|
||||
?: (compare key.n.a u.c)
|
||||
:: found key to the left of end
|
||||
a(r $(a r.a))
|
||||
:: found key to the right of end
|
||||
$(a (nip a(r ~)))
|
||||
==
|
||||
--
|
||||
:: +nip: remove root; for internal use
|
||||
::
|
||||
++ nip
|
||||
~/ %nip
|
||||
|= a=(tree item)
|
||||
^- (tree item)
|
||||
?> ?=(^ a)
|
||||
:: delete .n.a; merge and balance .l.a and .r.a
|
||||
::
|
||||
|- ^- (tree item)
|
||||
?~ l.a r.a
|
||||
?~ r.a l.a
|
||||
?: (mor key.n.l.a key.n.r.a)
|
||||
l.a(r $(l.a r.l.a))
|
||||
r.a(l $(r.a l.r.a))
|
||||
::
|
||||
:: +pop: produce .head (leftmost item) and .rest or crash if empty
|
||||
::
|
||||
++ pop
|
||||
~/ %pop
|
||||
|= a=(tree item)
|
||||
^- [head=item rest=(tree item)]
|
||||
?~ a !!
|
||||
?~ l.a [n.a r.a]
|
||||
=/ l $(a l.a)
|
||||
:- head.l
|
||||
:: load .rest.l back into .a and rebalance
|
||||
::
|
||||
?: |(?=(~ rest.l) (mor key.n.a key.n.rest.l))
|
||||
a(l rest.l)
|
||||
rest.l(r a(r r.rest.l))
|
||||
:: +pry: produce head (leftmost item) or null
|
||||
::
|
||||
++ pry
|
||||
~/ %pry
|
||||
|= a=(tree item)
|
||||
^- (unit item)
|
||||
?~ a ~
|
||||
|-
|
||||
?~ l.a `n.a
|
||||
$(a l.a)
|
||||
:: +put: ordered item insert
|
||||
::
|
||||
++ put
|
||||
~/ %put
|
||||
|= [a=(tree item) =key =val]
|
||||
^- (tree item)
|
||||
:: base case: replace null with single-item tree
|
||||
::
|
||||
?~ a [n=[key val] l=~ r=~]
|
||||
:: base case: overwrite existing .key with new .val
|
||||
::
|
||||
?: =(key.n.a key) a(val.n val)
|
||||
:: if item goes on left, recurse left then rebalance vertical order
|
||||
::
|
||||
?: (compare key key.n.a)
|
||||
=/ l $(a l.a)
|
||||
?> ?=(^ l)
|
||||
?: (mor key.n.a key.n.l)
|
||||
a(l l)
|
||||
l(r a(l r.l))
|
||||
:: item goes on right; recurse right then rebalance vertical order
|
||||
::
|
||||
=/ r $(a r.a)
|
||||
?> ?=(^ r)
|
||||
?: (mor key.n.a key.n.r)
|
||||
a(r r)
|
||||
r(l a(r l.r))
|
||||
:: +ram: produce tail (rightmost item) or null
|
||||
::
|
||||
++ ram
|
||||
~/ %ram
|
||||
|= a=(tree item)
|
||||
^- (unit item)
|
||||
?~ a ~
|
||||
|-
|
||||
?~ r.a `n.a
|
||||
$(a r.a)
|
||||
:: +run: apply gate to transform all values in place
|
||||
::
|
||||
++ run
|
||||
~/ %run
|
||||
|* [a=(tree item) b=$-(val *)]
|
||||
|-
|
||||
?~ a a
|
||||
[n=[key.n.a (b val.n.a)] l=$(a l.a) r=$(a r.a)]
|
||||
:: +tab: tabulate a subset excluding start element with a max count
|
||||
::
|
||||
++ tab
|
||||
~/ %tab
|
||||
|= [a=(tree item) b=(unit key) c=@]
|
||||
^- (list item)
|
||||
|^
|
||||
(flop e:(tabulate (del-span a b) b c))
|
||||
::
|
||||
++ tabulate
|
||||
|= [a=(tree item) b=(unit key) c=@]
|
||||
^- [d=@ e=(list item)]
|
||||
?: ?&(?=(~ b) =(c 0))
|
||||
[0 ~]
|
||||
=| f=[d=@ e=(list item)]
|
||||
|- ^+ f
|
||||
?: ?|(?=(~ a) =(d.f c)) f
|
||||
=. f $(a l.a)
|
||||
?: =(d.f c) f
|
||||
=. f [+(d.f) [n.a e.f]]
|
||||
?:(=(d.f c) f $(a r.a))
|
||||
::
|
||||
++ del-span
|
||||
|= [a=(tree item) b=(unit key)]
|
||||
^- (tree item)
|
||||
?~ a a
|
||||
?~ b a
|
||||
?: =(key.n.a u.b)
|
||||
r.a
|
||||
?: (compare key.n.a u.b)
|
||||
$(a r.a)
|
||||
a(l $(a l.a))
|
||||
--
|
||||
:: +tap: convert to list, left to right
|
||||
::
|
||||
++ tap
|
||||
~/ %tap
|
||||
|= a=(tree item)
|
||||
^- (list item)
|
||||
=| b=(list item)
|
||||
|- ^+ b
|
||||
?~ a b
|
||||
$(a l.a, b [n.a $(a r.a)])
|
||||
:: +uni: unify two ordered maps
|
||||
::
|
||||
:: .b takes precedence over .a if keys overlap.
|
||||
::
|
||||
++ uni
|
||||
~/ %uni
|
||||
|= [a=(tree item) b=(tree item)]
|
||||
^- (tree item)
|
||||
?~ b a
|
||||
?~ a b
|
||||
?: =(key.n.a key.n.b)
|
||||
[n=n.b l=$(a l.a, b l.b) r=$(a r.a, b r.b)]
|
||||
?: (mor key.n.a key.n.b)
|
||||
?: (compare key.n.b key.n.a)
|
||||
$(l.a $(a l.a, r.b ~), b r.b)
|
||||
$(r.a $(a r.a, l.b ~), b l.b)
|
||||
?: (compare key.n.a key.n.b)
|
||||
$(l.b $(b l.b, r.a ~), a r.a)
|
||||
$(r.b $(b r.b, l.a ~), a l.a)
|
||||
--
|
||||
:: ::
|
||||
:::: ++userlib :: (2u) non-vane utils
|
||||
:: ::::
|
||||
@ -6084,4 +5688,70 @@
|
||||
?. ?=(%soft -.wrapped)
|
||||
wrapped
|
||||
;;(task +.wrapped)
|
||||
::
|
||||
::
|
||||
++ balk
|
||||
=< bulk
|
||||
!:
|
||||
|%
|
||||
+$ bulk
|
||||
$: [her=ship rif=rift lyf=life]
|
||||
[van=@ta car=@ta cas=case]
|
||||
spr=spur
|
||||
==
|
||||
::
|
||||
++ de-part
|
||||
|= [=ship =rift =life =(pole knot)]
|
||||
^- (unit bulk)
|
||||
?. ?=([van=@ car=@ cas=@ spr=*] pole) ~
|
||||
?~ cas=(de-case cas.pole) ~
|
||||
:- ~
|
||||
:* [ship rift life]
|
||||
[van.pole car.pole u.cas]
|
||||
spr.pole
|
||||
==
|
||||
::
|
||||
++ de-path-soft
|
||||
|= =(pole knot)
|
||||
^- (unit bulk)
|
||||
:: [ship rift life vane care case path]
|
||||
?. ?=([her=@ rif=@ lyf=@ van=@ car=@ cas=@ spr=*] pole)
|
||||
~
|
||||
?~ her=(slaw %p her.pole) ~
|
||||
?~ rif=(slaw %ud rif.pole) ~
|
||||
?~ lyf=(slaw %ud lyf.pole) ~
|
||||
?~ cas=(de-case cas.pole) ~
|
||||
:- ~
|
||||
:* [u.her u.rif u.lyf]
|
||||
[van.pole car.pole u.cas]
|
||||
spr.pole
|
||||
==
|
||||
::
|
||||
++ de-path
|
||||
|= =path
|
||||
^- bulk
|
||||
(need (de-path-soft +<))
|
||||
::
|
||||
++ en-path
|
||||
|= =bulk
|
||||
^- path
|
||||
:* (scot %p her.bulk)
|
||||
(scot %ud rif.bulk)
|
||||
(scot %ud lyf.bulk)
|
||||
van.bulk
|
||||
car.bulk
|
||||
(scot cas.bulk)
|
||||
spr.bulk
|
||||
==
|
||||
::
|
||||
++ en-roof
|
||||
|= =bulk
|
||||
^- [vis=view bem=beam]
|
||||
=/ [des=desk pax=path]
|
||||
?^ spr.bulk spr.bulk
|
||||
[%$ ~]
|
||||
=/ bem=beam =,(bulk [[her des cas] pax])
|
||||
=+ vis=(cat 3 van.bulk car.bulk)
|
||||
[vis bem]
|
||||
--
|
||||
--
|
||||
|
||||
@ -21,10 +21,16 @@
|
||||
[%event who [/a/newt/0v1n.2m9vh %born ~]]~
|
||||
::
|
||||
++ handle-send
|
||||
|= [our=ship now=@da sndr=@p way=wire %send lan=lane:ames pac=@]
|
||||
=, ames
|
||||
|= [our=ship now=@da sndr=@p way=wire %send lan=lane pac=@]
|
||||
^- (list card:agent:gall)
|
||||
=/ rcvr=ship (lane-to-ship lan)
|
||||
=/ hear-lane (ship-to-lane sndr)
|
||||
=/ [ames=? =packet] (decode-packet pac)
|
||||
?: &(!ames !resp==(& (cut 0 [2 1] pac)))
|
||||
=/ [=peep =purr] (decode-request-info `@ux`(rsh 3^64 content.packet))
|
||||
%+ emit-aqua-events our
|
||||
[%read [rcvr path.peep] [hear-lane num.peep]]~
|
||||
%+ emit-aqua-events our
|
||||
[%event rcvr /a/newt/0v1n.2m9vh %hear hear-lane pac]~
|
||||
:: +lane-to-ship: decode a ship from an aqua lane
|
||||
|
||||
21
pkg/arvo/ted/keen.hoon
Normal file
21
pkg/arvo/ted/keen.hoon
Normal file
@ -0,0 +1,21 @@
|
||||
/- spider
|
||||
/+ strandio
|
||||
=, strand=strand:spider
|
||||
^- thread:spider
|
||||
|= arg=vase
|
||||
=/ m (strand ,vase)
|
||||
^- form:m
|
||||
=+ !<([~ arg=[ship path]] arg)
|
||||
;< dat=(unit (cask)) bind:m
|
||||
(keen:strandio arg)
|
||||
?~ dat
|
||||
(pure:m !>(~))
|
||||
;< =bowl:spider bind:m get-bowl:strandio
|
||||
=+ .^ =dais:clay %cb
|
||||
/(scot %p our.bowl)/[q.byk.bowl]/(scot %da now.bowl)/[p.u.dat]
|
||||
==
|
||||
=/ res (mule |.((vale.dais q.u.dat)))
|
||||
?: ?=(%| -.res)
|
||||
~|(%keen-mark-fail (mean leaf+"-keen: ames vale fail {<mark>}" p.res))
|
||||
(pure:m p.res)
|
||||
|
||||
13
pkg/arvo/ted/ph/keen.hoon
Normal file
13
pkg/arvo/ted/ph/keen.hoon
Normal file
@ -0,0 +1,13 @@
|
||||
/- spider
|
||||
/+ *ph-io
|
||||
=, strand=strand:spider
|
||||
^- thread:spider
|
||||
|= vase
|
||||
=/ m (strand ,vase)
|
||||
;< ~ bind:m start-simple
|
||||
;< ~ bind:m (init-ship ~bud &)
|
||||
;< ~ bind:m (init-ship ~dev &)
|
||||
;< ~ bind:m (dojo ~bud "-keen /cx/~dev/kids/1/desk/bill")
|
||||
;< ~ bind:m (wait-for-output ~bud "[ ~")
|
||||
;< ~ bind:m end
|
||||
(pure:m *vase)
|
||||
@ -184,6 +184,21 @@
|
||||
`[%done ~]
|
||||
`[%fail %timer-error u.error.sign-arvo.u.in.tin]
|
||||
==
|
||||
++ take-tune
|
||||
|= =wire
|
||||
=/ m (strand ,~)
|
||||
^- form:m
|
||||
|= tin=strand-input:strand
|
||||
?+ in.tin `[%skip ~]
|
||||
~ `[%wait ~]
|
||||
[~ %agent * %poke-ack *]
|
||||
?. =(wire wire.u.in.tin)
|
||||
`[%skip ~]
|
||||
?~ p.sign.u.in.tin
|
||||
`[%done ~]
|
||||
`[%fail %poke-fail u.p.sign.u.in.tin]
|
||||
==
|
||||
|
||||
::
|
||||
++ take-poke-ack
|
||||
|= =wire
|
||||
@ -319,6 +334,16 @@
|
||||
;< ~ bind:m (send-wait until)
|
||||
(take-wake `until)
|
||||
::
|
||||
++ keen
|
||||
|= [=ship =path]
|
||||
=/ m (strand ,(unit (cask)))
|
||||
^- form:m
|
||||
=/ =card:agent:gall [%pass /keen %arvo %a %keen ship path]
|
||||
;< ~ bind:m (send-raw-card card)
|
||||
;< [wire sign=sign-arvo] bind:m take-sign-arvo
|
||||
?> ?=(%tune +<.sign)
|
||||
(pure:m data.sign)
|
||||
::
|
||||
++ sleep
|
||||
|= for=@dr
|
||||
=/ m (strand ,~)
|
||||
|
||||
@ -41,6 +41,7 @@
|
||||
[%pause-events who=ship]
|
||||
[%snap-ships lab=term hers=(list ship)]
|
||||
[%restore-snap lab=term]
|
||||
[%read [from=ship =path] [for=lane:ames num=@ud]]
|
||||
[%event who=ship ue=unix-event]
|
||||
==
|
||||
::
|
||||
|
||||
@ -35,6 +35,16 @@ export class Ames extends Component {
|
||||
api.getPeer(who);
|
||||
}
|
||||
|
||||
renderPaths(paths) {
|
||||
const items = paths.map(path => {
|
||||
return {
|
||||
key: path,
|
||||
jsx: path
|
||||
}
|
||||
});
|
||||
return <SearchableList placeholder="path" items={items}/>;
|
||||
}
|
||||
|
||||
renderDucts(ducts) {
|
||||
const items = ducts.map(duct => {
|
||||
return {
|
||||
@ -91,7 +101,7 @@ export class Ames extends Component {
|
||||
<td>fragment-num</td>
|
||||
<td>num-fragments</td>
|
||||
<td>last-sent</td>
|
||||
<td>retries</td>
|
||||
<td>tries</td>
|
||||
<td>skips</td>
|
||||
</tr>
|
||||
<tr>
|
||||
@ -99,7 +109,7 @@ export class Ames extends Component {
|
||||
<td>{live['fragment-num']}</td>
|
||||
<td>{live['num-fragments']}</td>
|
||||
<td>{msToDa(live['last-sent'])}</td>
|
||||
<td>{live.retries}</td>
|
||||
<td>{live.tries}</td>
|
||||
<td>{live.skips}</td>
|
||||
</tr>
|
||||
</tbody></table>
|
||||
@ -213,6 +223,7 @@ export class Ames extends Component {
|
||||
Pending messages: {peer.alien.messages}
|
||||
Pending packets: {peer.alien.packets}
|
||||
Heeds: {this.renderDucts(peer.alien.heeds)}
|
||||
Keens: {this.renderPaths(peer.alien.keens)}
|
||||
</>);
|
||||
} else if (peer.known) {
|
||||
const p = peer.known;
|
||||
|
||||
0
pkg/urbit/wireshark/main.c
Normal file
0
pkg/urbit/wireshark/main.c
Normal file
93
tests/sys/lull/deq.hoon
Normal file
93
tests/sys/lull/deq.hoon
Normal file
@ -0,0 +1,93 @@
|
||||
/+ *deq
|
||||
/+ *test
|
||||
=/ big-num
|
||||
100
|
||||
=/ de (deq ,@)
|
||||
=/ big-list
|
||||
(gulf 1 big-num)
|
||||
=/ big
|
||||
(apl:de *(pha @) big-list)
|
||||
=/ foo-list (gulf 1 8)
|
||||
|%
|
||||
++ foo
|
||||
(apl:de *(pha @) 1 2 3 4 5 6 7 8 ~)
|
||||
++ bar
|
||||
`(pha @)`(apl:de *(pha @) 8 9 10 11 12 13 14 15 ~)
|
||||
::
|
||||
++ test-tap
|
||||
=/ ls
|
||||
~> %bout.[1 %tap]
|
||||
(tap:de big)
|
||||
(expect-eq !>(ls) !>(big-list))
|
||||
::
|
||||
++ test-left
|
||||
^- tang
|
||||
=/ bar
|
||||
~> %bout.[1 %cons]
|
||||
(cons:de bar 7)
|
||||
=. bar
|
||||
~> %bout.[1 %apl]
|
||||
(apl:de bar 1 2 3 4 5 6 ~)
|
||||
%- zing
|
||||
:-
|
||||
~> %bout.[1 %eq-1]
|
||||
(expect-eq !>((tap:de bar)) !>((gulf 1 15)))
|
||||
=^ val=(unit @) bar
|
||||
~> %bout.[1 %pop-left]
|
||||
(pop-left:de bar)
|
||||
~> %bout.[1 %eq-2]
|
||||
:~ (expect-eq !>(1) !>((need val)))
|
||||
(expect-eq !>((gulf 2 15)) !>((tap:de bar)))
|
||||
==
|
||||
::
|
||||
++ test-cons-tree
|
||||
=/ foo
|
||||
(cons:de foo 1)
|
||||
~
|
||||
::
|
||||
++ test-cons-list
|
||||
=/ big-list
|
||||
[1 big-list]
|
||||
~
|
||||
::
|
||||
++ test-rear-tree
|
||||
=/ big big
|
||||
=/ res (peek-right:de big)
|
||||
~
|
||||
::
|
||||
++ test-rear-list
|
||||
=/ last (rear big-list)
|
||||
~
|
||||
::
|
||||
++ test-right
|
||||
^- tang
|
||||
=/ foo
|
||||
~> %bout.[1 %snoc]
|
||||
(snoc:de foo 9)
|
||||
=. foo
|
||||
(apr:de foo 10 11 12 13 14 15 ~)
|
||||
%- zing
|
||||
:- (expect-eq !>((tap:de foo)) !>((gulf 1 15)))
|
||||
=^ val=(unit @) foo
|
||||
(pop-right:de foo)
|
||||
:~ (expect-eq !>((need val)) !>(15))
|
||||
(expect-eq !>((gulf 1 14)) !>((tap:de foo)))
|
||||
==
|
||||
++ test-queue
|
||||
^- tang
|
||||
=/ foo foo
|
||||
=. foo
|
||||
(apr:de foo 9 10 11 12 13 14 15 ~)
|
||||
=/ expected (gulf 1 15)
|
||||
%- zing
|
||||
|- ^- (list tang)
|
||||
=^ val=(unit @) foo
|
||||
(pop-left:de foo)
|
||||
?~ val
|
||||
(expect-eq !>(~) !>(expected))^~
|
||||
~& got/u.val
|
||||
?~ expected
|
||||
~[leaf/"queue mismatch"]
|
||||
:- (expect-eq !>(i.expected) !>(u.val))
|
||||
$(expected t.expected)
|
||||
--
|
||||
@ -1,16 +1,17 @@
|
||||
/+ *test
|
||||
/= ames /sys/vane/ames
|
||||
/= jael /sys/vane/jael
|
||||
/* dojo %hoon /app/dojo/hoon
|
||||
:: construct some test fixtures
|
||||
::
|
||||
=/ nec (ames ~nec)
|
||||
=/ bud (ames ~bud)
|
||||
=/ marbud (ames ~marbud)
|
||||
=/ nec ^$:((ames ~nec))
|
||||
=/ bud ^$:((ames ~bud))
|
||||
=/ marbud ^$:((ames ~marbud))
|
||||
::
|
||||
=/ our-comet ~bosrym-podwyl-magnes-dacrys--pander-hablep-masrym-marbud
|
||||
=/ our-comet2 ~togdut-rosled-fadlev-siddys--botmun-wictev-sapfus-marbud
|
||||
=/ comet (ames our-comet)
|
||||
=/ comet2 (ames our-comet2)
|
||||
=/ comet ^$:((ames our-comet))
|
||||
=/ comet2 ^$:((ames our-comet2))
|
||||
::
|
||||
=. now.nec ~1111.1.1
|
||||
=. eny.nec 0xdead.beef
|
||||
@ -183,6 +184,41 @@
|
||||
%+ snag index
|
||||
(skim moves is-move-send)
|
||||
::
|
||||
++ n-frags
|
||||
|= n=@
|
||||
^- @ux
|
||||
:: 6 chosen randomly to get some trailing zeros
|
||||
::
|
||||
%+ rsh 10
|
||||
%+ rep 13
|
||||
%+ turn (gulf 1 n)
|
||||
|=(x=@ (fil 3 1.024 (dis 0xff x)))
|
||||
::
|
||||
++ scry
|
||||
|= [vane=_nec car=term bem=beam]
|
||||
=/ =roof
|
||||
:: custom scry handler for +test-fine-response.
|
||||
:: could be refined further...
|
||||
::
|
||||
|= [lyc=gang vis=view bem=beam]
|
||||
^- (unit (unit cage))
|
||||
?+ vis ~
|
||||
%cp
|
||||
=/ black=dict:clay
|
||||
%*(. *dict:clay mod.rul %black)
|
||||
``noun+!>([black black])
|
||||
::
|
||||
%cz
|
||||
?+ -.r.bem !!
|
||||
%ud ``noun+!>((n-frags p.r.bem))
|
||||
==
|
||||
::
|
||||
%cx
|
||||
``hoon+!>(dojo)
|
||||
==
|
||||
=/ vane-core (vane(rof roof))
|
||||
(scry:vane-core ~ car bem)
|
||||
::
|
||||
++ call
|
||||
|= [vane=_nec =duct =task:ames]
|
||||
^- [moves=(list move:ames) _nec]
|
||||
@ -204,36 +240,38 @@
|
||||
|%
|
||||
++ test-packet-encoding ^- tang
|
||||
::
|
||||
=/ =packet:ames
|
||||
=/ =shot:ames
|
||||
:* [sndr=~nec rcvr=~bud]
|
||||
req=& sam=&
|
||||
sndr-tick=0b10
|
||||
rcvr-tick=0b11
|
||||
origin=~
|
||||
content=0xdead.beef
|
||||
==
|
||||
::
|
||||
=/ encoded (encode-packet:ames packet)
|
||||
=/ decoded (decode-packet:ames encoded)
|
||||
=/ encoded (etch-shot:ames shot)
|
||||
=/ decoded (sift-shot:ames encoded)
|
||||
::
|
||||
%+ expect-eq
|
||||
!> packet
|
||||
!> shot
|
||||
!> decoded
|
||||
::
|
||||
++ test-origin-encoding ^- tang
|
||||
::
|
||||
=/ =packet:ames
|
||||
=/ =shot:ames
|
||||
:* [sndr=~nec rcvr=~bud]
|
||||
req=& sam=&
|
||||
sndr-tick=0b10
|
||||
rcvr-tick=0b11
|
||||
origin=`0xbeef.cafe.beef
|
||||
content=0xdead.beef
|
||||
==
|
||||
::
|
||||
=/ encoded (encode-packet:ames packet)
|
||||
=/ decoded (decode-packet:ames encoded)
|
||||
=/ encoded (etch-shot:ames shot)
|
||||
=/ decoded (sift-shot:ames encoded)
|
||||
::
|
||||
%+ expect-eq
|
||||
!> packet
|
||||
!> shot
|
||||
!> decoded
|
||||
::
|
||||
++ test-shut-packet-encoding ^- tang
|
||||
@ -242,10 +280,10 @@
|
||||
:+ bone=17 message-num=18
|
||||
[%& num-fragments=1 fragment-num=1 fragment=`@`0xdead.beef]
|
||||
::
|
||||
=/ =packet:ames
|
||||
(encode-shut-packet:ames shut-packet nec-sym ~marnec ~marbud-marbud 3 17)
|
||||
=/ =shot:ames
|
||||
(etch-shut-packet:ames shut-packet nec-sym ~marnec ~marbud-marbud 3 17)
|
||||
::
|
||||
=/ decoded (decode-shut-packet:ames packet nec-sym 3 17)
|
||||
=/ decoded (sift-shut-packet:ames shot nec-sym 3 17)
|
||||
::
|
||||
%+ expect-eq
|
||||
!> shut-packet
|
||||
@ -277,8 +315,8 @@
|
||||
[%& num-fragments=1 fragment-num=0 (jam plea)]
|
||||
==
|
||||
::
|
||||
=/ =packet:ames
|
||||
%: encode-shut-packet:ames
|
||||
=/ =shot:ames
|
||||
%: etch-shut-packet:ames
|
||||
shut-packet
|
||||
nec-sym
|
||||
~bus
|
||||
@ -287,7 +325,7 @@
|
||||
rcvr-life=3
|
||||
==
|
||||
::
|
||||
=/ =blob:ames (encode-packet:ames packet)
|
||||
=/ =blob:ames (etch-shot:ames shot)
|
||||
=^ moves1 bud (call bud ~[//unix] %hear lane-foo blob)
|
||||
=^ moves2 bud
|
||||
=/ =point:ames
|
||||
@ -460,6 +498,91 @@
|
||||
!> [~[/g/talk] %give %done `error]
|
||||
!> (snag 0 `(list move:ames)`moves5)
|
||||
::
|
||||
++ test-fine-request
|
||||
^- tang
|
||||
=/ want=path /c/z/1/kids/sys
|
||||
=^ moves1 nec (call nec ~[/g/talk] %keen ~bud want)
|
||||
=/ req=hoot:ames
|
||||
%+ snag 0
|
||||
%+ murn ;;((list move:ames) moves1)
|
||||
|= =move:ames
|
||||
^- (unit hoot:ames)
|
||||
?. ?=(%give -.card.move) ~
|
||||
?. ?=(%send -.p.card.move) ~
|
||||
`;;(@uxhoot blob.p.card.move)
|
||||
=/ =shot:ames (sift-shot:ames `@ux`req)
|
||||
?< sam.shot
|
||||
?> req.shot
|
||||
=/ =keen:ames
|
||||
(sift-keen:ames `@ux`content.shot)
|
||||
~& keen
|
||||
(expect-eq !>(1) !>(1))
|
||||
::
|
||||
++ test-fine-hunk
|
||||
^- tang
|
||||
%- zing
|
||||
%+ turn (gulf 1 10)
|
||||
|= siz=@
|
||||
=/ want=path /~bud/0/1/c/z/(scot %ud siz)/kids/sys
|
||||
::
|
||||
=/ =beam [[~bud %$ da+now:bud] (welp /fine/hunk/1/16.384 want)]
|
||||
=/ [=mark =vase] (need (need (scry bud %x beam)))
|
||||
=+ !<(song=(list @uxmeow) vase)
|
||||
%+ expect-eq
|
||||
!>(siz)
|
||||
!>((lent song))
|
||||
::
|
||||
++ test-fine-response
|
||||
^- tang
|
||||
::%- zing
|
||||
::%+ turn (gulf 1 50)
|
||||
::|= siz=@
|
||||
::=/ want=path /~bud/0/1/c/z/(scot %ud siz)/kids/sys
|
||||
=/ want=path /~bud/0/1/c/x/1/kids/app/dojo/hoon
|
||||
=/ dit (jam %hoon dojo)
|
||||
=/ exp (cat 9 (fil 3 64 0xff) dit)
|
||||
=/ siz=@ud (met 13 exp)
|
||||
^- tang
|
||||
::
|
||||
=/ =beam [[~bud %$ da+now:bud] (welp /fine/hunk/1/16.384 want)]
|
||||
=/ [=mark =vase] (need (need (scry bud %x beam)))
|
||||
=+ !<(song=(list @uxmeow) vase)
|
||||
=/ paz=(list have:ames)
|
||||
%+ spun song
|
||||
|= [blob=@ux num=_1]
|
||||
^- [have:ames _num]
|
||||
:_ +(num)
|
||||
=/ =meow:ames (sift-meow:ames blob)
|
||||
[num meow]
|
||||
::
|
||||
=/ num-frag=@ud (lent paz)
|
||||
~& num-frag=num-frag
|
||||
=/ =roar:ames (sift-roar:ames num-frag (flop paz))
|
||||
%+ welp
|
||||
=/ dat
|
||||
?> ?=(^ dat.roar)
|
||||
;;(@ux q.dat.roar)
|
||||
(expect-eq !>(`@`dat) !>(`@`dojo))
|
||||
=/ event-core
|
||||
~! nec
|
||||
=/ foo [*@da *@ rof.nec]
|
||||
(per-event:(nec foo) [*@da *@ rof.nec] *duct ames-state.nec)
|
||||
%+ welp
|
||||
^- tang
|
||||
%- zing
|
||||
%+ turn paz
|
||||
|= [fra=@ud sig=@ siz=@ud byts]
|
||||
%+ expect-eq !>(%.y)
|
||||
!>
|
||||
%- veri-fra:keys:fine:event-core
|
||||
[~bud life.ames-state.bud want fra dat sig]
|
||||
~& %verifying-sig
|
||||
%+ expect-eq
|
||||
!>(&)
|
||||
!>
|
||||
%- meri:keys:fine:event-core
|
||||
[~bud life.ames-state.bud want roar]
|
||||
::
|
||||
++ test-old-ames-wire ^- tang
|
||||
=^ moves0 bud (call bud ~[/g/hood] %spew [%odd]~)
|
||||
=^ moves1 nec (call nec ~[/g/talk] %plea ~bud %g /talk [%get %post])
|
||||
|
||||
16
tests/sys/zuse/balk.hoon
Normal file
16
tests/sys/zuse/balk.hoon
Normal file
@ -0,0 +1,16 @@
|
||||
/+ *test
|
||||
|%
|
||||
++ hastuc-dibtux [~hastuc-dibtux 15 22]
|
||||
++ clay-x [%c %x %ud 3]
|
||||
++ test-en-path
|
||||
%+ expect-eq
|
||||
!>(`path`/cx/~hastuc-dibtux/base/3/sys/hoon/hoon)
|
||||
!> %- en-path:balk
|
||||
[hastuc-dibtux clay-x /base/sys/hoon/hoon]
|
||||
++ test-de-path
|
||||
=/ bal=balk
|
||||
(de-path:balk 15 22 /cx/~hastuc-dibtux/base/3/sys/hoon/hoon)
|
||||
%+ expect-eq !>(bal)
|
||||
!> ^- balk
|
||||
[hastuc-dibtux clay-x /base/sys/hoon/hoon]
|
||||
--
|
||||
Loading…
Reference in New Issue
Block a user