Update frame-bindings interface

* module/system/repl/debug.scm (print-locals): Update to work with new
  interface.
  (frame->module): Update.  Still doesn't work due to lack of
  `program-module', though.

* module/system/vm/program.scm (make-binding, binding:name)
  (binding:definition-offset, program-arity-bindings-for-ip): Remove
  these.

* module/system/vm/frame.scm (<binding>): New type.
  (available-bindings): Return a list of <binding> instances.
  (frame-lookup-binding, frame-binding-set!, frame-binding-ref):
  (frame-environment, frame-object-name): Adapt.

module/system/repl/debug.scm

@@ -1,6 +1,6 @@
 ;;; Guile VM debugging facilities
 
-;;; Copyright (C) 2001, 2009, 2010, 2011, 2013 Free Software Foundation, Inc.
+;;; Copyright (C) 2001, 2009, 2010, 2011, 2013, 2014 Free Software Foundation, Inc.
 ;;;
 ;;; This library is free software; you can redistribute it and/or
 ;;; modify it under the terms of the GNU Lesser General Public
@@ -113,14 +113,10 @@
       (format port "~aLocal variables:~%" per-line-prefix)
       (for-each
        (lambda (binding)
-         (let ((v (let ((x (frame-local-ref frame (binding:index binding))))
+         (let ((v (frame-local-ref frame (binding-slot binding))))
-                    (if (binding:boxed? binding)
-                        (variable-ref x)
-                        x))))
            (display per-line-prefix port)
            (run-hook before-print-hook v)
-           (format port "~a~:[~; (boxed)~] = ~v:@y\n"
+           (format port "~a = ~v:@y\n" (binding-name binding) width v)))
-                   (binding:name binding) (binding:boxed? binding) width v)))
        (frame-bindings frame))))))
 
 (define* (print-frame frame #:optional (port (current-output-port))
@@ -171,20 +167,20 @@
 (define (frame->module frame)
   (let ((proc (frame-procedure frame)))
     (if #f
-        ;; FIXME!
+        ;; FIXME: program-module does not exist.
         (let* ((mod (or (program-module proc) (current-module)))
                (mod* (make-module)))
           (module-use! mod* mod)
           (for-each
            (lambda (binding)
-             (let* ((x (frame-local-ref frame (binding:index binding)))
+             (let* ((x (frame-local-ref frame (binding-slot binding)))
-                    (var (if (binding:boxed? binding) x (make-variable x))))
+                    (var (if (variable? x) x (make-variable x))))
                (format #t
                        "~:[Read-only~;Mutable~] local variable ~a = ~70:@y\n"
-                       (binding:boxed? binding)
+                       (not (variable? x))
-                       (binding:name binding)
+                       (binding-name binding)
                        (if (variable-bound? var) (variable-ref var) var))
-               (module-add! mod* (binding:name binding) var)))
+               (module-add! mod* (binding-name binding) var)))
            (frame-bindings frame))
           mod*)
         (current-module))))

module/system/vm/frame.scm

@@ -24,15 +24,27 @@
   #:use-module (system vm program)
   #:use-module (system vm debug)
   #:use-module (system vm disassembler)
+  #:use-module (srfi srfi-9)
   #:use-module (rnrs bytevectors)
   #:use-module (ice-9 match)
-  #:export (frame-bindings
+  #:export (binding-index
+            binding-name
+            binding-slot
+
+            frame-bindings
             frame-lookup-binding
             frame-binding-ref frame-binding-set!
             frame-call-representation
             frame-environment
             frame-object-binding frame-object-name))
 
+(define-record-type <binding>
+  (make-binding idx name slot)
+  binding?
+  (idx binding-index)
+  (name binding-name)
+  (slot binding-slot))
+
 (define (parse-code code)
   (let ((len (bytevector-length code)))
     (let lp ((pos 0) (out '()))
@@ -212,7 +224,7 @@
                 (if n
                     (match (vector-ref defs n)
                       (#(name def-offset slot)
-                       (acons name slot (lp (1+ n)))))
+                       (cons (make-binding n name slot) (lp (1+ n)))))
                     '()))))
           (lp (1+ n) (- offset (vector-ref parsed n)))))))
 
@@ -228,21 +240,21 @@
   (let lp ((bindings (frame-bindings frame)))
     (cond ((null? bindings)
            #f)
-          ((eq? (binding:name (car bindings)) var)
+          ((eq? (binding-name (car bindings)) var)
            (car bindings))
           (else
            (lp (cdr bindings))))))
 
 (define (frame-binding-set! frame var val)
   (frame-local-set! frame
-                    (binding:index
+                    (binding-slot
                      (or (frame-lookup-binding frame var)
                          (error "variable not bound in frame" var frame)))
                     val))
 
 (define (frame-binding-ref frame var)
   (frame-local-ref frame
-                   (binding:index
+                   (binding-slot
                     (or (frame-lookup-binding frame var)
                         (error "variable not bound in frame" var frame)))))
 
@@ -342,7 +354,7 @@
 
 (define (frame-environment frame)
   (map (lambda (binding)
-	 (cons (binding:name binding) (frame-binding-ref frame binding)))
+	 (cons (binding-name binding) (frame-binding-ref frame binding)))
        (frame-bindings frame)))
 
 (define (frame-object-binding frame obj)
@@ -351,5 +363,5 @@
        (and (pair? bs) (car bs)))))
 
 (define (frame-object-name frame obj)
-  (cond ((frame-object-binding frame obj) => binding:name)
+  (cond ((frame-object-binding frame obj) => binding-name)
 	(else #f)))

module/system/vm/program.scm

@@ -24,10 +24,7 @@
   #:use-module (rnrs bytevectors)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
-  #:export (binding:name binding:definition-offset binding:slot
+  #:export (source:addr source:line source:column source:file
-            program-arity-bindings-for-ip
-
-            source:addr source:line source:column source:file
             source:line-for-user
             program-sources program-sources-pre-retire program-source
 
@@ -59,12 +56,6 @@
 (define (program-properties program)
   (find-program-properties (program-code program)))
 
-(define (make-binding name def-offset slot)
-  (vector name def-offset slot))
-(define (binding:name b) (vector-ref b 0))
-(define (binding:definition-offset b) (vector-ref b 1))
-(define (binding:slot b) (vector-ref b 2))
-
 (define (source:addr source)
   (car source))
 (define (source:file source)
@@ -124,13 +115,6 @@
                 (source-column source)))
        (find-program-sources (program-code proc))))
 
-(define (program-arity-bindings-for-ip prog ip)
-  (or-map (lambda (arity)
-            (and (<= (arity-low-pc arity) ip)
-                 (< ip (arity-high-pc arity))
-                 (arity-definitions arity)))
-          (or (find-program-arities (program-code prog)) '())))
-
 (define (arity:start a)
   (match a ((start end . _) start) (_ (error "bad arity" a))))
 (define (arity:end a)