Generalize breakpoints

scmvm/debugger.scm

@@ -23,25 +23,19 @@
   (continuation debugger-continuation debugger-continuation-set!)
   (stepping debugger-stepping? debugger-stepping-set!))
 
-(define (make-breakpoints asm)
+(define* (make-breakpoints #:optional (convert identity))
-  (define the-breakpoints '())
+  (define the-breakpoints (make-hash-table))
-  (define (->index index/label)
+  (match-lambda
+    [(or 'add 'enable) (lambda (key) (hashq-set! the-breakpoints (convert key) #t))]
+    ['disable (lambda (key) (hashq-set! the-breakpoints (convert key) #f))]
+    ['delete (lambda (key) (hashq-remove! the-breakpoints (convert key)))]
+    ['ref (lambda (key) (hashq-ref the-breakpoints (convert key) #f))]))
+
+(define (label-converter asm)
+  (lambda (index/label)
     (if (number? index/label)
         index/label
-        (car (hash-ref (assembler-labels asm) index/label))))
+        (car (hash-ref (assembler-labels asm) index/label)))))
-  (define-syntax-rule (ilambda (i) e ...)
-    (lambda (v) (let ([i (->index v)]) e ...)))
-  (match-lambda
-    ['add
-     (ilambda (i) (set! the-breakpoints (acons i #t the-breakpoints)))]
-    ['delete
-     (ilambda (i) (set! the-breakpoints (assq-remove! the-breakpoints i)))]
-    ['enable
-     (ilambda (i) (set! the-breakpoints (assq-set! the-breakpoints i #t)))]
-    ['disable
-     (ilambda (i) (set! the-breakpoints (assq-set! the-breakpoints i #f)))]
-    ['ref
-     (ilambda (i) (assq-ref the-breakpoints i))]))
 
 (define (make-debugger* asm)
   (define prgm
@@ -58,7 +52,7 @@
                (k))))
   (define vm (make-vm (assembler-instruction-set asm) #:debugger debug))
   (vm-load-program! vm prgm)
-  (set! the-debugger (make-debugger vm asm (make-breakpoints asm) #f #f))
+  (set! the-debugger (make-debugger vm asm (make-breakpoints (label-converter asm)) #f #f))
   (debugger-breakpoint-add! the-debugger 1)
   (reset (run-vm vm))
   the-debugger)