check-recursion ( obj quot: ( obj -- ) -- ) (original) (raw)

Vocabulary
prettyprint.backend

Inputs

Outputs
None

Word description
If the object is already being printed, that is, if the prettyprinter has encountered a cycle in the object graph, or if the maximum nesting depth has been reached, outputs a dummy string. Otherwise applies the quotation to the object.

Notes
This word should only be called from inside the with-pprint combinator.

Definition

USING: accessors classes kernel namespaces prettyprint.sections
sequences ;

IN: prettyprint.backend

: check-recursion ( obj quot: ( obj -- ) -- )
nesting-limit?
[ drop [ class-of name>> "~" 1surround ] keep present-text ]
[
over recursion-check get member-eq?
[ drop "~circularity~" swap present-text ] [
over recursion-check get push call
recursion-check get pop*
] if
] if ; inline