+
+;; Different versions of a simple pretty-printer for use in testing
+;; objfile/progspace lookup.
+
+(define (make-objfile-pp_s-printer val)
+ (make-pretty-printer-worker
+ #f
+ (lambda (printer)
+ (pp_s-printer "objfile " val))
+ #f))
+
+(define (install-objfile-pretty-printers! pspace objfile-name)
+ (let ((objfiles (filter (lambda (objfile)
+ (string-contains (objfile-filename objfile)
+ objfile-name))
+ (progspace-objfiles pspace)))
+ (dict (make-hash-table)))
+ (if (not (= (length objfiles) 1))
+ (error "objfile not found or ambiguous: " objfile-name))
+ (hash-set! dict "s" make-objfile-pp_s-printer)
+ (let ((pp (make-pretty-printer-from-dict
+ "objfile-pretty-printer-test"
+ dict lookup-pretty-printer-maker-from-dict)))
+ (append-pretty-printer! (car objfiles) pp))))
+
+(define (make-progspace-pp_s-printer val)
+ (make-pretty-printer-worker
+ #f
+ (lambda (printer)
+ (pp_s-printer "progspace " val))
+ #f))
+
+(define (install-progspace-pretty-printers! pspace)
+ (let ((dict (make-hash-table)))
+ (hash-set! dict "s" make-progspace-pp_s-printer)
+ (let ((pp (make-pretty-printer-from-dict
+ "progspace-pretty-printer-test"
+ dict lookup-pretty-printer-maker-from-dict)))
+ (append-pretty-printer! pspace pp))))