mirror of
https://github.com/ilyakooo0/urbit.git
synced 2024-11-11 04:48:00 +03:00
cleaned up timer vane
This commit is contained in:
Ubuntu
parent
93e6ea7fb8
commit
dc13ba6fb9
151
arvo/time.hoon
151
arvo/time.hoon
@ -1,17 +1,17 @@
|
||||
::
|
||||
:: :: %time, just a timer
|
||||
!? 164
|
||||
::
|
||||
|= pit=vase
|
||||
=> =~
|
||||
::::
|
||||
|= pit=vase
|
||||
=> =~
|
||||
|%
|
||||
++ bqno |* [a=_,* b=_,*] :: binary skew queno
|
||||
++ sqeu |* [a=_,* b=_,*] :: binary skew queno
|
||||
$: r=@u :: rank/depth
|
||||
k=a :: priority
|
||||
n=b :: value
|
||||
c=(bque a b) :: children
|
||||
c=(broq a b) :: children
|
||||
== ::
|
||||
++ bque |* [a=_,* b=_,*] :: binary skew que
|
||||
(list (bqno a b)) ::
|
||||
++ broq |* [a=_,* b=_,*] :: brodal skew qeu
|
||||
(list (sqeu a b)) ::
|
||||
++ gift :: out result <-$
|
||||
$% [%wake ~] :: wakey-wakey
|
||||
== ::
|
||||
@ -23,123 +23,130 @@
|
||||
++ move ,[p=duct q=(mold note gift)] :: local move
|
||||
++ note ,~ :: out request $->
|
||||
++ sign ,~ :: in result $<-
|
||||
++ clok (bque ,@da duct) :: stored timers
|
||||
++ clok (broq ,@da duct) :: stored timers
|
||||
--
|
||||
::
|
||||
|%
|
||||
++ pa :: priority queue
|
||||
++ raze
|
||||
|= tym=[p=clok q=clok]
|
||||
^+ tym
|
||||
?~ q.tym tym
|
||||
?: (gth p:~(get up p.tym) p:~(get up q.tym)) :: killed nonexisting
|
||||
~& [%snooze-lost del=p:~(get up q.tym) top=p:~(get up p.tym)]
|
||||
$(q.tym ~(pop up q.tym))
|
||||
?: =(~(get up p.tym) ~(get up q.tym))
|
||||
$(tym [~(pop up p.tym) ~(pop up q.tym)])
|
||||
tym
|
||||
::
|
||||
++ up :: priority queue
|
||||
=+ [key=,@da val=duct]
|
||||
=+ cmp=lte :: lte=min, gte=max
|
||||
=> |%
|
||||
++ link
|
||||
|= [p=(bqno key val) q=(bqno key val)] :: link eq rank
|
||||
^- (bqno key val)
|
||||
|= [p=(sqeu key val) q=(sqeu key val)] :: link eq rank
|
||||
^- (sqeu key val)
|
||||
?> =(r.p r.q)
|
||||
?: (cmp k.p k.q)
|
||||
[r=+(r.p) k=k.p n=n.p c=[i=q t=c.p]]
|
||||
[r=+(r.q) k=k.q n=n.q c=[i=p t=c.q]]
|
||||
++ slink :: skew link
|
||||
|= [p=(bqno key val) q=(bqno key val) r=(bqno key val)]
|
||||
^- (bqno key val)
|
||||
~! p
|
||||
~! q
|
||||
~! r
|
||||
::
|
||||
++ sink :: skew link
|
||||
|= [p=(sqeu key val) q=(sqeu key val) r=(sqeu key val)]
|
||||
^- (sqeu key val)
|
||||
?: &((cmp k.q k.p) (cmp k.q k.r))
|
||||
[r=+(r.q) k=k.q n=n.q c=[i=p t=[i=r t=c.q]]]
|
||||
?: &((cmp k.r k.p) (cmp k.r k.q))
|
||||
[r=+(r.r) k=k.r n=n.r c=[i=p t=[i=q t=c.r]]]
|
||||
[r=+(r.q) k=k.p n=n.p c=[i=q t=[i=r t=~]]]
|
||||
++ ins :: internal ins op
|
||||
|= [p=(bqno key val) q=(bque key val)]
|
||||
^- (bque key val)
|
||||
::
|
||||
++ sert :: internal ins op
|
||||
|= [p=(sqeu key val) q=(broq key val)]
|
||||
^- (broq key val)
|
||||
?~ q [p ~]
|
||||
?> (lte r.p r.i.q)
|
||||
?: (lth r.p r.i.q)
|
||||
[i=p t=q]
|
||||
$(p (link p i.q), q t.q)
|
||||
::
|
||||
++ uniq :: remove init dup
|
||||
|= q=(bque key val)
|
||||
|= q=(broq key val)
|
||||
?~ q ~
|
||||
(ins i.q t.q)
|
||||
++ meuq :: unique meld
|
||||
|= [p=(bque key val) q=(bque key val)]
|
||||
^- (bque key val)
|
||||
(sert i.q t.q)
|
||||
::
|
||||
++ meek :: unique meld
|
||||
|= [p=(broq key val) q=(broq key val)]
|
||||
^- (broq key val)
|
||||
?~ p q
|
||||
?~ q p
|
||||
?: (lth r.i.p r.i.q)
|
||||
[i.p $(p t.p)]
|
||||
?: (lth r.i.q r.i.p)
|
||||
[i.q $(q t.q)]
|
||||
(ins (link i.p i.q) $(p t.p, q t.q))
|
||||
++ gmi :: getmin
|
||||
|= q=(bque key val)
|
||||
^- p=[(bqno key val) (bque key val)]
|
||||
?~ q ~|(%fatal-gmi-empty !!)
|
||||
(sert (link i.p i.q) $(p t.p, q t.q))
|
||||
::
|
||||
++ mini :: getmin
|
||||
|= q=(broq key val)
|
||||
^- p=[(sqeu key val) (broq key val)]
|
||||
?~ q ~|(%fatal-mini-empty !!)
|
||||
?~ t.q [i=i.q t=~]
|
||||
=+ [l r]=$(q t.q)
|
||||
?: (cmp k.i.q k.l)
|
||||
[i.q t.q]
|
||||
[l [i.q r]]
|
||||
++ spli :: split
|
||||
::|* p=(bque) q=(list ,[k=,_+<-.cmp n=*]) r=(bque)
|
||||
|= [p=(bque key val) q=(list ,[k=key n=val]) r=(bque key val)]
|
||||
^- [t=(bque key val) x=(list ,[k=key n=val])]
|
||||
::
|
||||
++ spit :: split
|
||||
|= [p=(broq key val) q=(list ,[k=key n=val]) r=(broq key val)]
|
||||
^- [t=(broq key val) x=(list ,[k=key n=val])]
|
||||
?~ r
|
||||
[t=p x=q]
|
||||
?: =(0 r.i.r)
|
||||
$(q [[k=k.i.r n=n.i.r] q], r t.r)
|
||||
$(p [i.r p], r t.r)
|
||||
--
|
||||
|_ a=(bque key val) :: public interface
|
||||
++ add :: insert element
|
||||
|_ a=(broq key val) :: public interface
|
||||
++ put :: insert element
|
||||
|= [k=key n=val]
|
||||
^+ a
|
||||
?~ a [i=[r=0 k=k n=n c=~] t=~]
|
||||
?~ t.a [i=[r=0 k=k n=n c=~] t=a]
|
||||
?: =(r.i.a r.i.t.a)
|
||||
[i=(slink [r=0 k=k n=n c=~] i.a i.t.a) t=t.t.a]
|
||||
[i=(sink [r=0 k=k n=n c=~] i.a i.t.a) t=t.t.a]
|
||||
[i=[r=0 k=k n=n c=~] t=a]
|
||||
::
|
||||
++ pop :: remove top
|
||||
^+ a
|
||||
::^- [q=(bque key val) r=[k=key n=val]]
|
||||
=+ ?~ a ~|(%empty-bque-pop !!)
|
||||
[l r]=(gmi a)
|
||||
=+ [t x]=(spli ~ ~ c.l)
|
||||
=+ ?~ a ~|(%empty-broq-pop !!)
|
||||
[l r]=(mini a)
|
||||
=+ [t x]=(spit ~ ~ c.l)
|
||||
=. a r
|
||||
=. a (uni t)
|
||||
(gas x)
|
||||
::
|
||||
++ gas
|
||||
|= b=(list ,[k=key n=val])
|
||||
^+ a
|
||||
q:(roll b |=([[k=key n=val] q=_a] (add(a q) k n)))
|
||||
q:(roll b |=([[k=key n=val] q=_a] (put(a q) k n)))
|
||||
::
|
||||
++ tap
|
||||
^- (list ,[k=key n=val])
|
||||
?~ a ~
|
||||
[top tap(a pop)]
|
||||
++ top :: retrieve top
|
||||
[get tap(a pop)]
|
||||
::
|
||||
++ get :: retrieve top
|
||||
^- [p=key q=val]
|
||||
?~ a ~|(%empty-bque-peek !!)
|
||||
?~ a ~|(%empty-broq-peek !!)
|
||||
?~ t.a [k n]:i.a
|
||||
=+ m=top(a t.a)
|
||||
=+ m=get(a t.a)
|
||||
?.((cmp k.i.a p.m) m [k n]:i.a)
|
||||
::
|
||||
++ uni :: merge
|
||||
|= q=(bque key val)
|
||||
|= q=(broq key val)
|
||||
^+ a
|
||||
(meuq (uniq a) (uniq q))
|
||||
(meek (uniq a) (uniq q))
|
||||
--
|
||||
++ tops
|
||||
|= tym=[p=clok q=clok]
|
||||
^+ tym
|
||||
?~ q.tym tym
|
||||
?: (gth p:~(top pa p.tym) p:~(top pa q.tym)) :: killed nonexisting
|
||||
~& [%snooze-lost del=p:~(top pa q.tym) top=p:~(top pa p.tym)]
|
||||
$(q.tym ~(pop pa q.tym))
|
||||
?: =(~(top pa p.tym) ~(top pa q.tym))
|
||||
$(tym [~(pop pa p.tym) ~(pop pa q.tym)])
|
||||
tym
|
||||
--
|
||||
. ==
|
||||
=| $: %1 ::
|
||||
=| $: %0 ::
|
||||
tym=[p=clok q=clok] :: positive/negative
|
||||
== ::
|
||||
|= [now=@da eny=@ ski=sled] :: current invocation
|
||||
@ -162,19 +169,19 @@
|
||||
==
|
||||
=^ mof tym
|
||||
?- -.q.hic
|
||||
%rest =. q.tym (~(add pa q.tym) p.q.hic hen)
|
||||
=. tym (tops tym)
|
||||
%rest =. q.tym (~(put up q.tym) p.q.hic hen)
|
||||
=. tym (raze tym)
|
||||
[~ tym]
|
||||
%wait =. p.tym (~(add pa p.tym) p.q.hic hen)
|
||||
=. tym (tops tym)
|
||||
%wait =. p.tym (~(put up p.tym) p.q.hic hen)
|
||||
=. tym (raze tym)
|
||||
[~ tym]
|
||||
%wake
|
||||
|- ^+ [*(list move) tym]
|
||||
=. tym (tops tym)
|
||||
=. tym (raze tym)
|
||||
?: =([~ ~] tym) [~ tym] :: XX TMI
|
||||
=+ nex=~(top pa p.tym)
|
||||
=+ nex=~(get up p.tym)
|
||||
?: (lte now p.nex) [~ tym]
|
||||
=^ mof tym $(p.tym ~(pop pa p.tym))
|
||||
=^ mof tym $(p.tym ~(pop up p.tym))
|
||||
[[`move`[q.nex %give %wake ~] mof] tym]
|
||||
==
|
||||
[mof ..^$]
|
||||
@ -183,10 +190,10 @@
|
||||
|= [now=@da hen=duct]
|
||||
^- (unit ,@da)
|
||||
?~ p.tym ~
|
||||
(some p:[~(top pa p.tym)])
|
||||
(some p:[~(get up p.tym)])
|
||||
::
|
||||
++ load
|
||||
|= old=[%1 tym=[clok clok]]
|
||||
|= old=[%0 tym=[clok clok]]
|
||||
^+ ..^$
|
||||
..^$(tym tym.old)
|
||||
::
|
||||
@ -195,12 +202,12 @@
|
||||
^- (unit (unit (pair mark ,*)))
|
||||
=+ ^= liz
|
||||
|- ^- (list ,[@da duct])
|
||||
=. tym (tops tym)
|
||||
=. tym (raze tym)
|
||||
?~ p.tym ~
|
||||
[~(top pa p.tym) $(p.tym ~(pop pa p.tym))]
|
||||
[~(get up p.tym) $(p.tym ~(pop up p.tym))]
|
||||
[~ ~ [%tank >liz<]]
|
||||
::
|
||||
++ stay [%1 tym]
|
||||
++ stay [%0 tym]
|
||||
++ take :: process move
|
||||
|= [tea=wire hen=duct hin=(hypo sign)]
|
||||
^- [p=(list move) q=_..^$]
|
||||
|
||||
Loading…
Reference in New Issue
Block a user