I'm trying to write a pretty-printer for some macros in f2cl, and I'm
stuck on getting the following pretty-printed the way I want.
An example, pretty printed the way I want is:
(F2CL-LIB:FDO (I 3 (+ I 1))
((> I N4) NIL)
(TAGBODY
(SETF T1 (- (AINT (+ (* (FREF D (I) ((1 1024))) RDX) R1)) 2.0d0))
(FSET (FREF D (I) ((1 1024))) (- (FREF D (I) ((1 1024))) (* T1 BDX)))
(FSET (FREF D ((- I 1)) ((1 1024))) (+ (FREF D ((- I 1)) ((1 1024))) T1))
The general format looks something like:
(fdo (var init step)
((end-test) return-val)
body)
The body always starts with tagbody if that makes it easier. I can
get the pprinter to have the var-init-step and end-test on one line,
but I want them on separate lines.
This is what I have so far, but it's not quite right (and quite a
gross hack):
(defun pprint-fdo (fdo-sexp)
(pprint-logical-block (nil fdo-sexp :prefix "(" :suffix ")")
;; The fdo
(write (first fdo-sexp))
(write-char #\space)
;; The var step stuff
(pprint-logical-block (nil nil)
(write (second fdo-sexp))
(write-char #\space)
(pprint-newline :mandatory)
(write (third fdo-sexp))
(write-char #\space))
;; The body
(setf fdo-sexp (cdddr fdo-sexp))
(loop
(when (null fdo-sexp)
(return-from pprint-fdo))
(write-char #\space)
(pprint-newline :linear)
(write (first fdo-sexp))
(pop fdo-sexp))))
Any suggestions would be most welcome.
Ray
Raymond Toy <···@rtp.ericsson.se> writes:
> I'm trying to write a pretty-printer for some macros in f2cl, and I'm
> stuck on getting the following pretty-printed the way I want.
> [...] The general format looks something like:
>
> (fdo (var init step)
> ((end-test) return-val)
> body)
>
> [...] This is what I have so far, but it's not quite right (and
> quite a gross hack):
>
> (defun pprint-fdo (fdo-sexp)
> (pprint-logical-block (nil fdo-sexp :prefix "(" :suffix ")")
> ;; The fdo
> (write (first fdo-sexp))
> (write-char #\space)
> ;; The var step stuff
> (pprint-logical-block (nil nil)
> [...]
PPRINT-LOGICAL-BLOCK is not for doing indents, PPRINT-INDENT is your
friend there.
(defun pprint-fdo (fdo-sexp)
(pprint-logical-block (nil fdo-sexp :prefix "(" :suffix ")")
(write (pprint-pop))
(write-char #\space)
; (pprint-newline :miser)
(pprint-indent :current 0)
(write (pprint-pop))
(pprint-newline :mandatory)
(write (pprint-pop))
(pprint-indent :block 1)
(pprint-newline :mandatory)
(loop
(write (pprint-pop))
(pprint-exit-if-list-exhausted)
(write-char #\space)
(pprint-newline :linear))))
Using PPRINT-POP saves a lot of trouble, especially if the expression
is ever malformed.
--
Pekka P. Pirinen
You're only young once, but you can be immature forever.