From: Jan Nieuwenhuizen <janneke@gnu.org>
Date: Sun, 23 Oct 2016 12:22:53 +0000 (+0200)
Subject: Guile gc experiment: add pairs.
X-Git-Tag: v0.2~46
X-Git-Url: https://jxself.org/git/?p=mes.git;a=commitdiff_plain;h=088d9399455cda03a8a88a55acf4ac2bf4cdb257

Guile gc experiment: add pairs.

* guile/gc.scm (cell-type, cell-index, gc-cons, gc-car, gc-cdr): New
  function.
---

diff --git a/guile/gc.scm b/guile/gc.scm
index 01116994..9fd81118 100644
--- a/guile/gc.scm
+++ b/guile/gc.scm
@@ -3,31 +3,62 @@
 
 (define (R) (reload-module (current-module)))
 
-(define gc-size 20)
-(define the-cars (make-vector gc-size))
-(define the-cdrs (make-vector gc-size))
+(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 "free:") (display gc-free) (newline)
-  (display "cars:") (display the-cars) (newline))
+  (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) (car x))))
+  (cons type (if (pair? x) (cell-type x) '*)))
 
 (define (gc-alloc)
   ((lambda (index)
      (set! gc-free (+ gc-free 1))
-     ;;(cons 'cell index)
-     (make-cell *unspecified* index)
-     )
+     (make-cell '* index))
    gc-free))
 
 (define (gc-make-number x)
   ((lambda (cell)
-     (vector-set! the-cars (cdr cell) (make-cell 'number x))
+     (vector-set! the-cars (cell-index cell) (make-cell 'n x))
      cell)
    (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)
+(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)