changelog shortlog graph tags branches changeset files file revisions raw help

Mercurial > core / annotate lisp/lib/skel/core/print.lisp

changeset 663: cc89b337384b
parent: 9e7d4393eac6
child: 4d8451fe5423
author: Richard Westhaver <ellis@rwest.io>
date: Sat, 21 Sep 2024 22:58:22 -0400
permissions: -rw-r--r--
description: skel upgrades, added skel/net
574
9e7d4393eac6 add skel/core/print.lisp, wrap up obj/query init
Richard Westhaver <ellis@rwest.io>
parents:
diff changeset
1
 ;;; print.lisp --- Skel Printer
9e7d4393eac6 add skel/core/print.lisp, wrap up obj/query init
Richard Westhaver <ellis@rwest.io>
parents:
diff changeset
2
 
9e7d4393eac6 add skel/core/print.lisp, wrap up obj/query init
Richard Westhaver <ellis@rwest.io>
parents:
diff changeset
3
 ;; SK-PRINT
9e7d4393eac6 add skel/core/print.lisp, wrap up obj/query init
Richard Westhaver <ellis@rwest.io>
parents:
diff changeset
4
 
9e7d4393eac6 add skel/core/print.lisp, wrap up obj/query init
Richard Westhaver <ellis@rwest.io>
parents:
diff changeset
5
 ;;; Commentary:
9e7d4393eac6 add skel/core/print.lisp, wrap up obj/query init
Richard Westhaver <ellis@rwest.io>
parents:
diff changeset
6
 
9e7d4393eac6 add skel/core/print.lisp, wrap up obj/query init
Richard Westhaver <ellis@rwest.io>
parents:
diff changeset
7
 ;; SK-PRINT is the top-level interface, and dispatches on all sorts of SKEL
9e7d4393eac6 add skel/core/print.lisp, wrap up obj/query init
Richard Westhaver <ellis@rwest.io>
parents:
diff changeset
8
 ;; objects. The output is different than the PRINT-OBJECT methods, which are
9e7d4393eac6 add skel/core/print.lisp, wrap up obj/query init
Richard Westhaver <ellis@rwest.io>
parents:
diff changeset
9
 ;; implemented in the SKEL/CORE/OBJ package.
9e7d4393eac6 add skel/core/print.lisp, wrap up obj/query init
Richard Westhaver <ellis@rwest.io>
parents:
diff changeset
10
 
9e7d4393eac6 add skel/core/print.lisp, wrap up obj/query init
Richard Westhaver <ellis@rwest.io>
parents:
diff changeset
11
 ;; SK-PRINT is the 'external print' representation, which is structured, akin
9e7d4393eac6 add skel/core/print.lisp, wrap up obj/query init
Richard Westhaver <ellis@rwest.io>
parents:
diff changeset
12
 ;; to PPRINT - while PRINT-OBJECT is the 'internal print' and unstructured
9e7d4393eac6 add skel/core/print.lisp, wrap up obj/query init
Richard Westhaver <ellis@rwest.io>
parents:
diff changeset
13
 ;; representation.
9e7d4393eac6 add skel/core/print.lisp, wrap up obj/query init
Richard Westhaver <ellis@rwest.io>
parents:
diff changeset
14
 
9e7d4393eac6 add skel/core/print.lisp, wrap up obj/query init
Richard Westhaver <ellis@rwest.io>
parents:
diff changeset
15
 ;; All printer parameters are dynamic and dispatch occurs in the same manner
9e7d4393eac6 add skel/core/print.lisp, wrap up obj/query init
Richard Westhaver <ellis@rwest.io>
parents:
diff changeset
16
 ;; as the standard Lisp Printer. Additional parameters may be provided in the
9e7d4393eac6 add skel/core/print.lisp, wrap up obj/query init
Richard Westhaver <ellis@rwest.io>
parents:
diff changeset
17
 ;; future.
