2021-05-31 11:05:37 +00:00
|
|
|
#lang racket/base
|
2021-06-04 14:20:14 +00:00
|
|
|
;;; SPDX-License-Identifier: LGPL-3.0-or-later
|
2024-03-10 11:43:06 +00:00
|
|
|
;;; SPDX-FileCopyrightText: Copyright © 2016-2024 Tony Garnock-Jones <tonyg@leastfixedpoint.com>
|
2021-05-31 11:05:37 +00:00
|
|
|
|
|
|
|
|
(provide field?
|
|
|
|
|
(rename-out [make-field field])
|
|
|
|
|
field-name
|
|
|
|
|
field-id)
|
|
|
|
|
|
|
|
|
|
(require "dataflow.rkt")
|
|
|
|
|
(require "support/counter.rkt")
|
|
|
|
|
|
|
|
|
|
(struct field (name ;; Symbol
|
|
|
|
|
id ;; Nat
|
|
|
|
|
dataflow ;; Dataflow
|
|
|
|
|
[value #:mutable] ;; Any
|
|
|
|
|
)
|
|
|
|
|
#:methods gen:custom-write
|
|
|
|
|
[(define (write-proc f port mode)
|
2021-06-21 12:40:00 +00:00
|
|
|
(fprintf port "#<field:~a:~a:~s>" (field-id f) (field-name f) (field-value f)))]
|
2021-05-31 11:05:37 +00:00
|
|
|
#:property prop:procedure
|
|
|
|
|
(case-lambda
|
|
|
|
|
[(f)
|
|
|
|
|
(dataflow-record-observation! (field-dataflow f) f)
|
|
|
|
|
(field-value f)]
|
|
|
|
|
[(f new-value)
|
|
|
|
|
(when (not (equal? (field-value f) new-value))
|
|
|
|
|
(dataflow-record-damage! (field-dataflow f) f)
|
|
|
|
|
(set-field-value! f new-value))]))
|
|
|
|
|
|
|
|
|
|
(define generate-field-id (make-counter))
|
|
|
|
|
|
|
|
|
|
(define (make-field dataflow name initial-value)
|
|
|
|
|
(field name
|
|
|
|
|
(generate-field-id)
|
|
|
|
|
dataflow
|
|
|
|
|
initial-value))
|
