make enumerations print the prefix of their enumeration

This commit is contained in:
Robby Findler 2014-11-26 09:20:28 -06:00
parent 5612ebef02
commit c79a5573f9
2 changed files with 70 additions and 3 deletions

View File

@ -194,10 +194,49 @@
[base/e enum?]
[any/e enum?]))
(define enum-printing (make-parameter 0))
;; an enum a is a struct of < Nat or +Inf, Nat -> a, a -> Nat >
(struct enum
(size from to)
#:prefab)
(struct enum (size from to)
#:methods gen:custom-write
[(define (write-proc enum port mode)
(define recur
(case mode
[(#t) write]
[(#f) display]
[else (lambda (p port) (print p port mode))]))
(display "#<enum" port)
(parameterize ([enum-printing (+ (enum-printing) 1)])
(let loop ([i 0] [chars 0])
;; chars is an approximation on how much
;; we've printed so far.
(when (<= chars 20)
(define ele (from-nat enum i))
(define sp (open-output-string))
(recur ele sp)
(define s (get-output-string sp))
(cond
[(equal? s "")
;; if any enumeration values print as empty
;; strings, then we just give up so as to avoid
;; 'i' never incrementing and never terminating
(display ">" port)]
[else
(if (zero? i)
(display ": " port)
(display " " port))
;; only print twice up to depth 2 in order to avoid bad
;; algorithmic behavior (so enumerations of enumerations
;; of enumerations might look less beautiful in drracket)
(cond
[(<= (enum-printing) 2)
(display s port)]
[else
(recur ele port)])
(loop (+ i 1)
(+ chars (string-length s) 1))]))))
(display "...>" port))])
;; size : enum a -> Nat or +Inf
(define (size e)

View File

@ -456,3 +456,31 @@
(test-begin
(check-equal? (from-nat emptys/e 0) '())
(check-bijection? emptys/e))
(define (to-str e print?)
(define sp (open-output-string))
(if print?
(print e sp)
(write e sp))
(get-output-string sp))
;; printer tests
(check-equal? (to-str nat/e #t) "#<enum: 0 1 2 3 4 5 6 7 8 9 10...>")
(check-equal? (to-str (cons/e nat/e nat/e) #t) "#<enum: '(0 . 0) '(0 . 1) '(1 . 0)...>")
(check-equal? (to-str (cons/e nat/e nat/e) #f) "#<enum: (0 . 0) (0 . 1) (1 . 0)...>")
;; just check that it doesn't crash when we get deep nesting
;; (checks that we end up in the case that just uses the string
;; in the implementation of the enumerator printer)
(check-equal? (string? (to-str
(map/e (λ (i)
(map/e (λ (j)
(map/e (λ (k) (+ i j k))
(λ (_) (error 'ack))
nat/e))
(λ (_) (error 'ack))
nat/e))
(λ (_) (error 'ack))
nat/e)
#t))
#t)