From 00c5471830ada9e0223843a498816d226c69fef7 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Georges=20Dup=C3=A9ron?= <georges.duperon@gmail.com>
Date: Wed, 18 Jan 2017 03:37:42 +0100
Subject: [PATCH] Found source of the "ill-formed code (unexpected graph
 structure)" error (https://github.com/racket/racket/issues/1580)

---
 graph-type.hl.rkt        | 29 +++++++++++++++++++++++++++--
 test/test-graph-type.rkt | 32 +++++++++++++++++++++-----------
 2 files changed, 48 insertions(+), 13 deletions(-)

diff --git a/graph-type.hl.rkt b/graph-type.hl.rkt
index d0f8710..948ac99 100644
--- 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
index 6a08b80..9abe7ef 100644
--- 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)
+|#
+