2 (define-module (guile gc))
4 (define (R) (reload-module (current-module)))
7 (define the-cars (make-vector gc-size '(* . *)))
8 (define the-cdrs (make-vector gc-size '(* . *)))
11 (display "\nfree:") (display gc-free) (newline)
12 (display "cars:") (display the-cars) (newline)
13 (display "cdrs:") (display the-cdrs) (newline))
16 (define (cell-type c) (car (gc-cell c)))
17 (define cell-index cdr)
18 (define (cell-value c) (cdr (gc-cell c)))
20 (define (make-cell type . x)
21 (cons type (if (pair? x) (car x) '*)))
25 (set! gc-free (+ gc-free 1))
29 (define (make-number x)
31 (vector-set! the-cars (cell-index cell) (make-cell 'n x))
35 (define (make-symbol x)
37 (vector-set! the-cars (cell-index cell) (make-cell 's x))
43 (vector-set! the-cars (cell-index cell) (make-cell 'p (cell-index x)))
44 (vector-set! the-cdrs (cell-index cell) y)
49 (vector-ref the-cars (cell-index c)))
52 (vector-ref the-cdrs (cell-index c)))
54 (define gc-cell gc-car)
56 (eq? (cell-type c) 'p))
58 (define (gc-set-car! c x)
59 (if (gc-pair? c) (vector-set! the-cars (cell-index c) x)))
61 (define (gc-set-cdr! c x)
62 (if (gc-pair? c) (vector-set! the-cdrs (cell-index c) x)))
64 (display "number 7=") (display (make-number 7)) (newline)
65 (define first (make-number 8)) (newline)
67 (define second (make-number 9)) (newline)
69 (define pair (gc-cons first second))
71 (display "pair:") (display pair) (newline)
73 (display "car:") (display (gc-car pair)) (newline)
74 (display "cdr:") (display (gc-cdr pair)) (newline)
76 (define (gc-null? x) (eq? (car x) 'e))
78 (define gc-nil (make-cell 'e 0))
79 (display "nil: ") (display gc-nil) (newline)
81 (define (gc-list . rest)
82 (if (null? rest) gc-nil
83 (gc-cons (car rest) (apply gc-list (cdr rest)))))
85 (define lst (gc-list (make-symbol 'a) (make-symbol 'b) (make-symbol 'c)))
86 (display "lst:") (display lst) (newline)
89 (define (gc-display x . cont?)
90 (if (gc-pair? x) (begin (if (null? cont?) (display "("))
91 (gc-display (gc-car x))
92 (if (gc-pair? (gc-cdr x)) (display " "))
93 (gc-display (gc-cdr x) #t)
94 (if (null? cont?) (display ")")))
95 (if (gc-null? x) (if (not cont?) (display "()"))
96 (display (cell-value x)))))
97 (display "gc-display lst=") (gc-display lst) (newline)