Skip to content

Commit 478d4a0

Browse files
committed
Parametrize *standard-output* to *output-stream* special var
That way I can capture the result of truth table by doing: (defun truth-table (exp) (with-output-to-string (s) (let ((inference:*output-stream* s)) (inference:print-truth-table (inference:infix-to-prefix exp)))))
1 parent 0b6ba4f commit 478d4a0

File tree

2 files changed

+17
-13
lines changed

2 files changed

+17
-13
lines changed

src/package.lisp

+1
Original file line numberDiff line numberDiff line change
@@ -46,5 +46,6 @@
4646
#:equal-expression
4747
#:truth
4848
#:truth-infix
49+
#:*output-stream*
4950
#:main)
5051
(:nicknames "INFERENCE"))

src/truth-table.lisp

+16-13
Original file line numberDiff line numberDiff line change
@@ -5,6 +5,8 @@
55

66
(defparameter *truth-string* "T")
77
(defparameter *false-string* "F")
8+
(defparameter *output-stream* *standard-output*
9+
"Default stream to write the results")
810

911
(defun propositionp (symbol)
1012
"Check if the given SYMBOL can be a proposition (letters)"
@@ -134,15 +136,16 @@
134136
do (nsubst (intern-symbol op-name) op-name exp)
135137
finally (return exp)))
136138

137-
(defun princ-n (string n)
139+
(defun princ-n (string &optional (n 1))
138140
"Just print the STRING by N times"
139-
(dotimes (_ n) (princ string)))
141+
(dotimes (_ n)
142+
(format *output-stream* "~a" string)))
140143

141144
(defun print-bar (spaces)
142-
(princ "+")
145+
(princ-n "+" 1)
143146
(princ-n "-" (1- (reduce #'+ spaces)))
144-
(princ "+")
145-
(princ #\newline))
147+
(princ-n "+" 1)
148+
(princ-n #\newline))
146149

147150
(defun last-element (l)
148151
(car (last l)))
@@ -175,25 +178,25 @@ a tautology."
175178
collect (concatenate 'string " " p " |")))
176179
(spaces (mapcar #'length printable-header)))
177180
(print-bar spaces)
178-
(princ "|")
181+
(princ-n "|")
179182
(loop for exp in printable-header
180-
do (princ exp)
181-
finally (princ #\newline))
183+
do (princ-n exp)
184+
finally (princ-n #\newline))
182185
(print-bar spaces)
183186
(loop for n-value from 1 below n-values
184187
do (progn
185-
(princ "|")
188+
(princ-n "|")
186189
(loop for n-exp from 0 below (length header)
187190
do (let* ((space (nth n-exp spaces))
188191
(half-space (floor (- space 2) 2))
189192
(val (nth n-value (nth n-exp truth-table))))
190193
(princ-n " " half-space)
191-
(princ val)
194+
(princ-n val)
192195
(princ-n " " half-space)
193196
(if (oddp space)
194-
(princ " |")
195-
(princ "|"))))
196-
(princ #\newline)))
197+
(princ-n " |")
198+
(princ-n "|"))))
199+
(princ-n #\newline)))
197200
(print-bar spaces)))
198201

199202
(defmacro truth (exp)

0 commit comments

Comments
 (0)