commit 00c5471830ada9e0223843a498816d226c69fef7 parent 3caeea4d9ff979113fd5f0acad7889c726f912af Author: Georges Dupéron <georges.duperon@gmail.com> Date: Wed, 18 Jan 2017 03:37:42 +0100 Found source of the "ill-formed code (unexpected graph structure)" error (https://github.com/racket/racket/issues/1580) Diffstat:
| M | graph-type.hl.rkt | | | 29 | +++++++++++++++++++++++++++-- |
| M | test/test-graph-type.rkt | | | 33 | +++++++++++++++++++++------------ |
2 files changed, 48 insertions(+), 14 deletions(-)
diff --git a/graph-type.hl.rkt b/graph-type.hl.rkt @@ -25,11 +25,36 @@ {~seq #:invariant a {~and op {~or ∈ ∋ ≡ ≢ ∉}} b} … {~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 gi <graph-info>) (local-require racket/pretty) - #;(parameterize ([pretty-print-columns 188]) - (pretty-print gi (current-output-port) 0)) + #;(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)]) + (parameterize ([pretty-print-columns 188]) + (pretty-write (print-convert gi))))) #`(begin (define-syntax name #,gi)))] diff --git a/test/test-graph-type.rkt b/test/test-graph-type.rkt @@ -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 (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) -\ No newline at end of file +#;(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) +|# +