2016-11-24 07:25:07 +03:00
|
|
|
:: clay (4c), revision control
|
2019-02-02 00:46:09 +03:00
|
|
|
!:
|
2016-11-24 07:25:07 +03:00
|
|
|
:: This is split in three top-level sections: structure definitions, main
|
|
|
|
:: logic, and arvo interface.
|
|
|
|
::
|
|
|
|
::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
|
|
|
|
::
|
|
|
|
:: Here are the structures. `++raft` is the formal arvo state. It's also
|
|
|
|
:: worth noting that many of the clay-related structures are defined in zuse.
|
|
|
|
::
|
|
|
|
::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
|
|
|
|
|= pit/vase
|
2016-12-07 06:13:33 +03:00
|
|
|
=, clay
|
2016-11-24 07:25:07 +03:00
|
|
|
=> |%
|
2018-08-16 02:48:37 +03:00
|
|
|
+$ aeon @ud :: version number
|
2016-11-24 07:25:07 +03:00
|
|
|
::
|
|
|
|
:: Recursive structure of a desk's data.
|
|
|
|
::
|
|
|
|
:: We keep an ankh only for the current version of local desks. Everywhere
|
|
|
|
:: else we store it as (map path lobe).
|
|
|
|
::
|
2018-08-16 02:48:37 +03:00
|
|
|
+$ ankh :: expanded node
|
2018-02-11 08:24:22 +03:00
|
|
|
$~ [~ ~]
|
2016-11-24 07:25:07 +03:00
|
|
|
$: fil/(unit {p/lobe q/cage}) :: file
|
|
|
|
dir/(map @ta ankh) :: folders
|
|
|
|
== ::
|
|
|
|
::
|
|
|
|
:: Part of ++mery, representing the set of changes between the mergebase and
|
|
|
|
:: one of the desks being merged.
|
|
|
|
::
|
|
|
|
:: -- `new` is the set of files in the new desk and not in the mergebase.
|
|
|
|
:: -- `cal` is the set of changes in the new desk from the mergebase except
|
|
|
|
:: for any that are also in the other new desk.
|
|
|
|
:: -- `can` is the set of changes in the new desk from the mergebase and that
|
|
|
|
:: are also in the other new desk (potential conflicts).
|
|
|
|
:: -- `old` is the set of files in the mergebase and not in the new desk.
|
|
|
|
::
|
2018-08-16 02:48:37 +03:00
|
|
|
+$ cane
|
2016-11-24 07:25:07 +03:00
|
|
|
$: new/(map path lobe)
|
|
|
|
cal/(map path lobe)
|
|
|
|
can/(map path cage)
|
2018-03-19 07:18:20 +03:00
|
|
|
old/(map path ~)
|
2016-11-24 07:25:07 +03:00
|
|
|
==
|
|
|
|
::
|
|
|
|
:: Type of request.
|
|
|
|
::
|
2020-01-23 08:23:14 +03:00
|
|
|
:: %d produces a set of desks, %p gets file permissions, %t gets all paths
|
|
|
|
:: with the specified prefix, %u checks for existence, %v produces a ++dome
|
|
|
|
:: of all desk data, %w gets @ud and @da variants for the given case, %x
|
|
|
|
:: gets file contents, %y gets a directory listing, and %z gets a recursive
|
|
|
|
:: hash of the file contents and children.
|
2016-11-24 07:25:07 +03:00
|
|
|
::
|
2020-01-23 08:23:14 +03:00
|
|
|
:: ++ care ?($d $p $t $u $v $w $x $y $z)
|
2016-11-24 07:25:07 +03:00
|
|
|
::
|
|
|
|
:: Keeps track of subscribers.
|
|
|
|
::
|
|
|
|
:: A map of requests to a set of all the subscribers who should be notified
|
|
|
|
:: when the request is filled/updated.
|
|
|
|
::
|
2018-08-16 02:48:37 +03:00
|
|
|
+$ cult (jug wove duct)
|
2016-11-24 07:25:07 +03:00
|
|
|
::
|
|
|
|
:: Domestic desk state.
|
|
|
|
::
|
|
|
|
:: Includes subscriber list, dome (desk content), possible commit state (for
|
2018-01-25 18:15:01 +03:00
|
|
|
:: local changes), possible merge state (for incoming merges), and permissions.
|
2016-11-24 07:25:07 +03:00
|
|
|
::
|
|
|
|
++ dojo
|
|
|
|
$: qyx/cult :: subscribers
|
|
|
|
dom/dome :: desk state
|
2018-02-12 19:56:48 +03:00
|
|
|
per/regs :: read perms per path
|
|
|
|
pew/regs :: write perms per path
|
2016-11-24 07:25:07 +03:00
|
|
|
==
|
|
|
|
::
|
|
|
|
:: Desk state.
|
|
|
|
::
|
|
|
|
:: Includes a checked-out ankh with current content, most recent version, map
|
|
|
|
:: of all version numbers to commit hashes (commits are in hut.rang), and map
|
|
|
|
:: of labels to version numbers.
|
|
|
|
::
|
2019-05-16 01:50:13 +03:00
|
|
|
:: `mim` is a cache of the content in the directories that are mounted
|
|
|
|
:: to unix. Often, we convert to/from mime without anything really
|
|
|
|
:: having changed; this lets us short-circuit that in some cases.
|
|
|
|
:: Whenever you give an `%ergo`, you must update this.
|
|
|
|
::
|
2016-11-24 07:25:07 +03:00
|
|
|
++ dome
|
|
|
|
$: ank/ankh :: state
|
|
|
|
let/aeon :: top id
|
|
|
|
hit/(map aeon tako) :: versions by id
|
|
|
|
lab/(map @tas aeon) :: labels
|
2019-05-16 01:50:13 +03:00
|
|
|
mim/(map path mime) :: mime cache
|
2016-11-24 07:25:07 +03:00
|
|
|
== ::
|
|
|
|
::
|
|
|
|
:: Commit state.
|
|
|
|
::
|
|
|
|
:: -- `del` is the paths we're deleting.
|
|
|
|
:: -- `ink` is the insertions of hoon files (short-circuited for
|
|
|
|
:: bootstrapping).
|
|
|
|
:: -- `ins` is all the other insertions.
|
|
|
|
:: -- `dif` is the diffs in `dig` applied to their files.
|
|
|
|
:: -- `mut` is the diffs between `muc` and the original files.
|
|
|
|
::
|
|
|
|
++ dork :: diff work
|
|
|
|
$: del/(list path) :: deletes
|
|
|
|
ink/(list (pair path cage)) :: hoon inserts
|
2019-05-02 04:21:32 +03:00
|
|
|
ins/(list (pair path cage)) :: inserts
|
|
|
|
dif/(list (trel path lobe cage)) :: changes
|
|
|
|
mut/(list (trel path lobe cage)) :: mutations
|
2016-11-24 07:25:07 +03:00
|
|
|
== ::
|
|
|
|
::
|
|
|
|
:: Hash of a blob, for lookup in the object store (lat.ran)
|
|
|
|
::
|
|
|
|
++ lobe @uvI :: blob ref
|
|
|
|
::
|
|
|
|
:: New desk data.
|
|
|
|
::
|
|
|
|
:: Sent to other ships to update them about a particular desk. Includes a map
|
|
|
|
:: of all new aeons to hashes of their commits, the most recent aeon, and sets
|
|
|
|
:: of all new commits and data.
|
|
|
|
::
|
2016-12-16 09:34:01 +03:00
|
|
|
++ nako :: subscription state
|
2016-11-24 07:25:07 +03:00
|
|
|
$: gar/(map aeon tako) :: new ids
|
|
|
|
let/aeon :: next id
|
|
|
|
lar/(set yaki) :: new commits
|
|
|
|
bar/(set plop) :: new content
|
|
|
|
== ::
|
|
|
|
::
|
|
|
|
:: Formal vane state.
|
|
|
|
::
|
2018-12-13 10:42:15 +03:00
|
|
|
:: -- `rom` is our domestic state.
|
2016-11-24 07:25:07 +03:00
|
|
|
:: -- `hoy` is a collection of foreign ships where we know something about
|
|
|
|
:: their clay.
|
|
|
|
:: -- `ran` is the object store.
|
|
|
|
:: -- `mon` is a collection of mount points (mount point name to urbit
|
|
|
|
:: location).
|
|
|
|
:: -- `hez` is the unix duct that %ergo's should be sent to.
|
2018-01-24 00:52:31 +03:00
|
|
|
:: -- `cez` is a collection of named permission groups.
|
2018-09-06 02:05:23 +03:00
|
|
|
:: -- `cue` is a queue of requests to perform in later events.
|
|
|
|
:: -- `tip` is the date of the last write; if now, enqueue incoming requests.
|
2016-11-24 07:25:07 +03:00
|
|
|
::
|
|
|
|
++ raft :: filesystem
|
2019-05-02 04:21:32 +03:00
|
|
|
$: rom=room :: domestic
|
|
|
|
hoy=(map ship rung) :: foreign
|
|
|
|
ran=rang :: hashes
|
|
|
|
mon=(map term beam) :: mount points
|
|
|
|
hez=(unit duct) :: sync duct
|
|
|
|
cez=(map @ta crew) :: permission groups
|
2019-05-11 05:23:13 +03:00
|
|
|
cue=(qeu [=duct =task:able]) :: queued requests
|
2019-05-10 04:06:18 +03:00
|
|
|
act=active-write :: active write
|
2016-11-24 07:25:07 +03:00
|
|
|
== ::
|
|
|
|
::
|
2019-05-10 04:06:18 +03:00
|
|
|
:: Currently active write
|
|
|
|
::
|
|
|
|
++ active-write
|
|
|
|
%- unit
|
|
|
|
$: hen=duct
|
|
|
|
req=task:able
|
2019-05-16 23:44:41 +03:00
|
|
|
$= eval-data
|
|
|
|
$% [%commit commit=eval-form:eval:commit-clad]
|
|
|
|
[%merge merge=eval-form:eval:merge-clad]
|
2019-05-18 00:59:03 +03:00
|
|
|
[%mount mount=eval-form:eval:mount-clad]
|
2019-05-10 04:06:18 +03:00
|
|
|
==
|
|
|
|
==
|
|
|
|
::
|
2019-05-04 05:24:24 +03:00
|
|
|
:: The clad monad for commits.
|
2019-05-02 04:21:32 +03:00
|
|
|
::
|
|
|
|
:: -- `dome` is the new dome -- each writer has a lock on the dome for
|
|
|
|
:: that desk
|
|
|
|
:: -- `rang` is a superset of the global rang, but we uni:by it into
|
|
|
|
:: the global rang because other things might add stuff to it.
|
|
|
|
:: Thus, writers do *not* have a lock on the global rang.
|
|
|
|
::
|
2019-05-04 05:24:24 +03:00
|
|
|
++ commit-clad (clad ,[dome rang])
|
|
|
|
::
|
|
|
|
:: The clad monad for merges.
|
|
|
|
::
|
|
|
|
:: Same as +commit-clad, except includes a set of paths documenting the
|
|
|
|
:: conflicts encountered in the merge.
|
|
|
|
::
|
|
|
|
++ merge-clad (clad ,[(set path) dome rang])
|
2019-05-02 04:21:32 +03:00
|
|
|
::
|
2019-05-18 00:59:03 +03:00
|
|
|
:: The clad monad for mounts.
|
|
|
|
::
|
|
|
|
:: Just a new mount point and mime cache.
|
|
|
|
::
|
|
|
|
++ mount-clad (clad ,[new-mon=(pair term beam) mim=(map path mime)])
|
|
|
|
::
|
2016-11-24 07:25:07 +03:00
|
|
|
:: Object store.
|
|
|
|
::
|
|
|
|
:: Maps of commit hashes to commits and content hashes to content.
|
|
|
|
::
|
2016-12-16 09:34:01 +03:00
|
|
|
++ rang ::
|
2016-11-24 07:25:07 +03:00
|
|
|
$: hut/(map tako yaki) ::
|
|
|
|
lat/(map lobe blob) ::
|
|
|
|
== ::
|
|
|
|
::
|
|
|
|
:: Unvalidated response to a request.
|
|
|
|
::
|
|
|
|
:: Like a ++rant, but with a page of data rather than a cage of it.
|
|
|
|
::
|
|
|
|
++ rand :: unvalidated rant
|
|
|
|
$: p/{p/care q/case r/@tas} :: clade release book
|
|
|
|
q/path :: spur
|
|
|
|
r/page :: data
|
|
|
|
== ::
|
|
|
|
::
|
|
|
|
:: Generic desk state.
|
|
|
|
::
|
|
|
|
:: -- `lim` is the most recent date we're confident we have all the
|
|
|
|
:: information for. For local desks, this is always `now`. For foreign
|
|
|
|
:: desks, this is the last time we got a full update from the foreign
|
|
|
|
:: urbit.
|
|
|
|
:: -- `ref` is a possible request manager. For local desks, this is null.
|
|
|
|
:: For foreign desks, this keeps track of all pending foreign requests
|
|
|
|
:: plus a cache of the responses to previous requests.
|
|
|
|
:: -- `qyx` is the set of subscriptions, with listening ducts. These
|
|
|
|
:: subscriptions exist only until they've been filled.
|
|
|
|
:: -- `dom` is the actual state of the filetree. Since this is used almost
|
|
|
|
:: exclusively in `++ze`, we describe it there.
|
|
|
|
::
|
|
|
|
++ rede :: universal project
|
|
|
|
$: lim/@da :: complete to
|
|
|
|
ref/(unit rind) :: outgoing requests
|
|
|
|
qyx/cult :: subscribers
|
|
|
|
dom/dome :: revision state
|
2018-02-12 19:56:48 +03:00
|
|
|
per/regs :: read perms per path
|
|
|
|
pew/regs :: write perms per path
|
2016-11-24 07:25:07 +03:00
|
|
|
== ::
|
|
|
|
::
|
|
|
|
:: Foreign request manager.
|
|
|
|
::
|
|
|
|
:: When we send a request to a foreign ship, we keep track of it in here. This
|
|
|
|
:: includes a request counter, a map of request numbers to requests, a reverse
|
|
|
|
:: map of requesters to request numbers, a simple cache of common %sing
|
|
|
|
:: requests, and a possible nako if we've received data from the other ship and
|
|
|
|
:: are in the process of validating it.
|
|
|
|
::
|
|
|
|
++ rind :: request manager
|
|
|
|
$: nix/@ud :: request index
|
|
|
|
bom/(map @ud {p/duct q/rave}) :: outstanding
|
|
|
|
fod/(map duct @ud) :: current requests
|
|
|
|
haw/(map mood (unit cage)) :: simple cache
|
2019-05-17 03:24:10 +03:00
|
|
|
pud/update-qeu :: active updates
|
|
|
|
pur/request-map :: active requests
|
2016-11-24 07:25:07 +03:00
|
|
|
== ::
|
|
|
|
::
|
2019-05-23 00:39:12 +03:00
|
|
|
:: Result of a subscription
|
|
|
|
::
|
|
|
|
++ sub-result
|
|
|
|
$% [%blab =mood data=(each cage lobe)]
|
|
|
|
[%bleb ins=@ud range=(unit (pair aeon aeon))]
|
|
|
|
[%balk cage=(unit (each cage lobe)) =mood]
|
|
|
|
[%blas moods=(set mood)]
|
|
|
|
[%blub ~]
|
|
|
|
==
|
|
|
|
::
|
2019-05-17 03:24:10 +03:00
|
|
|
:: The clad monad for foreign updates.
|
|
|
|
::
|
2019-05-23 08:45:06 +03:00
|
|
|
:: Same as +commit-clad, except includes `lim`, as in +rede. Null if
|
2019-05-17 03:24:10 +03:00
|
|
|
:: subscription ended.
|
|
|
|
::
|
|
|
|
++ update-clad (clad ,(unit [lim=@da dome rang]))
|
|
|
|
++ update-qeu
|
|
|
|
$: waiting=(qeu [inx=@ud rut=(unit rand)])
|
2019-05-23 20:30:15 +03:00
|
|
|
eval-data=(unit [inx=@ud rut=(unit rand) =eval-form:eval:update-clad])
|
2019-05-17 03:24:10 +03:00
|
|
|
==
|
|
|
|
::
|
|
|
|
:: The clad monad for foreign simple requests
|
|
|
|
::
|
|
|
|
++ request-clad (clad ,cage)
|
2019-05-23 20:30:15 +03:00
|
|
|
++ request-map ,(map inx=@ud [=rand =eval-form:eval:request-clad])
|
2019-05-17 03:24:10 +03:00
|
|
|
::
|
2016-11-24 07:25:07 +03:00
|
|
|
:: Domestic ship.
|
|
|
|
::
|
|
|
|
:: `hun` is the duct to dill, and `dos` is a collection of our desks.
|
|
|
|
::
|
|
|
|
++ room :: fs per ship
|
|
|
|
$: hun/duct :: terminal duct
|
|
|
|
dos/(map desk dojo) :: native desk
|
|
|
|
== ::
|
|
|
|
::
|
|
|
|
:: Stored request.
|
|
|
|
::
|
|
|
|
:: Like a ++rave but with caches of current versions for %next and %many.
|
|
|
|
:: Generally used when we store a request in our state somewhere.
|
|
|
|
::
|
2018-01-22 18:01:00 +03:00
|
|
|
++ cach (unit (unit (each cage lobe))) :: cached result
|
2019-05-23 00:39:12 +03:00
|
|
|
+$ wove [for=(unit ship) =rove] :: stored source + req
|
2019-05-23 08:45:06 +03:00
|
|
|
++ rove :: stored request
|
2019-05-23 00:39:12 +03:00
|
|
|
$% [%sing =mood] :: single request
|
|
|
|
[%next =mood aeon=(unit aeon) =cach] :: next version of one
|
|
|
|
$: %mult :: next version of any
|
|
|
|
=mool :: original request
|
|
|
|
aeon=(unit aeon) :: checking for change
|
|
|
|
old-cach=(map [=care =path] cach) :: old version
|
|
|
|
new-cach=(map [=care =path] cach) :: new version
|
2018-01-23 19:35:12 +03:00
|
|
|
== ::
|
2019-05-23 00:39:12 +03:00
|
|
|
[%many track=? =moat lobes=(map path lobe)] :: change range
|
2016-11-24 07:25:07 +03:00
|
|
|
== ::
|
|
|
|
::
|
|
|
|
:: Foreign desk data.
|
|
|
|
::
|
2019-02-02 00:46:09 +03:00
|
|
|
++ rung
|
jael: provide edge-triggered breach notification
Until now, clients of Jael have had to store the first-seen rift if they
want to reliably detect breaches. Otherwise, they would get a false
positive if they heard an old message about a breach (eg if you kick
azimuth-tracker). Clay and Gall did this correctly, but Ames did not.
Jael already maintains this state, so I added a notification to the
existing subscription that happens whenever it notices a breach (a diff
or full where the new rift is greater than the old one).
Because this is an issue on the live network, I wrote state adapters
for Gall and Clay. The Gall one just removes the rift from our state,
but the Clay one is much more involved because we have to upgrade
instances of the clad monad that are possibly in progress.
Specifically, since more input is possible than before, we must wrap any
in-progress instances of the monad in a function that handles the
potential new input from Jael. This temporarily preservers a copy of
the old kernel, but only until the current commit/merge/update has
completed.
The real solution for Clay is to factor out those IO-heavy instances to
userspace tapp/async/imp/threads, and if an upgrade happens in the
middle, you should simply restart them.
Fixes #1852
2019-10-24 07:26:38 +03:00
|
|
|
$: rus=(map desk rede) :: neighbor desks
|
2019-02-02 00:46:09 +03:00
|
|
|
==
|
2016-11-24 07:25:07 +03:00
|
|
|
::
|
|
|
|
:: Hash of a commit, for lookup in the object store (hut.ran)
|
|
|
|
::
|
|
|
|
++ tako @ :: yaki ref
|
|
|
|
::
|
|
|
|
:: Commit.
|
|
|
|
::
|
|
|
|
:: List of parents, content, hash of self, and time commited.
|
|
|
|
::
|
|
|
|
++ yaki :: snapshot
|
|
|
|
$: p/(list tako) :: parents
|
|
|
|
q/(map path lobe) :: fileset
|
2016-12-16 09:34:01 +03:00
|
|
|
r/tako ::
|
2016-11-24 07:25:07 +03:00
|
|
|
:: :: XX s?
|
|
|
|
t/@da :: date
|
|
|
|
== ::
|
|
|
|
::
|
|
|
|
:: Unvalidated blob
|
|
|
|
::
|
|
|
|
++ plop blob :: unvalidated blob
|
2019-05-02 04:21:32 +03:00
|
|
|
::
|
2019-05-14 08:20:46 +03:00
|
|
|
:: The clay monad, for easier-to-follow state machines.
|
|
|
|
::
|
|
|
|
:: The best way to think about a clad is that it's a transaction that
|
|
|
|
:: may take multiple arvo events, and may send notes to other vanes to
|
|
|
|
:: get information.
|
2019-05-02 04:21:32 +03:00
|
|
|
::
|
2019-05-03 04:06:31 +03:00
|
|
|
+$ clad-input [now=@da new-rang=rang =sign]
|
2019-05-02 04:21:32 +03:00
|
|
|
::
|
|
|
|
:: notes: notes to send immediately. These will go out even if a
|
|
|
|
:: later stage of the process fails, so they shouldn't have any
|
2019-05-16 23:44:41 +03:00
|
|
|
:: semantic effect on the rest of the system. Path is
|
|
|
|
:: included exclusively for documentation and |verb.
|
2019-05-02 04:21:32 +03:00
|
|
|
:: effects: moves to send after the process ends.
|
2019-05-14 08:20:46 +03:00
|
|
|
:: wait: don't move on, stay here. The next sign should come back
|
|
|
|
:: to this same callback.
|
|
|
|
:: cont: continue process with new callback.
|
2019-05-02 04:21:32 +03:00
|
|
|
:: fail: abort process; don't send effects
|
|
|
|
:: done: finish process; send effects
|
|
|
|
::
|
|
|
|
++ clad-output-raw
|
|
|
|
|* a=mold
|
|
|
|
$~ [~ ~ %done *a]
|
2019-05-16 21:50:13 +03:00
|
|
|
$: notes=(list [path note])
|
2019-05-02 04:21:32 +03:00
|
|
|
effects=(list move)
|
|
|
|
$= next
|
|
|
|
$% [%wait ~]
|
|
|
|
[%cont self=(clad-form-raw a)]
|
2019-05-04 05:24:24 +03:00
|
|
|
[%fail err=(pair term tang)]
|
2019-05-02 04:21:32 +03:00
|
|
|
[%done value=a]
|
|
|
|
==
|
|
|
|
==
|
|
|
|
::
|
|
|
|
++ clad-form-raw
|
|
|
|
|* a=mold
|
|
|
|
$-(clad-input (clad-output-raw a))
|
|
|
|
::
|
|
|
|
++ clad-fail
|
2019-05-04 05:24:24 +03:00
|
|
|
|= err=(pair term tang)
|
2019-05-02 04:21:32 +03:00
|
|
|
|= clad-input
|
|
|
|
[~ ~ %fail err]
|
|
|
|
::
|
2019-05-17 03:24:10 +03:00
|
|
|
++ clad-init-sign `sign`[%y %init-clad ~]
|
|
|
|
::
|
2019-05-02 04:21:32 +03:00
|
|
|
++ clad
|
|
|
|
|* a=mold
|
|
|
|
|%
|
|
|
|
++ output (clad-output-raw a)
|
|
|
|
++ form (clad-form-raw a)
|
|
|
|
++ pure
|
2019-05-16 23:44:41 +03:00
|
|
|
|= arg=a
|
2019-05-02 04:21:32 +03:00
|
|
|
^- form
|
|
|
|
|= clad-input
|
|
|
|
[~ ~ %done arg]
|
|
|
|
::
|
|
|
|
++ bind
|
|
|
|
|* b=mold
|
|
|
|
|= [m-b=(clad-form-raw b) fun=$-(b form)]
|
|
|
|
^- form
|
|
|
|
|= input=clad-input
|
|
|
|
=/ b-res=(clad-output-raw b)
|
|
|
|
(m-b input)
|
|
|
|
^- output
|
|
|
|
:+ notes.b-res effects.b-res
|
|
|
|
?- -.next.b-res
|
|
|
|
%wait [%wait ~]
|
|
|
|
%cont [%cont ..$(m-b self.next.b-res)]
|
2019-05-04 05:24:24 +03:00
|
|
|
%fail [%fail err.next.b-res]
|
2019-05-02 04:21:32 +03:00
|
|
|
%done [%cont (fun value.next.b-res)]
|
|
|
|
==
|
2019-05-16 23:44:41 +03:00
|
|
|
::
|
|
|
|
:: The clad monad must be evaluted in a particular way to maintain
|
|
|
|
:: its monadic character. +take:eval implements this.
|
|
|
|
::
|
|
|
|
++ eval
|
|
|
|
|%
|
|
|
|
:: Indelible state of a clad
|
|
|
|
::
|
|
|
|
+$ eval-form
|
|
|
|
$: effects=(list move)
|
|
|
|
=form
|
|
|
|
==
|
|
|
|
::
|
2019-05-17 03:24:10 +03:00
|
|
|
:: Convert initial form to eval-form
|
|
|
|
::
|
|
|
|
++ from-form
|
|
|
|
|= =form
|
|
|
|
^- eval-form
|
|
|
|
[~ form]
|
|
|
|
::
|
2019-05-16 23:44:41 +03:00
|
|
|
:: The cases of results of +take
|
|
|
|
::
|
|
|
|
+$ eval-result
|
|
|
|
$% [%next ~]
|
|
|
|
[%fail err=(pair term tang)]
|
|
|
|
[%done value=a]
|
|
|
|
==
|
|
|
|
::
|
|
|
|
:: Take a new sign and run the clad against it
|
|
|
|
::
|
|
|
|
++ take
|
|
|
|
:: moves: accumulate throughout recursion the moves to be
|
|
|
|
:: produced now
|
|
|
|
=| moves=(list move)
|
|
|
|
|= [=eval-form =duct =our=wire =clad-input]
|
|
|
|
^- [[(list move) =eval-result] _eval-form]
|
|
|
|
:: run the clad callback
|
|
|
|
::
|
|
|
|
=/ =output (form.eval-form clad-input)
|
|
|
|
:: add notes to moves
|
|
|
|
::
|
|
|
|
=. moves
|
|
|
|
%+ welp
|
|
|
|
moves
|
|
|
|
%+ turn notes.output
|
|
|
|
|= [=path =note]
|
|
|
|
[duct %pass (weld our-wire path) note]
|
|
|
|
:: add effects to list to be produced when done
|
|
|
|
::
|
|
|
|
=. effects.eval-form
|
|
|
|
(weld effects.eval-form effects.output)
|
|
|
|
:: if done, produce effects
|
|
|
|
::
|
|
|
|
=? moves ?=(%done -.next.output)
|
|
|
|
%+ welp
|
|
|
|
moves
|
|
|
|
effects.eval-form
|
|
|
|
:: case-wise handle next steps
|
|
|
|
::
|
|
|
|
?- -.next.output
|
|
|
|
%wait [[moves %next ~] eval-form]
|
|
|
|
%fail [[moves %fail err.next.output] eval-form]
|
|
|
|
%done [[moves %done value.next.output] eval-form]
|
|
|
|
%cont
|
|
|
|
:: recurse to run continuation with initialization move
|
|
|
|
::
|
|
|
|
%_ $
|
|
|
|
form.eval-form self.next.output
|
2019-05-17 03:24:10 +03:00
|
|
|
sign.clad-input clad-init-sign
|
2019-05-16 23:44:41 +03:00
|
|
|
==
|
|
|
|
==
|
|
|
|
--
|
2019-05-02 04:21:32 +03:00
|
|
|
--
|
|
|
|
::
|
2019-05-17 03:24:10 +03:00
|
|
|
::
|
2016-11-24 07:25:07 +03:00
|
|
|
++ move {p/duct q/(wind note gift:able)} :: local move
|
|
|
|
++ note :: out request $->
|
2019-05-25 12:29:42 +03:00
|
|
|
$~ [%b %wait *@da] ::
|
|
|
|
$% $: %a :: to %ames
|
2019-07-29 09:37:49 +03:00
|
|
|
$>(%plea task:able:ames) ::
|
2019-05-25 12:29:42 +03:00
|
|
|
== ::
|
|
|
|
$: %b :: to %behn
|
|
|
|
$> $? %drip ::
|
|
|
|
%rest ::
|
|
|
|
%wait ::
|
|
|
|
== ::
|
|
|
|
task:able:behn ::
|
|
|
|
== ::
|
|
|
|
$: %c :: to %clay
|
|
|
|
$> $? %info :: internal edit
|
|
|
|
%merg :: merge desks
|
|
|
|
%warp ::
|
|
|
|
%werp ::
|
|
|
|
== ::
|
|
|
|
task:able ::
|
|
|
|
== ::
|
|
|
|
$: %d :: to %dill
|
|
|
|
$>(%flog task:able:dill) ::
|
|
|
|
== ::
|
|
|
|
$: %f :: to %ford
|
|
|
|
$> $? %build ::
|
|
|
|
%keep ::
|
|
|
|
%wipe ::
|
|
|
|
== ::
|
|
|
|
task:able:ford ::
|
2019-07-27 09:36:59 +03:00
|
|
|
== ::
|
2019-08-07 01:42:37 +03:00
|
|
|
$: %j :: by %jael
|
|
|
|
$>(%public-keys task:able:jael) ::
|
2019-01-31 05:48:30 +03:00
|
|
|
== == ::
|
2016-11-24 07:25:07 +03:00
|
|
|
++ riot (unit rant) :: response+complete
|
|
|
|
++ sign :: in result $<-
|
2019-05-25 12:29:42 +03:00
|
|
|
$~ [%b %wake ~] ::
|
|
|
|
$% $: %y ::
|
|
|
|
$% [%init-clad ~] ::
|
|
|
|
== == ::
|
|
|
|
$: %a :: by %ames
|
2019-08-28 06:12:56 +03:00
|
|
|
$> $? %boon :: response
|
|
|
|
%done :: (n)ack
|
|
|
|
%lost :: lost boon
|
2019-05-25 12:29:42 +03:00
|
|
|
== ::
|
|
|
|
gift:able:ames ::
|
|
|
|
== ::
|
|
|
|
$: %b :: by %behn
|
|
|
|
$% $>(%wake gift:able:behn) :: timer activate
|
|
|
|
$>(%writ gift:able) :: XX %slip
|
|
|
|
== == ::
|
|
|
|
$: %c :: by %clay
|
|
|
|
$> $? %mere ::
|
|
|
|
%note ::
|
|
|
|
%writ ::
|
|
|
|
== ::
|
|
|
|
gift:able ::
|
|
|
|
== ::
|
|
|
|
$: %f :: by %ford
|
|
|
|
$>(%made gift:able:ford) ::
|
|
|
|
== ::
|
2019-08-07 01:42:37 +03:00
|
|
|
$: %j :: by %jael
|
|
|
|
$>(%public-keys gift:able:jael) ::
|
2019-07-27 06:43:07 +03:00
|
|
|
== ::
|
2019-05-25 12:29:42 +03:00
|
|
|
$: @tas :: by any
|
2019-05-27 10:41:03 +03:00
|
|
|
$>(%crud vane-task) :: XX strange
|
|
|
|
== == ::
|
2016-11-24 07:25:07 +03:00
|
|
|
-- =>
|
2020-03-04 01:12:01 +03:00
|
|
|
~% %clay-utilities ..is ~
|
2018-10-04 21:37:42 +03:00
|
|
|
:: %utilities
|
|
|
|
::
|
|
|
|
|%
|
|
|
|
:: +sort-by-head: sorts alphabetically using the head of each element
|
|
|
|
::
|
|
|
|
++ sort-by-head
|
|
|
|
|=([a=(pair path *) b=(pair path *)] (aor p.a p.b))
|
|
|
|
::
|
2019-05-02 04:21:32 +03:00
|
|
|
:: Just send a note.
|
|
|
|
::
|
|
|
|
++ just-do
|
2019-05-16 21:50:13 +03:00
|
|
|
|= [=path =note]
|
2019-05-02 04:21:32 +03:00
|
|
|
=/ m (clad ,~)
|
|
|
|
^- form:m
|
|
|
|
|= clad-input
|
2019-05-16 21:50:13 +03:00
|
|
|
[[path note]~ ~ %done ~]
|
2019-05-02 04:21:32 +03:00
|
|
|
::
|
|
|
|
:: Wait for ford to respond
|
|
|
|
::
|
|
|
|
++ expect-ford
|
|
|
|
=/ m (clad ,made-result:ford)
|
|
|
|
^- form:m
|
|
|
|
|= clad-input
|
|
|
|
?: ?=(%init-clad +<.sign)
|
|
|
|
[~ ~ %wait ~]
|
|
|
|
?: ?=(%made +<.sign)
|
|
|
|
[~ ~ %done result.sign]
|
|
|
|
~| [%expected-made got=+<.sign]
|
|
|
|
!!
|
2019-05-03 04:06:31 +03:00
|
|
|
::
|
|
|
|
:: Wait for clay to respond
|
|
|
|
::
|
|
|
|
:: This setup where we take in a new-rang in +clad-input but only
|
|
|
|
:: apply it when calling +expect-clay is suspicious. I'm not sure
|
|
|
|
:: what's the best approach to reading in potentially new state that
|
|
|
|
:: we also may have changed but haven't committed.
|
|
|
|
::
|
|
|
|
++ expect-clay
|
|
|
|
|= ran=rang
|
|
|
|
=/ m (clad ,[riot rang])
|
|
|
|
^- form:m
|
|
|
|
|= clad-input
|
|
|
|
?: ?=(%init-clad +<.sign)
|
|
|
|
[~ ~ %wait ~]
|
|
|
|
?: ?=(%writ +<.sign)
|
|
|
|
=/ uni-rang=rang
|
2019-07-25 03:06:41 +03:00
|
|
|
:- (~(uni by hut.new-rang) hut.ran)
|
|
|
|
(~(uni by lat.new-rang) lat.ran)
|
2019-05-03 04:06:31 +03:00
|
|
|
[~ ~ %done p.sign uni-rang]
|
|
|
|
~| [%expected-writ got=+<.sign]
|
|
|
|
!!
|
2018-10-04 21:37:42 +03:00
|
|
|
-- =>
|
2020-03-04 01:12:01 +03:00
|
|
|
~% %clay + ~
|
2019-05-03 04:50:20 +03:00
|
|
|
|%
|
2019-05-23 08:35:09 +03:00
|
|
|
:: Printable form of a wove; useful for debugging
|
|
|
|
::
|
|
|
|
++ print-wove
|
|
|
|
|= =wove
|
|
|
|
:- for.wove
|
|
|
|
?- -.rove.wove
|
|
|
|
%sing [%sing mood.rove.wove]
|
|
|
|
%next [%next [mood aeon]:rove.wove]
|
|
|
|
%mult [%mult [mool aeon]:rove.wove]
|
|
|
|
%many [%many [track moat]:rove.wove]
|
|
|
|
==
|
|
|
|
::
|
|
|
|
:: Printable form of a cult; useful for debugging
|
|
|
|
::
|
|
|
|
++ print-cult
|
|
|
|
|= =cult
|
|
|
|
%+ turn ~(tap by cult)
|
|
|
|
|= [=wove ducts=(set duct)]
|
|
|
|
[ducts (print-wove wove)]
|
|
|
|
::
|
2019-05-03 04:50:20 +03:00
|
|
|
::
|
2019-05-14 08:20:46 +03:00
|
|
|
:: Make a new commit with the given +nori of changes.
|
2019-05-03 04:50:20 +03:00
|
|
|
::
|
2019-05-11 00:51:37 +03:00
|
|
|
++ commit
|
2019-05-14 08:20:46 +03:00
|
|
|
:: Global constants. These do not change during a commit.
|
2019-05-04 05:24:24 +03:00
|
|
|
::
|
|
|
|
|= $: our=ship
|
|
|
|
syd=desk
|
|
|
|
wen=@da
|
|
|
|
mon=(map term beam)
|
|
|
|
hez=(unit duct)
|
2019-05-10 04:06:18 +03:00
|
|
|
hun=duct
|
2019-05-04 05:24:24 +03:00
|
|
|
==
|
2019-05-03 04:50:20 +03:00
|
|
|
|^
|
2019-05-04 05:24:24 +03:00
|
|
|
:: Initial arguments
|
|
|
|
::
|
2019-05-11 00:51:37 +03:00
|
|
|
|= [lem=nori original-dome=dome ran=rang]
|
2019-05-04 05:24:24 +03:00
|
|
|
=/ m commit-clad
|
2019-05-03 04:50:20 +03:00
|
|
|
^- form:m
|
|
|
|
?: ?=(%| -.lem)
|
2019-05-14 08:20:46 +03:00
|
|
|
:: If the change is just adding a label, handle it directly.
|
|
|
|
::
|
2019-05-11 00:51:37 +03:00
|
|
|
=. original-dome
|
|
|
|
(execute-label:(state:util original-dome original-dome ran) p.lem)
|
|
|
|
=/ e (cor original-dome ran)
|
2019-05-04 05:24:24 +03:00
|
|
|
;< ~ bind:m (print-changes:e %| p.lem)
|
2019-05-10 04:06:18 +03:00
|
|
|
(pure:m dom:e ran:e)
|
2019-05-14 08:20:46 +03:00
|
|
|
::
|
|
|
|
:: Else, collect the data, apply it, fill in our local cache, let
|
|
|
|
:: unix know, and print a notification to the screen.
|
|
|
|
::
|
2019-05-11 00:51:37 +03:00
|
|
|
=/ e (cor original-dome ran)
|
2019-05-14 08:20:46 +03:00
|
|
|
;< [=dork mim=(map path mime)] bind:m (fill-dork:e wen p.lem)
|
|
|
|
;< [=suba e=_*cor] bind:m (apply-dork:e wen dork)
|
|
|
|
;< e=_*cor bind:m checkout-new-state:e
|
2019-05-16 01:50:13 +03:00
|
|
|
;< mim=(map path mime) bind:m (ergo-changes:e suba mim)
|
2019-05-14 08:20:46 +03:00
|
|
|
;< ~ bind:m (print-changes:e %& suba)
|
2019-05-23 05:12:44 +03:00
|
|
|
=. mim.dom.e mim
|
2019-05-10 04:06:18 +03:00
|
|
|
(pure:m dom:e ran:e)
|
2019-05-03 04:50:20 +03:00
|
|
|
::
|
2019-05-04 05:24:24 +03:00
|
|
|
:: A stateful core, where the global state is a dome and a rang.
|
|
|
|
::
|
|
|
|
:: These are the global state variables that an edit may change.
|
|
|
|
::
|
|
|
|
++ cor
|
2019-05-11 00:51:37 +03:00
|
|
|
|= [dom=dome ran=rang]
|
|
|
|
=/ original-dome dom
|
|
|
|
|%
|
2019-05-04 05:24:24 +03:00
|
|
|
++ this-cor .
|
2019-05-11 00:51:37 +03:00
|
|
|
++ sutil (state:util original-dome dom ran)
|
2019-05-14 08:20:46 +03:00
|
|
|
::
|
|
|
|
:: Collect all the insertions, deletions, diffs, and mutations
|
|
|
|
:: which are requested.
|
|
|
|
::
|
|
|
|
:: Sends them through ford for casting, patching, and diffing so
|
|
|
|
:: that the produced dork has all the relevant cages filled in.
|
|
|
|
::
|
|
|
|
:: Also fills in the mime cache. Often we need to convert to mime
|
|
|
|
:: anyway to send (back) to unix, so we just keep it around rather
|
|
|
|
:: than recalculating it. This is less necessary than before
|
|
|
|
:: because of the ford cache.
|
|
|
|
::
|
2019-05-04 05:24:24 +03:00
|
|
|
++ fill-dork
|
|
|
|
|= [wen=@da =soba]
|
2019-05-14 08:20:46 +03:00
|
|
|
=/ m (clad ,[=dork mim=(map path mime)])
|
2019-05-04 05:24:24 +03:00
|
|
|
^- form:m
|
|
|
|
=| $= nuz
|
|
|
|
$: del=(list (pair path miso))
|
|
|
|
ins=(list (pair path miso))
|
|
|
|
dif=(list (pair path miso))
|
|
|
|
mut=(list (pair path miso))
|
|
|
|
ink=(list (pair path miso))
|
|
|
|
==
|
2019-05-03 04:50:20 +03:00
|
|
|
::
|
2019-05-04 05:24:24 +03:00
|
|
|
=. nuz
|
|
|
|
|- ^+ nuz
|
|
|
|
?~ soba nuz
|
2019-05-03 04:50:20 +03:00
|
|
|
::
|
2019-05-04 05:24:24 +03:00
|
|
|
?- -.q.i.soba
|
|
|
|
%del $(soba t.soba, del.nuz [i.soba del.nuz])
|
|
|
|
%dif $(soba t.soba, dif.nuz [i.soba dif.nuz])
|
|
|
|
%ins
|
|
|
|
=/ pax=path p.i.soba
|
|
|
|
=/ mar=mark p.p.q.i.soba
|
2019-05-03 04:50:20 +03:00
|
|
|
::
|
2019-05-14 08:20:46 +03:00
|
|
|
:: We store `%hoon` files directly to `ink` so that we add
|
|
|
|
:: them without requiring any mark definitions. `%hoon`
|
|
|
|
:: files have to be treated specially to make the
|
|
|
|
:: bootstrapping sequence work, since the mark definitions
|
|
|
|
:: are themselves `%hoon` files.
|
|
|
|
::
|
2019-05-04 05:24:24 +03:00
|
|
|
?: ?& ?=([%hoon *] (flop pax))
|
|
|
|
?=(%mime mar)
|
|
|
|
==
|
|
|
|
$(soba t.soba, ink.nuz [i.soba ink.nuz])
|
|
|
|
$(soba t.soba, ins.nuz [i.soba ins.nuz])
|
2019-05-03 04:50:20 +03:00
|
|
|
::
|
2019-05-04 05:24:24 +03:00
|
|
|
%mut
|
|
|
|
=/ pax=path p.i.soba
|
|
|
|
=/ mis=miso q.i.soba
|
|
|
|
?> ?=(%mut -.mis)
|
|
|
|
=/ cag=cage p.mis
|
2019-05-16 01:50:13 +03:00
|
|
|
:: if :mis has the %mime mark and it's the same as cached, no-op
|
|
|
|
::
|
|
|
|
?: ?. =(%mime p.cag)
|
|
|
|
%.n
|
|
|
|
?~ cached=(~(get by mim.dom) pax)
|
|
|
|
%.n
|
|
|
|
=(q:;;(mime q.q.cag) q.u.cached)
|
|
|
|
::
|
|
|
|
$(soba t.soba)
|
2019-05-04 05:24:24 +03:00
|
|
|
:: if the :mis mark is the target mark and the value is the same, no-op
|
|
|
|
::
|
|
|
|
?: =/ target-mark=mark =+(spur=(flop pax) ?~(spur !! i.spur))
|
|
|
|
?. =(target-mark p.cag)
|
|
|
|
%.n
|
|
|
|
::
|
|
|
|
=/ stored (need (need (read-x:sutil & let.dom pax)))
|
|
|
|
=/ stored-cage=cage ?>(?=(%& -.stored) p.stored)
|
|
|
|
::
|
|
|
|
=(q.q.stored-cage q.q.cag)
|
2019-05-03 04:50:20 +03:00
|
|
|
::
|
2019-05-04 05:24:24 +03:00
|
|
|
$(soba t.soba)
|
|
|
|
:: the value differs from what's stored, so register mutation
|
2019-05-03 04:50:20 +03:00
|
|
|
::
|
2019-05-04 05:24:24 +03:00
|
|
|
$(soba t.soba, mut.nuz [i.soba mut.nuz])
|
|
|
|
==
|
|
|
|
:: sort each section alphabetically for determinism
|
|
|
|
::
|
|
|
|
=. nuz :*
|
|
|
|
(sort del.nuz sort-by-head)
|
|
|
|
(sort ins.nuz sort-by-head)
|
|
|
|
(sort dif.nuz sort-by-head)
|
|
|
|
(sort mut.nuz sort-by-head)
|
|
|
|
(sort ink.nuz sort-by-head)
|
2019-05-03 04:50:20 +03:00
|
|
|
==
|
2019-05-04 05:24:24 +03:00
|
|
|
=/ ink
|
|
|
|
%+ turn ink.nuz
|
|
|
|
|= {pax/path mis/miso}
|
|
|
|
^- (pair path cage)
|
|
|
|
?> ?=($ins -.mis)
|
|
|
|
=+ =>((flop pax) ?~(. %$ i))
|
2019-05-15 21:13:25 +03:00
|
|
|
[pax - [%atom %t ~] ;;(@t +>.q.q.p.mis)]
|
2019-05-03 04:50:20 +03:00
|
|
|
::
|
2019-05-14 08:20:46 +03:00
|
|
|
=/ mim
|
|
|
|
:: add the new files to the new mime cache
|
2019-05-03 04:50:20 +03:00
|
|
|
::
|
2019-05-14 08:20:46 +03:00
|
|
|
%- malt
|
2019-05-03 04:50:20 +03:00
|
|
|
^- (list (pair path mime))
|
2019-05-04 05:24:24 +03:00
|
|
|
;: weld
|
|
|
|
^- (list (pair path mime))
|
|
|
|
%+ murn ins.nuz
|
2019-05-03 04:50:20 +03:00
|
|
|
|= {pax/path mis/miso}
|
2019-05-04 05:24:24 +03:00
|
|
|
^- (unit (pair path mime))
|
2019-05-03 04:50:20 +03:00
|
|
|
?> ?=($ins -.mis)
|
2019-05-04 05:24:24 +03:00
|
|
|
?. ?=($mime p.p.mis)
|
|
|
|
~
|
2019-05-15 21:13:25 +03:00
|
|
|
`[pax ;;(mime q.q.p.mis)]
|
2019-05-04 05:24:24 +03:00
|
|
|
::
|
|
|
|
^- (list (pair path mime))
|
|
|
|
%+ murn ink.nuz
|
2019-05-03 04:50:20 +03:00
|
|
|
|= {pax/path mis/miso}
|
2019-05-04 05:24:24 +03:00
|
|
|
^- (unit (pair path mime))
|
|
|
|
?> ?=($ins -.mis)
|
|
|
|
?> ?=($mime p.p.mis)
|
2019-05-15 21:13:25 +03:00
|
|
|
`[pax ;;(mime q.q.p.mis)]
|
2019-05-04 05:24:24 +03:00
|
|
|
::
|
|
|
|
^- (list (pair path mime))
|
|
|
|
%+ murn mut.nuz
|
2019-05-03 04:50:20 +03:00
|
|
|
|= {pax/path mis/miso}
|
2019-05-04 05:24:24 +03:00
|
|
|
^- (unit (pair path mime))
|
2019-05-03 04:50:20 +03:00
|
|
|
?> ?=($mut -.mis)
|
2019-05-04 05:24:24 +03:00
|
|
|
?. ?=($mime p.p.mis)
|
|
|
|
~
|
2019-05-15 21:13:25 +03:00
|
|
|
`[pax ;;(mime q.q.p.mis)]
|
2019-05-04 05:24:24 +03:00
|
|
|
==
|
|
|
|
::
|
2019-05-14 08:20:46 +03:00
|
|
|
;< ins=(list (pair path cage)) bind:m (calc-inserts wen ins.nuz)
|
|
|
|
;< dif=(list (trel path lobe cage)) bind:m (calc-diffs wen dif.nuz)
|
|
|
|
;< mut=(list (trel path lobe cage)) bind:m (calc-mutates wen mut.nuz)
|
2019-05-04 05:24:24 +03:00
|
|
|
%+ pure:m
|
|
|
|
^- dork
|
|
|
|
[del=(turn del.nuz head) ink ins dif mut]
|
2019-05-14 08:20:46 +03:00
|
|
|
mim
|
|
|
|
::
|
|
|
|
:: Build the list of insertions by casting to the correct mark.
|
2019-05-04 05:24:24 +03:00
|
|
|
::
|
2019-05-14 08:20:46 +03:00
|
|
|
++ calc-inserts
|
2019-05-04 05:24:24 +03:00
|
|
|
|= [wen=@da ins=(list (pair path miso))]
|
|
|
|
=/ m (clad (list (pair path cage)))
|
|
|
|
^- form:m
|
|
|
|
;< ~ bind:m
|
2019-05-16 21:50:13 +03:00
|
|
|
%+ just-do /inserts
|
2019-05-04 05:24:24 +03:00
|
|
|
:* %f %build live=%.n %pin wen %list
|
|
|
|
^- (list schematic:ford)
|
|
|
|
%+ turn ins
|
2019-05-11 00:51:37 +03:00
|
|
|
|= [pax=path mis=miso]
|
2019-05-04 05:24:24 +03:00
|
|
|
?> ?=($ins -.mis)
|
|
|
|
:- [%$ %path -:!>(*path) pax]
|
|
|
|
=+ =>((flop pax) ?~(. %$ i))
|
2019-05-11 00:51:37 +03:00
|
|
|
[%cast [our syd] - [%$ p.mis]]
|
2019-05-04 05:24:24 +03:00
|
|
|
==
|
|
|
|
;< res=made-result:ford bind:m expect-ford
|
|
|
|
^- form:m
|
2019-05-03 04:50:20 +03:00
|
|
|
|= clad-input
|
2019-05-04 05:24:24 +03:00
|
|
|
:^ ~ ~ %done
|
|
|
|
^- (list (pair path cage))
|
|
|
|
%+ turn (made-result-to-success-cages:util res)
|
|
|
|
|= {pax/cage cay/cage}
|
|
|
|
?. ?=($path p.pax)
|
|
|
|
~|(%clay-take-inserting-strange-path-mark !!)
|
2019-05-15 21:13:25 +03:00
|
|
|
[;;(path q.q.pax) cay]
|
2019-05-04 05:24:24 +03:00
|
|
|
::
|
2019-05-14 08:20:46 +03:00
|
|
|
:: Build the list of diffs by apply the given diffs to the existing
|
|
|
|
:: data.
|
|
|
|
::
|
|
|
|
++ calc-diffs
|
2019-05-04 05:24:24 +03:00
|
|
|
|= [wen=@da dif=(list (pair path miso))]
|
|
|
|
=/ m (clad (list (trel path lobe cage)))
|
|
|
|
^- form:m
|
|
|
|
;< ~ bind:m
|
2019-05-16 21:50:13 +03:00
|
|
|
%+ just-do /diffs
|
2019-05-04 05:24:24 +03:00
|
|
|
:* %f %build live=%.n %pin wen %list
|
|
|
|
^- (list schematic:ford)
|
|
|
|
%+ turn dif
|
|
|
|
|= {pax/path mis/miso}
|
|
|
|
?> ?=($dif -.mis)
|
|
|
|
=+ (need (need (read-x:sutil & let.dom pax)))
|
|
|
|
?> ?=(%& -<)
|
|
|
|
:- [%$ %path -:!>(*path) pax]
|
2019-05-11 00:51:37 +03:00
|
|
|
[%pact [our syd] [%$ p.-] [%$ p.mis]]
|
2019-05-04 05:24:24 +03:00
|
|
|
==
|
|
|
|
;< res=made-result:ford bind:m expect-ford
|
|
|
|
^- form:m
|
|
|
|
|= clad-input
|
|
|
|
:^ ~ ~ %done
|
|
|
|
^- (list (trel path lobe cage))
|
|
|
|
=/ dig=(map path cage)
|
|
|
|
%- malt
|
|
|
|
(turn dif |=({pax/path mis/miso} ?>(?=($dif -.mis) [pax p.mis])))
|
|
|
|
%+ turn (made-result-to-cages:util res)
|
|
|
|
|= {pax/cage cay/cage}
|
|
|
|
^- (pair path (pair lobe cage))
|
|
|
|
?. ?=($path p.pax)
|
|
|
|
~|(%clay-take-diffing-strange-path-mark !!)
|
2019-05-15 21:13:25 +03:00
|
|
|
=+ paf=;;(path q.q.pax)
|
2019-05-04 05:24:24 +03:00
|
|
|
[paf (page-to-lobe:sutil [p q.q]:cay) (~(got by dig) paf)]
|
|
|
|
::
|
2019-05-14 08:20:46 +03:00
|
|
|
:: Build the list of mutations by casting to the correct mark and
|
|
|
|
:: diffing against the existing data.
|
|
|
|
::
|
|
|
|
++ calc-mutates
|
2019-05-04 05:24:24 +03:00
|
|
|
|= [wen=@da mut=(list (pair path miso))]
|
|
|
|
=/ m (clad (list (trel path lobe cage)))
|
|
|
|
^- form:m
|
|
|
|
;< ~ bind:m
|
2019-05-16 21:50:13 +03:00
|
|
|
%+ just-do /casts
|
2019-05-04 05:24:24 +03:00
|
|
|
:* %f %build live=%.n %pin wen %list
|
|
|
|
::~ [her syd %da wen] %tabl
|
|
|
|
^- (list schematic:ford)
|
|
|
|
%+ turn mut
|
|
|
|
|= {pax/path mis/miso}
|
|
|
|
?> ?=($mut -.mis)
|
|
|
|
:- [%$ %path -:!>(*path) pax]
|
|
|
|
=/ mar
|
|
|
|
%- lobe-to-mark:sutil
|
|
|
|
(~(got by q:(aeon-to-yaki:sutil let.dom)) pax)
|
2019-05-11 00:51:37 +03:00
|
|
|
[%cast [our syd] mar [%$ p.mis]]
|
2019-05-04 05:24:24 +03:00
|
|
|
==
|
|
|
|
;< res=made-result:ford bind:m expect-ford
|
|
|
|
;< hashes=(map path lobe) bind:m
|
|
|
|
|= clad-input
|
2019-12-18 03:48:08 +03:00
|
|
|
=/ cat=(list (pair path cage))
|
2019-05-04 05:24:24 +03:00
|
|
|
%+ turn (made-result-to-cages:util res)
|
|
|
|
|= {pax/cage cay/cage}
|
|
|
|
?. ?=($path p.pax)
|
|
|
|
~|(%castify-bad-path-mark !!)
|
2019-05-15 21:13:25 +03:00
|
|
|
[;;(path q.q.pax) cay]
|
2019-05-04 05:24:24 +03:00
|
|
|
:_ :+ ~ %done
|
|
|
|
^- (map path lobe)
|
|
|
|
%- malt
|
|
|
|
%+ turn cat
|
|
|
|
|= {pax/path cay/cage}
|
|
|
|
[pax (page-to-lobe:sutil [p q.q]:cay)]
|
2019-05-16 21:50:13 +03:00
|
|
|
^- (list [path note])
|
2019-05-04 05:24:24 +03:00
|
|
|
:_ ~
|
2019-05-16 21:50:13 +03:00
|
|
|
:* /mutates
|
|
|
|
%f %build live=%.n %pin wen %list
|
2019-05-04 05:24:24 +03:00
|
|
|
^- (list schematic:ford)
|
|
|
|
%+ turn cat
|
|
|
|
|= {pax/path cay/cage}
|
|
|
|
:- [%$ %path -:!>(*path) pax]
|
|
|
|
=/ scheme
|
2019-05-11 00:51:37 +03:00
|
|
|
%^ lobe-to-schematic:sutil [our syd] pax
|
2019-05-04 05:24:24 +03:00
|
|
|
(~(got by q:(aeon-to-yaki:sutil let.dom)) pax)
|
2019-05-11 00:51:37 +03:00
|
|
|
[%diff [our syd] scheme [%$ cay]]
|
2019-05-04 05:24:24 +03:00
|
|
|
==
|
|
|
|
;< res=made-result:ford bind:m expect-ford
|
|
|
|
%- pure:m
|
|
|
|
^- (list (trel path lobe cage))
|
|
|
|
%+ murn (made-result-to-cages:util res)
|
|
|
|
|= {pax/cage cay/cage}
|
|
|
|
^- (unit (pair path (pair lobe cage)))
|
|
|
|
?. ?=($path p.pax)
|
|
|
|
~|(%clay-take-mutating-strange-path-mark !!)
|
|
|
|
?: ?=($null p.cay)
|
|
|
|
~
|
2019-05-15 21:13:25 +03:00
|
|
|
=+ paf=;;(path q.q.pax)
|
2019-05-04 05:24:24 +03:00
|
|
|
`[paf (~(got by hashes) paf) cay]
|
|
|
|
::
|
2019-05-14 08:20:46 +03:00
|
|
|
:: Collect the relevant data from dok and run +execute-changes to
|
|
|
|
:: apply them to our state.
|
2019-05-04 05:24:24 +03:00
|
|
|
::
|
|
|
|
++ apply-dork
|
|
|
|
|= [wen=@da =dork]
|
|
|
|
=/ m (clad ,[=suba _this-cor])
|
|
|
|
^- form:m
|
2019-12-18 03:48:08 +03:00
|
|
|
=/ sim=(list (pair path misu))
|
2019-05-04 05:24:24 +03:00
|
|
|
;: weld
|
|
|
|
^- (list (pair path misu))
|
|
|
|
(turn del.dork |=(pax/path [pax %del ~]))
|
|
|
|
::
|
|
|
|
^- (list (pair path misu))
|
|
|
|
(turn ink.dork |=({pax/path cay/cage} [pax %ins cay]))
|
|
|
|
::
|
|
|
|
^- (list (pair path misu))
|
|
|
|
(turn ins.dork |=({pax/path cay/cage} [pax %ins cay]))
|
|
|
|
::
|
|
|
|
^- (list (pair path misu))
|
|
|
|
(turn dif.dork |=({pax/path cal/{lobe cage}} [pax %dif cal]))
|
|
|
|
::
|
|
|
|
^- (list (pair path misu))
|
|
|
|
(turn mut.dork |=({pax/path cal/{lobe cage}} [pax %dif cal]))
|
|
|
|
==
|
|
|
|
=/ res=(unit [=dome =rang])
|
|
|
|
(execute-changes:sutil wen sim)
|
|
|
|
?~ res
|
|
|
|
(clad-fail %dork-fail ~)
|
|
|
|
=: dom dome.u.res
|
|
|
|
ran rang.u.res
|
|
|
|
==
|
|
|
|
(pure:m sim this-cor)
|
|
|
|
::
|
2019-05-14 08:20:46 +03:00
|
|
|
:: Take the map of paths to lobes, convert to blobs, and save the
|
|
|
|
:: resulting ankh to the dome.
|
2019-05-04 05:24:24 +03:00
|
|
|
::
|
|
|
|
++ checkout-new-state
|
|
|
|
=/ m (clad ,_this-cor)
|
|
|
|
^- form:m
|
|
|
|
;< ~ bind:m
|
2019-05-16 21:50:13 +03:00
|
|
|
%+ just-do /checkout
|
2019-05-04 05:24:24 +03:00
|
|
|
=/ new-yaki (aeon-to-yaki:sutil let.dom)
|
|
|
|
:* %f %build live=%.n %list
|
|
|
|
^- (list schematic:ford)
|
|
|
|
%+ turn (sort ~(tap by q.new-yaki) sort-by-head)
|
|
|
|
|= {a/path b/lobe}
|
|
|
|
^- schematic:ford
|
|
|
|
:- [%$ %path-hash !>([a b])]
|
2019-05-11 00:51:37 +03:00
|
|
|
(lobe-to-schematic:sutil [our syd] a b)
|
2019-05-04 05:24:24 +03:00
|
|
|
==
|
|
|
|
;< res=made-result:ford bind:m expect-ford
|
|
|
|
?. ?=([%complete %success *] res)
|
|
|
|
=/ message (made-result-as-error:ford res)
|
|
|
|
(clad-fail %checkout-fail leaf+"clay patch failed" message)
|
|
|
|
::
|
2019-12-18 03:48:08 +03:00
|
|
|
=/ cat/(list (trel path lobe cage))
|
2019-05-04 05:24:24 +03:00
|
|
|
%+ turn (made-result-to-cages:util res)
|
2019-05-03 04:50:20 +03:00
|
|
|
|= {pax/cage cay/cage}
|
2019-05-04 05:24:24 +03:00
|
|
|
?. ?=($path-hash p.pax)
|
|
|
|
~|(%patch-bad-path-mark !!)
|
2019-05-15 21:13:25 +03:00
|
|
|
[-< -> +]:[;;({path lobe} q.q.pax) cay]
|
2019-05-04 05:24:24 +03:00
|
|
|
=. ank.dom (map-to-ankh:sutil (malt cat))
|
|
|
|
(pure:m this-cor)
|
|
|
|
::
|
2019-05-14 08:20:46 +03:00
|
|
|
:: Choose which changes must be synced to unix, and do so. We
|
|
|
|
:: convert to mime before dropping the ergo event to unix.
|
2019-05-04 05:24:24 +03:00
|
|
|
::
|
|
|
|
++ ergo-changes
|
2019-05-14 08:20:46 +03:00
|
|
|
|= [=suba mim=(map path mime)]
|
2019-05-16 01:50:13 +03:00
|
|
|
=/ m (clad ,mim=(map path mime))
|
2019-05-04 05:24:24 +03:00
|
|
|
^- form:m
|
2019-05-16 01:50:13 +03:00
|
|
|
?~ hez (pure:m mim)
|
2019-05-04 05:24:24 +03:00
|
|
|
=+ must=(must-ergo:util our syd mon (turn suba head))
|
|
|
|
?: =(~ must)
|
2019-05-16 01:50:13 +03:00
|
|
|
(pure:m mim)
|
2019-12-18 03:48:08 +03:00
|
|
|
=/ all-paths/(set path)
|
2019-05-04 05:24:24 +03:00
|
|
|
%+ roll
|
|
|
|
(turn ~(tap by must) (corl tail tail))
|
|
|
|
|= {pak/(set path) acc/(set path)}
|
|
|
|
(~(uni in acc) pak)
|
2019-05-15 21:07:14 +03:00
|
|
|
=/ changes (malt suba)
|
2019-05-04 05:24:24 +03:00
|
|
|
;< ~ bind:m
|
2019-05-16 21:50:13 +03:00
|
|
|
%+ just-do /ergo
|
2019-05-04 05:24:24 +03:00
|
|
|
:* %f %build live=%.n %list
|
|
|
|
^- (list schematic:ford)
|
|
|
|
%+ turn ~(tap in all-paths)
|
|
|
|
|= a/path
|
|
|
|
^- schematic:ford
|
|
|
|
:- [%$ %path !>(a)]
|
|
|
|
=+ b=(~(got by changes) a)
|
|
|
|
?: ?=($del -.b)
|
|
|
|
[%$ %null !>(~)]
|
2019-05-14 08:20:46 +03:00
|
|
|
=+ (~(get by mim) a)
|
2019-05-04 05:24:24 +03:00
|
|
|
?^ - [%$ %mime !>(u.-)]
|
2019-05-11 00:51:37 +03:00
|
|
|
:^ %cast [our syd] %mime
|
2019-05-04 05:24:24 +03:00
|
|
|
=/ x (need (need (read-x:sutil & let.dom a)))
|
|
|
|
?: ?=(%& -<)
|
|
|
|
[%$ p.x]
|
2019-05-11 00:51:37 +03:00
|
|
|
(lobe-to-schematic:sutil [our syd] a p.x)
|
2019-05-03 04:50:20 +03:00
|
|
|
==
|
2019-05-04 05:24:24 +03:00
|
|
|
;< res=made-result:ford bind:m expect-ford
|
|
|
|
?: ?=([%incomplete *] res)
|
|
|
|
(clad-fail %ergo-fail-incomplete leaf+"clay ergo incomplete" tang.res)
|
|
|
|
?. ?=([%complete %success *] res)
|
|
|
|
(clad-fail %ergo-fail leaf+"clay ergo failed" message.build-result.res)
|
2019-05-15 21:13:25 +03:00
|
|
|
=/ changes=(map path (unit mime))
|
2019-05-04 05:24:24 +03:00
|
|
|
%- malt ^- mode
|
|
|
|
%+ turn (made-result-to-cages:util res)
|
|
|
|
|= [pax=cage mim=cage]
|
|
|
|
?. ?=($path p.pax)
|
|
|
|
~|(%ergo-bad-path-mark !!)
|
2019-05-15 21:13:25 +03:00
|
|
|
:- ;;(path q.q.pax)
|
2019-05-04 05:24:24 +03:00
|
|
|
?. ?=($mime p.mim)
|
|
|
|
~
|
2019-05-15 21:13:25 +03:00
|
|
|
`;;(mime q.q.mim)
|
2019-05-16 01:50:13 +03:00
|
|
|
=. mim (apply-changes-to-mim:util mim changes)
|
2019-05-18 00:59:03 +03:00
|
|
|
;< ~ bind:m (give-ergo:util u.hez our syd mon changes)
|
|
|
|
(pure:m mim)
|
2019-05-04 05:24:24 +03:00
|
|
|
::
|
|
|
|
:: Print a summary of changes to dill.
|
|
|
|
::
|
|
|
|
++ print-changes
|
|
|
|
|= lem=nuri
|
|
|
|
=/ m (clad ,~)
|
|
|
|
^- form:m
|
|
|
|
:: skip full change output for initial filesystem
|
|
|
|
::
|
|
|
|
?: ?& =(%base syd)
|
|
|
|
|(=(1 let.dom) =(2 let.dom))
|
|
|
|
?=([%& ^] lem)
|
|
|
|
==
|
|
|
|
=/ msg=tape
|
|
|
|
%+ weld
|
|
|
|
"clay: committed initial filesystem"
|
|
|
|
?:(=(1 let.dom) " (hoon)" " (all)")
|
|
|
|
|= clad-input
|
|
|
|
:- ~ :_ [%done ~]
|
2019-05-10 04:06:18 +03:00
|
|
|
[hun %pass / %d %flog %text msg]~
|
2019-05-04 05:24:24 +03:00
|
|
|
::
|
|
|
|
=+ pre=`path`~[(scot %p our) syd (scot %ud let.dom)]
|
|
|
|
?- -.lem
|
|
|
|
%| (print-to-dill '=' %leaf :(weld (trip p.lem) " " (spud pre)))
|
|
|
|
%&
|
|
|
|
|- ^- form:m
|
|
|
|
?~ p.lem (pure:m ~)
|
|
|
|
;< ~ bind:m
|
|
|
|
%+ print-to-dill
|
|
|
|
?-(-.q.i.p.lem $del '-', $ins '+', $dif ':')
|
|
|
|
:+ %rose ["/" "/" ~]
|
|
|
|
%+ turn (weld pre p.i.p.lem)
|
|
|
|
|= a/cord
|
|
|
|
?: ((sane %ta) a)
|
|
|
|
[%leaf (trip a)]
|
|
|
|
[%leaf (dash:us (trip a) '\'' ~)]
|
|
|
|
^$(p.lem t.p.lem)
|
2019-05-03 04:50:20 +03:00
|
|
|
==
|
2019-05-04 05:24:24 +03:00
|
|
|
::
|
2019-05-14 08:20:46 +03:00
|
|
|
:: Send a tank straight to dill for printing.
|
2019-05-04 05:24:24 +03:00
|
|
|
::
|
|
|
|
++ print-to-dill
|
|
|
|
|= {car/@tD tan/tank}
|
|
|
|
=/ m (clad ,~)
|
|
|
|
^- form:m
|
|
|
|
|= clad-input
|
|
|
|
:- ~ :_ [%done ~]
|
2019-05-10 04:06:18 +03:00
|
|
|
[hun %give %note car tan]~
|
2019-05-04 05:24:24 +03:00
|
|
|
--
|
2019-05-03 04:50:20 +03:00
|
|
|
--
|
|
|
|
::
|
2019-05-14 08:20:46 +03:00
|
|
|
:: This transaction respresents a currently running merge. We always
|
|
|
|
:: say we're merging from 'ali' to 'bob'. The basic steps, not all of
|
|
|
|
:: which are always needed, are:
|
2019-05-03 04:50:20 +03:00
|
|
|
::
|
|
|
|
:: -- fetch ali's desk
|
|
|
|
:: -- diff ali's desk against the mergebase
|
|
|
|
:: -- diff bob's desk against the mergebase
|
|
|
|
:: -- merge the diffs
|
|
|
|
:: -- build the new state
|
|
|
|
:: -- "checkout" (apply to actual `++dome`) the new state
|
|
|
|
:: -- "ergo" (tell unix about) any changes
|
|
|
|
::
|
|
|
|
++ merge
|
2019-05-04 05:24:24 +03:00
|
|
|
:: Global constants. These do not change during a merge.
|
|
|
|
::
|
|
|
|
|= $: our=ship
|
2019-05-10 04:06:18 +03:00
|
|
|
wen=@da
|
2019-05-04 05:24:24 +03:00
|
|
|
ali-disc=(pair ship desk)
|
|
|
|
bob-disc=(pair ship desk)
|
|
|
|
cas=case
|
|
|
|
mon=(map term beam)
|
|
|
|
hez=(unit duct)
|
|
|
|
==
|
2019-05-11 00:51:37 +03:00
|
|
|
:: Run ford operations on ali unless it's a foreign desk
|
|
|
|
::
|
|
|
|
=/ ford-disc=disc:ford
|
|
|
|
?: =(p.ali-disc p.bob-disc)
|
|
|
|
ali-disc
|
|
|
|
bob-disc
|
2019-05-03 04:50:20 +03:00
|
|
|
|^
|
2019-05-04 05:24:24 +03:00
|
|
|
:: Initial arguments
|
|
|
|
::
|
|
|
|
|= [gem=germ dom=dome ran=rang]
|
|
|
|
=/ m merge-clad
|
2019-05-03 04:50:20 +03:00
|
|
|
^- form:m
|
2019-05-11 00:51:37 +03:00
|
|
|
=/ e (cor dom ran)
|
2019-05-04 05:24:24 +03:00
|
|
|
;< [bob=(unit yaki) gem=germ] bind:m (get-bob:e gem)
|
2019-05-11 00:51:37 +03:00
|
|
|
;< [ali=yaki e=_*cor] bind:m fetch-ali:e
|
2019-05-03 04:50:20 +03:00
|
|
|
;< $= res
|
|
|
|
%- unit
|
|
|
|
$: conflicts=(set path)
|
|
|
|
bop=(map path cage)
|
|
|
|
new=yaki
|
|
|
|
erg=(map path ?)
|
2019-05-11 00:51:37 +03:00
|
|
|
e=_*cor
|
2019-05-03 04:50:20 +03:00
|
|
|
==
|
|
|
|
bind:m
|
2019-05-04 05:24:24 +03:00
|
|
|
(merge:e gem cas ali bob)
|
2019-05-03 04:50:20 +03:00
|
|
|
?~ res
|
2019-05-14 08:20:46 +03:00
|
|
|
:: if no changes, we're done
|
|
|
|
::
|
2019-05-10 04:06:18 +03:00
|
|
|
(pure:m ~ dom:e ran:e)
|
2019-05-04 05:24:24 +03:00
|
|
|
=. e e.u.res
|
2019-05-16 01:50:13 +03:00
|
|
|
;< e=_*cor bind:m (checkout:e gem cas bob new.u.res bop.u.res)
|
|
|
|
;< mim=(map path mime) bind:m (ergo:e gem cas mon erg.u.res new.u.res)
|
|
|
|
=. mim.dom.e mim
|
2019-05-10 04:06:18 +03:00
|
|
|
(pure:m conflicts.u.res dom:e ran:e)
|
2019-05-04 05:24:24 +03:00
|
|
|
::
|
2019-05-10 04:06:18 +03:00
|
|
|
:: A stateful core, where the global state is a dome and a rang.
|
2019-05-04 05:24:24 +03:00
|
|
|
::
|
|
|
|
:: These are the global state variables that a merge may change.
|
|
|
|
::
|
|
|
|
++ cor
|
2019-05-11 00:51:37 +03:00
|
|
|
|= [dom=dome ran=rang]
|
|
|
|
=/ original-dome dom
|
|
|
|
|%
|
2019-05-04 05:24:24 +03:00
|
|
|
++ this-cor .
|
2019-05-11 00:51:37 +03:00
|
|
|
++ sutil (state:util original-dome dom ran)
|
2019-05-14 08:20:46 +03:00
|
|
|
::
|
|
|
|
:: Fetch the local disk, if it's there.
|
|
|
|
::
|
2019-05-04 05:24:24 +03:00
|
|
|
++ get-bob
|
|
|
|
|= gem=germ
|
|
|
|
=/ m (clad ,[bob=(unit yaki) gem=germ])
|
|
|
|
^- form:m
|
|
|
|
?: &(=(0 let.dom) !?=(?(%init %that) gem))
|
2019-05-10 04:06:18 +03:00
|
|
|
(error:he cas %no-bob-disc ~)
|
2019-05-04 05:24:24 +03:00
|
|
|
?: =(0 let.dom)
|
|
|
|
(pure:m ~ %init)
|
2019-05-10 04:06:18 +03:00
|
|
|
=/ tak (~(get by hit.dom) let.dom)
|
2019-05-04 05:24:24 +03:00
|
|
|
?~ tak
|
2019-05-10 04:06:18 +03:00
|
|
|
(error:he cas %no-bob-version ~)
|
|
|
|
=/ bob (~(get by hut.ran) u.tak)
|
2019-05-04 05:24:24 +03:00
|
|
|
?~ bob
|
2019-05-10 04:06:18 +03:00
|
|
|
(error:he cas %no-bob-commit ~)
|
2019-05-04 05:24:24 +03:00
|
|
|
(pure:m `u.bob gem)
|
|
|
|
::
|
|
|
|
:: Tell clay to get the state at the requested case for ali's desk.
|
|
|
|
::
|
|
|
|
++ fetch-ali
|
2019-05-10 04:06:18 +03:00
|
|
|
=/ m (clad ,[ali=yaki e=_this-cor])
|
2019-05-04 05:24:24 +03:00
|
|
|
^- form:m
|
|
|
|
;< ~ bind:m
|
2019-05-16 21:50:13 +03:00
|
|
|
%+ just-do /fetch-ali
|
2019-05-10 04:06:18 +03:00
|
|
|
[%c %warp p.ali-disc q.ali-disc `[%sing %v cas /]]
|
2019-05-04 05:24:24 +03:00
|
|
|
;< [rot=riot r=rang] bind:m (expect-clay ran)
|
|
|
|
=. ran r
|
|
|
|
?~ rot
|
2019-05-10 04:06:18 +03:00
|
|
|
(error:he cas %bad-fetch-ali ~)
|
2019-05-15 21:13:25 +03:00
|
|
|
=/ ali-dome
|
|
|
|
;; $: ank=*
|
|
|
|
let=@ud
|
|
|
|
hit=(map @ud tako)
|
|
|
|
lab=(map @tas @ud)
|
|
|
|
==
|
|
|
|
q.q.r.u.rot
|
2019-05-04 05:24:24 +03:00
|
|
|
?: =(0 let.ali-dome)
|
2019-05-10 04:06:18 +03:00
|
|
|
(error:he cas %no-ali-disc ~)
|
2019-05-04 05:24:24 +03:00
|
|
|
=/ tak (~(get by hit.ali-dome) let.ali-dome)
|
|
|
|
?~ tak
|
2019-05-10 04:06:18 +03:00
|
|
|
(error:he cas %no-ali-version ~)
|
2019-05-04 05:24:24 +03:00
|
|
|
=/ ali (~(get by hut.ran) u.tak)
|
|
|
|
?~ ali
|
2019-05-10 04:06:18 +03:00
|
|
|
(error:he cas %no-ali-commit ~)
|
|
|
|
(pure:m u.ali this-cor)
|
2019-05-03 04:50:20 +03:00
|
|
|
::
|
2019-05-04 05:24:24 +03:00
|
|
|
:: Produce null if nothing to do; else perform merge
|
2019-05-03 04:50:20 +03:00
|
|
|
::
|
2019-05-04 05:24:24 +03:00
|
|
|
++ merge
|
|
|
|
|= [gem=germ cas=case ali=yaki bob=(unit yaki)]
|
|
|
|
=/ m
|
|
|
|
%- clad
|
|
|
|
%- unit
|
|
|
|
$: conflicts=(set path)
|
|
|
|
bop=(map path cage)
|
|
|
|
new=yaki
|
|
|
|
erg=(map path ?)
|
2019-05-11 00:51:37 +03:00
|
|
|
e=_this-cor
|
2019-05-04 05:24:24 +03:00
|
|
|
==
|
|
|
|
^- form:m
|
|
|
|
?- gem
|
|
|
|
::
|
|
|
|
:: If this is an %init merge, we set the ali's commit to be bob's, and
|
|
|
|
:: we checkout the new state.
|
|
|
|
::
|
|
|
|
$init
|
|
|
|
%^ pure:m ~ ~
|
|
|
|
:^ ~
|
|
|
|
ali
|
|
|
|
(~(run by q.ali) |=(lobe %&))
|
|
|
|
this-cor(hut.ran (~(put by hut.ran) r.ali ali))
|
|
|
|
::
|
|
|
|
:: If this is a %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.
|
|
|
|
::
|
|
|
|
$this
|
|
|
|
=/ bob (need bob)
|
|
|
|
?: =(r.ali r.bob)
|
|
|
|
(pure:m ~)
|
2019-05-10 04:06:18 +03:00
|
|
|
?: (~(has in (reachable-takos:sutil r.bob)) r.ali)
|
2019-05-04 05:24:24 +03:00
|
|
|
(pure:m ~)
|
2019-05-10 04:06:18 +03:00
|
|
|
=/ new (make-yaki:sutil [r.ali r.bob ~] q.bob wen)
|
2019-05-04 05:24:24 +03:00
|
|
|
%^ pure:m ~ ~
|
|
|
|
:^ ~
|
|
|
|
new
|
|
|
|
~
|
|
|
|
this-cor(hut.ran (~(put by hut.ran) r.new new))
|
|
|
|
::
|
|
|
|
:: If this is a %that merge, we check to see if ali's and bob's commits
|
|
|
|
:: are the same, in which case we're done. Otherwise, we create a new
|
|
|
|
:: commit with ali's data plus ali and bob as parents.
|
|
|
|
::
|
|
|
|
$that
|
|
|
|
=/ bob (need bob)
|
|
|
|
?: =(r.ali r.bob)
|
|
|
|
(pure:m ~)
|
2019-05-10 04:06:18 +03:00
|
|
|
=/ new (make-yaki:sutil [r.ali r.bob ~] q.ali wen)
|
2019-05-04 05:24:24 +03:00
|
|
|
%^ pure:m ~ ~
|
|
|
|
:^ ~
|
|
|
|
new
|
|
|
|
%- malt ^- (list {path ?})
|
|
|
|
%+ murn ~(tap by (~(uni by q.bob) q.ali))
|
|
|
|
|= {pax/path lob/lobe}
|
|
|
|
^- (unit {path ?})
|
|
|
|
=+ a=(~(get by q.ali) pax)
|
|
|
|
=+ b=(~(get by q.bob) pax)
|
|
|
|
?: =(a b)
|
|
|
|
~
|
|
|
|
`[pax !=(~ a)]
|
|
|
|
this-cor(hut.ran (~(put by hut.ran) r.new new))
|
|
|
|
::
|
|
|
|
:: If this is a %fine 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 check to see if bob's commit is in the ancestry
|
|
|
|
:: of ali's. If not, this is not a fast-forward merge, so we error
|
|
|
|
:: out. If it is, we add ali's commit to bob's desk and checkout.
|
|
|
|
::
|
|
|
|
$fine
|
|
|
|
=/ bob (need bob)
|
|
|
|
?: =(r.ali r.bob)
|
|
|
|
(pure:m ~)
|
2019-05-10 04:06:18 +03:00
|
|
|
?: (~(has in (reachable-takos:sutil r.bob)) r.ali)
|
2019-05-04 05:24:24 +03:00
|
|
|
(pure:m ~)
|
2019-05-10 04:06:18 +03:00
|
|
|
?. (~(has in (reachable-takos:sutil r.ali)) r.bob)
|
|
|
|
(error:he cas %bad-fine-merge ~)
|
2019-05-04 05:24:24 +03:00
|
|
|
%^ pure:m ~ ~
|
|
|
|
:^ ~
|
|
|
|
ali
|
|
|
|
%- malt ^- (list {path ?})
|
|
|
|
%+ murn ~(tap by (~(uni by q.bob) q.ali))
|
|
|
|
|= {pax/path lob/lobe}
|
|
|
|
^- (unit {path ?})
|
|
|
|
=+ a=(~(get by q.ali) pax)
|
|
|
|
=+ b=(~(get by q.bob) pax)
|
|
|
|
?: =(a b)
|
|
|
|
~
|
|
|
|
`[pax !=(~ a)]
|
|
|
|
this-cor
|
|
|
|
::
|
2019-05-14 08:20:46 +03:00
|
|
|
:: If this is a %meet, %mate, or %meld merge, we may need to
|
|
|
|
:: fetch more data. If this merge is either trivial or a
|
|
|
|
:: fast-forward, we short-circuit to either ++done or the %fine
|
|
|
|
:: case.
|
2019-05-04 05:24:24 +03:00
|
|
|
::
|
|
|
|
:: Otherwise, we find the best common ancestor(s) with
|
2019-05-14 08:20:46 +03:00
|
|
|
:: ++find-merge-points. If there's no common ancestor, we error
|
|
|
|
:: out. Additionally, if there's more than one common ancestor
|
|
|
|
:: (i.e. this is a criss-cross merge), we error out. Something
|
|
|
|
:: akin to git's recursive merge should probably be used here,
|
|
|
|
:: but it isn't.
|
2019-05-04 05:24:24 +03:00
|
|
|
::
|
2019-05-14 08:20:46 +03:00
|
|
|
:: Once we have our single best common ancestor (merge base), we
|
|
|
|
:: store it in bas. If this is a %mate or %meld merge, we diff
|
|
|
|
:: both against the mergebase, merge the conflicts, and build the
|
|
|
|
:: new commit.
|
2019-05-04 05:24:24 +03:00
|
|
|
::
|
2019-05-14 08:20:46 +03:00
|
|
|
:: Otherwise (i.e. this is a %meet merge), we create a list of
|
|
|
|
:: all the changes between the mergebase and ali's commit and
|
|
|
|
:: store it in ali-diffs, and we put a similar list for bob's
|
|
|
|
:: commit in bob-diffs. Then we create bof, which is the a set
|
|
|
|
:: of changes in both ali and bob's commits. If this has any
|
|
|
|
:: members, we have conflicts, which is an error in a %meet
|
|
|
|
:: merge, so we error out.
|
2019-05-04 05:24:24 +03:00
|
|
|
::
|
2019-05-14 08:20:46 +03:00
|
|
|
:: Otherwise, we merge the merge base data with ali's data and
|
|
|
|
:: bob's data, which produces the data for the new commit.
|
2019-05-04 05:24:24 +03:00
|
|
|
::
|
|
|
|
?($meet $mate $meld)
|
|
|
|
=/ bob (need bob)
|
|
|
|
?: =(r.ali r.bob)
|
|
|
|
(pure:m ~)
|
|
|
|
?. (~(has by hut.ran) r.bob)
|
2019-05-10 04:06:18 +03:00
|
|
|
(error:he cas %bad-bob-tako >r.bob< ~)
|
|
|
|
?: (~(has in (reachable-takos:sutil r.bob)) r.ali)
|
2019-05-04 05:24:24 +03:00
|
|
|
(pure:m ~)
|
2019-05-10 04:06:18 +03:00
|
|
|
?: (~(has in (reachable-takos:sutil r.ali)) r.bob)
|
2019-05-04 05:24:24 +03:00
|
|
|
$(gem %fine)
|
|
|
|
=+ r=(find-merge-points:he ali bob)
|
|
|
|
?~ r
|
2019-05-10 04:06:18 +03:00
|
|
|
(error:he cas %merge-no-merge-base ~)
|
2019-05-04 05:24:24 +03:00
|
|
|
?. ?=({* ~ ~} r)
|
|
|
|
=+ (lent ~(tap in `(set yaki)`r))
|
2019-05-10 04:06:18 +03:00
|
|
|
(error:he cas %merge-criss-cross >[-]< ~)
|
2019-05-04 05:24:24 +03:00
|
|
|
=/ bas n.r
|
2019-05-10 04:06:18 +03:00
|
|
|
?: ?=(?($mate $meld) gem)
|
|
|
|
;< ali-diffs=cane bind:m (diff-bas ali bob bas)
|
|
|
|
;< bob-diffs=cane bind:m (diff-bas bob ali bas)
|
2019-05-04 05:24:24 +03:00
|
|
|
;< bof=(map path (unit cage)) bind:m
|
2019-05-10 04:06:18 +03:00
|
|
|
(merge-conflicts can.ali-diffs can.bob-diffs)
|
2019-05-04 05:24:24 +03:00
|
|
|
;< $: conflicts=(set path)
|
|
|
|
bop=(map path cage)
|
|
|
|
new=yaki
|
|
|
|
erg=(map path ?)
|
|
|
|
e=_this-cor
|
|
|
|
==
|
|
|
|
bind:m
|
2019-05-10 04:06:18 +03:00
|
|
|
(build gem ali bob bas ali-diffs bob-diffs bof)
|
2019-05-04 05:24:24 +03:00
|
|
|
(pure:m `[conflicts bop new erg e])
|
2019-05-10 04:06:18 +03:00
|
|
|
=/ ali-diffs=cane (calc-diffs:he ali bas)
|
|
|
|
=/ bob-diffs=cane (calc-diffs:he bob bas)
|
2019-05-04 05:24:24 +03:00
|
|
|
=/ bof=(map path *)
|
|
|
|
%- %~ int by
|
2019-05-10 04:06:18 +03:00
|
|
|
%- ~(uni by `(map path *)`new.ali-diffs)
|
|
|
|
%- ~(uni by `(map path *)`cal.ali-diffs)
|
|
|
|
%- ~(uni by `(map path *)`can.ali-diffs)
|
|
|
|
`(map path *)`old.ali-diffs
|
|
|
|
%- ~(uni by `(map path *)`new.bob-diffs)
|
|
|
|
%- ~(uni by `(map path *)`cal.bob-diffs)
|
|
|
|
%- ~(uni by `(map path *)`can.bob-diffs)
|
|
|
|
`(map path *)`old.bob-diffs
|
2019-11-12 08:40:47 +03:00
|
|
|
?. =(~ bof)
|
|
|
|
(error:he cas %meet-conflict >~(key by bof)< ~)
|
2019-05-04 05:24:24 +03:00
|
|
|
=/ old=(map path lobe)
|
2019-05-10 04:06:18 +03:00
|
|
|
%+ roll ~(tap by (~(uni by old.ali-diffs) old.bob-diffs))
|
|
|
|
=< .(old q.bas)
|
2019-05-04 05:24:24 +03:00
|
|
|
|= {{pax/path ~} old/(map path lobe)}
|
|
|
|
(~(del by old) pax)
|
|
|
|
=/ hat=(map path lobe)
|
|
|
|
%- ~(uni by old)
|
2019-05-10 04:06:18 +03:00
|
|
|
%- ~(uni by new.ali-diffs)
|
|
|
|
%- ~(uni by new.bob-diffs)
|
|
|
|
%- ~(uni by cal.ali-diffs)
|
|
|
|
cal.bob-diffs
|
2019-05-04 05:24:24 +03:00
|
|
|
=/ del=(map path ?)
|
2019-05-10 04:06:18 +03:00
|
|
|
(~(run by (~(uni by old.ali-diffs) old.bob-diffs)) |=(~ %|))
|
|
|
|
=/ new (make-yaki:sutil [r.ali r.bob ~] hat wen)
|
2019-05-04 05:24:24 +03:00
|
|
|
%^ pure:m ~ ~
|
|
|
|
:^ ~
|
|
|
|
new
|
|
|
|
%- ~(uni by del)
|
|
|
|
^- (map path ?)
|
|
|
|
%. |=(lobe %&)
|
2019-05-10 04:06:18 +03:00
|
|
|
~(run by (~(uni by new.ali-diffs) cal.ali-diffs))
|
|
|
|
this-cor(hut.ran (~(put by hut.ran) r.new new))
|
2019-05-04 05:24:24 +03:00
|
|
|
==
|
|
|
|
::
|
|
|
|
:: Diff a commit against the mergebase.
|
|
|
|
::
|
|
|
|
++ diff-bas
|
2019-05-10 04:06:18 +03:00
|
|
|
|= [yak=yaki yuk=yaki bas=yaki]
|
|
|
|
=/ m (clad ,cane)
|
2019-05-04 05:24:24 +03:00
|
|
|
^- form:m
|
|
|
|
;< ~ bind:m
|
2019-05-16 21:50:13 +03:00
|
|
|
%+ just-do /diff-bas
|
2019-05-10 04:06:18 +03:00
|
|
|
:* %f %build live=%.n %pin wen
|
2019-05-04 05:24:24 +03:00
|
|
|
%list
|
|
|
|
^- (list schematic:ford)
|
2019-05-10 04:06:18 +03:00
|
|
|
%+ murn ~(tap by q.bas)
|
2019-05-04 05:24:24 +03:00
|
|
|
|= {pax/path lob/lobe}
|
|
|
|
^- (unit schematic:ford)
|
|
|
|
=+ a=(~(get by q.yak) pax)
|
|
|
|
?~ a
|
|
|
|
~
|
|
|
|
?: =(lob u.a)
|
|
|
|
~
|
|
|
|
=+ (~(get by q.yuk) pax)
|
|
|
|
?~ -
|
|
|
|
~
|
|
|
|
?: =(u.a u.-)
|
|
|
|
~
|
|
|
|
:- ~
|
2019-05-11 00:51:37 +03:00
|
|
|
=/ disc ford-disc
|
2019-05-04 05:24:24 +03:00
|
|
|
:- [%$ %path !>(pax)]
|
2019-05-11 00:51:37 +03:00
|
|
|
:^ %diff ford-disc
|
2019-05-10 04:06:18 +03:00
|
|
|
(lobe-to-schematic:sutil disc pax lob)
|
|
|
|
(lobe-to-schematic:sutil disc pax u.a)
|
2019-05-04 05:24:24 +03:00
|
|
|
==
|
|
|
|
;< res=made-result:ford bind:m expect-ford
|
2019-05-10 04:06:18 +03:00
|
|
|
=+ tay=(made-result-to-cages-or-error:util res)
|
2019-05-04 05:24:24 +03:00
|
|
|
?: ?=(%| -.tay)
|
2019-05-10 04:06:18 +03:00
|
|
|
(error:he cas %diff-ali-bad-made leaf+"merge diff ali failed" p.tay)
|
|
|
|
=+ can=(cages-to-map:util p.tay)
|
2019-05-04 05:24:24 +03:00
|
|
|
?: ?=(%| -.can)
|
2019-05-10 04:06:18 +03:00
|
|
|
(error:he cas %diff-ali p.can)
|
2019-05-04 05:24:24 +03:00
|
|
|
%- pure:m
|
|
|
|
:* %- molt
|
|
|
|
%+ skip ~(tap by q.yak)
|
|
|
|
|= {pax/path lob/lobe}
|
|
|
|
(~(has by q.bas) pax)
|
|
|
|
::
|
|
|
|
%- molt ^- (list (pair path lobe))
|
|
|
|
%+ murn ~(tap by q.bas)
|
|
|
|
|= {pax/path lob/lobe}
|
|
|
|
^- (unit (pair path lobe))
|
|
|
|
=+ a=(~(get by q.yak) pax)
|
|
|
|
=+ b=(~(get by q.yuk) pax)
|
|
|
|
?. ?& ?=(^ a)
|
|
|
|
!=([~ lob] a)
|
|
|
|
=([~ lob] b)
|
2019-05-03 04:50:20 +03:00
|
|
|
==
|
2019-05-04 05:24:24 +03:00
|
|
|
~
|
|
|
|
`[pax +.a]
|
|
|
|
::
|
|
|
|
p.can
|
|
|
|
::
|
|
|
|
%- malt ^- (list {path ~})
|
|
|
|
%+ murn ~(tap by q.bas)
|
|
|
|
|= {pax/path lob/lobe}
|
|
|
|
?. =(~ (~(get by q.yak) pax))
|
|
|
|
~
|
|
|
|
(some pax ~)
|
|
|
|
==
|
|
|
|
::
|
2019-05-14 08:20:46 +03:00
|
|
|
:: Merge diffs that are on the same file.
|
2019-05-04 05:24:24 +03:00
|
|
|
::
|
|
|
|
++ merge-conflicts
|
|
|
|
|= [conflicts-ali=(map path cage) conflicts-bob=(map path cage)]
|
|
|
|
=/ m (clad ,bof=(map path (unit cage)))
|
|
|
|
^- form:m
|
|
|
|
;< ~ bind:m
|
2019-05-16 21:50:13 +03:00
|
|
|
%+ just-do /merge-conflicts
|
2019-05-04 05:24:24 +03:00
|
|
|
:* %f %build live=%.n %list
|
|
|
|
^- (list schematic:ford)
|
|
|
|
%+ turn
|
|
|
|
~(tap by (~(int by conflicts-ali) conflicts-bob))
|
|
|
|
|= {pax/path *}
|
|
|
|
^- schematic:ford
|
|
|
|
=+ cal=(~(got by conflicts-ali) pax)
|
|
|
|
=+ cob=(~(got by conflicts-bob) pax)
|
|
|
|
=/ her
|
|
|
|
=+ (slag (dec (lent pax)) pax)
|
|
|
|
?~(- %$ i.-)
|
|
|
|
:- [%$ %path !>(pax)]
|
|
|
|
[%join [p.bob-disc q.bob-disc] her [%$ cal] [%$ cob]]
|
|
|
|
==
|
|
|
|
;< res=made-result:ford bind:m expect-ford
|
|
|
|
=+ tay=(made-result-to-cages-or-error:util res)
|
|
|
|
?: ?=(%| -.tay)
|
2019-05-10 04:06:18 +03:00
|
|
|
(error:he cas %merge-bad-made leaf+"merging failed" p.tay)
|
|
|
|
=+ can=(cages-to-map:util p.tay)
|
2019-05-04 05:24:24 +03:00
|
|
|
?: ?=(%| -.can)
|
2019-05-10 04:06:18 +03:00
|
|
|
(error:he cas %merge p.can)
|
2019-05-04 05:24:24 +03:00
|
|
|
%- pure:m
|
|
|
|
(~(run by p.can) (flit |=({a/mark ^} !?=($null a))))
|
|
|
|
::
|
2019-05-10 04:06:18 +03:00
|
|
|
:: Apply the patches in bof to get the new merged content.
|
2019-05-04 05:24:24 +03:00
|
|
|
::
|
|
|
|
:: Gather all the changes between ali's and bob's commits and the
|
2019-05-10 04:06:18 +03:00
|
|
|
:: mergebase. This is similar to the %meet of ++merge, except
|
|
|
|
:: where they touch the same file, we use the merged versions.
|
2019-05-04 05:24:24 +03:00
|
|
|
::
|
|
|
|
++ build
|
2019-05-10 04:06:18 +03:00
|
|
|
|= $: gem=germ
|
|
|
|
ali=yaki
|
|
|
|
bob=yaki
|
|
|
|
bas=yaki
|
|
|
|
dal=cane
|
|
|
|
dob=cane
|
|
|
|
bof=(map path (unit cage))
|
|
|
|
==
|
2019-05-04 05:24:24 +03:00
|
|
|
=/ m
|
2019-05-10 04:06:18 +03:00
|
|
|
%- clad
|
|
|
|
$: conflicts=(set path)
|
|
|
|
bop=(map path cage)
|
|
|
|
new=yaki
|
|
|
|
erg=(map path ?)
|
|
|
|
e=_this-cor
|
|
|
|
==
|
2019-05-04 05:24:24 +03:00
|
|
|
^- form:m
|
|
|
|
;< ~ bind:m
|
2019-05-16 21:50:13 +03:00
|
|
|
%+ just-do /build
|
2019-05-04 05:24:24 +03:00
|
|
|
:* %f %build live=%.n %list
|
|
|
|
^- (list schematic:ford)
|
2019-05-10 04:06:18 +03:00
|
|
|
%+ murn ~(tap by bof)
|
2019-05-04 05:24:24 +03:00
|
|
|
|= {pax/path cay/(unit cage)}
|
|
|
|
^- (unit schematic:ford)
|
|
|
|
?~ cay
|
|
|
|
~
|
|
|
|
:- ~
|
|
|
|
:- [%$ %path !>(pax)]
|
2019-05-10 04:06:18 +03:00
|
|
|
=+ (~(get by q.bas) pax)
|
2019-05-04 05:24:24 +03:00
|
|
|
?~ -
|
|
|
|
~| %mate-strange-diff-no-base
|
|
|
|
!!
|
|
|
|
:* %pact
|
|
|
|
[p.bob-disc q.bob-disc]
|
2019-05-11 00:51:37 +03:00
|
|
|
(lobe-to-schematic:sutil ford-disc pax u.-)
|
2019-05-04 05:24:24 +03:00
|
|
|
[%$ u.cay]
|
|
|
|
==
|
|
|
|
==
|
|
|
|
;< res=made-result:ford bind:m expect-ford
|
2019-05-10 04:06:18 +03:00
|
|
|
=+ tay=(made-result-to-cages-or-error:util res)
|
2019-05-04 05:24:24 +03:00
|
|
|
?: ?=(%| -.tay)
|
2019-05-10 04:06:18 +03:00
|
|
|
(error:he cas %build-bad-made leaf+"delta building failed" p.tay)
|
|
|
|
=/ bop (cages-to-map:util p.tay)
|
2019-05-04 05:24:24 +03:00
|
|
|
?: ?=(%| -.bop)
|
2019-05-10 04:06:18 +03:00
|
|
|
(error:he cas %built p.bop)
|
2019-05-04 05:24:24 +03:00
|
|
|
=/ both-patched p.bop
|
|
|
|
=/ con=(map path *) :: 2-change conflict
|
|
|
|
%- molt
|
2019-05-10 04:06:18 +03:00
|
|
|
%+ skim ~(tap by bof)
|
2019-05-04 05:24:24 +03:00
|
|
|
|=({pax/path cay/(unit cage)} ?=(~ cay))
|
2019-05-10 04:06:18 +03:00
|
|
|
=/ cab=(map path lobe) :: conflict base
|
2019-05-04 05:24:24 +03:00
|
|
|
%- ~(urn by con)
|
|
|
|
|= {pax/path *}
|
2019-05-10 04:06:18 +03:00
|
|
|
(~(got by q.bas) pax)
|
2019-05-04 05:24:24 +03:00
|
|
|
=. con :: change+del conflict
|
|
|
|
%- ~(uni by con)
|
|
|
|
%- malt ^- (list {path *})
|
2019-05-10 04:06:18 +03:00
|
|
|
%+ skim ~(tap by old.dal)
|
2019-05-04 05:24:24 +03:00
|
|
|
|= {pax/path ~}
|
2019-05-10 04:06:18 +03:00
|
|
|
?: (~(has by new.dob) pax)
|
2019-05-04 05:24:24 +03:00
|
|
|
~| %strange-add-and-del
|
|
|
|
!!
|
2019-05-10 04:06:18 +03:00
|
|
|
(~(has by can.dob) pax)
|
2019-05-04 05:24:24 +03:00
|
|
|
=. con :: change+del conflict
|
|
|
|
%- ~(uni by con)
|
|
|
|
%- malt ^- (list {path *})
|
2019-05-10 04:06:18 +03:00
|
|
|
%+ skim ~(tap by old.dob)
|
2019-05-04 05:24:24 +03:00
|
|
|
|= {pax/path ~}
|
2019-05-10 04:06:18 +03:00
|
|
|
?: (~(has by new.dal) pax)
|
2019-05-04 05:24:24 +03:00
|
|
|
~| %strange-del-and-add
|
|
|
|
!!
|
2019-05-10 04:06:18 +03:00
|
|
|
(~(has by can.dal) pax)
|
2019-05-04 05:24:24 +03:00
|
|
|
=. con :: add+add conflict
|
|
|
|
%- ~(uni by con)
|
|
|
|
%- malt ^- (list {path *})
|
2019-05-10 04:06:18 +03:00
|
|
|
%+ skip ~(tap by (~(int by new.dal) new.dob))
|
2019-05-04 05:24:24 +03:00
|
|
|
|= {pax/path *}
|
2019-05-10 04:06:18 +03:00
|
|
|
=((~(got by new.dal) pax) (~(got by new.dob) pax))
|
|
|
|
?: &(?=($mate gem) ?=(^ con))
|
2019-05-04 05:24:24 +03:00
|
|
|
=+ (turn ~(tap by `(map path *)`con) |=({path *} >[+<-]<))
|
2019-05-10 04:06:18 +03:00
|
|
|
(error:he cas %mate-conflict -)
|
2019-05-04 05:24:24 +03:00
|
|
|
=/ old=(map path lobe) :: oldies but goodies
|
2019-05-10 04:06:18 +03:00
|
|
|
%+ roll ~(tap by (~(uni by old.dal) old.dob))
|
|
|
|
=< .(old q.bas)
|
2019-05-03 04:50:20 +03:00
|
|
|
|= {{pax/path ~} old/(map path lobe)}
|
|
|
|
(~(del by old) pax)
|
2019-05-04 05:24:24 +03:00
|
|
|
=/ can=(map path cage) :: content changes
|
|
|
|
%- molt
|
|
|
|
^- (list (pair path cage))
|
2019-05-10 04:06:18 +03:00
|
|
|
%+ murn ~(tap by bof)
|
2019-05-04 05:24:24 +03:00
|
|
|
|= {pax/path cay/(unit cage)}
|
|
|
|
^- (unit (pair path cage))
|
|
|
|
?~ cay
|
|
|
|
~
|
|
|
|
`[pax u.cay]
|
|
|
|
=^ hot lat.ran :: new content
|
|
|
|
^- {(map path lobe) (map lobe blob)}
|
|
|
|
%+ roll ~(tap by can)
|
|
|
|
=< .(lat lat.ran)
|
|
|
|
|= {{pax/path cay/cage} hat/(map path lobe) lat/(map lobe blob)}
|
|
|
|
=+ ^= bol
|
2019-05-10 04:06:18 +03:00
|
|
|
=+ (~(get by q.bas) pax)
|
2019-05-04 05:24:24 +03:00
|
|
|
?~ -
|
|
|
|
~| %mate-strange-diff-no-base
|
|
|
|
!!
|
2019-05-10 04:06:18 +03:00
|
|
|
%^ make-delta-blob:sutil
|
|
|
|
(page-to-lobe:sutil [p q.q]:(~(got by both-patched) pax))
|
|
|
|
[(lobe-to-mark:sutil u.-) u.-]
|
2019-05-04 05:24:24 +03:00
|
|
|
[p q.q]:cay
|
2019-07-25 03:06:41 +03:00
|
|
|
:- (~(put by hat) pax p.bol)
|
|
|
|
?: (~(has by lat) p.bol)
|
|
|
|
lat
|
|
|
|
(~(put by lat) p.bol bol)
|
2019-05-04 05:24:24 +03:00
|
|
|
:: ~& old=(~(run by old) mug)
|
2019-05-10 04:06:18 +03:00
|
|
|
:: ~& newdal=(~(run by new.dal) mug)
|
|
|
|
:: ~& newdob=(~(run by new.dob) mug)
|
|
|
|
:: ~& caldal=(~(run by cal.dal) mug)
|
|
|
|
:: ~& caldob=(~(run by cal.dob) mug)
|
2019-05-04 05:24:24 +03:00
|
|
|
:: ~& hot=(~(run by hot) mug)
|
|
|
|
:: ~& cas=(~(run by cas) mug)
|
|
|
|
=/ hat=(map path lobe) :: all the content
|
2019-05-03 04:50:20 +03:00
|
|
|
%- ~(uni by old)
|
2019-05-10 04:06:18 +03:00
|
|
|
%- ~(uni by new.dal)
|
|
|
|
%- ~(uni by new.dob)
|
|
|
|
%- ~(uni by cal.dal)
|
|
|
|
%- ~(uni by cal.dob)
|
2019-05-04 05:24:24 +03:00
|
|
|
%- ~(uni by hot)
|
2019-05-10 04:06:18 +03:00
|
|
|
cab
|
2019-05-03 04:50:20 +03:00
|
|
|
=/ del=(map path ?)
|
2019-05-10 04:06:18 +03:00
|
|
|
(~(run by (~(uni by old.dal) old.dob)) |=(~ %|))
|
|
|
|
=/ new (make-yaki:sutil [r.ali r.bob ~] hat wen)
|
2019-05-04 05:24:24 +03:00
|
|
|
%- pure:m
|
2019-05-10 04:06:18 +03:00
|
|
|
:* (silt (turn ~(tap by con) head))
|
|
|
|
both-patched
|
2019-05-03 04:50:20 +03:00
|
|
|
new
|
2019-05-10 04:06:18 +03:00
|
|
|
::
|
|
|
|
%- ~(uni by del)
|
|
|
|
^- (map path ?)
|
|
|
|
%. |=(lobe %&)
|
|
|
|
%~ run by
|
|
|
|
%- ~(uni by new.dal)
|
|
|
|
%- ~(uni by cal.dal)
|
|
|
|
%- ~(uni by cab)
|
|
|
|
hot
|
|
|
|
::
|
|
|
|
this-cor(hut.ran (~(put by hut.ran) r.new new))
|
|
|
|
==
|
2019-05-04 05:24:24 +03:00
|
|
|
::
|
2019-05-14 08:20:46 +03:00
|
|
|
:: Convert new commit into actual data (i.e. blobs rather than
|
|
|
|
:: lobes). Apply the new commit to our state
|
2019-05-04 05:24:24 +03:00
|
|
|
::
|
|
|
|
++ checkout
|
2019-05-10 04:06:18 +03:00
|
|
|
|= [gem=germ cas=case bob=(unit yaki) new=yaki bop=(map path cage)]
|
|
|
|
=/ m (clad ,_this-cor)
|
2019-05-04 05:24:24 +03:00
|
|
|
^- form:m
|
|
|
|
;< ~ bind:m
|
|
|
|
=/ val=beak
|
|
|
|
?: ?=($init gem)
|
|
|
|
[p.ali-disc q.ali-disc cas]
|
2019-05-10 04:06:18 +03:00
|
|
|
[p.bob-disc q.bob-disc da+wen]
|
2019-05-16 21:50:13 +03:00
|
|
|
%+ just-do /checkout
|
2019-05-11 05:23:13 +03:00
|
|
|
:* %f %build live=%.n %pin wen %list
|
2019-05-04 05:24:24 +03:00
|
|
|
^- (list schematic:ford)
|
|
|
|
%+ murn ~(tap by q.new)
|
|
|
|
|= {pax/path lob/lobe}
|
|
|
|
^- (unit schematic:ford)
|
|
|
|
?: (~(has by bop) pax)
|
|
|
|
~
|
|
|
|
:+ ~
|
|
|
|
[%$ %path !>(pax)]
|
2019-05-11 00:51:37 +03:00
|
|
|
(merge-lobe-to-schematic:he (fall bob *yaki) ford-disc pax lob)
|
2019-05-04 05:24:24 +03:00
|
|
|
==
|
|
|
|
;< res=made-result:ford bind:m expect-ford
|
2019-05-10 04:06:18 +03:00
|
|
|
=+ tay=(made-result-to-cages-or-error:util res)
|
2019-05-04 05:24:24 +03:00
|
|
|
?: ?=(%| -.tay)
|
2019-05-10 04:06:18 +03:00
|
|
|
(error:he cas %checkout-bad-made leaf+"merge checkout failed" p.tay)
|
|
|
|
=+ can=(cages-to-map:util p.tay)
|
2019-05-04 05:24:24 +03:00
|
|
|
?: ?=(%| -.can)
|
2019-05-10 04:06:18 +03:00
|
|
|
(error:he cas %checkout p.can)
|
2019-05-04 05:24:24 +03:00
|
|
|
=. let.dom +(let.dom)
|
|
|
|
=. hit.dom (~(put by hit.dom) let.dom r.new)
|
|
|
|
=. ank.dom
|
|
|
|
%- map-to-ankh:sutil
|
|
|
|
%- ~(run by (~(uni by bop) p.can))
|
2019-05-10 04:06:18 +03:00
|
|
|
|=(cage [(page-to-lobe:sutil p q.q) +<])
|
|
|
|
(pure:m this-cor)
|
2019-05-04 05:24:24 +03:00
|
|
|
::
|
|
|
|
:: Cast all the content that we're going to tell unix about to
|
|
|
|
:: %mime, then tell unix.
|
|
|
|
::
|
|
|
|
++ ergo
|
2019-05-10 04:06:18 +03:00
|
|
|
|= [gem=germ cas=case mon=(map term beam) erg=(map path ?) new=yaki]
|
2019-05-16 01:50:13 +03:00
|
|
|
=/ m (clad ,mim=(map path mime))
|
2019-05-04 05:24:24 +03:00
|
|
|
^- form:m
|
2019-05-10 04:06:18 +03:00
|
|
|
=+ must=(must-ergo:util our q.bob-disc mon (turn ~(tap by erg) head))
|
2019-05-04 05:24:24 +03:00
|
|
|
?: =(~ must)
|
2019-05-16 01:50:13 +03:00
|
|
|
(pure:m mim.dom)
|
2019-05-04 05:24:24 +03:00
|
|
|
=/ sum=(set path)
|
|
|
|
=+ (turn ~(tap by must) (corl tail tail))
|
|
|
|
%+ roll -
|
|
|
|
|= {pak/(set path) acc/(set path)}
|
|
|
|
(~(uni in acc) pak)
|
|
|
|
=/ val=beak
|
2019-05-10 04:06:18 +03:00
|
|
|
?: ?=($init gem)
|
|
|
|
[p.ali-disc q.ali-disc cas]
|
|
|
|
[p.bob-disc q.bob-disc da+wen]
|
2019-05-04 05:24:24 +03:00
|
|
|
;< ~ bind:m
|
2019-05-16 21:50:13 +03:00
|
|
|
%+ just-do /ergo
|
2019-05-11 05:23:13 +03:00
|
|
|
:* %f %build live=%.n %pin wen %list
|
2019-05-04 05:24:24 +03:00
|
|
|
^- (list schematic:ford)
|
|
|
|
%+ turn ~(tap in sum)
|
|
|
|
|= a/path
|
|
|
|
^- schematic:ford
|
|
|
|
:- [%$ %path !>(a)]
|
2019-05-10 04:06:18 +03:00
|
|
|
=+ b=(~(got by erg) a)
|
2019-05-04 05:24:24 +03:00
|
|
|
?. b
|
|
|
|
[%$ %null !>(~)]
|
2019-05-11 00:51:37 +03:00
|
|
|
=/ disc ford-disc :: [p q]:val
|
|
|
|
:^ %cast ford-disc %mime
|
2019-05-10 04:06:18 +03:00
|
|
|
(lobe-to-schematic:sutil disc a (~(got by q.new) a))
|
2019-05-04 05:24:24 +03:00
|
|
|
==
|
|
|
|
;< res=made-result:ford bind:m expect-ford
|
2019-05-10 04:06:18 +03:00
|
|
|
=+ tay=(made-result-to-cages-or-error:util res)
|
2019-05-04 05:24:24 +03:00
|
|
|
?: ?=(%| -.tay)
|
2019-05-10 04:06:18 +03:00
|
|
|
(error:he cas %ergo-bad-made leaf+"merge ergo failed" p.tay)
|
2019-05-04 05:24:24 +03:00
|
|
|
=+ =| nac=mode
|
|
|
|
|- ^- tan=$^(mode {p/term q/tang})
|
|
|
|
?~ p.tay nac
|
|
|
|
=* pax p.i.p.tay
|
|
|
|
?. ?=($path p.pax)
|
|
|
|
[%ergo >[%expected-path got=p.pax]< ~]
|
|
|
|
=* mim q.i.p.tay
|
2019-05-15 21:13:25 +03:00
|
|
|
=+ mit=?.(?=($mime p.mim) ~ `;;(mime q.q.mim))
|
|
|
|
$(p.tay t.p.tay, nac :_(nac [;;(path q.q.pax) mit]))
|
2019-05-10 04:06:18 +03:00
|
|
|
?: ?=([@ *] tan) (error:he cas tan)
|
2019-05-18 00:59:03 +03:00
|
|
|
=/ changes=(map path (unit mime)) (malt tan)
|
|
|
|
=/ mim (apply-changes-to-mim:util mim.dom changes)
|
2019-05-04 05:24:24 +03:00
|
|
|
?~ hez
|
2019-05-10 04:06:18 +03:00
|
|
|
(error:he cas %ergo-no-hez ~)
|
2019-05-18 00:59:03 +03:00
|
|
|
;< ~ bind:m (give-ergo:util u.hez our q.bob-disc mon changes)
|
|
|
|
(pure:m mim)
|
2019-05-04 05:24:24 +03:00
|
|
|
::
|
|
|
|
:: A small set of helper functions to assist in merging.
|
|
|
|
::
|
|
|
|
++ he
|
|
|
|
|%
|
2019-05-03 04:50:20 +03:00
|
|
|
::
|
2019-05-04 05:24:24 +03:00
|
|
|
:: Cancel the merge gracefully and produce an error.
|
|
|
|
::
|
|
|
|
++ error
|
2019-05-10 04:06:18 +03:00
|
|
|
|= [cas=case err=term tan=(list tank)]
|
|
|
|
(clad-fail err >ali-disc< >bob-disc< >cas< tan)
|
2019-05-04 05:24:24 +03:00
|
|
|
::
|
|
|
|
++ calc-diffs
|
|
|
|
|= [hed=yaki bas=yaki]
|
|
|
|
^- cane
|
|
|
|
:* %- molt
|
|
|
|
%+ skip ~(tap by q.hed)
|
|
|
|
|= {pax/path lob/lobe}
|
|
|
|
(~(has by q.bas) pax)
|
|
|
|
::
|
|
|
|
%- molt
|
|
|
|
%+ skip ~(tap by q.hed)
|
|
|
|
|= {pax/path lob/lobe}
|
|
|
|
=+ (~(get by q.bas) pax)
|
|
|
|
|(=(~ -) =([~ lob] -))
|
|
|
|
::
|
|
|
|
~
|
|
|
|
::
|
|
|
|
%- malt ^- (list {path ~})
|
|
|
|
%+ murn ~(tap by q.bas)
|
|
|
|
|= {pax/path lob/lobe}
|
|
|
|
^- (unit (pair path ~))
|
|
|
|
?. =(~ (~(get by q.hed) pax))
|
|
|
|
~
|
|
|
|
`[pax ~]
|
|
|
|
==
|
|
|
|
::
|
|
|
|
:: Create a schematic to turn a lobe into a blob.
|
|
|
|
::
|
|
|
|
:: We short-circuit if we already have the content somewhere.
|
|
|
|
::
|
|
|
|
++ merge-lobe-to-schematic
|
2019-05-10 04:06:18 +03:00
|
|
|
|= [bob=yaki disc=disc:ford pax=path lob=lobe]
|
2019-05-04 05:24:24 +03:00
|
|
|
^- schematic:ford
|
2019-05-10 04:06:18 +03:00
|
|
|
=+ lol=(~(get by q.bob) pax)
|
2019-05-04 05:24:24 +03:00
|
|
|
|- ^- schematic:ford
|
|
|
|
?: =([~ lob] lol)
|
2019-05-10 04:06:18 +03:00
|
|
|
=+ (need (need (read-x:sutil & let.dom pax)))
|
2019-05-04 05:24:24 +03:00
|
|
|
?> ?=(%& -<)
|
|
|
|
[%$ p.-]
|
2019-05-10 04:06:18 +03:00
|
|
|
:: ?: =([~ lob] lal)
|
|
|
|
:: [%$ +:(need fil.ank:(descend-path:(zu:sutil ank:(need alh)) pax))]
|
2019-05-04 05:24:24 +03:00
|
|
|
=+ bol=(~(got by lat.ran) lob)
|
|
|
|
?- -.bol
|
2019-05-10 04:06:18 +03:00
|
|
|
$direct (page-to-schematic:sutil disc q.bol)
|
2019-05-04 05:24:24 +03:00
|
|
|
$delta
|
2019-05-10 04:06:18 +03:00
|
|
|
[%pact disc $(lob q.q.bol) (page-to-schematic:sutil disc r.bol)]
|
2019-05-04 05:24:24 +03:00
|
|
|
==
|
|
|
|
::
|
|
|
|
:: Find the most recent common ancestor(s).
|
|
|
|
::
|
|
|
|
++ find-merge-points
|
|
|
|
|= {p/yaki q/yaki} :: maybe need jet
|
|
|
|
^- (set yaki)
|
|
|
|
%- reduce-merge-points
|
2019-05-10 04:06:18 +03:00
|
|
|
=+ r=(reachable-takos:sutil r.p)
|
2019-05-04 05:24:24 +03:00
|
|
|
|- ^- (set yaki)
|
|
|
|
?: (~(has in r) r.q) (~(put in *(set yaki)) q)
|
|
|
|
%+ roll p.q
|
|
|
|
|= {t/tako s/(set yaki)}
|
|
|
|
?: (~(has in r) t)
|
2019-05-10 04:06:18 +03:00
|
|
|
(~(put in s) (tako-to-yaki:sutil t)) :: found
|
|
|
|
(~(uni in s) ^$(q (tako-to-yaki:sutil t))) :: traverse
|
2019-05-04 05:24:24 +03:00
|
|
|
::
|
|
|
|
:: Helper for ++find-merge-points.
|
|
|
|
::
|
|
|
|
++ reduce-merge-points
|
|
|
|
|= unk/(set yaki) :: maybe need jet
|
|
|
|
=| gud/(set yaki)
|
|
|
|
=+ ^= zar
|
|
|
|
^- (map tako (set tako))
|
|
|
|
%+ roll ~(tap in unk)
|
|
|
|
|= {yak/yaki qar/(map tako (set tako))}
|
2019-05-10 04:06:18 +03:00
|
|
|
(~(put by qar) r.yak (reachable-takos:sutil r.yak))
|
2019-05-04 05:24:24 +03:00
|
|
|
|-
|
|
|
|
^- (set yaki)
|
|
|
|
?~ unk gud
|
|
|
|
=+ bun=(~(del in `(set yaki)`unk) n.unk)
|
|
|
|
?: %+ levy ~(tap by (~(uni in gud) bun))
|
|
|
|
|= yak/yaki
|
|
|
|
!(~(has in (~(got by zar) r.yak)) r.n.unk)
|
|
|
|
$(gud (~(put in gud) n.unk), unk bun)
|
|
|
|
$(unk bun)
|
|
|
|
--
|
|
|
|
--
|
|
|
|
--
|
|
|
|
::
|
2019-05-18 00:59:03 +03:00
|
|
|
:: Mount a beam to unix
|
|
|
|
::
|
|
|
|
++ mount
|
|
|
|
|= $: our=ship
|
|
|
|
syd=desk
|
|
|
|
wen=@da
|
|
|
|
hez=duct
|
|
|
|
dom=dome
|
|
|
|
ran=rang
|
|
|
|
==
|
|
|
|
|^
|
|
|
|
|= [pot=term bem=beam mon=(map term beam)]
|
|
|
|
=/ m mount-clad
|
|
|
|
^- form:m
|
|
|
|
=/ old-mon (~(get by mon) pot)
|
|
|
|
?^ old-mon
|
|
|
|
(clad-fail %already-mounted >u.old-mon< ~)
|
|
|
|
=. mon (~(put by mon) pot bem)
|
|
|
|
;< changes=(map path (unit mime)) bind:m (cast-to-mime bem)
|
|
|
|
;< ~ bind:m (ergo changes mon)
|
|
|
|
=/ mim (apply-changes-to-mim:util mim.dom changes)
|
|
|
|
(pure:m [pot bem] mim)
|
|
|
|
::
|
|
|
|
++ sutil (state:util dom dom ran)
|
|
|
|
:: Initializes a new mount point.
|
|
|
|
::
|
|
|
|
++ cast-to-mime
|
|
|
|
|= bem=beam
|
|
|
|
=/ m (clad ,(map path (unit mime)))
|
|
|
|
^- form:m
|
|
|
|
=* pax s.bem
|
|
|
|
=/ =aeon (need (case-to-aeon-before:sutil wen r.bem))
|
|
|
|
=/ must
|
|
|
|
=/ all (turn ~(tap by q:(aeon-to-yaki:sutil aeon)) head)
|
|
|
|
(skim all |=(paf/path =(pax (scag (lent pax) paf))))
|
|
|
|
?~ must
|
|
|
|
(pure:m ~)
|
|
|
|
;< ~ bind:m
|
|
|
|
%+ just-do /ergoing
|
|
|
|
:* %f %build live=%.n %list
|
|
|
|
^- (list schematic:ford)
|
|
|
|
%+ turn `(list path)`must
|
|
|
|
|= a/path
|
|
|
|
:- [%$ %path !>(a)]
|
|
|
|
:^ %cast [our %home] %mime
|
|
|
|
=+ (need (need (read-x:sutil & aeon a)))
|
|
|
|
?: ?=(%& -<)
|
|
|
|
[%$ p.-]
|
|
|
|
(lobe-to-schematic:sutil [our %home] a p.-)
|
|
|
|
==
|
|
|
|
;< res=made-result:ford bind:m expect-ford
|
|
|
|
?: ?=([%incomplete *] res)
|
|
|
|
(clad-fail %ergo-fail-incomplete leaf+"clay ergo incomplete" tang.res)
|
|
|
|
?. ?=([%complete %success *] res)
|
|
|
|
(clad-fail %ergo-fail leaf+"clay ergo failed" message.build-result.res)
|
|
|
|
%- pure:m
|
|
|
|
%- malt ^- mode
|
|
|
|
%+ turn (made-result-to-cages:util res)
|
|
|
|
|= [pax=cage mim=cage]
|
|
|
|
?. ?=($path p.pax)
|
|
|
|
~|(%ergo-bad-path-mark !!)
|
|
|
|
:- ;;(path q.q.pax)
|
|
|
|
?. ?=($mime p.mim)
|
|
|
|
~
|
|
|
|
`;;(mime q.q.mim)
|
|
|
|
::
|
|
|
|
:: Send changes to unix
|
|
|
|
::
|
|
|
|
++ ergo
|
|
|
|
|= [changes=(map path (unit mime)) mon=(map term beam)]
|
|
|
|
(give-ergo:util hez our syd mon changes)
|
|
|
|
--
|
|
|
|
::
|
2019-05-17 03:24:10 +03:00
|
|
|
:: A simple foreign request.
|
|
|
|
::
|
|
|
|
++ foreign-request
|
|
|
|
|= $: our=ship
|
|
|
|
her=ship
|
|
|
|
syd=desk
|
|
|
|
wen=@da
|
|
|
|
==
|
|
|
|
|^
|
|
|
|
|= [=rave =rand]
|
|
|
|
=/ m request-clad
|
|
|
|
^- form:m
|
|
|
|
?- p.p.rand
|
|
|
|
$d ~| %totally-temporary-error-please-replace-me !!
|
|
|
|
$p ~| %requesting-foreign-permissions-is-invalid !!
|
|
|
|
$t ~| %requesting-foreign-directory-is-vaporware !!
|
|
|
|
$u ~| %prolly-poor-idea-to-get-rang-over-network !!
|
|
|
|
$v ~| %weird-shouldnt-get-v-request-from-network !!
|
|
|
|
$z ~| %its-prolly-not-reasonable-to-request-ankh !!
|
|
|
|
$x (validate-x [p.p q.p q r]:rand)
|
|
|
|
::
|
|
|
|
$y
|
|
|
|
(pure:m [p.r.rand !>(;;(arch q.r.rand))])
|
|
|
|
::
|
|
|
|
$w
|
|
|
|
%- pure:m
|
|
|
|
:- p.r.rand
|
|
|
|
?+ p.r.rand ~| %strange-w-over-nextwork !!
|
|
|
|
$cass !>(;;(cass q.r.rand))
|
|
|
|
$null [[%atom %n ~] ~]
|
|
|
|
$nako !>(~|([%molding [&1 &2 &3]:q.r.rand] ;;(nako q.r.rand)))
|
|
|
|
==
|
|
|
|
==
|
|
|
|
::
|
|
|
|
:: Make sure that incoming data is of the mark it claims to be.
|
|
|
|
::
|
|
|
|
++ validate-x
|
|
|
|
|= [car=care cas=case pax=path peg=page]
|
|
|
|
=/ m (clad ,cage)
|
|
|
|
;< ~ bind:m
|
|
|
|
%+ just-do /foreign-x
|
|
|
|
[%f %build live=%.n %pin wen (vale-page:util [our %home] peg)]
|
|
|
|
;< res=made-result:ford bind:m expect-ford
|
|
|
|
^- form:m
|
|
|
|
?. ?=([%complete %success *] res)
|
|
|
|
=/ message (made-result-as-error:ford res)
|
|
|
|
(clad-fail %validate-foreign-x-failed message)
|
|
|
|
(pure:m (result-to-cage:ford build-result.res))
|
|
|
|
--
|
|
|
|
::
|
|
|
|
:: A full foreign update. Validate and apply to our local cache of
|
|
|
|
:: their state.
|
|
|
|
::
|
|
|
|
++ foreign-update
|
|
|
|
|= $: our=ship
|
|
|
|
her=ship
|
|
|
|
syd=desk
|
|
|
|
wen=@da
|
|
|
|
==
|
|
|
|
|^
|
|
|
|
|= [=moat rand=(unit rand) lim=@da dom=dome ran=rang]
|
|
|
|
=/ m update-clad
|
|
|
|
^- form:m
|
|
|
|
?~ rand
|
|
|
|
(pure:m ~)
|
2019-05-23 00:39:12 +03:00
|
|
|
=/ lem ?.(?=(%da -.to.moat) lim p.to.moat)
|
2019-05-17 03:24:10 +03:00
|
|
|
?> ?=(%nako p.r.u.rand)
|
|
|
|
=/ nako ;;(nako q.r.u.rand)
|
|
|
|
?: =(0 let.dom)
|
|
|
|
;< [dom=dome ran=rang] bind:m (apply-foreign-update nako dom ran)
|
|
|
|
(pure:m ~ lem dom ran)
|
|
|
|
;< blobs=(set blob) bind:m (validate-plops bar.nako)
|
|
|
|
;< [dom=dome ran=rang] bind:m
|
|
|
|
(apply-foreign-update nako(bar blobs) dom ran)
|
|
|
|
(pure:m ~ lem dom ran)
|
|
|
|
::
|
|
|
|
:: Make sure that incoming data is of the mark it claims to be.
|
|
|
|
::
|
|
|
|
++ validate-plops
|
|
|
|
|= plops=(set plop)
|
|
|
|
=/ m (clad ,(set blob))
|
|
|
|
^- form:m
|
|
|
|
;< ~ bind:m
|
|
|
|
%+ just-do /validate-plops
|
|
|
|
:* %f %build live=%.n %pin wen
|
|
|
|
%list
|
|
|
|
^- (list schematic:ford)
|
|
|
|
%+ turn ~(tap in plops)
|
|
|
|
|= a/plop
|
|
|
|
?- -.a
|
|
|
|
$direct
|
|
|
|
:- [%$ %blob !>([%direct p.a *page])]
|
|
|
|
(vale-page:util [our %home] p.q.a q.q.a)
|
|
|
|
::
|
|
|
|
$delta
|
|
|
|
:- [%$ %blob !>([%delta p.a q.a *page])]
|
|
|
|
(vale-page:util [our %home] p.r.a q.r.a)
|
|
|
|
==
|
|
|
|
==
|
|
|
|
;< res=made-result:ford bind:m expect-ford
|
|
|
|
=/ cages (made-result-to-cages-or-error:util res)
|
|
|
|
?: ?=(%| -.cages)
|
|
|
|
(clad-fail %validate-plops-failed p.cages)
|
|
|
|
=| blobs=(list blob)
|
|
|
|
|- ^- form:m
|
|
|
|
?~ p.cages
|
|
|
|
(pure:m (silt blobs))
|
|
|
|
=* bob p.i.p.cages
|
|
|
|
=* cay q.i.p.cages
|
|
|
|
?. ?=(%blob p.bob)
|
|
|
|
(clad-fail %validate-plops-not-blob >p.bob< ~)
|
|
|
|
=/ new-blob=blob
|
|
|
|
=/ blob ;;(blob q.q.bob)
|
|
|
|
?- -.blob
|
|
|
|
%delta [-.blob p.blob q.blob p.cay q.q.cay]
|
|
|
|
%direct [-.blob p.blob p.cay q.q.cay]
|
|
|
|
==
|
|
|
|
$(p.cages t.p.cages, blobs [new-blob blobs])
|
|
|
|
::
|
|
|
|
:: When we get a %w foreign update, store this in our state.
|
|
|
|
::
|
|
|
|
:: We get the commits and blobs from the nako and add them to our object
|
|
|
|
:: store, then we update the map of aeons to commits and the latest aeon.
|
|
|
|
::
|
|
|
|
++ apply-foreign-update
|
|
|
|
|= [=nako dom=dome ran=rang]
|
|
|
|
=/ m (clad ,[dome rang])
|
|
|
|
^- form:m
|
|
|
|
:: hit: updated commit-hashes by @ud case
|
|
|
|
::
|
|
|
|
=/ hit (~(uni by hit.dom) gar.nako)
|
|
|
|
:: nut: new commit-hash/commit pairs
|
|
|
|
::
|
|
|
|
=/ nut
|
|
|
|
(turn ~(tap in lar.nako) |=(=yaki [r.yaki yaki]))
|
|
|
|
:: hut: updated commits by hash
|
|
|
|
::
|
2019-07-25 03:16:41 +03:00
|
|
|
=/ hut (~(uni by (malt nut)) hut.ran)
|
2019-05-17 03:24:10 +03:00
|
|
|
:: nat: new blob-hash/blob pairs
|
|
|
|
::
|
|
|
|
=/ nat
|
|
|
|
(turn ~(tap in bar.nako) |=(=blob [p.blob blob]))
|
|
|
|
:: lat: updated blobs by hash
|
|
|
|
::
|
2019-07-25 03:06:41 +03:00
|
|
|
=/ lat (~(uni by (malt nat)) lat.ran)
|
2019-05-17 03:24:10 +03:00
|
|
|
:: traverse updated state and sanity check
|
|
|
|
::
|
|
|
|
=+ ~| :* %bad-foreign-update
|
|
|
|
[gar=gar let=let.nako nut=(turn nut head) nat=(turn nat head)]
|
|
|
|
[hitdom=hit.dom letdom=let.dom]
|
|
|
|
==
|
|
|
|
?: =(0 let.nako)
|
|
|
|
~
|
|
|
|
=/ =aeon 1
|
|
|
|
|- ^- ~
|
|
|
|
=/ =tako
|
|
|
|
~| [%missing-aeon aeon] (~(got by hit) aeon)
|
|
|
|
=/ =yaki
|
|
|
|
~| [%missing-tako tako] (~(got by hut) tako)
|
|
|
|
=+ %+ turn
|
|
|
|
~(tap by q.yaki)
|
|
|
|
|= [=path =lobe]
|
|
|
|
~| [%missing-blob path lobe]
|
|
|
|
?> (~(has by lat) lobe)
|
|
|
|
~
|
|
|
|
?: =(let.nako aeon)
|
|
|
|
~
|
|
|
|
$(aeon +(aeon))
|
|
|
|
:: produce updated state
|
|
|
|
::
|
|
|
|
=: let.dom (max let.nako let.dom)
|
|
|
|
hit.dom hit
|
|
|
|
hut.ran hut
|
|
|
|
lat.ran lat
|
|
|
|
==
|
|
|
|
(pure:m dom ran)
|
|
|
|
--
|
|
|
|
::
|
2019-05-14 08:20:46 +03:00
|
|
|
:: An assortment of useful functions, used in +commit, +merge, and +de
|
|
|
|
::
|
2019-05-04 05:24:24 +03:00
|
|
|
++ util
|
|
|
|
|%
|
|
|
|
:: Takes a list of changed paths and finds those paths that are inside a
|
|
|
|
:: mount point (listed in `mon`).
|
2019-05-03 04:50:20 +03:00
|
|
|
::
|
2019-05-04 05:24:24 +03:00
|
|
|
:: Output is a map of mount points to {length-of-mounted-path set-of-paths}.
|
2019-05-03 04:50:20 +03:00
|
|
|
::
|
2019-05-04 05:24:24 +03:00
|
|
|
++ must-ergo
|
|
|
|
|= [our=ship syd=desk mon=(map term beam) can/(list path)]
|
|
|
|
^- (map term (pair @ud (set path)))
|
|
|
|
%- malt ^- (list (trel term @ud (set path)))
|
|
|
|
%+ murn ~(tap by mon)
|
|
|
|
|= {nam/term bem/beam}
|
|
|
|
^- (unit (trel term @ud (set path)))
|
|
|
|
=- ?~(- ~ `[nam (lent s.bem) (silt `(list path)`-)])
|
|
|
|
%+ skim can
|
|
|
|
|= pax/path
|
|
|
|
&(=(p.bem our) =(q.bem syd) =((flop s.bem) (scag (lent s.bem) pax)))
|
|
|
|
::
|
2019-05-18 00:59:03 +03:00
|
|
|
:: Send changes to unix
|
|
|
|
::
|
|
|
|
++ give-ergo
|
|
|
|
|= $: hez=duct
|
|
|
|
our=ship
|
|
|
|
syd=desk
|
|
|
|
mon=(map term beam)
|
|
|
|
changes=(map path (unit mime))
|
|
|
|
==
|
|
|
|
=/ m (clad ,~)
|
|
|
|
^- form:m
|
|
|
|
=/ must (must-ergo our syd mon (turn ~(tap by changes) head))
|
|
|
|
|= clad-input
|
|
|
|
:- ~ :_ [%done ~]
|
|
|
|
%+ turn ~(tap by must)
|
|
|
|
|= [pot=term len=@ud pak=(set path)]
|
|
|
|
:* hez %give %ergo pot
|
|
|
|
%+ turn ~(tap in pak)
|
|
|
|
|= pax=path
|
|
|
|
[(slag len pax) (~(got by changes) pax)]
|
|
|
|
==
|
|
|
|
::
|
2019-05-16 01:50:13 +03:00
|
|
|
:: Add or remove entries to the mime cache
|
|
|
|
::
|
|
|
|
++ apply-changes-to-mim
|
|
|
|
|= [mim=(map path mime) changes=(map path (unit mime))]
|
|
|
|
^- (map path mime)
|
|
|
|
=/ changes-l=(list [pax=path change=(unit mime)])
|
|
|
|
~(tap by changes)
|
|
|
|
|- ^- (map path mime)
|
|
|
|
?~ changes-l
|
|
|
|
mim
|
|
|
|
?~ change.i.changes-l
|
|
|
|
$(changes-l t.changes-l, mim (~(del by mim) pax.i.changes-l))
|
|
|
|
$(changes-l t.changes-l, mim (~(put by mim) [pax u.change]:i.changes-l))
|
|
|
|
::
|
2019-05-17 03:24:10 +03:00
|
|
|
:: Create a schematic to validate a page.
|
|
|
|
::
|
|
|
|
:: If the mark is %hoon, we short-circuit the validation for bootstrapping
|
|
|
|
:: purposes.
|
|
|
|
::
|
|
|
|
++ vale-page
|
|
|
|
|= [=disc:ford a=page]
|
|
|
|
^- schematic:ford
|
|
|
|
?. ?=($hoon p.a) [%vale disc a]
|
|
|
|
?. ?=(@t q.a) [%dude >%weird-hoon< %ride [%zpzp ~] %$ *cage]
|
|
|
|
[%$ p.a [%atom %t ~] q.a]
|
|
|
|
::
|
2019-05-16 01:50:13 +03:00
|
|
|
:: Crashes on ford failure
|
|
|
|
::
|
2019-05-04 05:24:24 +03:00
|
|
|
++ ford-fail |=(tan/tang ~|(%ford-fail (mean tan)))
|
|
|
|
::
|
|
|
|
:: Takes either a result or a stack trace. If it's a stack trace, we crash;
|
|
|
|
:: else, we produce the result.
|
|
|
|
::
|
|
|
|
++ unwrap-tang
|
|
|
|
|* res/(each * tang)
|
|
|
|
?:(?=(%& -.res) p.res (mean p.res))
|
|
|
|
::
|
|
|
|
:: Parse a gage to a list of pairs of cages, crashing on error.
|
|
|
|
::
|
|
|
|
:: Composition of ++gage-to-cages-or-error and ++unwrap-tang. Maybe same as
|
|
|
|
:: ++gage-to-success-cages?
|
|
|
|
::
|
|
|
|
++ made-result-to-cages
|
|
|
|
|= result=made-result:ford
|
|
|
|
^- (list (pair cage cage))
|
|
|
|
(unwrap-tang (made-result-to-cages-or-error result))
|
|
|
|
::
|
|
|
|
:: Same as ++gage-to-cages-or-error except crashes on error. Maybe same as
|
|
|
|
:: ++gage-to-cages?
|
|
|
|
::
|
|
|
|
++ made-result-to-success-cages
|
|
|
|
|= result=made-result:ford
|
|
|
|
^- (list (pair cage cage))
|
|
|
|
?. ?=([%complete %success %list *] result)
|
|
|
|
(ford-fail >%strange-ford-result< ~)
|
|
|
|
:: process each row in the list, filtering out errors
|
|
|
|
::
|
|
|
|
%+ murn results.build-result.result
|
|
|
|
|= row=build-result:ford
|
|
|
|
^- (unit [cage cage])
|
|
|
|
::
|
|
|
|
?: ?=([%error *] row)
|
|
|
|
~& [%clay-whole-build-failed message.row]
|
|
|
|
~
|
|
|
|
?: ?=([%success [%error *] *] row)
|
|
|
|
~& [%clay-first-failure message.head.row]
|
|
|
|
~
|
|
|
|
?: ?=([%success [%success *] [%error *]] row)
|
|
|
|
~& %clay-second-failure
|
|
|
|
%- (slog message.tail.row)
|
|
|
|
~
|
|
|
|
?. ?=([%success [%success *] [%success *]] row)
|
|
|
|
~
|
|
|
|
`[(result-to-cage:ford head.row) (result-to-cage:ford tail.row)]
|
|
|
|
::
|
|
|
|
:: Expects a single-level gage (i.e. a list of pairs of cages). If the
|
|
|
|
:: result is of a different form, or if some of the computations in the gage
|
|
|
|
:: failed, we produce a stack trace. Otherwise, we produce the list of pairs
|
|
|
|
:: of cages.
|
|
|
|
::
|
|
|
|
++ made-result-to-cages-or-error
|
|
|
|
|= result=made-result:ford
|
|
|
|
^- (each (list (pair cage cage)) tang)
|
|
|
|
::
|
|
|
|
?: ?=([%incomplete *] result)
|
|
|
|
(mule |.(`~`(ford-fail tang.result)))
|
|
|
|
?. ?=([%complete %success %list *] result)
|
|
|
|
(mule |.(`~`(ford-fail >%strange-ford-result -.build-result.result< ~)))
|
|
|
|
=/ results=(list build-result:ford)
|
|
|
|
results.build-result.result
|
|
|
|
=< ?+(. [%& .] {@ *} .)
|
|
|
|
|-
|
|
|
|
^- ?((list [cage cage]) (each ~ tang))
|
|
|
|
?~ results ~
|
|
|
|
::
|
|
|
|
?. ?=([%success ^ *] i.results)
|
|
|
|
(mule |.(`~`(ford-fail >%strange-ford-result< ~)))
|
|
|
|
?: ?=([%error *] head.i.results)
|
|
|
|
(mule |.(`~`(ford-fail message.head.i.results)))
|
|
|
|
?: ?=([%error *] tail.i.results)
|
|
|
|
(mule |.(`~`(ford-fail message.tail.i.results)))
|
|
|
|
::
|
|
|
|
=+ $(results t.results)
|
|
|
|
?: ?=([@ *] -) -
|
|
|
|
:_ -
|
|
|
|
[(result-to-cage:ford head.i.results) (result-to-cage:ford tail.i.results)]
|
|
|
|
::
|
|
|
|
:: Assumes the list of pairs of cages is actually a listified map of paths
|
|
|
|
:: to cages, and converts it to (map path cage) or a stack trace on error.
|
|
|
|
::
|
|
|
|
++ cages-to-map
|
|
|
|
|= tay/(list (pair cage cage))
|
|
|
|
=| can/(map path cage)
|
|
|
|
|- ^- (each (map path cage) tang)
|
|
|
|
?~ tay [%& can]
|
|
|
|
=* pax p.i.tay
|
|
|
|
?. ?=($path p.pax)
|
|
|
|
(mule |.(`~`~|([%expected-path got=p.pax] !!)))
|
2019-05-09 22:46:19 +03:00
|
|
|
$(tay t.tay, can (~(put by can) ;;(path q.q.pax) q.i.tay))
|
2019-05-04 05:24:24 +03:00
|
|
|
::
|
2019-05-14 08:20:46 +03:00
|
|
|
:: Useful functions which operate on a dome and a rang.
|
|
|
|
::
|
|
|
|
:: `original-dome` is the dome which we had when the transaction
|
|
|
|
:: started. This is used as a lobe-to-blob cache in
|
|
|
|
:: +lobe-to-schematic so we don't have to recalculate the blobs for
|
|
|
|
:: files which haven't changed.
|
|
|
|
::
|
2019-05-04 05:24:24 +03:00
|
|
|
++ state
|
2019-05-11 00:51:37 +03:00
|
|
|
|= [original-dome=dome dom=dome ran=rang]
|
2019-05-04 05:24:24 +03:00
|
|
|
|%
|
|
|
|
:: These convert between aeon (version number), tako (commit hash), yaki
|
|
|
|
:: (commit data structure), lobe (content hash), and blob (content).
|
|
|
|
++ aeon-to-tako ~(got by hit.dom)
|
2019-07-18 00:57:01 +03:00
|
|
|
++ aeon-to-yaki |=(=aeon (tako-to-yaki (aeon-to-tako aeon)))
|
2019-05-04 05:24:24 +03:00
|
|
|
++ lobe-to-blob ~(got by lat.ran)
|
|
|
|
++ tako-to-yaki ~(got by hut.ran)
|
|
|
|
++ lobe-to-mark
|
|
|
|
|= a/lobe
|
|
|
|
=> (lobe-to-blob a)
|
|
|
|
?- -
|
|
|
|
$delta p.q
|
|
|
|
$direct p.q
|
2019-05-03 04:50:20 +03:00
|
|
|
==
|
2019-05-04 05:24:24 +03:00
|
|
|
::
|
2019-05-14 08:20:46 +03:00
|
|
|
:: Create a schematic out of a page (which is a [mark noun]).
|
2019-05-04 05:24:24 +03:00
|
|
|
::
|
|
|
|
++ page-to-schematic
|
|
|
|
|= [disc=disc:ford a=page]
|
|
|
|
^- schematic:ford
|
|
|
|
?. ?=($hoon p.a) [%volt disc a]
|
|
|
|
:: %hoon bootstrapping
|
|
|
|
[%$ p.a [%atom %t ~] q.a]
|
|
|
|
::
|
2019-05-14 08:20:46 +03:00
|
|
|
:: Create a schematic out of a lobe (content hash).
|
2019-05-04 05:24:24 +03:00
|
|
|
::
|
|
|
|
++ lobe-to-schematic (cury lobe-to-schematic-p &)
|
|
|
|
++ lobe-to-schematic-p
|
2019-05-11 00:51:37 +03:00
|
|
|
=. dom original-dome
|
2019-05-04 05:24:24 +03:00
|
|
|
|= [local=? disc=disc:ford pax=path lob=lobe]
|
|
|
|
^- schematic:ford
|
|
|
|
::
|
2019-12-18 03:48:08 +03:00
|
|
|
=/ hat/(map path lobe)
|
2019-05-04 05:24:24 +03:00
|
|
|
?: =(let.dom 0)
|
2019-05-03 04:50:20 +03:00
|
|
|
~
|
2019-05-04 05:24:24 +03:00
|
|
|
q:(aeon-to-yaki let.dom)
|
|
|
|
=+ lol=`(unit lobe)`?.(local `0vsen.tinel (~(get by hat) pax))
|
|
|
|
|- ^- schematic:ford
|
|
|
|
?: =([~ lob] lol)
|
|
|
|
=+ (need (need (read-x & let.dom pax)))
|
|
|
|
?> ?=(%& -<)
|
|
|
|
[%$ p.-]
|
|
|
|
=+ bol=(~(got by lat.ran) lob)
|
|
|
|
?- -.bol
|
|
|
|
$direct (page-to-schematic disc q.bol)
|
|
|
|
$delta ~| delta+q.q.bol
|
|
|
|
[%pact disc $(lob q.q.bol) (page-to-schematic disc r.bol)]
|
2019-05-03 04:50:20 +03:00
|
|
|
==
|
2019-05-04 05:24:24 +03:00
|
|
|
::
|
2019-05-14 08:20:46 +03:00
|
|
|
:: Hash a page to get a lobe.
|
2019-05-04 05:24:24 +03:00
|
|
|
::
|
|
|
|
++ page-to-lobe |=(page (shax (jam +<)))
|
|
|
|
::
|
|
|
|
:: Make a direct blob out of a page.
|
|
|
|
::
|
|
|
|
++ make-direct-blob
|
|
|
|
|= p/page
|
|
|
|
^- blob
|
|
|
|
[%direct (page-to-lobe p) p]
|
|
|
|
::
|
|
|
|
:: Make a delta blob out of a lobe, mark, lobe of parent, and page of diff.
|
|
|
|
::
|
|
|
|
++ make-delta-blob
|
|
|
|
|= {p/lobe q/{p/mark q/lobe} r/page}
|
|
|
|
^- blob
|
|
|
|
[%delta p q r]
|
|
|
|
::
|
|
|
|
:: Make a commit out of a list of parents, content, and date.
|
|
|
|
::
|
|
|
|
++ make-yaki
|
|
|
|
|= {p/(list tako) q/(map path lobe) t/@da}
|
|
|
|
^- yaki
|
|
|
|
=+ ^= has
|
|
|
|
%^ cat 7 (sham [%yaki (roll p add) q t])
|
|
|
|
(sham [%tako (roll p add) q t])
|
|
|
|
[p q has t]
|
|
|
|
::
|
|
|
|
++ case-to-date
|
|
|
|
|= [now=@da =case]
|
|
|
|
^- @da
|
|
|
|
:: if the case is already a date, use it.
|
|
|
|
::
|
|
|
|
?: ?=([%da *] case)
|
|
|
|
p.case
|
|
|
|
:: translate other cases to dates
|
|
|
|
::
|
|
|
|
=/ aey (case-to-aeon-before now case)
|
|
|
|
?~ aey `@da`0
|
|
|
|
?: =(0 u.aey) `@da`0
|
|
|
|
t:(aeon-to-yaki u.aey)
|
|
|
|
::
|
|
|
|
:: Reduce a case to an aeon (version number)
|
|
|
|
::
|
2019-05-14 08:20:46 +03:00
|
|
|
:: We produce null if we can't yet reduce the case for whatever
|
|
|
|
:: resaon (usually either the time or aeon hasn't happened yet or
|
|
|
|
:: the label hasn't been created).
|
2019-05-04 05:24:24 +03:00
|
|
|
::
|
|
|
|
++ case-to-aeon-before
|
|
|
|
|= [lim=@da lok=case]
|
|
|
|
^- (unit aeon)
|
|
|
|
?- -.lok
|
|
|
|
$da
|
|
|
|
?: (gth p.lok lim) ~
|
|
|
|
|- ^- (unit aeon)
|
|
|
|
?: =(0 let.dom) [~ 0] :: avoid underflow
|
|
|
|
?: %+ gte p.lok
|
|
|
|
=< t
|
2019-11-12 08:40:47 +03:00
|
|
|
~| [%letdom let=let.dom hit=hit.dom hut=~(key by hut.ran)]
|
2019-05-04 05:24:24 +03:00
|
|
|
~| [%getdom (~(get by hit.dom) let.dom)]
|
|
|
|
%- aeon-to-yaki
|
|
|
|
let.dom
|
|
|
|
[~ let.dom]
|
|
|
|
$(let.dom (dec let.dom))
|
|
|
|
::
|
|
|
|
$tas (~(get by lab.dom) p.lok)
|
|
|
|
$ud ?:((gth p.lok let.dom) ~ [~ p.lok])
|
2019-05-03 04:50:20 +03:00
|
|
|
==
|
|
|
|
::
|
2019-05-04 05:24:24 +03:00
|
|
|
:: Convert a map of paths to data into an ankh.
|
2019-05-03 04:50:20 +03:00
|
|
|
::
|
2019-05-04 05:24:24 +03:00
|
|
|
++ map-to-ankh
|
|
|
|
|= hat/(map path (pair lobe cage))
|
|
|
|
^- ankh
|
|
|
|
%+ roll ~(tap by hat)
|
|
|
|
|= {{pat/path lob/lobe zar/cage} ank/ankh}
|
|
|
|
^- ankh
|
|
|
|
?~ pat
|
|
|
|
ank(fil [~ lob zar])
|
|
|
|
=+ nak=(~(get by dir.ank) i.pat)
|
|
|
|
%= ank
|
|
|
|
dir %+ ~(put by dir.ank) i.pat
|
|
|
|
$(pat t.pat, ank (fall nak *ankh))
|
|
|
|
==
|
2019-05-03 04:50:20 +03:00
|
|
|
::
|
2019-05-04 05:24:24 +03:00
|
|
|
:: Update the object store with new blobs.
|
2019-05-03 04:50:20 +03:00
|
|
|
::
|
2019-07-25 01:57:28 +03:00
|
|
|
:: Must uni the old-lat into the new-lat so that if we recreate
|
|
|
|
:: the same blob hash, we use the old blob not the new one. Else
|
|
|
|
:: you get mutually recurring %delta blobs.
|
2019-05-04 05:24:24 +03:00
|
|
|
++ add-blobs
|
|
|
|
|= [new-blobs=(map path blob) old-lat=(map lobe blob)]
|
|
|
|
^- (map lobe blob)
|
2019-07-25 01:57:28 +03:00
|
|
|
=/ new-lat=(map lobe blob)
|
|
|
|
%- malt
|
|
|
|
%+ turn
|
|
|
|
~(tap by new-blobs)
|
|
|
|
|= [=path =blob]
|
|
|
|
[p.blob blob]
|
|
|
|
(~(uni by new-lat) old-lat)
|
2019-05-03 04:50:20 +03:00
|
|
|
::
|
2019-05-14 08:20:46 +03:00
|
|
|
:: Apply a change list, creating the commit and applying it to
|
|
|
|
:: the current state.
|
2019-05-04 05:24:24 +03:00
|
|
|
::
|
|
|
|
++ execute-changes
|
|
|
|
|= [wen=@da lem=suba]
|
|
|
|
^- (unit [dome rang])
|
|
|
|
=/ parent
|
|
|
|
?: =(0 let.dom)
|
2019-05-03 04:50:20 +03:00
|
|
|
~
|
2019-05-04 05:24:24 +03:00
|
|
|
[(aeon-to-tako let.dom)]~
|
|
|
|
=/ new-blobs (apply-changes lem)
|
|
|
|
=. lat.ran (add-blobs new-blobs lat.ran)
|
|
|
|
=/ new-lobes (~(run by new-blobs) |=(=blob p.blob))
|
|
|
|
=/ new-yaki (make-yaki parent new-lobes wen)
|
|
|
|
:: if no changes and not first commit or merge, abort
|
|
|
|
?. ?| =(0 let.dom)
|
|
|
|
!=((lent p.new-yaki) 1)
|
|
|
|
!=(q.new-yaki q:(aeon-to-yaki let.dom))
|
|
|
|
==
|
|
|
|
~
|
|
|
|
=: let.dom +(let.dom)
|
|
|
|
hit.dom (~(put by hit.dom) +(let.dom) r.new-yaki)
|
|
|
|
hut.ran (~(put by hut.ran) r.new-yaki new-yaki)
|
2019-05-03 04:50:20 +03:00
|
|
|
==
|
2019-05-04 05:24:24 +03:00
|
|
|
`[dom ran]
|
2019-05-03 04:50:20 +03:00
|
|
|
::
|
2019-05-14 08:20:46 +03:00
|
|
|
:: Apply label to current revision
|
2019-05-03 04:50:20 +03:00
|
|
|
::
|
2019-05-04 05:24:24 +03:00
|
|
|
++ execute-label
|
|
|
|
|= lab=@tas
|
|
|
|
?< (~(has by lab.dom) lab)
|
|
|
|
dom(lab (~(put by lab.dom) lab let.dom))
|
2019-05-03 04:50:20 +03:00
|
|
|
::
|
2019-05-14 08:20:46 +03:00
|
|
|
:: Apply a list of changes against the current state and produce
|
|
|
|
:: the new state.
|
2019-05-04 05:24:24 +03:00
|
|
|
::
|
|
|
|
++ apply-changes :: apply-changes
|
|
|
|
|= [change-files=(list [p=path q=misu])]
|
|
|
|
^- (map path blob)
|
|
|
|
=+ ^= old-files :: current state
|
|
|
|
?: =(let.dom 0) :: initial commit
|
|
|
|
~ :: has nothing
|
|
|
|
=< q
|
|
|
|
%- aeon-to-yaki
|
|
|
|
let.dom
|
|
|
|
=; new-files=(map path blob)
|
|
|
|
=+ sar=(silt (turn change-files head)) :: changed paths
|
|
|
|
%+ roll ~(tap by old-files) :: find unchanged
|
|
|
|
=< .(bat new-files)
|
|
|
|
|= [[pax=path gar=lobe] bat=(map path blob)]
|
|
|
|
?: (~(has in sar) pax) :: has update
|
|
|
|
bat
|
|
|
|
%+ ~(put by bat) pax
|
|
|
|
~| [pax gar (lent ~(tap by lat.ran))]
|
|
|
|
(lobe-to-blob gar) :: use original
|
|
|
|
%+ roll change-files
|
|
|
|
|= {{pax/path mys/misu} new-files/(map path blob)}
|
|
|
|
^+ new-files
|
|
|
|
?- -.mys
|
|
|
|
$ins :: insert if not exist
|
|
|
|
?: (~(has by new-files) pax)
|
|
|
|
~|([%ins-new-files pax] !!)
|
|
|
|
?: (~(has by old-files) pax)
|
|
|
|
~|([%ins-old-files pax] !!)
|
|
|
|
%+ ~(put by new-files) pax
|
|
|
|
%- make-direct-blob
|
|
|
|
?: &(?=($mime -.p.mys) =([%hoon ~] (slag (dec (lent pax)) pax)))
|
|
|
|
`page`[%hoon +.+.q.q.p.mys]
|
|
|
|
[p q.q]:p.mys
|
|
|
|
::
|
|
|
|
$del :: delete if exists
|
|
|
|
?> |((~(has by old-files) pax) (~(has by new-files) pax))
|
|
|
|
(~(del by new-files) pax)
|
|
|
|
::
|
|
|
|
$dif :: mutate, must exist
|
|
|
|
=+ ber=(~(get by new-files) pax) :: XX typed
|
|
|
|
=+ her==>((flop pax) ?~(. %$ i))
|
|
|
|
?~ ber
|
|
|
|
=+ har=(~(get by old-files) pax)
|
|
|
|
?~ har !!
|
|
|
|
%+ ~(put by new-files) pax
|
|
|
|
(make-delta-blob p.mys [(lobe-to-mark u.har) u.har] [p q.q]:q.mys)
|
|
|
|
:: XX check vase !evil
|
|
|
|
:: XX of course that's a problem, p.u.ber isn't in rang since it
|
|
|
|
:: was just created. We shouldn't be sending multiple
|
|
|
|
:: diffs
|
|
|
|
:: %+ ~(put by bar) pax
|
|
|
|
:: %^ make-delta-blob p.mys
|
|
|
|
:: [(lobe-to-mark p.u.ber) p.u.ber]
|
|
|
|
:: [p q.q]:q.mys
|
|
|
|
:: :: XX check vase !evil
|
|
|
|
~|([%two-diffs-for-same-file pax] !!)
|
2019-05-03 04:50:20 +03:00
|
|
|
==
|
|
|
|
::
|
2019-05-14 08:20:46 +03:00
|
|
|
:: Traverse parentage and find all ancestor hashes
|
2019-05-03 04:50:20 +03:00
|
|
|
::
|
2019-05-04 05:24:24 +03:00
|
|
|
++ reachable-takos :: reachable
|
|
|
|
|= p/tako
|
|
|
|
^- (set tako)
|
|
|
|
=+ y=(tako-to-yaki p)
|
|
|
|
%+ roll p.y
|
|
|
|
=< .(s (~(put in *(set tako)) p))
|
|
|
|
|= {q/tako s/(set tako)}
|
|
|
|
?: (~(has in s) q) :: already done
|
|
|
|
s :: hence skip
|
|
|
|
(~(uni in s) ^$(p q)) :: otherwise traverse
|
2019-05-03 04:50:20 +03:00
|
|
|
::
|
2019-05-14 08:20:46 +03:00
|
|
|
:: Get the data at a node.
|
2019-05-03 04:50:20 +03:00
|
|
|
::
|
2019-05-14 08:20:46 +03:00
|
|
|
:: If it's in our ankh (current state cache), we can just produce
|
|
|
|
:: the result. Otherwise, we've got to look up the node at the
|
|
|
|
:: aeon to get the content hash, use that to find the blob, and use
|
|
|
|
:: the blob to get the data. We also special-case the hoon mark
|
|
|
|
:: for bootstrapping purposes.
|
2019-05-04 05:24:24 +03:00
|
|
|
::
|
|
|
|
++ read-x
|
|
|
|
|= [local=? yon=aeon pax=path]
|
|
|
|
^- (unit (unit (each cage lobe)))
|
|
|
|
?: =(0 yon)
|
|
|
|
[~ ~]
|
|
|
|
=+ tak=(~(get by hit.dom) yon)
|
|
|
|
?~ tak
|
2019-05-03 04:50:20 +03:00
|
|
|
~
|
2019-05-04 05:24:24 +03:00
|
|
|
?: &(local =(yon let.dom))
|
|
|
|
:- ~
|
|
|
|
%+ bind
|
|
|
|
fil.ank:(descend-path:(zu ank.dom) pax)
|
|
|
|
|=(a/{p/lobe q/cage} [%& q.a])
|
|
|
|
=+ yak=(tako-to-yaki u.tak)
|
|
|
|
=+ lob=(~(get by q.yak) pax)
|
|
|
|
?~ lob
|
|
|
|
[~ ~]
|
|
|
|
=+ mar=(lobe-to-mark u.lob)
|
|
|
|
?. ?=($hoon mar)
|
|
|
|
[~ ~ %| u.lob]
|
|
|
|
:^ ~ ~ %&
|
|
|
|
:+ mar [%atom %t ~]
|
|
|
|
|- ^- @t :: (urge cord) would be faster
|
|
|
|
=+ bol=(lobe-to-blob u.lob)
|
|
|
|
?: ?=($direct -.bol)
|
2019-05-15 21:13:25 +03:00
|
|
|
;;(@t q.q.bol)
|
2019-05-04 05:24:24 +03:00
|
|
|
?> ?=($delta -.bol)
|
|
|
|
=+ txt=$(u.lob q.q.bol)
|
|
|
|
?> ?=($txt-diff p.r.bol)
|
2019-05-15 21:13:25 +03:00
|
|
|
=+ dif=;;((urge cord) q.r.bol)
|
2019-05-04 05:24:24 +03:00
|
|
|
=, format
|
|
|
|
=+ pac=(of-wain (lurk:differ (to-wain (cat 3 txt '\0a')) dif))
|
|
|
|
(end 3 (dec (met 3 pac)) pac)
|
|
|
|
::
|
|
|
|
:: Traverse an ankh.
|
|
|
|
::
|
|
|
|
++ zu :: filesystem
|
|
|
|
|= ank/ankh :: filesystem state
|
|
|
|
=| ram/path :: reverse path into
|
|
|
|
|%
|
|
|
|
++ descend :: descend
|
|
|
|
|= lol/@ta
|
|
|
|
^+ +>
|
|
|
|
=+ you=(~(get by dir.ank) lol)
|
|
|
|
+>.$(ram [lol ram], ank ?~(you [~ ~] u.you))
|
|
|
|
::
|
|
|
|
++ descend-path :: descend recursively
|
|
|
|
|= way/path
|
|
|
|
^+ +>
|
|
|
|
?~(way +> $(way t.way, +> (descend i.way)))
|
|
|
|
--
|
2019-05-03 04:50:20 +03:00
|
|
|
--
|
|
|
|
--
|
2016-11-24 07:25:07 +03:00
|
|
|
::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
|
|
|
|
:: section 4cA, filesystem logic
|
|
|
|
::
|
|
|
|
:: This core contains the main logic of clay. Besides `++ze`, this directly
|
|
|
|
:: contains the logic for commiting new revisions (local urbits), managing
|
|
|
|
:: and notifying subscribers (reactivity), and pulling and validating content
|
|
|
|
:: (remote urbits).
|
|
|
|
::
|
|
|
|
:: The state includes:
|
|
|
|
::
|
2018-12-13 10:42:15 +03:00
|
|
|
:: -- local urbit `our`
|
2016-11-24 07:25:07 +03:00
|
|
|
:: -- current time `now`
|
|
|
|
:: -- current duct `hen`
|
2019-02-02 00:46:09 +03:00
|
|
|
:: -- scry handler `ski`
|
2018-12-13 10:42:15 +03:00
|
|
|
:: -- all vane state `++raft` (rarely used, except for the object store)
|
2016-11-24 07:25:07 +03:00
|
|
|
:: -- target urbit `her`
|
|
|
|
:: -- target desk `syd`
|
|
|
|
::
|
|
|
|
:: For local desks, `our` == `her` is one of the urbits on our pier. For
|
|
|
|
:: foreign desks, `her` is the urbit the desk is on and `our` is the local
|
|
|
|
:: urbit that's managing the relationship with the foreign urbit. Don't mix
|
|
|
|
:: up those two, or there will be wailing and gnashing of teeth.
|
|
|
|
::
|
2018-12-13 10:42:15 +03:00
|
|
|
:: While setting up `++de`, we check if `our` == `her`. If so, we get
|
|
|
|
:: the desk information from `dos.rom`. Otherwise, we get the rung from
|
|
|
|
:: `hoy` and get the desk information from `rus` in there. In either case,
|
|
|
|
:: we normalize the desk information to a `++rede`, which is all the
|
|
|
|
:: desk-specific data that we utilize in `++de`. Because it's effectively
|
|
|
|
:: a part of the `++de` state, let's look at what we've got:
|
2016-11-24 07:25:07 +03:00
|
|
|
::
|
|
|
|
:: -- `lim` is the most recent date we're confident we have all the
|
|
|
|
:: information for. For local desks, this is always `now`. For foreign
|
|
|
|
:: desks, this is the last time we got a full update from the foreign
|
|
|
|
:: urbit.
|
|
|
|
:: -- `ref` is a possible request manager. For local desks, this is null.
|
|
|
|
:: For foreign desks, this keeps track of all pending foreign requests
|
|
|
|
:: plus a cache of the responses to previous requests.
|
|
|
|
:: -- `qyx` is the set of subscriptions, with listening ducts. These
|
|
|
|
:: subscriptions exist only until they've been filled.
|
|
|
|
:: -- `dom` is the actual state of the filetree. Since this is used almost
|
|
|
|
:: exclusively in `++ze`, we describe it there.
|
|
|
|
::
|
|
|
|
::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
|
|
|
|
++ de :: per desk
|
2019-02-02 00:46:09 +03:00
|
|
|
|= [our=ship now=@da ski=sley hen=duct raft]
|
2018-12-13 10:42:15 +03:00
|
|
|
|= [her=ship syd=desk]
|
|
|
|
:: XX ruf=raft crashes in the compiler
|
|
|
|
::
|
2019-02-02 00:46:09 +03:00
|
|
|
=* ruf |4.+6.^$
|
2018-12-13 10:42:15 +03:00
|
|
|
::
|
2019-12-18 03:48:08 +03:00
|
|
|
=/ [mow=(list move) hun=(unit duct) rede]
|
2018-12-13 10:42:15 +03:00
|
|
|
?. =(our her)
|
|
|
|
:: no duct, foreign +rede or default
|
|
|
|
::
|
2019-07-27 09:36:59 +03:00
|
|
|
:+ ?: (~(has by hoy.ruf) her)
|
|
|
|
~
|
2019-08-07 01:42:37 +03:00
|
|
|
[hun.rom.ruf %pass /sinks %j %public-keys (silt her ~)]~
|
2019-07-27 09:36:59 +03:00
|
|
|
~
|
2019-06-30 15:50:00 +03:00
|
|
|
=/ rus rus:(~(gut by hoy.ruf) her *rung)
|
|
|
|
%+ ~(gut by rus) syd
|
2019-05-04 05:24:24 +03:00
|
|
|
[lim=~2000.1.1 ref=`*rind qyx=~ dom=*dome per=~ pew=~]
|
2018-12-13 10:42:15 +03:00
|
|
|
:: administrative duct, domestic +rede
|
|
|
|
::
|
2019-07-27 09:36:59 +03:00
|
|
|
:+ ~ `hun.rom.ruf
|
2019-06-30 15:50:00 +03:00
|
|
|
=/ jod (~(gut by dos.rom.ruf) syd *dojo)
|
2019-05-04 05:24:24 +03:00
|
|
|
[lim=now ref=~ [qyx dom per pew]:jod]
|
2018-12-13 10:42:15 +03:00
|
|
|
::
|
2019-07-27 09:36:59 +03:00
|
|
|
=* red=rede ->+
|
2016-11-24 07:25:07 +03:00
|
|
|
|%
|
|
|
|
++ abet :: resolve
|
2018-12-13 10:42:15 +03:00
|
|
|
^- [(list move) raft]
|
|
|
|
:- (flop mow)
|
|
|
|
?. =(our her)
|
|
|
|
:: save foreign +rede
|
|
|
|
::
|
2019-06-30 15:50:00 +03:00
|
|
|
=/ run (~(gut by hoy.ruf) her *rung)
|
2019-02-02 00:46:09 +03:00
|
|
|
=/ rug (~(put by rus.run) syd red)
|
|
|
|
ruf(hoy (~(put by hoy.ruf) her run(rus rug)))
|
2018-12-13 10:42:15 +03:00
|
|
|
:: save domestic +room
|
|
|
|
::
|
2019-05-03 04:50:20 +03:00
|
|
|
%= ruf
|
|
|
|
hun.rom (need hun)
|
2019-05-04 05:24:24 +03:00
|
|
|
dos.rom (~(put by dos.rom.ruf) syd [qyx dom per pew]:red)
|
2019-05-03 04:50:20 +03:00
|
|
|
==
|
2016-11-24 07:25:07 +03:00
|
|
|
::
|
2019-05-03 04:50:20 +03:00
|
|
|
:: Handle `%sing` requests
|
2016-11-24 07:25:07 +03:00
|
|
|
::
|
2019-05-03 04:50:20 +03:00
|
|
|
++ aver
|
|
|
|
|= {for/(unit ship) mun/mood}
|
|
|
|
^- (unit (unit (each cage lobe)))
|
|
|
|
=+ ezy=?~(ref ~ (~(get by haw.u.ref) mun))
|
|
|
|
?^ ezy
|
|
|
|
`(bind u.ezy |=(a/cage [%& a]))
|
2019-05-23 00:39:12 +03:00
|
|
|
=+ nao=(case-to-aeon case.mun)
|
|
|
|
:: ~& [%aver-mun nao [%from syd lim case.mun]]
|
2019-05-03 04:50:20 +03:00
|
|
|
?~(nao ~ (read-at-aeon:ze for u.nao mun))
|
2016-11-24 07:25:07 +03:00
|
|
|
::
|
2019-05-03 04:50:20 +03:00
|
|
|
:: Queue a move.
|
2018-02-12 18:02:32 +03:00
|
|
|
::
|
2019-05-03 04:50:20 +03:00
|
|
|
++ emit
|
|
|
|
|= mof/move
|
|
|
|
%_(+> mow [mof mow])
|
2016-11-24 07:25:07 +03:00
|
|
|
::
|
2019-05-03 04:50:20 +03:00
|
|
|
:: Queue a list of moves
|
2016-11-24 07:25:07 +03:00
|
|
|
::
|
2019-05-03 04:50:20 +03:00
|
|
|
++ emil
|
|
|
|
|= mof/(list move)
|
2019-05-14 09:18:52 +03:00
|
|
|
%_(+> mow (weld (flop mof) mow))
|
2016-11-24 07:25:07 +03:00
|
|
|
::
|
2019-05-03 04:50:20 +03:00
|
|
|
:: Produce either null or a result along a subscription.
|
2016-11-24 07:25:07 +03:00
|
|
|
::
|
2019-05-03 04:50:20 +03:00
|
|
|
:: Producing null means subscription has been completed or cancelled.
|
2016-11-24 07:25:07 +03:00
|
|
|
::
|
2019-05-03 04:50:20 +03:00
|
|
|
++ balk
|
|
|
|
|= {hen/duct cay/(unit (each cage lobe)) mun/mood}
|
2016-11-24 07:25:07 +03:00
|
|
|
^+ +>
|
2019-05-03 04:50:20 +03:00
|
|
|
?~ cay (blub hen)
|
|
|
|
(blab hen mun u.cay)
|
2016-11-24 07:25:07 +03:00
|
|
|
::
|
2019-05-03 04:50:20 +03:00
|
|
|
:: Set timer.
|
2016-11-24 07:25:07 +03:00
|
|
|
::
|
2019-05-03 04:50:20 +03:00
|
|
|
++ bait
|
|
|
|
|= {hen/duct tym/@da}
|
2019-05-23 03:01:02 +03:00
|
|
|
(emit hen %pass /tyme/(scot %p her)/[syd] %b %wait tym)
|
2016-11-24 07:25:07 +03:00
|
|
|
::
|
2019-05-03 04:50:20 +03:00
|
|
|
:: Cancel timer.
|
2019-05-02 04:21:32 +03:00
|
|
|
::
|
2019-05-03 04:50:20 +03:00
|
|
|
++ best
|
|
|
|
|= {hen/duct tym/@da}
|
2019-05-23 03:01:02 +03:00
|
|
|
(emit hen %pass /tyme/(scot %p her)/[syd] %b %rest tym)
|
2019-05-03 04:50:20 +03:00
|
|
|
::
|
|
|
|
:: Give subscription result.
|
|
|
|
::
|
|
|
|
:: Result can be either a direct result (cage) or a lobe of a result. In
|
|
|
|
:: the latter case we fetch the data at the lobe and produce that.
|
|
|
|
::
|
|
|
|
++ blab
|
|
|
|
|= {hen/duct mun/mood dat/(each cage lobe)}
|
|
|
|
^+ +>
|
|
|
|
?: ?=(%& -.dat)
|
2019-09-10 23:38:39 +03:00
|
|
|
%- emit
|
|
|
|
:* hen %slip %b %drip
|
|
|
|
!>([%writ ~ [care.mun case.mun syd] path.mun p.dat])
|
|
|
|
==
|
2019-05-03 04:50:20 +03:00
|
|
|
%- emit
|
2019-05-23 00:39:12 +03:00
|
|
|
:* hen %pass [%blab care.mun (scot case.mun) syd path.mun]
|
2019-05-03 04:50:20 +03:00
|
|
|
%f %build live=%.n %pin
|
2019-05-23 00:39:12 +03:00
|
|
|
(case-to-date case.mun)
|
|
|
|
(lobe-to-schematic [her syd] path.mun p.dat)
|
2019-05-02 04:21:32 +03:00
|
|
|
==
|
|
|
|
::
|
2019-05-04 05:24:24 +03:00
|
|
|
++ case-to-date (cury case-to-date:util lim)
|
|
|
|
++ case-to-aeon (cury case-to-aeon-before:util lim)
|
|
|
|
++ lobe-to-schematic (cury lobe-to-schematic-p:util ?=(~ ref))
|
2019-05-02 04:21:32 +03:00
|
|
|
::
|
2019-05-03 04:50:20 +03:00
|
|
|
++ blas
|
|
|
|
|= {hen/duct das/(set mood)}
|
2019-05-02 04:21:32 +03:00
|
|
|
^+ +>
|
2019-05-03 04:50:20 +03:00
|
|
|
?> ?=(^ das)
|
|
|
|
:: translate the case to a date
|
|
|
|
::
|
2019-05-23 00:39:12 +03:00
|
|
|
=/ cas [%da (case-to-date case.n.das)]
|
2019-05-14 08:20:46 +03:00
|
|
|
=- (emit hen %slip %b %drip !>([%wris cas -]))
|
2019-05-23 00:39:12 +03:00
|
|
|
(~(run in `(set mood)`das) |=(m/mood [care.m path.m]))
|
2019-05-02 04:21:32 +03:00
|
|
|
::
|
2019-05-03 04:50:20 +03:00
|
|
|
:: Give next step in a subscription.
|
2019-05-02 04:21:32 +03:00
|
|
|
::
|
2019-05-03 04:50:20 +03:00
|
|
|
++ bleb
|
|
|
|
|= {hen/duct ins/@ud hip/(unit (pair aeon aeon))}
|
2019-05-02 04:21:32 +03:00
|
|
|
^+ +>
|
2019-05-03 04:50:20 +03:00
|
|
|
%^ blab hen [%w [%ud ins] ~]
|
|
|
|
:- %&
|
|
|
|
?~ hip
|
|
|
|
[%null [%atom %n ~] ~]
|
|
|
|
[%nako !>((make-nako:ze u.hip))]
|
2019-05-02 04:21:32 +03:00
|
|
|
::
|
2019-05-03 04:50:20 +03:00
|
|
|
:: Tell subscriber that subscription is done.
|
2019-05-02 04:21:32 +03:00
|
|
|
::
|
2019-05-03 04:50:20 +03:00
|
|
|
++ blub
|
|
|
|
|= hen/duct
|
|
|
|
(emit hen %slip %b %drip !>([%writ ~]))
|
2019-05-02 04:21:32 +03:00
|
|
|
::
|
2019-05-03 04:50:20 +03:00
|
|
|
:: Lifts a function so that a single result can be fanned out over a set of
|
|
|
|
:: subscriber ducts.
|
2019-05-02 04:21:32 +03:00
|
|
|
::
|
2019-05-03 04:50:20 +03:00
|
|
|
:: Thus, `((duct-lift func) subs arg)` runs `(func sub arg)` for each `sub`
|
|
|
|
:: in `subs`.
|
2019-05-02 04:21:32 +03:00
|
|
|
::
|
2019-05-03 04:50:20 +03:00
|
|
|
++ duct-lift
|
|
|
|
|* send/_|=({duct *} ..duct-lift)
|
|
|
|
|= {a/(set duct) arg/_+<+.send} ^+ ..duct-lift
|
|
|
|
=+ all=~(tap by a)
|
|
|
|
|- ^+ ..duct-lift
|
|
|
|
?~ all ..duct-lift
|
|
|
|
=. +>.send ..duct-lift
|
|
|
|
$(all t.all, duct-lift (send i.all arg))
|
2019-05-02 04:21:32 +03:00
|
|
|
::
|
2019-05-23 00:39:12 +03:00
|
|
|
++ blub-all (duct-lift |=([a=duct ~] (blub a)))
|
|
|
|
++ blab-all (duct-lift blab)
|
|
|
|
++ blas-all (duct-lift blas)
|
|
|
|
++ balk-all (duct-lift balk)
|
|
|
|
++ bleb-all (duct-lift bleb)
|
2019-05-03 04:50:20 +03:00
|
|
|
::
|
|
|
|
:: Transfer a request to another ship's clay.
|
|
|
|
::
|
|
|
|
++ send-over-ames
|
2019-06-29 02:43:52 +03:00
|
|
|
|= [=duct =ship index=@ud =riff]
|
|
|
|
^+ +>
|
|
|
|
::
|
|
|
|
=/ =desk p.riff
|
|
|
|
=/ =wire /warp-index/(scot %p ship)/(scot %tas desk)/(scot %ud index)
|
2019-07-29 09:37:49 +03:00
|
|
|
=/ =path [%question desk (scot %ud index) ~]
|
|
|
|
(emit duct %pass wire %a %plea ship %c path riff)
|
2019-05-03 04:50:20 +03:00
|
|
|
::
|
|
|
|
:: 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
|
|
|
|
:: waiting for a particular time. If it's a foreign request, we add it to
|
|
|
|
:: our request manager (ref, which is a ++rind) and make the request to the
|
|
|
|
:: foreign ship.
|
|
|
|
::
|
|
|
|
++ duce :: produce request
|
2019-05-13 23:53:46 +03:00
|
|
|
|= wov=wove
|
2019-05-03 04:50:20 +03:00
|
|
|
^+ +>
|
|
|
|
=. wov (dedupe wov)
|
|
|
|
=. qyx (~(put ju qyx) wov hen)
|
|
|
|
?~ ref
|
2019-05-23 00:39:12 +03:00
|
|
|
(run-if-future rove.wov |=(@da (bait hen +<)))
|
2019-05-14 08:20:46 +03:00
|
|
|
|- ^+ +>+.$
|
2019-05-23 00:39:12 +03:00
|
|
|
=/ =rave (rove-to-rave rove.wov)
|
|
|
|
=. rave
|
|
|
|
?. ?=([%sing %v *] rave) rave
|
|
|
|
[%many %| [%ud let.dom] case.mood.rave path.mood.rave]
|
2019-05-03 04:50:20 +03:00
|
|
|
=+ inx=nix.u.ref
|
2019-05-14 08:20:46 +03:00
|
|
|
=. +>+.$
|
2019-05-03 04:50:20 +03:00
|
|
|
=< ?>(?=(^ ref) .)
|
2019-06-29 02:43:52 +03:00
|
|
|
(send-over-ames hen her inx syd `rave)
|
2019-05-14 08:20:46 +03:00
|
|
|
%= +>+.$
|
2019-05-03 04:50:20 +03:00
|
|
|
nix.u.ref +(nix.u.ref)
|
2019-05-23 00:39:12 +03:00
|
|
|
bom.u.ref (~(put by bom.u.ref) inx [hen rave])
|
2019-05-03 04:50:20 +03:00
|
|
|
fod.u.ref (~(put by fod.u.ref) hen inx)
|
|
|
|
==
|
|
|
|
::
|
|
|
|
:: If a similar request exists, switch to the existing request.
|
|
|
|
::
|
|
|
|
:: "Similar" requests are those %next and %many requests which are the same
|
|
|
|
:: up to starting case, but we're already after the starting case. This
|
|
|
|
:: stacks later requests for something onto the same request so that they
|
|
|
|
:: all get filled at once.
|
|
|
|
::
|
|
|
|
++ dedupe :: find existing alias
|
|
|
|
|= wov/wove
|
|
|
|
^- wove
|
|
|
|
=; won/(unit wove) (fall won wov)
|
2019-05-23 00:39:12 +03:00
|
|
|
=* rov rove.wov
|
2019-05-03 04:50:20 +03:00
|
|
|
?- -.rov
|
|
|
|
$sing ~
|
|
|
|
$next
|
2019-05-23 00:39:12 +03:00
|
|
|
=+ aey=(case-to-aeon case.mood.rov)
|
2019-05-03 04:50:20 +03:00
|
|
|
?~ aey ~
|
|
|
|
%- ~(rep in ~(key by qyx))
|
|
|
|
|= {haw/wove res/(unit wove)}
|
|
|
|
?^ res res
|
2019-05-23 00:39:12 +03:00
|
|
|
?. =(for.wov for.haw) ~
|
|
|
|
=* hav rove.haw
|
2019-05-03 04:50:20 +03:00
|
|
|
=- ?:(- `haw ~)
|
|
|
|
?& ?=($next -.hav)
|
2019-05-23 00:39:12 +03:00
|
|
|
=(mood.hav mood.rov(case case.mood.hav))
|
2019-05-03 04:50:20 +03:00
|
|
|
::
|
|
|
|
:: only a match if this request is before
|
|
|
|
:: or at our starting case.
|
2019-05-23 00:39:12 +03:00
|
|
|
=+ hay=(case-to-aeon case.mood.hav)
|
2019-05-03 04:50:20 +03:00
|
|
|
?~(hay | (lte u.hay u.aey))
|
2019-05-02 04:21:32 +03:00
|
|
|
==
|
2019-05-03 04:50:20 +03:00
|
|
|
::
|
|
|
|
$mult
|
2019-05-23 00:39:12 +03:00
|
|
|
=+ aey=(case-to-aeon case.mool.rov)
|
2019-05-03 04:50:20 +03:00
|
|
|
?~ aey ~
|
|
|
|
%- ~(rep in ~(key by qyx))
|
|
|
|
|= {haw/wove res/(unit wove)}
|
|
|
|
?^ res res
|
2019-05-23 00:39:12 +03:00
|
|
|
?. =(for.wov for.haw) ~
|
|
|
|
=* hav rove.haw
|
2019-05-03 04:50:20 +03:00
|
|
|
=- ?:(- `haw ~)
|
|
|
|
?& ?=($mult -.hav)
|
2019-05-23 00:39:12 +03:00
|
|
|
=(mool.hav mool.rov(case case.mool.hav))
|
2019-05-03 04:50:20 +03:00
|
|
|
::
|
|
|
|
:: only a match if this request is before
|
|
|
|
:: or at our starting case, and it has been
|
|
|
|
:: tested at least that far.
|
2019-05-23 00:39:12 +03:00
|
|
|
=+ hay=(case-to-aeon case.mool.hav)
|
2019-05-03 04:50:20 +03:00
|
|
|
?& ?=(^ hay)
|
|
|
|
(lte u.hay u.aey)
|
2019-05-23 00:39:12 +03:00
|
|
|
?=(^ aeon.hav)
|
|
|
|
(gte u.aeon.hav u.aey)
|
2019-05-03 04:50:20 +03:00
|
|
|
==
|
2019-05-02 04:21:32 +03:00
|
|
|
==
|
2019-05-03 04:50:20 +03:00
|
|
|
::
|
|
|
|
$many
|
2019-05-23 00:39:12 +03:00
|
|
|
=+ aey=(case-to-aeon from.moat.rov)
|
2019-05-03 04:50:20 +03:00
|
|
|
?~ aey ~
|
|
|
|
%- ~(rep in ~(key by qyx))
|
|
|
|
|= {haw/wove res/(unit wove)}
|
|
|
|
?^ res res
|
2019-05-23 00:39:12 +03:00
|
|
|
?. =(for.wov for.haw) ~
|
|
|
|
=* hav rove.haw
|
2019-05-03 04:50:20 +03:00
|
|
|
=- ?:(- `haw ~)
|
|
|
|
?& ?=($many -.hav)
|
2019-05-23 00:39:12 +03:00
|
|
|
=(hav rov(from.moat from.moat.hav))
|
2019-05-03 04:50:20 +03:00
|
|
|
::
|
|
|
|
:: only a match if this request is before
|
|
|
|
:: or at our starting case.
|
2019-05-23 00:39:12 +03:00
|
|
|
=+ hay=(case-to-aeon from.moat.hav)
|
2019-05-03 04:50:20 +03:00
|
|
|
?~(hay | (lte u.hay u.aey))
|
|
|
|
==
|
|
|
|
==
|
2016-11-24 07:25:07 +03:00
|
|
|
::
|
2019-05-03 04:50:20 +03:00
|
|
|
:: Set permissions for a node.
|
2016-11-24 07:25:07 +03:00
|
|
|
::
|
2019-05-03 04:50:20 +03:00
|
|
|
++ perm
|
|
|
|
|= {pax/path rit/rite}
|
|
|
|
^+ +>
|
|
|
|
=/ mis/(set @ta)
|
|
|
|
%+ roll
|
|
|
|
=- ~(tap in -)
|
|
|
|
?- -.rit
|
|
|
|
$r who:(fall red.rit *rule)
|
|
|
|
$w who:(fall wit.rit *rule)
|
|
|
|
$rw (~(uni in who:(fall red.rit *rule)) who:(fall wit.rit *rule))
|
|
|
|
==
|
|
|
|
|= {w/whom s/(set @ta)}
|
|
|
|
?: |(?=(%& -.w) (~(has by cez) p.w)) s
|
|
|
|
(~(put in s) p.w)
|
|
|
|
?^ mis
|
2019-07-16 02:11:22 +03:00
|
|
|
:: TODO remove this nasty hack
|
|
|
|
::
|
|
|
|
?. ?=([[%a *] *] hen)
|
|
|
|
+>.$
|
2019-06-29 02:43:52 +03:00
|
|
|
=- (emit hen %give %done `[%perm-fail [%leaf "No such group(s): {-}"]~])
|
2019-05-03 04:50:20 +03:00
|
|
|
%+ roll ~(tap in `(set @ta)`mis)
|
|
|
|
|= {g/@ta t/tape}
|
|
|
|
?~ t (trip g)
|
|
|
|
:(weld t ", " (trip g))
|
2019-07-16 02:11:22 +03:00
|
|
|
:: TODO remove this nasty hack
|
|
|
|
::
|
|
|
|
=< ?. ?=([[%a *] *] hen)
|
|
|
|
.
|
|
|
|
(emit hen %give %done ~)
|
|
|
|
::
|
2019-05-03 04:50:20 +03:00
|
|
|
?- -.rit
|
|
|
|
$r wake(per (put-perm per pax red.rit))
|
|
|
|
$w wake(pew (put-perm pew pax wit.rit))
|
|
|
|
$rw wake(per (put-perm per pax red.rit), pew (put-perm pew pax wit.rit))
|
|
|
|
==
|
2016-11-24 07:25:07 +03:00
|
|
|
::
|
2019-05-03 04:50:20 +03:00
|
|
|
++ put-perm
|
|
|
|
|= {pes/regs pax/path new/(unit rule)}
|
|
|
|
?~ new (~(del by pes) pax)
|
|
|
|
(~(put by pes) pax u.new)
|
2016-11-24 07:25:07 +03:00
|
|
|
::
|
2019-05-03 04:50:20 +03:00
|
|
|
:: Remove a group from all rules.
|
2016-11-24 07:25:07 +03:00
|
|
|
::
|
2019-05-03 04:50:20 +03:00
|
|
|
++ forget-crew
|
|
|
|
|= nom/@ta
|
|
|
|
%= +>
|
|
|
|
per (forget-crew-in nom per)
|
|
|
|
pew (forget-crew-in nom pew)
|
|
|
|
==
|
2016-11-24 07:25:07 +03:00
|
|
|
::
|
2019-05-03 04:50:20 +03:00
|
|
|
++ forget-crew-in
|
|
|
|
|= {nom/@ta pes/regs}
|
|
|
|
%- ~(run by pes)
|
|
|
|
|= r/rule
|
|
|
|
r(who (~(del in who.r) |+nom))
|
2016-11-24 07:25:07 +03:00
|
|
|
::
|
2019-05-03 04:50:20 +03:00
|
|
|
:: Cancel a request.
|
2016-11-24 07:25:07 +03:00
|
|
|
::
|
2019-05-03 04:50:20 +03:00
|
|
|
:: For local requests, we just remove it from `qyx`. For foreign requests,
|
|
|
|
:: we remove it from `ref` and tell the foreign ship to cancel as well.
|
2016-11-24 07:25:07 +03:00
|
|
|
::
|
2019-05-03 04:50:20 +03:00
|
|
|
++ cancel-request :: release request
|
|
|
|
^+ .
|
|
|
|
=^ wos/(list wove) qyx
|
|
|
|
:_ (~(run by qyx) |=(a/(set duct) (~(del in a) hen)))
|
|
|
|
%- ~(rep by qyx)
|
|
|
|
|= {{a/wove b/(set duct)} c/(list wove)}
|
|
|
|
?.((~(has in b) hen) c [a c])
|
|
|
|
?~ ref
|
|
|
|
=> .(ref `(unit rind)`ref) :: XX TMI
|
|
|
|
?: =(~ wos) + :: XX handle?
|
|
|
|
|- ^+ +>
|
|
|
|
?~ wos +>
|
2019-05-23 00:39:12 +03:00
|
|
|
$(wos t.wos, +> (run-if-future rove.i.wos |=(@da (best hen +<))))
|
2019-05-03 04:50:20 +03:00
|
|
|
^+ ..cancel-request
|
|
|
|
=+ nux=(~(get by fod.u.ref) hen)
|
|
|
|
?~ nux ..cancel-request
|
|
|
|
=: fod.u.ref (~(del by fod.u.ref) hen)
|
|
|
|
bom.u.ref (~(del by bom.u.ref) u.nux)
|
|
|
|
==
|
2019-06-29 02:43:52 +03:00
|
|
|
(send-over-ames hen her u.nux syd ~)
|
2016-11-24 07:25:07 +03:00
|
|
|
::
|
2019-05-03 04:50:20 +03:00
|
|
|
:: Handles a request.
|
2016-11-24 07:25:07 +03:00
|
|
|
::
|
2019-05-03 04:50:20 +03:00
|
|
|
:: `%sing` requests are handled by ++aver. `%next` requests are handled by
|
|
|
|
:: running ++aver at the given case, and then subsequent cases until we find
|
|
|
|
:: a case where the two results aren't equivalent. If it hasn't happened
|
|
|
|
:: yet, we wait. `%many` requests are handled by producing as much as we can
|
|
|
|
:: and then waiting if the subscription range extends into the future.
|
2016-11-24 07:25:07 +03:00
|
|
|
::
|
2019-05-03 04:50:20 +03:00
|
|
|
++ start-request
|
2019-05-23 00:39:12 +03:00
|
|
|
|= [for=(unit ship) rav=rave]
|
|
|
|
^+ ..start-request
|
2019-12-18 03:48:08 +03:00
|
|
|
=/ [new-sub=(unit rove) sub-results=(list sub-result)]
|
2019-05-23 00:39:12 +03:00
|
|
|
(try-fill-sub for (rave-to-rove rav))
|
|
|
|
=. ..start-request (send-sub-results sub-results [hen ~ ~])
|
|
|
|
?~ new-sub
|
|
|
|
..start-request
|
|
|
|
(duce for u.new-sub)
|
2016-11-24 07:25:07 +03:00
|
|
|
::
|
2019-05-04 05:24:24 +03:00
|
|
|
:: Continue committing
|
2016-11-24 07:25:07 +03:00
|
|
|
::
|
2019-05-04 05:24:24 +03:00
|
|
|
++ take-commit
|
2019-05-03 04:50:20 +03:00
|
|
|
|= =sign
|
|
|
|
^+ +>
|
2019-05-16 23:44:41 +03:00
|
|
|
=/ m commit-clad
|
2019-05-03 04:50:20 +03:00
|
|
|
?~ act
|
|
|
|
~|(%no-active-write !!)
|
2019-05-16 23:44:41 +03:00
|
|
|
?. ?=(%commit -.eval-data.u.act)
|
|
|
|
~|(%active-not-commit !!)
|
|
|
|
=^ r=[moves=(list move) =eval-result:eval:m] commit.eval-data.u.act
|
|
|
|
(take:eval:m commit.eval-data.u.act hen /commit/[syd] now ran sign)
|
|
|
|
=> .(+>.$ (emil moves.r)) :: TMI
|
|
|
|
?- -.eval-result.r
|
|
|
|
%next +>.$
|
|
|
|
%fail (fail-commit err.eval-result.r)
|
|
|
|
%done (done-commit value.eval-result.r)
|
2019-05-03 04:50:20 +03:00
|
|
|
==
|
2016-11-24 07:25:07 +03:00
|
|
|
::
|
2019-05-03 04:50:20 +03:00
|
|
|
:: Don't release effects or apply state changes; print error
|
|
|
|
::
|
2019-05-04 05:24:24 +03:00
|
|
|
++ fail-commit
|
|
|
|
|= err=(pair term tang)
|
2019-05-03 04:50:20 +03:00
|
|
|
^+ +>
|
2019-05-04 05:24:24 +03:00
|
|
|
=? +>.$ ?=(^ q.err)
|
2019-05-03 04:50:20 +03:00
|
|
|
%- emit
|
|
|
|
:* (need hun) %give %note
|
|
|
|
'!' %rose [" " "" ""]
|
2019-05-04 05:24:24 +03:00
|
|
|
leaf+"clay commit error"
|
|
|
|
leaf+(trip p.err)
|
|
|
|
q.err
|
2016-11-24 07:25:07 +03:00
|
|
|
==
|
2019-05-03 04:50:20 +03:00
|
|
|
finish-write
|
2019-05-02 04:21:32 +03:00
|
|
|
::
|
2019-05-03 04:50:20 +03:00
|
|
|
:: Release effects and apply state changes
|
2019-05-02 04:21:32 +03:00
|
|
|
::
|
2019-05-04 05:24:24 +03:00
|
|
|
++ done-commit
|
2019-05-16 23:44:41 +03:00
|
|
|
|= [=dome =rang]
|
2019-05-03 04:50:20 +03:00
|
|
|
^+ +>
|
|
|
|
=: dom dome
|
2019-07-25 03:16:41 +03:00
|
|
|
hut.ran (~(uni by hut.rang) hut.ran)
|
|
|
|
lat.ran (~(uni by lat.rang) lat.ran)
|
2019-05-02 04:21:32 +03:00
|
|
|
==
|
2019-05-13 23:53:46 +03:00
|
|
|
=. +>.$ wake
|
2019-05-03 04:50:20 +03:00
|
|
|
finish-write
|
|
|
|
::
|
2019-05-04 05:24:24 +03:00
|
|
|
:: Continue merging
|
|
|
|
::
|
|
|
|
++ take-merge
|
|
|
|
|= =sign
|
|
|
|
^+ +>
|
2019-05-16 23:44:41 +03:00
|
|
|
=/ m merge-clad
|
2019-05-04 05:24:24 +03:00
|
|
|
?~ act
|
|
|
|
~|(%no-active-write !!)
|
2019-05-16 23:44:41 +03:00
|
|
|
?. ?=(%merge -.eval-data.u.act)
|
|
|
|
~|(%active-not-merge !!)
|
|
|
|
=^ r=[moves=(list move) =eval-result:eval:m] merge.eval-data.u.act
|
|
|
|
(take:eval:m merge.eval-data.u.act hen /merge/[syd] now ran sign)
|
|
|
|
=> .(+>.$ (emil moves.r)) :: TMI
|
|
|
|
?- -.eval-result.r
|
|
|
|
%next +>.$
|
|
|
|
%fail (fail-merge err.eval-result.r)
|
|
|
|
%done (done-merge value.eval-result.r)
|
2019-05-04 05:24:24 +03:00
|
|
|
==
|
|
|
|
::
|
|
|
|
:: Don't release effects or apply state changes; print error
|
|
|
|
::
|
|
|
|
++ fail-merge
|
|
|
|
|= err=(pair term tang)
|
|
|
|
^+ +>
|
|
|
|
=. +>.$
|
2019-09-10 06:00:56 +03:00
|
|
|
(emit [hen %slip %b %drip !>([%mere %| err])])
|
2019-05-04 05:24:24 +03:00
|
|
|
finish-write
|
|
|
|
::
|
|
|
|
:: Release effects and apply state changes
|
|
|
|
::
|
|
|
|
++ done-merge
|
2019-05-16 23:44:41 +03:00
|
|
|
|= [conflicts=(set path) =dome =rang]
|
2019-05-04 05:24:24 +03:00
|
|
|
^+ +>
|
2019-09-10 06:00:56 +03:00
|
|
|
=. +>.$ (emit [hen %slip %b %drip !>([%mere %& conflicts])])
|
2019-05-04 05:24:24 +03:00
|
|
|
=: dom dome
|
2019-07-25 03:06:41 +03:00
|
|
|
hut.ran (~(uni by hut.rang) hut.ran)
|
|
|
|
lat.ran (~(uni by lat.rang) lat.ran)
|
2019-05-04 05:24:24 +03:00
|
|
|
==
|
2019-05-13 23:53:46 +03:00
|
|
|
=. +>.$ wake
|
2019-05-04 05:24:24 +03:00
|
|
|
finish-write
|
|
|
|
::
|
2019-05-18 00:59:03 +03:00
|
|
|
:: Continue mounting
|
|
|
|
::
|
|
|
|
++ take-mount
|
|
|
|
|= =sign
|
|
|
|
^+ +>
|
|
|
|
=/ m mount-clad
|
|
|
|
?~ act
|
|
|
|
~|(%no-active-write !!)
|
|
|
|
?. ?=(%mount -.eval-data.u.act)
|
|
|
|
~|(%active-not-mount !!)
|
|
|
|
=^ r=[moves=(list move) =eval-result:eval:m] mount.eval-data.u.act
|
|
|
|
(take:eval:m mount.eval-data.u.act hen /mount/[syd] now ran sign)
|
|
|
|
=> .(+>.$ (emil moves.r)) :: TMI
|
|
|
|
?- -.eval-result.r
|
|
|
|
%next +>.$
|
|
|
|
%fail (fail-mount err.eval-result.r)
|
|
|
|
%done (done-mount value.eval-result.r)
|
|
|
|
==
|
|
|
|
::
|
|
|
|
:: Don't release effects or apply state changes; print error
|
|
|
|
::
|
|
|
|
++ fail-mount
|
|
|
|
|= err=(pair term tang)
|
|
|
|
^+ +>
|
|
|
|
%- (slog leaf+"mount failed" leaf+(trip p.err) q.err)
|
|
|
|
finish-write
|
|
|
|
::
|
|
|
|
:: Release effects and apply state changes
|
|
|
|
::
|
|
|
|
++ done-mount
|
|
|
|
|= [new-mon=(pair term beam) mim=(map path mime)]
|
|
|
|
^+ +>
|
|
|
|
=: mon (~(put by mon) new-mon)
|
|
|
|
mim.dom mim
|
|
|
|
==
|
|
|
|
finish-write
|
|
|
|
::
|
2019-05-03 04:50:20 +03:00
|
|
|
:: Start next item in write queue
|
|
|
|
::
|
|
|
|
++ finish-write
|
|
|
|
^+ .
|
|
|
|
=. act ~
|
|
|
|
?~ cue
|
|
|
|
.
|
2019-05-11 05:23:13 +03:00
|
|
|
=/ =duct duct:(need ~(top to cue))
|
2019-05-11 00:51:37 +03:00
|
|
|
(emit [duct %pass /queued-request %b %wait now])
|
|
|
|
::
|
2019-05-17 03:24:10 +03:00
|
|
|
:: Continue foreign request
|
|
|
|
::
|
|
|
|
++ take-foreign-request
|
|
|
|
|= [inx=@ud =sign]
|
|
|
|
^+ +>
|
|
|
|
=/ m request-clad
|
|
|
|
?> ?=(^ ref)
|
|
|
|
?~ request=(~(get by pur.u.ref) inx)
|
|
|
|
~|(%no-active-foreign-request !!)
|
|
|
|
=^ r=[moves=(list move) =eval-result:eval:m] eval-form.u.request
|
|
|
|
%- take:eval:m
|
|
|
|
:* eval-form.u.request
|
|
|
|
hen
|
|
|
|
/foreign-request/(scot %p her)/[syd]/(scot %ud inx)
|
|
|
|
now
|
|
|
|
ran
|
|
|
|
sign
|
|
|
|
==
|
2019-05-23 00:39:12 +03:00
|
|
|
=> .(+>.$ (emil moves.r)) :: TMI
|
2019-05-17 03:24:10 +03:00
|
|
|
?- -.eval-result.r
|
|
|
|
%next +>.$
|
2019-05-23 20:30:15 +03:00
|
|
|
%fail (fail-foreign-request inx rand.u.request err.eval-result.r)
|
|
|
|
%done (done-foreign-request inx rand.u.request value.eval-result.r)
|
2019-05-17 03:24:10 +03:00
|
|
|
==
|
|
|
|
::
|
|
|
|
:: Fail foreign request
|
|
|
|
::
|
|
|
|
++ fail-foreign-request
|
2019-05-23 20:30:15 +03:00
|
|
|
|= [inx=@ud =rand err=(pair term tang)]
|
2019-05-17 03:24:10 +03:00
|
|
|
^+ +>
|
|
|
|
%- (slog leaf+"foreign request failed" leaf+(trip p.err) q.err)
|
|
|
|
?> ?=(^ ref)
|
2019-05-23 20:30:15 +03:00
|
|
|
=/ =mood [p.p q.p q]:rand
|
2019-05-17 03:24:10 +03:00
|
|
|
=: haw.u.ref (~(put by haw.u.ref) mood ~)
|
|
|
|
bom.u.ref (~(del by bom.u.ref) inx)
|
|
|
|
fod.u.ref (~(del by fod.u.ref) hen)
|
|
|
|
==
|
|
|
|
wake
|
|
|
|
::
|
|
|
|
:: Finish foreign request
|
|
|
|
::
|
|
|
|
++ done-foreign-request
|
2019-05-23 20:30:15 +03:00
|
|
|
|= [inx=@ud =rand =cage]
|
2019-05-17 03:24:10 +03:00
|
|
|
^+ +>
|
|
|
|
?> ?=(^ ref)
|
2019-05-23 20:30:15 +03:00
|
|
|
=/ =mood [p.p q.p q]:rand
|
2019-05-17 03:24:10 +03:00
|
|
|
=: haw.u.ref (~(put by haw.u.ref) mood `cage)
|
|
|
|
bom.u.ref (~(del by bom.u.ref) inx)
|
|
|
|
fod.u.ref (~(del by fod.u.ref) hen)
|
|
|
|
==
|
|
|
|
wake
|
|
|
|
::
|
|
|
|
:: Called when a foreign ship answers one of our requests.
|
|
|
|
::
|
|
|
|
:: If it's a `%many` request, start a `+foreign-update`. Else start
|
|
|
|
:: a `+foreign-request`.
|
|
|
|
::
|
|
|
|
:: After updating ref (our request manager), we handle %x, %w, and %y
|
|
|
|
:: responses. For %x, we call ++validate-x to validate the type of
|
|
|
|
:: the response. For %y, we coerce the result to an arch.
|
|
|
|
::
|
|
|
|
++ take-foreign-answer :: external change
|
|
|
|
|= [inx=@ud rut=(unit rand)]
|
|
|
|
^+ +>
|
|
|
|
?> ?=(^ ref)
|
|
|
|
=+ ruv=(~(get by bom.u.ref) inx)
|
|
|
|
?~ ruv +>.$
|
|
|
|
=/ rav=rave q.u.ruv
|
|
|
|
?: ?=(%many -.rav)
|
|
|
|
:: add to update queue
|
|
|
|
::
|
|
|
|
=. waiting.pud.u.ref
|
|
|
|
(~(put to waiting.pud.u.ref) inx rut)
|
|
|
|
:: start update if nothing active
|
|
|
|
::
|
|
|
|
start-next-foreign-update
|
|
|
|
?~ rut
|
|
|
|
:: nothing here, so cache that
|
|
|
|
::
|
|
|
|
%_ wake
|
|
|
|
haw.u.ref
|
|
|
|
?. ?=($sing -.rav) haw.u.ref
|
2019-05-23 00:39:12 +03:00
|
|
|
(~(put by haw.u.ref) mood.rav ~)
|
2019-05-17 03:24:10 +03:00
|
|
|
==
|
|
|
|
:: something here, so kick off a validator
|
|
|
|
::
|
|
|
|
=. pur.u.ref
|
|
|
|
%+ ~(put by pur.u.ref)
|
|
|
|
inx
|
2019-05-23 20:30:15 +03:00
|
|
|
:- u.rut
|
2019-05-17 03:24:10 +03:00
|
|
|
%- from-form:eval:request-clad
|
|
|
|
((foreign-request our her syd now) rav u.rut)
|
|
|
|
(take-foreign-request inx clad-init-sign)
|
|
|
|
::
|
|
|
|
:: Continue foreign update
|
|
|
|
::
|
|
|
|
++ take-foreign-update
|
|
|
|
|= =sign
|
|
|
|
^+ +>
|
|
|
|
=/ m update-clad
|
|
|
|
?> ?=(^ ref)
|
|
|
|
?~ eval-data.pud.u.ref
|
|
|
|
~|(%no-active-foreign-update !!)
|
|
|
|
=* ed u.eval-data.pud.u.ref
|
2019-05-23 00:39:12 +03:00
|
|
|
=/ inx inx.ed
|
2019-05-17 03:24:10 +03:00
|
|
|
=^ r=[moves=(list move) =eval-result:eval:m]
|
|
|
|
eval-form.u.eval-data.pud.u.ref
|
|
|
|
%- take:eval:m
|
|
|
|
:* eval-form.ed
|
|
|
|
hen
|
|
|
|
/foreign-update/(scot %p her)/[syd]
|
|
|
|
now
|
|
|
|
ran
|
|
|
|
sign
|
|
|
|
==
|
2019-05-23 00:39:12 +03:00
|
|
|
=> .(+>.$ (emil moves.r)) :: TMI
|
2019-05-17 03:24:10 +03:00
|
|
|
?- -.eval-result.r
|
2019-05-23 04:15:57 +03:00
|
|
|
%next +>.$
|
|
|
|
%fail (fail-foreign-update inx err.eval-result.r)
|
|
|
|
%done (done-foreign-update inx value.eval-result.r)
|
2019-05-17 03:24:10 +03:00
|
|
|
==
|
|
|
|
::
|
|
|
|
:: Fail foreign update
|
|
|
|
::
|
|
|
|
++ fail-foreign-update
|
|
|
|
|= [inx=@ud err=(pair term tang)]
|
|
|
|
^+ +>
|
|
|
|
%- (slog leaf+"foreign update failed" leaf+(trip p.err) q.err)
|
|
|
|
?> ?=(^ ref)
|
|
|
|
=: bom.u.ref (~(del by bom.u.ref) inx)
|
|
|
|
fod.u.ref (~(del by fod.u.ref) hen)
|
|
|
|
==
|
|
|
|
=. +>.$ =<(?>(?=(^ ref) .) wake)
|
|
|
|
=. eval-data.pud.u.ref ~
|
|
|
|
start-next-foreign-update
|
|
|
|
::
|
|
|
|
:: Finish foreign update
|
|
|
|
::
|
|
|
|
++ done-foreign-update
|
|
|
|
|= [inx=@ud res=(unit [new-lim=@da =new=dome =new=rang])]
|
|
|
|
^+ +>
|
|
|
|
?> ?=(^ ref)
|
|
|
|
=: bom.u.ref (~(del by bom.u.ref) inx)
|
|
|
|
fod.u.ref (~(del by fod.u.ref) hen)
|
|
|
|
==
|
|
|
|
?~ res
|
|
|
|
wake
|
|
|
|
=: lim new-lim.u.res
|
|
|
|
dom new-dome.u.res
|
|
|
|
ran new-rang.u.res
|
|
|
|
==
|
|
|
|
=. +>.$ =<(?>(?=(^ ref) .) wake)
|
|
|
|
=. eval-data.pud.u.ref ~
|
|
|
|
start-next-foreign-update
|
|
|
|
::
|
|
|
|
:: Kick off the the next foreign update in the queue
|
|
|
|
::
|
|
|
|
++ start-next-foreign-update
|
|
|
|
^+ .
|
|
|
|
?> ?=(^ ref)
|
|
|
|
?. =(~ eval-data.pud.u.ref)
|
|
|
|
.
|
|
|
|
?: =(~ waiting.pud.u.ref)
|
|
|
|
.
|
|
|
|
=^ next=[inx=@ud rut=(unit rand)] waiting.pud.u.ref
|
|
|
|
~(get to waiting.pud.u.ref)
|
|
|
|
=/ ruv (~(get by bom.u.ref) inx.next)
|
|
|
|
?~ ruv
|
|
|
|
~& [%clay-foreign-update-lost her syd inx.next]
|
|
|
|
start-next-foreign-update
|
|
|
|
=. hen p.u.ruv
|
|
|
|
=/ =rave q.u.ruv
|
|
|
|
?> ?=(%many -.rave)
|
|
|
|
=. eval-data.pud.u.ref
|
|
|
|
:- ~
|
2019-05-23 20:30:15 +03:00
|
|
|
:+ inx.next
|
|
|
|
rut.next
|
2019-05-17 03:24:10 +03:00
|
|
|
%- from-form:eval:update-clad
|
2019-05-23 00:39:12 +03:00
|
|
|
((foreign-update our her syd now) moat.rave rut.next lim dom ran)
|
2019-05-17 03:24:10 +03:00
|
|
|
(take-foreign-update clad-init-sign)
|
|
|
|
::
|
2019-05-23 00:39:12 +03:00
|
|
|
:: fire function if request is in future
|
|
|
|
::
|
|
|
|
++ run-if-future
|
|
|
|
|= [rov=rove fun=$-(@da _.)]
|
2016-11-24 07:25:07 +03:00
|
|
|
^+ +>.$
|
|
|
|
%+ fall
|
|
|
|
%+ bind
|
|
|
|
^- (unit @da)
|
|
|
|
?- -.rov
|
2019-05-23 00:39:12 +03:00
|
|
|
%sing
|
|
|
|
?. ?=(%da -.case.mood.rov) ~
|
|
|
|
`p.case.mood.rov
|
2018-01-15 22:09:38 +03:00
|
|
|
::
|
2019-05-23 00:39:12 +03:00
|
|
|
%next ~
|
|
|
|
%mult ~
|
|
|
|
%many
|
2016-12-02 22:34:07 +03:00
|
|
|
%^ hunt lth
|
2019-05-23 03:01:02 +03:00
|
|
|
?. ?=(%da -.from.moat.rov) ~
|
|
|
|
?. (lth now p.from.moat.rov) ~
|
|
|
|
[~ p.from.moat.rov]
|
2019-05-23 00:39:12 +03:00
|
|
|
?. ?=(%da -.to.moat.rov) ~
|
2019-05-23 03:01:02 +03:00
|
|
|
`(max now p.to.moat.rov)
|
2016-11-24 07:25:07 +03:00
|
|
|
==
|
|
|
|
fun
|
|
|
|
+>.$
|
|
|
|
::
|
2019-05-23 00:39:12 +03:00
|
|
|
++ rave-to-rove
|
|
|
|
|= rav/rave
|
|
|
|
^- rove
|
|
|
|
?- -.rav
|
|
|
|
%sing rav
|
|
|
|
%next [- mood ~ ~]:rav
|
|
|
|
%mult [- mool ~ ~ ~]:rav
|
|
|
|
%many [- track moat ~]:rav
|
|
|
|
==
|
|
|
|
::
|
|
|
|
++ rove-to-rave
|
2016-11-24 07:25:07 +03:00
|
|
|
|= rov/rove
|
|
|
|
^- rave
|
|
|
|
?- -.rov
|
2019-05-23 00:39:12 +03:00
|
|
|
%sing rov
|
|
|
|
%next [- mood]:rov
|
|
|
|
%mult [- mool]:rov
|
|
|
|
%many [- track moat]:rov
|
2016-11-24 07:25:07 +03:00
|
|
|
==
|
|
|
|
::
|
2019-05-23 00:39:12 +03:00
|
|
|
++ send-sub-results
|
|
|
|
|= [sub-results=(list sub-result) ducts=(set duct)]
|
|
|
|
^+ ..wake
|
|
|
|
?~ sub-results
|
|
|
|
..wake
|
|
|
|
=. ..wake
|
|
|
|
?- -.i.sub-results
|
|
|
|
%blab (blab-all ducts +.i.sub-results)
|
|
|
|
%bleb (bleb-all ducts +.i.sub-results)
|
|
|
|
%balk (balk-all ducts +.i.sub-results)
|
|
|
|
%blas (blas-all ducts +.i.sub-results)
|
|
|
|
%blub (blub-all ducts +.i.sub-results)
|
|
|
|
==
|
|
|
|
$(sub-results t.sub-results)
|
|
|
|
::
|
2019-05-23 03:01:02 +03:00
|
|
|
:: Loop through open subscriptions and check if we can fill any of
|
|
|
|
:: them.
|
2016-11-24 07:25:07 +03:00
|
|
|
::
|
2019-05-23 00:39:12 +03:00
|
|
|
++ wake
|
2016-11-24 07:25:07 +03:00
|
|
|
^+ .
|
2019-05-23 00:39:12 +03:00
|
|
|
=/ old-subs=(list [=wove ducts=(set duct)]) ~(tap by qyx)
|
2019-05-23 03:01:02 +03:00
|
|
|
=| new-subs=(list [=wove ducts=(set duct)])
|
2016-11-24 07:25:07 +03:00
|
|
|
|- ^+ ..wake
|
2019-05-23 00:39:12 +03:00
|
|
|
?~ old-subs
|
|
|
|
:: install new subs
|
|
|
|
::
|
|
|
|
..wake(qyx (~(gas by *cult) new-subs))
|
|
|
|
?: =(~ ducts.i.old-subs)
|
|
|
|
:: drop forgotten roves
|
|
|
|
::
|
2019-05-23 03:01:02 +03:00
|
|
|
$(old-subs t.old-subs)
|
2019-12-18 03:48:08 +03:00
|
|
|
=/ [new-sub=(unit rove) sub-results=(list sub-result)]
|
2019-05-23 00:39:12 +03:00
|
|
|
(try-fill-sub wove.i.old-subs)
|
|
|
|
=. ..wake (send-sub-results sub-results ducts.i.old-subs)
|
|
|
|
=. new-subs
|
|
|
|
?~ new-sub
|
|
|
|
new-subs
|
|
|
|
[[[for.wove.i.old-subs u.new-sub] ducts.i.old-subs] new-subs]
|
|
|
|
$(old-subs t.old-subs)
|
|
|
|
::
|
|
|
|
:: Try to fill a subscription
|
|
|
|
::
|
|
|
|
++ try-fill-sub
|
|
|
|
|= [for=(unit ship) rov=rove]
|
|
|
|
^- [new-sub=(unit rove) (list sub-result)]
|
2018-02-07 03:34:09 +03:00
|
|
|
?- -.rov
|
2019-05-23 00:39:12 +03:00
|
|
|
%sing
|
|
|
|
=/ cache-value=(unit (unit cage))
|
|
|
|
?~(ref ~ (~(get by haw.u.ref) mood.rov))
|
|
|
|
?^ cache-value
|
|
|
|
:: if we have a result in our cache, produce it
|
|
|
|
::
|
|
|
|
:- ~
|
|
|
|
?~ u.cache-value
|
|
|
|
[%blub ~]~
|
|
|
|
[%blab mood.rov %& u.u.cache-value]~
|
|
|
|
:: else, check to see if rove is for an aeon we know
|
|
|
|
::
|
|
|
|
=/ aeon=(unit aeon) (case-to-aeon case.mood.rov)
|
|
|
|
?~ aeon
|
|
|
|
[`rov ~]
|
|
|
|
:: we have the appropriate aeon, so read in the data
|
|
|
|
::
|
|
|
|
=/ value=(unit (unit (each cage lobe)))
|
|
|
|
(read-at-aeon:ze for u.aeon mood.rov)
|
|
|
|
?~ value
|
|
|
|
:: We don't have the data directly, which is potentially
|
|
|
|
:: problematical. How can we fetch the data?
|
|
|
|
::
|
|
|
|
?: =(0 u.aeon)
|
|
|
|
~& [%clay-sing-indirect-data-0 `path`[syd '0' path.mood.rov]]
|
|
|
|
[~ ~]
|
|
|
|
~& [%clay-sing-indirect-data desk=syd mood=mood.rov aeon=u.aeon]
|
|
|
|
[`rov ~]
|
|
|
|
:: we have the data, so we produce the results
|
|
|
|
::
|
2019-05-23 03:01:02 +03:00
|
|
|
[~ [%balk u.value mood.rov]~]
|
2016-11-24 07:25:07 +03:00
|
|
|
::
|
2018-01-19 03:54:41 +03:00
|
|
|
:: %next is just %mult with one path, so we pretend %next = %mult here.
|
2019-05-23 00:39:12 +03:00
|
|
|
::
|
|
|
|
?(%next %mult)
|
2018-01-18 01:55:12 +03:00
|
|
|
:: because %mult requests need to wait on multiple files for each
|
2019-05-23 00:39:12 +03:00
|
|
|
:: revision that needs to be checked for changes, we keep two
|
|
|
|
:: cache maps. {old} is the revision at {(dec aeon)}, {new} is
|
|
|
|
:: the revision at {aeon}. if we have no {aeon} yet, that means
|
|
|
|
:: it was still unknown last time we checked.
|
|
|
|
::
|
2018-02-07 03:34:09 +03:00
|
|
|
=* vor rov
|
2018-01-19 03:54:41 +03:00
|
|
|
|^
|
2019-05-23 00:39:12 +03:00
|
|
|
=/ rov=rove
|
|
|
|
?: ?=(%mult -.vor) vor
|
2018-01-19 03:54:41 +03:00
|
|
|
:* %mult
|
2019-05-23 00:39:12 +03:00
|
|
|
[case [[care path] ~ ~]]:mood.vor
|
|
|
|
aeon.vor
|
|
|
|
[[[care.mood.vor path.mood.vor] cach.vor] ~ ~]
|
2018-01-19 03:54:41 +03:00
|
|
|
~
|
|
|
|
==
|
2019-05-23 00:39:12 +03:00
|
|
|
?> ?=(%mult -.rov)
|
|
|
|
:: we will either respond or store the maybe updated request.
|
|
|
|
::
|
2019-09-10 23:38:39 +03:00
|
|
|
=; res=(each (map mood (unit (each cage lobe))) rove)
|
2018-05-04 03:59:10 +03:00
|
|
|
?: ?=(%& -.res)
|
2018-01-19 03:54:41 +03:00
|
|
|
(respond p.res)
|
|
|
|
(store p.res)
|
2019-05-23 00:39:12 +03:00
|
|
|
:: recurse here on next aeon if possible/needed.
|
|
|
|
::
|
2019-09-10 23:38:39 +03:00
|
|
|
|- ^- (each (map mood (unit (each cage lobe))) rove)
|
2018-01-18 01:55:12 +03:00
|
|
|
:: if we don't have an aeon yet, see if we have one now.
|
2019-05-23 00:39:12 +03:00
|
|
|
::
|
|
|
|
?~ aeon.rov
|
|
|
|
=/ aeon=(unit aeon) (case-to-aeon case.mool.rov)
|
2018-01-18 01:55:12 +03:00
|
|
|
:: if we still don't, wait.
|
2019-05-23 00:39:12 +03:00
|
|
|
::
|
|
|
|
?~ aeon |+rov
|
2018-01-18 01:55:12 +03:00
|
|
|
:: if we do, update the request and retry.
|
2019-05-23 00:39:12 +03:00
|
|
|
::
|
|
|
|
$(aeon.rov `+(u.aeon), old-cach.rov ~, new-cach.rov ~)
|
2018-01-22 18:01:00 +03:00
|
|
|
:: if old isn't complete, try filling in the gaps.
|
2019-05-23 00:39:12 +03:00
|
|
|
::
|
|
|
|
=? old-cach.rov !(complete old-cach.rov)
|
|
|
|
(read-unknown mool.rov(case [%ud (dec u.aeon.rov)]) old-cach.rov)
|
2018-01-18 01:55:12 +03:00
|
|
|
:: if the next aeon we want to compare is in the future, wait again.
|
2019-05-23 00:39:12 +03:00
|
|
|
::
|
|
|
|
=/ next-aeon=(unit aeon) (case-to-aeon [%ud u.aeon.rov])
|
|
|
|
?~ next-aeon |+rov
|
2018-01-18 01:55:12 +03:00
|
|
|
:: if new isn't complete, try filling in the gaps.
|
2019-05-23 00:39:12 +03:00
|
|
|
::
|
|
|
|
=? new-cach.rov !(complete new-cach.rov)
|
|
|
|
(read-unknown mool.rov(case [%ud u.aeon.rov]) new-cach.rov)
|
2018-01-18 01:55:12 +03:00
|
|
|
:: if they're still not both complete, wait again.
|
2019-05-23 00:39:12 +03:00
|
|
|
::
|
|
|
|
?. ?& (complete old-cach.rov)
|
|
|
|
(complete new-cach.rov)
|
2018-01-18 01:55:12 +03:00
|
|
|
==
|
|
|
|
|+rov
|
2019-05-23 00:39:12 +03:00
|
|
|
:: both complete, so check if anything has changed
|
|
|
|
::
|
2019-09-10 23:38:39 +03:00
|
|
|
=/ changes=(map mood (unit (each cage lobe)))
|
2019-05-23 00:39:12 +03:00
|
|
|
%+ roll ~(tap by old-cach.rov)
|
|
|
|
|= $: [[car=care pax=path] old-cach-value=cach]
|
2019-09-10 23:38:39 +03:00
|
|
|
changes=(map mood (unit (each cage lobe)))
|
2019-05-23 00:39:12 +03:00
|
|
|
==
|
|
|
|
=/ new-cach-value=cach (~(got by new-cach.rov) car pax)
|
|
|
|
?< |(?=(~ old-cach-value) ?=(~ new-cach-value))
|
2019-09-10 23:38:39 +03:00
|
|
|
=/ new-entry=(unit (pair mood (unit (each cage lobe))))
|
2019-05-23 00:39:12 +03:00
|
|
|
=/ =mood [car [%ud u.aeon.rov] pax]
|
|
|
|
?~ u.old-cach-value
|
|
|
|
?~ u.new-cach-value
|
|
|
|
:: not added
|
|
|
|
::
|
|
|
|
~
|
|
|
|
:: added
|
|
|
|
::
|
2019-09-10 23:38:39 +03:00
|
|
|
`[mood `u.u.new-cach-value]
|
2019-05-23 00:39:12 +03:00
|
|
|
?~ u.new-cach-value
|
|
|
|
:: deleted
|
|
|
|
::
|
2019-09-10 23:38:39 +03:00
|
|
|
`[mood ~]
|
2019-05-23 00:39:12 +03:00
|
|
|
?: (equivalent-data:ze u.u.new-cach-value u.u.old-cach-value)
|
|
|
|
:: unchanged
|
|
|
|
::
|
|
|
|
~
|
|
|
|
:: changed
|
|
|
|
::
|
2019-09-10 23:38:39 +03:00
|
|
|
`[mood `u.u.new-cach-value]
|
2019-05-23 00:39:12 +03:00
|
|
|
:: if changed, save the change
|
|
|
|
::
|
|
|
|
?~ new-entry
|
|
|
|
changes
|
|
|
|
(~(put by changes) u.new-entry)
|
|
|
|
:: if there are any changes, send response. if none, move on to
|
|
|
|
:: next aeon.
|
|
|
|
::
|
|
|
|
?^ changes &+changes
|
|
|
|
$(u.aeon.rov +(u.aeon.rov), new-cach.rov ~)
|
|
|
|
::
|
|
|
|
:: check again later
|
2018-01-19 03:54:41 +03:00
|
|
|
::
|
2019-05-23 00:39:12 +03:00
|
|
|
++ store
|
|
|
|
|= rov=rove
|
|
|
|
^- [new-sub=(unit rove) (list sub-result)]
|
|
|
|
=/ new-rove=rove
|
|
|
|
?> ?=(%mult -.rov)
|
|
|
|
?: ?=(%mult -.vor) rov
|
|
|
|
?> ?=([* ~ ~] old-cach.rov)
|
|
|
|
=* one n.old-cach.rov
|
|
|
|
[%next [care.p.one case.mool.rov path.p.one] aeon.rov q.one]
|
|
|
|
[`new-rove ~]
|
2018-01-19 03:54:41 +03:00
|
|
|
::
|
2019-05-23 00:39:12 +03:00
|
|
|
:: send changes
|
|
|
|
::
|
|
|
|
++ respond
|
2019-09-10 23:38:39 +03:00
|
|
|
|= res=(map mood (unit (each cage lobe)))
|
2019-05-23 00:39:12 +03:00
|
|
|
^- [new-sub=(unit rove) (list sub-result)]
|
|
|
|
:- ~
|
|
|
|
?: ?=(%mult -.vor)
|
|
|
|
[%blas ~(key by res)]~
|
|
|
|
?> ?=([* ~ ~] res)
|
2019-09-10 23:38:39 +03:00
|
|
|
?~ q.n.res
|
|
|
|
[%blub ~]~
|
|
|
|
[%blab [p u.q]:n.res]~
|
2018-01-19 03:54:41 +03:00
|
|
|
::
|
2019-05-23 00:39:12 +03:00
|
|
|
:: no unknowns
|
|
|
|
::
|
|
|
|
++ complete
|
|
|
|
|= hav=(map (pair care path) cach)
|
2018-01-23 19:35:12 +03:00
|
|
|
?& ?=(^ hav)
|
|
|
|
(levy ~(tap by `(map (pair care path) cach)`hav) know)
|
|
|
|
==
|
|
|
|
::
|
2019-05-23 00:39:12 +03:00
|
|
|
:: know about file in cach
|
|
|
|
::
|
|
|
|
++ know |=({(pair care path) c/cach} ?=(^ c))
|
|
|
|
::
|
|
|
|
:: fill in the blanks
|
2018-01-19 03:54:41 +03:00
|
|
|
::
|
2019-05-23 00:39:12 +03:00
|
|
|
++ read-unknown
|
|
|
|
|= [=mool hav=(map (pair care path) cach)]
|
|
|
|
=? hav ?=(~ hav)
|
|
|
|
%- malt ^- (list (pair (pair care path) cach))
|
|
|
|
%+ turn
|
|
|
|
~(tap in paths.mool)
|
|
|
|
|= [c=care p=path]
|
|
|
|
^- [[care path] cach]
|
|
|
|
[[c p] ~]
|
|
|
|
%- ~(urn by hav)
|
|
|
|
|= [[c=care p=path] o=cach]
|
|
|
|
?^(o o (aver for c case.mool p))
|
2018-01-19 03:54:41 +03:00
|
|
|
--
|
2016-11-24 07:25:07 +03:00
|
|
|
::
|
2019-05-23 00:39:12 +03:00
|
|
|
%many
|
|
|
|
=/ from-aeon (case-to-aeon from.moat.rov)
|
|
|
|
?~ from-aeon
|
|
|
|
:: haven't entered the relevant range, so do nothing
|
|
|
|
::
|
|
|
|
[`rov ~]
|
|
|
|
=/ to-aeon (case-to-aeon to.moat.rov)
|
|
|
|
?~ to-aeon
|
|
|
|
:: we're in the middle of the range, so produce what we can,
|
|
|
|
:: but don't end the subscription
|
|
|
|
::
|
|
|
|
:: update "from" case to the aeon after now
|
|
|
|
::
|
|
|
|
=. from.moat.rov
|
|
|
|
[%ud +(let.dom)]
|
|
|
|
:- `rov
|
|
|
|
=/ new-lobes=(map path lobe)
|
|
|
|
(lobes-at-path:ze for let.dom path.moat.rov)
|
|
|
|
?: =(lobes.rov new-lobes)
|
|
|
|
:: if no changes, don't produce results
|
|
|
|
::
|
|
|
|
~
|
|
|
|
:: else changes, so produce them
|
|
|
|
::
|
|
|
|
[%bleb let.dom ?:(track.rov ~ `[u.from-aeon let.dom])]~
|
|
|
|
:: we're past the end of the range, so end subscription
|
|
|
|
::
|
|
|
|
:- ~
|
|
|
|
=/ new-lobes=(map path lobe)
|
|
|
|
(lobes-at-path:ze for u.to-aeon path.moat.rov)
|
|
|
|
:: if changed, give subscription result
|
|
|
|
::
|
|
|
|
=/ bleb=(list sub-result)
|
|
|
|
?: =(lobes.rov new-lobes)
|
|
|
|
~
|
|
|
|
[%bleb +(u.from-aeon) ?:(track.rov ~ `[u.from-aeon u.to-aeon])]~
|
|
|
|
:: end subscription
|
|
|
|
::
|
|
|
|
=/ blub=(list sub-result)
|
|
|
|
[%blub ~]~
|
|
|
|
(weld bleb blub)
|
2016-11-24 07:25:07 +03:00
|
|
|
==
|
2019-05-23 00:39:12 +03:00
|
|
|
::
|
2016-11-24 07:25:07 +03:00
|
|
|
++ drop-me
|
|
|
|
^+ .
|
2019-05-04 05:24:24 +03:00
|
|
|
~| %clay-drop-me-not-implemented
|
|
|
|
!!
|
|
|
|
:: ?~ mer
|
|
|
|
:: .
|
|
|
|
:: %- emit(mer ~) ^- move :*
|
|
|
|
:: hen.u.mer %give %mere %| %user-interrupt
|
|
|
|
:: >sor.u.mer< >our< >cas.u.mer< >gem.u.mer< ~
|
|
|
|
:: ==
|
2016-11-24 07:25:07 +03:00
|
|
|
::
|
|
|
|
::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
|
|
|
|
::
|
|
|
|
:: This core has no additional state, and the distinction exists purely for
|
|
|
|
:: documentation. The overarching theme is that `++de` directly contains
|
|
|
|
:: logic for metadata about the desk, while `++ze` is composed primarily
|
|
|
|
:: of helper functions for manipulating the desk state (`++dome`) itself.
|
|
|
|
:: Functions include:
|
|
|
|
::
|
|
|
|
:: -- converting between cases, commit hashes, commits, content hashes,
|
|
|
|
:: and content
|
|
|
|
:: -- creating commits and content and adding them to the tree
|
|
|
|
:: -- finding which data needs to be sent over the network to keep the
|
2018-02-08 00:28:33 +03:00
|
|
|
:: other urbit up-to-date
|
2016-11-24 07:25:07 +03:00
|
|
|
:: -- reading from the file tree through different `++care` options
|
|
|
|
:: -- the `++me` core for merging.
|
|
|
|
::
|
|
|
|
:: The dome is composed of the following:
|
|
|
|
::
|
|
|
|
:: -- `ank` is the ankh, which is the file data itself. An ankh is both
|
|
|
|
:: a possible file and a possible directory. An ankh has both:
|
|
|
|
:: -- `fil`, a possible file, stored as both a cage and its hash
|
|
|
|
:: -- `dir`, a map of @ta to more ankhs.
|
|
|
|
:: -- `let` is the number of the most recent revision.
|
|
|
|
:: -- `hit` is a map of revision numbers to commit hashes.
|
|
|
|
:: -- `lab` is a map of labels to revision numbers.
|
|
|
|
::
|
|
|
|
::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
|
2019-05-14 08:20:46 +03:00
|
|
|
::
|
|
|
|
:: The useful utility functions that are common to several cores
|
|
|
|
::
|
2019-05-11 00:51:37 +03:00
|
|
|
++ util (state:[^util] dom dom ran)
|
2019-05-14 08:20:46 +03:00
|
|
|
::
|
|
|
|
:: Other utility functions
|
|
|
|
::
|
2016-11-24 07:25:07 +03:00
|
|
|
++ ze
|
|
|
|
|%
|
|
|
|
:: These convert between aeon (version number), tako (commit hash), yaki
|
|
|
|
:: (commit data structure), lobe (content hash), and blob (content).
|
2019-07-18 00:57:01 +03:00
|
|
|
::
|
|
|
|
:: XX the following are duplicated from the +state core
|
|
|
|
::
|
2016-11-24 07:25:07 +03:00
|
|
|
++ aeon-to-tako ~(got by hit.dom)
|
2019-07-18 00:57:01 +03:00
|
|
|
++ aeon-to-yaki |=(=aeon (tako-to-yaki (aeon-to-tako aeon)))
|
2016-11-24 07:25:07 +03:00
|
|
|
++ lobe-to-blob ~(got by lat.ran)
|
|
|
|
++ tako-to-yaki ~(got by hut.ran)
|
2019-05-04 05:24:24 +03:00
|
|
|
++ page-to-lobe page-to-lobe:util
|
2016-11-24 07:25:07 +03:00
|
|
|
::
|
|
|
|
:: Checks whether two pieces of data (either cages or lobes) are the same.
|
|
|
|
::
|
|
|
|
++ equivalent-data
|
|
|
|
|= {one/(each cage lobe) two/(each cage lobe)}
|
|
|
|
^- ?
|
2018-03-19 06:54:47 +03:00
|
|
|
?: ?=(%& -.one)
|
|
|
|
?: ?=(%& -.two)
|
2016-11-24 07:25:07 +03:00
|
|
|
=([p q.q]:p.one [p q.q]:p.two)
|
|
|
|
=(p.two (page-to-lobe [p q.q]:p.one))
|
2018-03-19 06:54:47 +03:00
|
|
|
?: ?=(%& -.two)
|
2016-11-24 07:25:07 +03:00
|
|
|
=(p.one (page-to-lobe [p q.q]:p.two))
|
|
|
|
=(p.one p.two)
|
|
|
|
::
|
|
|
|
:: Gets a map of the data at the given path and all children of it.
|
|
|
|
::
|
|
|
|
++ lobes-at-path
|
2018-02-07 03:34:09 +03:00
|
|
|
|= {for/(unit ship) yon/aeon pax/path}
|
2016-11-24 07:25:07 +03:00
|
|
|
^- (map path lobe)
|
|
|
|
?: =(0 yon) ~
|
2018-02-09 15:00:12 +03:00
|
|
|
:: we use %z for the check because it looks at all child paths.
|
2019-05-23 04:15:57 +03:00
|
|
|
?. |(?=(~ for) (may-read u.for %z yon pax)) ~
|
2016-11-24 07:25:07 +03:00
|
|
|
%- malt
|
|
|
|
%+ skim
|
2018-04-04 21:15:10 +03:00
|
|
|
%~ tap by
|
2018-04-04 21:07:05 +03:00
|
|
|
=< q
|
|
|
|
%- aeon-to-yaki
|
|
|
|
yon
|
2016-11-24 07:25:07 +03:00
|
|
|
|= {p/path q/lobe}
|
2018-03-19 07:18:20 +03:00
|
|
|
?| ?=(~ pax)
|
|
|
|
?& !?=(~ p)
|
2016-11-24 07:25:07 +03:00
|
|
|
=(-.pax -.p)
|
|
|
|
$(p +.p, pax +.pax)
|
|
|
|
== ==
|
|
|
|
::
|
|
|
|
:: Creates a nako of all the changes between a and b.
|
|
|
|
::
|
|
|
|
++ make-nako
|
|
|
|
|= {a/aeon b/aeon}
|
|
|
|
^- nako
|
|
|
|
:+ ?> (lte b let.dom)
|
|
|
|
|-
|
|
|
|
?: =(b let.dom)
|
|
|
|
hit.dom
|
|
|
|
$(hit.dom (~(del by hit.dom) let.dom), let.dom (dec let.dom))
|
|
|
|
b
|
|
|
|
?: =(0 b)
|
|
|
|
[~ ~]
|
|
|
|
(data-twixt-takos (~(get by hit.dom) a) (aeon-to-tako b))
|
|
|
|
::
|
|
|
|
:: 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.
|
|
|
|
::
|
|
|
|
++ data-twixt-takos
|
|
|
|
|= {a/(unit tako) b/tako}
|
|
|
|
^- {(set yaki) (set plop)}
|
2019-05-03 04:50:20 +03:00
|
|
|
=+ old=?~(a ~ (reachable-takos:util u.a))
|
2019-12-18 03:48:08 +03:00
|
|
|
=/ yal/(set tako)
|
2016-11-24 07:25:07 +03:00
|
|
|
%- silt
|
|
|
|
%+ skip
|
2019-05-03 04:50:20 +03:00
|
|
|
~(tap in (reachable-takos:util b))
|
2016-11-24 07:25:07 +03:00
|
|
|
|=(tak/tako (~(has in old) tak))
|
2017-02-13 22:58:49 +03:00
|
|
|
:- (silt (turn ~(tap in yal) tako-to-yaki))
|
|
|
|
(silt (turn ~(tap in (new-lobes (new-lobes ~ old) yal)) lobe-to-blob))
|
2016-11-24 07:25:07 +03:00
|
|
|
::
|
|
|
|
:: Get all the lobes that are referenced in `a` except those that are
|
|
|
|
:: already in `b`.
|
|
|
|
::
|
|
|
|
++ new-lobes :: object hash set
|
|
|
|
|= {b/(set lobe) a/(set tako)} :: that aren't in b
|
|
|
|
^- (set lobe)
|
2017-02-13 22:58:49 +03:00
|
|
|
%+ roll ~(tap in a)
|
2016-11-24 07:25:07 +03:00
|
|
|
|= {tak/tako bar/(set lobe)}
|
|
|
|
^- (set lobe)
|
|
|
|
=+ yak=(tako-to-yaki tak)
|
2017-02-13 23:43:18 +03:00
|
|
|
%+ roll ~(tap by q.yak)
|
2016-11-24 07:25:07 +03:00
|
|
|
=< .(far bar)
|
|
|
|
|= {{path lob/lobe} far/(set lobe)}
|
|
|
|
^- (set lobe)
|
|
|
|
?~ (~(has in b) lob) :: don't need
|
|
|
|
far
|
|
|
|
=+ gar=(lobe-to-blob lob)
|
|
|
|
?- -.gar
|
|
|
|
$direct (~(put in far) lob)
|
|
|
|
$delta (~(put in $(lob q.q.gar)) lob)
|
|
|
|
==
|
|
|
|
::
|
2018-02-07 23:11:25 +03:00
|
|
|
:: Gets the permissions that apply to a particular node.
|
|
|
|
::
|
|
|
|
:: If the node has no permissions of its own, we use its parent's.
|
|
|
|
:: If no permissions have been set for the entire tree above the node,
|
|
|
|
:: we default to fully private (empty whitelist).
|
|
|
|
::
|
|
|
|
++ read-p
|
|
|
|
|= pax/path
|
|
|
|
^- (unit (unit (each cage lobe)))
|
|
|
|
=- [~ ~ %& %noun !>(-)]
|
|
|
|
:- (read-p-in pax per.red)
|
|
|
|
(read-p-in pax pew.red)
|
|
|
|
::
|
|
|
|
++ read-p-in
|
2018-02-12 19:56:48 +03:00
|
|
|
|= {pax/path pes/regs}
|
2018-02-07 23:11:25 +03:00
|
|
|
^- dict
|
2018-06-20 20:12:26 +03:00
|
|
|
=/ rul/(unit rule) (~(get by pes) pax)
|
2018-06-19 02:10:11 +03:00
|
|
|
?^ rul
|
|
|
|
:+ pax mod.u.rul
|
|
|
|
%- ~(rep in who.u.rul)
|
2018-06-20 01:27:16 +03:00
|
|
|
|= {w/whom out/(pair (set ship) (map @ta crew))}
|
2018-08-16 02:48:37 +03:00
|
|
|
?: ?=({%& @p} w)
|
2018-06-20 00:43:16 +03:00
|
|
|
[(~(put in p.out) +.w) q.out]
|
2018-06-20 20:12:26 +03:00
|
|
|
=/ cru/(unit crew) (~(get by cez.ruf) +.w)
|
2018-06-19 02:10:11 +03:00
|
|
|
?~ cru out
|
2018-06-20 00:43:16 +03:00
|
|
|
[p.out (~(put by q.out) +.w u.cru)]
|
|
|
|
?~ pax [/ %white ~ ~]
|
2018-02-13 21:45:24 +03:00
|
|
|
$(pax (scag (dec (lent pax)) `path`pax))
|
2018-02-07 23:04:07 +03:00
|
|
|
::
|
|
|
|
++ may-read
|
|
|
|
|= {who/ship car/care yon/aeon pax/path}
|
|
|
|
^- ?
|
|
|
|
?+ car
|
|
|
|
(allowed-by who pax per.red)
|
2018-02-07 23:11:25 +03:00
|
|
|
::
|
|
|
|
$p
|
|
|
|
=(who our)
|
2018-02-07 23:04:07 +03:00
|
|
|
::
|
|
|
|
?($y $z)
|
|
|
|
=+ tak=(~(get by hit.dom) yon)
|
|
|
|
?~ tak |
|
|
|
|
=+ yak=(tako-to-yaki u.tak)
|
|
|
|
=+ len=(lent pax)
|
2018-02-09 02:35:42 +03:00
|
|
|
=- (levy ~(tap in -) |=(p/path (allowed-by who p per.red)))
|
|
|
|
%+ roll ~(tap in (~(del in ~(key by q.yak)) pax))
|
|
|
|
|= {p/path s/(set path)}
|
|
|
|
?. =(pax (scag len p)) s
|
|
|
|
%- ~(put in s)
|
|
|
|
?: ?=($z car) p
|
|
|
|
(scag +(len) p)
|
2018-02-07 23:04:07 +03:00
|
|
|
==
|
|
|
|
::
|
|
|
|
++ may-write
|
|
|
|
|= {w/ship p/path}
|
|
|
|
(allowed-by w p pew.red)
|
|
|
|
::
|
|
|
|
++ allowed-by
|
2018-02-12 19:56:48 +03:00
|
|
|
|= {who/ship pax/path pes/regs}
|
2018-02-07 23:04:07 +03:00
|
|
|
^- ?
|
2018-06-20 20:12:26 +03:00
|
|
|
=/ rul/real rul:(read-p-in pax pes)
|
|
|
|
=/ in-list/?
|
2018-06-20 00:43:16 +03:00
|
|
|
?| (~(has in p.who.rul) who)
|
2018-06-20 01:27:16 +03:00
|
|
|
::
|
2018-06-20 00:43:16 +03:00
|
|
|
%- ~(rep by q.who.rul)
|
2018-06-20 20:12:26 +03:00
|
|
|
|= {{@ta cru/crew} out/_|}
|
2018-06-20 00:43:16 +03:00
|
|
|
?: out &
|
|
|
|
(~(has in cru) who)
|
|
|
|
==
|
2018-06-19 02:10:11 +03:00
|
|
|
?: =(%black mod.rul)
|
|
|
|
!in-list
|
|
|
|
in-list
|
2018-08-22 22:56:46 +03:00
|
|
|
:: +read-t: produce the list of paths within a yaki with :pax as prefix
|
|
|
|
::
|
|
|
|
++ read-t
|
|
|
|
|= [yon=aeon pax=path]
|
|
|
|
^- (unit (unit [%file-list (hypo (list path))]))
|
|
|
|
:: if asked for version 0, produce an empty list of files
|
|
|
|
::
|
|
|
|
?: =(0 yon)
|
|
|
|
``[%file-list -:!>(*(list path)) *(list path)]
|
|
|
|
:: if asked for a future version, we don't have an answer
|
|
|
|
::
|
|
|
|
?~ tak=(~(get by hit.dom) yon)
|
|
|
|
~
|
|
|
|
:: look up the yaki snapshot based on the version
|
|
|
|
::
|
|
|
|
=/ yak=yaki (tako-to-yaki u.tak)
|
|
|
|
:: calculate the path length once outside the loop
|
|
|
|
::
|
|
|
|
=/ path-length (lent pax)
|
|
|
|
::
|
|
|
|
:^ ~ ~ %file-list
|
|
|
|
:- -:!>(*(list path))
|
|
|
|
^- (list path)
|
|
|
|
:: sort the matching paths alphabetically
|
|
|
|
::
|
|
|
|
=- (sort - aor)
|
|
|
|
:: traverse the filesystem, filtering for paths with :pax as prefix
|
|
|
|
::
|
|
|
|
%+ skim ~(tap in ~(key by q.yak))
|
|
|
|
|=(paf=path =(pax (scag path-length paf)))
|
2018-02-07 23:04:07 +03:00
|
|
|
::
|
2016-11-24 07:25:07 +03:00
|
|
|
:: Checks for existence of a node at an aeon.
|
|
|
|
::
|
|
|
|
:: This checks for existence of content at the node, and does *not* look
|
|
|
|
:: at any of its children.
|
|
|
|
::
|
|
|
|
++ read-u
|
2019-12-18 19:00:02 +03:00
|
|
|
|= [yon=aeon pax=path]
|
|
|
|
^- (unit (unit (each [%flag (hypo ?)] lobe)))
|
|
|
|
:: if asked for a future version, we don't have an answer
|
|
|
|
::
|
|
|
|
?~ tak=(~(get by hit.dom) yon)
|
2016-11-24 07:25:07 +03:00
|
|
|
~
|
2019-12-18 19:00:02 +03:00
|
|
|
:: look up the yaki snapshot based on the version
|
|
|
|
::
|
|
|
|
=/ yak=yaki (tako-to-yaki u.tak)
|
|
|
|
:: produce the result based on whether or not there's a file at :pax
|
|
|
|
::
|
|
|
|
``[%& %flag -:!>(*?) (~(has by q.yak) pax)]
|
2016-11-24 07:25:07 +03:00
|
|
|
::
|
|
|
|
:: Gets the dome (desk state) at a particular aeon.
|
|
|
|
::
|
|
|
|
:: For past aeons, we don't give an actual ankh in the dome, but the rest
|
2018-10-04 21:37:42 +03:00
|
|
|
:: of the data is legit. We also never send the mime cache over the wire.
|
2016-11-24 07:25:07 +03:00
|
|
|
::
|
|
|
|
++ read-v
|
|
|
|
|= {yon/aeon pax/path}
|
2018-10-04 21:37:42 +03:00
|
|
|
^- (unit (unit {$dome (hypo dome:clay)}))
|
2016-11-24 07:25:07 +03:00
|
|
|
?: (lth yon let.dom)
|
|
|
|
:* ~ ~ %dome -:!>(%dome)
|
2018-10-04 21:37:42 +03:00
|
|
|
^- dome:clay
|
|
|
|
:* ank=`[[%ank-in-old-v-not-implemented *ankh] ~ ~]
|
|
|
|
let=yon
|
|
|
|
hit=(molt (skim ~(tap by hit.dom) |=({p/@ud *} (lte p yon))))
|
|
|
|
lab=(molt (skim ~(tap by lab.dom) |=({* p/@ud} (lte p yon))))
|
|
|
|
== ==
|
2016-11-24 07:25:07 +03:00
|
|
|
?: (gth yon let.dom)
|
|
|
|
~
|
2018-10-04 21:37:42 +03:00
|
|
|
``[%dome -:!>(*dome:clay) [ank let hit lab]:dom]
|
2016-11-24 07:25:07 +03:00
|
|
|
::
|
2018-05-03 00:37:03 +03:00
|
|
|
:: Gets all cases refering to the same revision as the given case.
|
|
|
|
::
|
|
|
|
:: For the %da case, we give just the canonical timestamp of the revision.
|
|
|
|
::
|
|
|
|
++ read-w
|
|
|
|
|= cas/case
|
|
|
|
^- (unit (unit (each cage lobe)))
|
2019-05-04 05:24:24 +03:00
|
|
|
=+ aey=(case-to-aeon cas)
|
2018-05-03 00:37:03 +03:00
|
|
|
?~ aey ~
|
|
|
|
=- [~ ~ %& %cass !>(-)]
|
|
|
|
^- cass
|
|
|
|
:- u.aey
|
|
|
|
?: =(0 u.aey) `@da`0
|
|
|
|
t:(aeon-to-yaki u.aey)
|
|
|
|
::
|
2016-11-24 07:25:07 +03:00
|
|
|
:: Gets the data at a node.
|
|
|
|
::
|
2019-05-04 05:24:24 +03:00
|
|
|
++ read-x (cury read-x:util ?=(~ ref))
|
2016-11-24 07:25:07 +03:00
|
|
|
::
|
|
|
|
:: Gets an arch (directory listing) at a node.
|
|
|
|
::
|
|
|
|
++ read-y
|
|
|
|
|= {yon/aeon pax/path}
|
|
|
|
^- (unit (unit {$arch (hypo arch)}))
|
|
|
|
?: =(0 yon)
|
|
|
|
``[%arch -:!>(*arch) *arch]
|
|
|
|
=+ tak=(~(get by hit.dom) yon)
|
|
|
|
?~ tak
|
|
|
|
~
|
|
|
|
=+ yak=(tako-to-yaki u.tak)
|
|
|
|
=+ len=(lent pax)
|
|
|
|
:^ ~ ~ %arch
|
|
|
|
:: ~& cy+pax
|
|
|
|
:- -:!>(*arch)
|
|
|
|
^- arch
|
|
|
|
:- (~(get by q.yak) pax)
|
2018-03-19 07:18:20 +03:00
|
|
|
^- (map knot ~)
|
|
|
|
%- molt ^- (list (pair knot ~))
|
2016-11-24 07:25:07 +03:00
|
|
|
%+ turn
|
|
|
|
^- (list (pair path lobe))
|
2017-02-13 23:43:18 +03:00
|
|
|
%+ skim ~(tap by (~(del by q.yak) pax))
|
2016-11-24 07:25:07 +03:00
|
|
|
|= {paf/path lob/lobe}
|
|
|
|
=(pax (scag len paf))
|
|
|
|
|= {paf/path lob/lobe}
|
|
|
|
=+ pat=(slag len paf)
|
|
|
|
[?>(?=(^ pat) i.pat) ~]
|
|
|
|
::
|
|
|
|
:: Gets a recursive hash of a node and all its children.
|
|
|
|
::
|
|
|
|
++ read-z
|
|
|
|
|= {yon/aeon pax/path}
|
|
|
|
^- (unit (unit {$uvi (hypo @uvI)}))
|
|
|
|
?: =(0 yon)
|
|
|
|
``uvi+[-:!>(*@uvI) *@uvI]
|
|
|
|
=+ tak=(~(get by hit.dom) yon)
|
|
|
|
?~ tak
|
|
|
|
~
|
|
|
|
=+ yak=(tako-to-yaki u.tak)
|
|
|
|
=+ len=(lent pax)
|
|
|
|
:: ~& read-z+[yon=yon qyt=~(wyt by q.yak) pax=pax]
|
2019-12-18 03:48:08 +03:00
|
|
|
=/ descendants/(list (pair path lobe))
|
2016-11-24 07:25:07 +03:00
|
|
|
:: ~& %turning
|
|
|
|
:: =- ~& %turned -
|
|
|
|
%+ turn
|
|
|
|
:: ~& %skimming
|
|
|
|
:: =- ~& %skimmed -
|
2017-02-13 23:43:18 +03:00
|
|
|
%+ skim ~(tap by (~(del by q.yak) pax))
|
2016-11-24 07:25:07 +03:00
|
|
|
|= {paf/path lob/lobe}
|
|
|
|
=(pax (scag len paf))
|
|
|
|
|= {paf/path lob/lobe}
|
|
|
|
[(slag len paf) lob]
|
|
|
|
=+ us=(~(get by q.yak) pax)
|
|
|
|
^- (unit (unit {$uvi (hypo @uvI)}))
|
|
|
|
:^ ~ ~ %uvi
|
|
|
|
:- -:!>(*@uvI)
|
2018-03-19 07:18:20 +03:00
|
|
|
?: &(?=(~ descendants) ?=(~ us))
|
2016-11-24 07:25:07 +03:00
|
|
|
*@uvI
|
|
|
|
%+ roll
|
|
|
|
^- (list (pair path lobe))
|
|
|
|
[[~ ?~(us *lobe u.us)] descendants]
|
|
|
|
|=({{path lobe} @uvI} (shax (jam +<)))
|
|
|
|
::
|
|
|
|
:: Get a value at an aeon.
|
|
|
|
::
|
2019-05-23 00:39:12 +03:00
|
|
|
:: Value can be either null, meaning we don't have it yet, [null null],
|
|
|
|
:: meaning we know it doesn't exist, or [null null (each cage lobe)],
|
2016-11-24 07:25:07 +03:00
|
|
|
:: meaning we either have the value directly or a content hash of the
|
|
|
|
:: value.
|
|
|
|
::
|
|
|
|
++ read-at-aeon :: read-at-aeon:ze
|
2019-05-03 04:50:20 +03:00
|
|
|
|= [for=(unit ship) yon=aeon mun=mood] :: seek and read
|
2016-11-24 07:25:07 +03:00
|
|
|
^- (unit (unit (each cage lobe)))
|
2019-05-23 00:39:12 +03:00
|
|
|
?. |(?=(~ for) (may-read u.for care.mun yon path.mun))
|
2018-02-07 23:04:07 +03:00
|
|
|
~
|
2019-05-23 00:39:12 +03:00
|
|
|
?- care.mun
|
2019-05-03 04:50:20 +03:00
|
|
|
%d
|
|
|
|
:: XX this should only allow reads at the current date
|
2018-12-13 10:42:15 +03:00
|
|
|
::
|
|
|
|
?: !=(our her)
|
|
|
|
[~ ~]
|
2019-05-23 00:39:12 +03:00
|
|
|
?^ path.mun
|
2017-01-04 10:08:40 +03:00
|
|
|
~&(%no-cd-path [~ ~])
|
2018-12-13 10:42:15 +03:00
|
|
|
[~ ~ %& %noun !>(~(key by dos.rom.ruf))]
|
2018-05-03 00:40:21 +03:00
|
|
|
::
|
2019-05-23 00:39:12 +03:00
|
|
|
%p (read-p path.mun)
|
|
|
|
%t (bind (read-t yon path.mun) (lift |=(a=cage [%& a])))
|
|
|
|
%u (read-u yon path.mun)
|
|
|
|
%v (bind (read-v yon path.mun) (lift |=(a/cage [%& a])))
|
|
|
|
%w (read-w case.mun)
|
|
|
|
%x (read-x yon path.mun)
|
|
|
|
%y (bind (read-y yon path.mun) (lift |=(a/cage [%& a])))
|
|
|
|
%z (bind (read-z yon path.mun) (lift |=(a/cage [%& a])))
|
2018-05-03 00:40:21 +03:00
|
|
|
==
|
2019-05-03 04:50:20 +03:00
|
|
|
++ zu zu:util
|
2016-11-24 07:25:07 +03:00
|
|
|
--
|
|
|
|
--
|
|
|
|
--
|
|
|
|
::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
|
|
|
|
:: section 4cA, filesystem vane
|
|
|
|
::
|
|
|
|
:: This is the arvo interface vane. Our formal state is a `++raft`, which
|
|
|
|
:: has five components:
|
|
|
|
::
|
2018-12-13 10:42:15 +03:00
|
|
|
:: -- `rom` is the state for all local desks.
|
2016-11-24 07:25:07 +03:00
|
|
|
:: -- `hoy` is the state for all foreign desks.
|
|
|
|
:: -- `ran` is the global, hash-addressed object store.
|
|
|
|
:: -- `mon` is the set of mount points in unix.
|
|
|
|
:: -- `hez` is the duct to the unix sync.
|
|
|
|
::
|
|
|
|
::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
|
|
|
|
=| :: instrument state
|
2019-11-03 07:07:51 +03:00
|
|
|
$: ver=%2 :: vane version
|
2019-02-02 00:46:09 +03:00
|
|
|
ruf=raft :: revision tree
|
2016-11-24 07:25:07 +03:00
|
|
|
== ::
|
2018-12-06 00:41:21 +03:00
|
|
|
|= [our=ship now=@da eny=@uvJ ski=sley] :: current invocation
|
2016-11-24 07:25:07 +03:00
|
|
|
^? :: opaque core
|
|
|
|
|% ::
|
|
|
|
++ call :: handle request
|
2018-12-04 00:22:39 +03:00
|
|
|
|= $: hen=duct
|
2020-02-11 01:03:03 +03:00
|
|
|
dud=(unit goof)
|
2018-12-04 00:22:39 +03:00
|
|
|
type=*
|
|
|
|
wrapped-task=(hobo task:able)
|
2016-11-24 07:25:07 +03:00
|
|
|
==
|
2019-05-11 00:51:37 +03:00
|
|
|
^- [(list move) _..^$]
|
2018-12-04 00:22:39 +03:00
|
|
|
::
|
2020-01-21 02:01:36 +03:00
|
|
|
=/ req=task:able ((harden task:able) wrapped-task)
|
2020-02-24 22:09:37 +03:00
|
|
|
::
|
|
|
|
:: error notifications "downcast" to %crud
|
|
|
|
::
|
|
|
|
=? req ?=(^ dud)
|
|
|
|
~| %crud-in-crud
|
|
|
|
?< ?=(%crud -.req)
|
|
|
|
[%crud -.req tang.u.dud]
|
|
|
|
::
|
2019-02-22 02:57:51 +03:00
|
|
|
:: only one of these should be going at once, so queue
|
|
|
|
::
|
2019-05-18 00:59:03 +03:00
|
|
|
?: ?=(?(%info %merg %mont) -.req)
|
2019-05-11 00:51:37 +03:00
|
|
|
:: If there's an active write or a queue, enqueue
|
|
|
|
::
|
|
|
|
:: We only want one active write so each can be a clean
|
2019-05-14 08:20:46 +03:00
|
|
|
:: transaction. We don't intercept `%into` because it
|
|
|
|
:: immediately translates itself into one or two `%info` calls.
|
2019-05-11 00:51:37 +03:00
|
|
|
::
|
|
|
|
?: |(!=(~ act.ruf) !=(~ cue.ruf))
|
|
|
|
=. cue.ruf (~(put to cue.ruf) [hen req])
|
2019-05-23 04:15:57 +03:00
|
|
|
:: ~& :* %clall-enqueing
|
|
|
|
:: cue=(turn ~(tap to cue.ruf) |=([=duct =task:able] [duct -.task]))
|
|
|
|
:: ^= act
|
|
|
|
:: ?~ act.ruf
|
|
|
|
:: ~
|
|
|
|
:: [hen req -.eval-data]:u.act.ruf
|
|
|
|
:: ==
|
2019-05-11 00:51:37 +03:00
|
|
|
[~ ..^$]
|
2019-05-14 08:20:46 +03:00
|
|
|
:: If the last commit happened in this event, enqueue
|
2019-05-11 00:51:37 +03:00
|
|
|
::
|
|
|
|
:: Without this, two commits could have the same date, which
|
|
|
|
:: would make clay violate referential transparency.
|
|
|
|
::
|
|
|
|
=/ =desk des.req
|
2019-06-30 15:50:00 +03:00
|
|
|
=/ =dojo (~(gut by dos.rom.ruf) desk *dojo)
|
2019-05-11 00:51:37 +03:00
|
|
|
?: =(0 let.dom.dojo)
|
|
|
|
(handle-task hen req)
|
2019-05-14 08:20:46 +03:00
|
|
|
=/ sutil (state:util dom.dojo dom.dojo ran.ruf)
|
2019-05-11 00:51:37 +03:00
|
|
|
=/ last-write=@da t:(aeon-to-yaki:sutil let.dom.dojo)
|
|
|
|
?: !=(last-write now)
|
|
|
|
(handle-task hen req)
|
2019-02-23 02:52:18 +03:00
|
|
|
=. cue.ruf (~(put to cue.ruf) [hen req])
|
2019-05-11 00:51:37 +03:00
|
|
|
=/ wait-behn [hen %pass /queued-request %b %wait now]
|
|
|
|
[[wait-behn ~] ..^$]
|
2019-02-22 02:57:51 +03:00
|
|
|
(handle-task hen req)
|
|
|
|
::
|
2019-05-14 08:20:46 +03:00
|
|
|
:: Handle a task, without worrying about write queueing
|
|
|
|
::
|
2019-02-22 02:57:51 +03:00
|
|
|
++ handle-task
|
|
|
|
|= [hen=duct req=task:able]
|
2019-05-11 00:51:37 +03:00
|
|
|
^- [(list move) _..^$]
|
2018-02-09 15:33:15 +03:00
|
|
|
?- -.req
|
2019-05-11 00:51:37 +03:00
|
|
|
%boat
|
2016-11-24 07:25:07 +03:00
|
|
|
:_ ..^$
|
2017-02-13 23:43:18 +03:00
|
|
|
[hen %give %hill (turn ~(tap by mon.ruf) head)]~
|
2019-07-25 01:54:45 +03:00
|
|
|
::
|
2019-05-11 00:51:37 +03:00
|
|
|
%cred
|
2018-02-07 23:07:42 +03:00
|
|
|
=. cez.ruf
|
2018-02-09 15:33:15 +03:00
|
|
|
?~ cew.req (~(del by cez.ruf) nom.req)
|
|
|
|
(~(put by cez.ruf) nom.req cew.req)
|
2018-02-07 23:07:42 +03:00
|
|
|
:: wake all desks, a request may have been affected.
|
|
|
|
=| mos/(list move)
|
2018-12-13 10:42:15 +03:00
|
|
|
=/ des ~(tap in ~(key by dos.rom.ruf))
|
2018-02-07 23:07:42 +03:00
|
|
|
|-
|
2019-06-29 02:43:52 +03:00
|
|
|
?~ des [[[hen %give %done ~] mos] ..^^$]
|
2019-02-02 00:46:09 +03:00
|
|
|
=/ den ((de our now ski hen ruf) our i.des)
|
2018-02-12 18:02:32 +03:00
|
|
|
=^ mor ruf
|
|
|
|
=< abet:wake
|
|
|
|
?: ?=(^ cew.req) den
|
|
|
|
(forget-crew:den nom.req)
|
2018-02-07 23:07:42 +03:00
|
|
|
$(des t.des, mos (weld mos mor))
|
|
|
|
::
|
2019-05-11 00:51:37 +03:00
|
|
|
%crew
|
2018-02-07 23:07:42 +03:00
|
|
|
[[hen %give %cruz cez.ruf]~ ..^$]
|
2018-02-12 19:57:59 +03:00
|
|
|
::
|
2019-05-11 00:51:37 +03:00
|
|
|
%crow
|
2018-12-13 10:42:15 +03:00
|
|
|
=/ des ~(tap by dos.rom.ruf)
|
2018-02-12 19:57:59 +03:00
|
|
|
=| rus/(map desk {r/regs w/regs})
|
|
|
|
|^
|
|
|
|
?~ des [[hen %give %croz rus]~ ..^^$]
|
|
|
|
=+ per=(filter-rules per.q.i.des)
|
|
|
|
=+ pew=(filter-rules pew.q.i.des)
|
2018-02-13 21:47:44 +03:00
|
|
|
=? rus |(?=(^ per) ?=(^ pew))
|
|
|
|
(~(put by rus) p.i.des per pew)
|
|
|
|
$(des t.des)
|
2018-02-12 19:57:59 +03:00
|
|
|
::
|
|
|
|
++ filter-rules
|
|
|
|
|= pes/regs
|
|
|
|
^+ pes
|
|
|
|
=- (~(gas in *regs) -)
|
2018-02-13 21:47:44 +03:00
|
|
|
%+ skim ~(tap by pes)
|
2018-02-12 19:57:59 +03:00
|
|
|
|= {p/path r/rule}
|
2018-02-13 21:47:44 +03:00
|
|
|
(~(has in who.r) |+nom.req)
|
2018-02-12 19:57:59 +03:00
|
|
|
--
|
2018-11-23 20:19:23 +03:00
|
|
|
::
|
2019-05-11 00:51:37 +03:00
|
|
|
%crud
|
2018-11-23 20:19:23 +03:00
|
|
|
[[[hen %slip %d %flog req] ~] ..^$]
|
2016-11-24 07:25:07 +03:00
|
|
|
::
|
2019-05-11 00:51:37 +03:00
|
|
|
%drop
|
2019-08-09 21:52:42 +03:00
|
|
|
~? =(~ act.ruf)
|
|
|
|
[%clay-idle cue-length=~(wyt in cue.ruf)]
|
|
|
|
~? ?=(^ act.ruf)
|
|
|
|
[%clay-cancelling hen -.req -.eval-data]:u.act.ruf
|
|
|
|
=. act.ruf ~
|
|
|
|
?~ cue.ruf
|
|
|
|
[~ ..^$]
|
|
|
|
=/ =duct duct:(need ~(top to cue.ruf))
|
|
|
|
[[duct %pass /queued-request %b %wait now]~ ..^$]
|
2016-11-24 07:25:07 +03:00
|
|
|
::
|
2019-05-11 00:51:37 +03:00
|
|
|
%info
|
2018-02-09 16:48:08 +03:00
|
|
|
?: =(%$ des.req)
|
2019-05-02 04:21:32 +03:00
|
|
|
~|(%info-no-desk !!)
|
2019-05-10 04:06:18 +03:00
|
|
|
=. act.ruf
|
2019-06-30 15:50:00 +03:00
|
|
|
=/ =dojo (~(gut by dos.rom.ruf) des.req *dojo)
|
2019-05-10 04:06:18 +03:00
|
|
|
=/ writer=form:commit-clad
|
2019-05-11 00:51:37 +03:00
|
|
|
%- %- commit
|
2019-05-10 04:06:18 +03:00
|
|
|
:* our
|
|
|
|
des.req
|
|
|
|
now
|
|
|
|
mon.ruf
|
|
|
|
hez.ruf
|
|
|
|
hun.rom.ruf
|
|
|
|
==
|
|
|
|
:* dit.req
|
2019-05-11 00:51:37 +03:00
|
|
|
dom.dojo
|
2019-05-10 04:06:18 +03:00
|
|
|
ran.ruf
|
|
|
|
==
|
2019-05-18 00:59:03 +03:00
|
|
|
`[hen req %commit (from-form:eval:commit-clad writer)]
|
2016-11-24 07:25:07 +03:00
|
|
|
=^ mos ruf
|
2019-05-11 00:51:37 +03:00
|
|
|
=/ den ((de our now ski hen ruf) our des.req)
|
2019-05-17 03:24:10 +03:00
|
|
|
abet:(take-commit:den clad-init-sign)
|
2016-11-24 07:25:07 +03:00
|
|
|
[mos ..^$]
|
|
|
|
::
|
2019-05-11 00:51:37 +03:00
|
|
|
%init
|
2018-12-13 10:42:15 +03:00
|
|
|
[~ ..^$(hun.rom.ruf hen)]
|
2016-11-24 07:25:07 +03:00
|
|
|
::
|
2019-05-11 00:51:37 +03:00
|
|
|
%into
|
2016-11-24 07:25:07 +03:00
|
|
|
=. hez.ruf `hen
|
|
|
|
:_ ..^$
|
2018-02-09 16:48:08 +03:00
|
|
|
=+ bem=(~(get by mon.ruf) des.req)
|
2018-08-16 02:48:37 +03:00
|
|
|
?: &(?=(~ bem) !=(%$ des.req))
|
2018-02-09 16:48:08 +03:00
|
|
|
~|([%bad-mount-point-from-unix des.req] !!)
|
2019-12-18 03:48:08 +03:00
|
|
|
=/ bem/beam
|
2016-11-24 07:25:07 +03:00
|
|
|
?^ bem
|
|
|
|
u.bem
|
2018-12-13 10:42:15 +03:00
|
|
|
[[our %base %ud 1] ~]
|
|
|
|
=/ dos (~(get by dos.rom.ruf) q.bem)
|
2016-11-24 07:25:07 +03:00
|
|
|
?~ dos
|
2019-05-11 05:23:13 +03:00
|
|
|
!! :: fire next in queue
|
2016-11-24 07:25:07 +03:00
|
|
|
?: =(0 let.dom.u.dos)
|
2018-02-09 16:48:08 +03:00
|
|
|
=+ cos=(mode-to-soba ~ s.bem all.req fis.req)
|
2019-12-18 03:48:08 +03:00
|
|
|
=/ [one=soba two=soba]
|
2016-11-24 07:25:07 +03:00
|
|
|
%+ skid cos
|
2019-05-11 00:51:37 +03:00
|
|
|
|= [a=path b=miso]
|
|
|
|
?& ?=(%ins -.b)
|
|
|
|
?=(%mime p.p.b)
|
|
|
|
?=([%hoon ~] (slag (dec (lent a)) a))
|
2016-11-24 07:25:07 +03:00
|
|
|
==
|
2018-12-13 10:59:53 +03:00
|
|
|
:~ [hen %pass /one %c %info q.bem %& one]
|
|
|
|
[hen %pass /two %c %info q.bem %& two]
|
2016-11-24 07:25:07 +03:00
|
|
|
==
|
|
|
|
=+ yak=(~(got by hut.ran.ruf) (~(got by hit.dom.u.dos) let.dom.u.dos))
|
2018-02-09 16:48:08 +03:00
|
|
|
=+ cos=(mode-to-soba q.yak (flop s.bem) all.req fis.req)
|
2018-12-13 10:59:53 +03:00
|
|
|
[hen %pass /both %c %info q.bem %& cos]~
|
2016-11-24 07:25:07 +03:00
|
|
|
::
|
2019-05-11 00:51:37 +03:00
|
|
|
%merg :: direct state up
|
2018-02-09 16:48:08 +03:00
|
|
|
?: =(%$ des.req)
|
2019-05-03 04:06:31 +03:00
|
|
|
~&(%merg-no-desk !!)
|
2019-05-10 04:06:18 +03:00
|
|
|
=. act.ruf
|
2019-06-30 15:50:00 +03:00
|
|
|
=/ =dojo (~(gut by dos.rom.ruf) des.req *dojo)
|
2019-05-10 04:06:18 +03:00
|
|
|
=/ writer=form:merge-clad
|
|
|
|
%- %- merge
|
|
|
|
:* our
|
|
|
|
now
|
|
|
|
[her dem]:req
|
|
|
|
[our des.req]
|
|
|
|
cas.req
|
|
|
|
mon.ruf
|
|
|
|
hez.ruf
|
|
|
|
==
|
|
|
|
:* how.req
|
2019-05-11 00:51:37 +03:00
|
|
|
dom.dojo
|
2019-05-10 04:06:18 +03:00
|
|
|
ran.ruf
|
|
|
|
==
|
2019-05-18 00:59:03 +03:00
|
|
|
`[hen req %merge (from-form:eval:merge-clad writer)]
|
2016-11-24 07:25:07 +03:00
|
|
|
=^ mos ruf
|
2019-05-11 00:51:37 +03:00
|
|
|
=/ den ((de our now ski hen ruf) our des.req)
|
2019-05-17 03:24:10 +03:00
|
|
|
abet:(take-merge:den clad-init-sign)
|
2016-11-24 07:25:07 +03:00
|
|
|
[mos ..^$]
|
|
|
|
::
|
2019-05-11 00:51:37 +03:00
|
|
|
%mont
|
2016-11-24 07:25:07 +03:00
|
|
|
=. hez.ruf ?^(hez.ruf hez.ruf `[[%$ %sync ~] ~])
|
2019-05-18 00:59:03 +03:00
|
|
|
=. act.ruf
|
2019-06-30 15:50:00 +03:00
|
|
|
=/ =dojo (~(gut by dos.rom.ruf) q.bem.req *dojo)
|
2019-05-18 00:59:03 +03:00
|
|
|
=/ writer=form:mount-clad
|
|
|
|
%- %- mount
|
|
|
|
:* our
|
|
|
|
q.bem.req
|
|
|
|
now
|
|
|
|
(need hez.ruf)
|
|
|
|
dom.dojo
|
|
|
|
ran.ruf
|
|
|
|
==
|
|
|
|
:* des.req
|
|
|
|
bem.req
|
|
|
|
mon.ruf
|
|
|
|
==
|
|
|
|
`[hen req %mount (from-form:eval:mount-clad writer)]
|
2016-11-24 07:25:07 +03:00
|
|
|
=^ mos ruf
|
2019-05-18 00:59:03 +03:00
|
|
|
=/ den ((de our now ski hen ruf) p.bem.req q.bem.req)
|
|
|
|
abet:(take-mount:den clad-init-sign)
|
2016-11-24 07:25:07 +03:00
|
|
|
[mos ..^$]
|
2017-01-12 18:50:35 +03:00
|
|
|
::
|
2019-05-11 00:51:37 +03:00
|
|
|
%dirk
|
2017-01-12 18:50:35 +03:00
|
|
|
?~ hez.ruf
|
|
|
|
~& %no-sync-duct
|
|
|
|
[~ ..^$]
|
2018-02-09 16:48:08 +03:00
|
|
|
?. (~(has by mon.ruf) des.req)
|
|
|
|
~& [%not-mounted des.req]
|
2017-01-12 18:50:35 +03:00
|
|
|
[~ ..^$]
|
2018-02-09 16:48:08 +03:00
|
|
|
:- ~[[u.hez.ruf %give %dirk des.req]]
|
2017-01-12 18:50:35 +03:00
|
|
|
..^$
|
2016-11-24 07:25:07 +03:00
|
|
|
::
|
2019-05-11 00:51:37 +03:00
|
|
|
%ogre
|
2016-11-24 07:25:07 +03:00
|
|
|
?~ hez.ruf
|
|
|
|
~& %no-sync-duct
|
|
|
|
[~ ..^$]
|
2018-02-09 16:48:08 +03:00
|
|
|
=* pot pot.req
|
|
|
|
?@ pot
|
|
|
|
?. (~(has by mon.ruf) pot)
|
|
|
|
~& [%not-mounted pot]
|
2016-11-24 07:25:07 +03:00
|
|
|
[~ ..^$]
|
2018-02-09 16:48:08 +03:00
|
|
|
:_ ..^$(mon.ruf (~(del by mon.ruf) pot))
|
|
|
|
[u.hez.ruf %give %ogre pot]~
|
2016-11-24 07:25:07 +03:00
|
|
|
:_ %_ ..^$
|
|
|
|
mon.ruf
|
|
|
|
%- molt
|
2017-02-13 23:43:18 +03:00
|
|
|
%+ skip ~(tap by mon.ruf)
|
2018-02-09 16:48:08 +03:00
|
|
|
(corl (cury test pot) tail)
|
2016-11-24 07:25:07 +03:00
|
|
|
==
|
|
|
|
%+ turn
|
2018-02-09 16:48:08 +03:00
|
|
|
(skim ~(tap by mon.ruf) (corl (cury test pot) tail))
|
|
|
|
|= {pon/term bem/beam}
|
|
|
|
[u.hez.ruf %give %ogre pon]
|
2018-02-07 00:18:25 +03:00
|
|
|
::
|
2019-05-11 00:51:37 +03:00
|
|
|
%perm
|
2018-02-07 00:18:25 +03:00
|
|
|
=^ mos ruf
|
2019-02-02 00:46:09 +03:00
|
|
|
=/ den ((de our now ski hen ruf) our des.req)
|
2018-02-09 15:33:15 +03:00
|
|
|
abet:(perm:den pax.req rit.req)
|
2018-02-07 00:18:25 +03:00
|
|
|
[mos ..^$]
|
2019-09-27 23:00:37 +03:00
|
|
|
::
|
|
|
|
%trim [~ ..^$]
|
2019-02-01 10:37:00 +03:00
|
|
|
::
|
2019-05-11 00:51:37 +03:00
|
|
|
%vega [~ ..^$]
|
2016-11-24 07:25:07 +03:00
|
|
|
::
|
2019-05-11 00:51:37 +03:00
|
|
|
?(%warp %werp)
|
2018-12-13 21:23:26 +03:00
|
|
|
:: capture whether this read is on behalf of another ship
|
|
|
|
:: for permissions enforcement
|
|
|
|
::
|
2018-02-09 15:33:15 +03:00
|
|
|
=^ for req
|
2019-05-11 00:51:37 +03:00
|
|
|
?: ?=(%warp -.req)
|
2018-02-09 15:33:15 +03:00
|
|
|
[~ req]
|
2018-12-13 21:23:26 +03:00
|
|
|
:- ?:(=(our who.req) ~ `who.req)
|
|
|
|
[%warp wer.req rif.req]
|
|
|
|
::
|
2019-05-11 00:51:37 +03:00
|
|
|
?> ?=(%warp -.req)
|
2018-02-09 16:48:08 +03:00
|
|
|
=* rif rif.req
|
2016-11-24 07:25:07 +03:00
|
|
|
=^ mos ruf
|
2019-02-02 00:46:09 +03:00
|
|
|
=/ den ((de our now ski hen ruf) wer.req p.rif)
|
2016-11-24 07:25:07 +03:00
|
|
|
=< abet
|
2018-02-09 15:25:46 +03:00
|
|
|
?~ q.rif
|
2016-11-24 07:25:07 +03:00
|
|
|
cancel-request:den
|
2018-02-09 15:25:46 +03:00
|
|
|
(start-request:den for u.q.rif)
|
2016-11-24 07:25:07 +03:00
|
|
|
[mos ..^$]
|
|
|
|
::
|
2019-07-29 09:37:49 +03:00
|
|
|
%plea
|
2019-06-29 02:43:52 +03:00
|
|
|
=* her ship.req
|
2019-07-29 09:37:49 +03:00
|
|
|
=* pax path.plea.req
|
|
|
|
=* res payload.plea.req
|
2019-06-29 02:43:52 +03:00
|
|
|
::
|
|
|
|
?> ?=({%question *} pax)
|
|
|
|
=+ ryf=;;(riff res)
|
|
|
|
:_ ..^$
|
|
|
|
:~ [hen %give %done ~]
|
|
|
|
=/ =wire
|
|
|
|
[%foreign-warp (scot %p her) t.pax]
|
|
|
|
[hen %pass wire %c %werp her our ryf]
|
|
|
|
==
|
2016-11-24 07:25:07 +03:00
|
|
|
::
|
2019-05-11 00:51:37 +03:00
|
|
|
%wegh
|
2016-11-24 07:25:07 +03:00
|
|
|
:_ ..^$ :_ ~
|
|
|
|
:^ hen %give %mass
|
2019-01-30 03:38:27 +03:00
|
|
|
:+ %clay %|
|
|
|
|
:~ domestic+&+rom.ruf
|
|
|
|
foreign+&+hoy.ruf
|
|
|
|
:+ %object-store %|
|
|
|
|
:~ commits+&+hut.ran.ruf
|
|
|
|
blobs+&+lat.ran.ruf
|
2016-11-24 07:25:07 +03:00
|
|
|
==
|
2019-01-30 03:38:27 +03:00
|
|
|
dot+&+ruf
|
2016-11-24 07:25:07 +03:00
|
|
|
==
|
|
|
|
==
|
|
|
|
::
|
|
|
|
++ load
|
jael: provide edge-triggered breach notification
Until now, clients of Jael have had to store the first-seen rift if they
want to reliably detect breaches. Otherwise, they would get a false
positive if they heard an old message about a breach (eg if you kick
azimuth-tracker). Clay and Gall did this correctly, but Ames did not.
Jael already maintains this state, so I added a notification to the
existing subscription that happens whenever it notices a breach (a diff
or full where the new rift is greater than the old one).
Because this is an issue on the live network, I wrote state adapters
for Gall and Clay. The Gall one just removes the rift from our state,
but the Clay one is much more involved because we have to upgrade
instances of the clad monad that are possibly in progress.
Specifically, since more input is possible than before, we must wrap any
in-progress instances of the monad in a function that handles the
potential new input from Jael. This temporarily preservers a copy of
the old kernel, but only until the current commit/merge/update has
completed.
The real solution for Clay is to factor out those IO-heavy instances to
userspace tapp/async/imp/threads, and if an upgrade happens in the
middle, you should simply restart them.
Fixes #1852
2019-10-24 07:26:38 +03:00
|
|
|
!:
|
2019-11-03 07:07:51 +03:00
|
|
|
|= [%2 =raft]
|
|
|
|
..^$(ruf raft)
|
2016-11-24 07:25:07 +03:00
|
|
|
::
|
|
|
|
++ scry :: inspect
|
|
|
|
|= {fur/(unit (set monk)) ren/@tas why/shop syd/desk lot/coin tyl/path}
|
|
|
|
^- (unit (unit cage))
|
2018-03-19 06:54:47 +03:00
|
|
|
?. ?=(%& -.why) ~
|
2016-11-24 07:25:07 +03:00
|
|
|
=* his p.why
|
|
|
|
:: ~& scry+[ren `path`[(scot %p his) syd ~(rent co lot) tyl]]
|
|
|
|
:: =- ~& %scry-done -
|
2018-08-16 02:48:37 +03:00
|
|
|
=+ luk=?.(?=(%$ -.lot) ~ ((soft case) p.lot))
|
2016-11-24 07:25:07 +03:00
|
|
|
?~ luk [~ ~]
|
|
|
|
?: =(%$ ren)
|
|
|
|
[~ ~]
|
|
|
|
=+ run=((soft care) ren)
|
|
|
|
?~ run [~ ~]
|
2018-02-06 23:57:38 +03:00
|
|
|
::TODO if it ever gets filled properly, pass in the full fur.
|
|
|
|
=/ for/(unit ship)
|
|
|
|
%- ~(rep in (fall fur ~))
|
|
|
|
|= {m/monk s/(unit ship)}
|
|
|
|
?^ s s
|
2018-05-04 03:59:10 +03:00
|
|
|
?: ?=(%| -.m) ~
|
2018-02-06 23:57:38 +03:00
|
|
|
?: =(p.m his) ~
|
|
|
|
`p.m
|
2019-02-02 00:46:09 +03:00
|
|
|
=/ den ((de our now ski [/scryduct ~] ruf) his syd)
|
2018-02-07 03:34:09 +03:00
|
|
|
=+ (aver:den for u.run u.luk tyl)
|
2016-11-24 07:25:07 +03:00
|
|
|
?~ - -
|
|
|
|
?~ u.- -
|
2018-03-19 06:54:47 +03:00
|
|
|
?: ?=(%& -.u.u.-) ``p.u.u.-
|
2016-11-24 07:25:07 +03:00
|
|
|
~
|
|
|
|
::
|
2019-11-03 07:07:51 +03:00
|
|
|
++ stay [ver ruf]
|
2016-11-24 07:25:07 +03:00
|
|
|
++ take :: accept response
|
2020-02-11 01:03:03 +03:00
|
|
|
|= [tea=wire hen=duct dud=(unit goof) hin=(hypo sign)]
|
2018-12-01 22:31:54 +03:00
|
|
|
^+ [*(list move) ..^$]
|
2020-02-25 01:10:59 +03:00
|
|
|
?^ dud
|
|
|
|
~|(%clay-take-dud (mean tang.u.dud))
|
|
|
|
::
|
2019-07-27 06:43:07 +03:00
|
|
|
?: ?=([%commit @ *] tea)
|
2019-05-04 05:24:24 +03:00
|
|
|
=* syd i.t.tea
|
2016-11-24 07:25:07 +03:00
|
|
|
=^ mos ruf
|
2019-02-02 00:46:09 +03:00
|
|
|
=/ den ((de our now ski hen ruf) our syd)
|
2019-05-04 05:24:24 +03:00
|
|
|
abet:(take-commit:den q.hin)
|
2016-11-24 07:25:07 +03:00
|
|
|
[mos ..^$]
|
2019-05-17 03:24:10 +03:00
|
|
|
::
|
2019-07-27 06:43:07 +03:00
|
|
|
?: ?=([%merge @ *] tea)
|
2019-05-02 04:21:32 +03:00
|
|
|
=* syd i.t.tea
|
|
|
|
=^ mos ruf
|
|
|
|
=/ den ((de our now ski hen ruf) our syd)
|
2019-05-04 05:24:24 +03:00
|
|
|
abet:(take-merge:den q.hin)
|
2019-05-02 04:21:32 +03:00
|
|
|
[mos ..^$]
|
2019-05-17 03:24:10 +03:00
|
|
|
::
|
2019-07-27 06:43:07 +03:00
|
|
|
?: ?=([%mount @ *] tea)
|
2019-05-18 00:59:03 +03:00
|
|
|
=* syd i.t.tea
|
|
|
|
=^ mos ruf
|
|
|
|
=/ den ((de our now ski hen ruf) our syd)
|
|
|
|
abet:(take-mount:den q.hin)
|
|
|
|
[mos ..^$]
|
|
|
|
::
|
2019-06-29 02:43:52 +03:00
|
|
|
?: ?=([%foreign-warp *] tea)
|
|
|
|
?> ?=(%writ +<.q.hin)
|
|
|
|
:_ ..^$
|
2019-08-05 23:58:53 +03:00
|
|
|
[hen %give %boon `(unit rand)`(bind `riot`p.q.hin rant-to-rand)]~
|
2019-06-29 02:43:52 +03:00
|
|
|
::
|
2019-07-27 06:43:07 +03:00
|
|
|
?: ?=([%foreign-request @ @ @ *] tea)
|
2019-05-17 03:24:10 +03:00
|
|
|
=/ her (slav %p i.t.tea)
|
|
|
|
=/ syd (slav %tas i.t.t.tea)
|
|
|
|
=/ inx (slav %ud i.t.t.t.tea)
|
|
|
|
=^ mos ruf
|
|
|
|
=/ den ((de our now ski hen ruf) her syd)
|
|
|
|
abet:(take-foreign-request:den inx q.hin)
|
|
|
|
[mos ..^$]
|
|
|
|
::
|
2019-07-27 06:43:07 +03:00
|
|
|
?: ?=([%foreign-update @ @ *] tea)
|
2019-05-17 03:24:10 +03:00
|
|
|
=/ her (slav %p i.t.tea)
|
|
|
|
=/ syd (slav %tas i.t.t.tea)
|
|
|
|
=^ mos ruf
|
|
|
|
=/ den ((de our now ski hen ruf) her syd)
|
|
|
|
abet:(take-foreign-update:den q.hin)
|
|
|
|
[mos ..^$]
|
|
|
|
::
|
2019-07-27 06:43:07 +03:00
|
|
|
?: ?=([%blab care @ @ *] tea)
|
|
|
|
?> ?=(%made +<.q.hin)
|
2018-06-16 01:36:41 +03:00
|
|
|
?. ?=([%complete %success *] result.q.hin)
|
2016-11-24 07:25:07 +03:00
|
|
|
~| %blab-fail
|
2018-08-09 00:47:01 +03:00
|
|
|
~> %mean.|.((made-result-as-error:ford result.q.hin))
|
2016-11-24 07:25:07 +03:00
|
|
|
!! :: interpolate ford fail into stack trace
|
|
|
|
:_ ..^$ :_ ~
|
2019-05-02 04:21:32 +03:00
|
|
|
:* hen %slip %b %drip !>
|
|
|
|
:* %writ ~
|
2019-07-27 06:43:07 +03:00
|
|
|
^- [care case @tas]
|
2019-05-09 22:46:19 +03:00
|
|
|
[i.t.tea ;;(case +>:(slay i.t.t.tea)) i.t.t.t.tea]
|
2016-11-24 07:25:07 +03:00
|
|
|
::
|
|
|
|
`path`t.t.t.t.tea
|
2018-08-09 00:47:01 +03:00
|
|
|
`cage`(result-to-cage:ford build-result.result.q.hin)
|
2019-05-02 04:21:32 +03:00
|
|
|
== ==
|
2019-05-17 03:24:10 +03:00
|
|
|
::
|
2019-06-29 02:43:52 +03:00
|
|
|
?: ?=([%warp-index @ @ @ ~] tea)
|
2019-08-28 06:12:56 +03:00
|
|
|
?+ +<.q.hin ~| %clay-warp-index-strange !!
|
|
|
|
%done
|
2019-07-29 12:08:26 +03:00
|
|
|
?~ error.q.hin
|
|
|
|
[~ ..^$]
|
|
|
|
:: TODO better error handling
|
|
|
|
::
|
2019-08-05 23:58:53 +03:00
|
|
|
~& %clay-take-warp-index-error^our^tea^tag.u.error.q.hin
|
2019-07-29 12:08:26 +03:00
|
|
|
%- (slog tang.u.error.q.hin)
|
|
|
|
[~ ..^$]
|
|
|
|
::
|
2019-08-28 06:12:56 +03:00
|
|
|
%lost
|
|
|
|
~| %clay-take-lost^our
|
|
|
|
:: TODO better error handling
|
2019-08-05 23:58:53 +03:00
|
|
|
!!
|
2019-06-29 02:43:52 +03:00
|
|
|
::
|
2019-08-28 06:12:56 +03:00
|
|
|
%boon
|
|
|
|
=+ ;; res=(unit rand) payload.q.hin
|
|
|
|
::
|
|
|
|
=/ her=ship (slav %p i.t.tea)
|
|
|
|
=/ =desk (slav %tas i.t.t.tea)
|
|
|
|
=/ index=@ud (slav %ud i.t.t.t.tea)
|
|
|
|
::
|
|
|
|
=^ mos ruf
|
|
|
|
=/ den ((de our now ski hen ruf) her desk)
|
|
|
|
abet:(take-foreign-answer:den index res)
|
|
|
|
[mos ..^$]
|
|
|
|
==
|
2019-06-29 02:43:52 +03:00
|
|
|
::
|
2019-07-27 06:43:07 +03:00
|
|
|
?: ?=([%sinks ~] tea)
|
|
|
|
?> ?=(%public-keys +<.q.hin)
|
jael: provide edge-triggered breach notification
Until now, clients of Jael have had to store the first-seen rift if they
want to reliably detect breaches. Otherwise, they would get a false
positive if they heard an old message about a breach (eg if you kick
azimuth-tracker). Clay and Gall did this correctly, but Ames did not.
Jael already maintains this state, so I added a notification to the
existing subscription that happens whenever it notices a breach (a diff
or full where the new rift is greater than the old one).
Because this is an issue on the live network, I wrote state adapters
for Gall and Clay. The Gall one just removes the rift from our state,
but the Clay one is much more involved because we have to upgrade
instances of the clad monad that are possibly in progress.
Specifically, since more input is possible than before, we must wrap any
in-progress instances of the monad in a function that handles the
potential new input from Jael. This temporarily preservers a copy of
the old kernel, but only until the current commit/merge/update has
completed.
The real solution for Clay is to factor out those IO-heavy instances to
userspace tapp/async/imp/threads, and if an upgrade happens in the
middle, you should simply restart them.
Fixes #1852
2019-10-24 07:26:38 +03:00
|
|
|
?. ?=(%breach -.public-keys-result.q.hin)
|
2019-07-27 06:43:07 +03:00
|
|
|
[~ ..^$]
|
|
|
|
=/ who who.public-keys-result.q.hin
|
|
|
|
?: =(our who)
|
|
|
|
[~ ..^$]
|
|
|
|
:: Cancel subscriptions
|
|
|
|
::
|
|
|
|
=/ foreign-desk=(unit rung)
|
|
|
|
(~(get by hoy.ruf) who)
|
|
|
|
?~ foreign-desk
|
|
|
|
[~ ..^$]
|
|
|
|
=/ cancel-ducts=(list duct)
|
|
|
|
%- zing ^- (list (list duct))
|
|
|
|
%+ turn ~(tap by rus.u.foreign-desk)
|
|
|
|
|= [=desk =rede]
|
|
|
|
^- (list duct) %- zing ^- (list (list duct))
|
|
|
|
%+ turn ~(tap by qyx.rede)
|
|
|
|
|= [=wove ducts=(set duct)]
|
|
|
|
:: ~& [%sunk-wove desk (print-wove wove) ducts]
|
|
|
|
~(tap in ducts)
|
|
|
|
=/ cancel-moves=(list move)
|
|
|
|
%+ turn cancel-ducts
|
|
|
|
|= =duct
|
|
|
|
[duct %slip %b %drip !>([%writ ~])]
|
|
|
|
:: Clear ford cache
|
|
|
|
::
|
|
|
|
=/ clear-ford-cache-moves=(list move)
|
|
|
|
:~ [hen %pass /clear/keep %f %keep 0 1]
|
|
|
|
[hen %pass /clear/wipe %f %wipe 100]
|
|
|
|
[hen %pass /clear/kep %f %keep 2.048 64]
|
|
|
|
==
|
|
|
|
:: delete local state of foreign desk
|
|
|
|
::
|
|
|
|
=. hoy.ruf (~(del by hoy.ruf) who)
|
|
|
|
[(weld clear-ford-cache-moves cancel-moves) ..^$]
|
|
|
|
::
|
2016-11-24 07:25:07 +03:00
|
|
|
?- -.+.q.hin
|
2019-07-27 06:43:07 +03:00
|
|
|
%public-keys ~|([%public-keys-raw tea] !!)
|
2019-05-02 04:21:32 +03:00
|
|
|
%init-clad
|
|
|
|
~|(%clad-not-real !!)
|
2017-06-13 04:04:38 +03:00
|
|
|
::
|
2019-05-11 00:51:37 +03:00
|
|
|
%crud
|
2016-11-24 07:25:07 +03:00
|
|
|
[[[hen %slip %d %flog +.q.hin] ~] ..^$]
|
|
|
|
::
|
2019-05-18 00:59:03 +03:00
|
|
|
%made ~|(%clay-raw-ford !!)
|
2019-05-11 00:51:37 +03:00
|
|
|
%mere
|
2018-03-19 06:54:47 +03:00
|
|
|
?: ?=(%& -.p.+.q.hin)
|
2016-11-24 07:25:07 +03:00
|
|
|
~& 'initial merge succeeded'
|
|
|
|
[~ ..^$]
|
|
|
|
~> %slog.
|
|
|
|
:^ 0 %rose [" " "[" "]"]
|
|
|
|
:^ leaf+"initial merge failed"
|
|
|
|
leaf+"my most sincere apologies"
|
|
|
|
>p.p.p.+.q.hin<
|
|
|
|
q.p.p.+.q.hin
|
|
|
|
[~ ..^$]
|
|
|
|
::
|
2019-05-11 00:51:37 +03:00
|
|
|
%note [[hen %give +.q.hin]~ ..^$]
|
|
|
|
%wake
|
2019-04-10 06:15:37 +03:00
|
|
|
:: TODO: handle behn errors
|
|
|
|
::
|
|
|
|
?^ error.q.hin
|
|
|
|
[[hen %slip %d %flog %crud %wake u.error.q.hin]~ ..^$]
|
|
|
|
::
|
2019-05-23 03:01:02 +03:00
|
|
|
?: ?=([%tyme @ @ ~] tea)
|
|
|
|
=/ her (slav %p i.t.tea)
|
|
|
|
=/ syd (slav %tas i.t.t.tea)
|
|
|
|
=^ mos ruf
|
|
|
|
=/ den ((de our now ski hen ruf) her syd)
|
|
|
|
abet:wake:den
|
|
|
|
[mos ..^$]
|
2019-02-09 06:18:38 +03:00
|
|
|
::
|
2019-01-18 08:37:34 +03:00
|
|
|
=^ queued cue.ruf ~(get to cue.ruf)
|
2018-09-06 02:05:23 +03:00
|
|
|
::
|
|
|
|
=/ queued-duct=duct -.queued
|
|
|
|
=/ queued-task=task:able +.queued
|
|
|
|
::
|
2019-03-13 15:04:54 +03:00
|
|
|
:: ~& :* %clay-waking
|
2019-03-08 08:27:07 +03:00
|
|
|
:: queued-duct
|
|
|
|
:: hen
|
|
|
|
:: ?~(cue.ruf /empty -:(need ~(top to cue.ruf)))
|
|
|
|
:: ==
|
2018-09-06 02:05:23 +03:00
|
|
|
~| [%mismatched-ducts %queued queued-duct %timer hen]
|
|
|
|
?> =(hen queued-duct)
|
|
|
|
::
|
2019-05-02 04:21:32 +03:00
|
|
|
(handle-task hen queued-task)
|
2016-11-24 07:25:07 +03:00
|
|
|
::
|
2019-06-29 02:43:52 +03:00
|
|
|
:: handled in the wire dispatcher
|
|
|
|
::
|
2019-07-29 09:37:49 +03:00
|
|
|
%boon !!
|
2019-08-28 06:12:56 +03:00
|
|
|
%lost !!
|
2019-06-29 02:43:52 +03:00
|
|
|
%writ !!
|
2016-11-24 07:25:07 +03:00
|
|
|
::
|
2019-06-29 02:43:52 +03:00
|
|
|
%done
|
|
|
|
?~ error=error.q.hin
|
2019-05-11 05:23:13 +03:00
|
|
|
[~ ..^$]
|
2019-10-30 23:23:37 +03:00
|
|
|
%- (slog >%clay-lost< >tag.u.error< tang.u.error)
|
2016-11-24 07:25:07 +03:00
|
|
|
[~ ..^$]
|
|
|
|
==
|
|
|
|
::
|
|
|
|
++ rant-to-rand
|
|
|
|
|= rant
|
|
|
|
^- rand
|
|
|
|
[p q [p q.q]:r]
|
|
|
|
::
|
|
|
|
++ mode-to-soba
|
|
|
|
|= {hat/(map path lobe) pax/path all/? mod/mode}
|
|
|
|
^- soba
|
|
|
|
%+ weld
|
|
|
|
^- (list (pair path miso))
|
|
|
|
?. all
|
|
|
|
~
|
|
|
|
=+ mad=(malt mod)
|
|
|
|
=+ len=(lent pax)
|
2019-12-18 03:48:08 +03:00
|
|
|
=/ descendants/(list path)
|
2016-11-24 07:25:07 +03:00
|
|
|
%+ turn
|
2017-02-13 23:43:18 +03:00
|
|
|
%+ skim ~(tap by hat)
|
2016-11-24 07:25:07 +03:00
|
|
|
|= {paf/path lob/lobe}
|
|
|
|
=(pax (scag len paf))
|
|
|
|
|= {paf/path lob/lobe}
|
|
|
|
(slag len paf)
|
|
|
|
%+ murn
|
|
|
|
descendants
|
|
|
|
|= pat/path
|
2018-03-19 07:18:20 +03:00
|
|
|
^- (unit (pair path {$del ~}))
|
2016-11-24 07:25:07 +03:00
|
|
|
?: (~(has by mad) pat)
|
|
|
|
~
|
|
|
|
`[(weld pax pat) %del ~]
|
|
|
|
^- (list (pair path miso))
|
|
|
|
%+ murn mod
|
|
|
|
|= {pat/path mim/(unit mime)}
|
|
|
|
^- (unit (pair path miso))
|
|
|
|
=+ paf=(weld pax pat)
|
|
|
|
?~ mim
|
|
|
|
=+ (~(get by hat) paf)
|
|
|
|
?~ -
|
|
|
|
~& [%deleting-already-gone pax pat]
|
|
|
|
~
|
|
|
|
`[paf %del ~]
|
|
|
|
=+ (~(get by hat) paf)
|
|
|
|
?~ -
|
|
|
|
`[paf %ins %mime -:!>(*mime) u.mim]
|
|
|
|
`[paf %mut %mime -:!>(*mime) u.mim]
|
|
|
|
--
|