graph-info.hl.rkt (13278B)
1 #lang hyper-literate racket #:no-auto-require 2 3 @require[scribble-math 4 scribble-enhanced/doc 5 "notations.rkt" 6 (for-label racket)] 7 8 @title[#:style (with-html5 manual-doc-style) 9 #:tag "graph-info" 10 #:tag-prefix "phc-graph/graph-info"]{Compile-time graph metadata} 11 12 @(chunks-toc-prefix 13 '("(lib phc-graph/scribblings/phc-graph-implementation.scrbl)" 14 "phc-graph/graph-info")) 15 16 We define here the compile-time metadata describing a graph type. 17 18 @section{Graph type information} 19 20 The type of a graph is actually the type of its constituent nodes. The node 21 types may be polymorphic in the @racket[_tvars] type variables. The root node 22 name and the order of the nodes are purely indicative here, as a reference to 23 any node in the graph instance would be indistinguishable from a graph rooted 24 in that node type. 25 26 The @racket[_invariants] are not enforced by the node types. Instead, the node 27 types just include the invariant type as a witness (inside the @racket[raw] 28 field). The invariant is enforced either by construction, or with a run-time 29 check performed during the graph creation. 30 31 @chunk[<graph-info> 32 (struct+/contract graph-info 33 ([name identifier?] 34 [tvars (listof identifier?)] 35 [root-node identifier?] 36 [node-order (listof identifier?)] 37 [nodes (hash/c symbol? node-info? #:immutable #t)] 38 [invariants (set/c invariant-info? #:kind 'immutable #:cmp 'equal)]) 39 #:transparent 40 #:methods gen:custom-write 41 [(define write-proc (struct-printer 'graph-info))] 42 #:property prop:custom-print-quotable 'never)] 43 44 @;{ 45 Since sets created with @racket[set] cannot be used within syntax objects 46 (they cannot be marshalled into compiled code), we fake sets using hashes with 47 empty values: 48 49 @chunk[<hash-set/c> 50 (provide hash-set/c) 51 (define/contract (hash-set/c elem/c 52 #:kind [kind 'dont-care] 53 #:cmp [cmp 'dont-care]) 54 (->* (chaperone-contract?) 55 (#:kind (or/c 'dont-care 'immutable 'mutable 56 'weak 'mutable-or-weak) 57 #:cmp (or/c 'dont-care 'equal 'eqv 'eq)) 58 contract?) 59 (define immutable 60 (case kind 61 [(immutable) #t] 62 [(dont-care) 'dont-care] 63 [else #f])) 64 (define h (hash/c elem/c 65 null? 66 #:immutable immutable)) 67 (define cmp-contracts 68 (case cmp 69 [(dont-care) empty] 70 [(equal) (list hash-equal?)] 71 [(eqv) (list hash-eqv?)] 72 [(eq) (list hash-eq?)])) 73 (define weak-contracts 74 (case kind 75 [(weak) (list hash-weak?)] 76 ;; This is redundant: the mutable check is already included above 77 [(mutable-or-weak) (list (or/c hash-weak? (not/c immutable?)))] 78 [(dont-care) empty] 79 [else (list (not/c hash-weak?))])) 80 (if (empty? (append cmp-contracts weak-contracts)) 81 h 82 (apply and/c (append (list h) cmp-contracts weak-contracts))))] 83 84 @chunk[<hash-set/c> 85 (provide equal-hash-set/c) 86 (define/contract (equal-hash-set/c elem/c 87 #:kind [kind 'dont-care]) 88 (->* (chaperone-contract?) 89 (#:kind (or/c 'dont-care 'immutable 'mutable 90 'weak 'mutable-or-weak)) 91 contract?) 92 (hash-set/c elem/c #:kind kind #:cmp 'equal))] 93 94 @chunk[<hash-set/c> 95 (provide list->equal-hash-set) 96 (define/contract (list->equal-hash-set l) 97 (-> (listof any/c) (equal-hash-set/c any/c #:kind 'immutable)) 98 (make-immutable-hash (map (λ (v) (cons v null)) l)))] 99 } 100 101 @section{Graph builder information} 102 103 The information about a graph type is valid regardless of how the graph 104 instances are constructed, and is therefore rather succinct. 105 106 The @racket[graph-builder-info] @racket[struct] extends this with meaningful 107 information about graph transformations. Two transformations which have the 108 same output graph type may use different sets of mapping functions. 109 Furthermore, the @racket[_dependent-invariants] are invariants relating the 110 input and output of a graph transformation. 111 112 The @racket[_multi-constructor] identifier refers to a function which takes 113 @${n} lists of lists of mapping argument tuples, and returns @${n} lists of 114 lists of nodes. It is the most general function allowing the creation of 115 instances of the graph. Wrappers which accept a single tuple of arguments and 116 return the corresponding node can be written based on it. 117 118 @chunk[<graph-builder-info> 119 (struct+/contract graph-builder-info graph-info 120 ([name identifier?] 121 [tvars (listof identifier?)] 122 [root-node identifier?] 123 [node-order (listof identifier?)] 124 [nodes (hash/c symbol? node-info? #:immutable #t)] 125 [invariants (set/c invariant-info? #:kind 'immutable #:cmp 'equal)]) 126 ([multi-constructor identifier?] 127 [root-mapping identifier?] 128 [mapping-order (listof identifier?)] 129 [mappings (hash/c symbol? mapping-info? #:immutable #t)] 130 [dependent-invariants (set/c dependent-invariant-info? 131 #:kind 'immutable 132 #:cmp 'equal)]) 133 #:transparent 134 #:methods gen:custom-write 135 [(define write-proc (struct-printer 'graph-builder-info))] 136 #:property prop:custom-print-quotable 'never)] 137 138 @section{Node information} 139 140 @chunk[<node-info> 141 (struct+/contract node-info 142 ([predicate? identifier?] 143 [field-order (listof identifier?)] 144 [fields (hash/c symbol? field-info? #:immutable #t)] 145 [promise-type stx-type/c] 146 ;; Wrappers can mean that we have incomplete types with fewer 147 ;; fields than the final node type. 148 ;[make-incomplete-type identifier?] 149 ;[incomplete-type identifier?] 150 ) 151 #:transparent 152 #:methods gen:custom-write 153 [(define write-proc (struct-printer 'node-info))] 154 #:property prop:custom-print-quotable 'never)] 155 156 @section{Field information} 157 158 A field has a type. 159 160 @chunk[<field-info> 161 (struct+/contract field-info 162 ([type stx-type/c]) 163 #:transparent 164 #:methods gen:custom-write 165 [(define write-proc (struct-printer 'field-info))] 166 #:property prop:custom-print-quotable 'never)] 167 168 @;[incomplete-type identifier?] 169 170 @section{Invariant information} 171 172 @chunk[<invariant-info> 173 (struct+/contract invariant-info 174 ([predicate identifier?] ; (→ RootNode Boolean : +witness-type) 175 [witness-type stx-type/c]) 176 #:transparent 177 #:methods gen:custom-write 178 [(define write-proc (struct-printer 'invariant-info))] 179 #:property prop:custom-print-quotable 'never 180 #:methods gen:equal+hash 181 |<gen:equal+hash free-id-tree=?>|)] 182 183 Instances of @racket[invariant-info] are compared pointwise with 184 @racket[free-id-tree=?]: 185 186 @chunk[|<gen:equal+hash free-id-tree=?>| 187 [(define equal-proc free-id-tree=?) 188 (define hash-proc free-id-tree-hash-code) 189 (define hash2-proc free-id-tree-secondary-hash-code)]] 190 191 @section{Dependent invariant information} 192 193 The invariants described in the previous section assert properties of a graph 194 instance in isolation. It is however desirable to also describe invariants 195 which relate the old and the new graph in a graph transformation. 196 197 @chunk[<dependent-invariant-info> 198 (struct+/contract dependent-invariant-info 199 ([checker identifier?] ; (→ RootMappingArguments… NewGraphRoot Boolean) 200 [name identifier?]) 201 #:transparent 202 #:methods gen:custom-write 203 [(define write-proc (struct-printer 'dependent-invariant-info))] 204 #:property prop:custom-print-quotable 'never 205 #:methods gen:equal+hash 206 |<gen:equal+hash free-id-tree=?>|)] 207 208 Instances of @racket[dependent-invariant-info] are compared pointwise with 209 @racket[free-id-tree=?], like @racket[invariant-info]. 210 211 @section{Mapping information} 212 213 @chunk[<mapping-info> 214 (struct+/contract mapping-info 215 ([mapping-function identifier?] 216 [with-promises-type identifier?] 217 [make-placeholder-type identifier?] 218 [placeholder-type identifier?]) 219 #:transparent 220 #:methods gen:custom-write 221 [(define write-proc (struct-printer 'mapping-info))] 222 #:property prop:custom-print-quotable 'never)] 223 224 @section{Printing} 225 226 It is much easier to debug graph information if it is free from the visual 227 clutter of printed syntax objects (which waste most of the screen real estate 228 printing @tt{#<syntax:/path/to/file}, when the interesting part is the 229 contents of the syntax object). 230 231 We therefore pre-process the fields, transforming syntax objects into regular 232 data. 233 234 @chunk[<printer> 235 (define (to-datum v) 236 (syntax->datum (datum->syntax #f v))) 237 238 (define ((syntax-convert old-print-convert-hook) 239 val basic-convert sub-convert) 240 (cond 241 [(set? val) 242 (cons 'set (map sub-convert (set->list val)))] 243 [(and (hash? val) (immutable? val)) 244 (cons 'hash 245 (append-map (λ (p) (list (sub-convert (car p)) 246 (sub-convert (cdr p)))) 247 (hash->list val)))] 248 [(syntax? val) 249 (list 'syntax (to-datum val))] 250 [else 251 (old-print-convert-hook val basic-convert sub-convert)])) 252 253 (define ((struct-printer ctor) st port mode) 254 (match-define (vector name fields ...) (struct->vector st)) 255 (define-values (info skipped?) (struct-info st)) 256 (define-values (-short-name _2 _3 _4 _5 _6 _7 _8) 257 (struct-type-info info)) 258 (define short-name (or ctor -short-name)) 259 (define (to-datum v) 260 (syntax->datum (datum->syntax #f v))) 261 (case mode 262 [(#t) 263 (display "#(" port) 264 (display name port) 265 (for-each (λ (f) 266 (display " " port) 267 (write (to-datum f) port)) 268 fields) 269 (display ")" port)] 270 [(#f) 271 (display "#(" port) 272 (display name port) 273 (for-each (λ (f) 274 (display " " port) 275 (display (to-datum f) port)) 276 fields) 277 (display ")" port)] 278 [else 279 (let ([old-print-convert-hook (current-print-convert-hook)]) 280 (parameterize ([constructor-style-printing #t] 281 [show-sharing #f] 282 [current-print-convert-hook 283 (syntax-convert old-print-convert-hook)]) 284 (write 285 (cons short-name 286 (map print-convert 287 ;; to-datum doesn't work if I map it on the fields? 288 fields)) 289 port)))]))] 290 291 @CHUNK[<*> 292 (require phc-toolkit/untyped 293 type-expander/expander 294 racket/struct 295 mzlib/pconvert 296 "free-identifier-tree-equal.rkt" 297 (for-syntax phc-toolkit/untyped 298 syntax/parse 299 syntax/parse/experimental/template 300 racket/syntax)) 301 302 (define-syntax/parse 303 (struct+/contract name {~optional parent} 304 {~optional ([parent-field parent-contract] ...)} 305 ([field contract] ...) 306 {~optional {~and transparent #:transparent}} 307 (~and {~seq methods+props ...} 308 (~seq (~or {~seq #:methods _ _} 309 {~seq #:property _ _}) 310 ...))) 311 #:with name/c (format-id #'name "~a/c" #'name) 312 (template 313 (begin 314 (struct name (?? parent) (field ...) 315 (?? transparent) 316 methods+props ...) 317 (define name/c 318 (struct/c name 319 (?? (?@ parent-contract ...)) 320 contract ...)) 321 (module+ test 322 (require rackunit) 323 (check-pred flat-contract? name/c)) 324 (provide name/c 325 (contract-out (struct (?? (name parent) name) 326 ((?? (?@ [parent-field parent-contract] 327 ...)) 328 [field contract] 329 ...))))))) 330 331 <printer> 332 333 <field-info> 334 <node-info> 335 <invariant-info> 336 <dependent-invariant-info> 337 <graph-info> 338 <mapping-info> 339 <graph-builder-info>]