From e1d5135af60848d71251f49171fb50e8bd929181 Mon Sep 17 00:00:00 2001
From: Jan Nieuwenhuizen <janneke@gnu.org>
Date: Sun, 23 Oct 2016 17:21:56 +0200
Subject: [PATCH 1/1] Guile gc experiment: add lists and display.

* guile/gc.scm (gc-nil, gc-null?, gc-list, gc-display, make-symbol):
  New function.
---
 guile/gc.scm | 70 ++++++++++++++++++++++++++++++++++++++--------------
 1 file changed, 52 insertions(+), 18 deletions(-)

diff --git a/guile/gc.scm b/guile/gc.scm
index 9fd81118..66177c05 100644
--- a/guile/gc.scm
+++ b/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)))
+
+(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 (gc-make-number 7)) (newline)
-(define first (gc-make-number 8)) (newline)
+(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)
-- 
2.31.1