[cells-cvs] CVS cells/utils-kt

[ktilton]

Update of /project/cells/cvsroot/cells/utils-kt
In directory clnet:/tmp/cvs-serv8789/utils-kt

Modified Files:
	core.lisp debug.lisp detritus.lisp flow-control.lisp 
Log Message:
nothing special

--- /project/cells/cvsroot/cells/utils-kt/core.lisp	2008/04/23 03:20:10	1.9
+++ /project/cells/cvsroot/cells/utils-kt/core.lisp	2008/06/16 12:38:04	1.10
@@ -46,41 +46,26 @@
 		value)))
       ,@(when docstring (list docstring)))))
 
-
-(export! exe-path exe-dll font-path)
-
-#-iamnotkenny
-(defun exe-path ()
-  #+its-alive!
-  (excl:current-directory)
-  #-its-alive!
+(defun test-setup (&optional drib)
+  #+(and allegro ide)
+  (ide.base::find-new-prompt-command
+   (cg.base::find-window :listener-frame))
+  (when drib
+    (dribble (merge-pathnames 
+              (make-pathname :name drib :type "TXT")
+              (project-path)))))
+
+(export! test-setup test-prep test-init)
+(export! project-path)
+(defun project-path ()
+  #+(and allegro ide)
   (excl:path-pathname (ide.base::project-file ide.base:*current-project*)))
 
-#-iamnotkenny 
-(defun font-path ()
-  (merge-pathnames
-   (make-pathname
-    :directory #+its-alive! (list :relative "font")
-    #-its-alive! (append (butlast (pathname-directory 
-       (exe-path)
-  ))
-   (list "TY Extender" "font")))
-   (exe-path)))
-
 #+test
-(list (exe-path)(font-path))
+(test-setup)
 
-(defmacro exe-dll (&optional filename)
-  (assert filename)
-  (concatenate 'string filename ".dll"))
+(defun test-prep (&optional drib)
+  (test-setup drib))
 
-#+chya
-(defun exe-dll (&optional filename)
-  (merge-pathnames
-   (make-pathname :name filename :type "DLL"
-     :directory (append (butlast (pathname-directory (exe-path)))
-                  (list "dll")))
-   (exe-path)))
-
-#+test
-(probe-file (exe-dll "openal32"))
+(defun test-init (&optional drib)
+  (test-setup drib))
\ No newline at end of file
--- /project/cells/cvsroot/cells/utils-kt/debug.lisp	2008/03/15 15:18:34	1.19
+++ /project/cells/cvsroot/cells/utils-kt/debug.lisp	2008/06/16 12:38:04	1.20
@@ -55,13 +55,13 @@
 
 (defmacro count-it (&rest keys)
   (declare (ignorable keys))
-  #+(or) `(progn)
-  `(when (car *counting*)
+  `(progn)
+  #+(or) `(when (car *counting*)
      (call-count-it , at keys)))
 
 (defun call-count-it (&rest keys)
     (declare (ignorable keys))
-  (when (find (car keys) '(:trcfailed :TGTNILEVAL))
+  #+nahh (when (find (car keys) '(:trcfailed :TGTNILEVAL))
     (break "clean up time ~a" keys))
   (let ((entry (assoc keys *count* :test #'equal)))
       (if entry
@@ -85,6 +85,7 @@
   (when clearp (count-clear "show-count")))
   
 
+               
 ;-------------------- timex ---------------------------------
 
 (export! timex)
--- /project/cells/cvsroot/cells/utils-kt/detritus.lisp	2008/03/15 15:18:34	1.20
+++ /project/cells/cvsroot/cells/utils-kt/detritus.lisp	2008/06/16 12:38:04	1.21
@@ -59,30 +59,6 @@
 (defun collect-if (test list)
   (remove-if-not test list))
 
-(defun test-setup (&optional drib)
-  #-(or iamnotkenny its-alive!)
-  (ide.base::find-new-prompt-command
-   (cg.base::find-window :listener-frame))
-  (when drib
-    (dribble (merge-pathnames 
-              (make-pathname :name drib :type "TXT")
-              (project-path)))))
-
-(export! project-path)
-(defun project-path ()
-  #+allegro (excl:path-pathname (ide.base::project-file ide.base:*current-project*)))
-
-#+test
-(test-setup)
-
-(defun test-prep (&optional drib)
-  (test-setup drib))
-
-(defun test-init (&optional drib)
-  (test-setup drib))
-
-(export! test-setup test-prep test-init)
-
 ;;; --- FIFO Queue -----------------------------
 
 (defun make-fifo-queue (&rest init-data)
--- /project/cells/cvsroot/cells/utils-kt/flow-control.lisp	2008/03/15 15:18:34	1.13
+++ /project/cells/cvsroot/cells/utils-kt/flow-control.lisp	2008/06/16 12:38:04	1.14
@@ -150,11 +150,15 @@
 (defun -1?1 (x) (* -1?1 x))
 
 (defun prime? (n)
-  (and (> n 1)
-    (or (= 2 n)(oddp n))
-    (loop for d upfrom 3 by 2 to (sqrt n)
-        when (zerop (mod n d)) return nil
-        finally (return t))))
+  (when (> n 1)
+    (cond
+     ((= 2 n) t)
+     ((evenp n) (values nil 2))
+     (t (loop for d upfrom 3 by 2 to (sqrt n)
+            when (zerop (mod n d)) do (return-from prime? (values nil d))
+            finally (return t))))))
+
+
 
 ; --- cloucell support for struct access of slots ------------------------