From e20f87adba4f4f278c668ca3ea2b6245931025b5 Mon Sep 17 00:00:00 2001
From: Sam Caldwell <samcaldwell@utexas.edu>
Date: Tue, 19 Jul 2016 17:49:45 -0400
Subject: [PATCH] Implement field/c using a struct rather than make-contract

Asumu suggested that using a struct with the contract property is
generally preferred.
---
 racket/syndicate/actor.rkt | 53 +++++++++++++++++++++++---------------
 1 file changed, 32 insertions(+), 21 deletions(-)

diff --git a/racket/syndicate/actor.rkt b/racket/syndicate/actor.rkt
index 546c36c..9c7d35a 100644
--- a/racket/syndicate/actor.rkt
+++ b/racket/syndicate/actor.rkt
@@ -112,27 +112,38 @@
     [() (wrap (field))]
     [(x) (field (guard x))]))
 
-(define (field/c ctc)
-  (let ([ctc (coerce-contract 'field/c ctc)])
-    (make-contract #:name (build-compound-type-name 'field/c ctc)
-                   #:first-order
-                   (lambda (f) (and (field-handle? f)
-                                    (ctc (f))))
-                   #:late-neg-projection
-                   (lambda (blame)
-                     (define proc (get/build-late-neg-projection ctc))
-                     (define blame/c (blame-add-context blame "the field of"))
-                     (define proj (proc (blame-swap blame/c)))
-                     (define proj-pos (lambda (x) (proj x (blame-positive blame))))
-                     (lambda (f neg-party)
-                       (define proj-neg (lambda (x) (proj x neg-party)))
-                       (cond
-                         [(field-handle? f)
-                          (make-field-proxy f proj-neg proj-pos)]
-                         [else (raise-blame-error blame/c
-                                                  #:missing-party neg-party
-                                                  f
-                                                  '(expected: "a field"))]))))))
+(define/subexpression-pos-prop (field/c ctc)
+  (make-field/c (coerce-contract 'field/c ctc)))
+
+(define-struct field/c (ctc)
+  #:property prop:custom-write custom-write-property-proc
+  #:omit-define-syntaxes
+  #:property prop:contract
+  (build-contract-property
+   #:name
+   (lambda (ctc) (build-compound-type-name 'field/c (field/c-ctc ctc)))
+   #:first-order
+   (lambda (ctc)
+     (let ([ctc (field/c-ctc ctc)])
+       (lambda (f) (and (field-handle? f)
+                        (ctc (f))))))
+   #:late-neg-projection
+   (lambda (ctc)
+     (let ([ctc (field/c-ctc ctc)])
+       (lambda (blame)
+         (define proc (get/build-late-neg-projection ctc))
+         (define blame/c (blame-add-context blame "the field of"))
+         (define proj (proc (blame-swap blame/c)))
+         (define proj-pos (lambda (x) (proj x (blame-positive blame))))
+         (lambda (f neg-party)
+           (define proj-neg (lambda (x) (proj x neg-party)))
+           (cond
+             [(field-handle? f)
+              (make-field-proxy f proj-neg proj-pos)]
+             [else (raise-blame-error blame/c
+                                      #:missing-party neg-party
+                                      f
+                                      '(expected: "a field"))])))))))
 
 (struct actor-state (mux ;; Mux
                      facets ;; (Hash FID Facet)