* now exporting set-rtd-printer!

src/ikarus.library-manager.ss

@@ -19,11 +19,14 @@
         [(x) (set! set (set-cons x set))])))
 
   (define current-library-collection
-    (make-parameter (make-collection) 
+    ;;; this works now because make-collection is a lambda
+    ;;; binding and this turns into a complex binding as far
+    ;;; as letrec is concerned.  It will be more ok once we do
+    ;;; letrec*.
+    (make-parameter (make-collection)
       (lambda (x)
         (unless (procedure? x)
-          (error 'current-library-collection 
+          (error 'current-library-collection "~s is not a procedure" x))
-            "~s is not a procedure" x))
         x)))
 
   (define-record library 
@@ -87,7 +90,6 @@
   (define (imported-label->binding lab)
     (get-hash-table label->binding-table lab #f))
 
-
   (define (invoke-library lib)
     (let ([invoke (library-invoke-state lib)])
       (when (procedure? invoke)
@@ -102,7 +104,6 @@
   (define (invoke-library-by-spec spec)
     (invoke-library (find-library-by-spec/die spec)))
 
-
   (define installed-libraries 
     (lambda () ((current-library-collection))))
   (define library-spec       
@@ -112,9 +113,7 @@
       (list (library-id x) (library-name x) (library-ver x))))
 
   ;;; init
-
+  (set-rtd-printer! (type-descriptor library)
-  ((record-field-mutator (record-type-descriptor (type-descriptor library)) 'printer)
-    (type-descriptor library)
     (lambda (x p)
       (unless (library? x)
         (error 'record-type-printer "not a library"))

src/ikarus.records.ss

@@ -4,7 +4,8 @@
   (export
     make-record-type record-type-name record-type-symbol
     record-type-field-names record-constructor record-predicate
-    record-field-accessor record-field-mutator record?  record-rtd
+    record-field-accessor record-field-mutator record? record-rtd
+    set-rtd-printer!
     (rename (record-rtd record-type-descriptor)) 
     record-name record-printer record-length record-ref record-set!)
 
@@ -17,7 +18,7 @@
       record-type-field-names record-constructor record-predicate
       record-field-accessor record-field-mutator record? record-rtd
       record-type-descriptor record-name record-printer record-length
-      record-ref record-set!))
+      record-ref record-set! set-rtd-printer!))
 
 
 
@@ -58,7 +59,7 @@
     (lambda (rtd fields)
       ($record-set! rtd 2 fields)))
 
-  (define set-rtd-printer!
+  (define $set-rtd-printer!
     (lambda (rtd printer)
       ($record-set! rtd 3 printer)))
    
@@ -253,9 +254,16 @@
           (error 'record-set! "index ~s is out of range for ~s" i x))
         ($record-set! x i v))))
 
+  (define (set-rtd-printer! x p)
+    (unless (rtd? x)
+      (error 'set-rtd-printer! "~s is not an rtd" x))
+    (unless (procedure? p)
+      (error 'set-rtd-printer! "~s is not a procedure" p))
+    ($set-rtd-printer! x p))
+
   (set-rtd-fields! (base-rtd) '(name fields length printer symbol))
   (set-rtd-name! (base-rtd) "base-rtd")
-  (set-rtd-printer! (base-rtd)
+  ($set-rtd-printer! (base-rtd)
     (lambda (x p)
       (unless (rtd? x)
         (error 'record-type-printer "not an rtd"))

src/makefile.ss

@@ -382,6 +382,7 @@
       [record-type-field-names i]
       [record-type-symbol      i]
       [record-type-name        i]
+      [set-rtd-printer!        i]
       [record-name             i]
       [record-constructor      i]
       [record-predicate        i]