Factored out the mztake parts from the annotator.
The annotator takes lists of locations to annotate intead of taking a process and some clients. svn: r179
This commit is contained in:
Guillaume Marceau
parent
5780f1bad6
commit
b76f0e77be
77
collects/mztake/TAGS
Normal file
77
collects/mztake/TAGS
Normal file
|
|
@ -0,0 +1,77 @@
|
||||||
|
|
||||||
|
debugger-annotate.ss,91
|
||||||
|
(define (arglist-bindingsarglist-bindings10,204
|
||||||
|
(cons #'var (arannotate20,430
|
||||||
|
|
||||||
|
debugger-model.ss,46
|
||||||
|
(define debugger-moddebugger-model@12,332
|
||||||
|
|
||||||
|
debugger-tool.ss,0
|
||||||
|
|
||||||
|
info.ss,128
|
||||||
|
(define namename2,41
|
||||||
|
(define toolstools3,69
|
||||||
|
(define tool-namestool-names4,111
|
||||||
|
(define tool-iconstool-icons5,155
|
||||||
|
|
||||||
|
mztake-structs.ss,2742
|
||||||
|
(define-struct tracestruct:trace-struct20,825
|
||||||
|
(define-struct tracemake-trace-struct20,825
|
||||||
|
(define-struct tracetrace-struct?20,825
|
||||||
|
(define-struct tracetrace-struct-evnt-rcvr20,825
|
||||||
|
(define-struct traceset-trace-struct-evnt-rcvr!20,825
|
||||||
|
(define-struct trace-structtrace-struct20,825
|
||||||
|
|
||||||
|
(define-struct (struct:break-trace22,900
|
||||||
|
|
||||||
|
(define-struct (make-break-trace22,900
|
||||||
|
|
||||||
|
(define-struct (break-trace?22,900
|
||||||
|
|
||||||
|
(define-struct (break-trace22,900
|
||||||
|
(define-struct (breastruct:bind-trace23,904
|
||||||
|
(define-struct (breamake-bind-trace23,904
|
||||||
|
(define-struct (breabind-trace?23,904
|
||||||
|
(define-struct (breabind-trace-variable-to-bind23,904
|
||||||
|
(define-struct (breaset-bind-trace-variable-to-bind!23,904
|
||||||
|
(define-struct (breabind-trace23,904
|
||||||
|
(varistruct:debug-client26,997
|
||||||
|
(varimake-debug-client26,997
|
||||||
|
(varidebug-client?26,997
|
||||||
|
(varidebug-client-modpath26,997
|
||||||
|
(variset-debug-client-modpath!26,997
|
||||||
|
(varidebug-client-tracepoints26,997
|
||||||
|
(variset-debug-client-tracepoints!26,997
|
||||||
|
(varidebug-client-line-col->pos26,997
|
||||||
|
(variset-debug-client-line-col->pos!26,997
|
||||||
|
(varidebug-client-process26,997
|
||||||
|
(variset-debug-client-process!26,997
|
||||||
|
(varidebug-client26,997
|
||||||
|
struct:debug-process31,1313
|
||||||
|
make-debug-process31,1313
|
||||||
|
debug-process?31,1313
|
||||||
|
debug-process-custodian31,1313
|
||||||
|
set-debug-process-custodian!31,1313
|
||||||
|
debug-process-run-semaphore31,1313
|
||||||
|
set-debug-process-run-semaphore!31,1313
|
||||||
|
debug-process-running?31,1313
|
||||||
|
set-debug-process-running?!31,1313
|
||||||
|
debug-process-exited?31,1313
|
||||||
|
set-debug-process-exited?!31,1313
|
||||||
|
debug-process-exceptions31,1313
|
||||||
|
set-debug-process-exceptions!31,1313
|
||||||
|
debug-process-runtime31,1313
|
||||||
|
set-debug-process-runtime!31,1313
|
||||||
|
debug-process-main-client31,1313
|
||||||
|
set-debug-process-main-client!31,1313
|
||||||
|
debug-process-clients31,1313
|
||||||
|
set-debug-process-clients!31,1313
|
||||||
|
debug-process31,1313
|
||||||
|
; Creates a trace thcreate-bind-trace59,3677
|
||||||
|
; Creates a trace thcreate-break-trace63,3900
|
||||||
|
(define (create-breacreate-empty-debug-process66,3952
|
||||||
|
create-empty-debug-client76,4469
|
||||||
|
|
||||||
|
mztake-syntax.ss,0
|
||||||
|
|
||||||
|
mztake.ss,0
|
||||||
|
|
@ -1,12 +1,58 @@
|
||||||
(module debugger-annotate mzscheme
|
(module debugger-annotate mzscheme
|
||||||
|
|
||||||
(require (prefix kernel: (lib "kerncase.ss" "syntax"))
|
(require (prefix kernel: (lib "kerncase.ss" "syntax"))
|
||||||
(lib "marks.ss" "mztake" "private"))
|
(lib "marks.ss" "mztake" "private")
|
||||||
|
(lib "mred.ss" "mred")
|
||||||
|
(lib "load-annotator.ss" "mztake" "private")
|
||||||
|
(lib "more-useful-code.ss" "mztake" "private")
|
||||||
|
(lib "list.ss"))
|
||||||
|
|
||||||
;; (define count 0)
|
(provide annotate-stx
|
||||||
|
run/incremental-annotation
|
||||||
(provide annotate)
|
bindings)
|
||||||
|
|
||||||
|
;; TARGETS is a list of pairs:
|
||||||
|
;; `(,module-long-filename (,character-offset ...))
|
||||||
|
|
||||||
|
(define (run/incremental-annotation main-module custodian targets receive-result)
|
||||||
|
|
||||||
|
(define ((break target) mark-set kind final-mark)
|
||||||
|
(let ([mark-list (continuation-mark-set->list mark-set debug-key)])
|
||||||
|
(receive-result (make-normal-breakpoint-info (cons final-mark mark-list) target))))
|
||||||
|
|
||||||
|
(define ((err-display-handler source) message exn)
|
||||||
|
(thread (lambda () (receive-result (make-error-breakpoint-info (list source exn))))))
|
||||||
|
|
||||||
|
(define (annotate-module-with-error-handler stx err-hndlr)
|
||||||
|
(syntax-case stx (module #%plain-module-begin)
|
||||||
|
[(module name req (#%plain-module-begin body ...))
|
||||||
|
#`(module name req (#%plain-module-begin
|
||||||
|
(error-display-handler #,err-hndlr)
|
||||||
|
body ...))]))
|
||||||
|
|
||||||
|
(define (path->target path)
|
||||||
|
(first (filter (lambda (c) (equal? (first c) path))
|
||||||
|
targets)))
|
||||||
|
|
||||||
|
(let* ([all-used-module-paths (map first targets)]
|
||||||
|
|
||||||
|
[annotate-module? (lambda (fn m)
|
||||||
|
(memf (lambda (sym) (equal? sym fn))
|
||||||
|
all-used-module-paths))]
|
||||||
|
|
||||||
|
[annotator (lambda (fn m stx)
|
||||||
|
;;(printf "annotating: ~a~n~n" fn)
|
||||||
|
(let* ([target (path->target fn)]
|
||||||
|
[breakpoints (second target)]
|
||||||
|
[stx (annotate-stx (expand stx) (list fn breakpoints) (break target))])
|
||||||
|
;; add an error handler so anything that goes wrong points to the correct module
|
||||||
|
(annotate-module-with-error-handler stx (err-display-handler fn))))])
|
||||||
|
|
||||||
|
(parameterize ([current-custodian custodian]
|
||||||
|
[current-namespace (make-namespace-with-mred)]
|
||||||
|
[error-display-handler (err-display-handler (format "Loading module ~a..." main-module))])
|
||||||
|
(require/annotations `(file ,main-module) annotate-module? annotator))))
|
||||||
|
|
||||||
(define (arglist-bindings arglist-stx)
|
(define (arglist-bindings arglist-stx)
|
||||||
(syntax-case arglist-stx ()
|
(syntax-case arglist-stx ()
|
||||||
[var
|
[var
|
||||||
|
|
@ -17,7 +63,12 @@
|
||||||
[(var . others)
|
[(var . others)
|
||||||
(cons #'var (arglist-bindings #'others))]))
|
(cons #'var (arglist-bindings #'others))]))
|
||||||
|
|
||||||
(define (annotate stx breakpoints breakpoint-origin break)
|
(define (annotate-break? expr targets)
|
||||||
|
(and (eq? (syntax-source expr) (first targets))
|
||||||
|
(memq (- (syntax-position expr) 1) ; syntax positions start at one.
|
||||||
|
(second targets))))
|
||||||
|
|
||||||
|
(define (annotate-stx stx targets break-fn)
|
||||||
|
|
||||||
(define (top-level-annotate stx)
|
(define (top-level-annotate stx)
|
||||||
(kernel:kernel-syntax-case stx #f
|
(kernel:kernel-syntax-case stx #f
|
||||||
|
|
@ -89,7 +140,7 @@
|
||||||
|
|
||||||
(define (break-wrap debug-info annotated)
|
(define (break-wrap debug-info annotated)
|
||||||
#`(begin
|
#`(begin
|
||||||
(#,break (current-continuation-marks) 'debugger-break #,debug-info)
|
(#,break-fn (current-continuation-marks) 'debugger-break #,debug-info)
|
||||||
#,annotated))
|
#,annotated))
|
||||||
|
|
||||||
(define annotated
|
(define annotated
|
||||||
|
|
@ -140,7 +191,6 @@
|
||||||
|
|
||||||
[(quote-syntax _) expr]
|
[(quote-syntax _) expr]
|
||||||
|
|
||||||
;; FIXME: we have to think harder about this
|
|
||||||
[(with-continuation-mark key mark body)
|
[(with-continuation-mark key mark body)
|
||||||
(quasisyntax/loc expr (with-continuation-mark key
|
(quasisyntax/loc expr (with-continuation-mark key
|
||||||
#,(annotate #`mark bound-vars #f)
|
#,(annotate #`mark bound-vars #f)
|
||||||
|
|
@ -162,18 +212,21 @@
|
||||||
[else (error 'expr-syntax-object-iterator "unknown expr: ~a"
|
[else (error 'expr-syntax-object-iterator "unknown expr: ~a"
|
||||||
(syntax-object->datum expr))]))
|
(syntax-object->datum expr))]))
|
||||||
|
|
||||||
;; (set! count (+ count 1))
|
(if (annotate-break? expr targets)
|
||||||
;; (if (= (modulo count 100) 0)
|
|
||||||
;; (fprintf (current-error-port) "syntax-source: ~v\nsyntax-position: ~v\n" (syntax-source expr) (syntax-position expr)))
|
|
||||||
|
|
||||||
|
|
||||||
(if (and (eq? (syntax-source expr) breakpoint-origin)
|
|
||||||
(memq (- (syntax-position expr) 1) ; syntax positions start at one.
|
|
||||||
breakpoints))
|
|
||||||
(break-wrap (make-debug-info expr bound-vars bound-vars 'at-break #f)
|
(break-wrap (make-debug-info expr bound-vars bound-vars 'at-break #f)
|
||||||
annotated)
|
annotated)
|
||||||
annotated))
|
annotated))
|
||||||
|
|
||||||
(top-level-annotate stx)))
|
(top-level-annotate stx))
|
||||||
|
|
||||||
|
;; Retreives the binding of a variable from a normal-breakpoint-info.
|
||||||
|
;; Returns a list of pairs `(,variable-name-stx ,variable-value). Each
|
||||||
|
;; item in the list is a shadowed instance of a variable with the given
|
||||||
|
;; name, with the first item being the one in scope.
|
||||||
|
(define (bindings event sym)
|
||||||
|
(let ([mark-list (normal-breakpoint-info-mark-list event)])
|
||||||
|
(map (lambda (binding) (list (mark-binding-binding binding)
|
||||||
|
(mark-binding-value binding)))
|
||||||
|
(lookup-all-bindings (lambda (id) (eq? (syntax-e id) sym))
|
||||||
|
mark-list)))))
|
||||||
|
|
||||||
|
|
||||||
|
|
@ -1,67 +0,0 @@
|
||||||
(module debugger-model mzscheme
|
|
||||||
(require (lib "unit.ss")
|
|
||||||
(lib "mred.ss" "mred")
|
|
||||||
(lib "marks.ss" "mztake" "private")
|
|
||||||
"debugger-annotate.ss"
|
|
||||||
"mztake-structs.ss"
|
|
||||||
(lib "load-annotator.ss" "mztake" "private")
|
|
||||||
(lib "more-useful-code.ss" "mztake" "private"))
|
|
||||||
|
|
||||||
(provide debugger-model@)
|
|
||||||
|
|
||||||
(define debugger-model@
|
|
||||||
(unit
|
|
||||||
(import receive-result
|
|
||||||
process)
|
|
||||||
(export run)
|
|
||||||
|
|
||||||
(define run-semaphore (debug-process-run-semaphore process))
|
|
||||||
|
|
||||||
(define ((break client) mark-set kind final-mark)
|
|
||||||
(let ([mark-list (continuation-mark-set->list mark-set debug-key)])
|
|
||||||
(receive-result (make-normal-breakpoint-info (cons final-mark mark-list) client))
|
|
||||||
(semaphore-wait run-semaphore)))
|
|
||||||
|
|
||||||
|
|
||||||
(define ((err-display-handler source) message exn)
|
|
||||||
(thread (lambda () (receive-result (make-error-breakpoint-info (list source exn))))))
|
|
||||||
|
|
||||||
|
|
||||||
(define (annotate-module-with-error-handler stx err-hndlr)
|
|
||||||
(syntax-case stx (module #%plain-module-begin)
|
|
||||||
[(module name req (#%plain-module-begin body ...))
|
|
||||||
#`(module name req (#%plain-module-begin
|
|
||||||
(error-display-handler #,err-hndlr)
|
|
||||||
body ...))]))
|
|
||||||
|
|
||||||
|
|
||||||
; Return run functions
|
|
||||||
(define (run)
|
|
||||||
(parameterize ([error-display-handler (err-display-handler "Trying to load client code...")])
|
|
||||||
(let* ([clients (debug-process-clients process)]
|
|
||||||
|
|
||||||
[all-used-module-paths (map (lambda (c) (debug-client-modpath c))
|
|
||||||
clients)]
|
|
||||||
|
|
||||||
[path->client (lambda (path)
|
|
||||||
(car (filter (lambda (c) (equal? (debug-client-modpath c) path))
|
|
||||||
clients)))]
|
|
||||||
|
|
||||||
[annotate-module? (lambda (fn m)
|
|
||||||
(memf (lambda (sym) (equal? sym fn))
|
|
||||||
all-used-module-paths))]
|
|
||||||
|
|
||||||
[annotator (lambda (fn m stx)
|
|
||||||
;(printf "annotating: ~a~n~n" fn)
|
|
||||||
(let* ([client (path->client fn)]
|
|
||||||
[breakpoints (hash-keys (debug-client-tracepoints client))]
|
|
||||||
[stx (annotate (expand stx) breakpoints fn (break client))])
|
|
||||||
; add an error handler so anything that goes wrong points to the correct module
|
|
||||||
(annotate-module-with-error-handler stx (err-display-handler fn))))]
|
|
||||||
|
|
||||||
[main-mod (debug-client-modpath (debug-process-main-client process))])
|
|
||||||
|
|
||||||
(parameterize ([current-custodian (debug-process-custodian process)]
|
|
||||||
[current-namespace (make-namespace-with-mred)]
|
|
||||||
[error-display-handler (err-display-handler (format "Loading module ~a..." main-mod))])
|
|
||||||
(require/annotations `(file ,main-mod) annotate-module? annotator))))))))
|
|
||||||
|
|
@ -117,14 +117,13 @@ TESTING/CAPABILITIES------------------------------------------------------------
|
||||||
|#
|
|#
|
||||||
|
|
||||||
(require (lib "match.ss")
|
(require (lib "match.ss")
|
||||||
(lib "unit.ss")
|
|
||||||
(lib "contract.ss")
|
(lib "contract.ss")
|
||||||
(lib "marks.ss" "mztake" "private") ; TODO local private copy until stepper release
|
(lib "marks.ss" "mztake" "private") ; TODO local private copy until stepper release
|
||||||
(prefix frp: (lib "frp.ss" "frtime"))
|
(prefix frp: (lib "frp.ss" "frtime"))
|
||||||
(lib "useful-code.ss" "mztake" "private")
|
(lib "useful-code.ss" "mztake" "private")
|
||||||
(lib "more-useful-code.ss" "mztake" "private") ; mostly for hash- bindings
|
(lib "more-useful-code.ss" "mztake" "private") ; mostly for hash- bindings
|
||||||
"mztake-structs.ss"
|
"mztake-structs.ss"
|
||||||
"debugger-model.ss")
|
"debugger-annotate.ss")
|
||||||
|
|
||||||
(provide/contract [start/resume (debug-process? . -> . void?)]
|
(provide/contract [start/resume (debug-process? . -> . void?)]
|
||||||
[kill (debug-process? . -> . void?)]
|
[kill (debug-process? . -> . void?)]
|
||||||
|
|
@ -188,19 +187,27 @@ TESTING/CAPABILITIES------------------------------------------------------------
|
||||||
; ;; ; ; ;; ; ; ; ; ; ;; ; ; ; ; ; ;
|
; ;; ; ; ;; ; ; ; ; ; ;; ; ; ; ; ; ;
|
||||||
; ;;;;; ;;;; ; ; ; ;;;;;; ;;;; ; ;;; ; ; ;;;;
|
; ;;;;; ;;;; ; ; ; ;;;;;; ;;;; ; ;;; ; ; ;;;;
|
||||||
;
|
;
|
||||||
|
|
||||||
|
(define (find-client process modpath)
|
||||||
|
(first
|
||||||
|
(filter (lambda (c) (equal? modpath (debug-client-modpath c)))
|
||||||
|
(debug-process-clients process))))
|
||||||
|
|
||||||
; Callback for when a breakpoint (tracepoint) is hit by the model
|
; Callback for when a breakpoint (tracepoint) is hit by the model
|
||||||
; ((client) breakpoint-struct) -> ()
|
; ((client) breakpoint-struct) -> ()
|
||||||
(define ((receive-result process) result)
|
(define ((receive-result process) result)
|
||||||
|
|
||||||
; Before we process the trace, see if we are supposed to pause
|
; Before we process the trace, see if we are supposed to pause
|
||||||
|
;; TODO : this condition variable has a race condition
|
||||||
(unless (running-now? process)
|
(unless (running-now? process)
|
||||||
(semaphore-wait (debug-process-run-semaphore process)))
|
(semaphore-wait (debug-process-run-semaphore process)))
|
||||||
|
|
||||||
(match result
|
(match result
|
||||||
; regular breakpoint
|
; regular breakpoint
|
||||||
[($ normal-breakpoint-info (top-mark rest-mark ...) client)
|
[($ normal-breakpoint-info (top-mark rest-mark ...) target)
|
||||||
(let* ([byte-offset (sub1 (syntax-position (mark-source top-mark)))]
|
(let* ([byte-offset (sub1 (syntax-position (mark-source top-mark)))]
|
||||||
|
;; TODO : find-client is slow and awkward
|
||||||
|
[client (find-client process (first target))]
|
||||||
[traces (hash-get (debug-client-tracepoints client) byte-offset)])
|
[traces (hash-get (debug-client-tracepoints client) byte-offset)])
|
||||||
|
|
||||||
(assert (not (empty? traces))
|
(assert (not (empty? traces))
|
||||||
|
|
@ -212,8 +219,8 @@ TESTING/CAPABILITIES------------------------------------------------------------
|
||||||
(frp:send-synchronous-events to-send))
|
(frp:send-synchronous-events to-send))
|
||||||
|
|
||||||
; Now that we processed the trace, do we want to pause or continue
|
; Now that we processed the trace, do we want to pause or continue
|
||||||
(when (running-now? process)
|
(unless (running-now? process)
|
||||||
(semaphore-post (debug-process-run-semaphore process))))]
|
(semaphore-wait (debug-process-run-semaphore process))))]
|
||||||
|
|
||||||
[($ error-breakpoint-info (source exn))
|
[($ error-breakpoint-info (source exn))
|
||||||
; all errors and raises from the TARGET program will be caught here
|
; all errors and raises from the TARGET program will be caught here
|
||||||
|
|
@ -270,19 +277,6 @@ TESTING/CAPABILITIES------------------------------------------------------------
|
||||||
(display (format "mztake: ~a~n---~n" str)))
|
(display (format "mztake: ~a~n---~n" str)))
|
||||||
|
|
||||||
|
|
||||||
; retreives the binding of a variable from a bind trace event
|
|
||||||
(define (binding event sym)
|
|
||||||
(define (do-n-times fn n arg)
|
|
||||||
(foldl (lambda (x arg) (fn arg)) arg (build-list n (lambda (x) x))))
|
|
||||||
|
|
||||||
(let ([mark-list (normal-breakpoint-info-mark-list event)]
|
|
||||||
[current-frame-num 0])
|
|
||||||
(map (lambda (binding) (list (mark-binding-binding binding)
|
|
||||||
(mark-binding-value binding)))
|
|
||||||
(lookup-all-bindings (lambda (id) (eq? (syntax-e id) sym))
|
|
||||||
(do-n-times cdr current-frame-num mark-list)))))
|
|
||||||
|
|
||||||
|
|
||||||
(define create-trace
|
(define create-trace
|
||||||
(case-lambda
|
(case-lambda
|
||||||
[(client line col type args)
|
[(client line col type args)
|
||||||
|
|
@ -308,11 +302,11 @@ TESTING/CAPABILITIES------------------------------------------------------------
|
||||||
(list variable-to-bind))]
|
(list variable-to-bind))]
|
||||||
[values (map
|
[values (map
|
||||||
(lambda (var)
|
(lambda (var)
|
||||||
(let ([val (binding event var)])
|
(let ([val (bindings event var)])
|
||||||
(if (empty? val)
|
(if (empty? val)
|
||||||
(script-error
|
(script-error
|
||||||
(format "Variable not found at the syntax location for the BIND: `~a'" var))
|
(format "Variable not found at the syntax location for the BIND: `~a'" var))
|
||||||
(cadar (binding event var)))))
|
(cadar (bindings event var)))))
|
||||||
vars)])
|
vars)])
|
||||||
(list evnt-rcvr
|
(list evnt-rcvr
|
||||||
(if (list? variable-to-bind) values
|
(if (list? variable-to-bind) values
|
||||||
|
|
@ -372,6 +366,15 @@ TESTING/CAPABILITIES------------------------------------------------------------
|
||||||
; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ;
|
; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ;
|
||||||
; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ;; ; ; ; ; ; ;
|
; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ;; ; ; ; ; ; ;
|
||||||
; ; ; ;;;; ;;; ;;;; ;;;; ;;;; ; ;;;; ; ; ; ;;; ;;;;
|
; ; ; ;;;; ;;; ;;;; ;;;; ;;;; ; ;;;; ; ; ; ;;; ;;;;
|
||||||
|
|
||||||
|
(define (run* process receive-result)
|
||||||
|
(run/incremental-annotation
|
||||||
|
(debug-client-modpath (debug-process-main-client process))
|
||||||
|
(debug-process-custodian process)
|
||||||
|
(map (lambda (c) (list (debug-client-modpath c)
|
||||||
|
(hash-keys (debug-client-tracepoints c))))
|
||||||
|
(debug-process-clients process))
|
||||||
|
receive-result))
|
||||||
|
|
||||||
(define (start-debug-process receive-result process)
|
(define (start-debug-process receive-result process)
|
||||||
; initialize the semaphore
|
; initialize the semaphore
|
||||||
|
|
@ -380,10 +383,7 @@ TESTING/CAPABILITIES------------------------------------------------------------
|
||||||
(frp:set-cell! (debug-process-exited? process) #f)
|
(frp:set-cell! (debug-process-exited? process) #f)
|
||||||
|
|
||||||
(thread (lambda ()
|
(thread (lambda ()
|
||||||
; connect to the debugger-model@ unit
|
(thread-wait (thread (lambda () (run* process receive-result))))
|
||||||
(define-values/invoke-unit (run) debugger-model@ #f receive-result process)
|
|
||||||
; run the process
|
|
||||||
(thread-wait (thread (lambda () (run))))
|
|
||||||
; program terminates
|
; program terminates
|
||||||
(stop process)
|
(stop process)
|
||||||
(print-info (format "process exited normally: ~a" (main-client-name process))))))
|
(print-info (format "process exited normally: ~a" (main-client-name process))))))
|
||||||
|
|
|
||||||
|
|
@ -279,7 +279,7 @@
|
||||||
(define (hash-values hash)
|
(define (hash-values hash)
|
||||||
(hash-fold hash empty (lambda (key val acc) (cons val acc))))
|
(hash-fold hash empty (lambda (key val acc) (cons val acc))))
|
||||||
(define (hash-pairs hash)
|
(define (hash-pairs hash)
|
||||||
(hash-fold hash empty (lambda (key val acc) (cons (cons key val) acc))))
|
(hash-fold hash empty (lambda (key val acc) (cons (list key val) acc))))
|
||||||
(define (hash-add-all! to-hash from-hash) ;; // memcpy-style argument order
|
(define (hash-add-all! to-hash from-hash) ;; // memcpy-style argument order
|
||||||
(hash-for-each from-hash
|
(hash-for-each from-hash
|
||||||
(lambda (key val) (hash-put! to-hash key val))))
|
(lambda (key val) (hash-put! to-hash key val))))
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue
Block a user