Fixes bug 173382: Contents of opaque records should not be printed

scheme/ikarus.writer.ss

@@ -137,19 +137,27 @@
 
   (define write-struct
     (lambda (x p m h i)
-      (write-char #\# p)
+      (cond
-      (write-char #\[ p)
+        [(let ([rtd (struct-type-descriptor x)])
-      (let ([i (writer (struct-name x) p m h i)])
+           (and (record-type-descriptor? rtd) 
-        (let ([n (struct-length x)])
+                (record-type-opaque? rtd)))
-          (let f ([idx 0] [i i])
+         (write-char* "#<unknown>" p)
-            (cond
+         i]
-              [(fx= idx n)
+        [else
-               (write-char #\] p)
+         (write-char #\# p)
-               i]
+         (write-char #\[ p)
-              [else 
+         (let ([i (writer (struct-name x) p m h i)])
-               (write-char #\space p)
+           (let ([n (struct-length x)])
-               (f (fxadd1 idx) 
+             (let f ([idx 0] [i i])
-                  (writer (struct-ref x idx) p m h i))]))))))
+               (cond
+                 [(fx= idx n)
+                  (write-char #\] p)
+                  i]
+                 [else 
+                  (write-char #\space p)
+                  (f (fxadd1 idx) 
+                     (writer (struct-ref x idx) p m h
+                             i))]))))])))
   
   (define initial?
     (lambda (c)
@@ -563,6 +571,8 @@
         [(hashtable? x)
          (write-char* "#<hashtable>" p)
          i]
+        ;[(record? x) 
+        ; (write-shareable x p m h i write-struct)]
         [(struct? x)
          (let ([printer (struct-printer x)])
            (if (procedure? printer)
@@ -622,7 +632,9 @@
          (cond
            [(hashtable-ref h x #f) =>
             (lambda (n)
-              (hashtable-set! h x (fxadd1 n)))])]))
+              (hashtable-set! h x (fxadd1 n)))])]
+        ;;; FIXME: recursive records/structs
+        ))
     (define (dynamic x h)
       (cond
         [(pair? x)
@@ -647,7 +659,9 @@
             (vec-dynamic x 0 (vector-length x) h)
             (when (and (hashtable-ref h x #f)
                        (fxzero? (hashtable-ref h x #f)))
-              (hashtable-set! h x #f))])])) 
+              (hashtable-set! h x #f))])]
+        ;;; FIXME: recursive records/structs
+        ))
     (if (print-graph) 
         (graph x h)
         (dynamic x h)))

scheme/last-revision

@@ -1 +1 @@
-1165
+1166