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

svn: r2596

collects/mztake/TODO.txt

@@ -2,16 +2,6 @@
 - Automated tests
 - Trace by function name 
  
-  #|:::::::::LOAD/ANNOTATOR BUGS:::::::::::
-* catch oops exception
-* catch the other two exceptions that my loaders throw
-* detect if the source code for a certain module is missing and throw an exception
-* do I want to parameterize it over a given namespace?
-* does this handle module prefixes?
-* what happens if two modules have the same name in different directories
-* MAKE SURE THERE WONT BE COLLISIONS WHEN EVAL'NG MODULES...GIVE THEM UNIQUE NAMES BASED ON PATH!
-::::::::::::::::::::::::::::::::::::::::::
-
 CHANGES TO MAKE-----------------------------------------------------------------------------
 Ability to add named anchors into code using Special menu in DRS -- use those anchors as tracepoints.
 
@@ -19,42 +9,15 @@ Demo monitoring DrScheme for Robby?
 
 Bind Stop button to kill-all.
 
-Test Suite for debugger annotator
-
-Demo and docs for debugging multiple files, to make Robby happy.  It is true that the docs are not very helpful on this count.  It'd be nice if you could mock up a quick example of tracing something inside DrScheme....
-
 On the whole, I like the tool, although it'd be nice to have either
  	(a) an interactive pointy-clicky interface rather than figuring
  		out line/column co-ordinates, or
- 	(b) an AST-based description of the thing to be monitored (shades
- 		of aspect-oriented programming).
 
 
 Re-direct, or at least prefix, program output from the client so that it can be distinguished from the script
 
 Paramterize print-struct to #f for printing in the script
 
-
-DEMOS---------------------------------------------------------------------------------------
-* Data structure examples
-  Binary search over a tree, show which node is being examined, or the most commonly taken path
-  Parse, graph the AST -- show OR and AND precedence getting messed up
-
-* MST example
-
-* something with multiple threads doing something and draw the threads in different colors in a window
-
-
-OPTIMIZATIONS-------------------------------------------------------------------------------
-* improve speed of lookup for line-col->pos; load them into a hashtable?  not important since this is just startup time for the script.
-
-* improve speed of load/annotate
-
-* improve speed of functions in (run)
-
-* Remove marks.ss from MzTake as soon as the new version of it becomes standard with releases.
-
-
 ERROR-CHECKING/HANDLING---------------------------------------------------------------------
 
 * Make all exposed cells and evstreams read-only by lifting the identity function on them

collects/mztake/annotator.ss

@@ -6,6 +6,7 @@
            (lib "marks.ss" "mztake")
            (lib "mred.ss" "mred")
            (lib "pretty.ss")
+           (lib "base-gm.ss" "frtime")
            (lib "load-sandbox.ss" "mztake")
            (prefix srfi: (lib "search.ss" "srfi" "1"))
            )

collects/mztake/demos/dijkstra/dijkstra-mztake.ss

@@ -37,9 +37,9 @@
 	 "dijkstra-solver.ss"
          (lib "match.ss"))
 
