diff --git a/pkgs/data-pkgs/data-enumerate-lib/data/enumerate.rkt b/pkgs/data-pkgs/data-enumerate-lib/data/enumerate.rkt index e0f42f190f..2bc4cd4a63 100644 --- a/pkgs/data-pkgs/data-enumerate-lib/data/enumerate.rkt +++ b/pkgs/data-pkgs/data-enumerate-lib/data/enumerate.rkt @@ -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 "#" 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) diff --git a/pkgs/data-pkgs/data-test/tests/data/enumerate.rkt b/pkgs/data-pkgs/data-test/tests/data/enumerate.rkt index 32f492cdeb..7f01090e05 100644 --- a/pkgs/data-pkgs/data-test/tests/data/enumerate.rkt +++ b/pkgs/data-pkgs/data-test/tests/data/enumerate.rkt @@ -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) "#") +(check-equal? (to-str (cons/e nat/e nat/e) #t) "#") +(check-equal? (to-str (cons/e nat/e nat/e) #f) "#") + +;; 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)