diff options
| -rw-r--r-- | def.lisp | 39 | ||||
| -rw-r--r-- | package.lisp | 2 | ||||
| -rw-r--r-- | util.lisp | 4 |
3 files changed, 44 insertions, 1 deletions
@@ -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)) @@ -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)) |