-
Notifications
You must be signed in to change notification settings - Fork 0
/
printv.lisp
98 lines (85 loc) · 3.72 KB
/
printv.lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
;;;; -*- Mode:Common-Lisp; Package:Common-Lisp-User; Syntax:common-lisp -*-
;;;; *-* File: /usr/local/gbbopen/printv.lisp *-*
;;;; *-* Edited-By: cork *-*
;;;; *-* Last-Edit: Tue Nov 16 13:50:22 2010 *-*
;;;; *-* Machine: cyclone.cs.umass.edu *-*
;;;; **************************************************************************
;;;; **************************************************************************
;;;; *
;;;; * Handy PRINTV Macro
;;;; *
;;;; **************************************************************************
;;;; **************************************************************************
;;;
;;; Written by: Dan Corkill
;;;
;;; Copyright (C) 2006-2010, Dan Corkill <corkill@GBBopen.org>
;;; Part of the GBBopen Project.
;;; Licensed under Apache License 2.0 (see LICENSE for license information).
;;;
;;; * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
;;;
;;; 06-05-09 Copied from module-manager.lisp for stand-alone use. (Corkill)
;;;
;;; * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
(in-package :common-lisp-user)
;;; ---------------------------------------------------------------------------
;;; NOTE: Keep synchronized with the original PRINTV definitions in
;;; module-manager.lisp
;;; ---------------------------------------------------------------------------
(defun printv-separator ()
(format *trace-output* "~&;; ~60,,,'-<-~>~%")
(force-output *trace-output*))
;;; ---------------------------------------------------------------------------
(defun printv-form-printer (form)
(typecase form
;; String (label):
(string (format *trace-output* "~&;; ~a~%" form))
;; Evaluated form:
((or cons
(and symbol (not keyword)))
(format *trace-output* "~&;; ~w =>" form))
;; Self-evaluating form:
(t (format *trace-output* "~&;; ~s~%" form)))
(force-output *trace-output*))
;;; ---------------------------------------------------------------------------
(defun printv-values-printer (values-list)
(format *trace-output*
"~:[ [returned 0 values]~;~:*~{ ~w~^;~}~]~%"
values-list)
(force-output *trace-output*))
;;; ---------------------------------------------------------------------------
(defun printv-expander (forms
;; Allow for customized printv-style printv'ers:
&optional values-trans-fn)
(let ((result-sym (gensym)))
`(let ((*print-readably* nil)
,result-sym)
,@(loop for form in forms
nconcing
(cond
;; Separator requested?
((eq form ':hr)
;; list used for splicing protection...
(list '(printv-separator)))
;; Evaluated form:
((or (consp form)
(and (symbolp form)
(not (keywordp form))))
`((printv-form-printer ',form)
(printv-values-printer
(setf ,result-sym
,(if values-trans-fn
`(funcall ,values-trans-fn
(multiple-value-list ,form))
`(multiple-value-list ,form))))))
;; Self-evaluating form:
(t `((printv-form-printer
(car (setf ,result-sym (list ,form))))))))
(values-list ,result-sym))))
;;; ---------------------------------------------------------------------------
(defmacro printv (&rest forms)
(printv-expander forms))
;;; ===========================================================================
;;; End of File
;;; ===========================================================================