ilyakooo0/urbit
1
0
Fork 0
mirror of https://github.com/ilyakooo0/urbit.git synced 2024-09-21 07:28:30 +03:00
Code Issues Packages Projects Releases Wiki Activity

Merge 804e2578ed into release/next-userspace

Browse Source
This commit is contained in:
janeway-bot 2021-05-19 21:29:17 +04:00 committed by GitHub
commit 9da9a986e9
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
22 changed files with 855 additions and 341 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
bin/solid.pill
View File

@ -1,3 +1,3 @@
version https://git-lfs.github.com/spec/v1
oid sha256:d7b7cf24e56ab078cf1dcb82e4e7744f188c5221c08772d6cfb15f59ce81aaa5
size 11198219
oid sha256:88acd8aa1aae3d11579ada954b6e0b06c940de7856d22017cc1a1442de97fcf3
size 13650762

2
pkg/arvo/app/dojo.hoon
View File

@ -875,7 +875,7 @@
%ge (dy-run-generator (dy-cage p.p.p.bil) q.p.bil)
%sa
=+ .^(=dais:clay cb+(en-beam he-beak /[p.bil]))
(dy-hand p.bil bunt:dais)
(dy-hand p.bil *vale:dais)
::
%as
=/ cag=cage (dy-cage p.q.bil)

10
pkg/arvo/app/graph-store.hoon
View File

@ -724,7 +724,7 @@
:+ %add-nodes
[ship term]
%- ~(gas by *(map index:store node:store))
%+ turn (tap:orm `graph:store`(subset:orm p.u.graph start end))
%+ turn (tap:orm `graph:store`(lot:orm p.u.graph start end))
|= [=atom =node:store]
^- [index:store node:store]
[~[atom] node]
@ -775,7 +775,7 @@
%+ turn
=- ?.(older (slag (safe-sub (lent -) count) -) (scag count -))
%- tap:orm
%+ subset:orm u.graph
%+ lot:orm u.graph
=/ idx
(snag (dec (lent index)) index)
?:(older [`idx ~] [~ `idx])
@ -826,7 +826,7 @@
:+ %add-nodes
[ship term]
%- ~(gas by *(map index:store node:store))
%+ turn (tap:orm `graph:store`(subset:orm p.children.u.node end start))
%+ turn (tap:orm `graph:store`(lot:orm p.children.u.node end start))
|= [=atom =node:store]
^- [index:store node:store]
[(snoc index atom) node]
@ -840,7 +840,7 @@
=/ update-log=(unit update-log:store) (~(get by update-logs) [ship term])
?~ update-log [~ ~]
:: orm-log is ordered backwards, so swap start and end
``noun+!>((subset:orm-log u.update-log end start))
``noun+!>((lot:orm-log u.update-log end start))
::
[%x %update-log @ @ ~]
=/ =ship (slav %p i.t.t.path)
@ -858,7 +858,7 @@
%+ biff m-update-log
|= =update-log:store
=/ result=(unit [=time =update:store])
(peek:orm-log:store update-log)
(pry:orm-log:store update-log)
(bind result |=([=time update:store] time))
==
::

2
pkg/arvo/app/hark-graph-hook.hoon
View File

@ -256,7 +256,7 @@
=/ graph=graph:graph-store :: graph in subscription is bunted
(get-graph-mop:gra rid)
=/ node=(unit node:graph-store)
(bind (peek:orm:graph-store graph) |=([@ =node:graph-store] node))
(bind (pry:orm:graph-store graph) |=([@ =node:graph-store] node))
=/ assoc=(unit association:metadata)
(peek-association:met %graph rid)
=^ cards state

15
pkg/arvo/gen/hood/fuse.hoon Normal file
View File

