mirror of
https://github.com/ilyakooo0/urbit.git
synced 2025-01-07 07:30:23 +03:00
Merge branch 'master' of github.com:urbit/urbit
Conflicts: urb/urbit.pill
This commit is contained in:
C. Guy Yarvin
commit
c0758b3704
@ -692,20 +692,19 @@
|
|||||||
::
|
::
|
||||||
++ reel :: right fold
|
++ reel :: right fold
|
||||||
~/ %reel
|
~/ %reel
|
||||||
|* [a=(list) b=_=|([p=* q=*] |.(q))]
|
|* [a=(list) b=_|=([* *] +<+)]
|
||||||
|- ^+ q.b
|
|- ^+ +<+.b
|
||||||
?~ a
|
?~ a
|
||||||
q.b
|
+<+.b
|
||||||
(b i.a $(a t.a))
|
(b i.a $(a t.a))
|
||||||
::
|
::
|
||||||
++ roll :: left fold
|
++ roll :: left fold
|
||||||
~/ %roll
|
~/ %roll
|
||||||
|* [a=(list) b=_=|([p=* q=*] |.(q))]
|
|* [a=(list) b=_|=([* *] +<+)]
|
||||||
|-
|
|- ^+ +<+.b
|
||||||
^+ q.b
|
|
||||||
?~ a
|
?~ a
|
||||||
q.b
|
+<+.b
|
||||||
$(a t.a, b b(q (b i.a q.b)))
|
$(a t.a, b b(+<+ (b i.a +<+.b)))
|
||||||
::
|
::
|
||||||
++ skid :: separate
|
++ skid :: separate
|
||||||
|* [a=(list) b=$+(* ?)]
|
|* [a=(list) b=$+(* ?)]
|
||||||
@ -1172,19 +1171,23 @@
|
|||||||
::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
|
::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
|
||||||
:: section 2cG, floating point ::
|
:: section 2cG, floating point ::
|
||||||
::
|
::
|
||||||
++ rlyd |= red=@rd ^- [s=? h=@ f=@ e=(unit tape)] !:
|
++ rlyd |= red=@rd ^- [s=? h=@ f=@ e=(unit tape) n=?] !:
|
||||||
~& [%rlyd `@ux`red]
|
~& [%rlyd `@ux`red]
|
||||||
[s=(sig:rd red) h=(hol:rd red) f=(fac:rd red) e=(err:rd red)]
|
=+ s=(sea:rd red)
|
||||||
++ rlyh |=(reh=@rh ~|(%real-nyet ^-([s=? h=@ f=@ e=(unit tape)] !!)))
|
=+ negexp==(1 (mod e.s 2))
|
||||||
++ rlyq |=(req=@rq ~|(%real-nyet ^-([s=? h=@ f=@ e=(unit tape)] !!)))
|
[s=(sig:rd red) h=(hol:rd red) f=(fac:rd red) e=(err:rd red) n=negexp]
|
||||||
++ rlys |=(res=@rs ~|(%real-nyet ^-([s=? h=@ f=@ e=(unit tape)] !!)))
|
++ rlyh |=(reh=@rh ~|(%real-nyet ^-([s=? h=@ f=@ e=(unit tape) n=?] !!)))
|
||||||
++ ryld |= v=[syn=? hol=@ zer=@ fac=@] ^- @rd !:
|
++ rlyq |=(req=@rq ~|(%real-nyet ^-([s=? h=@ f=@ e=(unit tape) n=?] !!)))
|
||||||
|
++ rlys |=(res=@rs ~|(%real-nyet ^-([s=? h=@ f=@ e=(unit tape) n=?] !!)))
|
||||||
|
++ ryld |= v=[syn=? hol=@ zer=@ fac=@ exp=(unit ,@)] ^- @rd !:
|
||||||
?: &(=(hol.v 0) =(zer.v 0) =(fac.v 0))
|
?: &(=(hol.v 0) =(zer.v 0) =(fac.v 0))
|
||||||
(bit:rd (szer:vl:fl 1.023 52 syn.v))
|
(bit:rd (szer:vl:fl 1.023 52 syn.v))
|
||||||
(bit:rd (cof:fl 52 1.023 v))
|
?~ exp.v
|
||||||
++ rylh |=([syn=? hol=@ zer=@ fac=@] ~|(%real-nyet ^-(@rh !!)))
|
(bit:rd (cof:fl 52 1.023 v))
|
||||||
++ rylq |=([syn=? hol=@ zer=@ fac=@] ~|(%real-nyet ^-(@rq !!)))
|
(ipow:rd u.exp.v (bit:rd (cof:fl 52 1.023 v)))
|
||||||
++ ryls |=([syn=? hol=@ zer=@ fac=@] ~|(%real-nyet ^-(@rs !!)))
|
++ rylh |=([syn=? hol=@ zer=@ fac=@ exp=(unit ,@)] ~|(%real-nyet ^-(@rh !!)))
|
||||||
|
++ rylq |=([syn=? hol=@ zer=@ fac=@ exp=(unit ,@)] ~|(%real-nyet ^-(@rq !!)))
|
||||||
|
++ ryls |=([syn=? hol=@ zer=@ fac=@ exp=(unit ,@)] ~|(%real-nyet ^-(@rs !!)))
|
||||||
|
|
||||||
:: Floating point operations for general floating points.
|
:: Floating point operations for general floating points.
|
||||||
:: [s=sign, e=unbiased exponent, f=fraction a=ari]
|
:: [s=sign, e=unbiased exponent, f=fraction a=ari]
|
||||||
@ -1212,7 +1215,8 @@
|
|||||||
$(c (^mul c a), b (^add b 1))
|
$(c (^mul c a), b (^add b 1))
|
||||||
::
|
::
|
||||||
:: convert from sign/whole/frac -> sign/exp/ari w/ precision p, bias b
|
:: convert from sign/whole/frac -> sign/exp/ari w/ precision p, bias b
|
||||||
++ cof |= [p=@u b=@u s=? h=@u z=@ f=@u] ^- [s=? e=@s a=@u]
|
:: g is garbage
|
||||||
|
++ cof |= [p=@u b=@u s=? h=@u z=@ f=@u g=(unit ,@)] ^- [s=? e=@s a=@u]
|
||||||
?: &(=(0 h) =(0 f))
|
?: &(=(0 h) =(0 f))
|
||||||
[s=s e=`@s`(dec (^mul 2 b)) a=(ari p 0)]
|
[s=s e=`@s`(dec (^mul 2 b)) a=(ari p 0)]
|
||||||
?: &(=(0 h))
|
?: &(=(0 h))
|
||||||
@ -1268,8 +1272,13 @@
|
|||||||
::=+ k=(lsh 0 (^add (dec (met 0 a.n)) (abs:si e.n)) 1)
|
::=+ k=(lsh 0 (^add (dec (met 0 a.n)) (abs:si e.n)) 1)
|
||||||
::=+ g=(lsh 0 (dec (met 0 a.n)) 1)
|
::=+ g=(lsh 0 (dec (met 0 a.n)) 1)
|
||||||
:::(mix k g a.n)
|
:::(mix k g a.n)
|
||||||
(rep a.n |=(a=@ (peg a 0b10)) (abs:si e.n))
|
::(rep a.n |=(a=@ (^mul 2 (peg a 0b10))) (abs:si e.n)) :: kill & move
|
||||||
=+ d=(bex (^sub (met 0 b) 1))
|
a.n
|
||||||
|
~& `@ub`b
|
||||||
|
?: =(0 (mod e.n 2))
|
||||||
|
=+ d=(bex (^sub (met 0 b) 1))
|
||||||
|
(^div (^mul b (bey 10 q 0 1)) d)
|
||||||
|
=+ d=(bex (^add (abs:si e.n) (dec (met 0 b))))
|
||||||
(^div (^mul b (bey 10 q 0 1)) d)
|
(^div (^mul b (bey 10 q 0 1)) d)
|
||||||
::
|
::
|
||||||
++ hol |= [p=@u n=[s=? e=@s a=@u]] ^- @u
|
++ hol |= [p=@u n=[s=? e=@s a=@u]] ^- @u
|
||||||
@ -1374,6 +1383,7 @@
|
|||||||
~
|
~
|
||||||
--
|
--
|
||||||
|
|
||||||
|
|
||||||
::::::::::::
|
::::::::::::
|
||||||
++ add |= [b=@u p=@u n=[s=? e=@s a=@u] m=[s=? e=@s a=@u]] ^- [s=? e=@s a=@u]
|
++ add |= [b=@u p=@u n=[s=? e=@s a=@u] m=[s=? e=@s a=@u]] ^- [s=? e=@s a=@u]
|
||||||
=+ g=(gar:te:fl b n m)
|
=+ g=(gar:te:fl b n m)
|
||||||
@ -1495,7 +1505,7 @@
|
|||||||
::::::::::::
|
::::::::::::
|
||||||
++ sun ~/ %sun
|
++ sun ~/ %sun
|
||||||
|= a=@u ^- @rd
|
|= a=@u ^- @rd
|
||||||
(bit (cof:fl 52 1.023 %.y a 0 0))
|
(bit (cof:fl 52 1.023 %.y a 0 0 ~))
|
||||||
|
|
||||||
++ add ~/ %add
|
++ add ~/ %add
|
||||||
|= [a=@rd b=@rd] ^- @rd
|
|= [a=@rd b=@rd] ^- @rd
|
||||||
@ -1541,6 +1551,16 @@
|
|||||||
|
|
||||||
++ bex |= a=@s ^- @rd
|
++ bex |= a=@s ^- @rd
|
||||||
(bit [s=%.y e=a a=(ari:fl 52 0)])
|
(bit [s=%.y e=a a=(ari:fl 52 0)])
|
||||||
|
|
||||||
|
++ ipow |= [exp=@s n=@rd]
|
||||||
|
^- @rd
|
||||||
|
?: =(0 (mod exp 2))
|
||||||
|
?: =(0 exp)
|
||||||
|
n
|
||||||
|
(mul .~10 $(exp (^sub exp 2)))
|
||||||
|
?: =(1 exp)
|
||||||
|
(div n .~10)
|
||||||
|
(div $(exp (^sub exp 2)) .~10)
|
||||||
--
|
--
|
||||||
::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
|
::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
|
||||||
:: section 2cH, urbit time ::
|
:: section 2cH, urbit time ::
|
||||||
@ -3315,11 +3335,12 @@
|
|||||||
++ a-co |=(dat=@ ((d-co 1) dat))
|
++ a-co |=(dat=@ ((d-co 1) dat))
|
||||||
++ d-co |=(min=@ (em-co [10 min] |=([? b=@ c=tape] [~(d ne b) c])))
|
++ d-co |=(min=@ (em-co [10 min] |=([? b=@ c=tape] [~(d ne b) c])))
|
||||||
++ r-co
|
++ r-co
|
||||||
|= [syn=? nub=@ der=@ ign=(unit tape)]
|
|= [syn=? nub=@ der=@ ign=(unit tape) ne=?]
|
||||||
=> .(rex ['.' (t-co ((d-co 1) der))])
|
=> .(rex ['.' (t-co ((d-co 1) der) ne)])
|
||||||
=> .(rex ((d-co 1) nub))
|
=> .(rex ((d-co 1) nub))
|
||||||
?:(syn rex ['-' rex])
|
?:(syn rex ['-' rex])
|
||||||
++ t-co |= a=tape ^- tape
|
++ t-co |= [a=tape n=?] ^- tape
|
||||||
|
?: n a
|
||||||
?~ a ~|(%empty-frac !!) t.a
|
?~ a ~|(%empty-frac !!) t.a
|
||||||
::
|
::
|
||||||
++ s-co
|
++ s-co
|
||||||
@ -3486,13 +3507,25 @@
|
|||||||
;~ plug
|
;~ plug
|
||||||
;~(pose (cold | hep) (easy &))
|
;~(pose (cold | hep) (easy &))
|
||||||
;~(plug dim:ag ;~(pose ;~(pfix dot ;~(plug zer dim:ag)) (easy [0 0])))
|
;~(plug dim:ag ;~(pose ;~(pfix dot ;~(plug zer dim:ag)) (easy [0 0])))
|
||||||
|
;~(pose ;~(pfix (just 'e') (cook some ;~(plug ;~(pose (cold | hep) (easy &)) dim:ag))) (easy ~))
|
||||||
==
|
==
|
||||||
|
=+ ^= voy
|
||||||
|
::(cook |=([a=? b=[c=@ d=@ e=@] f=(unit ,@) g=?] [a c.b d.b e.b f]) vox)k
|
||||||
|
(cook royl-cell vox)
|
||||||
;~ pose
|
;~ pose
|
||||||
(stag %rh (cook rylh ;~(pfix ;~(plug sig sig) vox)))
|
(stag %rh (cook rylh ;~(pfix ;~(plug sig sig) voy)))
|
||||||
(stag %rq (cook rylq ;~(pfix ;~(plug sig sig sig) vox)))
|
(stag %rq (cook rylq ;~(pfix ;~(plug sig sig sig) voy)))
|
||||||
(stag %rd (cook ryld ;~(pfix sig vox)))
|
(stag %rd (cook ryld ;~(pfix sig voy)))
|
||||||
(stag %rs (cook ryls vox))
|
(stag %rs (cook ryls voy))
|
||||||
==
|
==
|
||||||
|
++ royl-cell
|
||||||
|
|= [a=? b=[c=@ d=@ e=@] f=(unit ,[h=? i=@])]
|
||||||
|
^- [? @ @ @ (unit ,@s)]
|
||||||
|
?~ f
|
||||||
|
[a c.b d.b e.b ~]
|
||||||
|
?: h.u.f
|
||||||
|
[a c.b d.b e.b [~ (mul i.u.f 2)]]
|
||||||
|
[a c.b d.b e.b [~ (dec (mul i.u.f 2))]]
|
||||||
++ tash
|
++ tash
|
||||||
=+ ^= neg
|
=+ ^= neg
|
||||||
|= [syn=? mol=dime] ^- dime
|
|= [syn=? mol=dime] ^- dime
|
||||||
|
|||||||
@ -598,8 +598,7 @@
|
|||||||
"\""
|
"\""
|
||||||
%+ reel
|
%+ reel
|
||||||
(turn (trip p.val) jesc)
|
(turn (trip p.val) jesc)
|
||||||
=| [p=tape q=tape]
|
|=([tape tape] (weld +<))
|
||||||
|.((weld p q))
|
|
||||||
"\""
|
"\""
|
||||||
==
|
==
|
||||||
%o
|
%o
|
||||||
|
|||||||
80
main/app/appbug/core.hoon
Normal file
80
main/app/appbug/core.hoon
Normal file
@ -0,0 +1,80 @@
|
|||||||
|
!: |= *
|
||||||
|
::::::::: Appbug: a simple application.
|
||||||
|
::
|
||||||
|
=> |%
|
||||||
|
++ catt
|
||||||
|
|= [@t @t]
|
||||||
|
^- @t
|
||||||
|
(cat 3 +<- +<+)
|
||||||
|
++ clay
|
||||||
|
|= [mih=ship dez=span caz=span sup=path]
|
||||||
|
=> |%
|
||||||
|
::
|
||||||
|
++ gifted
|
||||||
|
|= (list miso)
|
||||||
|
=+ (turn +< |=(p=miso [sup p]))
|
||||||
|
[%into mih dez (nori [& ~ [*cart -]])]
|
||||||
|
::
|
||||||
|
++ plan
|
||||||
|
|= [chg=$+([@ @] @) den=@ dif=$+([@ @] udon)]
|
||||||
|
^- (list miso)
|
||||||
|
=+ cur=curr
|
||||||
|
?~ cur
|
||||||
|
[[%ins den] ~]
|
||||||
|
?^ q.u.cur
|
||||||
|
[[%del q.u.cur] [%ins den] ~]
|
||||||
|
[[%mut (dif q.u.cur (chg q.u.cur den))] ~]
|
||||||
|
::
|
||||||
|
++ curr
|
||||||
|
^- (unit ,[p=cash q=*])
|
||||||
|
=+ yaz=(zu ((hard ankh) .^(%cz (scot %p mih) dez caz ~)))
|
||||||
|
q:ank:(deny:yaz sup)
|
||||||
|
--
|
||||||
|
|%
|
||||||
|
++ pend |=(den=@t (gifted (plan catt den (diff %c))))
|
||||||
|
++ push |=(den=@ (gifted (plan |=(* den) den (diff %c))))
|
||||||
|
++ pull (bind curr |*([cash q=*] q))
|
||||||
|
++ outw |=(* (push (scot %uw (jam +<)))) :: we're not JS XX
|
||||||
|
++ getw ?.(.?(pull) ~ (cue (slav %uw ;;(,@ +.pull)))) :: ?~ fails XX
|
||||||
|
--
|
||||||
|
--
|
||||||
|
|_ [hid=hide vat=[%0 p=@ud]]
|
||||||
|
++ poke
|
||||||
|
|= [ost=bone *]
|
||||||
|
=. p.vat +(p.vat)
|
||||||
|
:_ +>.$
|
||||||
|
=+ msg=:(catt (scot %da lat.hid) ' ping ' (scot %ud p.vat))
|
||||||
|
:~ [ost %give %rasp ~ %json *json]
|
||||||
|
:^ ost %pass /no/return
|
||||||
|
[%c (pend:(clay our.hid /try/(scot %da lat.hid)/bump/log) msg)]
|
||||||
|
==
|
||||||
|
::
|
||||||
|
++ peek
|
||||||
|
|= [you=ship pax=path]
|
||||||
|
:- %hymn
|
||||||
|
^- manx
|
||||||
|
;html
|
||||||
|
;head
|
||||||
|
;title: Foobug!
|
||||||
|
==
|
||||||
|
;body
|
||||||
|
;p: Dude, a better answer is {<p.vat>}.
|
||||||
|
;button(onclick "bump()"): (Bump.)
|
||||||
|
;script
|
||||||
|
; var mess = 0;
|
||||||
|
;
|
||||||
|
; function bump() {
|
||||||
|
; xhr = new XMLHttpRequest();
|
||||||
|
; xhr.onload = function() { mess++; }
|
||||||
|
; xhr.open("PUT", "/tim/"+user+"/"+appl+"/"+port+"/"+mess);
|
||||||
|
; xhr.setRequestHeader("content-type", "text/json");
|
||||||
|
; xhr.send(JSON.stringify({oryx: oryx, xyro: {}}));
|
||||||
|
; }
|
||||||
|
==
|
||||||
|
==
|
||||||
|
==
|
||||||
|
++ haxs
|
||||||
|
1
|
||||||
|
--
|
||||||
|
|
||||||
|
|
||||||
@ -7,7 +7,7 @@
|
|||||||
^- bowl
|
^- bowl
|
||||||
:_ ~
|
:_ ~
|
||||||
=+ dub=(scot %p bud)
|
=+ dub=(scot %p bud)
|
||||||
=+ wyl=((hard will) .^(%a /[dub]/will=))
|
=+ wyl=((hard will) .^(%a /=will=/[dub]))
|
||||||
?~ wyl
|
?~ wyl
|
||||||
[[%la %leaf "no will for {(trip dub)}"] ~]
|
[[%la %leaf "no will for {(trip dub)}"] ~]
|
||||||
[[%la >q.q.q.i.wyl<] ~]
|
[[%la >q.q.q.i.wyl<] ~]
|
||||||
|
|||||||
103
try/bin/bootque.hoon
Normal file
103
try/bin/bootque.hoon
Normal file
@ -0,0 +1,103 @@
|
|||||||
|
!:
|
||||||
|
:: /=main=/bin/app/hoon
|
||||||
|
::
|
||||||
|
=> %= .
|
||||||
|
+
|
||||||
|
=> +
|
||||||
|
=> ^/===/bin/pque
|
||||||
|
|%
|
||||||
|
:: efficient priority queue
|
||||||
|
:: possibly empty
|
||||||
|
++ pque |* [a=_,* b=_,*]
|
||||||
|
(unit (rque a b))
|
||||||
|
:: internal - nonempty pque
|
||||||
|
++ rque |* [a=_,* b=_,*]
|
||||||
|
$: k=a
|
||||||
|
n=b
|
||||||
|
q=(bque a (rque a b))
|
||||||
|
==
|
||||||
|
:: maximally optimal priority queue
|
||||||
|
:: O(1) insert, meld, peek
|
||||||
|
:: O(log n) pop
|
||||||
|
::
|
||||||
|
:: lte -> min priority queue
|
||||||
|
:: gte -> max priority queue
|
||||||
|
::
|
||||||
|
:: bootstrapped off of ++pr
|
||||||
|
::
|
||||||
|
:: to create, use something like
|
||||||
|
:: ~zod/try=> ((qu ,@ ,@) lte)
|
||||||
|
::
|
||||||
|
:: example operations
|
||||||
|
::
|
||||||
|
:: =+ pri=((qu ,@ ,@) lte)
|
||||||
|
:: =+ q=~
|
||||||
|
:: =. q (insert.pri q 3 2)
|
||||||
|
:: =^ r q (pop.pri q)
|
||||||
|
++ qu !:
|
||||||
|
|* [key=$+(* *) val=$+(* *)]
|
||||||
|
|= cmp=$+([key key] ?)
|
||||||
|
=+ bt=((pr key (rque key val)) cmp)
|
||||||
|
|%
|
||||||
|
++ insert
|
||||||
|
|= [q=(pque key val) k=key n=val]
|
||||||
|
^- (pque key val)
|
||||||
|
(meld [~ [k=k n=n q=~]] q)
|
||||||
|
++ meld
|
||||||
|
|= [q=(pque key val) p=(pque key val)]
|
||||||
|
^- (pque key val)
|
||||||
|
?~ p q
|
||||||
|
?~ q p
|
||||||
|
?: (cmp k.u.p k.u.q)
|
||||||
|
[~ [k=k.u.p n=n.u.p q=(insert.bt q.u.p [k=k.u.q n=[k.u.q n=n.u.q q=q.u.q]])]]
|
||||||
|
[~ [k=k.u.q n=n.u.q q=(insert.bt q.u.q [k=k.u.p n=[k=k.u.p n=n.u.p q=q.u.p]])]]
|
||||||
|
:: errors on empty pque, sigcheck first
|
||||||
|
++ peek
|
||||||
|
|= q=(pque key val)
|
||||||
|
^- [k=key n=val]
|
||||||
|
?~ q ~|(%empty-pque-peek !!)
|
||||||
|
[k=k.u.q n=n.u.q]
|
||||||
|
:: errors on empty pque, sigcheck first
|
||||||
|
++ pop
|
||||||
|
|= q=(pque key val)
|
||||||
|
^- [r=[k=key n=val] q=(pque key val)]
|
||||||
|
?~ q ~|(%empty-pque-pop !!)
|
||||||
|
?~ q.u.q
|
||||||
|
[r=(peek q) q=~] :: queue is now empty
|
||||||
|
=+ s=(pop.bt q.u.q) :: [r=[k=key n=rque] q=bque]
|
||||||
|
~! s
|
||||||
|
[r=(peek q) q=[~ [k=k.r.s n=n.n.r.s q=(meld.bt q.n.r.s q.s)]]]
|
||||||
|
--
|
||||||
|
--
|
||||||
|
==
|
||||||
|
|= *
|
||||||
|
|= ~
|
||||||
|
^- bowl
|
||||||
|
:_ ~ :_ ~
|
||||||
|
:- %$
|
||||||
|
!>
|
||||||
|
=+ pri=((qu ,@ ,@) lte)
|
||||||
|
=+ pq=(insert.pri ~ 6 302)
|
||||||
|
=. pq (insert.pri pq 5 3.897)
|
||||||
|
=. pq (insert.pri pq 2 1)
|
||||||
|
=+ pq2=(insert.pri ~ 508 542)
|
||||||
|
=. pq2 (insert.pri pq2 42 89)
|
||||||
|
=. pq2 (insert.pri pq2 325 325)
|
||||||
|
=. pq2 (insert.pri pq2 41 37)
|
||||||
|
=. pq (meld.pri pq pq2)
|
||||||
|
~& pq
|
||||||
|
=^ r pq (pop.pri pq)
|
||||||
|
~& r
|
||||||
|
=^ r pq (pop.pri pq)
|
||||||
|
~& r
|
||||||
|
=^ r pq (pop.pri pq)
|
||||||
|
~& r
|
||||||
|
=^ r pq (pop.pri pq)
|
||||||
|
~& r
|
||||||
|
=^ r pq (pop.pri pq)
|
||||||
|
~& r
|
||||||
|
=^ r pq (pop.pri pq)
|
||||||
|
~& r
|
||||||
|
=^ r pq (pop.pri pq)
|
||||||
|
~& r
|
||||||
|
pq
|
||||||
148
try/bin/pque.hoon
Normal file
148
try/bin/pque.hoon
Normal file
@ -0,0 +1,148 @@
|
|||||||
|
!:
|
||||||
|
:: /=main=/bin/app/hoon
|
||||||
|
::
|
||||||
|
=> %= .
|
||||||
|
+
|
||||||
|
=> +
|
||||||
|
!:
|
||||||
|
|%
|
||||||
|
++ bqno |* [a=_,* b=_,*] :: binary skew queno
|
||||||
|
$: r=@u :: rank/depth
|
||||||
|
k=a :: priority
|
||||||
|
n=b :: value
|
||||||
|
c=(bque a b) :: children
|
||||||
|
== ::
|
||||||
|
++ bque |* [a=_,* b=_,*] :: binary skew que
|
||||||
|
(list (bqno a b)) ::
|
||||||
|
++ pr !: :: priority queue
|
||||||
|
|* [key=$+(* *) val=$+(* *)]
|
||||||
|
|= cmp=$+([key key] ?) :: lte=min, gte=max
|
||||||
|
|%
|
||||||
|
++ link
|
||||||
|
|= [p=(bqno key val) q=(bqno key val)] :: link eq rank
|
||||||
|
^- (bqno 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
|
||||||
|
?: &((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)
|
||||||
|
?~ 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 ~
|
||||||
|
(ins i.q t.q)
|
||||||
|
++ meuq :: unique meld
|
||||||
|
|= [p=(bque key val) q=(bque key val)]
|
||||||
|
^- (bque 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)
|
||||||
|
^- [i=(bqno key val) t=(bque key val)]
|
||||||
|
?~ q ~|(%fatal-gmi-empty !!)
|
||||||
|
?~ t.q [i=i.q t=~]
|
||||||
|
=+ r=$(q t.q)
|
||||||
|
?: (cmp k.i.q k.i.r)
|
||||||
|
[i=i.q t=t.q]
|
||||||
|
[i=i.r t=[i.q t.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])]
|
||||||
|
?~ 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)
|
||||||
|
++ insl :: insert list
|
||||||
|
::|* [p=(list, [k=,_+<-.cmp n=*]) q=(bque)]
|
||||||
|
|= [p=(list ,[k=key n=val]) q=(bque key val)]
|
||||||
|
^- (bque key val)
|
||||||
|
?~ p q
|
||||||
|
?~ q p
|
||||||
|
$(p t.p, q (insert q i.p))
|
||||||
|
::
|
||||||
|
:: :: public interface
|
||||||
|
::
|
||||||
|
++ insert :: real ins
|
||||||
|
|= [q=(bque key val) k=key n=val]
|
||||||
|
^- (bque key val)
|
||||||
|
?~ q [i=[r=0 k=k n=n c=~] t=~]
|
||||||
|
?~ t.q [i=[r=0 k=k n=n c=~] t=q]
|
||||||
|
?: =(r.i.q r.i.t.q)
|
||||||
|
[i=(slink [r=0 k=k n=n c=~] i.q i.t.q) t=t.t.q]
|
||||||
|
[i=[r=0 k=k n=n c=~] t=q]
|
||||||
|
++ meld :: concat
|
||||||
|
|= [p=(bque key val) q=(bque key val)]
|
||||||
|
^- (bque key val)
|
||||||
|
(meuq (uniq p) (uniq q))
|
||||||
|
++ peek :: find min/max
|
||||||
|
|= q=(bque key val)
|
||||||
|
^- [k=key n=val]
|
||||||
|
?~ q ~|(%empty-bque-peek !!)
|
||||||
|
?~ t.q [k=k.i.q n=n.i.q]
|
||||||
|
=+ m=$(q t.q)
|
||||||
|
?: (cmp k.i.q k.m) [k=k.i.q n=n.i.q] m
|
||||||
|
++ pop :: delete min/max
|
||||||
|
|= q=(bque key val)
|
||||||
|
^- [r=[k=key n=val] q=(bque key val)]
|
||||||
|
::^- [q=(bque key val) r=[k=key n=val]]
|
||||||
|
?~ q ~|(%empty-bque-pop !!)
|
||||||
|
=+ m=(gmi q)
|
||||||
|
=+ s=(spli ~ ~ c.i.m)
|
||||||
|
[q=[k=k.i.m n=n.i.m] r=(insl x.s (meld t.m t.s))]
|
||||||
|
::[q=(insl x.s (meld t.m t.s)) r=[k=k.i.m n=n.i.m]]
|
||||||
|
--
|
||||||
|
--
|
||||||
|
==
|
||||||
|
|= *
|
||||||
|
|= ~
|
||||||
|
^- bowl
|
||||||
|
:_ ~ :_ ~
|
||||||
|
:- %$
|
||||||
|
!>
|
||||||
|
!:
|
||||||
|
=+ pri=((pr ,@ ,@) lte)
|
||||||
|
=+ pq=(insert.pri ~ 6 3)
|
||||||
|
=. pq (insert.pri pq 5 2)
|
||||||
|
=. pq (insert.pri pq 2 5)
|
||||||
|
=+ pq2=(insert.pri ~ 508 1.084)
|
||||||
|
=. pq2 (insert.pri pq2 42 75)
|
||||||
|
=. pq2 (insert.pri pq2 325 562)
|
||||||
|
=. pq2 (insert.pri pq2 41 822)
|
||||||
|
=. pq (meld.pri pq pq2)
|
||||||
|
=^ r pq (pop.pri pq)
|
||||||
|
~& r
|
||||||
|
=^ r pq (pop.pri pq)
|
||||||
|
~& r
|
||||||
|
=^ r pq (pop.pri pq)
|
||||||
|
~& r
|
||||||
|
=^ r pq (pop.pri pq)
|
||||||
|
~& r
|
||||||
|
=^ r pq (pop.pri pq)
|
||||||
|
~& r
|
||||||
|
=^ r pq (pop.pri pq)
|
||||||
|
~& r
|
||||||
|
pq
|
||||||
Loading…
Reference in New Issue
Block a user