Allow garbage-collection of no-longer-needed operations.
This commit is contained in:
parent
d67d490885
commit
eb27d6acc5
|
@ -11,6 +11,7 @@
|
|||
(struct file-being-edited (name) #:prefab)
|
||||
(struct proposed-op (p) #:prefab)
|
||||
(struct accepted-op (p) #:prefab)
|
||||
(struct client-seen-up-to (revision) #:prefab)
|
||||
|
||||
(define cmdline-port (make-parameter 5888))
|
||||
(define cmdline-filename (make-parameter "info.rkt"))
|
||||
|
@ -23,6 +24,17 @@
|
|||
""))))])
|
||||
(assert (extract-snapshot (state)))
|
||||
|
||||
(define/query-set client-seen-revs (client-seen-up-to $rev) rev)
|
||||
(let ((oldest-needed-rev #f))
|
||||
(begin/dataflow
|
||||
(define min-rev
|
||||
(or (for/fold [(min-rev #f)] [(rev (client-seen-revs))]
|
||||
(min (or min-rev rev) rev))
|
||||
(server-state-revision (state))))
|
||||
(when (not (equal? oldest-needed-rev min-rev))
|
||||
(set! oldest-needed-rev min-rev)
|
||||
(state (forget-operation-history (state) oldest-needed-rev)))))
|
||||
|
||||
(begin/dataflow
|
||||
(display-to-file (simple-document-text (server-state-document (state)))
|
||||
(cmdline-filename)
|
||||
|
@ -50,15 +62,21 @@
|
|||
(newline p)
|
||||
(send! (tcp-channel s c (get-output-bytes p))))
|
||||
|
||||
(field [seen-up-to 0])
|
||||
(assert (client-seen-up-to (seen-up-to)))
|
||||
|
||||
(on-start
|
||||
(output filename)
|
||||
(let-event [(asserted ($ snapshot (server-snapshot _ _)))]
|
||||
(output snapshot)
|
||||
(seen-up-to (server-snapshot-revision snapshot))
|
||||
(react (on (message (accepted-op $p))
|
||||
(output p)))))
|
||||
|
||||
(on (message (tcp-channel-line c s $line))
|
||||
(send! (proposed-op (deserialize (read (open-input-bytes line)))))))
|
||||
(match (deserialize (read (open-input-bytes line)))
|
||||
[(? number? n) (seen-up-to n)]
|
||||
[(? pending-operation? p) (send! (proposed-op p))])))
|
||||
|
||||
(module+ main
|
||||
(require racket/cmdline)
|
||||
|
|
Loading…
Reference in New Issue