commit e951c7b26f0e1ef3f523d47f4ca39cb46ca0050c
parent 48bc1ed2f926c45f01eb781c97e4fd94682908cd
Author: Georges Dupéron <georges.duperon@gmail.com>
Date: Sun, 1 Jan 2017 21:03:03 +0100
Started writing on phantom types as witnesses for invariants
Diffstat:
6 files changed, 129 insertions(+), 41 deletions(-)
diff --git a/Graph-notes-copy2.vue b/Graph-notes-copy2.vue
@@ -1,14 +1,14 @@
-<!-- Tufts VUE 3.3.0 concept-map (Graph-notes-copy2.vue) 2016-12-29 -->
+<!-- Tufts VUE 3.3.0 concept-map (Graph-notes-copy2.vue) 2016-12-30 -->
<!-- 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 Thu Dec 29 22:27:01 CET 2016 by georges on platform Linux 4.4.38 in JVM 1.8.0_122-04 -->
+<!-- Do Not Remove: Saved date Fri Dec 30 22:07:05 CET 2016 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="1483046821901" size="202869"
+ <resource referenceCreated="1483132025205" size="204773"
spec="/home/georges/phc/racket-packages/phc-graph/Graph-notes-copy2.vue"
type="1" xsi:type="URLResource">
<title>Graph-notes-copy2.vue</title>
@@ -1046,8 +1046,8 @@
<shape arcwidth="20.0" archeight="20.0" xsi:type="roundRect"/>
</child>
<child ID="215" label="Structural invariant" layerID="1"
- created="1479312437302" x="-526.0517" y="296.2496" width="162.0"
- height="86.75" strokeWidth="1.0" autoSized="true" xsi:type="node">
+ created="1479312437302" x="-526.0517" y="273.2496" width="162.0"
+ height="107.0" strokeWidth="1.0" autoSized="true" xsi:type="node">
<fillColor>#F2AE45</fillColor>
<strokeColor>#000000</strokeColor>
<textColor>#000000</textColor>
@@ -1083,6 +1083,16 @@
<URIString>http://vue.tufts.edu/rdf/resource/6e13f9e943a6be970d2ffe25a12d6061</URIString>
<shape arcwidth="20.0" archeight="20.0" xsi:type="roundRect"/>
</child>
+ <child ID="537" label="a.c = count(a.b)" created="1483131981450"
+ x="34.0" y="83.75" width="118.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/518eb6ce534430712734d86a5ed52578</URIString>
+ <shape arcwidth="20.0" archeight="20.0" xsi:type="roundRect"/>
+ </child>
<shape arcwidth="20.0" archeight="20.0" xsi:type="roundRect"/>
</child>
<child ID="216" label="Fill in auto fields" layerID="1"
@@ -1516,16 +1526,16 @@
<ID1 xsi:type="node">216</ID1>
<ID2 xsi:type="node">269</ID2>
</child>
- <child ID="273" layerID="1" created="1479315784203" x="-550.9628"
- y="268.6448" width="41.538574" height="28.104797"
+ <child ID="273" layerID="1" created="1479315784203" x="-547.75836"
+ y="268.64478" width="22.596802" height="13.172211"
strokeWidth="1.0" autoSized="false" controlCount="0"
arrowState="2" xsi:type="link">
<strokeColor>#000000</strokeColor>
<textColor>#404040</textColor>
<font>SansSerif-plain-11</font>
<URIString>http://vue.tufts.edu/rdf/resource/6e18c7e043a6be970d2ffe25213bebda</URIString>
- <point1 x="-550.4628" y="269.1448"/>
- <point2 x="-509.92426" y="296.2496"/>
+ <point1 x="-547.25836" y="269.1448"/>
+ <point2 x="-525.66156" y="281.31702"/>
<ID1 xsi:type="node">269</ID1>
<ID2 xsi:type="node">215</ID2>
</child>
@@ -1614,16 +1624,16 @@
<ID1 xsi:type="node">278</ID1>
<ID2 xsi:type="node">264</ID2>
</child>
- <child ID="286" layerID="1" created="1479316060242" x="-444.86713"
- y="59.84375" width="4.7231445" height="236.90625"
+ <child ID="286" layerID="1" created="1479316060242" x="-444.6682"
+ y="59.84375" width="4.5158997" height="213.90625"
strokeWidth="1.0" autoSized="false" controlCount="0"
arrowState="2" xsi:type="link">
<strokeColor>#000000</strokeColor>
<textColor>#404040</textColor>
<font>SansSerif-plain-11</font>
<URIString>http://vue.tufts.edu/rdf/resource/6e1c69c643a6be970d2ffe2578e91de4</URIString>
- <point1 x="-440.64398" y="60.34375"/>
- <point2 x="-444.36713" y="296.25"/>
+ <point1 x="-440.65234" y="60.34375"/>
+ <point2 x="-444.16824" y="273.25"/>
<ID1 xsi:type="node">280</ID1>
<ID2 xsi:type="node">215</ID2>
</child>
@@ -2015,10 +2025,9 @@
<ID2 xsi:type="node">335</ID2>
</child>
<child ID="342"
- label="Define a wrapper, which may alter the input and input types, and the output and output types"
+ label="Define a wrapper, which may alter the input value and input types, and the output value and output types"
layerID="1" created="1479326681064" x="347.9707" y="1262.2448"
- width="683.25" height="202.25" strokeWidth="1.0"
- autoSized="true" xsi:type="node">
+ width="726.0" height="202.25" strokeWidth="1.0" autoSized="true" xsi:type="node">
<fillColor>#F2AE45</fillColor>
<strokeColor>#776D6D</strokeColor>
<textColor>#000000</textColor>
@@ -2130,15 +2139,15 @@
</child>
<shape arcwidth="20.0" archeight="20.0" xsi:type="roundRect"/>
</child>
- <child ID="345" layerID="1" created="1479326900002" x="219.06221"
- y="1077.2448" width="304.619" height="185.5" strokeWidth="1.0"
+ <child ID="345" layerID="1" created="1479326900002" x="219.88948"
+ y="1077.2448" width="317.8918" height="185.5" 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/6ec139aac0a80026616d92397220832f</URIString>
- <point1 x="219.56223" y="1077.7448"/>
- <point2 x="523.1812" y="1262.2448"/>
+ <point1 x="220.3895" y="1077.7448"/>
+ <point2 x="537.2813" y="1262.2448"/>
<ID1 xsi:type="node">293</ID1>
<ID2 xsi:type="node">342</ID2>
</child>
@@ -3704,7 +3713,7 @@
<URIString>http://vue.tufts.edu/rdf/resource/6dbf6b15c0a80026548592b8d2f3fee2</URIString>
</layer>
<userZoom>1.0</userZoom>
- <userOrigin x="-1573.3625" y="-374.75525"/>
+ <userOrigin x="-1829.3625" y="-403.75525"/>
<presentationBackground>#FFFFFF</presentationBackground>
<PathwayList currentPathway="0" revealerIndex="-1">
<pathway ID="0" label="Chemin sans nom" created="1479309847603"
diff --git a/info.rkt b/info.rkt
@@ -11,7 +11,8 @@
"srfi-lite-lib"
"delay-pure"
"backport-template-pr1514"
- "typed-map"))
+ "typed-map"
+ "scribble-lib"))
(define build-deps '("scribble-lib"
"racket-doc"
"remember"
diff --git a/invariants-phantom.hl.rkt b/invariants-phantom.hl.rkt
@@ -1,15 +1,19 @@
#lang aful/unhygienic hyper-literate type-expander/lang
-@title[#;#:style #;(with-html5 manual-doc-style)
- #:tag "invariants-phantom"
- #:tag-prefix "phc-graph/invariants-phantom"]{Tracking checked contracts
+@require[scribble-math
+ scribble-enhanced/doc
+ "notations.rkt"]
+
+@title[#:style (with-html5 manual-doc-style)
+ #:tag "inv-phantom"
+ #:tag-prefix "phc-graph/inv-phantom"]{Tracking checked contracts
via phantom types}
@(chunks-toc-prefix
'("(lib phc-graph/scribblings/phc-graph-implementation.scrbl)"
- "phc-graph/invariants-phantom"))
+ "phc-graph/inv-phantom"))
-@section{Overview}
+@section{Introduction}
The cautious compiler writer will no doubt want to check that the graph used
to represent the program verifies some structural properties. For example, the
@@ -18,6 +22,8 @@ property is that the @racket[in-method] field of an instruction points back to
the method containing it. We will use this second property as a running
example in this section.
+@section{Implementation overview}
+
It is possible to express with Typed/Racket that a @racket[Method] should
contain a list of @racket[Instruction]s, and that @racket[Instruction]s should
point to a @racket[Method]@note{We are not concerned here about the ability to
@@ -86,13 +92,80 @@ to wrap it in a struct type which is only accessible by the graph library:
(code:comment "provide only the type, not the constructor or accessor")
(provide Flag-Wrapper)]
-@; size → use a dummy function which errors when called
-@; (accepts an opaque token to prevent calling)
-
-@; Subtyping: multiple contracts with case→
-
-@; Subtyping: when C1 ⇒ C2,
-@; make the marker for C1 a subtype of the marker for C2
+We would like to be able to indicate that a graph node has validated several
+invariants. For that, we need a way to represent the type of a "set" of
+invariant witnesses. We also want some subtyping relationship between the
+sets: a set @${s₁} with more invariant witnesses should be a subtype of a
+subset @${s₂ ⊆ s₁}. We can order the invariant witnesses and use @racket[Rec]
+to build the type of a list of invariant witnesses, where some may be missing:
+
+@chunk[<invariant-set-as-List+Rec>
+ (define-type At-Least-InvB+InvD
+ (Rec R₁ (U (Pairof Any R₁)
+ (Pairof 'InvB (Rec R₂ (U (Pairof Any R₂)
+ (Pairof 'InvD (Listof Any))))))))]
+
+@chunk[<invariant-set-as-List+Rec-use>
+ (ann '(InvA InvB InvC InvD InvE) At-Least-InvB+InvD)
+ (ann '(InvB InvD) At-Least-InvB+InvD)
+ (code:comment "Rejected, because it lacks 'InvD")
+ (code:comment "(ann '(InvB InvC InvE) At-Least-InvB+InvD)")
+ (code:comment "The elements must be in the right order,")
+ (code:comment "this would be rejected by the typechecker:")
+ (code:comment "(ann '(InvD InvB) At-Least-InvB+InvD)")]
+
+Another solution is to group the witnesses in an untagged union with
+@racket[U], and place it in a contravariant position:
+
+@chunk[<invariant-set-as-contravariant-U>
+ (define-type At-Least-InvB+InvD
+ (→ (U 'InvB 'InvD) Void))]
+
+This solution also has the advantage that the size of the run-time witness is
+constant, and does not depend on the number of checked contracts (unlike the
+representation using a list). In practice the function should never be called.
+It can however simply be implemented in a way which pleases the type checked
+as a function accepting anything and returning void.
+
+In addition to testifying that a graph node was checked against multiple,
+separate contracts, there might be some contracts which check stronger
+properties than others. A way to encode this relationship in the type system
+is to have subtyping relationships between the contract witnesses, so that
+@; TODO: get rid of the mathit
+@${\mathit{P}₁(x) ⇒ \mathit{P}₂(x) ⇒ \mathit{Inv}₁ @texsubtype \mathit{Inv}₂}:
+
+@chunk[<invariant-contract-subtyping>
+ (struct InvWeak ())
+ (struct InvStrong InvWeak ())]
+
+If the witnesses must appear in a contravariant position (when using
+@racket[U] to group them), the relationship must be reversed:
+
+@chunk[<invariant-contract-subtyping>
+ (struct InvStrongContra ())
+ (struct InvWeakContra InvStrongContra ())]
+
+Alternatively, it is possible to use a second contravariant position to
+reverse the subtyping relationship again:
+
+@chunk[<invariant-contract-subtyping>
+ (struct InvWeak ())
+ (struct InvStrong InvWeak ())
+
+ (define InvWeakContra (→ InvWeak Void))
+ (define InvStrongContra (→ InvStrong Void))]
+
+Finally, we note that the invariants should always be represented using a
+particular struct type, instead of using a symbol, so that name clashes are
+not a problem.
+
+@section{Types for some graph contracts}
+
+@chunk[<structural>
+ (≡ [a : Nd] (get a f1 f2))
+ (∈ [a : Nd] (get a f1 f2))
+ (∉ [a : Nd] (get a f1 f2))
+ (∉ [a : Nd] (get a (* f1 f2 f3 f4) (* f5 f6)))]
@chunk[<*>
(void)]
\ No newline at end of file
diff --git a/notations.rkt b/notations.rkt
@@ -0,0 +1,7 @@
+#lang racket
+
+(require scribble/base)
+
+(provide texsubtype)
+
+(define texsubtype "<:")
+\ No newline at end of file
diff --git a/test/test-flexible-with.rkt b/test/test-flexible-with.rkt
@@ -22,15 +22,13 @@
[struct struct-field …] …)))]))
(gs bt-fields
- 257
+ 16
(a b c)
[sab a b]
[sbc b c]
[sabc a b c])
-;(define-type btac (bt-fields a c))
-
-#|
+(define-type btac (bt-fields a c))
(check-equal?:
(~> (ann (with-c (sab→tree 1 2) 'nine)
@@ -78,5 +76,4 @@
(call-with-values
#λ(tree→sbc (without-a (with-c (sab→tree 1 2) 3)))
list)
- '(2 3))
-|#
-\ No newline at end of file
+ '(2 3))
+\ No newline at end of file
diff --git a/times.rkt b/times.rkt.txt
