Guile gc experiment: add lists and display.
* guile/gc.scm (gc-nil, gc-null?, gc-list, gc-display, make-symbol): New function.
This commit is contained in:
parent
088d939945
commit
e1d5135af6
70
guile/gc.scm
70
guile/gc.scm
|
@ -13,11 +13,12 @@
|
|||
(display "cdrs:") (display the-cdrs) (newline))
|
||||
(show-gc)
|
||||
|
||||
(define cell-type car)
|
||||
(define (cell-type c) (car (gc-cell c)))
|
||||
(define cell-index cdr)
|
||||
(define (cell-value c) (cdr (gc-cell c)))
|
||||
|
||||
(define (make-cell type . x)
|
||||
(cons type (if (pair? x) (cell-type x) '*)))
|
||||
(cons type (if (pair? x) (car x) '*)))
|
||||
|
||||
(define (gc-alloc)
|
||||
((lambda (index)
|
||||
|
@ -25,36 +26,45 @@
|
|||
(make-cell '* index))
|
||||
gc-free))
|
||||
|
||||
(define (gc-make-number x)
|
||||
(define (make-number x)
|
||||
((lambda (cell)
|
||||
(vector-set! the-cars (cell-index cell) (make-cell 'n x))
|
||||
cell)
|
||||
(gc-alloc)))
|
||||
|
||||
(define (make-symbol x)
|
||||
((lambda (cell)
|
||||
(vector-set! the-cars (cell-index cell) (make-cell 's 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))))
|
||||
(vector-set! the-cars (cell-index cell) (make-cell 'p (cell-index x)))
|
||||
(vector-set! the-cdrs (cell-index cell) y)
|
||||
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))))))
|
||||
(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))))))
|
||||
(vector-ref the-cdrs (cell-index c)))
|
||||
|
||||
(display (gc-make-number 7)) (newline)
|
||||
(define first (gc-make-number 8)) (newline)
|
||||
(define gc-cell gc-car)
|
||||
(define (gc-pair? c)
|
||||
(eq? (cell-type c) 'p))
|
||||
|
||||
(define (gc-set-car! c x)
|
||||
(if (gc-pair? c) (vector-set! the-cars (cell-index c) x)))
|
||||
|
||||
(define (gc-set-cdr! c x)
|
||||
(if (gc-pair? c) (vector-set! the-cdrs (cell-index c) x)))
|
||||
|
||||
(display "number 7=") (display (make-number 7)) (newline)
|
||||
(define first (make-number 8)) (newline)
|
||||
(show-gc)
|
||||
(define second (gc-make-number 9)) (newline)
|
||||
(define second (make-number 9)) (newline)
|
||||
(show-gc)
|
||||
(define pair (gc-cons first second))
|
||||
(show-gc)
|
||||
|
@ -62,3 +72,27 @@
|
|||
|
||||
(display "car:") (display (gc-car pair)) (newline)
|
||||
(display "cdr:") (display (gc-cdr pair)) (newline)
|
||||
|
||||
(define (gc-null? x) (eq? (car x) 'e))
|
||||
|
||||
(define gc-nil (make-cell 'e 0))
|
||||
(display "nil: ") (display gc-nil) (newline)
|
||||
|
||||
(define (gc-list . rest)
|
||||
(if (null? rest) gc-nil
|
||||
(gc-cons (car rest) (apply gc-list (cdr rest)))))
|
||||
|
||||
(define lst (gc-list (make-symbol 'a) (make-symbol 'b) (make-symbol 'c)))
|
||||
(display "lst:") (display lst) (newline)
|
||||
(show-gc)
|
||||
|
||||
(define (gc-display x . cont?)
|
||||
(if (gc-pair? x) (begin (if (null? cont?) (display "("))
|
||||
(gc-display (gc-car x))
|
||||
(if (gc-pair? (gc-cdr x)) (display " "))
|
||||
(gc-display (gc-cdr x) #t)
|
||||
(if (null? cont?) (display ")")))
|
||||
(if (gc-null? x) (if (not cont?) (display "()"))
|
||||
(display (cell-value x)))))
|
||||
(display "gc-display lst=") (gc-display lst) (newline)
|
||||
(show-gc)
|
||||
|
|
Loading…
Reference in a new issue