clay: support ranges in sys.kelvin

This commit is contained in:
Philip Monk 2022-10-13 20:36:33 -07:00
parent 2cc6abbf78
commit 478da3b77b
5 changed files with 83 additions and 61 deletions

View File

@ -928,6 +928,9 @@
[%| p=(list a) q=(list a)] :: p -> q[chunk]
== ::
++ urge |*(a=mold (list (unce a))) :: list change
+$ waft :: kelvin range
$^ [[%1 ~] p=(set weft)] ::
weft ::
+$ whom (each ship @ta) :: ship or named crew
+$ yoki (each yuki yaki) :: commit
+$ yuki :: proto-commit
@ -1027,6 +1030,22 @@
::
++ page-to-lobe |=(page (shax (jam +<)))
::
++ cord-to-waft
|= =cord
^- waft
:- [%1 ~]
%- sy ^- (list weft)
%+ turn (rash cord (star (ifix [gay gay] tall:vast)))
|= =hoon
!<(weft (slap !>(~) hoon))
::
++ waft-to-wefts
|= kal=waft
^- (set weft)
?^ -.kal
p.kal
[kal ~ ~]
::
:: +make-yaki: make commit out of a list of parents, content, and date.
::
++ make-yaki

View File

@ -1765,38 +1765,42 @@
!!
:: find desk kelvin
::
=/ kel=weft (get-kelvin yoki)
?. ?| =(kel zuse+zuse) :: kelvin match
=/ kel=(set weft) (waft-to-wefts (get-kelvin yoki))
?. ?| (~(has in kel) zuse+zuse) :: kelvin match
?& !=(%base syd) :: best-effort compat
=(%zuse lal.kel)
(gth num.kel zuse)
%- ~(any in kel)
|= =weft
&(=(%zuse lal.weft) (gth num.weft zuse))
==
?& =(%base syd) :: ready to upgrade
%+ levy ~(tap by tore:(lu now rof hen ruf))
|= [=desk =zest wic=(set weft)]
?| =(%base desk)
!?=(%live zest)
(~(has in wic) kel)
!=(~ (~(int in wic) kel))
==
==
==
?: (gth num.kel zuse)
?: (~(all in kel) |=(=weft (gth num.weft zuse)))
%- (slog leaf+"clay: old-kelvin, {<[need=zuse/zuse have=kel]>}" ~)
..park
=. wic.dom (~(put by wic.dom) kel yoki)
=. wic.dom
%+ roll ~(tap in kel)
|: [weft=*weft wic=wic.dom]
(~(put by wic) weft yoki)
=? ..park !?=(%base syd) (emit hen %pass /park-wick %c %wick ~)
%- (slog leaf+"clay: wait-for-kelvin, {<[need=zuse/zuse have=kel]>}" ~)
..park
=. wic.dom (~(del by wic.dom) kel)
=. wic.dom (~(del by wic.dom) zuse+zuse)
::
=/ old-yaki
?: =(0 let.dom)
*yaki
(aeon-to-yaki:ze let.dom)
=/ old-kel
=/ old-kel=(set weft)
?: =(0 let.dom)
zuse+zuse
(get-kelvin %| old-yaki)
[zuse+zuse ~ ~]
(waft-to-wefts (get-kelvin %| old-yaki))
=/ [deletes=(set path) changes=(map path (each page lobe))]
(get-changes q.old-yaki new-data)
~| [from=let.dom deletes=deletes changes=~(key by changes)]
@ -1807,6 +1811,13 @@
=/ invalid (~(uni in deletes) ~(key by changes))
?: &(=(%base syd) !updated (~(any in invalid) is-kernel-path))
(sys-update yoki new-data)
=. ..park (emit hen %pass /park-wick %c %wick ~)
=. wic.dom
%+ roll ~(tap in kel)
|: [weft=*weft wic=wic.dom]
?: (gte num.weft zuse)
wic
(~(put by wic) weft yoki)
::
=+ ?. (did-kernel-update invalid) ~
((slog 'clay: kernel updated' ~) ~)
@ -1890,7 +1901,7 @@
(emil (weld moves-1 moves-2))
?. ?=(%live liv.dom.dojo.i.desks)
$(desks t.desks)
?~ wat=(~(get by wic.dom.dojo.i.desks) kel)
?~ wat=(~(get by wic.dom.dojo.i.desks) zuse+zuse)
:: XX should crash here
::
$(desks t.desks)
@ -1923,10 +1934,10 @@
::
++ get-kelvin
|= =yoki
^- weft
^- waft
|^ ?- -.yoki
%|
%- lobe-to-weft
%- lobe-to-waft
~> %mean.(cat 3 'clay: missing /sys/kelvin on ' syd)
~| ~(key by q.p.yoki)
(~(got by q.p.yoki) /sys/kelvin)
@ -1937,26 +1948,24 @@
~| ~(key by q.p.yoki)
(~(got by q.p.yoki) /sys/kelvin)
?- -.fil
%& (page-to-weft p.fil)
%| (lobe-to-weft p.fil)
%& (page-to-waft p.fil)
%| (lobe-to-waft p.fil)
==
==
::
++ lobe-to-weft
++ lobe-to-waft
|= =lobe
^- weft
^- waft
=/ peg=(unit page) (~(get by lat.ran) lobe)
?~ peg ~|([%sys-kelvin-tombstoned syd] !!)
(page-to-weft u.peg)
(page-to-waft u.peg)
::
++ page-to-weft
++ page-to-waft
|= =page
^- weft
^- waft
?+ p.page ~|(clay-bad-kelvin-mark/p.page !!)
%kelvin ;;(weft q.page)
%mime
=+ ;;(=mime q.page)
!<(weft (slap !>(~) (ream q.q.mime)))
%kelvin ;;(waft q.page)
%mime (cord-to-waft q.q:;;(mime q.page))
==
--
::
@ -4505,7 +4514,7 @@
|- ^- mark
?~ t.t.pax
i.pax
:((cury cat 3) i.pax '-' $(pax t.pax))
(rap 3 i.pax '-' $(pax t.pax) ~)
::
=^ m2 nub.f
|- ^- [(list mark) _nub.f]

