suzanne.soy/phc-graph
1
0
Fork 0
Code Issues 24 Pull Requests Actions Packages Projects Releases Wiki Activity

Printing bug when printing the set.

Browse Source
This commit is contained in:
Georges Dupéron 2017-01-17 19:12:51 +01:00
parent fb1786b4ac
commit bd04ef6262
9 changed files with 414 additions and 1160 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

55
Graph-notes-copy2.vue
View File

@ -1,14 +1,14 @@
<!-- Tufts VUE 3.3.0 concept-map (Graph-notes-copy2.vue) 2017-01-16 -->
<!-- Tufts VUE: http://vue.tufts.edu/ -->
<!-- Do Not Remove: VUE mapping @version(1.1) jar:file:/nix/store/z92y35qgs6g3cvvh0i4f14mg5n47zvvi-vue-3.3.0/share/vue/vue.jar!/tufts/vue/resources/lw_mapping_1_1.xml -->
<!-- Do Not Remove: Saved date Mon Jan 16 01:54:56 CET 2017 by georges on platform Linux 4.4.38 in JVM 1.8.0_122-04 -->
<!-- Do Not Remove: Saved date Mon Jan 16 09:59:19 CET 2017 by georges on platform Linux 4.4.38 in JVM 1.8.0_122-04 -->
<!-- Do Not Remove: Saving version @(#)VUE: built October 8 2015 at 1724 by tomadm on Linux 2.6.32-504.23.4.el6.x86_64 i386 JVM 1.7.0_21-b11(bits=32) -->
<?xml version="1.0" encoding="US-ASCII"?>
<LW-MAP xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
xsi:noNamespaceSchemaLocation="none" ID="0"
label="Graph-notes-copy2.vue" created="1479309847604" x="0.0"
y="0.0" width="1.4E-45" height="1.4E-45" strokeWidth="0.0" autoSized="false">
<resource referenceCreated="1484528096110" size="208901"
<resource referenceCreated="1484557159072" size="211457"
spec="/home/georges/phc/racket-packages/phc-graph/Graph-notes-copy2.vue"
type="1" xsi:type="URLResource">
<title>Graph-notes-copy2.vue</title>
@ -3778,12 +3778,59 @@
<ID1 xsi:type="node">540</ID1>
<ID2 xsi:type="node">542</ID2>
</child>
<child ID="544" label="Check addition of new fields to the input"
layerID="1" created="1484557019620" x="2235.3042" y="324.74472"
width="274.0" height="23.0" strokeWidth="1.0" autoSized="true" xsi:type="node">
<fillColor>#F2AE45</fillColor>
<strokeColor>#776D6D</strokeColor>
<textColor>#000000</textColor>
<font>SansSerif-plain-12</font>
<URIString>http://vue.tufts.edu/rdf/resource/a68081d4c0a801286ae39894efbfa682</URIString>
<shape arcwidth="20.0" archeight="20.0" xsi:type="roundRect"/>
</child>
<child ID="545" layerID="1" created="1484557019630" x="1975.7919"
y="347.24472" width="335.61157" height="63.670532"
strokeWidth="1.0" autoSized="false" controlCount="0"
arrowState="2" xsi:type="link">
<strokeColor>#404040</strokeColor>
<textColor>#404040</textColor>
<font>SansSerif-plain-11</font>
<URIString>http://vue.tufts.edu/rdf/resource/a68081d5c0a801286ae398949e441433</URIString>
<point1 x="1976.2917" y="410.41525"/>
<point2 x="2310.9033" y="347.74472"/>
<ID1 xsi:type="node">357</ID1>
<ID2 xsi:type="node">544</ID2>
</child>
<child ID="546"
label="By versionning the lists of fields,&#xa;and indicating the last-good version number&#xa;in the graph creation code &#x2014; new versions have to be&#xa;approved by bumping the number."
layerID="1" created="1484557036779" x="2181.971" y="222.0781"
width="368.0" height="68.0" strokeWidth="1.0" autoSized="true" xsi:type="node">
<fillColor>#F2AE45</fillColor>
<strokeColor>#776D6D</strokeColor>
<textColor>#000000</textColor>
<font>SansSerif-plain-12</font>
<URIString>http://vue.tufts.edu/rdf/resource/a68081d5c0a801286ae398942effba1f</URIString>
<shape arcwidth="20.0" archeight="20.0" xsi:type="roundRect"/>
</child>
<child ID="547" layerID="1" created="1484557036786" x="2368.157"
y="289.57812" width="3.7387695" height="35.66797"
strokeWidth="1.0" autoSized="false" controlCount="0"
arrowState="2" xsi:type="link">
<strokeColor>#404040</strokeColor>
<textColor>#404040</textColor>
<font>SansSerif-plain-11</font>
<URIString>http://vue.tufts.edu/rdf/resource/a68081d6c0a801286ae398944c00f8fa</URIString>
<point1 x="2371.3958" y="324.7461"/>
<point2 x="2368.657" y="290.07812"/>
<ID1 xsi:type="node">544</ID1>
<ID2 xsi:type="node">546</ID2>
</child>
<layer ID="1" label="Layer 1" created="1479309847607" x="0.0"
y="0.0" width="1.4E-45" height="1.4E-45" strokeWidth="0.0" autoSized="false">
<URIString>http://vue.tufts.edu/rdf/resource/6dbf6b15c0a80026548592b8d2f3fee2</URIString>
</layer>
<userZoom>1.0</userZoom>
<userOrigin x="-1656.3625" y="-636.75525"/>
<userZoom>0.75</userZoom>
<userOrigin x="-1182.522" y="-189.81644"/>
<presentationBackground>#FFFFFF</presentationBackground>
<PathwayList currentPathway="0" revealerIndex="-1">
<pathway ID="0" label="Chemin sans nom" created="1479309847603"

50
Graph-notes.mm
View File

@ -1,50 +0,0 @@
<map version="1.0.1">
<!-- To view this file, download free mind mapping software FreeMind from http://freemind.sourceforge.net -->
<node CREATED="1479307928543" ID="ID_115580742" MODIFIED="1479308216259" TEXT="Graph">
<font NAME="SansSerif" SIZE="16"/>
<node CREATED="1479307978656" ID="ID_1467790846" MODIFIED="1479308216235" POSITION="right" TEXT="">
<font NAME="SansSerif" SIZE="16"/>
</node>
<node CREATED="1479308005979" ID="ID_1461725970" MODIFIED="1479308216211" POSITION="left" TEXT="invariants">
<font NAME="SansSerif" SIZE="16"/>
<node CREATED="1479308061764" ID="ID_378722052" MODIFIED="1479308216188" TEXT="scope">
<font NAME="SansSerif" SIZE="16"/>
<node CREATED="1479308065663" ID="ID_939090742" MODIFIED="1479308216164" TEXT="Input">
<font NAME="SansSerif" SIZE="16"/>
</node>
<node CREATED="1479308091707" ID="ID_1563514202" MODIFIED="1479308216094" TEXT="Output">
<font NAME="SansSerif" SIZE="16"/>
</node>
<node CREATED="1479308095316" ID="ID_1340973971" MODIFIED="1479308233811" TEXT="Transformation">
<font NAME="SansSerif" SIZE="16"/>
<node CREATED="1479308237795" ID="ID_1309060989" MODIFIED="1479308254807" TEXT="like -&gt;i">
<font NAME="DejaVu Sans Mono" SIZE="12"/>
</node>
</node>
</node>
<node CREATED="1479308274575" ID="ID_1586701005" MODIFIED="1479308282949" TEXT="Verification time">
<node CREATED="1479308293860" ID="ID_46833274" MODIFIED="1479308297548" TEXT="Run-time"/>
<node CREATED="1479308298132" ID="ID_170224426" MODIFIED="1479308304972" TEXT="Compile-time">
<node CREATED="1479308308988" ID="ID_1071628135" MODIFIED="1479308321217" TEXT="Field types"/>
<node CREATED="1479308325655" ID="ID_1497263973" MODIFIED="1479308474005" TEXT="Type policy">
<node CREATED="1479308366808" ID="ID_1203881216" MODIFIED="1479308368145" TEXT="e.g. no cycles within the types"/>
</node>
<node CREATED="1479308372692" ID="ID_1614080405" MODIFIED="1479308442436" TEXT="Macro policy">
<node CREATED="1479308444994" ID="ID_1687400809" MODIFIED="1479308450313" TEXT="i.e. correct by construction"/>
<node CREATED="1479308486419" FOLDED="true" ID="ID_1005390685" MODIFIED="1479308873487" TEXT="May interfere with each other">
<icon BUILTIN="messagebox_warning"/>
<node CREATED="1479308564613" ID="ID_246345249" MODIFIED="1479308870465" STYLE="bubble" TEXT="e.g. a &quot;no cycles starting from this node&quot; constraint&#xa;would not work as expected if a &quot;backwards link&quot; is&#xa;filled in afterwards.&#xa;We probably need to hardcode a basic set of&#xa;constraints which know about each other and&#xa;about the potential interactions."/>
</node>
<node CREATED="1479308516231" FOLDED="true" ID="ID_521874707" MODIFIED="1479309080946" TEXT="May alter a mapping&apos;s inputs">
<node CREATED="1479308984967" ID="ID_666428602" MODIFIED="1479309027685" TEXT="Conserve well-scopedness within a transition:&#xa;pass in nodes flagged with a &#x2200; type, and&#xa;check that the output contains that flag.&#xa;Potentially out-of-scope fields in the input do&#xa;not have the flag."/>
</node>
<node CREATED="1479308767829" ID="ID_1128145279" MODIFIED="1479308903893" TEXT="May wrapp a mapping&apos;s outputs">
<node CREATED="1479308905956" ID="ID_1856836622" MODIFIED="1479308919205" TEXT="e.g. wrap with (ann)"/>
</node>
</node>
</node>
</node>
<node CREATED="1479308289261" ID="ID_1896946451" MODIFIED="1479308292028" TEXT="Specification"/>
</node>
</node>
</map>

1064
Graph-notes.vue
View File

File diff suppressed because it is too large Load Diff

273
graph-info.hl.rkt
View File

@ -1,43 +1,236 @@
#lang racket
#lang hyper-literate racket #:no-auto-require
(provide (struct-out graph-info)
(struct-out node-info)
(struct-out field-info)
(struct-out rich-graph-info)
(struct-out rich-mapping-info))
@require[scribble-math
scribble-enhanced/doc
"notations.rkt"
(for-label racket)]
(struct graph-info (name
multi-constructor
root
node-order
nodes))
(struct node-info (constructor
predicate?
field-order
fields
promise-type
make-incomplete-type ;; may be removed later
incomplete-type
make-placeholder-type ;; may be removed later.
placeholder-type))
(struct field-info (type
incomplete-type))
@title[#:style (with-html5 manual-doc-style)
#:tag "graph-info"
#:tag-prefix "phc-graph/graph-info"]{Compile-time graph metadata}
(struct rich-graph-info (name
multi-constructor
root-node
root-mapping
node-order
nodes
mapping-order
mappings))
(struct rich-mapping-info (constructor
;predicate?
;field-order
;fields
with-promises-type
;make-incomplete-type ;; may be removed later
;incomplete-type
;make-placeholder-type ;; may be removed later.
;placeholder-type
))
@(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}
@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)])
#:transparent
#:methods gen:custom-write
[(define write-proc (struct-printer 'graph-info))]
#:property prop:custom-print-quotable 'never)]
@section{Graph builder information}
@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)])
([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?)])
#: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 identifier?]
[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 identifier?])
#: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 identifier?])
#:transparent
#:methods gen:custom-write
[(define write-proc (struct-printer 'invariant-info))]
#:property prop:custom-print-quotable 'never)]
@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)]
@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 (struct-printer2 ctor)
(make-constructor-style-printer
(λ (v) ctor)
(λ (v) (map to-datum (struct->list v)))))
(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 "#(~#t~" port)
(display name port)
(for-each (λ (f)
(display " " port)
(write (to-datum f) port))
fields)
(display ")" port)]
[(#f)
(display "#(~#f~" port)
(display name port)
(for-each (λ (f)
(display " " port)
(display (to-datum f) port))
fields)
(display ")" port)]
[(0)
(display "(" port)
(display short-name port)
(for-each (λ (f)
(display " " port)
;; Circumvent the undocumented(?) autodetection of
;; print which changes the behaviour if objects which
;; are not eq? to the original fields are directly
;; printed to the port.
(let ([str (with-output-to-string
(λ ()
(print (to-datum f) (current-output-port) 0)))])
(display (string-append str " ") port)))
fields)
(display ")" port)]
[(1)
(display "#(" port)
(display name port)
(for-each (λ (f)
(display " " port)
(display
;; Circumvent the undocumented(?) autodetection of
;; print which changes the behaviour if objects which
;; are not eq? to the original fields are directly
;; printed to the port.
#;(with-output-to-string
(λ ()
(print (to-datum f) (current-output-port) 1)))
"abab"
port))
fields)
(display ")" port)]))]
@CHUNK[<*>
(require phc-toolkit/untyped
racket/struct
(for-syntax phc-toolkit/untyped
syntax/parse
syntax/parse/experimental/template))
(define-syntax/parse
(struct+/contract name {~optional parent}
{~optional ([parent-field parent-contract] ...)}
([field contract] ...)
{~optional {~and transparent #:transparent}}
(~and {~seq methods+props ...}
(~seq (~maybe #:methods
{~literal gen:custom-write}
_)
(~maybe #:property
{~literal prop:custom-print-quotable}
_))))
(quasisyntax/top-loc this-syntax
#,(template
(begin
(struct name (?? parent) (field ...)
(?? transparent)
methods+props ...)
(provide (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>]

91
graph-type.hl.rkt Normal file
View File

@ -0,0 +1,91 @@
#lang hyper-literate typed/racket #:no-auto-require
@require[scribble-math
scribble-enhanced/doc
"notations.rkt"
(for-label racket)]
@title[#:style (with-html5 manual-doc-style)
#:tag "graph-type"
#:tag-prefix "phc-graph/graph-type"]{Declaring graph types}
@(chunks-toc-prefix
'("(lib phc-graph/scribblings/phc-graph-implementation.scrbl)"
"phc-graph/graph-type"))
@CHUNK[<define-graph-type>
(begin-for-syntax
(define-syntax-class signature
#:datum-literals (∈ ∋ ≡ ≢ ∉)
#:literals (:)
(pattern (name
{~maybe #:∀ (tvar …)}
(~and {~seq [nodeᵢ:id [fieldᵢⱼ:id : τ] …] …}
{~seq [root-node . _] _ …})
{~seq #:invariant a {~and op {~or ∈ ∋ ≡ ≢ ∉}} b} …
{~seq #:invariant p} …))))
(define-syntax/parse (define-graph-type . :signature)
(define gi <graph-info>)
(local-require racket/pretty)
(pretty-print gi (current-output-port) 0)
#`(begin
(define-syntax name #,gi)))]
@chunk[<graph-info>
(graph-info #'name
(syntax->list (if (attribute tvar) #'(tvar …) #'()))
#'root-node
(syntax->list #'(nodeᵢ …))
(make-immutable-hash
(map cons
(stx-map syntax-e #'(nodeᵢ …))
(stx-map (λ/syntax-case (nodeᵢ [fieldᵢⱼ τᵢⱼ] …) ()
<node-info>)
#'([nodeᵢ [fieldᵢⱼ τᵢⱼ] …] …))))
(list->set
(append
(stx-map (λ/syntax-case (op a b) () <invariant-info-op>)
#'([op a b] …))
(stx-map (λ/syntax-case p () <invariant-info-p>)
#'(p …)))))]
@chunk[<node-info>
(node-info (meta-struct-predicate
(check-remembered-node! #'(nodeᵢ fieldᵢⱼ …)))
(syntax->list #'(fieldᵢⱼ …))
(make-immutable-hash
(map cons
(stx-map syntax-e #'(fieldᵢⱼ …))
(stx-map (λ/syntax-case (fieldᵢⱼ τᵢⱼ) ()
<field-info>)
#'([fieldᵢⱼ τᵢⱼ] …))))
(check-remembered-node! #'(nodeᵢ fieldᵢⱼ …))
(meta-struct-constructor
(check-remembered-tagged! #'(node-incompleteᵢ fieldᵢⱼ …)))
(check-remembered-tagged! #'(node-incompleteᵢ fieldᵢⱼ …)))]
@chunk[<field-info>
(field-info #'τᵢⱼ)]
@chunk[<invariant-info-op>
(invariant-info #'predicateTODO
#'witnessTODO)]
@chunk[<invariant-info-p>
(invariant-info #'predicateTODO
#'witnessTODO)]
@chunk[<*>
(require racket/require
phc-toolkit
(lib "phc-adt/tagged-structure-low-level.hl.rkt")
(for-syntax "graph-info.hl.rkt"
phc-toolkit/untyped
(subtract-in syntax/parse phc-graph/subtemplate)
racket/set
phc-graph/subtemplate))
(provide define-graph-type)
<define-graph-type>]

12
graph.hl.rkt
View File

@ -1,5 +1,6 @@
#lang hyper-literate typed/racket/base #:no-auto-require
@(require racket/require
@(require scribble-math
racket/require
scribble-enhanced/doc
racket/require
hyper-literate
@ -20,6 +21,15 @@
(require (for-label (submod ".."))))
@doc-lib-setup
@title[#:style (with-html5 manual-doc-style)
#:tag "graph-impl"
#:tag-prefix "phc-graph/graph-impl"]{Implementation of the graph macro}
@(chunks-toc-prefix
'("(lib phc-graph/scribblings/phc-graph-implementation.scrbl)"
"phc-graph/graph-impl"))
@chunk[<graph>
(define-syntax define-graph
(syntax-parser

5
scribblings/phc-graph-implementation.scrbl
View File

@ -13,4 +13,7 @@ the @other-doc['(lib "phc-graph/scribblings/phc-graph.scrbl")] document.
@include-section[(submod "../traversal.hl.rkt" doc)]
@include-section[(submod "../flexible-with.hl.rkt" doc)]
@include-section[(submod "../invariants-phantom.hl.rkt" doc)]
@include-section[(submod "../invariants-phantom.hl.rkt" doc)]
@include-section[(submod "../graph-info.hl.rkt" doc)]
@include-section[(submod "../graph-type.hl.rkt" doc)]
@include-section[(submod "../graph.hl.rkt" doc)]

8
test/adt-pre-declarations.rkt
View File

@ -2,3 +2,11 @@
(remembered! tagged-structure (tg a b))
(remembered! tagged-structure (tg a c))
(remembered! tagged-structure (t0))
(remembered! tagged-structure (City citizens name streets))
(remembered! tagged-structure (Street houses name))
(remembered! tagged-structure (House owner))
(remembered! tagged-structure (Person name))
(remembered! tagged-structure (node-incompleteᵢ citizens name streets))
(remembered! tagged-structure (node-incompleteᵢ houses name))
(remembered! tagged-structure (node-incompleteᵢ owner))
(remembered! tagged-structure (node-incompleteᵢ name))

16
test/test-graph-type.rkt Normal file
View File

@ -0,0 +1,16 @@
#lang typed/racket
(require phc-adt
(lib "phc-graph/graph-type.hl.rkt"))
(adt-init)
(define-graph-type g1
[City [name : String]
[streets : (Listof Street)]
[citizens : (Listof Person)]]
[Street [name : String]
[houses : (Listof House)]]
[House [owner : Person]]
[Person [name : String]]
#:invariant City.citizens._ ∈ City.streets._.houses._.owner
#:invariant City.citizens._ ∋ City.streets._.houses._.owner)