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

Cleaned up flexible structures implementation. The problem is that compiling the definitions is rather slow (~4 minutes for 10/128 fields), although those can be pre-compiled in advance, and using the functions is rather slow to typecheck (about 0.4s to use a 10/32 constructor), which is more of a problem.

Browse Source
This commit is contained in:
Georges Dupéron 2017-05-18 15:10:33 +02:00
parent 8f13786bf0
commit bf9d5b2328
3 changed files with 60 additions and 39 deletions

12
binarytree.hl.rkt Normal file
View File

@ -0,0 +1,12 @@
#lang type-expander
(provide BinaryTree)
(require (for-syntax syntax/parse
phc-toolkit/aliases))
(define-type-expander BinaryTree
(syntax-parser
[(_ leafⱼ …)
;; TODO: implement BinaryTree.
#'(List leafⱼ …)]))

31
flexible-with-generalized-ctor-test.rkt
View File

@ -1,13 +1,28 @@
#lang type-expander
(require (lib "phc-graph/flexible-with-generalized-ctor.hl.rkt"))
(provide f g)
(require "flexible-with-generalized-ctor.hl.rkt"
"binarytree.hl.rkt")
(provide f-4-2 f-8-3)
(builder-f f 4 2)
(builder-f f-4-2 4 2)
#;((inst f propagate-τ '|1| Number '|3| String)
oracle '|1| 100 '|3| "bee")
(ann ((inst f-4-2 propagate-τ '|1| Number '|3| String)
oracle '|1| 100 '|3| "bee")
(BinaryTree
(Promise (Pairof #f Any))
(Promise (Pairof '|1| Number))
(Promise (Pairof #f Any))
(Promise (Pairof '|3| String))))
(builder-f g 8 3)
(builder-f f-8-3 8 3)
#;((inst g propagate-τ '|1| Number '|3| String '|7| Symbol)
oracle '|1| 100 '|3| "bee" '|7| 'buzz)
(ann ((inst f-8-3 propagate-τ '|1| Number '|3| String '|7| Symbol)
oracle '|1| 100 '|3| "bee" '|7| 'buzz)
(BinaryTree
(Promise (Pairof #f Any))
(Promise (Pairof '|1| Number))
(Promise (Pairof #f Any))
(Promise (Pairof '|3| String))
(Promise (Pairof #f Any))
(Promise (Pairof #f Any))
(Promise (Pairof #f Any))
(Promise (Pairof '|7| Symbol))))

56
flexible-with-generalized-ctor.hl.rkt
View File

@ -9,7 +9,6 @@
꩜chunk[<*>
(provide builder-τ
None
propagate-τ
oracle
builder-f)
@ -20,15 +19,8 @@
racket/list
racket/function
subtemplate/override)
(for-meta 2 racket/base))
(struct (T) None ([f : (Promise T)]))
(define-type-expander BinaryTree
(syntax-parser
[(_ leafⱼ …)
;; TODO: implement BinaryTree.
#'(List leafⱼ …)]))
(for-meta 2 racket/base)
"binarytree.hl.rkt")
<propagate-τ>
<oracle-τ>
@ -70,7 +62,7 @@ form of) the builder function type as follows:
(→ (code:comment "; Keys and values:")
{?@ (∩ Kⱼ (U 'NSymⱼᵢ …)) Xⱼ} …
;; Result type:
(BinaryTree |<Some or None>| …)))]
(BinaryTree (Promise |<Some or None>|) …)))]
We expect each key ꩜racket[Kⱼ] to be a symbol of the shape ꩜racket[|0|],
꩜racket[|1|], ꩜racket[|2|] and so on:
@ -115,11 +107,12 @@ otherwise. The second element of the pair contains our expected
꩜racket[(Some Xⱼ)] type, but the whole pair is collapsed to ꩜racket[Nothing]
when ꩜racket[Kⱼ] is not ꩜racket['NSymᵢ].
We use a similar approach to conditionally produce the ꩜racket[None] element,
but instead of intersecting ꩜racket[Kⱼ] with ꩜racket['NSymᵢ], we intersect it
with the complement of ꩜racket['NSymᵢ]. Typed Racket lacks the possibility to
negate a type, so we manually compute the complement of ꩜racket['NSymᵢ] in the
set of possible keys (that is, ꩜racket['NSymᵢ …]).
We use a similar approach to conditionally produce the ꩜racket[None] element
(which we represent as ꩜racket[#f]), but instead of intersecting ꩜racket[Kⱼ]
with ꩜racket['NSymᵢ], we intersect it with the complement of ꩜racket['NSymᵢ].
Typed Racket lacks the possibility to negate a type, so we manually compute
the complement of ꩜racket['NSymᵢ] in the set of possible keys (that is,
꩜racket['NSymᵢ …]).
꩜chunk[<builder-τ-with-3>
#:with NSyms (NSymᵢ …)
@ -138,7 +131,7 @@ The resulting type should therefore be ꩜racket[Nothing] only if there is no
꩜racket[(List . exceptᵢ)] otherwise.
꩜chunk[|<None if ∀ k ∈ Kⱼ , k ≠ NSymᵢ>|
(None (List {∩ Kᵢⱼ {U 'exceptᵢⱼ …}} …))]
(Pairof #f (List {∩ Kᵢⱼ {U 'exceptᵢⱼ …}} …))]
This approach relies on the fact that occurrences of ꩜racket[Nothing] within
structs and pairs containing collapse the entire struct or pair type to
@ -163,12 +156,12 @@ To force Typed Racket to propagate ꩜racket[Nothing] outwards as much as
we need, we intersect the whole form with a polymorphic type ꩜racket[A]:
꩜hlite[|<builder-function-type'>|
{/(∀(+ _ / _ _)(→ _ _ ooo (bt + (∩ / _ + A) / _)))}
{/(∀(+ _ / _ _)(→ _ _ ooo (bt (p + (∩ / _ + A)) / ooo)))}
(∀ (A {?@ Kⱼ Xⱼ} …)
(→ (code:comment "; Keys and values:")
{?@ (∩ Kⱼ (U 'NSymⱼᵢ …)) Xⱼ} …
;; Result type:
(BinaryTree (∩ |<Some or None>| A) …)))]
(BinaryTree (Promise (∩ |<Some or None>| A)) …)))]
The type ꩜racket[propagate-τ] defined below is used to instantiate ꩜racket[A],
and is carefully picked so that its intersection will in no way change the
@ -180,8 +173,8 @@ instantiated.
꩜chunk[<propagate-τ>
(define-type propagate-τ
(U (Pairof Any Any)
(None (Listof Any))))]
(U (Pairof Symbol Any)
(Pairof #f (Listof Symbol))))]
꩜;Use chunkref instead of ꩜racket[|<Some or None>|] ?
@ -199,8 +192,8 @@ upgrade.
꩜chunk[<oracle-τ>
(define-type (oracle-τ A)
(∀ (B) (→ (∩ B
(U (Pairof Any Any)
(None (Listof Any))))
(U (Pairof Symbol Any)
(Pairof #f (Listof Symbol))))
(∩ A B))))]
The oracle does nothing more than return its argument unchanged:
@ -220,7 +213,7 @@ oracle:
(code:comment "; Keys and values:")
{?@ (∩ Kⱼ (U 'NSymⱼᵢ …)) Xⱼ} …
;; Result type:
(BinaryTree (∩ |<Some or None>| A) …)))]
(BinaryTree (Promise (∩ |<Some or None>| A)) …)))]
@ -243,11 +236,12 @@ oracle:
꩜chunk[<builder-function-implementation>
(: name |<builder-function-type''>| #;(builder-τ n m))
(define (name oracle {?@ kⱼ xⱼ} …)
(list (cond
[((make-predicate 'NSymᵢⱼ) kᵢⱼ)
((inst oracle (Pairof (∩ Kᵢⱼ 'NSymᵢⱼ) Xᵢⱼ)) (cons kᵢⱼ xᵢⱼ))]
…
[else
((inst oracle (None (List (∩ Kᵢⱼ (U 'exceptᵢⱼ …)) …)))
(None (delay (list kᵢⱼ …))))])
(list (delay
(cond
[((make-predicate 'NSymᵢⱼ) kᵢⱼ)
((inst oracle (Pairof (∩ Kᵢⱼ 'NSymᵢⱼ) Xᵢⱼ)) (cons kᵢⱼ xᵢⱼ))]
…
[else
((inst oracle (Pairof #f (List (∩ Kᵢⱼ (U 'exceptᵢⱼ …)) …)))
(cons #f (list kᵢⱼ …)))]))
…))]