[cl-typesetting-devel] CLISP support

[Klaus Weidner]

Hi,

I got the table handling working on CLISP. This was *not* fun to track
down, it turned out to be due to semantic differences in the way the
different Lisps implement the LOOP macro. This has cost me a couple of
hours which I'd rather have spent on something more productive :-(

See below for results of my experiments. If someone can point me to the
place in the standard that proves that one of these behaviors is not
compliant, I'll gladly file a bug report for the affected implementation.

Section 6.1.2.1 says that variables are stepped "at" each iteration (when
exactly?), and that the difference between parallel AND and sequential
FOR binding is analogous to the difference between DO and DO* (which
behave identically as far as loop termination is concerned). I personally
find the CLISP behavior more logical...

The appended patch has workarounds, but IMHO the code should really be
rewritten to be less loopy. Apparently having more than a single exit
clause in a loop is asking for trouble, and the implementations can't
even agree on the simple case of what an "for X on LIST" should return.

-Klaus

;; LOOP test results. CMUCL and SBCL have identical behavior, which
;; apparently also matches that of LispWorks.

(loop for r in '(42) finally (return r))

   all   => 42

(loop for r on '(42) finally (return r))

   sbcl  => nil
   clisp => (42)

(loop for i from 0 below 2
      for j from 0 below 1
      finally (return (list i j)))

   all   => (1 1)

(loop for i from 0 below 2
      for j from 0 below 2
      finally (return (list i j)))

   sbcl  => (2 1)
   clisp => (2 2)

(loop for i from 0 below 2
      and j from 0 below 2
      finally (return (list i j)))

   all   => (2 2)

(loop for i from 0 below 2
      for j from 0 below 3
      finally (return (list i j)))

   sbcl  => (2 1)
   clisp => (2 2)

(loop for i from 0 below 3
      for j from 0 below 2
      finally (return (list i j)))

   all   => (2 2)

-------------- next part --------------
diff -urN -x *.fas -x *.lib orig/cl-typesetting/tables.lisp cl-typesetting/tables.lisp
--- orig/cl-typesetting/tables.lisp	Tue Apr 20 17:16:58 2004
+++ cl-typesetting/tables.lisp	Sat Apr 24 22:27:12 2004
@@ -92,9 +92,9 @@
           do (setf (splittable-p row) nil)
         do
         (loop for j = 0 then (+ j (col-span c))
-              and tail on (cells row)
+              for tail = (cells row) then (cdr tail)
               for c = (first tail)		; j is the column number of c
-              while (< j col-number)
+              while (and tail (< j col-number))
               collect (first tail) into head
               finally				; insert cell between head and tail
               (setf (cells row) (nconc head (list cell) tail)))
@@ -131,7 +131,7 @@
                                 :end (1- (length row-span))
                                 :initial-value (* (1- (length row-span))
                                                   full-size-offset)))  into max-height
-          finally (setf height (+ (max (or (height row) 0) max-height) +epsilon+)))
+          finally (setf height (+ (max (or (height row) 0) (or max-height 0)) +epsilon+)))
     (setf (height row) height)
     (loop for cell in (cells row)
           for row-span = (row-span cell)
@@ -184,15 +184,22 @@
           for row = (first rows)
           for y = (+ padding border (height row) full-size-offset)
                 then (+ y (height row) full-size-offset)
-          while (<= y max-height)
+          while (and rows (<= y max-height))
           ;do (setf (dy row) (+ (height row) full-size-offset))
           do (push row boxes)
           finally
+	  ;; screwed by loop semantic differences :-(
+	  ;; (loop for r in '(42) finally (return r))
+	  ;;    all   => 42
+	  ;; (loop for r on '(42) finally (return r))
+	  ;;    sbcl  => nil
+	  ;;    clisp => (42)
+	  #+clisp (unless (> y max-height) (pop rows))
           (when (and boxes
                      ;; Trim unsplitalbe rows and reverse the list of accumulated boxes
-                     (setf boxes (loop for tail on boxes
+                     (setf boxes (loop for tail = boxes then (cdr tail)
                                        for row = (first tail)
-                                       until (splittable-p row)
+                                       until (or (not row) (splittable-p row))
                                        do (decf prev-y (+ (height row) full-size-offset))
                                        finally (return (nreverse tail)))))
             (setq boxes (append header boxes footer))