340 lines
13 KiB
Racket
340 lines
13 KiB
Racket
#lang hyper-literate racket #:no-auto-require
|
|
|
|
@require[scribble-math
|
|
scribble-enhanced/doc
|
|
"notations.rkt"
|
|
(for-label racket)]
|
|
|
|
@title[#:style (with-html5 manual-doc-style)
|
|
#:tag "graph-info"
|
|
#:tag-prefix "phc-graph/graph-info"]{Compile-time graph metadata}
|
|
|
|
@(chunks-toc-prefix
|
|
'("(lib phc-graph/scribblings/phc-graph-implementation.scrbl)"
|
|
"phc-graph/graph-info"))
|
|
|
|
We define here the compile-time metadata describing a graph type.
|
|
|
|
@section{Graph type information}
|
|
|
|
The type of a graph is actually the type of its constituent nodes. The node
|
|
types may be polymorphic in the @racket[_tvars] type variables. The root node
|
|
name and the order of the nodes are purely indicative here, as a reference to
|
|
any node in the graph instance would be indistinguishable from a graph rooted
|
|
in that node type.
|
|
|
|
The @racket[_invariants] are not enforced by the node types. Instead, the node
|
|
types just include the invariant type as a witness (inside the @racket[raw]
|
|
field). The invariant is enforced either by construction, or with a run-time
|
|
check performed during the graph creation.
|
|
|
|
@chunk[<graph-info>
|
|
(struct+/contract graph-info
|
|
([name identifier?]
|
|
[tvars (listof identifier?)]
|
|
[root-node identifier?]
|
|
[node-order (listof identifier?)]
|
|
[nodes (hash/c symbol? node-info? #:immutable #t)]
|
|
[invariants (set/c invariant-info? #:kind 'immutable #:cmp 'equal)])
|
|
#:transparent
|
|
#:methods gen:custom-write
|
|
[(define write-proc (struct-printer 'graph-info))]
|
|
#:property prop:custom-print-quotable 'never)]
|
|
|
|
@;{
|
|
Since sets created with @racket[set] cannot be used within syntax objects
|
|
(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: 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}
|
|
|
|
The information about a graph type is valid regardless of how the graph
|
|
instances are constructed, and is therefore rather succinct.
|
|
|
|
The @racket[graph-builder-info] @racket[struct] extends this with meaningful
|
|
information about graph transformations. Two transformations which have the
|
|
same output graph type may use different sets of mapping functions.
|
|
Furthermore, the @racket[_dependent-invariants] are invariants relating the
|
|
input and output of a graph transformation.
|
|
|
|
The @racket[_multi-constructor] identifier refers to a function which takes
|
|
@${n} lists of lists of mapping argument tuples, and returns @${n} lists of
|
|
lists of nodes. It is the most general function allowing the creation of
|
|
instances of the graph. Wrappers which accept a single tuple of arguments and
|
|
return the corresponding node can be written based on it.
|
|
|
|
@chunk[<graph-builder-info>
|
|
(struct+/contract graph-builder-info graph-info
|
|
([name identifier?]
|
|
[tvars (listof identifier?)]
|
|
[root-node identifier?]
|
|
[node-order (listof identifier?)]
|
|
[nodes (hash/c symbol? node-info? #:immutable #t)]
|
|
[invariants (set/c invariant-info? #:kind 'immutable #:cmp 'equal)])
|
|
([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?
|
|
#:kind 'immutable
|
|
#:cmp 'equal)])
|
|
#:transparent
|
|
#:methods gen:custom-write
|
|
[(define write-proc (struct-printer 'graph-builder-info))]
|
|
#:property prop:custom-print-quotable 'never)]
|
|
|
|
@section{Node information}
|
|
|
|
@chunk[<node-info>
|
|
(struct+/contract node-info
|
|
([predicate? identifier?]
|
|
[field-order (listof identifier?)]
|
|
[fields (hash/c symbol? field-info? #:immutable #t)]
|
|
[promise-type stx-type/c]
|
|
;; Wrappers can mean that we have incomplete types with fewer
|
|
;; fields than the final node type.
|
|
;[make-incomplete-type identifier?]
|
|
;[incomplete-type identifier?]
|
|
)
|
|
#:transparent
|
|
#:methods gen:custom-write
|
|
[(define write-proc (struct-printer 'node-info))]
|
|
#:property prop:custom-print-quotable 'never)]
|
|
|
|
@section{Field information}
|
|
|
|
A field has a type.
|
|
|
|
@chunk[<field-info>
|
|
(struct+/contract field-info
|
|
([type stx-type/c])
|
|
#:transparent
|
|
#:methods gen:custom-write
|
|
[(define write-proc (struct-printer 'field-info))]
|
|
#:property prop:custom-print-quotable 'never)]
|
|
|
|
@;[incomplete-type identifier?]
|
|
|
|
@section{Invariant information}
|
|
|
|
@chunk[<invariant-info>
|
|
(struct+/contract invariant-info
|
|
([predicate identifier?] ; (→ RootNode Boolean : +witness-type)
|
|
[witness-type stx-type/c])
|
|
#:transparent
|
|
#:methods gen:custom-write
|
|
[(define write-proc (struct-printer 'invariant-info))]
|
|
#:property prop:custom-print-quotable 'never
|
|
#:methods gen:equal+hash
|
|
|<gen:equal+hash free-id-tree=?>|)]
|
|
|
|
Instances of @racket[invariant-info] are compared pointwise with
|
|
@racket[free-id-tree=?]:
|
|
|
|
@chunk[|<gen:equal+hash free-id-tree=?>|
|
|
[(define equal-proc free-id-tree=?)
|
|
(define hash-proc free-id-tree-hash-code)
|
|
(define hash2-proc free-id-tree-secondary-hash-code)]]
|
|
|
|
@section{Dependent invariant information}
|
|
|
|
The invariants described in the previous section assert properties of a graph
|
|
instance in isolation. It is however desirable to also describe invariants
|
|
which relate the old and the new graph in a graph transformation.
|
|
|
|
@chunk[<dependent-invariant-info>
|
|
(struct+/contract dependent-invariant-info
|
|
([checker identifier?] ; (→ RootMappingArguments… NewGraphRoot Boolean)
|
|
[name identifier?])
|
|
#:transparent
|
|
#:methods gen:custom-write
|
|
[(define write-proc (struct-printer 'dependent-invariant-info))]
|
|
#:property prop:custom-print-quotable 'never
|
|
#:methods gen:equal+hash
|
|
|<gen:equal+hash free-id-tree=?>|)]
|
|
|
|
Instances of @racket[dependent-invariant-info] are compared pointwise with
|
|
@racket[free-id-tree=?], like @racket[invariant-info].
|
|
|
|
@section{Mapping information}
|
|
|
|
@chunk[<mapping-info>
|
|
(struct+/contract mapping-info
|
|
([mapping-function identifier?]
|
|
[with-promises-type identifier?]
|
|
[make-placeholder-type identifier?]
|
|
[placeholder-type identifier?])
|
|
#:transparent
|
|
#:methods gen:custom-write
|
|
[(define write-proc (struct-printer 'mapping-info))]
|
|
#:property prop:custom-print-quotable 'never)]
|
|
|
|
@section{Printing}
|
|
|
|
It is much easier to debug graph information if it is free from the visual
|
|
clutter of printed syntax objects (which waste most of the screen real estate
|
|
printing @tt{#<syntax:/path/to/file}, when the interesting part is the
|
|
contents of the syntax object).
|
|
|
|
We therefore pre-process the fields, transforming syntax objects into regular
|
|
data.
|
|
|
|
@chunk[<printer>
|
|
(define (to-datum v)
|
|
(syntax->datum (datum->syntax #f v)))
|
|
|
|
(define ((syntax-convert old-print-convert-hook)
|
|
val basic-convert sub-convert)
|
|
(cond
|
|
[(set? val)
|
|
(cons 'set (map sub-convert (set->list val)))]
|
|
[(and (hash? val) (immutable? val))
|
|
(cons 'hash
|
|
(append-map (λ (p) (list (sub-convert (car p))
|
|
(sub-convert (cdr p))))
|
|
(hash->list val)))]
|
|
[(syntax? val)
|
|
(list 'syntax (to-datum val))]
|
|
[else
|
|
(old-print-convert-hook val basic-convert sub-convert)]))
|
|
|
|
(define ((struct-printer ctor) st port mode)
|
|
(match-define (vector name fields ...) (struct->vector st))
|
|
(define-values (info skipped?) (struct-info st))
|
|
(define-values (-short-name _2 _3 _4 _5 _6 _7 _8)
|
|
(struct-type-info info))
|
|
(define short-name (or ctor -short-name))
|
|
(define (to-datum v)
|
|
(syntax->datum (datum->syntax #f v)))
|
|
(case mode
|
|
[(#t)
|
|
(display "#(" port)
|
|
(display name port)
|
|
(for-each (λ (f)
|
|
(display " " port)
|
|
(write (to-datum f) port))
|
|
fields)
|
|
(display ")" port)]
|
|
[(#f)
|
|
(display "#(" port)
|
|
(display name port)
|
|
(for-each (λ (f)
|
|
(display " " port)
|
|
(display (to-datum f) port))
|
|
fields)
|
|
(display ")" port)]
|
|
[else
|
|
(let ([old-print-convert-hook (current-print-convert-hook)])
|
|
(parameterize ([constructor-style-printing #t]
|
|
[show-sharing #f]
|
|
[current-print-convert-hook
|
|
(syntax-convert old-print-convert-hook)])
|
|
(write
|
|
(cons short-name
|
|
(map print-convert
|
|
;; to-datum doesn't work if I map it on the fields?
|
|
fields))
|
|
port)))]))]
|
|
|
|
@CHUNK[<*>
|
|
(require phc-toolkit/untyped
|
|
type-expander/expander
|
|
racket/struct
|
|
mzlib/pconvert
|
|
"free-identifier-tree-equal.rkt"
|
|
(for-syntax phc-toolkit/untyped
|
|
syntax/parse
|
|
syntax/parse/experimental/template
|
|
racket/syntax))
|
|
|
|
(define-syntax/parse
|
|
(struct+/contract name {~optional parent}
|
|
{~optional ([parent-field parent-contract] ...)}
|
|
([field contract] ...)
|
|
{~optional {~and transparent #:transparent}}
|
|
(~and {~seq methods+props ...}
|
|
(~seq (~or {~seq #:methods _ _}
|
|
{~seq #:property _ _})
|
|
...)))
|
|
#:with name/c (format-id #'name "~a/c" #'name)
|
|
(template
|
|
(begin
|
|
(struct name (?? parent) (field ...)
|
|
(?? transparent)
|
|
methods+props ...)
|
|
(define name/c
|
|
(struct/c name
|
|
(?? (?@ parent-contract ...))
|
|
contract ...))
|
|
(module+ test
|
|
(require rackunit)
|
|
(check-pred flat-contract? name/c))
|
|
(provide name/c
|
|
(contract-out (struct (?? (name parent) name)
|
|
((?? (?@ [parent-field parent-contract]
|
|
...))
|
|
[field contract]
|
|
...)))))))
|
|
|
|
<printer>
|
|
|
|
<field-info>
|
|
<node-info>
|
|
<invariant-info>
|
|
<dependent-invariant-info>
|
|
<graph-info>
|
|
<mapping-info>
|
|
<graph-builder-info>]
|