~ chicken-core (chicken-5) 5441f5e1833793cd141f0e4b5a1e12428099b243
commit 5441f5e1833793cd141f0e4b5a1e12428099b243
Author: felix <felix@call-with-current-continuation.org>
AuthorDate: Fri Oct 8 23:35:20 2010 +0200
Commit: felix <felix@call-with-current-continuation.org>
CommitDate: Fri Oct 8 23:35:20 2010 +0200
removed tinyclos support from csi's describe
diff --git a/csi.scm b/csi.scm
index c2d40c1b..3cf2f271 100644
--- a/csi.scm
+++ b/csi.scm
@@ -609,13 +609,9 @@ EOF
[(pair? x) (fprintf out "pair with car ~S~%and cdr ~S~%" (car x) (cdr x))]
[(procedure? x)
(let ([len (##sys#size x)])
- (if (and (> len 3)
- (memq #:tinyclos ##sys#features)
- (eq? ##tinyclos#entity-tag (##sys#slot x (fx- len 1))) ) ;XXX handle this in tinyclos egg (difficult)
- (describe-object x out)
- (descseq
- (sprintf "procedure with code pointer ~X" (##sys#peek-unsigned-integer x 0))
- ##sys#size ##sys#slot 1) ) ) ]
+ (descseq
+ (sprintf "procedure with code pointer ~X" (##sys#peek-unsigned-integer x 0))
+ ##sys#size ##sys#slot 1) ) ]
[(port? x)
(fprintf out
"~A port of type ~A with name ~S and file pointer ~X~%"
@@ -623,8 +619,6 @@ EOF
(##sys#slot x 7)
(##sys#slot x 3)
(##sys#peek-unsigned-integer x 0) ) ]
- [(and (memq #:tinyclos ##sys#features) (instance? x)) ; XXX put into tinyclos egg
- (describe-object x out) ]
[(##sys#locative? x)
(fprintf out "locative~% pointer ~X~% index ~A~% type ~A~%"
(##sys#peek-unsigned-integer x 0)
Trap