(newline))))
(define (original-value addr code objs)
- (define (branch-code? code)
- (string-match "^br" (symbol->string (car code))))
- (define (list-or-vector? code)
- (case (car code)
- ((list vector) #t)
- (else #f)))
-
- (let ((code (code-unpack code)))
- (cond ((list-or-vector? code)
- (let ((len (+ (* (cadr code) 256) (caddr code))))
- (format #f "~a element~a" len (if (> len 1) "s" ""))))
- ((code->object code) => object->string)
- ((branch-code? code)
- (let ((offset (+ (* (cadr code) 256) (caddr code))))
- (format #f "-> ~A" (+ addr offset 3))))
- (else
- (let ((inst (car code)) (args (cdr code)))
- (case inst
- ((make-false) "#f")
- ((object-ref)
- (if objs (object->string (vector-ref objs (car args))) #f))
- ((mv-call)
- (let ((offset (+ (* (caddr code) 256) (cadddr code))))
- (format #f "MV -> ~A" (+ addr offset 4))))
- (else #f)))))))
+ (let* ((code (code-unpack code))
+ (inst (car code))
+ (args (cdr code)))
+ (case inst
+ ((list vector)
+ (let ((len (+ (* (cadr code) 256) (caddr code))))
+ (format #f "~a element~a" len (if (> len 1) "s" ""))))
+ ((br br-if br-if-eq br-if-not br-if-not-eq br-if-not-null br-if-null)
+ (let ((offset (+ (* (car args) 256) (cadr args))))
+ (format #f "-> ~A" (+ addr offset 3))))
+ ((object-ref)
+ (if objs (object->string (vector-ref objs (car args))) #f))
+ ((mv-call)
+ (let ((offset (+ (* (caddr code) 256) (cadddr code))))
+ (format #f "MV -> ~A" (+ addr offset 4))))
+ (else
+ (and=> (code->object code) object->string)))))
(define (list->info list)
(object->string list))