@ -0,0 +1,15 @@
:: Kiln: Fuse local desk from (optionally-)foreign sources
::
:::: /hoon/fuse/hood/gen
::
/* help-text %txt /gen/hood/fuse/help/txt
=, clay
::
::::
::
:- %say
|= [[now=@da eny=@uvJ bec=beak] [arg=[?(~ [des=desk bas=beak con=(list [beak germ]) ~])]] ~]
:- %kiln-fuse
?~ arg
((slog (turn `wain`help-text |=(=@t leaf+(trip t)))) ~)
[des bas con]:arg

8
pkg/arvo/gen/hood/fuse/help.txt Normal file
View File

@ -0,0 +1,8 @@
Usage:
|fuse %destination-desk base-beak ~[[source-beak %some-germ] [another-beak %another-germ]]
A fuse replaces the contents of %destination-desk with the merge of the
specified beaks according to their merge strategies. This has no dependence
on the previous state of %destination-desk so any commits/work there will
be overwritten.

6
pkg/arvo/gen/tally.hoon
View File

@ -1,5 +1,5 @@
/- gr=group, md=metadata-store, ga=graph-store
/+ re=resource
/+ re=resource, graph=graph-store
!:
:- %say
|= $: [now=@da eny=@uvJ =beak]
@ -86,9 +86,9 @@
%+ scry update:ga
[%x %graph-store /graph/(scot %p entity.r)/[name.r]/noun]
?> ?=(%add-graph -.q.upd)
=/ mo ((ordered-map atom node:ga) gth)
=* mo orm:graph
=/ week=(list [@da node:ga])
(tap:mo (subset:mo graph.q.upd ~ `(sub now ~d7)))
(tap:mo (lot:mo graph.q.upd ~ `(sub now ~d7)))
:- (lent week)
%~ wyt in
%+ roll week

14
pkg/arvo/lib/hood/kiln.hoon
View File

@ -55,6 +55,12 @@
cas=case ::
gim=?(%auto germ) ::
==
+$ kiln-fuse
$@ ~
$: syd=desk
bas=beak
con=(list [beak germ])
==
--
|= [bowl:gall state]
?> =(src our)
@ -381,6 +387,11 @@
?~ +< abet
abet:abet:(merge:(work syd) ali sud cas gim)
::
++ poke-fuse
|= k=kiln-fuse
?~ k abet
abet:(emit [%pass /kiln/fuse/[syd.k] %arvo %c [%fuse syd.k bas.k con.k]])
::
++ poke-cancel
|= a=@tas
abet:(emit %pass /cancel %arvo %c [%drop a])
@ -430,6 +441,7 @@
%kiln-info =;(f (f !<(_+<.f vase)) poke-info)
%kiln-label =;(f (f !<(_+<.f vase)) poke-label)
%kiln-merge =;(f (f !<(_+<.f vase)) poke-merge)
%kiln-fuse =;(f (f !<(_+<.f vase)) poke-fuse)
%kiln-mount =;(f (f !<(_+<.f vase)) poke-mount)
%kiln-ota =;(f (f !<(_+<.f vase)) poke:update)
%kiln-ota-info =;(f (f !<(_+<.f vase)) poke-ota-info)
@ -489,6 +501,8 @@
++ take |=(way=wire ?>(?=([@ ~] way) (work i.way))) :: general handler
++ take-mere ::
|= [way=wire are=(each (set path) (pair term tang))]
?. ?=([@ ~] way)
abet
abet:abet:(mere:(take way) are)
::
++ take-coup-fancy ::

7
pkg/arvo/lib/language-server/parser.hoon
View File

@ -21,7 +21,10 @@
(most ;~(plug com gaw) taut-rule)
::
%+ rune tis
;~(plug sym ;~(pfix gap fas (more fas urs:ab)))
;~(plug sym ;~(pfix gap stap))
::
%+ rune sig
;~((glue gap) sym wyde:vast stap)
::
%+ rune cen
;~(plug sym ;~(pfix gap ;~(pfix cen sym)))
@ -37,7 +40,7 @@
;~ (glue gap)
sym
;~(pfix cen sym)
;~(pfix fas (more fas urs:ab))
stap
==
::
%+ stag %tssg

2
pkg/arvo/lib/strandio.hoon
View File

@ -490,7 +490,7 @@
=/ m (strand ,vase)
^- form:m
;< =riot:clay bind:m
(warp ship desk ~ %sing %b case /[mak])
(warp ship desk ~ %sing %e case /[mak])
?~ riot
(strand-fail %build-nave >arg< ~)
?> =(%nave p.r.u.riot)

55
pkg/arvo/sys/hoon.hoon
View File

@ -5452,12 +5452,14 @@
:::: 4k: atom printing
::
++ co
!:
~% %co ..co ~
=< |_ lot=coin
++ rear |=(rom=tape rend(rep rom))
++ rent `@ta`(rap 3 rend)
++ rent ~+ `@ta`(rap 3 rend)
++ rend
^- tape
~+
?: ?=(%blob -.lot)
['~' '0' ((v-co 1) (jam p.lot))]
?: ?=(%many -.lot)
@ -5602,18 +5604,17 @@
|= a=dn
?: ?=([%i *] a) (weld ?:(s.a "inf" "-inf") rep)
?: ?=([%n *] a) (weld "nan" rep)
=/ f=(pair tape @)
%. a.a
%+ ed-co(rep ~) [10 1]
|=([a=? b=@ c=tape] [~(d ne b) ?.(a c ['.' c])])
=. e.a (sum:si e.a (sun:si (dec q.f)))
=/ res
%+ weld p.f
?~ e.a
rep
%+ weld ?:((syn:si e.a) "e" "e-")
((d-co 1) (abs:si e.a))
?:(s.a res ['-' res])
=; rep ?:(s.a rep ['-' rep])
=/ f ((d-co 1) a.a)
=^ e e.a
=/ e=@s (sun:si (lent f))
=/ sci :(sum:si e.a e -1)
?: (syn:si (dif:si e.a --3)) [--1 sci] :: 12000 -> 12e3 e>+2
?: !(syn:si (dif:si sci -2)) [--1 sci] :: 0.001 -> 1e-3 e<-2
[(sum:si sci --1) --0] :: 1.234e2 -> '.'@3 -> 123 .4
=? rep !=(--0 e.a)
:(weld ?:((syn:si e.a) "e" "e-") ((d-co 1) (abs:si e.a)))
(weld (ed-co e f) rep)
::
++ s-co
|= esc=(list @) ^- tape
@ -5659,20 +5660,13 @@
:: - used only for @r* floats
::
++ ed-co
|= [[bas=@ min=@] par=$-([? @ tape] tape)]
=| [fir=? cou=@ud]
|= hol=@
^- [tape @]
?: &(=(0 hol) =(0 min))
[rep cou]
=/ [dar=@ rad=@] (dvr hol bas)
%= $
min ?:(=(0 min) 0 (dec min))
hol dar
rep (par &(=(0 dar) !fir) rad rep)
fir |
cou +(cou)
==
|= [exp=@s int=tape] ^- tape
=/ [pos=? dig=@u] [=(--1 (cmp:si exp --0)) (abs:si exp)]
?. pos
(into (weld (reap +(dig) '0') int) 1 '.')
=/ len (lent int)
?: (lth dig len) (into int dig '.')
(weld int (reap (sub dig len) '0'))
::
:: +ox-co: format '.'-separated digit sequences in numeric base
::
@ -5965,9 +5959,8 @@
::
++ spat |=(pax=path (crip (spud pax))) :: render path to cord
++ spud |=(pax=path ~(ram re (smyt pax))) :: render path to tape
++ stab :: parse cord to path
=+ fel=;~(pfix fas (more fas urs:ab))
|=(zep=@t `path`(rash zep fel))
++ stab |=(zep=@t `path`(rash zep stap)) :: parse cord to path
++ stap ;~(pfix fas (more fas urs:ab)) :: path parser
::
:::: 4n: virtualization
::
@ -6627,7 +6620,7 @@
+$ seminoun
:: partial noun; blocked subtrees are ~
::
$~ [[%full ~] ~]
$~ [[%full / ~ ~] ~]
[mask=stencil data=noun]
::
:: +stencil: noun knowledge map

9
pkg/arvo/sys/lull.hoon
View File

@ -762,6 +762,11 @@
her=@p dem=desk cas=case :: source
how=germ :: method
== ::
$: %fuse :: merge many
des=desk :: target desk
bas=beak :: base desk
con=(list [beak germ]) :: merges
==
[%mont pot=term bem=beam] :: mount to unix
[%dirk des=desk] :: mark mount dirty
[%ogre pot=$@(desk beam)] :: delete mount point
@ -928,6 +933,7 @@
:: /- sur-file :: surface imports from /sur
:: /+ lib-file :: library imports from /lib
:: /= face /path :: imports built hoon file at path
:: /~ face type /path :: imports built hoon files from directory
:: /% face %mark :: imports mark definition from /mar
:: /$ face %from %to :: imports mark converter from /mar
:: /* face %mark /path :: unbuilt file imports, as mark
@ -936,6 +942,7 @@
$: sur=(list taut)
lib=(list taut)
raw=(list [face=term =path])
raz=(list [face=term =spec =path])
maz=(list [face=term =mark])
caz=(list [face=term =mars])
bar=(list [face=term =mark =path])
@ -955,7 +962,6 @@
$_
^?
|%
++ bunt *typ
++ diff |~([old=typ new=typ] *dif)
++ form *mark
++ join |~([a=dif b=dif] *(unit (unit dif)))
@ -970,7 +976,6 @@
+$ dais
$_ ^|
|_ sam=vase
++ bunt sam
++ diff |~(new=_sam *vase)
++ form *mark
++ join |~([a=vase b=vase] *(unit (unit vase)))

36
pkg/arvo/sys/vane/ames.hoon
View File

@ -1944,11 +1944,11 @@
=/ =bone bone.shut-packet
::
?: ?=(%& -.meat.shut-packet)
=+ ?~ dud ~
=+ ?. &(?=(^ dud) msg.veb) ~
%. ~
%+ slog
leaf+"ames: {<her.channel>} fragment crashed {<mote.u.dud>}"
?.(msg.veb ~ tang.u.dud)
%- slog
:_ tang.u.dud
leaf+"ames: {<her.channel>} fragment crashed {<mote.u.dud>}"
(run-message-sink bone %hear lane shut-packet ?=(~ dud))
:: Just try again on error, printing trace
::
@ -1967,20 +1967,12 @@
++ on-memo
|= [=bone payload=* valence=?(%plea %boon)]
^+ peer-core
:: if we haven't been trying to talk to %live, reset timer
::
=? last-contact.qos.peer-state
?& ?=(%live -.qos.peer-state)
%- ~(all by snd.peer-state)
|= =message-pump-state
=(~ live.packet-pump-state.message-pump-state)
==
now
::
=/ =message-blob (dedup-message (jim payload))
=. peer-core (run-message-pump bone %memo message-blob)
::
?: &(=(%boon valence) ?=(?(%dead %unborn) -.qos.peer-state))
?: ?& =(%boon valence)
(gte now (add ~s30 last-contact.qos.peer-state))
==
check-clog
peer-core
:: +dedup-message: replace with any existing copy of this message
@ -2535,7 +2527,7 @@
++ assert
^+ message-pump
=/ top-live
(peek:packet-queue:*make-packet-pump live.packet-pump-state.state)
(pry:packet-queue:*make-packet-pump live.packet-pump-state.state)
?. |(?=(~ top-live) (lte current.state message-num.key.u.top-live))
~| [%strange-current current=current.state key.u.top-live]
!!
@ -2603,7 +2595,7 @@
=| acc=(unit static-fragment)
^+ [static-fragment=acc live=live.state]
::
%^ (traverse:packet-queue _acc) live.state acc
%^ (dip:packet-queue _acc) live.state acc
|= $: acc=_acc
key=live-packet-key
val=live-packet-val
@ -2681,7 +2673,7 @@
=/ acc
resends=*(list static-fragment)
::
%^ (traverse:packet-queue _acc) live.state acc
%^ (dip:packet-queue _acc) live.state acc
|= $: acc=_acc
key=live-packet-key
val=live-packet-val
@ -2734,7 +2726,7 @@
::
^+ [acc live=live.state]
::
%^ (traverse:packet-queue _acc) live.state acc
%^ (dip:packet-queue _acc) live.state acc
|= $: acc=_acc
key=live-packet-key
val=live-packet-val
@ -2781,7 +2773,7 @@
::
^+ [metrics=metrics.state live=live.state]
::
%^ (traverse:packet-queue pump-metrics) live.state acc=metrics.state
%^ (dip:packet-queue pump-metrics) live.state acc=metrics.state
|= $: metrics=pump-metrics
key=live-packet-key
val=live-packet-val
@ -2804,10 +2796,10 @@
::
++ set-wake
^+ packet-pump
:: if nonempty .live, peek at head to get next wake time
:: if nonempty .live, pry at head to get next wake time
::
=/ new-wake=(unit @da)
?~ head=(peek:packet-queue live.state)
?~ head=(pry:packet-queue live.state)
~
`(next-expiry:gauge u.head)
:: no-op if no change

4
pkg/arvo/sys/vane/behn.hoon
View File

@ -186,7 +186,7 @@
=* timers timers.state
:: if no timers, cancel existing wakeup timer or no-op
::
=/ first=(unit [date=@da *]) (peek:timer-map timers.state)
=/ first=(unit [date=@da *]) (pry:timer-map timers.state)
?~ first
?~ next-wake
event-core
@ -351,7 +351,7 @@
[%timers %next ~]
:^ ~ ~ %noun
!> ^- (unit @da)
(bind (peek:timer-map timers) head)
(bind (pry:timer-map timers) head)
::
[%timers @ ~]
?~ til=(slaw %da i.t.tyl)

515
pkg/arvo/sys/vane/clay.hoon
View File

@ -59,6 +59,12 @@
::
+$ cult (jug wove duct)
::
:: State for ongoing %fuse merges. `con` maintains the ordering,
:: `sto` stores the data needed to merge, and `bas` is the base
:: beak for the merge.
::
+$ melt [bas=beak con=(list [beak germ]) sto=(map beak (unit dome:clay))]
::
:: Domestic desk state.
::
:: Includes subscriber list, dome (desk content), possible commit state (for
@ -69,6 +75,7 @@
dom=dome :: desk state
per=regs :: read perms per path
pew=regs :: write perms per path
fiz=melt :: state for mega merges
==
::
:: Desk state.
@ -118,11 +125,11 @@
:: Ford cache
::
+$ ford-cache
$: files=(map path [res=vase dez=(set path)])
naves=(map mark [res=vase dez=(set path)])
marks=(map mark [res=dais dez=(set path)])
casts=(map mars [res=vase dez=(set path)])
tubes=(map mars [res=tube dez=(set path)])
$: files=(map path [res=vase dez=(set [dir=? =path])])
naves=(map mark [res=vase dez=(set [dir=? =path])])
marks=(map mark [res=dais dez=(set [dir=? =path])])
casts=(map mars [res=vase dez=(set [dir=? =path])])
tubes=(map mars [res=tube dez=(set [dir=? =path])])
==
:: $reef-cache: built system files
::
@ -212,6 +219,7 @@
dom=dome :: revision state
per=regs :: read perms per path
pew=regs :: write perms per path
fiz=melt :: domestic mega merges
== ::
::
:: Foreign request manager.
@ -303,6 +311,7 @@
$: %c :: to %clay
$> $? %info :: internal edit
%merg :: merge desks
%fuse :: merge many
%pork ::
%warp ::
%werp ::
@ -428,18 +437,23 @@
::
++ an
|_ nak=ankh
:: +dug: produce ankh at path
::
++ dug
|= =path
^- (unit ankh)
?~ path `nak
?~ kid=(~(get by dir.nak) i.path)
~
$(nak u.kid, path t.path)
:: +get: produce file at path
::
++ get
|= =path
^- (unit cage)
?~ path
?~ fil.nak
~
`q.u.fil.nak
?~ kid=(~(get by dir.nak) i.path)
~
$(nak u.kid, path t.path)
?~ nik=(dug path) ~
?~ fil.u.nik ~
`q.u.fil.u.nik
--
++ with-face |=([face=@tas =vase] vase(p [%face face p.vase]))
++ with-faces
@ -472,7 +486,7 @@
+$ state
$: baked=(map path cage)
cache=ford-cache
stack=(list (set path))
stack=(list (set [dir=? =path]))
cycle=(set build)
==
+$ args
@ -493,8 +507,8 @@
:: +pop-stack: pop build stack, copying deps downward
::
++ pop-stack
^- [(set path) _stack.nub]
=^ top=(set path) stack.nub stack.nub
^- [(set [dir=? =path]) _stack.nub]
=^ top=(set [dir=? =path]) stack.nub stack.nub
=? stack.nub ?=(^ stack.nub)
stack.nub(i (~(uni in i.stack.nub) top))
[top stack.nub]
@ -559,7 +573,6 @@
=/ dif diff:deg
^- (nave typ dif)
|%
++ bunt +<.cor
++ diff
|= [old=typ new=typ]
^- dif
@ -581,7 +594,6 @@
=/ dif _*diff:grad:cor
^- (nave:clay typ dif)
|%
++ bunt +<.cor
++ diff |=([old=typ new=typ] (diff:~(grad cor old) new))
++ form form:grad:cor
++ join
@ -622,7 +634,6 @@
:_ nub
^- dais
|_ sam=vase
++ bunt (slap nav limb/%bunt)
++ diff
|= new=vase
(slam (slap nav limb/%diff) (slop sam new))
@ -649,7 +660,7 @@
|= diff=vase
(slam (slap nav limb/%pact) (slop sam diff))
++ vale
|= =noun
|: noun=q:(slap nav !,(*hoon *vale))
(slam (slap nav limb/%vale) noun/noun)
--
:: +build-cast: produce gate to convert mark .a to, statically typed
@ -805,9 +816,11 @@
=^ res=vase nub (run-pile pile)
res
::
++ build-file
|= =path
++ build-dependency
|= dep=(each [dir=path fil=path] path)
^- [vase state]
=/ =path
?:(?=(%| -.dep) p.dep fil.p.dep)
~| %error-building^path
?^ got=(~(get by files.cache.nub) path)
=? stack.nub ?=(^ stack.nub)
@ -816,7 +829,9 @@
?: (~(has in cycle.nub) file+path)
~|(cycle+file+path^stack.nub !!)
=. cycle.nub (~(put in cycle.nub) file+path)
=. stack.nub [(sy path ~) stack.nub]
=. stack.nub
=- [(sy - ~) stack.nub]
?:(?=(%| -.dep) dep [& dir.p.dep])
=^ cag=cage nub (read-file path)
?> =(%hoon p.cag)
=/ tex=tape (trip !<(@t q.cag))
@ -826,11 +841,42 @@
=. files.cache.nub (~(put by files.cache.nub) path [res top])
[res nub]
::
++ build-file
|= =path
(build-dependency |+path)
:: +build-directory: builds files in top level of a directory
::
:: this excludes files directly at /path/hoon,
:: instead only including files in the unix-style directory at /path,
:: such as /path/file/hoon, but not /path/more/file/hoon.
::
++ build-directory
|= =path
^- [(map @ta vase) state]
=/ fiz=(list @ta)
=/ nuk=(unit _ankh) (~(dug an ankh) path)
?~ nuk ~
%+ murn
~(tap by dir.u.nuk)
|= [nom=@ta nak=_ankh]
?. ?=([~ [~ *] *] (~(get by dir.nak) %hoon)) ~
`nom
::
=| rez=(map @ta vase)
|-
?~ fiz
[rez nub]
=* nom=@ta i.fiz
=/ pax=^path (weld path nom %hoon ~)
=^ res nub (build-dependency &+[path pax])
$(fiz t.fiz, rez (~(put by rez) nom res))
::
++ run-pile
|= =pile
=^ sut=vase nub (run-tauts bud %sur sur.pile)
=^ sut=vase nub (run-tauts sut %lib lib.pile)
=^ sut=vase nub (run-raw sut raw.pile)
=^ sut=vase nub (run-raz sut raz.pile)
=^ sut=vase nub (run-maz sut maz.pile)
=^ sut=vase nub (run-caz sut caz.pile)
=^ sut=vase nub (run-bar sut bar.pile)
@ -869,7 +915,10 @@
(most ;~(plug com gaw) taut-rule)
::
%+ rune tis
;~(plug sym ;~(pfix gap fas (more fas urs:ab)))
;~(plug sym ;~(pfix gap stap))
::
%+ rune sig
;~((glue gap) sym wyde:vast stap)
::
%+ rune cen
;~(plug sym ;~(pfix gap ;~(pfix cen sym)))
@ -885,7 +934,7 @@
;~ (glue gap)
sym
;~(pfix cen sym)
;~(pfix fas (more fas urs:ab))
;~(pfix stap)
==
::
%+ stag %tssg
@ -931,6 +980,30 @@
=. p.pin [%face face.i.raw p.pin]
$(sut (slop pin sut), raw t.raw)
::
++ run-raz
|= [sut=vase raz=(list [face=term =spec =path])]
^- [vase state]
?~ raz [sut nub]
=^ res=(map @ta vase) nub
(build-directory path.i.raz)
=; pin=vase
=. p.pin [%face face.i.raz p.pin]
$(sut (slop pin sut), raz t.raz)
::
=/ =type (~(play ut p.sut) [%kttr spec.i.raz])
:: ensure results nest in the specified type,
:: and produce a homogenous map containing that type.
::
:- %- ~(play ut p.sut)
[%kttr %make [%wing ~[%map]] ~[[%base %atom %ta] spec.i.raz]]
|-
?~ res ~
?. (~(nest ut type) | p.q.n.res)
~| [%nest-fail path.i.raz p.n.res]
!!
:- [p.n.res q.q.n.res]
[$(res l.res) $(res r.res)]
::
++ run-maz
|= [sut=vase maz=(list [face=term =mark])]
^- [vase state]
@ -1043,12 +1116,12 @@
~
=/ rus rus:(~(gut by hoy.ruf) her *rung)
%+ ~(gut by rus) syd
[lim=~2000.1.1 ref=`*rind qyx=~ dom=*dome per=~ pew=~]
[lim=~2000.1.1 ref=`*rind qyx=~ dom=*dome per=~ pew=~ fiz=*melt]
:: administrative duct, domestic +rede
::
:+ ~ `hun.rom.ruf
=/ jod (~(gut by dos.rom.ruf) syd *dojo)
[lim=now ref=~ [qyx dom per pew]:jod]
[lim=now ref=~ [qyx dom per pew fiz]:jod]
::
=* red=rede ->+
|%
@ -1065,7 +1138,7 @@
::
%= ruf
hun.rom (need hun)
dos.rom (~(put by dos.rom.ruf) syd [qyx dom per pew]:red)
dos.rom (~(put by dos.rom.ruf) syd [qyx dom per pew fiz]:red)
==
::
:: Handle `%sing` requests
@ -1256,6 +1329,24 @@
=/ =path [%question desk (scot %ud index) ~]
(emit duct %pass wire %a %plea ship %c path `riff-any`[%1 riff])
::
++ foreign-capable
|= =rave
|^
?- -.rave
%many &
%sing (good-care care.mood.rave)
%next (good-care care.mood.rave)
%mult
%- ~(all in paths.mool.rave)
|= [=care =path]
(good-care care)
==
::
++ good-care
|= =care
(~(has in ^~((silt `(list ^care)`~[%u %w %x %y %z]))) care)
--
::
:: Create a request that cannot be filled immediately.
::
:: If it's a local request, we just put in in `qyx`, setting a timer if it's
@ -1275,6 +1366,10 @@
=. rave
?. ?=([%sing %v *] rave) rave
[%many %| [%ud let.dom] case.mood.rave path.mood.rave]
::
?. (foreign-capable rave)
~|([%clay-bad-foreign-request-care rave] !!)
::
=+ inx=nix.u.ref
=. +>+.$
=< ?>(?=(^ ref) .)
@ -1582,12 +1677,19 @@
::
++ invalidate
|* [key=mold value=mold]
|= [cache=(map key [value dez=(set path)]) invalid=(set path)]
=/ builds=(list [key value dez=(set path)]) ~(tap by cache)
|= [cache=(map key [value dez=(set [dir=? =path])]) invalid=(set path)]
=/ builds=(list [key value dez=(set [dir=? =path])])
~(tap by cache)
|- ^+ cache
?~ builds
~
?: ?=(^ (~(int in dez.i.builds) invalid))
?: %- ~(any in dez.i.builds)
|= [dir=? =path]
?. dir (~(has in invalid) path)
=+ l=(lent path)
%- ~(any in invalid)
|= i=^path
&(=(path (scag l i)) ?=([@ %hoon ~] (slag l i)))
$(builds t.builds)
(~(put by $(builds t.builds)) i.builds)
::
@ -1962,32 +2064,178 @@
=/ =wire /merge/[syd]/(scot %p ali-ship)/[ali-desk]/[germ]
(emit hen %pass wire %c %warp ali-ship ali-desk `[%sing %v case /])
::
++ make-melt
|= [bas=beak con=(list [beak germ])]
^- melt
:+ bas con
%- ~(gas by *(map beak (unit dome:clay)))
:- [bas *(unit dome:clay)]
(turn con |=(a=[beak germ] [-.a *(unit dome:clay)]))
::
++ start-fuse
|= [bas=beak con=(list [beak germ])]
^+ ..start-fuse
=/ moves=(list move)
%+ turn
[[bas *germ] con]
|= [bec=beak germ]
^- move
=/ wir=wire /fuse/[syd]/(scot %p p.bec)/[q.bec]/(scot r.bec)
[hen %pass wir %c %warp p.bec q.bec `[%sing %v r.bec /]]
::
:: We also want to clear the state (fiz) associated with this
:: merge and print a warning if it's non trivial i.e. we're
:: starting a new fuse before the previous one terminated.
::
=/ err=tang
?~ con.fiz
~
=/ discarded=tang
%+ turn
~(tap in sto.fiz)
|= [k=beak v=(unit dome:clay)]
^- tank
=/ received=tape ?~(v "missing" "received")
leaf+"{<k>} {received}"
:_ discarded
leaf+"fusing into {<syd>} from {<bas>} {<con>} - overwriting prior fuse"
=. fiz (make-melt bas con)
((slog err) (emil moves))
::
++ take-fuse
|^
::
|= [bec=beak =riot]
^+ ..take-fuse
?~ riot
::
:: By setting fiz to *melt the merge is aborted - any further
:: responses we get for the merge will cause take-fuse to crash
::
=. fiz *melt
((slog [leaf+"clay: fuse failed, missing {<bec>}"]~) ..take-fuse)
?> (~(has by sto.fiz) bec)
=. fiz
:+ bas.fiz con.fiz
(~(put by sto.fiz) bec `!<(dome:clay q.r.u.riot))
=/ all-done=flag
%- ~(all by sto.fiz)
|= res=(unit dome:clay)
^- flag
!=(res ~)
?. all-done
..take-fuse
=| rag=rang
=/ clean-state ..take-fuse
=/ initial-dome=dome:clay (need (~(got by sto.fiz) bas.fiz))
=/ continuation-yaki=yaki
(~(got by hut.ran) (~(got by hit.initial-dome) let.initial-dome))
=/ parents=(list tako) ~[(~(got by hit.initial-dome) let.initial-dome)]
=/ merges con.fiz
|-
^+ ..take-fuse
?~ merges
=/ t=tang [leaf+"{<syd>} fused from {<bas.fiz>} {<con.fiz>}" ~]
=. ..take-fuse (done-fuse clean-state %& ~)
(park | [%| continuation-yaki(p (flop parents))] rag)
=/ [bec=beak g=germ] i.merges
=/ ali-dom=dome:clay (need (~(got by sto.fiz) bec))
=/ result (merge-helper p.bec q.bec g ali-dom `continuation-yaki)
?- -.result
%|
(done-fuse clean-state %| %fuse-merge-failed p.result)
::
%&
=/ merge-result=(unit merge-result) +.result
?~ merge-result
::
:: This merge was a no-op, just continue
::
$(merges t.merges)
?^ conflicts.u.merge-result
::
:: If there are merge conflicts send the error and abort the merge
::
(done-fuse clean-state %& conflicts.u.merge-result)
=/ merged-yaki=yaki
?- -.new.u.merge-result
%|
+.new.u.merge-result
::
%&
::
:: Convert the yuki to yaki
::
=/ yuk=yuki +.new.u.merge-result
=/ lobes=(map path lobe)
%- ~(run by q.yuk)
|= val=(each page lobe)
^- lobe
?- -.val
%& (page-to-lobe +.val)
%| +.val
==
(make-yaki p.yuk lobes now)
==
%= $
continuation-yaki merged-yaki
merges t.merges
hut.ran (~(put by hut.ran) r.merged-yaki merged-yaki)
lat.rag (~(uni by lat.rag) lat.u.merge-result)
parents [(~(got by hit.ali-dom) let.ali-dom) parents]
==
==
:: +done-fuse: restore state after a fuse is attempted, whether it
:: succeeds or fails.
::
++ done-fuse
|= [to-restore=_..take-fuse result=(each (set path) (pair term tang))]
^+ ..take-fuse
=. fiz.to-restore *melt
(done:to-restore result)
--
::
++ done
|= result=(each (set path) (pair term tang))
^+ ..merge
(emit hen %give %mere result)
::
++ merge
|= [=ali=ship =ali=desk =germ =riot]
^+ ..merge
|^
?~ riot
(done %| %ali-unavailable >[ali-ship ali-desk germ]< ~)
(done %| %ali-unavailable ~[>[ali-ship ali-desk germ]<])
=/ ali-dome=dome:clay !<(dome:clay q.r.u.riot)
=/ result=(each (unit merge-result) (pair term tang))
(merge-helper ali-ship ali-desk germ ali-dome ~)
?- -.result
%|
(done %| +.result)
::
%&
=/ mr=(unit merge-result) +.result
?~ mr
(done %& ~)
=. ..merge (done %& conflicts.u.mr)
(park | new.u.mr ~ lat.u.mr)
==
::
+$ merge-result [conflicts=(set path) new=yoki lat=(map lobe blob)]
::
++ merge-helper
|= [=ali=ship =ali=desk =germ ali-dome=dome:clay continuation-yaki=(unit yaki)]
^- (each (unit merge-result) [term tang])
|^
^- (each (unit merge-result) [term tang])
=/ ali-yaki=yaki (~(got by hut.ran) (~(got by hit.ali-dome) let.ali-dome))
=/ bob-yaki=(unit yaki)
?~ let.dom
~
(~(get by hut.ran) (~(got by hit.dom) let.dom))
=/ merge-result (merge-by-germ ali-yaki bob-yaki)
?: ?=(%| -.merge-result)
(done %| p.merge-result)
?~ p.merge-result
(done %& ~)
=. ..merge (done %& conflicts.u.p.merge-result)
(park | new.u.p.merge-result ~ lat.u.p.merge-result)
?~ continuation-yaki
?~ let.dom
~
(~(get by hut.ran) (~(got by hit.dom) let.dom))
continuation-yaki
(merge-by-germ ali-yaki bob-yaki)
::
++ done
|= result=(each (set path) (pair term tang))
^+ ..merge
(emit hen %give %mere result)
::
+$ merge-result [conflicts=(set path) new=yoki lat=(map lobe blob)]
++ merge-by-germ
|= [=ali=yaki bob-yaki=(unit yaki)]
^- (each (unit merge-result) [term tang])
@ -2005,16 +2253,13 @@
?- germ
::
:: If this is a %only-this merge, we check to see if ali's and bob's
:: commits are the same, in which case we're done. Otherwise, we
:: check to see if ali's commit is in the ancestry of bob's, in
:: which case we're done. Otherwise, we create a new commit with
:: bob's data plus ali and bob as parents.
:: commits are the same, in which case we're done.
:: Otherwise, we create a new commit with bob's data plus ali and
:: bob as parents.
::
%only-this
?: =(r.ali-yaki r.bob-yaki)
&+~
?: (~(has in (reachable-takos:ze r.bob-yaki)) r.ali-yaki)
&+~
:* %& ~
conflicts=~
new=&+[[r.bob-yaki r.ali-yaki ~] (to-yuki q.bob-yaki)]
@ -2042,8 +2287,6 @@
%take-this
?: =(r.ali-yaki r.bob-yaki)
&+~
?: (~(has in (reachable-takos:ze r.bob-yaki)) r.ali-yaki)
&+~
=/ new-data (~(uni by q.ali-yaki) q.bob-yaki)
:* %& ~
conflicts=~
@ -2313,7 +2556,7 @@
=+ (slag (dec (lent path)) path)
?~(- %$ i.-)
=/ =dais (get-dais mark)
=/ res=(unit (unit vase)) (~(join dais bunt:dais) q.cal q.cob)
=/ res=(unit (unit vase)) (~(join dais *vale:dais) q.cal q.cob)
?~ res
`[form:dais q.cob]
?~ u.res
@ -2665,6 +2908,9 @@
++ start-request
|= [for=(unit [ship @ud]) rav=rave]
^+ ..start-request
?: &(?=(^ for) !(foreign-capable rav))
~& [%bad-foreign-request-care from=for rav]
..start-request
=^ [new-sub=(unit rove) sub-results=(list sub-result)] fod.dom
(try-fill-sub for (rave-to-rove rav))
=. ..start-request (send-sub-results sub-results [hen ~ ~])
@ -2721,14 +2967,23 @@
%r ~| %no-cages-please-they-are-just-way-too-big !!
%s ~| %please-dont-get-your-takos-over-a-network !!
%t ~| %requesting-foreign-directory-is-vaporware !!
%u ~| %prolly-poor-idea-to-get-rang-over-network !!
%v ~| %weird-shouldnt-get-v-request-from-network !!
%z `(validate-z r.rand)
%u `(validate-u r.rand)
%w `(validate-w r.rand)
%x (validate-x [p.p q.p q r]:rand)
%y `[p.r.rand !>(;;(arch q.r.rand))]
%z `(validate-z r.rand)
==
::
:: Make sure the incoming data is a %u response
::
++ validate-u
|= =page
^- cage
?> ?=(%flag p.page)
:- p.page
!> ;;(? q.page)
::
:: Make sure the incoming data is a %w response
::
++ validate-w
@ -2749,7 +3004,11 @@
=/ vale-result
%- mule |.
%- wrap:fusion
(page-to-cage:(ford:fusion static-ford-args) peg)
:: Use %home's marks to validate, so we don't have to build the
:: foreign hoon/zuse
::
=/ args %*(static-ford-args . dom dom:(~(got by dos.rom) %home))
(page-to-cage:(ford:fusion args) peg)
?: ?=(%| -.vale-result)
%- (slog >%validate-x-failed< p.vale-result)
~
@ -2762,7 +3021,7 @@
^- cage
?> ?=(%uvi p.page)
:- p.page
!>(;;(@uvI q.page))
!> ;;(@uvI q.page)
--
::
:: Respond to backfill request
@ -3391,12 +3650,29 @@
|-
?: =(b let.dom)
hit.dom
:: del everything after b
$(hit.dom (~(del by hit.dom) let.dom), let.dom (dec let.dom))
b
?: =(0 b)
[~ ~]
(data-twixt-takos =(0 ver) (~(get by hit.dom) a) (aeon-to-tako b))
::
=/ excludes=(set tako)
=| acc=(set tako)
=/ lower=@ud 1
|-
:: a should be excluded, so wait until we're past it
?: =(lower +(a))
acc
=/ res=(set tako) (reachable-takos (~(got by hit.dom) lower))
$(acc (~(uni in acc) res), lower +(lower))
=/ includes=(set tako)
=| acc=(set tako)
=/ upper=@ud b
|-
?: =(upper a)
acc
=/ res=(set tako) (reachable-takos (~(got by hit.dom) upper))
$(acc (~(uni in acc) res), upper (dec upper))
[(~(run in (~(dif in includes) excludes)) tako-to-yaki) ~]
:: Traverse parentage and find all ancestor hashes
::
++ reachable-takos :: reachable
@ -3415,30 +3691,6 @@
=. s ^$(p i.p.y)
$(p.y t.p.y)
::
:: Gets the data between two commit hashes, assuming the first is an
:: ancestor of the second.
::
:: Get all the takos before `a`, then get all takos before `b` except the
:: ones we found before `a`. Then convert the takos to yakis and also get
:: all the data in all the yakis.
::
:: What happens if you run an %init merge on a desk that already
:: had a commit?
::
++ data-twixt-takos
|= [plops=? a=(unit tako) b=tako]
^- [(set yaki) (set plop)]
=+ old=?~(a ~ (reachable-takos u.a))
=/ yal=(set tako)
%- silt
%+ skip
~(tap in (reachable-takos b))
|=(tak=tako (~(has in old) tak))
:- (silt (turn ~(tap in yal) tako-to-yaki))
?. plops
~
(silt (turn ~(tap in (new-lobes (new-lobes ~ old) yal)) lobe-to-blob))
::
:: Get all the lobes that are referenced in `a` except those that are
:: already in `b`.
::
@ -3528,11 +3780,11 @@
[[~ ~] fod.dom]
=/ cached=(unit [=vase *]) (~(get by naves.fod.dom) i.path)
?^ cached
:_(fod.dom [~ ~ %& %nave !>(vase.u.cached)])
:_(fod.dom [~ ~ %& %nave vase.u.cached])
=^ =vase fod.dom
%- wrap:fusion
(build-nave:(ford:fusion static-ford-args) i.path)
:_(fod.dom [~ ~ %& %nave !>(vase)])
:_(fod.dom [~ ~ %& %nave vase])
::
++ read-f
!.
@ -3958,12 +4210,14 @@
::
::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
=| :: instrument state
$: ver=%7 :: vane version
$: ver=%8 :: vane version
ruf=raft :: revision tree
== ::
|= [now=@da eny=@uvJ rof=roof] :: current invocation
~% %clay-top ..part ~
|% ::
++ call :: handle request
~/ %clay-call
|= $: hen=duct
dud=(unit goof)
wrapped-task=(hobo task)
@ -4074,6 +4328,14 @@
=/ den ((de now rof hen ruf) our des.req)
abet:(start-merge:den her.req dem.req cas.req how.req)
[mos ..^$]
::
%fuse
?: =(%$ des.req)
~&(%fuse-no-desk !!)
=^ mos ruf
=/ den ((de now rof hen ruf) our des.req)
abet:(start-fuse:den bas.req con.req)
[mos ..^$]
::
%mont
=. hez.ruf ?^(hez.ruf hez.ruf `[[%$ %sync ~] ~])
@ -4202,11 +4464,41 @@
++ load
=> |%
+$ raft-any
$% [%7 raft-7]
$% [%8 raft-8]
[%7 raft-7]
[%6 raft-6]
==
+$ raft-7 raft
+$ dojo-7 dojo
+$ raft-8 raft
+$ raft-7
$: rom=room-7
hoy=(map ship rung-7)
ran=rang
mon=(map term beam)
hez=(unit duct)
cez=(map @ta crew)
pud=(unit [=desk =yoki])
==
+$ room-7
$: hun=duct
dos=(map desk dojo-7)
==
+$ rung-7
$: rus=(map desk rede-7)
==
+$ dojo-7
$: qyx=cult
dom=dome
per=regs
pew=regs
==
+$ rede-7
$: lim=@da
ref=(unit rind)
qyx=cult
dom=dome
per=regs
pew=regs
==
+$ ford-cache-7 ford-cache
+$ raft-6
$: rom=room-6 :: domestic
@ -4249,7 +4541,8 @@
|= old=raft-any
|^
=? old ?=(%6 -.old) 7+(raft-6-to-7 +.old)
?> ?=(%7 -.old)
=? old ?=(%7 -.old) 8+(raft-7-to-8 +.old)
?> ?=(%8 -.old)
..^^$(ruf +.old)
:: +raft-6-to-7: delete stale ford caches (they could all be invalid)
::
@ -4270,9 +4563,30 @@
|= =rede-6
rede-6(dom dom.rede-6(fod *ford-cache-7))
==
:: +raft-7-to-8: create bunted melts in each dojo/rede
::
++ raft-7-to-8
|= raf=raft-7
^- raft-8
%= raf
dos.rom
%- ~(run by dos.rom.raf)
|= doj=dojo-7
^- dojo
[qyx.doj dom.doj per.doj pew.doj *melt]
::
hoy
%- ~(run by hoy.raf)
|= =rung-7
%- ~(run by rus.rung-7)
|= r=rede-7
^- rede
[lim.r ref.r qyx.r dom.r per.r pew.r *melt]
==
--
::
++ scry :: inspect
~/ %clay-scry
^- roon
|= [lyc=gang car=term bem=beam]
^- (unit (unit cage))
@ -4334,6 +4648,7 @@
==
::
++ take :: accept response
~/ %clay-take
|= [tea=wire hen=duct dud=(unit goof) hin=sign]
^+ [*(list move) ..^$]
?^ dud
@ -4350,6 +4665,18 @@
abet:(merge:den ali-ship ali-desk germ p.hin)
[mos ..^$]
::
?: ?=([%fuse @ @ @ @ ~] tea)
?> ?=(%writ +<.hin)
=* syd i.t.tea
=/ ali-ship=@p (slav %p i.t.t.tea)
=* ali-desk=desk i.t.t.t.tea
=/ ali-case (rash i.t.t.t.t.tea nuck:so)
?> ?=([%$ *] ali-case)
=^ mos ruf
=/ den ((de now rof hen ruf) our i.t.tea)
abet:(take-fuse:den [ali-ship ali-desk (case +.ali-case)] p.hin)
[mos ..^$]
::
?: ?=([%foreign-warp *] tea)
?> ?=(%writ +<.hin)
:_ ..^$

13
pkg/arvo/sys/vane/eyre.hoon
View File

@ -215,7 +215,7 @@
?: =('subscribe' u.maybe-key)
%. item
%+ pe %subscribe
(ot id+ni ship+(su fed:ag) app+so path+(su ;~(pfix fas (more fas urs:ab))) ~)
(ot id+ni ship+(su fed:ag) app+so path+(su stap) ~)
?: =('unsubscribe' u.maybe-key)
%. item
%+ pe %unsubscribe
@ -426,10 +426,12 @@
:- ~
%- as-octs:mimes:html
%- crip
%- zing
%- zing ^- ^wall
%- zing ^- (list ^wall)
%+ turn wall
|= t=tape
"{t}\0a"
^- ^wall
~[t "\0a"]
:: +internal-server-error: 500 page, with a tang
::
++ internal-server-error
@ -1598,6 +1600,7 @@
:: +channel-event-to-sign: attempt to recover a sign from a channel-event
::
++ channel-event-to-sign
~% %eyre-channel-event-to-sign ..part ~
|= event=channel-event
^- (unit sign:agent:gall)
?. ?=(%fact -.event) `event
@ -1678,6 +1681,7 @@
==
::
++ event-json-to-wall
~% %eyre-json-to-wall ..part ~
|= [event-id=@ud =json]
^- wall
:~ (weld "id: " (format-ud-as-integer event-id))
@ -2095,6 +2099,7 @@
~% %http-server ..part ~
|%
++ call
~/ %eyre-call
|= [=duct dud=(unit goof) wrapped-task=(hobo task)]
^- [(list move) _http-server-gate]
::
@ -2297,6 +2302,7 @@
==
::
++ take
~/ %eyre-take
|= [=wire =duct dud=(unit goof) =sign]
^- [(list move) _http-server-gate]
?^ dud
@ -2484,6 +2490,7 @@
:: +scry: request a path in the urbit namespace
::
++ scry
~/ %eyre-scry
^- roon
|= [lyc=gang car=term bem=beam]
^- (unit (unit cage))

1
pkg/arvo/sys/vane/gall.hoon
View File

@ -646,6 +646,7 @@
:: cleared queue in +load 3-to-4 or +load-4-to-5
::
=? stand ?=(~ stand)
~& [%gall-missing wire hen]
(~(put to *(qeu remote-request)) %missing)
~| [full-wire=full-wire hen=hen stand=stand]
=^ rr stand ~(get to stand)

354
pkg/arvo/sys/zuse.hoon
View File

@ -3286,7 +3286,7 @@
++ ship :: string from ship
|= a=^ship
^- json
(tape (slag 1 (scow %p a)))
[%n (rap 3 '"' (rsh [3 1] (scot %p a)) '"' ~)]
:: :: ++numb:enjs:format
++ numb :: number from unsigned
|= a=@u
@ -3458,7 +3458,7 @@
[(rash a fel) b]
:: :: ++pa:dejs:format
++ pa :: string as path
(su ;~(pfix fas (more fas urs:ab)))
(su stap)
:: :: ++pe:dejs:format
++ pe :: prefix
|* [pre=* wit=fist]
@ -5070,36 +5070,54 @@
|= ord=$-([key key] ?)
|= a=*
=/ b ;;((tree [key=key val=value]) a)
?> (check-balance:((ordered-map key value) ord) b)
?> (apt:((on key value) ord) b)
b
::
:: $mk-item: constructor for +ordered-map item type
::
++ mk-item |$ [key val] [key=key val=val]
:: +ordered-map: treap with user-specified horizontal order
::
:: Conceptually smaller items go on the left, so the item with the
:: smallest key can be popped off the head. If $key is `@` and
:: .compare is +lte, then the numerically smallest item is the head.
++ 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
::
++ ordered-map
++ on
~/ %on
|* [key=mold val=mold]
=> |%
+$ item (mk-item key val)
+$ item [key=key val=val]
--
:: +compare: item comparator for horizontal order
::
~% %comp +>+ ~
|= compare=$-([key key] ?)
~% %core + ~
|%
:: +check-balance: verify horizontal and vertical orderings
:: +all: apply logical AND boolean test on all values
::
++ check-balance
=| [l=(unit key) r=(unit key)]
|= a=(tree item)
++ 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
@ -5122,64 +5140,22 @@
::
?~(r.a %.y &((mor key.n.a key.n.r.a) $(a r.a, r `key.n.a)))
==
:: +put: ordered item insert
:: +bap: convert to list, right to left
::
++ 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))
:: +peek: produce head (smallest item) or null
::
++ peek
++ bap
~/ %bap
|= a=(tree item)
^- (unit item)
::
?~ a ~
?~ l.a `n.a
$(a l.a)
::
:: +pop: produce .head (smallest item) and .rest or crash if empty
::
++ 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))
^- (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
::
@ -5192,30 +5168,15 @@
[found a(l lef)]
=+ [found rig]=$(a r.a)
[found a(r rig)]
:: +nip: remove root; for internal use
::
++ 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))
:: +traverse: stateful partial inorder traversal
:: +dip: stateful partial inorder traversal
::
:: Mutates .state on each run of .f. Starts at .start key, or if
:: .start is ~, starts at the head (item with smallest key). Stops
:: when .f produces .stop=%.y. Traverses from smaller to larger
:: keys. Each run of .f can replace an item's value or delete the
:: item.
:: .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.
::
++ traverse
++ dip
~/ %dip
|* state=mold
|= $: a=(tree item)
=state
@ -5274,63 +5235,18 @@
=/ rig main(a r.a)
rig(a a(r a.rig))
--
:: +tap: convert to list, smallest to largest
::
++ tap
|= a=(tree item)
^- (list item)
::
=| b=(list item)
|- ^+ b
?~ a b
::
$(a l.a, b [n.a $(a r.a)])
:: +bap: convert to list, largest to smallest
::
++ bap
|= a=(tree item)
^- (list item)
::
=| b=(list item)
|- ^+ b
?~ a b
::
$(a r.a, b [n.a $(a l.a)])
:: +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))
:: +uni: unify two ordered maps
::
:: .b takes precedence over .a if keys overlap.
::
++ 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)
::
:: +get: get val at key or return ~
::
++ get
~/ %get
|= [a=(tree item) b=key]
^- (unit val)
?~ a ~
@ -5339,11 +5255,24 @@
?: (compare b key.n.a)
$(a l.a)
$(a r.a)
:: +got: need value at key
::
:: +subset: take a range excluding start and/or end and all elements
++ 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
::
++ subset
++ lot
~/ %lot
|= $: tre=(tree item)
start=(unit key)
end=(unit key)
@ -5389,6 +5318,154 @@
$(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
@ -5535,7 +5612,8 @@
:: :: ++unm:chrono:userlib
++ unm :: Urbit to Unix ms
|= a=@da
(div (mul (sub a ~1970.1.1) 1.000) ~s1)
=- (div (mul - 1.000) ~s1)
(sub (add a (div ~s1 2.000)) ~1970.1.1)
:: :: ++unt:chrono:userlib
++ unt :: Urbit to Unix time
|= a=@da

28
pkg/arvo/tests/sys/vane/clay.hoon
View File

@ -23,7 +23,7 @@
=/ src "."
%+ expect-eq
!> ^- pile:fusion
:* ~ ~ ~ ~ ~ ~
:* ~ ~ ~ ~ ~ ~ ~
tssg+[%dbug [/sur/foo/hoon [[1 1] [1 2]]] [%cnts ~[[%.y 1]] ~]]~
==
!> (parse-pile:(ford):fusion /sur/foo/hoon src)
@ -32,7 +32,7 @@
=/ src "/% moo %mime\0a."
%+ expect-eq
!> ^- pile:fusion
:* sur=~ lib=~ raw=~
:* sur=~ lib=~ raw=~ raz=~
maz=[face=%moo mark=%mime]~
caz=~ bar=~
tssg+[%dbug [/sur/foo/hoon [[2 1] [2 2]]] [%cnts ~[[%.y 1]] ~]]~
@ -43,7 +43,7 @@
=/ src "/$ goo %mime %txt\0a."
%+ expect-eq
!> ^- pile:fusion
:* sur=~ lib=~ raw=~ maz=~
:* sur=~ lib=~ raw=~ raz=~ maz=~
caz=[face=%goo from=%mime to=%txt]~
bar=~
tssg+[%dbug [/sur/foo/hoon [[2 1] [2 2]]] [%cnts ~[[%.y 1]] ~]]~
@ -74,7 +74,7 @@
[`%hood-drum %hood-drum]
[`%hood-write %hood-write]
==
raw=~ maz=~ caz=~ bar=~
raw=~ raz=~ maz=~ caz=~ bar=~
tssg+[%dbug [/sur/foo/hoon [[10 1] [10 2]]] [%cnts ~[[%.y 1]] ~]]~
==
!> (parse-pile:(ford):fusion /sur/foo/hoon src)
@ -112,10 +112,10 @@
;: weld
%+ expect-eq
!>(*mime)
(slap res limb/%bunt)
(slap res !,(*hoon *vale))
::
%+ expect-eq
!> (~(gas in *(set path)) /mar/mime/hoon ~)
!> (~(gas in *(set [? path])) |^/mar/mime/hoon ~)
!> dez:(~(got by files.cache.nub) /mar/mime/hoon)
==
::
@ -139,10 +139,10 @@
;: weld
%+ expect-eq
!>(*@t)
(slap res limb/%bunt)
(slap res !,(*hoon *vale))
::
%+ expect-eq
!> (~(gas in *(set path)) /mar/udon/hoon /lib/cram/hoon ~)
!> (~(gas in *(set [? path])) |^/mar/udon/hoon |^/lib/cram/hoon ~)
!> dez:(~(got by files.cache.nub) /mar/udon/hoon)
==
::
@ -170,7 +170,7 @@
=/ changes
%- my
:~ [/mar/mime/hoon &+hoon+mar-mime]
[/lib/foo/hoon &+hoon+'/% moo %mime\0abunt:moo']
[/lib/foo/hoon &+hoon+'/% moo %mime\0a*vale:moo']
==
=/ ford
%: ford:fusion
@ -224,7 +224,7 @@
(slap res (ream '(+ [*^ [%bob ~] ~])'))
::
%+ expect-eq
!> (~(gas in *(set path)) /gen/hello/hoon ~)
!> (~(gas in *(set [? path])) |^/gen/hello/hoon ~)
!> dez:(~(got by files.cache.nub) /gen/hello/hoon)
==
::
@ -249,10 +249,10 @@
!>((slab %read %get-our -.res))
::
%+ expect-eq
!> %- ~(gas in *(set path))
:~ /lib/strandio/hoon
/lib/strand/hoon
/sur/spider/hoon
!> %- ~(gas in *(set [? path]))
:~ [| /lib/strandio/hoon]
[| /lib/strand/hoon]
[| /sur/spider/hoon]
==
!> dez:(~(got by files.cache.nub) /lib/strandio/hoon)
==

1
pkg/arvo/tests/sys/vane/eyre.hoon
View File

@ -2353,7 +2353,6 @@
:^ ~ ~ %dais
!> ^- dais:clay
|_ sam=vase
++ bunt !!
++ diff !!
++ form !!
++ join !!

7
pkg/arvo/tests/sys/zuse/format.hoon
View File

@ -179,10 +179,15 @@
%+ expect-eq
!> [%n '1000']
!> (time ~1970.1.1..0.0.1)
:: timestamps should invert
::
%+ expect-eq
!> [%n '1001']
!> (time (from-unix-ms:chrono:userlib 1.001))
:: ship - store ship identity as a string
::
%+ expect-eq
!> [%s 'zod']
!> [%n '"zod"']
!> (ship ~zod)
==
:: dejs - recursive processing of `json` values

103
pkg/arvo/tests/sys/zuse/ordered-map.hoon
View File

@ -9,6 +9,7 @@
(items-from-keys (gulf 0 6))
::
=/ atom-map ((ordered-map @ud @tas) lte)
=/ gte-atom-map ((ordered-map @ud @tas) gte)
::
|%
++ test-ordered-map-gas ^- tang
@ -17,7 +18,7 @@
::
%+ expect-eq
!> %.y
!> (check-balance:atom-map a)
!> (apt:atom-map a)
::
++ test-ordered-map-tap ^- tang
::
@ -27,6 +28,72 @@
!> test-items
!> (tap:atom-map a)
::
++ test-ordered-map-tab-gte ^- tang
::
=/ a=(tree [@ud @tas]) (gas:gte-atom-map ~ test-items)
::
%+ expect-eq
!> (flop test-items)
!> (tab:gte-atom-map a ~ 7)
::
++ test-ordered-map-tab-gte-starting-from ^- tang
::
=/ a=(tree [@ud @tas]) (gas:gte-atom-map ~ test-items)
=/ small-test-items=(list [@ud @tas])
(items-from-keys (gulf 2 5))
::
%+ expect-eq
!> (flop small-test-items)
!> (tab:gte-atom-map a [~ 6] 4)
::
++ test-ordered-map-tab-gte-count ^- tang
::
=/ a=(tree [@ud @tas]) (gas:gte-atom-map ~ test-items)
=/ small-test-items=(list [@ud @tas])
(items-from-keys (gulf 4 6))
::
%+ expect-eq
!> (flop small-test-items)
!> (tab:gte-atom-map a ~ 3)
::
++ test-ordered-map-tab ^- tang
::
=/ a=(tree [@ud @tas]) (gas:atom-map ~ test-items)
::
%+ expect-eq
!> test-items
!> (tab:atom-map a ~ 7)
::
++ test-ordered-map-tab-starting-from ^- tang
::
=/ a=(tree [@ud @tas]) (gas:atom-map ~ test-items)
=/ small-test-items=(list [@ud @tas])
(items-from-keys (gulf 1 4))
::
%+ expect-eq
!> small-test-items
!> (tab:atom-map a [~ 0] 4)
::
++ test-ordered-map-tab-count ^- tang
::
=/ a=(tree [@ud @tas]) (gas:atom-map ~ test-items)
=/ small-test-items=(list [@ud @tas])
(items-from-keys (gulf 0 2))
::
%+ expect-eq
!> small-test-items
!> (tab:atom-map a ~ 3)
::
++ test-ordered-map-tab-more-than-exist ^- tang
::
=/ specific-test-items=(list [@ud @tas])
(items-from-keys (gulf 1 6))
=/ a=(tree [@ud @tas]) (gas:atom-map ~ specific-test-items)
::
%+ expect-eq
!> specific-test-items
!> (tab:atom-map a [~ 0] 8)
::
++ test-ordered-map-pop ^- tang
::
=/ a=(tree [@ud @tas]) (gas:atom-map ~ test-items)
@ -35,13 +102,13 @@
!> [[0 %a] (gas:atom-map ~ (items-from-keys (gulf 1 6)))]
!> (pop:atom-map a)
::
++ test-ordered-map-peek ^- tang
++ test-ordered-map-pry ^- tang
::
=/ a=(tree [@ud @tas]) (gas:atom-map ~ test-items)
::
%+ expect-eq
!> `[0 %a]
!> (peek:atom-map a)
!> (pry:atom-map a)
::
++ test-ordered-map-nip ^- tang
::
@ -53,61 +120,61 @@
!> (gas:atom-map ~ ~[[0^%a] [1^%b] [2^%c] [3^%d] [4^%e] [5^%f]])
!> b
::
++ test-ordered-map-subset ^- tang
++ test-ordered-map-lot ^- tang
::
=/ a=(tree [@ud @tas]) (gas:atom-map ~ test-items)
::
=/ b (subset:atom-map a `0 `4)
=/ b (lot:atom-map a `0 `4)
::
%+ expect-eq
!> (gas:atom-map ~ ~[[1^%b] [2^%c] [3^%d]])
!> b
::
++ test-ordered-map-null-start-subset ^- tang
++ test-ordered-map-null-start-lot ^- tang
::
=/ a=(tree [@ud @tas]) (gas:atom-map ~ test-items)
::
=/ b (subset:atom-map a ~ `5)
=/ b (lot:atom-map a ~ `5)
::
%+ expect-eq
!> (gas:atom-map ~ ~[[0^%a] [1^%b] [2^%c] [3^%d] [4^%e]])
!> b
::
++ test-ordered-map-null-end-subset ^- tang
++ test-ordered-map-null-end-lot ^- tang
::
=/ a=(tree [@ud @tas]) (gas:atom-map ~ test-items)
::
=/ b (subset:atom-map a `1 ~)
=/ b (lot:atom-map a `1 ~)
::
%+ expect-eq
!> (gas:atom-map ~ ~[[2^%c] [3^%d] [4^%e] [5^%f] [6^%g]])
!> b
::
++ test-ordered-map-double-null-subset ^- tang
++ test-ordered-map-double-null-lot ^- tang
::
=/ a=(tree [@ud @tas]) (gas:atom-map ~ test-items)
::
=/ b (subset:atom-map a ~ ~)
=/ b (lot:atom-map a ~ ~)
::
%+ expect-eq
!> (gas:atom-map ~ ~[[0^%a] [1^%b] [2^%c] [3^%d] [4^%e] [5^%f] [6^%g]])
!> b
::
++ test-ordered-map-not-found-start-subset ^- tang
++ test-ordered-map-not-found-start-lot ^- tang
::
=/ a=(tree [@ud @tas]) (gas:atom-map ~ ~[[1^%b]])
::
=/ b (subset:atom-map a `0 ~)
=/ b (lot:atom-map a `0 ~)
::
%+ expect-eq
!> (gas:atom-map ~ ~[[1^%b]])
!> b
::
++ test-ordered-map-traverse ^- tang
++ test-ordered-map-dip ^- tang
::
=/ a=(tree [@ud @tas]) (gas:atom-map ~ test-items)
::
=/ b %- (traverse:atom-map ,(list [@ud @tas]))
=/ b %- (dip:atom-map ,(list [@ud @tas]))
:* a
state=~
::
@ -129,11 +196,11 @@
!> -.b
==
::
++ test-ordered-map-traverse-delete-all ^- tang
++ test-ordered-map-dip-delete-all ^- tang
;: weld
=/ q ((ordered-map ,@ ,~) lte)
=/ o (gas:q ~ ~[1/~ 2/~ 3/~])
=/ b ((traverse:q ,~) o ~ |=([~ key=@ ~] [~ %| ~]))
=/ b ((dip:q ,~) o ~ |=([~ key=@ ~] [~ %| ~]))
%+ expect-eq
!> [~ ~]
!> b
@ -147,7 +214,7 @@
?:((lth aa ba) %.y ?:((gth aa ba) %.n (lte ab bb)))
=/ q ((ordered-map ,[@ @] ,~) compare)
=/ o (gas:q ~ c)
=/ b ((traverse:q ,~) o ~ |=([~ key=[@ @] ~] [~ %| ~]))
=/ b ((dip:q ,~) o ~ |=([~ key=[@ @] ~] [~ %| ~]))
%+ expect-eq
!> [~ ~]
!> b