make enumerations print the prefix of their enumeration
This commit is contained in:
parent
5612ebef02
commit
c79a5573f9
|
@ -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)
|
||||
|
|
|
@ -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)
|
||||
|
|
Loading…
Reference in New Issue
Block a user