Add FIFO build cache. Tests pass

gen/ford-turbo.hoon

@@ -7429,17 +7429,37 @@
   |=  [ford-gate=_ford-gate ship=@p]
   ^-  tang
   ::
+  =^  results1  ford-gate
+    %-  test-ford-call  :*
+      ford-gate
+      now=~1234.5.6
+      scry=scry-is-forbidden
+      call-args=[duct=~[/empty] type=~ [%keep 0 0]]
+      expected-moves=~
+    ==
+  ::
   =/  ford  *ford-gate
   =/  state  (~(got by state-by-ship.ax.+>+<.ford) ship)
-  =.  compiler-cache.state  compiler-cache:*ford-state:ford
   ::
-  ?:  =(*ford-state:ford state)
+  =/  default-state  *ford-state:ford
+  ::
+  =.  max-size.compiler-cache.state     max-size.compiler-cache.default-state
+  =.  max-size.queue.build-cache.state  max-size.queue.build-cache.default-state
+  =.  next-anchor-id.build-cache.state  0
+  ::
+  %+  welp  results1
+  ::
+  ?:  =(default-state state)
     ~
   ::
   =/  build-state=(list tank)
-    %+  turn  ~(tap in ~(key by builds.state))
+    %-  zing
-    |=  build=build:ford
+    %+  turn  ~(tap by builds.state)
-    [%leaf (build-to-tape:ford build)]
+    |=  [build=build:ford build-status=build-status:ford]
+    :~  [%leaf (build-to-tape:ford build)]
+        [%leaf "requesters: {<requesters.build-status>}"]
+        [%leaf "clients: {<~(tap in ~(key by clients.build-status))>}"]
+    ==
   ::
   =/  braces  [[' ' ' ' ~] ['{' ~] ['}' ~]]
   ::

sys/vane/ford.hoon

@@ -82,6 +82,14 @@
         max-size=_2.048
         depth=_1
     ==
+::  +capped-queue: a +qeu with a maximum number of entries
+::
+++  capped-queue
+  |*  item-type=mold
+  $:  queue=(qeu item-type)
+      size=@ud
+      max-size=_64
+  ==
 --
 |%
 ::  +by-clock: interface core for a cache using the clock replacement algorithm
@@ -212,6 +220,56 @@
       size    0
     ==
   --
