From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from omta037.useast.a.cloudfilter.net (omta037.useast.a.cloudfilter.net [44.202.169.36]) by sourceware.org (Postfix) with ESMTPS id 7E1A43858C1F for ; Sat, 19 Aug 2023 20:24:03 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 7E1A43858C1F Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=tromey.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=tromey.com Received: from eig-obgw-5003a.ext.cloudfilter.net ([10.0.29.159]) by cmsmtp with ESMTP id XMxAqlnR8WU1cXSUNq7fpg; Sat, 19 Aug 2023 20:24:03 +0000 Received: from box5379.bluehost.com ([162.241.216.53]) by cmsmtp with ESMTPS id XSUMqxIzz9I7XXSUMq2I43; Sat, 19 Aug 2023 20:24:03 +0000 X-Authority-Analysis: v=2.4 cv=RfaDtnhv c=1 sm=1 tr=0 ts=64e124e3 a=ApxJNpeYhEAb1aAlGBBbmA==:117 a=ApxJNpeYhEAb1aAlGBBbmA==:17 a=OWjo9vPv0XrRhIrVQ50Ab3nP57M=:19 a=dLZJa+xiwSxG16/P+YVxDGlgEgI=:19 a=UttIx32zK-AA:10 a=Qbun_eYptAEA:10 a=f0N82Vsox4_WMKUOApIA:9 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=tromey.com; s=default; h=Content-Transfer-Encoding:MIME-Version:References:In-Reply-To: Message-ID:Date:Subject:Cc:To:From:Sender:Reply-To:Content-Type:Content-ID: Content-Description:Resent-Date:Resent-From:Resent-Sender:Resent-To:Resent-Cc :Resent-Message-ID:List-Id:List-Help:List-Unsubscribe:List-Subscribe: List-Post:List-Owner:List-Archive; bh=HEJK6e/bITjJijaBwCeqnGecC7MD7U0g21VMs4oNoS4=; b=ysYtbU6XBXbDA3Fkhk4IHdW8TY Hv0MmaWOce2Lm9vRCd43VlI0JrnAtEGI+2HWp4LJoDlPkshS5BSRRPBU9gzteH4ef7UEy3+mcu6MQ Cu0EKGV3eRpGNs6zixqA+INtL; Received: from 75-166-142-177.hlrn.qwest.net ([75.166.142.177]:36668 helo=localhost.localdomain) by box5379.bluehost.com with esmtpsa (TLS1.2) tls TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384 (Exim 4.96) (envelope-from ) id 1qXQ4Y-003yKO-0V; Sat, 19 Aug 2023 11:49:14 -0600 From: Tom Tromey To: cgen@sourceware.org Cc: Tom Tromey Subject: [RFC 14/14] Remove pprint.scm and cos-pprint.scm Date: Sat, 19 Aug 2023 11:42:13 -0600 Message-ID: <20230819174900.866436-15-tom@tromey.com> X-Mailer: git-send-email 2.41.0 In-Reply-To: <20230819174900.866436-1-tom@tromey.com> References: <20230819174900.866436-1-tom@tromey.com> MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-AntiAbuse: This header was added to track abuse, please include it with any abuse report X-AntiAbuse: Primary Hostname - box5379.bluehost.com X-AntiAbuse: Original Domain - sourceware.org X-AntiAbuse: Originator/Caller UID/GID - [47 12] / [47 12] X-AntiAbuse: Sender Address Domain - tromey.com X-BWhitelist: no X-Source-IP: 75.166.142.177 X-Source-L: No X-Exim-ID: 1qXQ4Y-003yKO-0V X-Source: X-Source-Args: X-Source-Dir: X-Source-Sender: 75-166-142-177.hlrn.qwest.net (localhost.localdomain) [75.166.142.177]:36668 X-Source-Auth: tom+tromey.com X-Email-Count: 0 X-Org: HG=bhshared;ORG=bluehost; X-Source-Cap: ZWx5bnJvYmk7ZWx5bnJvYmk7Ym94NTM3OS5ibHVlaG9zdC5jb20= X-Local-Domain: yes X-CMAE-Envelope: MS4xfGxfRuNO/5+eyTrUNj5Kq31YxEH60Qdw1J5eQg7n3zy4J3YLWcRoX9r4AAiTzTfrgO+nP69o8TTubVw/OLUravqeFNzD1Nkr7zF4R+X1wLSGE9KDYMJz sUl+Edt9/z1l00tlOg9Zw8wW0hNA5Z8NY7kmM4Ip2qLWk+Z9zR64LIv6HwpTIWfxj9p7AbMbQJsZKg== X-Spam-Status: No, score=-3025.0 required=5.0 tests=BAYES_00,DKIM_SIGNED,DKIM_VALID,GIT_PATCH_0,JMQ_SPF_NEUTRAL,SPF_HELO_NONE,SPF_PASS,TXREP autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org List-Id: pprint.scm and cos-pprint.scm are for debugging. They aren't used in-tree and Guile provides a pretty-printer now. --- cos-pprint.scm | 26 ------ pprint.scm | 212 ------------------------------------------------- 2 files changed, 238 deletions(-) delete mode 100644 cos-pprint.scm delete mode 100644 pprint.scm diff --git a/cos-pprint.scm b/cos-pprint.scm deleted file mode 100644 index 0bf55c6..0000000 --- a/cos-pprint.scm +++ /dev/null @@ -1,26 +0,0 @@ -;;;; cos-pprint.scm --- pretty-print definitions for COS -;;;; Copyright (C) 2005, 2009 Red Hat, Inc. -;;;; This file is part of CGEN. -;;;; See file COPYING.CGEN for details. - -;;; To use this with pprint.scm: -;;; -;;; (load "pprint.scm") -;;; (load "cos-pprint.scm") -;;; -;;; You must load this file second, so it can redefine the ELIDE? and -;;; ELIDED-NAME hooks. -;;; -;;; See the documentation in pprint.scm for details. - -(define (elide? obj) - (or (object? obj) (class? obj))) - -(define (elided-name obj) - (cond ((class? obj) `(class ,(class-name obj))) - ((object? obj) - `(object ,(class-name (object-class obj)) - ,@(if (method-present? obj 'get-name) - (list (send obj 'get-name)) - '()))) - (else (error "unexpected elided object")))) diff --git a/pprint.scm b/pprint.scm deleted file mode 100644 index 63d78bf..0000000 --- a/pprint.scm +++ /dev/null @@ -1,212 +0,0 @@ -;;;; pprint.scm --- pretty-printing objects for CGEN -;;;; Copyright (C) 2005, 2009 Red Hat, Inc. -;;;; This file is part of CGEN. -;;;; See file COPYING.CGEN for details. - -;;; This file defines a printing function PPRINT, and some hooks to -;;; let you print certain kind of objects in a summary way, and get at -;;; their full values later. - -;;; PPRINT is a printer for Scheme objects that prints lists or -;;; vectors that contain shared structure or cycles and prints them in -;;; a finite, legible way. -;;; -;;; Ordinary values print in the usual way: -;;; -;;; guile> (pprint '(1 #(2 3) 4)) -;;; (1 #(2 3) 4) -;;; -;;; Values can share structure: -;;; -;;; guile> (let* ((c (list 1 2)) -;;; (d (list c c))) -;;; (write d) -;;; (newline)) -;;; ((1 2) (1 2)) -;;; -;;; In that list, the two instances of (1 2) are actually the same object; -;;; the top-level list refers to the same object twice. -;;; -;;; Printing that structure with PPRINT shows the sharing: -;;; -;;; guile> (let* ((c (list 1 2)) -;;; (d (list c c))) -;;; (pprint d)) -;;; (#0=(1 2) #0#) -;;; -;;; Here the "#0=" before the list (1 2) labels it with the number -;;; zero. Then, the "#0#" as the second element of the top-level list -;;; indicates that the object appears here, too, referring to it by -;;; its label. -;;; -;;; If you have several objects that appear more than once, they each -;;; get a separate label: -;;; -;;; guile> (let* ((a (list 1 2)) -;;; (b (list 3 4)) -;;; (c (list a b a b))) -;;; (pprint c)) -;;; (#0=(1 2) #1=(3 4) #0# #1#) -;;; -;;; Cyclic values just share structure with themselves: -;;; -;;; guile> (let* ((a (list 1 #f))) -;;; (set-cdr! a a) -;;; (pprint a)) -;;; #0=(1 . #0#) -;;; -;;; -;;; PPRINT also consults the function ELIDE? and ELIDED-NAME to see -;;; whether it should print a value in a summary form. You can -;;; re-define those functions to customize PPRINT's behavior; -;;; cos-pprint.scm defines them to handle COS objects and classes -;;; nicely. -;;; -;;; (ELIDE? OBJ) should return true if OBJ should be elided. -;;; (ELIDED-NAME OBJ) should return a (non-cyclic!) object to be used -;;; as OBJ's abbreviated form. -;;; -;;; PPRINT prints an elided object as a list ($ N NAME), where NAME is -;;; the value returned by ELIDED-NAME to stand for the object, and N -;;; is a number; each elided object gets its own number. You can refer -;;; to the elided object number N as ($ N). -;;; -;;; For example, if you've loaded CGEN, pprint.scm, and cos-pprint.scm -;;; (you must load cos-pprint.scm *after* loading pprint.scm), you can -;;; print a list containing the and classes: -;;; -;;; guile> (pprint (list )) -;;; (($ 1 (class )) ($ 2 (class ))) -;;; guile> (class-name ($ 1)) -;;; -;;; guile> (class-name ($ 2)) -;;; -;;; -;;; As a special case, PPRINT never elides the object that was passed -;;; to it directly. So you can look inside an elided object by doing -;;; just that: -;;; -;;; guile> (pprint ($ 2)) -;;; #0=#("class" () ((name #:unbound #f . 0) ... -;;; - - -;;; A list of elided objects, larger numbers first, and the number of -;;; the first element. -(define elide-table '()) -(define elide-table-last -1) - -;;; Add OBJ to the elided object list, and return its number. -(define (add-elided-object obj) - (set! elide-table (cons obj elide-table)) - (set! elide-table-last (+ elide-table-last 1)) - elide-table-last) - -;;; Referencing elided objects. -(define ($ n) - (if (<= 0 n elide-table-last) - (list-ref elide-table (- elide-table-last n)) - "no such object")) - -;;; A default predicate for elision. -(define (elide? obj) #f) - -;;; If (elide? OBJ) is true, return some sort of abbreviated list -;;; structure that might be helpful to the user in identifying the -;;; elided object. -;;; A default definition. -(define (elided-name obj) "") - -;;; This is a pretty-printer that handles cyclic and shared structure. -(define (pprint original-obj) - - ;; Return true if OBJ should be elided in this call to pprint. - ;; (We never elide the object we were passed itself.) - (define (elide-this-call? obj) - (and (not (eq? obj original-obj)) - (elide? obj))) - - ;; First, traverse OBJ and build a hash table mapping objects - ;; referenced more than once to #t, and everything else to #f. - ;; (Only include entries for objects that might be interior nodes: - ;; pairs and vectors.) - (let ((shared - ;; Guile's stupid hash tables don't resize the table; the - ;; chains just get longer and longer. So we need a big value here. - (let ((seen (make-hash-table 65521)) - (shared (make-hash-table 4093))) - (define (walk! obj) - (if (or (pair? obj) (vector? obj)) - (if (hashq-ref seen obj) - (hashq-set! shared obj #t) - (begin - (hashq-set! seen obj #t) - (cond ((elide-this-call? obj)) - ((pair? obj) (begin (walk! (car obj)) - (walk! (cdr obj)))) - ((vector? obj) (do ((i 0 (+ i 1))) - ((>= i (vector-length obj))) - (walk! (vector-ref obj i)))) - (else (error "unhandled interior type"))))))) - (walk! original-obj) - shared))) - - ;; A counter for shared structure labels. - (define fresh-shared-label - (let ((n 0)) - (lambda () - (let ((l n)) - (set! n (+ n 1)) - l)))) - - (define (print obj) - (print-with-label obj (hashq-ref shared obj))) - - ;; Print an object OBJ, which SHARED maps to L. - ;; L is always (hashq-ref shared obj), but we have that value handy - ;; at times, so this entry point lets us avoid looking it up again. - (define (print-with-label obj label) - (if (number? label) - ;; If we've already visited this object, just print a - ;; reference to its label. - (map display `("#" ,label "#")) - (begin - ;; If it needs a label, attach one now. - (if (eqv? label #t) (let ((label (fresh-shared-label))) - (hashq-set! shared obj label) - (map display `("#" ,label "=")))) - ;; Print the object. - (cond ((elide-this-call? obj) - (write (list '$ (add-elided-object obj) (elided-name obj)))) - ((pair? obj) (begin (display "(") - (print-tail obj))) - ((vector? obj) (begin (display "#(") - (do ((i 0 (+ i 1))) - ((>= i (vector-length obj))) - (print (vector-ref obj i)) - (if (< (+ i 1) (vector-length obj)) - (display " "))) - (display ")"))) - (else (write obj)))))) - - ;; Print a pair P as if it were the tail of a list; assume the - ;; opening paren and any previous elements have been printed. - (define (print-tail obj) - (print (car obj)) - (force-output) - (let ((tail (cdr obj))) - (if (null? tail) - (display ")") - ;; We use the dotted pair syntax if the cdr isn't a pair, but - ;; also if it needs to be labeled. - (let ((tail-label (hashq-ref shared tail))) - (if (or (not (pair? tail)) tail-label) - (begin (display " . ") - (print-with-label tail tail-label) - (display ")")) - (begin (display " ") - (print-tail tail))))))) - - (print original-obj) - (newline))) - -- 2.41.0