mirror of
https://github.com/urbit/shrub.git
synced 2025-01-03 10:02:32 +03:00
Merge branch 'master' into release/2021-5-27
This commit is contained in:
Matilde Park
commit
c4a65eb65f
@ -1,3 +1,3 @@
|
||||
version https://git-lfs.github.com/spec/v1
|
||||
oid sha256:d7b7cf24e56ab078cf1dcb82e4e7744f188c5221c08772d6cfb15f59ce81aaa5
|
||||
size 11198219
|
||||
oid sha256:88acd8aa1aae3d11579ada954b6e0b06c940de7856d22017cc1a1442de97fcf3
|
||||
size 13650762
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -1,6 +1,5 @@
|
||||
:: graph-store [landscape]
|
||||
::
|
||||
::
|
||||
/+ store=graph-store, sigs=signatures, res=resource, default-agent, dbug, verb
|
||||
~% %graph-store-top ..part ~
|
||||
|%
|
||||
@ -724,7 +723,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 +774,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])
|
||||
@ -846,7 +845,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]
|
||||
@ -860,7 +859,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)
|
||||
@ -878,7 +877,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))
|
||||
==
|
||||
::
|
||||
|
||||
@ -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
15
pkg/arvo/gen/hood/fuse.hoon
Normal 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
8
pkg/arvo/gen/hood/fuse/help.txt
Normal 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.
|
||||
@ -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
|
||||
|
||||
@ -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 ::
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -33,7 +33,7 @@
|
||||
++ grab
|
||||
|%
|
||||
++ noun
|
||||
|= p=*
|
||||
|: p=`*`%*(. *indexed-post index.p [0 ~])
|
||||
=/ ip ;;(indexed-post p)
|
||||
?> ?=([@ ~] index.p.ip)
|
||||
ip
|
||||
|
||||
@ -49,7 +49,7 @@
|
||||
++ grab
|
||||
|%
|
||||
++ noun
|
||||
|= p=*
|
||||
|: p=`*`%*(. *indexed-post index.p [0 0 ~])
|
||||
=/ ip ;;(indexed-post p)
|
||||
?+ index.p.ip ~|(index+index.p.ip !!)
|
||||
:: top-level link post; title and url
|
||||
|
||||
@ -43,7 +43,7 @@
|
||||
:: +noun: validate post
|
||||
::
|
||||
++ noun
|
||||
|= p=*
|
||||
|: p=`*`%*(. *indexed-post contents.p [%text '']~)
|
||||
=/ ip ;;(indexed-post p)
|
||||
?> ?=(^ contents.p.ip)
|
||||
ip
|
||||
|
||||
@ -58,7 +58,7 @@
|
||||
:: +noun: validate publish note
|
||||
::
|
||||
++ noun
|
||||
|= p=*
|
||||
|: p=`*`%*(. *indexed-post index.p [0 ~])
|
||||
=/ ip ;;(indexed-post p)
|
||||
?+ index.p.ip !!
|
||||
:: top level post must have no content
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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)))
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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)
|
||||
:_ ..^$
|
||||
|
||||
@ -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))
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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)
|
||||
==
|
||||
|
||||
@ -2353,7 +2353,6 @@
|
||||
:^ ~ ~ %dais
|
||||
!> ^- dais:clay
|
||||
|_ sam=vase
|
||||
++ bunt !!
|
||||
++ diff !!
|
||||
++ form !!
|
||||
++ join !!
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user