Explorar el Código

removed memoize instrumentation and general cleanup

Mark VandenBrink hace 12 años
padre
commit
85d54a8729
Se han modificado 1 ficheros con 12 adiciones y 24 borrados
  1. 12 24
      utils.lisp

+ 12 - 24
utils.lisp

@@ -3,7 +3,6 @@
 (in-package #:utils)
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
-  (pushnew :INSTRUMENT-MEMOIZED *features*)
   #+DBG (defvar *standard-optimize-settings* '(optimize (debug 3)))
   #-DBG (defvar *standard-optimize-settings* '(optimize (speed 3) (safety 0) (space 0) (debug 0)))
   )
@@ -12,7 +11,9 @@
 
 (defun warn-user (format-string &rest args)
   "Print a warning error to *ERROR-OUTPUT* and continue"
-  (when *break-on-warn-user* (break "Breaking in WARN-USER"))
+  (declare #.utils:*standard-optimize-settings*)
+  (when *break-on-warn-user*
+    (break "Breaking in WARN-USER"))
   (format *error-output* "~&********************************************************************************~%")
   #+CCL (format *error-output* "~&WARNING in ~a:: " (ccl::%last-fn-on-stack 1))
   (apply #'format *error-output* format-string args)
@@ -33,9 +34,11 @@
 (declaim (inline upto-null))
 (defun upto-null (string)
   "Trim STRING to end at first NULL found"
+  (declare #.utils:*standard-optimize-settings*)
   (subseq string 0 (position #\Null string)))
 
 (defun dump-data (file-name data)
+  (declare #.utils:*standard-optimize-settings*)
   (with-open-file (f file-name :direction :output :if-exists :supersede :element-type '(unsigned-byte 8))
     (write-sequence data f)))
 
@@ -80,40 +83,24 @@ The above will expand to (ash (logand #xFFFBB240 #xFFE00000) -21) at COMPILE tim
   `(aif ,test-form
         (progn ,@body)))
 
-#+INSTRUMENT-MEMOIZED (progn
-                        (defstruct memoized-funcs
-                          name
-                          table
-                          calls
-                          finds
-                          news)
-                        (defvar *memoized-funcs* nil))
-
 (defun mk-memoize (func-name)
   "Takes a normal function object and returns a memoized one"
+  (declare #.utils:*standard-optimize-settings*)
   (let* ((func (symbol-function func-name))
-         (hash-table (make-hash-table :test 'equal))
-          #+INSTRUMENT-MEMOIZED (s (make-memoized-funcs :table hash-table :calls 0 :finds 0 :news 0 :name func-name))
-         )
-
-    #+INSTRUMENT-MEMOIZED (push s *memoized-funcs*)
+         (hash-table (make-hash-table :test 'equal)))
 
     #'(lambda (arg)
         (multiple-value-bind (value foundp) (gethash arg hash-table)
-          #+INSTRUMENT-MEMOIZED (incf (memoized-funcs-calls s))
           (if foundp
-              (progn
-                #+INSTRUMENT-MEMOIZED (incf (memoized-funcs-finds s))
-                value)
-              (progn
-                #+INSTRUMENT-MEMOIZED (incf (memoized-funcs-news s))
-                (setf (gethash arg hash-table) (funcall func arg))))))))
+              value
+              (setf (gethash arg hash-table) (funcall func arg)))))))
 
 (defmacro memoize (func-name)
-  "Memoize function associated with Function-Name. Simplified version"
+  "Memoize function associated with FUNC-NAME. Simplified version"
   `(setf (symbol-function ,func-name) (utils::mk-memoize ,func-name)))
 
 (defun timings (function)
+  (declare #.utils:*standard-optimize-settings*)
   (let ((real-base (get-internal-real-time)))
     (funcall function)
     (float (/ (- (get-internal-real-time) real-base) internal-time-units-per-second))))
@@ -145,6 +132,7 @@ The macro expansion has relatively low overhead in space or time."
 
 (defun DBG-helper (tag expressions-thunks last-expression last-thunk)
   ;; Helper for the above debugging macro
+  (declare #.utils:*standard-optimize-settings*)
   (labels
       ((f (stream fmt &rest args)
          (with-standard-io-syntax