suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

cleaned up and fixed base-gm.ss in frtime and mztake

Browse Source 
svn: r2595
This commit is contained in:
Guillaume Marceau 2006-04-04 23:20:27 +00:00
parent 524dbb1cbe
commit 3d50bb27f2
2 changed files with 61 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
collects/frtime/base-gm.ss
View File

@ -2,13 +2,40 @@
(require (lib "list.ss")
(lib "etc.ss"))
(provide make-hash
(provide assert
print-each
make-hash
hash-get
hash-put!
hash-remove!
hash-map
hash-for-each
hash-mem?)
hash-mem?
hash-fold
hash-keys
hash-add-all!)
(define-struct (exn:assert exn) ())
(define-syntax (assert stx)
(syntax-case stx ()
[(src-assert bool) #'(src-assert bool "")]
[(src-assert bool msg ...)
(with-syntax ([src-text (datum->syntax-object
(syntax src-assert)
(format "~a:~a:~a: assertion failed: "
(syntax-source (syntax bool))
(syntax-line (syntax bool))
(syntax-column (syntax bool))))])
#'(unless bool
(raise (make-exn:assert (format-each src-text msg ...)))))]))
(define (format-each . args)
(apply string-append (map (lambda (s) (format "~a " s)) args)))
(define (print-each . args)
(printf "~a~n" (apply format-each args)))
(define make-hash make-hash-table)
(define hash-get hash-table-get)
@ -16,4 +43,13 @@
(define hash-remove! hash-table-remove!)
(define hash-map hash-table-map)
(define hash-for-each hash-table-for-each)
(define (hash-mem? hash item) (hash-get hash item (lambda () false))))
(define (hash-mem? hash item) (hash-get hash item (lambda () false)))
(define (hash-fold hash init fn)
(hash-for-each hash (lambda (key val) (set! init (fn key val init)))) init)
(define (hash-keys hash)
(hash-fold hash empty (lambda (key val acc) (cons key acc))))
(define (hash-add-all! to-hash from-hash) ;; // memcpy-style argument order
(hash-for-each from-hash
(lambda (key val) (hash-put! to-hash key val))))
)

47
collects/frtime/heap.ss
View File

@ -2,12 +2,13 @@
(require (lib "etc.ss")
"base-gm.ss"
(lib "list.ss")
"dv.ss")
(provide make-heap heap-empty? heap-size heap-insert heap-pop
heap-peak heap-remove heap-find
heap-contains heap-resort heap-tostring)
heap-contains heap-resort heap->list)
@ -119,43 +120,39 @@
(define (heap-resort heap item)
(heap-remove heap item)
(heap-insert heap item))
(define (heap-tostring heap . fns)
(let* ((data (t-data heap))
(data-list (let loop ((i 1))
(if (> i (heap-last heap)) empty
(cons (dv:ref data i) (loop (+ i 1)))))))
(string-append "heap: sz " (number->string (heap-size heap)) ", "
(apply to-string (cons data-list fns)))))
(define (heap->list heap)
(vector->list (t-data heap)))
(define (test)
(define f (make-heap > eq?))
(define d (t-data f))
(heap-insert f 99)
(debug "A " d)
(print-each "A " d)
(heap-remove-pos f 1)
(debug "B " d)
(print-each "B " d)
(for-each (lambda (x) (heap-insert f x)) '(1 2 3 4 5 6 7 8 9 10 11 12 13 14))
(debug "C " d)
(heap-remove f 10) (debug " " d)
(heap-remove f 5) (debug " " d)
(heap-remove f 8) (debug " " d)
(heap-remove f 13) (debug " " d)
(debug (heap-contains f 11))
(debug (heap-contains f 123))
(print-each "C " d)
(heap-remove f 10) (print-each " " d)
(heap-remove f 5) (print-each " " d)
(heap-remove f 8) (print-each " " d)
(heap-remove f 13) (print-each " " d)
(print-each (heap-contains f 11))
(print-each (heap-contains f 123))
(heap-pop f)
(heap-pop f)
(heap-pop f)
(heap-pop f) (debug " " d)
(debug (heap-contains f 11))
(debug (heap-contains f 4))
(debug (heap-tostring f))
(heap-pop f) (print-each " " d)
(print-each (heap-contains f 11))
(print-each (heap-contains f 4))
(print-each (heap->list f))
(heap-remove f 2)
(debug (heap-tostring f))
(print-each (heap->list f))
(heap-remove f 3)
(debug (heap-tostring f))
(print-each (heap->list f))
)
;(test)
)