[gambit-list] Problem with compiled code using tables

[Bradley Lucier]

Marc:

There's a very nice little thread in comp.lang.lisp about how to 
calculate the number of partitions of a positive integer.  The fastest 
algorithm by far uses Common Lisp's hash tables, so I thought I would 
try it with Gambit's tables, but it doesn't seem to work when compiled.

Here is the code:

(define (iota-reverse n)
   (let loop ((i 1)
              (result '()))
     (if (> i n)
         result
         (loop (+ i 1)
               (cons i result)))))

(define (make-list n #!optional init)
   (vector->list (make-vector n init)))

(define (break-partitions n break)
   (or (table-ref *break-cache* (cons n break) #f)
       (let ((result
              (cond ((= break 1)
                     (list (make-list n 1)))
                    ((= break n)
                     (list (list n)))
                    (else
                     (let ((rem (- n break)))
                       (map (lambda (i)
                              (cons break (break-partitions rem i)))
                            (iota-reverse (min break rem))))))))
         (table-set! *break-cache* (cons n break) result)
         result)))

(define (breaks n)
   (apply append
          (map (lambda (break)
                 (break-partitions n break))
               (iota-reverse n)))))

It gives the correct result when interpreted, but not when compiled:

[descartes:~/programs/gambc40b13] lucier% gsi
loading /usr/local/Gambit-C/gambcext.scm
Gambit Version 4.0 beta 13

 > (load "partition.scm")
"/Users/lucier/programs/gambc40b13/partition.scm"
 > (pp (breaks 10))
((10)
  (9 (1))
  (8 (2))
  (8 (1 1))
  (7 (3))
  (7 (2 (1)))
  (7 (1 1 1))
  (6 (4))
  (6 (3 (1)))
  (6 (2 (2)) (2 (1 1)))
  (6 (1 1 1 1))
  (5 (5))
  (5 (4 (1)))
  (5 (3 (2)) (3 (1 1)))
  (5 (2 (2 (1))) (2 (1 1 1)))
  (5 (1 1 1 1 1))
  (4 (4 (2)) (4 (1 1)))
  (4 (3 (3)) (3 (2 (1))) (3 (1 1 1)))
  (4 (2 (2 (2)) (2 (1 1))) (2 (1 1 1 1)))
  (4 (1 1 1 1 1 1))
  (3 (3 (3 (1))) (3 (2 (2)) (2 (1 1))) (3 (1 1 1 1)))
  (3 (2 (2 (2 (1))) (2 (1 1 1))) (2 (1 1 1 1 1)))
  (3 (1 1 1 1 1 1 1))
  (2 (2 (2 (2 (2)) (2 (1 1))) (2 (1 1 1 1))) (2 (1 1 1 1 1 1)))
  (2 (1 1 1 1 1 1 1 1))
  (1 1 1 1 1 1 1 1 1 1))
 > (define a (time (breaks 500)))
(time (breaks 500))
     83976 ms real time
     71372 ms cpu time (69503 user, 1869 system)
     33 collections accounting for 7657 ms real time (6264 user, 124 
system)
     764582700 bytes allocated
     no minor faults
     no major faults
[descartes:~/programs/gambc40b13] lucier% gsi
loading /usr/local/Gambit-C/gambcext.scm
Gambit Version 4.0 beta 13

 > (load "partition")
"/Users/lucier/programs/gambc40b13/partition.o2"
 > (pp (breaks 10))
((10)
  (9 (1))
  (8 (2))
  (8 (1 1))
  (7 (3))
  (7 (2 (1)))
  (7 (1 1 1))
  (6 (4))
  (6 (3 (1)))
  (6 (2 (2)) (2 (1 1)))
  (6 (1 1 1 1))
  (5 (5))
  (5 (4 (1)))
  (5 (3 (2)) (3 (1 1)))
  (5 (2 (2 (1))) (2 (1 1 1)))
  (5 (1 1 1 1 1))
  (4 (4 (2)) (4 (1 1)))
  (4 (3 (3)) (3 (2 (1))) (3 (1 1 1)))
  (4 (2 (2 (2)) (2 (1 1))) (2 (1 1 1 1)))
  (4 (1 1 1 1 1 1))
  (3 (3 (3 (1))) (3 (2 (2)) (2 (1 1))) (3 (1 1 1 1)))
  (3 (2 (2 (2 (1))) (2 (1 1 1))) (2 (1 1 1 1 1)))
  (3 (1 1 1 1 1 1 1))
  (2 (2 (2 (2 (2)) (2 (1 1))) (2 (1 1 1 1))) (2 (1 1 1 1 1 1)))
  (2 (1 1 1 1 1 1 1 1))
  (1 1 1 1 1 1 1 1 1 1))
 > (define a (time (breaks 500)))
*** ERROR IN break-partitions, "partition.scm"@15.7 -- (Argument 1) 
Instance of #<type #2 table> expected
(table-ref 0 '(26 . 16) #f)
1> ,e
n = 26
break = 16
(current-exception-handler) = primordial-exception-handler
(current-input-port) = '#<input-output-port #3 (console)>
(current-output-port) = '#<input-output-port #3 (console)>
(current-directory) = "/Users/lucier/programs/gambc40b13/"
1> ,y
0  break-partitions          "partition.scm"@15.7    (table-ref 
*break-cache...
1> ,i
#<procedure #4 break-partitions> =
(lambda (n break)
   (or (table-ref *break-cache* (cons n break) #f)
       (let ((result (cond ((= break 1) (list (make-list n 1)))
                           ((= break n) (list (list n)))
                           (else
                            (let ((rem (- n break)))
                              (map (lambda (i)
                                     (cons break (break-partitions rem 
i)))
                                   (iota-reverse (min break rem))))))))
         (table-set! *break-cache* (cons n break) result)
         result)))
1> (table-length *break-cache*)
1404
1>

Do you know what's happening?

This is in MacOS 10.4.1, Apple's gcc-4.0, default configure and build.

I used the '(debug) option to compile the code (which works very 
nicely, by the way).

Brad