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

Got printing of the graph-info working

Browse Source
This commit is contained in:
Georges Dupéron 2017-01-17 23:03:41 +01:00
parent bd04ef6262
commit 1ef7613daa
3 changed files with 34 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

63
graph-info.hl.rkt
View File

@ -132,10 +132,20 @@ data.
(define (to-datum v) (define (to-datum v)
(syntax->datum (datum->syntax #f v))) (syntax->datum (datum->syntax #f v)))
(define (struct-printer2 ctor) (define ((syntax-convert old-print-convert-hook)
(make-constructor-style-printer val basic-convert sub-convert)
(λ (v) ctor) (cond
(λ (v) (map to-datum (struct->list v))))) [(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 ((struct-printer ctor) st port mode) (define ((struct-printer ctor) st port mode)
(match-define (vector name fields ...) (struct->vector st)) (match-define (vector name fields ...) (struct->vector st))
@ -162,42 +172,23 @@ data.
(display (to-datum f) port)) (display (to-datum f) port))
fields) fields)
(display ")" port)] (display ")" port)]
[(0) [else
(display "(" port) (let ([old-print-convert-hook (current-print-convert-hook)])
(display short-name port) (parameterize ([constructor-style-printing #t]
(for-each (λ (f) [show-sharing #f]
(display " " port) [current-print-convert-hook
;; Circumvent the undocumented(?) autodetection of (syntax-convert old-print-convert-hook)])
;; print which changes the behaviour if objects which (write
;; are not eq? to the original fields are directly (cons short-name
;; printed to the port. (map print-convert
(let ([str (with-output-to-string ;; to-datum doesn't work if I map it on the fields?
(λ () fields))
(print (to-datum f) (current-output-port) 0)))]) port)))]))]
(display (string-append str " ") port)))
fields)
(display ")" port)]
[(1)
(display "#(" port)
(display name port)
(for-each (λ (f)
(display " " port)
(display
;; Circumvent the undocumented(?) autodetection of
;; print which changes the behaviour if objects which
;; are not eq? to the original fields are directly
;; printed to the port.
#;(with-output-to-string
(λ ()
(print (to-datum f) (current-output-port) 1)))
"abab"
port))
fields)
(display ")" port)]))]
@CHUNK[<*> @CHUNK[<*>
(require phc-toolkit/untyped (require phc-toolkit/untyped
racket/struct racket/struct
mzlib/pconvert
(for-syntax phc-toolkit/untyped (for-syntax phc-toolkit/untyped
syntax/parse syntax/parse
syntax/parse/experimental/template)) syntax/parse/experimental/template))

7
graph-type.hl.rkt
View File

@ -28,9 +28,10 @@
(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)
(pretty-print gi (current-output-port) 0) (parameterize ([pretty-print-columns 188])
(pretty-print gi (current-output-port) 0))
#`(begin #`(begin
(define-syntax name #,gi)))] #;(define-syntax name #,gi)))]
@chunk[<graph-info> @chunk[<graph-info>
(graph-info #'name (graph-info #'name
@ -84,7 +85,7 @@
phc-toolkit/untyped phc-toolkit/untyped
(subtract-in syntax/parse phc-graph/subtemplate) (subtract-in syntax/parse phc-graph/subtemplate)
racket/set racket/set
phc-graph/subtemplate)) phc-graph/subtemplate-override))
(provide define-graph-type) (provide define-graph-type)

3
info.rkt
View File

@ -12,7 +12,8 @@
"delay-pure" "delay-pure"
"backport-template-pr1514" "backport-template-pr1514"
"typed-map" "typed-map"
"scribble-lib")) "scribble-lib"
"pconvert-lib"))
(define build-deps '("scribble-lib" (define build-deps '("scribble-lib"
"racket-doc" "racket-doc"
"remember" "remember"