[Openmcl-devel] Re: PPC Floating-Point Compiler for MCL/OpenMCL

[Gary King]

Hi Randall, 

This is awesome! One thing I'd like is being able to do local functions. E.g.,  

(defun nearly-equal-p (x y &optional (threshold 0.0001D0)) 
  ;; excuse the symbol overuse! 
  (double-flet ((doit (x y threshold) 
                  (< (abs (- x y)) threshold))) 
               (doit x y threshold))) 

This is mainly to support more complex lambda lists and give people a chance to coerce variables if necessary.  

Our lab also has macros defun* and defmethod* which support optional type checking and temporary declaration removal without altering the source code. In development, we add the extra type checking and remove certain declarations and then add them back
when we're sure of the code. This might be an easy way to handle the type check or not to type check question. The source for this is below 



;;; --------------------------------------------------------------------------- 
;;; defun* and defmethod* : conditional declarations 
;;; --------------------------------------------------------------------------- 

(defvar *optimizations-to-ignore*  
  '() 
  "Declarations in this list are ignored in defmethod* and defun* forms.") 

;;; --------------------------------------------------------------------------- 

(defvar *add-check-types* t 
  "If true (the default), type declarations are parsed and check-types  
are added for each of them.") 

;;; --------------------------------------------------------------------------- 

#+test 
(setf *add-check-types* t 
      *optimizations-to-ignore* '(list type optimize)) 

;;; --------------------------------------------------------------------------- 

(defmacro defmethod* (name &rest args) 
  `(defmethod ,name ,@(parse-defun args))) 

;;; --------------------------------------------------------------------------- 

(defmacro defun* (name args &body body) 
  `(defun ,name ,args ,@(parse-defun body))) 

;;; --------------------------------------------------------------------------- 

(defun parse-defun (forms) 
  ;; minor optimization 
  (when (and (not *add-check-types*) 
             (null *optimizations-to-ignore*)) 
    (return-from parse-defun forms)) 
   
  (let ((check-types nil)) 
    (labels ((do-it (body) 
               (cond ((null body) nil) 
                     ((atom body) body) 
                     ((eq (first body) 'declare)  
                      (multiple-value-bind (parsed-version checks) 
                                           (parse-declare body) 
                        (setf check-types (append check-types checks)) 
                        parsed-version)) 
                     (t 
                      (when (and (consp (car body)) 
                                 check-types 
                                 (not (eq (first (car body)) 'declare))) 
                        (setf body (append check-types body)) 
                        (nilf check-types)) 
                      (cons (do-it (car body)) 
                            (do-it (cdr body))))))) 
      (do-it forms)))) 
          
;;; --------------------------------------------------------------------------- 

(defun parse-declare (forms) 
  (let ((checks nil)) 
    (labels ((catch-types (body) 
               (when (and *add-check-types* 
                          (type-declaration-p body)) 
                 (destructuring-bind (type &rest vars) 
                                     (if (eq (first body) 'type) 
                                       (rest body) 
                                       body) 
                   (setf checks (append checks (mapcar (lambda (var) 
                                                         `(check-type ,var ,type)) 
                                                       vars)))))) 
             (do-it (body) 
               (cond ((null body) nil) 
                     ((atom body) body) 
                     ((and (type-declaration-p (first body)) 
                           (member 'type *optimizations-to-ignore*)) 
                      (catch-types (first body)) 
                      nil) 
                     ((member (first body) *optimizations-to-ignore*) 
                      nil) 
                     (t 
                      (cons (do-it (car body)) 
                            (do-it (cdr body))))))) 
      (values (do-it forms) checks)))) 

;;; --------------------------------------------------------------------------- 

(defun type-declaration-p (declaration) 
  (and (consp declaration) 
       (or (eq (first declaration) 'type) 
           #+MCL 
           (ccl:type-specifier-p declaration)))) 


Thanks for the contrib, 
Gary 



On Friday, February 7, 2003, at 01:33 PM, Randall Beer wrote: 


> I'm releasing version 0.1 of FPC-PPC, a floating-point compiler for MCL and OpenMCL. 
> 
> The source code and documentation can be found in the Software section at 
> http://vorlon.cwru.edu/~beer 
> 
> FPC-PPC compiles Lisp double-float expressions directly into PPC assembly language, producing code that is usually significantly faster and that allocates much less memory than the Lisp compiler. 
> 
> For example, the following function takes about 370 ms to execute 100,000 times (on a 1GHz PowerBook G4; not including GC time) and allocates 14.4MB of memory on MCL 5.0b: 
> 
> (defun euclidean-distance-3 (x1 y1 z1 x2 y2 z2) 
>   (let ((dx (- x1 x2)) 
>         (dy (- y1 y2)) 
>         (dz (- z1 z2))) 
>     (sqrt (+ (* dx dx) (* dy dy) (* dz dz))))) 
> 
> Using FPC-PPC, the following executes in just 33 ms and allocates *no* memory: 
> 
> (define-double-function  %euclidean-distance-3 (x1 y1 z1 x2 y2 z2) 
>   (let ((dx (- x1 x2)) 
>         (dy (- y1 y2)) 
>         (dz (- z1 z2))) 
>     (sqrt (+ (* dx dx) (* dy dy) (* dz dz))))) 
> 
> (setf x! (%copy-float 0.0)) 
> 
> (time 
>   (dotimes (i 100000) 
>     (%set-double! x! (euclidean-distance-3 1.0D0 2.0D0 3.0D0 4.0D0 5.0D0 6.0D0)))) 
> 
> This is a PRELIMINARY release.  Comments and bug reports are welcome. 
> 
> Randy Beer 
> 
> 
> 
--  
Gary Warren King 
Senior Research Fellow 
Experimental Knowledge Systems Laboratory 
Department of Computer Science 
Computer Science Building 
Amherst, Massachusetts 01003 
413.577.0176 
gwking at cs.umass.edu