Page 3 of 3

Re: Please help my head get around 'deftype'

Posted: Wed Oct 22, 2008 10:30 am
by qbg
I was thinking today, and came up with a better implementation for defun*:

Code: Select all

(defparameter *%function-types* (make-hash-table :test #'eq))

(defmacro defun* (name limited-lambda-list &body body)
  "Like defun, but saves type information.
   Special lambda lists (&optional, &key, etc.) not supported
   Lambda list treated like that of defmethod; ((integer a) b (integer c)) would
    yield variable a, b, and c where a&c are integers and b is of type T"
  (let ((ll (mapcar (lambda (itm) (if (consp itm) (cadr itm) itm)) limited-lambda-list))
	(types (mapcar (lambda (itm) (if (consp itm) (car itm) t)) limited-lambda-list))
        (docstring (if (stringp (car body)) (car body)))
        (body (if (stringp (car body)) (cdr body) body)))
    `(progn
       (if (fboundp ',name)
	   (remhash (symbol-function ',name) *%function-types*))
       (defun ,name ,ll
	 ,docstring
	 ,@(loop for var in ll for type in types collect `(check-type ,var ,type))
	 ,@body)
       (setf (gethash (symbol-function ',name) *%function-types*)
	     ',types)
       ',name)))

(defun check-function (function &rest types)
  "Checks that a given function (defined with defun*) is of the correct type"
  (let ((ftypes (gethash function *%function-types*)))
    (when (or (/= (length ftypes) (length types))
              (notevery #'subtypep types ftypes))
      (error "Function ~a is typed ~a, expected ~a" function ftypes types))))

(defun unregister-function (function)
  (remhash function *%function-types*))
1) check-function is safe to use on untyped functions.
2) check-function can be trivially improved to reject all untyped functions
3) The lambda list for the function defun* creates is helpful, though still limited.
4) It automatically checks to make sure the function was given the right types.

I'm thinking of making a simple prototype-based object system based on the above technique.

Re: Please help my head get around 'deftype'

Posted: Wed Oct 22, 2008 2:30 pm
by lnostdal
about body, declarations and doc-strings .. Alexandria has a parse-body which might be useful .. it can be used like, say, this:

Code: Select all

(defmacro mk-on-cnt-add-fn ((new-children-sym container-sym &key
                                              (on-cnt-add-fn-sym 'on-cnt-add-fn on-cnt-add-fn-sym-supplied-p)
                                              once-only-p)
                            &body body)
  (multiple-value-bind (body declarations) (parse-body body)
    (unless on-cnt-add-fn-sym-supplied-p
      (push `(declare (ignorable ,on-cnt-add-fn-sym)) declarations))
    `(lambda (,new-children-sym ,container-sym ,on-cnt-add-fn-sym)
       ,@declarations
       (when ,once-only-p (remove-cb ,container-sym :cnt-add ,on-cnt-add-fn-sym))
       ,@body)))
..parse-body actually returns 3 values .. the 3rd one being the doc-string, but i don't use this here

Re: Please help my head get around 'deftype'

Posted: Wed Nov 26, 2008 3:26 am
by Szymon
tlareywi wrote: [...] 2. A way to define a function signature type. For instance, a type that represents the class of all functions that take two number arguments. [...]

Code: Select all

(deftype functions-that-take-two-number-arguments () (quote (function (number number) t)))
examples:

Code: Select all

CL-USER> (deftype functions-that-take-two-arguments () (quote (function (* *) t)))
FUNCTIONS-THAT-TAKE-TWO-ARGUMENTS

CL-USER> (declaim (ftype functions-that-take-two-arguments test-2 test-3))
; No value

CL-USER> (defun test-2 (a b) (values a b))
TEST-2

CL-USER> (defun test-3 (a b c) (values a b c))
; in: LAMBDA NIL
;     (SB-INT:NAMED-LAMBDA TEST-3 (A B C) (BLOCK TEST-3 (VALUES A B C)))
; ==>
;   #'(SB-INT:NAMED-LAMBDA TEST-3 (A B C) (BLOCK TEST-3 (VALUES A B C)))
; 
; caught STYLE-WARNING:
;   The definition has three args, but the proclamation has two.
; 
; compilation unit finished
;   caught 1 STYLE-WARNING condition
TEST-3
new type:

Code: Select all

CL-USER> (deftype fun-args (&rest args)
           `(function ,(if (and (integerp (car args)) (endp (cdr args)))
                           (make-list (car args) :initial-element (quote *))
                           args)
                      t))
FUN-ARGS
first example -- declaim function(s) with fixed number of arguments:

Code: Select all

CL-USER> (declaim (ftype (fun-args 2) test-fun-2-args test-fun-3-args))
; No value

CL-USER> (defun test-fun-2-args (a b) (values a b))
TEST-FUN-2-ARGS

CL-USER> (defun test-fun-3-args (a b c) (values a b c))
; [...]
; caught STYLE-WARNING:
;   The definition has three args, but the proclamation has two.
; [...]
TEST-FUN-3-ARGS
second example -- declaim function with fixed number of args and specified (input) types --
1: number
2: symbol
3: array of element type integer which contains 3 elements

Code: Select all

CL-USER> (declaim (ftype (fun-args number symbol (array integer (3))) fun-test))
; No value

CL-USER> (defun fun-test (a b c) (values a b c))
FUN-TEST

CL-USER> (fun-test 3.14 'foo #(1 2 3))
3.14
FOO
#(1 2 3)

CL-USER> (ignore-errors (fun-test 0 0 0))
NIL
#<TYPE-ERROR {AC8F3C1}>

CL-USER> (ignore-errors (fun-test 3.14 'foo #(1 2)))
NIL
#<TYPE-ERROR {AD85601}>

Re: Please help my head get around 'deftype'

Posted: Wed Nov 26, 2008 3:30 am
by Szymon
...