mirror of
https://github.com/urbit/shrub.git
synced 2024-12-25 21:12:56 +03:00
Merge pull request #6542 from urbit/wicrum/wan-mop
lull,ames: use `mop` instead of `pha` in `.wan.keens`
This commit is contained in:
Ted Blackman
GitHub
commit
51e85291c1
@ -831,7 +831,9 @@
|
|||||||
|= keen-state
|
|= keen-state
|
||||||
|^ ^- json
|
|^ ^- json
|
||||||
%- pairs
|
%- pairs
|
||||||
:~ 'wan'^a/(turn (tap:(deq want) wan) wants)
|
:~ :- %wan
|
||||||
|
a/(turn (tap:((on @ud want) lte) wan) |=([@ a=_+6:wants] (wants a)))
|
||||||
|
::
|
||||||
'nex'^a/(turn nex wants)
|
'nex'^a/(turn nex wants)
|
||||||
::
|
::
|
||||||
:- 'hav'
|
:- 'hav'
|
||||||
|
|||||||
@ -36,27 +36,6 @@
|
|||||||
max-size=_2.048
|
max-size=_2.048
|
||||||
depth=_1
|
depth=_1
|
||||||
==
|
==
|
||||||
::
|
|
||||||
:: +afx: polymorphic node type for finger trees
|
|
||||||
::
|
|
||||||
++ 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: finger tree
|
|
||||||
::
|
|
||||||
++ pha
|
|
||||||
|$ [val]
|
|
||||||
$~ [%nul ~]
|
|
||||||
$% [%nul ~]
|
|
||||||
[%one p=val]
|
|
||||||
[%big p=(afx val) q=(pha val) r=(afx val)]
|
|
||||||
==
|
|
||||||
::
|
|
||||||
:: +mop: constructs and validates ordered ordered map based on key,
|
:: +mop: constructs and validates ordered ordered map based on key,
|
||||||
:: val, and comparator gate
|
:: val, and comparator gate
|
||||||
::
|
::
|
||||||
@ -461,6 +440,13 @@
|
|||||||
?: (compare key.n.a key.n.b)
|
?: (compare key.n.a key.n.b)
|
||||||
$(l.b $(b l.b, r.a ~), a r.a)
|
$(l.b $(b l.b, r.a ~), a r.a)
|
||||||
$(r.b $(b r.b, l.a ~), a l.a)
|
$(r.b $(b r.b, l.a ~), a l.a)
|
||||||
|
:: +wyt: measure size
|
||||||
|
::
|
||||||
|
++ wyt
|
||||||
|
~/ %wyt
|
||||||
|
|= a=(tree item)
|
||||||
|
^- @ud
|
||||||
|
?~(a 0 +((add $(a l.a) $(a r.a))))
|
||||||
--
|
--
|
||||||
::
|
::
|
||||||
+$ deco ?(~ %bl %br %un) :: text decoration
|
+$ deco ?(~ %bl %br %un) :: text decoration
|
||||||
@ -1029,9 +1015,9 @@
|
|||||||
keens=(map path keen-state)
|
keens=(map path keen-state)
|
||||||
==
|
==
|
||||||
+$ keen-state
|
+$ keen-state
|
||||||
$: wan=(pha want) :: request packets, sent
|
$: wan=((mop @ud want) lte) :: request packets, sent
|
||||||
nex=(list want) :: request packets, unsent
|
nex=(list want) :: request packets, unsent
|
||||||
hav=(list have) :: response packets, backward
|
hav=(list have) :: response packets, backward
|
||||||
num-fragments=@ud
|
num-fragments=@ud
|
||||||
num-received=@ud
|
num-received=@ud
|
||||||
next-wake=(unit @da)
|
next-wake=(unit @da)
|
||||||
@ -1182,7 +1168,6 @@
|
|||||||
?: (gth message-num.a message-num.b)
|
?: (gth message-num.a message-num.b)
|
||||||
%.n
|
%.n
|
||||||
(lte fragment-num.a fragment-num.b)
|
(lte fragment-num.a fragment-num.b)
|
||||||
::
|
|
||||||
:: $pump-metrics: congestion control state for a |packet-pump
|
:: $pump-metrics: congestion control state for a |packet-pump
|
||||||
::
|
::
|
||||||
:: This is an Ames adaptation of TCP's Reno congestion control
|
:: This is an Ames adaptation of TCP's Reno congestion control
|
||||||
|
|||||||
@ -777,6 +777,301 @@
|
|||||||
++ com |~(a=pass ^?(..nu))
|
++ com |~(a=pass ^?(..nu))
|
||||||
--
|
--
|
||||||
--
|
--
|
||||||
|
::
|
||||||
|
+$ ames-state-13
|
||||||
|
$: peers=(map ship ship-state-13)
|
||||||
|
=unix=duct
|
||||||
|
=life
|
||||||
|
=rift
|
||||||
|
crypto-core=acru:ames
|
||||||
|
=bug
|
||||||
|
snub=[form=?(%allow %deny) ships=(set ship)]
|
||||||
|
cong=[msg=@ud mem=@ud]
|
||||||
|
==
|
||||||
|
::
|
||||||
|
+$ ship-state-13
|
||||||
|
$% [%alien alien-agenda]
|
||||||
|
[%known peer-state-13]
|
||||||
|
==
|
||||||
|
::
|
||||||
|
+$ peer-state-13
|
||||||
|
$: $: =symmetric-key
|
||||||
|
=life
|
||||||
|
=rift
|
||||||
|
=public-key
|
||||||
|
sponsor=ship
|
||||||
|
==
|
||||||
|
route=(unit [direct=? =lane])
|
||||||
|
=qos
|
||||||
|
=ossuary
|
||||||
|
snd=(map bone message-pump-state)
|
||||||
|
rcv=(map bone message-sink-state)
|
||||||
|
nax=(set [=bone =message-num])
|
||||||
|
heeds=(set duct)
|
||||||
|
closing=(set bone)
|
||||||
|
corked=(set bone)
|
||||||
|
keens=(map path keen-state-13)
|
||||||
|
==
|
||||||
|
::
|
||||||
|
++ keen-state-13
|
||||||
|
=< $: wan=(pha want) :: request packts, sent
|
||||||
|
nex=(list want) :: request packets, unsent
|
||||||
|
hav=(list have) :: response packets, backward
|
||||||
|
num-fragments=@ud
|
||||||
|
num-received=@ud
|
||||||
|
next-wake=(unit @da)
|
||||||
|
listeners=(set duct)
|
||||||
|
metrics=pump-metrics
|
||||||
|
==
|
||||||
|
|%
|
||||||
|
:: +afx: polymorphic node type for finger trees
|
||||||
|
::
|
||||||
|
++ 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: finger tree
|
||||||
|
::
|
||||||
|
:: DO NOT USE THIS
|
||||||
|
:: It's wrong and only kept around for state migration purposes.
|
||||||
|
::
|
||||||
|
++ pha
|
||||||
|
|$ [val]
|
||||||
|
$~ [%nul ~]
|
||||||
|
$% [%nul ~]
|
||||||
|
[%one p=val]
|
||||||
|
[%big p=(afx val) q=(pha val) r=(afx val)]
|
||||||
|
==
|
||||||
|
:: +deq: deque
|
||||||
|
::
|
||||||
|
:: DO NOT USE THIS
|
||||||
|
:: It's wrong and only kept around for state migration purposes.
|
||||||
|
::
|
||||||
|
++ 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)
|
||||||
|
:: :: +| %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
|
||||||
|
==
|
||||||
|
--
|
||||||
|
--
|
||||||
|
--
|
||||||
:: $bug: debug printing configuration
|
:: $bug: debug printing configuration
|
||||||
::
|
::
|
||||||
:: veb: verbosity toggles
|
:: veb: verbosity toggles
|
||||||
@ -909,7 +1204,8 @@
|
|||||||
[%10 ames-state-10]
|
[%10 ames-state-10]
|
||||||
[%11 ames-state-11]
|
[%11 ames-state-11]
|
||||||
[%12 ames-state-12]
|
[%12 ames-state-12]
|
||||||
[%13 ^ames-state]
|
[%13 ames-state-13]
|
||||||
|
[%14 ^ames-state]
|
||||||
==
|
==
|
||||||
::
|
::
|
||||||
|= [now=@da eny=@ rof=roof]
|
|= [now=@da eny=@ rof=roof]
|
||||||
@ -1032,7 +1328,7 @@
|
|||||||
:: lifecycle arms; mostly pass-throughs to the contained adult ames
|
:: lifecycle arms; mostly pass-throughs to the contained adult ames
|
||||||
::
|
::
|
||||||
++ scry scry:adult-core
|
++ scry scry:adult-core
|
||||||
++ stay [%13 %larva queued-events ames-state.adult-gate]
|
++ stay [%14 %larva queued-events ames-state.adult-gate]
|
||||||
++ load
|
++ load
|
||||||
|= $= old
|
|= $= old
|
||||||
$% $: %4
|
$% $: %4
|
||||||
@ -1099,6 +1395,13 @@
|
|||||||
[%adult state=ames-state-12]
|
[%adult state=ames-state-12]
|
||||||
== ==
|
== ==
|
||||||
$: %13
|
$: %13
|
||||||
|
$% $: %larva
|
||||||
|
events=(qeu queued-event)
|
||||||
|
state=ames-state-13
|
||||||
|
==
|
||||||
|
[%adult state=ames-state-13]
|
||||||
|
== ==
|
||||||
|
$: %14
|
||||||
$% $: %larva
|
$% $: %larva
|
||||||
events=(qeu queued-event)
|
events=(qeu queued-event)
|
||||||
state=_ames-state.adult-gate
|
state=_ames-state.adult-gate
|
||||||
@ -1113,7 +1416,7 @@
|
|||||||
=. state.old (state-4-to-5:load:adult-core state.old)
|
=. state.old (state-4-to-5:load:adult-core state.old)
|
||||||
$(-.old %5)
|
$(-.old %5)
|
||||||
::
|
::
|
||||||
[%5 %adult *]
|
[%5 %adult *]
|
||||||
=. cached-state `[%5 state.old]
|
=. cached-state `[%5 state.old]
|
||||||
~> %slog.0^leaf/"ames: larva reload"
|
~> %slog.0^leaf/"ames: larva reload"
|
||||||
larval-gate
|
larval-gate
|
||||||
@ -1201,14 +1504,24 @@
|
|||||||
=. queued-events events.old
|
=. queued-events events.old
|
||||||
larval-gate
|
larval-gate
|
||||||
::
|
::
|
||||||
[%13 %adult *] (load:adult-core %13 state.old)
|
[%13 %adult *]
|
||||||
|
=. cached-state `[%13 state.old]
|
||||||
|
~> %slog.0^leaf/"ames: larva reload"
|
||||||
|
larval-gate
|
||||||
::
|
::
|
||||||
[%13 %larva *]
|
[%13 %larva *]
|
||||||
~> %slog.1^leaf/"ames: larva: load"
|
~> %slog.1^leaf/"ames: larva: load"
|
||||||
|
=. cached-state `[%13 state.old]
|
||||||
=. queued-events events.old
|
=. queued-events events.old
|
||||||
=. adult-gate (load:adult-core %13 state.old)
|
|
||||||
larval-gate
|
larval-gate
|
||||||
::
|
::
|
||||||
|
[%14 %adult *] (load:adult-core %14 state.old)
|
||||||
|
::
|
||||||
|
[%14 %larva *]
|
||||||
|
~> %slog.1^leaf/"ames: larva: load"
|
||||||
|
=. queued-events events.old
|
||||||
|
=. adult-gate (load:adult-core %14 state.old)
|
||||||
|
larval-gate
|
||||||
==
|
==
|
||||||
::
|
::
|
||||||
++ event-11-to-12
|
++ event-11-to-12
|
||||||
@ -1250,7 +1563,9 @@
|
|||||||
12+(state-11-to-12:load:adult-core +.u.cached-state)
|
12+(state-11-to-12:load:adult-core +.u.cached-state)
|
||||||
=? u.cached-state ?=(%12 -.u.cached-state)
|
=? u.cached-state ?=(%12 -.u.cached-state)
|
||||||
13+(state-12-to-13:load:adult-core +.u.cached-state)
|
13+(state-12-to-13:load:adult-core +.u.cached-state)
|
||||||
?> ?=(%13 -.u.cached-state)
|
=? u.cached-state ?=(%13 -.u.cached-state)
|
||||||
|
14+(state-13-to-14:load:adult-core +.u.cached-state)
|
||||||
|
?> ?=(%14 -.u.cached-state)
|
||||||
=. ames-state.adult-gate +.u.cached-state
|
=. ames-state.adult-gate +.u.cached-state
|
||||||
[moz larval-core(cached-state ~)]
|
[moz larval-core(cached-state ~)]
|
||||||
--
|
--
|
||||||
@ -3814,8 +4129,8 @@
|
|||||||
(trace %fine verb her ships.bug.ames-state print)
|
(trace %fine verb her ships.bug.ames-state print)
|
||||||
::
|
::
|
||||||
++ fi-emit |=(move fine(event-core (emit +<)))
|
++ fi-emit |=(move fine(event-core (emit +<)))
|
||||||
++ fi-deq (deq want)
|
++ fi-mop ((on @ud want) lte)
|
||||||
++ fi-gauge (ga metrics.keen (wyt:fi-deq wan.keen))
|
++ fi-gauge (ga metrics.keen (wyt:fi-mop wan.keen))
|
||||||
++ fi-wait |=(tim=@da (fi-pass-timer %b %wait tim))
|
++ fi-wait |=(tim=@da (fi-pass-timer %b %wait tim))
|
||||||
++ fi-rest |=(tim=@da (fi-pass-timer %b %rest tim))
|
++ fi-rest |=(tim=@da (fi-pass-timer %b %rest tim))
|
||||||
::
|
::
|
||||||
@ -3839,7 +4154,7 @@
|
|||||||
=/ fra=@ 1
|
=/ fra=@ 1
|
||||||
=/ req=hoot (fi-etch-wail fra)
|
=/ req=hoot (fi-etch-wail fra)
|
||||||
=/ =want [fra req last=now tries=1 skips=0]
|
=/ =want [fra req last=now tries=1 skips=0]
|
||||||
=. wan.keen (cons:fi-deq *(pha ^want) want)
|
=. wan.keen (put:fi-mop ~ [fra .]:want)
|
||||||
(fi-send `@ux`req)
|
(fi-send `@ux`req)
|
||||||
::
|
::
|
||||||
++ fi-rcv
|
++ fi-rcv
|
||||||
@ -3909,12 +4224,12 @@
|
|||||||
=| marked=(list want)
|
=| marked=(list want)
|
||||||
|= fra=@ud
|
|= fra=@ud
|
||||||
^- [? _fine]
|
^- [? _fine]
|
||||||
=; [[found=? cor=_fine] wan=(pha want)]
|
=; [[found=? cor=_fine] wan=_wan.keen]
|
||||||
:- found
|
:- found
|
||||||
?.(found fine cor(wan.keen wan))
|
?.(found fine cor(wan.keen wan))
|
||||||
%^ (dip-left:fi-deq ,[found=? cor=_fine]) wan.keen
|
%^ (dip:fi-mop ,[found=? cor=_fine]) wan.keen
|
||||||
[| fine]
|
[| fine]
|
||||||
|= [[found=? cor=_fine] =want]
|
|= [[found=? cor=_fine] @ud =want]
|
||||||
^- [(unit _want) stop=? [found=? cor=_fine]]
|
^- [(unit _want) stop=? [found=? cor=_fine]]
|
||||||
=. fine cor
|
=. fine cor
|
||||||
?: =(fra fra.want)
|
?: =(fra fra.want)
|
||||||
@ -3965,7 +4280,7 @@
|
|||||||
=^ =want nex.keen nex.keen
|
=^ =want nex.keen nex.keen
|
||||||
=. last-sent.want now
|
=. last-sent.want now
|
||||||
=. tries.want +(tries.want)
|
=. tries.want +(tries.want)
|
||||||
=. wan.keen (snoc:fi-deq wan.keen want)
|
=. wan.keen (put:fi-mop wan.keen [fra .]:want)
|
||||||
=. fine (fi-send `@ux`hoot.want)
|
=. fine (fi-send `@ux`hoot.want)
|
||||||
$(inx +(inx))
|
$(inx +(inx))
|
||||||
::
|
::
|
||||||
@ -3981,11 +4296,11 @@
|
|||||||
::
|
::
|
||||||
++ fi-fast-retransmit
|
++ fi-fast-retransmit
|
||||||
|= fra=@ud
|
|= fra=@ud
|
||||||
=; [cor=_fine wants=(pha want)]
|
=; [cor=_fine wants=_wan.keen]
|
||||||
cor(wan.keen wants)
|
cor(wan.keen wants)
|
||||||
%^ (dip-left:fi-deq ,cor=_fine) wan.keen
|
%^ (dip:fi-mop ,cor=_fine) wan.keen
|
||||||
fine
|
fine
|
||||||
|= [cor=_fine =want]
|
|= [cor=_fine @ud =want]
|
||||||
^- [(unit ^want) stop=? cor=_fine]
|
^- [(unit ^want) stop=? cor=_fine]
|
||||||
?. (lte fra.want fra)
|
?. (lte fra.want fra)
|
||||||
[`want & cor]
|
[`want & cor]
|
||||||
@ -4003,9 +4318,9 @@
|
|||||||
++ fi-set-wake
|
++ fi-set-wake
|
||||||
^+ fine
|
^+ fine
|
||||||
=/ next-wake=(unit @da)
|
=/ next-wake=(unit @da)
|
||||||
?~ want=(peek-left:fi-deq wan.keen)
|
?~ want=(pry:fi-mop wan.keen)
|
||||||
~
|
~
|
||||||
`(next-expiry:fi-gauge +>:u.want)
|
`(next-expiry:fi-gauge +>:val.u.want)
|
||||||
?: =(next-wake next-wake.keen)
|
?: =(next-wake next-wake.keen)
|
||||||
fine
|
fine
|
||||||
=? fine !=(~ next-wake.keen)
|
=? fine !=(~ next-wake.keen)
|
||||||
@ -4027,13 +4342,14 @@
|
|||||||
=. peer-state (update-peer-route her peer-state)
|
=. peer-state (update-peer-route her peer-state)
|
||||||
=. metrics.keen on-timeout:fi-gauge
|
=. metrics.keen on-timeout:fi-gauge
|
||||||
=^ want=(unit want) wan.keen
|
=^ want=(unit want) wan.keen
|
||||||
(pop-left:fi-deq wan.keen)
|
?~ res=(pry:fi-mop wan.keen) `wan.keen
|
||||||
|
(del:fi-mop wan.keen key.u.res)
|
||||||
~| %took-wake-for-empty-want
|
~| %took-wake-for-empty-want
|
||||||
?> ?=(^ want)
|
?> ?=(^ want)
|
||||||
=: tries.u.want +(tries.u.want)
|
=: tries.u.want +(tries.u.want)
|
||||||
last-sent.u.want now
|
last-sent.u.want now
|
||||||
==
|
==
|
||||||
=. wan.keen (cons:fi-deq wan.keen u.want)
|
=. wan.keen (put:fi-mop wan.keen [fra .]:u.want)
|
||||||
(fi-send `@ux`hoot.u.want)
|
(fi-send `@ux`hoot.u.want)
|
||||||
--
|
--
|
||||||
:: +ga: constructor for |pump-gauge congestion control core
|
:: +ga: constructor for |pump-gauge congestion control core
|
||||||
@ -4252,15 +4568,15 @@
|
|||||||
[moves ames-gate]
|
[moves ames-gate]
|
||||||
:: +stay: extract state before reload
|
:: +stay: extract state before reload
|
||||||
::
|
::
|
||||||
++ stay [%13 %adult ames-state]
|
++ stay [%14 %adult ames-state]
|
||||||
:: +load: load in old state after reload
|
:: +load: load in old state after reload
|
||||||
::
|
::
|
||||||
++ load
|
++ load
|
||||||
=< |= $= old-state
|
=< |= $= old-state
|
||||||
$% [%13 ^ames-state]
|
$% [%14 ^ames-state]
|
||||||
==
|
==
|
||||||
^+ ames-gate
|
^+ ames-gate
|
||||||
?> ?=(%13 -.old-state)
|
?> ?=(%14 -.old-state)
|
||||||
ames-gate(ames-state +.old-state)
|
ames-gate(ames-state +.old-state)
|
||||||
:: all state transitions are called from larval ames
|
:: all state transitions are called from larval ames
|
||||||
::
|
::
|
||||||
@ -4379,7 +4695,7 @@
|
|||||||
::
|
::
|
||||||
++ state-12-to-13
|
++ state-12-to-13
|
||||||
|= old=ames-state-12
|
|= old=ames-state-12
|
||||||
^- ^ames-state
|
^- ames-state-13
|
||||||
=+ !< =rift
|
=+ !< =rift
|
||||||
q:(need (need (rof ~ %j `beam`[[our %rift %da now] /(scot %p our)])))
|
q:(need (need (rof ~ %j `beam`[[our %rift %da now] /(scot %p our)])))
|
||||||
=+ pk=sec:ex:crypto-core.old
|
=+ pk=sec:ex:crypto-core.old
|
||||||
@ -4397,10 +4713,27 @@
|
|||||||
::
|
::
|
||||||
++ ship-state-12-to-13
|
++ ship-state-12-to-13
|
||||||
|= old=ship-state-12
|
|= old=ship-state-12
|
||||||
^- ship-state
|
^- ship-state-13
|
||||||
?: ?=(%alien -.old)
|
?: ?=(%alien -.old)
|
||||||
old(heeds [heeds.old ~])
|
old(heeds [heeds.old ~])
|
||||||
old(corked [corked.old ~])
|
old(corked [corked.old ~])
|
||||||
|
::
|
||||||
|
++ state-13-to-14
|
||||||
|
|= old=ames-state-13
|
||||||
|
^- ^ames-state
|
||||||
|
=- old(peers -)
|
||||||
|
%- ~(run by peers.old)
|
||||||
|
|= old=ship-state-13
|
||||||
|
?: ?=(%alien -.old) old
|
||||||
|
old(keens (~(run by keens.old) keen-state-13-to-14))
|
||||||
|
::
|
||||||
|
++ keen-state-13-to-14
|
||||||
|
|= old=keen-state-13
|
||||||
|
^- keen-state
|
||||||
|
=- old(wan -)
|
||||||
|
%+ gas:((on @ud want) lte) ~
|
||||||
|
%+ turn (tap:(deq:keen-state-13 want) wan.old)
|
||||||
|
|= =want [fra .]:want
|
||||||
--
|
--
|
||||||
:: +scry: dereference namespace
|
:: +scry: dereference namespace
|
||||||
::
|
::
|
||||||
|
|||||||
@ -336,7 +336,7 @@
|
|||||||
=. pos.zim.pki
|
=. pos.zim.pki
|
||||||
%+ ~(put by pos.zim.pki)
|
%+ ~(put by pos.zim.pki)
|
||||||
our
|
our
|
||||||
[rift=1 life=1 (my [`@ud`1 [`life`1 pub:ex:cub]] ~) `(^sein:title our)]
|
[rift=0 life=1 (my [`@ud`1 [`life`1 pub:ex:cub]] ~) `(^sein:title our)]
|
||||||
:: our private key
|
:: our private key
|
||||||
::
|
::
|
||||||
:: Private key updates are disallowed for fake ships,
|
:: Private key updates are disallowed for fake ships,
|
||||||
@ -825,7 +825,7 @@
|
|||||||
%+ turn passes
|
%+ turn passes
|
||||||
|= [who=ship =pass]
|
|= [who=ship =pass]
|
||||||
^- [who=ship =point]
|
^- [who=ship =point]
|
||||||
[who [rift=1 life=1 (my [1 1 pass] ~) `(^sein:title who)]]
|
[who [rift=0 life=1 (my [1 1 pass] ~) `(^sein:title who)]]
|
||||||
=. moz [[hen %give %public-keys %full (my points)] moz]
|
=. moz [[hen %give %public-keys %full (my points)] moz]
|
||||||
..feel
|
..feel
|
||||||
--
|
--
|
||||||
@ -1140,10 +1140,10 @@
|
|||||||
[~ ~]
|
[~ ~]
|
||||||
=/ who (slaw %p i.tyl)
|
=/ who (slaw %p i.tyl)
|
||||||
?~ who [~ ~]
|
?~ who [~ ~]
|
||||||
:: fake ships always have rift=1
|
:: fake ships always have rift=0
|
||||||
::
|
::
|
||||||
?: fak.own.pki.lex
|
?: fak.own.pki.lex
|
||||||
``[%atom !>(1)]
|
``[%atom !>(0)]
|
||||||
=/ pos (~(get by pos.zim.pki.lex) u.who)
|
=/ pos (~(get by pos.zim.pki.lex) u.who)
|
||||||
?~ pos ~
|
?~ pos ~
|
||||||
``[%atom !>(rift.u.pos)]
|
``[%atom !>(rift.u.pos)]
|
||||||
@ -1154,10 +1154,10 @@
|
|||||||
[~ ~]
|
[~ ~]
|
||||||
=/ who (slaw %p i.tyl)
|
=/ who (slaw %p i.tyl)
|
||||||
?~ who [~ ~]
|
?~ who [~ ~]
|
||||||
:: fake ships always have rift=1
|
:: fake ships always have rift=0
|
||||||
::
|
::
|
||||||
?: fak.own.pki.lex
|
?: fak.own.pki.lex
|
||||||
``[%noun !>((some 1))]
|
``[%noun !>((some 0))]
|
||||||
=/ pos (~(get by pos.zim.pki.lex) u.who)
|
=/ pos (~(get by pos.zim.pki.lex) u.who)
|
||||||
?~ pos ``[%noun !>(~)]
|
?~ pos ``[%noun !>(~)]
|
||||||
``[%noun !>((some rift.u.pos))]
|
``[%noun !>((some rift.u.pos))]
|
||||||
|
|||||||
@ -5593,288 +5593,6 @@
|
|||||||
$(pops [oldest pops])
|
$(pops [oldest pops])
|
||||||
--
|
--
|
||||||
--
|
--
|
||||||
::
|
|
||||||
++ deq
|
|
||||||
|* val=mold
|
|
||||||
|%
|
|
||||||
::
|
|
||||||
:: +| %utilities
|
|
||||||
::
|
|
||||||
++ make-afx
|
|
||||||
|= ls=(list val)
|
|
||||||
?+ ls ~|(bad-finger/(lent ls) !!)
|
|
||||||
[* ~] [%1 ls]
|
|
||||||
[* * ~] [%2 ls]
|
|
||||||
[* * * ~] [%3 ls]
|
|
||||||
[* * * * ~] [%4 ls]
|
|
||||||
==
|
|
||||||
::
|
|
||||||
++ wyt
|
|
||||||
|= a=(pha val)
|
|
||||||
^- @ud
|
|
||||||
?- -.a
|
|
||||||
%nul 0
|
|
||||||
%one 1
|
|
||||||
%big :(add (lent +.p.a) (lent +.r.a) $(a q.a))
|
|
||||||
==
|
|
||||||
::
|
|
||||||
++ 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)]
|
|
||||||
==
|
|
||||||
::
|
|
||||||
:: +peek-left: inspect leftmost value
|
|
||||||
::
|
|
||||||
++ peek-left
|
|
||||||
|= a=(pha val)
|
|
||||||
^- (unit val)
|
|
||||||
?- -.a
|
|
||||||
%nul ~
|
|
||||||
%one `p.a
|
|
||||||
%big `p.p.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
|
|
||||||
==
|
|
||||||
--
|
|
||||||
--
|
|
||||||
:: ::
|
:: ::
|
||||||
:::: ++userlib :: (2u) non-vane utils
|
:::: ++userlib :: (2u) non-vane utils
|
||||||
:: ::::
|
:: ::::
|
||||||
|
|||||||
@ -1,98 +0,0 @@
|
|||||||
/+ *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-wyt
|
|
||||||
=/ le
|
|
||||||
~> %bout.[1 %wyt]
|
|
||||||
(wyt:de big)
|
|
||||||
(expect-eq !>(le) !>(big-num))
|
|
||||||
::
|
|
||||||
++ 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)
|
|
||||||
--
|
|
||||||
Loading…
Reference in New Issue
Block a user