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 file-being-edited (name) #:prefab)
|
||||||
(struct proposed-op (p) #:prefab)
|
(struct proposed-op (p) #:prefab)
|
||||||
(struct accepted-op (p) #:prefab)
|
(struct accepted-op (p) #:prefab)
|
||||||
|
(struct client-seen-up-to (revision) #:prefab)
|
||||||
|
|
||||||
(define cmdline-port (make-parameter 5888))
|
(define cmdline-port (make-parameter 5888))
|
||||||
(define cmdline-filename (make-parameter "info.rkt"))
|
(define cmdline-filename (make-parameter "info.rkt"))
|
||||||
|
@ -23,6 +24,17 @@
|
||||||
""))))])
|
""))))])
|
||||||
(assert (extract-snapshot (state)))
|
(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
|
(begin/dataflow
|
||||||
(display-to-file (simple-document-text (server-state-document (state)))
|
(display-to-file (simple-document-text (server-state-document (state)))
|
||||||
(cmdline-filename)
|
(cmdline-filename)
|
||||||
|
@ -50,15 +62,21 @@
|
||||||
(newline p)
|
(newline p)
|
||||||
(send! (tcp-channel s c (get-output-bytes 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
|
(on-start
|
||||||
(output filename)
|
(output filename)
|
||||||
(let-event [(asserted ($ snapshot (server-snapshot _ _)))]
|
(let-event [(asserted ($ snapshot (server-snapshot _ _)))]
|
||||||
(output snapshot)
|
(output snapshot)
|
||||||
|
(seen-up-to (server-snapshot-revision snapshot))
|
||||||
(react (on (message (accepted-op $p))
|
(react (on (message (accepted-op $p))
|
||||||
(output p)))))
|
(output p)))))
|
||||||
|
|
||||||
(on (message (tcp-channel-line c s $line))
|
(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
|
(module+ main
|
||||||
(require racket/cmdline)
|
(require racket/cmdline)
|
||||||
|
|
Loading…
Reference in New Issue