View File

@ -1,18 +1,28 @@
=/ weft ,[lal=@tas num=@ud] :: TODO remove after merge
|_ kel=weft
|_ kal=waft:clay
++ grow
|%
++ mime `^mime`[/text/x-kelvin (as-octs:mimes:html hoon)]
++ noun kel
++ hoon (crip "{<[lal num]:kel>}\0a")
++ noun kal
++ hoon
%+ rap 3
%+ turn
%+ sort
~(tap in (waft-to-wefts:clay kal))
|= [a=weft b=weft]
?: =(lal.a lal.b)
(gte num.a num.b)
(gte lal.a lal.b)
|= =weft
(rap 3 '[%' (scot %tas lal.weft) ' ' (scot %ud num.weft) ']\0a' ~)
::
++ txt (to-wain:format hoon)
--
++ grab
|%
++ noun weft
++ noun waft:clay
++ mime
|= [=mite len=@ud tex=@]
!<(weft (slap !>(~) (ream tex)))
(cord-to-waft:clay tex)
--
++ grad %noun
--

View File

@ -50,7 +50,7 @@
/[ego]/[syd]/[wen]/sys/kelvin
?. .^(? %cu kel-path)
leaf+"bad desk: {<syd>}"
=+ .^(=weft %cx kel-path)
=+ .^(=waft %cx kel-path)
:+ %rose ["" "{<syd>}" "::"]
^- tang
=/ hash .^(@uv %cz /[ego]/[syd]/[wen])
@ -73,7 +73,17 @@
%dead "suspended"
%held "suspended until next update"
==
:~ leaf/"/sys/kelvin: {<[lal num]:weft>}"
=/ kul=tape
%+ roll
%+ sort
~(tap in (waft-to-wefts:clay waft))
|= [a=weft b=weft]
?: =(lal.a lal.b)
(lte num.a num.b)
(lte lal.a lal.b)
|= [=weft =tape]
(welp " {<[lal num]:weft>}" tape)
:~ leaf/"/sys/kelvin: {kul}"
leaf/"base hash: {?.(=(1 (lent meb)) <meb> <(head meb)>)}"
leaf/"%cz hash: {<hash>}"
::
@ -101,32 +111,6 @@
leaf/"no %kids desk"
=+ .^(hash=@uv %cz /[ego]/[syd]/[wen])
leaf/"%kids %cz hash: {<hash>}"
:: +read-kelvin-foreign: read /sys/kelvin from a foreign desk
::
++ read-kelvin-foreign
|= [=ship =desk =aeon]
^- weft
~| read-foreign-kelvin/+<
=/ her (scot %p ship)
=/ syd (scot %tas desk)
=/ yon (scot %ud aeon)
::
=/ dom .^(dome cv/~[her syd yon])
=/ tak (scot %uv (~(got by hit.dom) let.dom))
=/ yak .^(yaki cs/~[her syd yon %yaki tak])
=/ lob (scot %uv (~(got by q.yak) /sys/kelvin))
=/ peg .^(page cs/~[her syd yon %blob lob])
;;(weft q.peg)
:: +read-kelvin-local: read /sys/kelvin from a local desk
::
++ read-kelvin-local
|= [our=ship =desk now=@da]
^- (unit weft)
~| read-kelvin-local+desk
=/ pax (en-beam [our desk da+now] /sys/kelvin)
?. .^(? cu/pax)
~
[~ .^(weft cx/pax)]
:: +read-bill-foreign: read /desk/bill from a foreign desk
::
++ read-bill-foreign

View File

@ -371,7 +371,7 @@
[%glob u.glob.chad.charge]
:_(state [add-fact fetch-glob]:cha)
::
?(%next %dead)
?(%held %dead)
=/ glob=(unit glob)
?:(?=(%glob -.chad.charge) `glob.chad.charge ~)
=. charges (new-chad:cha %suspend glob)