mes/guile/gc.scm

(define-module (guile gc))

(define (R) (reload-module (current-module)))

(define gc-size 10)
(define the-cars (make-vector gc-size '(* . *)))
(define the-cdrs (make-vector gc-size '(* . *)))
(define gc-free 0)
(define (show-gc)
  (display "\nfree:") (display gc-free) (newline)
  (display "cars:") (display the-cars) (newline)
  (display "cdrs:") (display the-cdrs) (newline))
(show-gc)

(define cell-type car)
(define cell-index cdr)

(define (make-cell type . x)
  (cons type (if (pair? x) (cell-type x) '*)))

(define (gc-alloc)
  ((lambda (index)
     (set! gc-free (+ gc-free 1))
     (make-cell '* index))
   gc-free))

(define (gc-make-number x)
  ((lambda (cell)
     (vector-set! the-cars (cell-index cell) (make-cell 'n x))
     cell)
   (gc-alloc)))

(define (gc-cons x y)
  ((lambda (cell)
     ((lambda (pair)
      (vector-set! the-cars (cell-index cell) pair)
      (vector-set! the-cars (cell-index cell) (make-cell 'p (cell-index x)))
      (vector-set! the-cdrs (cell-index cell) (make-cell 'p (cell-index y)))
      pair)
      (make-cell 'p (cell-index cell))))
   (gc-alloc)))

(define (gc-car c)
  (if (eq? (cell-type c) 'p) (vector-ref the-cars
                                         (cell-index
                                          (vector-ref the-cars (cell-index c))))))

(define (gc-cdr c)
  (if (eq? (cell-type c) 'p) (vector-ref the-cars
                                         (cell-index
                                          (vector-ref the-cdrs (cell-index c))))))

(display (gc-make-number 7)) (newline)
(define first (gc-make-number 8)) (newline)
(show-gc)
(define second (gc-make-number 9)) (newline)
(show-gc)
(define pair (gc-cons first second))
(show-gc)
(display "pair:") (display pair) (newline)

(display "car:") (display (gc-car pair)) (newline)
(display "cdr:") (display (gc-cdr pair)) (newline)