9e7d4393eac6 add skel/core/print.lisp, wrap up obj/query init
Richard Westhaver <ellis@rwest.io>
parents:
diff changeset
18
 
9e7d4393eac6 add skel/core/print.lisp, wrap up obj/query init
Richard Westhaver <ellis@rwest.io>
parents:
diff changeset
19
 ;;; Code:
9e7d4393eac6 add skel/core/print.lisp, wrap up obj/query init
Richard Westhaver <ellis@rwest.io>
parents:
diff changeset
20
 (in-package :skel/core/print)
9e7d4393eac6 add skel/core/print.lisp, wrap up obj/query init
Richard Westhaver <ellis@rwest.io>
parents:
diff changeset
21
 
9e7d4393eac6 add skel/core/print.lisp, wrap up obj/query init
Richard Westhaver <ellis@rwest.io>
parents:
diff changeset
22
 ;; sb-pretty::*standard-pprint-dispatch-table*
9e7d4393eac6 add skel/core/print.lisp, wrap up obj/query init
Richard Westhaver <ellis@rwest.io>
parents:
diff changeset
23
 ;; *readtable*
9e7d4393eac6 add skel/core/print.lisp, wrap up obj/query init
Richard Westhaver <ellis@rwest.io>
parents:
diff changeset
24
 
9e7d4393eac6 add skel/core/print.lisp, wrap up obj/query init
Richard Westhaver <ellis@rwest.io>
parents:
diff changeset
25
 (sb-ext:defglobal *sk-print-dispatch-table* (sb-pretty::make-pprint-dispatch-table #() nil nil))
9e7d4393eac6 add skel/core/print.lisp, wrap up obj/query init
Richard Westhaver <ellis@rwest.io>
parents:
diff changeset
26
 
663
cc89b337384b skel upgrades, added skel/net
Richard Westhaver <ellis@rwest.io>
parents: 574
diff changeset
27
 (defmethod sk-print ((self skel) &key (stream t) (id t) &allow-other-keys)
cc89b337384b skel upgrades, added skel/net
Richard Westhaver <ellis@rwest.io>
parents: 574
diff changeset
28
   (if id
cc89b337384b skel upgrades, added skel/net
Richard Westhaver <ellis@rwest.io>
parents: 574
diff changeset
29
       (format stream "~S ~A~%" (keywordicate (class-name (class-of self))) (format-sxhash (obj/id:id self)))
cc89b337384b skel upgrades, added skel/net
Richard Westhaver <ellis@rwest.io>
parents: 574
diff changeset
30
       (format stream "~S~%" (keywordicate (class-name (class-of self)))))
cc89b337384b skel upgrades, added skel/net
Richard Westhaver <ellis@rwest.io>
parents: 574
diff changeset
31
   (mapcar 
cc89b337384b skel upgrades, added skel/net
Richard Westhaver <ellis@rwest.io>
parents: 574
diff changeset
32
    (lambda (slot)
cc89b337384b skel upgrades, added skel/net
Richard Westhaver <ellis@rwest.io>
parents: 574
diff changeset
33
      (let ((name (sb-mop:slot-definition-name slot)))
cc89b337384b skel upgrades, added skel/net
Richard Westhaver <ellis@rwest.io>
parents: 574
diff changeset
34
        (when (slot-boundp self name)
cc89b337384b skel upgrades, added skel/net
Richard Westhaver <ellis@rwest.io>
parents: 574
diff changeset
35
          (when-let ((val (slot-value self name)))
cc89b337384b skel upgrades, added skel/net
Richard Westhaver <ellis@rwest.io>
parents: 574
diff changeset
36
            (format stream ":~A ~A~%" name val)))))
cc89b337384b skel upgrades, added skel/net
Richard Westhaver <ellis@rwest.io>
parents: 574
diff changeset
37
    (sb-mop:class-direct-slots (class-of self)))
cc89b337384b skel upgrades, added skel/net
Richard Westhaver <ellis@rwest.io>
parents: 574
diff changeset
38
   self)