Add: def:fast for optimized function defs

3 files changed, 44 insertions, 1 deletions

diff --git a/def.lisp b/def.lisp
index 9944505..0142801 100644
--- a/def.lisp
+++ b/def.lisp
@@ -98,4 +98,43 @@ E.g.
          ,@options))))
 
 
+(defmacro fast (name (&rest lambda-list) -> return-type &body body)
+  "A fastfun is one for which every parameter is typed, a return type is
+declared. DEF:FAST generates an optimized DEFUN.
 
+Each positional parameter must be a list (VAR TYPE) &KEY &REST and
+&OPTIONAL arguments all look like (VAR TYPE . MORE) where MORE is
+whatever defun normally accepts in the lambda list for these
+arguments.
+
+E.g. 
+
+(def::fast sum-ints ((x integer) (y integer) &optional (z integer 0)) -> integer
+    \"Sums integers\"
+    (+ x y z))
+"
+  (assert (string-equal -> "->") () "-> must be named -> ** chortle **.")
+  (multiple-value-bind (lambda-list type-declarations)
+      (loop
+        :with types := nil
+        :with ll := nil
+        :for x :in lambda-list
+        :do (cond ((lambda-opt-p x)
+                   (push x ll))
+                  ((listp x)
+                   (destructuring-bind (var type . other) x
+                     (let ((found (find type types
+                                        :test #'equalp
+                                        :key #'second)))
+                       (if found
+                           (push var (cddr found))
+                           (push (list 'cl:type type var) types)))
+                     (push 
+                      (if other (cons var other) var)
+                      ll))))
+        :finally (return (values (nreverse ll) types)))
+    `(defun ,name ,lambda-list
+       (declare ,@type-declarations
+                (values ,return-type)
+                (optimize (speed 3) (safety 0)))
+       ,@body)))
diff --git a/package.lisp b/package.lisp
index 779ea68..af8d29c 100644
--- a/package.lisp
+++ b/package.lisp
@@ -3,4 +3,4 @@
 (defpackage #:def
   (:use #:cl)
   (:shadow #:var #:class)
-  (:export #:class #:var #:const))
+  (:export #:class #:var #:const #:fast))
diff --git a/util.lisp b/util.lisp
index 537d85d..3008865 100644
--- a/util.lisp
+++ b/util.lisp
@@ -34,3 +34,7 @@ YES is everything for which PRED is T, NO is everything else."
        (string= muffer name :end2 (length muffer))
        (string= muffer name :start2 (- (length (symbol-name name))
                                        (length muffer)))))
+
+(defun lambda-opt-p (x)
+  (find x '(cl:&optional cl:&key cl:&aux cl:&allow-other-keys cl:&rest)
+        :test #'eq))