artemist/mes
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

Guile gc experiment: add pairs.

Browse source 
* guile/gc.scm (cell-type, cell-index, gc-cons, gc-car, gc-cdr): New
  function.
This commit is contained in:
Jan Nieuwenhuizen 2016-10-23 14:22:53 +02:00
parent c5e20f196c
commit 088d939945
1 changed files with 42 additions and 11 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

53
guile/gc.scm
View file

@ -3,31 +3,62 @@
(define (R) (reload-module (current-module))) (define (R) (reload-module (current-module)))
(define gc-size 20) (define gc-size 10)
(define the-cars (make-vector gc-size)) (define the-cars (make-vector gc-size '(* . *)))
(define the-cdrs (make-vector gc-size)) (define the-cdrs (make-vector gc-size '(* . *)))
(define gc-free 0) (define gc-free 0)
(define (show-gc) (define (show-gc)
(display "free:") (display gc-free) (newline) (display "\nfree:") (display gc-free) (newline)
(display "cars:") (display the-cars) (newline)) (display "cars:") (display the-cars) (newline)
(display "cdrs:") (display the-cdrs) (newline))
(show-gc) (show-gc)
(define cell-type car)
(define cell-index cdr)
(define (make-cell type . x) (define (make-cell type . x)
(cons type (if (pair? x) (car x)))) (cons type (if (pair? x) (cell-type x) '*)))
(define (gc-alloc) (define (gc-alloc)
((lambda (index) ((lambda (index)
(set! gc-free (+ gc-free 1)) (set! gc-free (+ gc-free 1))
;;(cons 'cell index) (make-cell '* index))
(make-cell *unspecified* index)
)
gc-free)) gc-free))
(define (gc-make-number x) (define (gc-make-number x)
((lambda (cell) ((lambda (cell)
(vector-set! the-cars (cdr cell) (make-cell 'number x)) (vector-set! the-cars (cell-index cell) (make-cell 'n x))
cell) cell)
(gc-alloc))) (gc-alloc)))
(display (gc-make-number 3)) (newline) (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) (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)