~ chicken-core (chicken-5) b8689e69e38e91bef50edc3ecfb45af180a2b228
commit b8689e69e38e91bef50edc3ecfb45af180a2b228
Author: felix <felix@call-with-current-continuation.org>
AuthorDate: Mon Nov 15 11:43:26 2010 -0500
Commit: felix <felix@call-with-current-continuation.org>
CommitDate: Mon Nov 15 11:43:26 2010 -0500
fixed broken ,g command in csi
diff --git a/csi.scm b/csi.scm
index d0cd9ca9..12f7de81 100644
--- a/csi.scm
+++ b/csi.scm
@@ -814,6 +814,7 @@ EOF
(define copy-from-frame
(let ((display display)
+ (newline newline)
(call/cc call/cc))
(lambda (name)
(let* ((ct (or ##sys#repl-recent-call-chain '()))
@@ -822,33 +823,39 @@ EOF
(cond ((symbol? name) (##sys#slot name 1)) ; name
((string? name) name)
(else
- (display "string or symbol required for `,cf'\n")
+ (display "string or symbol required for `,g'\n")
#f))))
+ (define (compare sym)
+ (let ((str (##sys#slot sym 1))) ; name
+ (string=?
+ name
+ (substring str 0 (min (string-length name) (string-length str))))))
(if name
(call/cc
(lambda (return)
(define (fail msg)
(display msg)
+ (newline)
(return (##sys#void)))
- (do ((ct ct (cdr ct))
- (i (fx- len 1) (fx- i 1)))
- ((null? ct) (fail "no environment in frame\n"))
+ (do ((ct ct (cdr ct)))
+ ((null? ct) (fail "no environment in frame"))
+ ;;XXX this should be refactored as it duplicates the code above
(let* ((info (car ct))
(here (eq? selected-frame info))
(data (##sys#slot info 2)) ; cooked2 (cntr/frameinfo)
- (finfo (##sys#structure? data 'frameinfo))
- (cntr (if finfo (##sys#slot data 1) data))) ; cntr
+ (finfo (##sys#structure? data 'frameinfo)))
(when (and here finfo)
(for-each
(lambda (e v)
(do ((i 0 (fx+ i 1))
(be e (cdr be)))
- ((null? be) (fail "no such variable\n"))
- (when (string=? name (##sys#slot (car be) 1)) ; name
+ ((null? be))
+ (when (compare (car be))
(history-add (list (##sys#slot v i)))
(return (##sys#slot v i)))))
(##sys#slot data 2) ; e
- (##sys#slot data 3))))))) ; v
+ (##sys#slot data 3)) ; v
+ (fail (##sys#string-append "no such variable: " name)))))))
(##sys#void))))))
Trap