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

Found source of the "ill-formed code (unexpected graph structure)" error (https://github.com/racket/racket/issues/1580)

Browse Source
This commit is contained in:
Georges Dupéron 2017-01-18 03:37:42 +01:00
parent 3caeea4d9f
commit 00c5471830
2 changed files with 48 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
graph-type.hl.rkt
View File

@ -25,11 +25,36 @@
{~seq #:invariant a {~and op {~or ∈ ∋ ≡ ≢ ∉}} b} … {~seq #:invariant a {~and op {~or ∈ ∋ ≡ ≢ ∉}} b} …
{~seq #:invariant p} …)))) {~seq #:invariant p} …))))
;; DEBUG
(require (for-syntax mzlib/pconvert
racket/list))
(define-for-syntax (to-datum v)
(syntax->datum (datum->syntax #f v)))
(define-for-syntax ((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-syntax/parse (define-graph-type . :signature) (define-syntax/parse (define-graph-type . :signature)
(define gi <graph-info>) (define gi <graph-info>)
(local-require racket/pretty) (local-require racket/pretty)
#;(parameterize ([pretty-print-columns 188]) #;(let ([old-print-convert-hook (current-print-convert-hook)])
(pretty-print gi (current-output-port) 0)) (parameterize ([constructor-style-printing #t]
[show-sharing #f]
[current-print-convert-hook
(syntax-convert old-print-convert-hook)])
(parameterize ([pretty-print-columns 188])
(pretty-write (print-convert gi)))))
#`(begin #`(begin
(define-syntax name #,gi)))] (define-syntax name #,gi)))]

32
test/test-graph-type.rkt
View File

@ -1,16 +1,26 @@
#lang typed/racket #lang racket
(define-syntax (mk stx)
(syntax-case stx ()
[(_ x)
#`(define-syntax x
#,(make-prefab-struct 's (hash)))]))
(mk x)
#|
(require phc-adt (require phc-adt
(lib "phc-graph/graph-type.hl.rkt")) (lib "phc-graph/graph-type.hl.rkt"))
(adt-init) (adt-init)
(define-graph-type g1 #;(define-graph-type g1
[City [name : String] [City [name : String]
[streets : (Listof Street)] [streets : (Listof Street)]
[citizens : (Listof Person)]] [citizens : (Listof Person)]]
[Street [name : String] [Street [name : String]
[houses : (Listof House)]] [houses : (Listof House)]]
[House [owner : Person]] [House [owner : Person]]
[Person [name : String]] [Person [name : String]]
#:invariant City.citizens._ ∈ City.streets._.houses._.owner #:invariant City.citizens._ ∈ City.streets._.houses._.owner
#:invariant City.citizens._ ∋ City.streets._.houses._.owner) #:invariant City.citizens._ ∋ City.streets._.houses._.owner)
|#