-(define inserts (trace (loc "heap.ss" 49 6) item))
+(define inserts (trace (loc '(lib "heap.ss" "frtime") '(let* ((sorter _) _) _))
-;(define removes (trace (loc "heap.ss" 67 10) result))
+                       item))
-(define removes (trace (loc/r 66 22)))
+(define removes (trace (loc/r '(dv:ref (t-data _) _))))
 
 #| The following code
 merely observes the insertions and removals

collects/mztake/demos/dijkstra/dijkstra-solver.ss

@@ -1,5 +1,5 @@
 (module dijkstra-solver mzscheme
-  (require "heap.ss"
+  (require (lib "heap.ss" "frtime")
            (lib "list.ss")
            "graph.ss")
 

collects/mztake/demos/dijkstra/graph.ss

@@ -1,6 +1,8 @@
 ;; -*- compile-command: "mzscheme -M errortrace -u graph.ss" -*-
 (module graph mzscheme
-  (require (lib "more-useful-code.ss" "mztake"))
+  (require (lib "base-gm.ss" "frtime")
+           (lib "etc.ss")
+           (lib "list.ss"))
   
   (provide make-graph
            ;; --- Constructors :
@@ -57,7 +59,7 @@
   (define (make-graph . flags)
     (let ((flag-hash (make-hash)))
       (set! flags (expands-safe-flag flags))
-      (for-each-f flags (lambda (flag) (hash-put! flag-hash flag true)))
+      (for-each (lambda (flag) (hash-put! flag-hash flag true)) flags)
       (if (member 'equal flags)
           (make-t flag-hash 0 0 (make-hash 'equal) (make-hash 'equal) (make-hash 'equal))
           (make-t flag-hash 0 0 (make-hash) (make-hash) (make-hash)))))
@@ -159,12 +161,12 @@
   
   (define (graph-node-remove! graph node)
     (assert (graph-node-mem? graph node))
-    (for-each-f (hash-get (t-successors graph) node)
+    (for-each (lambda (i) (graph-edge-remove! graph node i))
-                (lambda (i) (graph-edge-remove! graph node i)))
+              (hash-keys (hash-get (t-successors graph) node)))
     
     (if (graph-directed? graph)
-        (for-each-f (hash-get (t-predessessors graph) node)
+        (for-each (lambda (i) (graph-edge-remove! graph i node))
-                    (lambda (i) (graph-edge-remove! graph i node))))
+                  (hash-keys (hash-get (t-predessessors graph) node))))
     
     (hash-remove! (t-nodes graph) node)
     (hash-remove! (t-successors graph) node)
@@ -177,15 +179,10 @@
       [(graph node with-self-loop) (graph-node-collapse! graph node with-self-loop (lambda (pred-label succ-label) no-value))]
       [(graph node with-self-loop label-fn)
        (let ((is-directed (graph-directed? graph)))
-         (for-each-f
+         (for-each
-
-          (if is-directed 
-              (hash-get (t-predessessors graph) node)
-              (hash-get (t-successors graph) node))
           
           (lambda (pred)
-            (for-each-f
+            (for-each
-             (hash-get (t-successors graph) node)
              (lambda (succ)
                (unless (or (and (not is-directed) (eq? pred succ))
                            (graph-edge-mem? graph pred succ))
@@ -197,7 +194,12 @@
                      (hash-put! (hash-get (t-successors graph) pred) succ new-label)
                      (if is-directed
                          (hash-put! (hash-get (t-predessessors graph) succ) pred new-label)
-                         (hash-put! (hash-get (t-successors graph) succ) pred new-label))))))))))
+                         (hash-put! (hash-get (t-successors graph) succ) pred new-label))))))
+             (hash-keys (hash-get (t-successors graph) node))))
+          
+          (hash-keys (hash-get
+                      (if is-directed (t-predessessors graph) (t-successors graph))
+                      node))))
        (graph-node-remove! graph node)]))
   
   (define (graph-node-has-label? graph node)
@@ -223,14 +225,14 @@
         (hash-keys (hash-get (t-successors graph) node))))
   
   (define (graph-for-each-adjs graph node fn)
-    (for-each (lambda (succ) (fn node succ))
+    (for-each (hash-keys (hash-get (t-successors graph) node))
-              (hash-get (t-successors graph) node))
+              (lambda (succ) (fn node succ)))
     (when (graph-directed? graph)
-      (for-each (lambda (pred) (fn pred node))
+      (for-each (hash-keys (hash-get (t-predessessors graph) node))
-                (hash-get (t-predessessors graph) node))))
+                (lambda (pred) (fn pred node)))))
   
   (define (graph-for-each-node graph fn)
-    (for-each-f (t-nodes graph) fn))
+    (for-each fn (hash-keys (t-nodes graph))))
   
   (define (graph-fold-nodes graph init fn)
     (let ((acc init))
@@ -308,8 +310,8 @@
     (graph-for-each-node 
      graph
      (lambda (from) 
-       (for-each-f (hash-get (t-successors graph) from)
+       (for-each (lambda (to) (fn from to))
-                   (lambda (to) (fn from to))))))
+                 (hash-keys (hash-get (t-successors graph) from))))))
   
   (define (graph-fold-edges graph init fn)
     (let ((acc init))
@@ -326,10 +328,10 @@
     (if (not (hash-mem? dealt-with node)) 
         (begin (hash-put! dealt-with node true)
                (pre-fn node)
-               (for-each-f (if backward
+               (for-each (lambda (n) (graph-dfs-from-node-with-log graph n dealt-with pre-fn post-fn backward))
-                               (hash-get (t-predessessors graph) node)
+                         (if backward
-                               (hash-get (t-successors graph) node))
+                             (hash-keys (hash-get (t-predessessors graph) node))
-                           (lambda (n) (graph-dfs-from-node-with-log graph n dealt-with pre-fn post-fn backward)))
+                             (hash-keys (hash-get (t-successors graph) node))))
                (post-fn node))))
   
   
@@ -381,8 +383,7 @@
       (let ((component-graph (graph-make-similar graph empty '(safe equal)))
             (node2supernode (make-hash)))
         
-        (for-each-f 
+        (for-each
-         finish-times
          (lambda (n) 
            (if (not (hash-mem? dealt-with n))
                (let ((super-node (graph-make-node! component-graph empty)))
@@ -392,7 +393,8 @@
                     (graph-node-set! component-graph super-node (cons i (graph-node-label component-graph super-node)))
                     (hash-put! node2supernode i super-node))
                   (lambda (i) i)
-                  true)))))
+                  true))))
+         finish-times)
         (graph-for-each-edge graph
                              (lambda (from to)
                                (graph-edge-add! component-graph 
@@ -441,9 +443,6 @@
   (define (graph-to-string-with-labels graph . to-string)
     (graph-to-string-prv graph true (if (empty? to-string) true (first to-string))))
   
-  (define to-string-f (make-to-string `((,t? ,graph-to-string))))
-  (define debug-f (make-debug to-string-f))
-  (define for-each-f (make-for-each))
   
   ;;; =====================================================================
   ;;; Tests
@@ -470,8 +469,8 @@
     (display (graph-edge-mem? graph 'a 'b))
     (newline)
     
-    (debug-f (graph-to-list graph true))
+    (print-each (graph-to-list graph true))
-    (graph-for-each-edge graph (lambda (a b) (debug-f "A " a b)))
+    (graph-for-each-edge graph (lambda (a b) (print-each "A " a b)))
     
     (graph-dfs-from-node graph 'a (lambda (i) (display i)))
     (newline)
@@ -490,7 +489,7 @@
       (graph-edge-add! star 'x 4)
       (graph-edge-add! star 'x 5)
       (graph-node-collapse! star 'x false)
-      (debug-f "collapsed:" (graph-to-list star)))
+      (print-each "collapsed:" (graph-to-list star)))
     
     (let ((strong-graph (make-graph 'directed)))
       
@@ -513,11 +512,11 @@
       (graph-edge-add! strong-graph 'xb 'xc)
       (graph-edge-add! strong-graph 'xc 'xa)
       
-      (debug-f "strong-graph" strong-graph)
+      (print-each "strong-graph" strong-graph)
-      (debug-f "component" (graph-components strong-graph))
+      (print-each "component" (graph-components strong-graph))
       (let ((components (graph-strongly-connected-components strong-graph)))
-        (debug-f "strong-components" components)
+        (print-each "strong-components" components)
-        (debug-f "toposort" (graph-topological-sort (first components)))))
+        (print-each "toposort" (graph-topological-sort (first components)))))
     
     (let ((u-graph (make-graph)))
       (graph-edge-add! u-graph 'a 'b)
@@ -531,11 +530,11 @@
       (graph-edge-add! u-graph 'xa 'xc)
       (graph-edge-add! u-graph 'xb 'xd)
       (newline)
-      (debug-f "u-graph" u-graph)
+      (print-each "u-graph" u-graph)
       (graph-edge-remove! u-graph 'b 'a)
       (graph-node-remove! u-graph 'd)
-      (debug-f "u-graph" u-graph)
+      (print-each "u-graph" u-graph)
-      (debug-f "component" (graph-components u-graph)))
+      (print-each "component" (graph-components u-graph)))
     
     )
   ;(graph-test)

collects/mztake/demos/dijkstra/heap-speed-mztake.ss

@@ -1,5 +1,5 @@
 (require (lib "mztake.ss" "mztake"))
-(set-main! "heap.ss")
+(set-main! '(lib "heap.ss" "frtime"))
 
 (define start (current-milliseconds))
 (set-running! #t)

collects/mztake/demos/dijkstra/heap.ss

@@ -1,162 +0,0 @@
-(module heap mzscheme
-  
-  (require (lib "etc.ss")
-           "dv.ss")
-  
-  
-  (provide make-heap heap-empty? heap-size heap-insert heap-pop
-	   heap-peak heap-remove heap-find
-           heap-contains heap-resort)
-  
-  
-  
-  
-  (define-struct t (sorter equality data))
-  
-  ;; sorter: elements which have the most trueness according to 
-  ;; the sorter pop out first
-  (define (make-heap sorter equality)
-    (let ((data (dv:make 5)))
-      (dv:append data 0)
-      (make-t sorter equality data)))
-  
-  (define (heap-size heap)
-    (- (dv:length (t-data heap)) 1))
-  
-  (define (heap-empty? heap)
-    (= (heap-size heap) 0))
-  
-  (define (heap-last heap)
-    (- (dv:length (t-data heap)) 1))
-  
-  (define (heap-parent i) 
-    (floor (/ i 2)))
-  
-  (define (heap-left i) (* i 2))
-  
-  (define (heap-right i) (+ 1 (* i 2)))
-  
-  (define (heap-has-right heap i) 
-    (<= (heap-right i) (heap-last heap)))
-  
-  (define (heap-has-left heap i)
-    (<= (heap-left i) (heap-last heap)))
-  
-  (define (heap-insert heap item)
-    (let* ((sorter (t-sorter heap))
-	   (data (t-data heap)))
-      (dv:append data item)
-      (let ((d (let loop ((prev (heap-last heap))
-			  (current (heap-parent (heap-last heap))))
-		 
-		 (cond ((= current 0) prev)
-		       ((sorter item (dv:ref data current)) 
-			(dv:set! data prev (dv:ref data current))
-			(loop current (heap-parent current)))
-		       (#t prev)))))
-	(dv:set! data d item))))
-  
-  (define (heap-peak heap)
-    (if (= (heap-size heap) 0) (error "heap-peak: empty")
-	(dv:ref (t-data heap) 1)))
-  
-  (define (heap-pop heap)
-    (if (= (heap-size heap) 0) (error "heap-pop: empty")
-        (let ([result (dv:ref (t-data heap) 1)])
-          (heap-remove-pos heap 1)
-          result)))
-  
-  (define (heap-remove-pos heap pos)
-    (let* ((data (t-data heap))
-	   (sorter (t-sorter heap)))
-      
-      (cond ((= 0 (heap-size heap)) (error "heap: removing from empty"))
-	    ((= pos (heap-last heap)) (dv:remove-last data))
-	    (#t (let ((item (dv:ref data (heap-last heap))))
-		  (dv:remove-last data)
-		  (let loop ((current pos))
-		    
-		    (dv:set! data current item)
-		    (let* ((left (heap-left current))
-			   (right (heap-right current))
-			   (best-1 (if (and (heap-has-left heap current)
-					    (sorter (dv:ref data left) item)) 
-				       left current))
-			   
-			   (best-2 (if (and (heap-has-right heap current)
-					    (sorter (dv:ref data right)
-						    (dv:ref data best-1)))
-				       right best-1)))
-		      
-		      (if (not (= best-2 current))
-			  (begin (dv:set! data current (dv:ref data best-2))
-				 (loop best-2))))))))))
-  
-  ;; return false if the object is not found
-  (define (heap-remove heap item)
-    (let ((pos (heap-find heap item)))
-      (if (not pos) false
-	  (begin (heap-remove-pos heap pos) true))))
-  
-  (define (heap-contains heap item)
-    (if (heap-find heap item) true false))
-  
-  (define (heap-find heap item)
-    (let ((data (t-data heap))
-	  (equality (t-equality heap))
-	  (sorter (t-sorter heap)))
-      (let loop ((current 1))
-	(let ((current-item (dv:ref data current)))
-	  (cond ((equality item current-item) current)
-		((sorter item current-item) #f)
-		(#t (or (and (heap-has-left heap current)
-			     (not (sorter item (dv:ref data (heap-left current))))
-			     (loop (heap-left current)))
-			(and (heap-has-right heap current)
-			     (not (sorter item (dv:ref data (heap-right current))))
-			     (loop (heap-right current))))))))))
-  
-  (define (heap-resort heap item)
-    (heap-remove heap item)
-    (heap-insert heap item))
-  
-  
-  
-  (define (test)
-    (define f (make-heap > eq?))
-    (define d (t-data f))
-    (heap-insert f 99)
-    ;(debug "A " d) 
-    (heap-remove-pos f 1)
-    ;(debug "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))
-    (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-remove f 2)
-    ;(debug (heap-tostring f))
-    (heap-remove f 3)
-    ;(debug (heap-tostring f))
-    )
-  
-  (define (test-speed)
-    (let loop ([count  3000]) 
-      (when (> count 0)
-        (test)
-        (loop (sub1 count)))))
-  
-;  (time (test-speed))
-  
-  )
-

collects/mztake/demos/random/random-mztake.ss

@@ -3,7 +3,7 @@
          (lib "useful-code.ss" "mztake")
          (as-is mzscheme assoc))
 
-(define/bind (loc "random.ss" 4 6) x)
+(define/bind (loc "random.ss" '(loop _)) x)
 
 (define (assoc-inc l x)
   (let ([filtered (filter (lambda (y) (not (eq? x (first y)))) l)]

collects/mztake/demos/sine/sine-mztake.ss

@@ -2,8 +2,7 @@
          (lib "useful-code.ss" "mztake"))
 (require (lib "mztake.ss" "mztake"))
 
-;(define/bind (loc "sine.ss" 5 ) x sin-x)
+(define/bind (loc "sine.ss" '(if _) ) x sin-x)
-(define/bind (loc "sine.ss" '(if  _ ...) ) x sin-x)
 
 (define (pick-cute-color x y)
   (if (< 200 y)

collects/mztake/demos/sprofiler/sprofiler-mztake.ss

@@ -1,6 +1,6 @@
 (require (lib "mztake.ss" "mztake" )
          (lib "match.ss")
-         (lib "more-useful-code.ss" "mztake"))
+         (lib "base-gm.ss" "frtime"))
 
 (set-main! "picture.ss")
 

collects/mztake/doc.txt

@@ -26,14 +26,14 @@ behavior of the program "highway-mztake.ss", in the demos directory of
 the MzTake collection:
 
   (require (lib "mztake.ss" "mztake"))
-  (define/bind (loc "highway.ss" 3) speed)
+  (define/bind (loc "highway.ss" 4) speed)
   (printf-b "current speed: ~a" speed)
        ;; more code
   (set-running! true)
 
 This code executes a target module in the file "highway.ss"
 after installing a _trace point_ (also known as a _watch
-point_) just before the Scheme expression on the third line
+point_) just before the Scheme expression on the fourth line
 of "highway.ss".  SPEED is a FrTime behavior that always
 contains the *current* value of the variable named SPEED in
 the target program.
@@ -167,7 +167,22 @@ _Installing Trace Points_
    datum.  For instance, to install a trace point on the tenth line of
    the MzLib's list library, use:
 
-     (trace (loc '(lib "list.ss") 10) ...)
+     (trace (loc '(lib "list.ss") 10)   <body>   )
+
+> (loc require-spec pattern)
+
+   The LOC function can also accept a pattern.  MzTake will scan the
+   text of the target source file and install a breakpoint at every
+   location where the text matches the pattern.  The pattern language
+   is very simple.  Every symbol in the pattern is taken literally,
+   with the exception of the underscore.  In a pattern, and underscore
+   stand for zero, one, or many items.  Unlike the patterns used by
+   match.ss, MzTake does not make use of an ellipsis to indicate
+   repetition.  The repetition is always implicit. The following
+   expression inserts a tracepoint on every lambda expression that has
+   exactly one argument, called "l" :
+
+     (trace (loc '(lib "list.ss") '(lambda (l) _))  <body> )
   
 > (trace loc body ...)
 

collects/mztake/engine.ss

@@ -2,11 +2,12 @@
   (require "marks.ss"
            (lib "etc.ss")
            (lib "list.ss")
+           (lib "match.ss")
            (prefix frp: (lib "lang-ext.ss" "frtime"))           
            (rename (lib "frp-core.ss" "frtime")
                    frp:signal-thunk signal-thunk)
            "useful-code.ss"
-           "more-useful-code.ss" ; mostly for hash- bindings
+           (lib "base-gm.ss" "frtime")
            "mztake-structs.ss"
            "load-sandbox.ss"
            "annotator.ss"
@@ -71,13 +72,13 @@
   
   (define (pattern->pos stx-lst)
     (define (quote-symbols lst)
-      (cond 
+      (match lst
-        [(empty? lst) empty]
+        [(? symbol? s) `(quote ,s)]
-        [(eq? lst '_) lst]
+        [() empty]
-        [(eq? lst '...) lst]
+        [('_ tl ...) `(_ ... ,@(quote-symbols tl))]
-        [(symbol? lst) `(quote ,lst)]
+        [(hd tl ...) (cons (quote-symbols hd)
-        [else (cons (quote-symbols (first lst))
+                           (quote-symbols tl))]
-                    (quote-symbols (rest lst)))]))
+        [item item]))
     
     (define (collect-locations h stx lst)
       (let loop ([stx stx] [lst lst])
@@ -271,6 +272,11 @@
        
        ;; annotate-module?
        (lambda (filename module-name)
+         #;(print-each "annotate-module?"
+                       filename
+                       (process-has-file? process filename)
+                       (policy-requests-annotatation? (debug-process-policy process) filename))
+         
          (or (process-has-file? process filename)
              (policy-requests-annotatation? (debug-process-policy process) filename)))
        
@@ -278,7 +284,10 @@
        (lambda (stx)
          (if (not (syntax-source stx))
              stx
-             (let*-values ([(client) (find-client/create process (path->string (syntax-source stx)))]
+             (let*-values ([(client)
+                            (find-client/create
+                             process
+                             (path->string (syntax-source stx)))]
                            [(annotated-stx pos-list)
                             (annotate-for-single-stepping 
                              stx 

collects/mztake/more-useful-code.ss

@@ -1,54 +0,0 @@
-(module more-useful-code mzscheme
-  (require (lib "list.ss")
-	   (lib "etc.ss"))
-  
-  (provide make-hash
-           hash?
-	   hash-get
-	   hash-put!
-	   hash-remove!
-	   hash-map
-	   hash-for-each
-           hash-size/slow
-	   hash-mem?
-           hash-fold
-           hash-filter!
-           hash-keys
-           hash-values
-           hash-pairs
-           hash-add-all!
-           hash-get-or-define!)
-  
-  
-  (define make-hash make-hash-table)
-  (define hash? hash-table?)
-  (define hash-get hash-table-get)
-  (define hash-put! hash-table-put!)
-  (define hash-remove! hash-table-remove!)
-  (define hash-map hash-table-map)
-  (define hash-for-each hash-table-for-each)
-  (define (hash-empty? hash)(let/ec k (hash-for-each hash (lambda (k v) (k false))) true))
-  (define (hash-size/slow hash) (hash-fold hash 0 (lambda (key val acc) (+ acc 1))))
-  (define (hash-mem? hash item) (let/ec k (begin (hash-get hash item (lambda () (k false))) true)))
-  (define (hash-fold hash init fn)
-    (hash-for-each hash (lambda (key val) (set! init (fn key val init)))) init)
-  (define (hash-filter! hash predicate)
-    (hash-for-each 
-     hash (lambda (key val) (if (not (predicate key val))
-                           (hash-remove! hash key)))))
-  (define (hash-keys hash) 
-    (hash-fold hash empty (lambda (key val acc) (cons key acc))))
-  (define (hash-values hash) 
-    (hash-fold hash empty (lambda (key val acc) (cons val acc))))
-  (define (hash-pairs hash)
-    (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
-    (hash-for-each from-hash
-                   (lambda (key val) (hash-put! to-hash key val))))
-
-  (define (hash-get-or-define! hash key val-fn)
-    (if (not (hash-mem? hash key)) 
-        (begin (let ((v (val-fn)))
-                 (hash-put! hash key v)
-                 v))
-        (hash-get hash key))))

collects/mztake/mztake-structs.ss

@@ -1,7 +1,7 @@
 (module mztake-structs mzscheme
   (require (lib "match.ss")
            (lib "etc.ss")
-           (lib "more-useful-code.ss" "mztake"))
+           (lib "base-gm.ss" "frtime"))
   
   (provide (all-defined))
   

collects/mztake/mztake.ss

@@ -6,7 +6,7 @@
            (rename (lib "frtime.ss" "frtime") frp:value-nowable? value-nowable?)
            (rename (lib "frtime.ss" "frtime") frp:behaviorof behaviorof)
            "mztake-structs.ss"
-           "more-useful-code.ss"
+           (lib "base-gm.ss" "frtime")
            (lib "etc.ss")
            (lib "list.ss")
            "marks.ss"