Fixed 3D syntax issues by using prefabs.

graph-info.hl.rkt

@@ -24,11 +24,63 @@ We define here the compile-time metadata describing a graph type.
           [root-node identifier?]
           [node-order (listof identifier?)]
           [nodes (hash/c symbol? node-info? #:immutable #t)]
-          [invariants (set/c invariant-info? #:kind 'immutable)])
+          [invariants (equal-hash-set/c invariant-info? #:kind 'immutable)])
-         #:transparent
+         #:prefab)]
-         #:methods gen:custom-write
+
-         [(define write-proc (struct-printer 'graph-info))]
+Since sets created with @racket[set] cannot be used within syntax objects
-         #:property prop:custom-print-quotable 'never)]
+(they cannot be marshalled into compiled code), we fake sets using hashes with
+empty values:
+
+@chunk[<hash-set/c>
+       (provide hash-set/c)
+       (define/contract (hash-set/c elem/c
+                                    #:kind [kind 'dont-care]
+                                    #:cmp [cmp 'dont-care])
+         (->* (chaperone-contract?)
+              (#:kind (or/c 'dont-care 'immutable 'mutable
+                            'weak 'mutable-or-weak)
+               #:cmp (or/c 'dont-care 'equal 'eqv 'eq))
+              contract?)
+         (define immutable
+           (case kind
+             [(immutable)       #t]
+             [(dont-care)       'dont-care]
+             [else              #f]))
+         (define h              (hash/c elem/c
+                                        null?
+                                        #:immutable immutable))
+         (define cmp-contracts
+           (case cmp
+             [(dont-care)       empty]
+             [(equal)           (list hash-equal?)]
+             [(eqv)             (list hash-eqv?)]
+             [(eq)              (list hash-eq?)]))
+         (define weak-contracts
+           (case kind
+             [(weak)            (list hash-weak?)]
+             ;; This is redundant as the mutable check is already included above
+             [(mutable-or-weak) (list (or/c hash-weak? (not/c immutable?)))]
+             [(dont-care)       empty]
+             [else              (list (not/c hash-weak?))]))
+         (if (empty? (append cmp-contracts weak-contracts))
+             h
+             (apply and/c (append (list h) cmp-contracts weak-contracts))))]
+
+@chunk[<hash-set/c>
+       (provide equal-hash-set/c)
+       (define/contract (equal-hash-set/c elem/c
+                                          #:kind [kind 'dont-care])
+         (->* (chaperone-contract?)
+              (#:kind (or/c 'dont-care 'immutable 'mutable
+                            'weak 'mutable-or-weak))
+              contract?)
+         (hash-set/c elem/c #:kind kind #:cmp 'equal))]
+
+@chunk[<hash-set/c>
+       (provide list->equal-hash-set)
+       (define/contract (list->equal-hash-set l)
+         (-> (listof any/c) (equal-hash-set/c any/c #:kind 'immutable))
+         (make-immutable-hash (map (λ (v) (cons v null)) l)))]
 
 @section{Graph builder information}
 
@@ -39,16 +91,14 @@ We define here the compile-time metadata describing a graph type.
           [root-node identifier?]
           [node-order (listof identifier?)]
           [nodes (hash/c symbol? node-info? #:immutable #t)]
-          [invariants (set/c invariant-info? #:kind 'immutable)])
+          [invariants (equal-hash-set/c invariant-info? #:kind 'immutable)])
          ([multi-constructor identifier?]
           [root-mapping identifier?]
           [mapping-order (listof identifier?)]
           [mappings (hash/c symbol? mapping-info? #:immutable #t)]
-          [dependent-invariants (set/c dependent-invariant-info?)])
+          [dependent-invariants (equal-hash-set/c dependent-invariant-info?
-         #:transparent
+                                                  #:kind 'immutable)])
-         #:methods gen:custom-write
+         #:prefab)]
-         [(define write-proc (struct-printer 'graph-builder-info))]
-         #:property prop:custom-print-quotable 'never)]
 
 @section{Node information}
 
@@ -60,10 +110,7 @@ We define here the compile-time metadata describing a graph type.
           [promise-type identifier?]
           [make-incomplete-type identifier?]
           [incomplete-type identifier?])
-         #:transparent
+         #:prefab)]
-         #:methods gen:custom-write
-         [(define write-proc (struct-printer 'node-info))]
-         #:property prop:custom-print-quotable 'never)]
 
 @section{Field information}
 
@@ -72,10 +119,7 @@ A field has a type.
 @chunk[<field-info>
        (struct+/contract field-info
          ([type identifier?])
-         #:transparent
+         #:prefab)]
-         #:methods gen:custom-write
-         [(define write-proc (struct-printer 'field-info))]
-         #:property prop:custom-print-quotable 'never)]
 
 @;[incomplete-type identifier?]
 
@@ -85,10 +129,7 @@ A field has a type.
        (struct+/contract invariant-info
          ([predicate identifier?] ; (→ RootNode Boolean : +witness-type)
           [witness-type identifier?])
-         #:transparent
+         #:prefab)]
-         #:methods gen:custom-write
-         [(define write-proc (struct-printer 'invariant-info))]
-         #:property prop:custom-print-quotable 'never)]
 
 @section{Dependent invariant information}
 
@@ -100,10 +141,7 @@ which relate the old and the new graph in a graph transformation.
        (struct+/contract dependent-invariant-info
          ([checker identifier?] ; (→ RootMappingArguments… NewGraphRoot Boolean)
           [name identifier?])
-         #:transparent
+         #:prefab)]
-         #:methods gen:custom-write
-         [(define write-proc (struct-printer 'dependent-invariant-info))]
-         #:property prop:custom-print-quotable 'never)]
 
 @section{Mapping information}
 
@@ -113,10 +151,7 @@ which relate the old and the new graph in a graph transformation.
           [with-promises-type identifier?]
           [make-placeholder-type identifier?]
           [placeholder-type identifier?])
-         #:transparent
+         #:prefab)]
-         #:methods gen:custom-write
-         [(define write-proc (struct-printer 'mapping-info))]
-         #:property prop:custom-print-quotable 'never)]
 
 @section{Printing}
 
@@ -191,7 +226,9 @@ data.
                 mzlib/pconvert
                 (for-syntax phc-toolkit/untyped
                             syntax/parse
-                            syntax/parse/experimental/template))
+                            syntax/parse/experimental/template
+                            racket/syntax))
+       
        (define-syntax/parse
            (struct+/contract name {~optional parent}
              {~optional ([parent-field parent-contract] ...)}
@@ -203,19 +240,28 @@ data.
                                  _)
                          (~maybe #:property
                                  {~literal prop:custom-print-quotable}
-                                 _))))
+                                 _)))
+             {~optional {~and prefab #:prefab}})
+         #:with name/c (format-id #'name "~a/c" #'name)
          (quasisyntax/top-loc this-syntax
            #,(template
               (begin
                 (struct name (?? parent) (field ...)
                   (?? transparent)
-                  methods+props ...)
+                  methods+props ...
-                (provide (contract-out (struct (?? (name parent) name)
+                  (?? prefab))
+                (define name/c
+                  (struct/c name
+                            (?? (?@ parent-contract ...))
+                            contract ...))
+                (provide name/c
+                         (contract-out (struct (?? (name parent) name)
                                          ((?? (?@ [parent-field parent-contract]
                                                   ...))
                                           [field contract]
                                           ...))))))))
-       
+
+       <hash-set/c>
        <printer>
 
        <field-info>

graph-type.hl.rkt

@@ -44,7 +44,7 @@
                          (stx-map (λ/syntax-case (nodeᵢ [fieldᵢⱼ τᵢⱼ] …) ()
                                     <node-info>)
                                   #'([nodeᵢ [fieldᵢⱼ τᵢⱼ] …] …))))
-                   (list->set
+                   (list->equal-hash-set
                     (append
                      (stx-map (λ/syntax-case (op a b) () <invariant-info-op>)
                               #'([op a b] …))