+::  +to-capped-queue: interface door for +capped-queue
+::
+++  to-capped-queue
+  |*  item-type=mold
+  |_  queue=(capped-queue item-type)
+  ::  +put: enqueue :item, possibly popping and producing an old item
+  ::
+  ++  put
+    |=  item=item-type
+    ^-  [(unit item-type) _queue]
+    ::   are we already at max capacity?
+    ::
+    ?.  =(size.queue max-size.queue)
+      ::  we're below max capacity, so push and increment size
+      ::
+      =.  queue.queue  (~(put to queue.queue) item)
+      =.  size.queue   +(size.queue)
+      ::
+      [~ queue]
+    ::  we're at max capacity, so pop before pushing; size is unchanged
+    ::
+    =^  oldest  queue.queue  ~(get to queue.queue)
+    =.  queue.queue          (~(put to queue.queue) item)
+    ::
+    [`oldest queue]
+  ::  +get: pop an item off the queue, adjusting size
+  ::
+  ++  get
+    ^-  [item-type _queue]
+    ::
+    =.  size.queue           (dec size.queue)
+    =^  oldest  queue.queue  ~(get to queue.queue)
+    ::
+    [oldest queue]
+  ::  change the :max-size of the queue, popping items if necessary
+  ::
+  ++  resize
+    =|  pops=(list item-type)
+    |=  new-max=@ud
+    ^+  [pops queue]
+    ::  we're not overfull, so no need to pop off more items
+    ::
+    ?:  (gte new-max size.queue)
+      [(flop pops) queue(max-size new-max)]
+    ::  we're above capacity; pop an item off and recurse
+    ::
+    =^  oldest  queue  get
+    ::
+    $(pops [oldest pops])
+  --
 --
 |%
 ::  +axle: overall ford state
@@ -267,9 +325,16 @@
       ::  pending-subscriptions: outgoing subscriptions on live resources
       ::
       pending-subscriptions=(request-tracker subscription)
-      ::  build-cache: fifo queue of previous completed ducts.
+      ::  build-cache: fifo queue of completed root builds
       ::
-      ::  build-cache=(qeu duct)
+      $=  build-cache
+      $:  ::  next-anchor-id: incrementing identifier for cache anchors
+          ::
+          next-anchor-id=@ud
+          ::  queue: fifo queue of root builds identified by anchor id
+          ::
+          queue=(capped-queue build-cache-key)
+      ==
       ::  compiler-cache: clock based cache of build results
       ::
       compiler-cache=(clock compiler-cache-key build-result)
@@ -473,6 +538,16 @@
       [%slim subject-type=type formula=hoon]
       [%slit gate=type sample=type]
   ==
+::  +build-cache-key: key for the fifo cache of completed build trees
+::
++=  build-cache-key
+  $:  ::  id: incrementing identifier for an +anchor
+      ::
+      id=@ud
+      ::  root-build: the root build associated with this anchor
+      ::
+      root-build=build
+  ==
 ::  +build-receipt: result of running +make
 ::
 ::    A +build-receipt contains all information necessary to perform the
@@ -1149,7 +1224,6 @@
     ::
     =<  finalize
     ::
-    ::  ~&  [%rebuild subscription=subscription pending-subscriptions.state]
     =.  pending-subscriptions.state
       +:(del-request pending-subscriptions.state subscription duct)
     ::
@@ -1311,15 +1385,28 @@
   ::
   ++  keep
     ~/  %keep
-    |=  max=@ud
+    |=  [compiler-cache-size=@ud build-cache-size=@ud]
     ^+  state
+    ::  pop old builds out of :build-cache and remove their cache anchors
+    ::
+    =^  pops  queue.build-cache.state
+      %.  build-cache-size
+      ~(resize (to-capped-queue build-cache-key) queue.build-cache.state)
+    ::
+    =.  state
+      |-  ^+  state
+      ?~  pops  state
+      ::
+      =.  state  (remove-anchor-from-root root-build.i.pops [%cache id.i.pops])
+      ::
+      $(pops t.pops)
     ::
     %_    state
         compiler-cache
       %-  %~  resize
               (by-clock compiler-cache-key build-result)
               compiler-cache.state
-      max
+      compiler-cache-size
     ==
   ::  +cancel: cancel a build
   ::
@@ -1350,7 +1437,7 @@
       =/  root-build=build  [in-progress.live root-schematic]:u.duct-status
       ::
       =.  ..execute  (cancel-scrys root-build)
-      =.  state  (remove-duct-from-root root-build)
+      =.  state  (remove-anchor-from-root root-build [%duct duct])
       ..execute
     ::  if the duct was live and has an unfinished build, cancel it
     ::
@@ -1359,7 +1446,7 @@
       =/  root-build=build  [u.in-progress.live root-schematic]:u.duct-status
       ::
       =.  ..execute  (cancel-scrys root-build)
-      =.  state  (remove-duct-from-root root-build)
+      =.  state  (remove-anchor-from-root root-build [%duct duct])
       ..execute
     ::  if there is no completed build for the live duct, we're done
     ::
@@ -1369,7 +1456,7 @@
     ::
     =/  root-build=build  [date.u.last-sent root-schematic.u.duct-status]
     ::
-    =.  state  (remove-duct-from-root root-build)
+    =.  state  (remove-anchor-from-root root-build [%duct duct])
     ::
     ?~  subscription.u.last-sent
       ..execute
@@ -1388,31 +1475,113 @@
     =.  ..execute  (cancel-scry-request i.blocked-sub-scrys)
     ::
     $(blocked-sub-scrys t.blocked-sub-scrys)
-  ::  +remove-duct-from-root: remove :duct from a build tree
+  ::  +move-root-to-cache: replace :duct with a %cache anchor in :build's tree
   ::
-  ++  remove-duct-from-root
+  ++  move-root-to-cache
-    ~/  %remove-duct-from-root
+    ~/  %move-root-to-cache
     |=  =build
     ^+  state
-    ::  ~&  [%remove-duct-from-root (build-to-tape build) duct]
+    ::  obtain the new cache id and increment the :next-anchor-id in the state
+    ::
+    =^  new-id  next-anchor-id.build-cache.state
+      =/  id=@ud  next-anchor-id.build-cache.state
+      [id +(id)]
+    ::  replace the requester in the root build
     ::
     =.  builds.state
       %+  ~(jab by builds.state)  build
       |=  =build-status
-      build-status(requesters (~(del in requesters.build-status) [%duct duct]))
+      %_    build-status
+          requesters
+        =-  (~(del in -) [%duct duct])
+        =-  (~(put in -) [%cache new-id])
+        requesters.build-status
+      ==
+    ::  enqueue :build into cache, possibly popping and deleting a stale build
     ::
-    =.  builds.state  (remove-duct-from-subs build)
+    =^  oldest  queue.build-cache.state
+      %.  [new-id build]
+      ~(put (to-capped-queue build-cache-key) queue.build-cache.state)
+    ::
+    =?    state
+        ?=(^ oldest)
+      (remove-anchor-from-root root-build.u.oldest [%cache id.u.oldest])
+    ::  recursively replace :clients in :build and descendants
+    ::
+    |-  ^+  state
+    ::
+    =/  client-status=build-status  (~(got by builds.state) build)
+    =/  subs=(list ^build)  ~(tap in ~(key by subs.client-status))
+    ::
+    |-  ^+  state
+    ?~  subs  state
+    ::
+    =.  builds.state
+      %+  ~(jab by builds.state)  i.subs
+      |=  =build-status
+      %_    build-status
+          clients
+        =/  old-clients-on-duct  (~(get ju clients.build-status) [%duct duct])
+        ::
+        =-  (~(del by -) [%duct duct])
+        =-  (~(put by -) [%cache new-id] old-clients-on-duct)
+        clients.build-status
+      ==
+    ::
+    =.  state  ^$(build i.subs)
+    ::
+    $(subs t.subs)
+  ::  +remove-anchor-from-root: remove :anchor from :build's tree
+  ::
+  ++  remove-anchor-from-root
+    ~/  %remove-anchor-from-root
+    |=  [=build =anchor]
+    ^+  state
+    ::
+    =.  builds.state
+      %+  ~(jab by builds.state)  build
+      |=  =build-status
+      build-status(requesters (~(del in requesters.build-status) anchor))
+    ::
+    =.  builds.state  (remove-anchor-from-subs build anchor)
     ::
     (cleanup build)
-  ::  +add-ducts-to-build-subs: for each sub, add all of :build's ducts
+  ::  +remove-anchor-from-subs: recursively remove :anchor from sub-builds
   ::
-  ++  add-ducts-to-build-subs
+  ++  remove-anchor-from-subs
-    ~/  %add-ducts-to-build-subs
+    ~/  %remove-anchor-from-subs
+    |=  [=build =anchor]
+    ^+  builds.state
+    ::
+    =/  =build-status  (~(got by builds.state) build)
+    =/  subs=(list ^build)  ~(tap in ~(key by subs.build-status))
+    =/  client=^build  build
+    ::
+    |-  ^+  builds.state
+    ?~  subs  builds.state
+    ::
+    =/  sub-status=^build-status  (~(got by builds.state) i.subs)
+    ::
+    =.  clients.sub-status
+      (~(del ju clients.sub-status) anchor client)
+    ::
+    =.  builds.state  (~(put by builds.state) i.subs sub-status)
+    ::
+    =?  builds.state  !(~(has by clients.sub-status) anchor)
+      ::
+      ^$(build i.subs)
+    ::
+    $(subs t.subs)
+  ::  +add-anchors-to-build-subs: for each sub, add all of :build's anchors
+  ::
+  ++  add-anchors-to-build-subs
+    ~/  %add-anchors-to-build-subs
     |=  =build
     ^+  state
     ::
     =/  =build-status  (~(got by builds.state) build)
-    =/  new-anchors  ~(tap in (~(put in ~(key by clients.build-status)) [%duct duct]))
+    =/  new-anchors
+      ~(tap in (~(put in ~(key by clients.build-status)) [%duct duct]))
     =/  subs  ~(tap in ~(key by subs.build-status))
     ::
     =.  state
@@ -1459,33 +1628,6 @@
     =?  builds.state  !already-had-anchor  ^$(build i.subs)
     ::
     $(subs t.subs)
-  ::  +remove-duct-from-subs: recursively remove duct from sub-builds
-  ::
-  ++  remove-duct-from-subs
-    ~/  %remove-duct-from-subs
-    |=  =build
-    ^+  builds.state
-    ::  ~&  [%remove-duct-from-subs (build-to-tape build)]
-    ::
-    =/  =build-status  (~(got by builds.state) build)
-    =/  subs=(list ^build)  ~(tap in ~(key by subs.build-status))
-    =/  client=^build  build
-    ::
-    |-  ^+  builds.state
-    ?~  subs  builds.state
-    ::
-    =/  sub-status=^build-status  (~(got by builds.state) i.subs)
-    ::
-    =.  clients.sub-status
-      (~(del ju clients.sub-status) [%duct duct] client)
-    ::
-    =.  builds.state  (~(put by builds.state) i.subs sub-status)
-    ::
-    =?  builds.state  !(~(has by clients.sub-status) [%duct duct])
-      ::
-      ^$(build i.subs)
-    ::
-    $(subs t.subs)
   ::  +copy-build-tree-as-provisional: prepopulate new live build
   ::
   ::    Make a provisional copy of the completed old root build tree at the
@@ -1640,7 +1782,6 @@
     ++  gather-build
       |=  =build
       ^+  ..execute
-      ::  ~&  [%gather-build duct (build-to-tape build)]
       ~|  [%duct duct]
       =/  duct-status  (~(got by ducts.state) duct)
       ::  if we already have a result for this build, don't rerun the build
@@ -1656,7 +1797,7 @@
       ::
       =/  =build-status  (~(got by builds.state) build)
       ?:  ?=(%blocked -.state.build-status)
-        =.  state  (add-ducts-to-build-subs build)
+        =.  state  (add-anchors-to-build-subs build)
         ::
         =/  sub-scrys=(list scry-request)
           ~(tap in (collect-blocked-sub-scrys build))
@@ -1765,7 +1906,7 @@
       =.  builds.state
         (add-subs-to-client build un-stored-new-subs [verified=%.n blocked=%.y])
       ::
-      =.  state  (add-ducts-to-build-subs build)
+      =.  state  (add-anchors-to-build-subs build)
       ::
       ?^  un-stored-new-subs
         ::  enqueue incomplete sub-builds to be promoted or run
@@ -1824,7 +1965,6 @@
     ++  promote-build
       |=  [old-build=build new-date=@da new-subs=(list build)]
       ^+  ..execute
-      ::  ~&  [%promote-build (build-to-tape old-build) new-date]
       ::  grab the previous result, freshening the cache
       ::
       =^  old-build-record  builds.state  (access-build-record old-build)
@@ -1954,7 +2094,7 @@
           [sub [verified=& blocked]]
         ==
       ::
-      =.  state  (add-ducts-to-build-subs client)
+      =.  state  (add-anchors-to-build-subs client)
       ::
       |-  ^+  state
       ?~  sub-builds  state
@@ -2921,7 +3061,6 @@
       ::
       ?~  q.parsed
         =/  =path  (rail-to-path source-rail)
-        ~&  [%fail path]
         %-  return-error
         :-  :-  %leaf
             %+  weld  "ford: %hood: syntax error at "
@@ -4570,7 +4709,6 @@
         (wrap-error call-result)
       ::
       =/  product=vase  vase.u.call-result
-      ~&  [%call-result u.call-result]
       ::  +grab might produce the wrong type
       ::
       ?.  (~(nest ut p.mark-sample) | p.product)
@@ -5321,7 +5459,7 @@
     ?-    -.live.duct-status
         %once
       =.  ducts.state  (~(del by ducts.state) duct)
-      =.  state  (remove-duct-from-root build)
+      =.  state  (move-root-to-cache build)
       ::
       ..execute
     ::
@@ -5332,7 +5470,7 @@
       =?  state  ?=(^ last-sent.live.duct-status)
         =/  old-build=^build  build(date date.u.last-sent.live.duct-status)
         ::
-        (remove-duct-from-root old-build)
+        (move-root-to-cache old-build)
       ::
       =/  resource-list=(list [=disc resources=(set resource)])
         ~(tap by resources)
@@ -5350,8 +5488,10 @@
             [%leaf "tried to subscribe to multiple discs:"]
             [%leaf "{<resource-list>}"]
           ==
+        ::  delete this instead of caching it, since it wasn't right
+        ::
         =.  ducts.state  (~(del by ducts.state) duct)
-        =.  state  (remove-duct-from-root build)
+        =.  state  (remove-anchor-from-root build [%duct duct])
         ..execute
       ::
       =/  subscription=(unit subscription)
@@ -5419,6 +5559,8 @@
         $(orphans t.orphans)
       ==
     ::
+    =/  =anchor  [%duct duct]
+    ::
     |-  ^+  ..execute
     ?~  orphans  ..execute
     ::  remove link to :build in :i.orphan's +build-status
@@ -5427,14 +5569,14 @@
       %+  update-build-status  i.orphans
       |=  orphan-status=_build-status
       %_  orphan-status
-        clients  (~(del ju clients.orphan-status) [%duct duct] build)
+        clients  (~(del ju clients.orphan-status) anchor build)
       ==
     ::
-    ?:  (~(has by clients.orphan-status) [%duct duct])
+    ?:  (~(has by clients.orphan-status) anchor)
       $(orphans t.orphans)
     ::  :build was the last client on this duct so remove it
     ::
-    =.  builds.state  (remove-duct-from-subs i.orphans)
+    =.  builds.state  (remove-anchor-from-subs i.orphans anchor)
     =.  state  (cleanup i.orphans)
     $(orphans t.orphans)
   ::  +access-build-record: access a +build-record, updating :last-accessed
@@ -5742,7 +5884,7 @@
       ::
       =.  state-by-ship.ax
         %+  ~(put by state-by-ship.ax)  ship
-        (keep:(per-event event-args) max.task)
+        (keep:(per-event event-args) [compiler-cache build-cache]:task)
       ::
       $(ship-states t.ship-states)
     ::
@@ -5838,7 +5980,6 @@
       =+  [ship desk date]=(raid:wired t.t.wire ~[%p %tas %da])
       =/  disc  [ship desk]
       ::
-      ::  ~&  [%pending-subscriptions pending-subscriptions.ship-state]
       =/  =subscription
         ~|  [%ford-take-bad-clay-sub wire=wire duct=duct]
         =/  =duct-status  (~(got by ducts.ship-state) duct)
@@ -5846,12 +5987,10 @@
         ?>  ?=(^ last-sent.live.duct-status)
         ?>  ?=(^ subscription.u.last-sent.live.duct-status)
         u.subscription.u.last-sent.live.duct-status
-      ::  ~&  [%subscription subscription]
       ::
       =/  ducts=(list ^duct)
         ~|  [%ford-take-missing-subscription subscription]
         (get-request-ducts pending-subscriptions.ship-state subscription)
-      ::  ~&  [%ducts-for-clay-sub ducts]
       ::
       =|  moves=(list move)
       |-  ^+  [moves ship-state]
@@ -5886,7 +6025,6 @@
       =/  ducts=(list ^duct)
         ~|  [%ford-take-missing-scry-request scry-request]
         (get-request-ducts pending-scrys.ship-state scry-request)
-      ::  ~&  [%ducts-for-scrys ducts]
       ::
       =|  moves=(list move)
       |-  ^+  [moves ship-state]

sys/zuse.hoon

@@ -828,9 +828,9 @@
               ::
               =schematic
           ==
-          ::  %keep: resize cache to :max entries
+          ::  %keep: reset cache sizes
           ::
-          [%keep max=@ud]
+          [%keep compiler-cache=@ud build-cache=@ud]
           ::  %kill: stop a build; send on same duct as original %build request
           ::
           $:  %kill