From: Pillsy
Subject: A better syntax for type declaration?
Date: 
Message-ID: <1164929783.128882.53840@79g2000cws.googlegroups.com>
One of my less favorite things about Common Lisp is the way variable
types are declared. As it stands, it is awkward and verbose, because
you often have to type stuff like

(let ((foo 3) (bar 1.7d0) baz)
  (declare (type fixnum foo)
	   (type double-float bar))
  ;; Do stuff here.
  )

This is a bunch of extra typing, with "declare", a bunch of "type"s, a
bunch of parens, and a bunch of repeated variable names. It's also,
IMO, hard to read, since the type information is placed relatively far
away from the introduction of the variables.

Pretty much every language I can think of where types can be declared
has, IMO, a better way of doing this.

Ideally, I think I'd like something like this:

(let ((foo 3 fixnum) (bar 1.7d0 double-float) (baz))
  ;; Do stuff here.
  )

This keeps variables together with their type information and is
gratifyingly concise. A similar syntax, with the initial values
omitted, could work nicely:

(defun foo ((bar fixnum) (baz double-float))
  ;; Do stuff here.
  )

The "let" style declarations would have to make a comeback for
&optional and &key parameters with default values, which strikes me as
a minor wart at worst. Now, since CL provides defmacro so I can write
my own syntax, I'm not just whining---I plan on implementing some stuff
that works like this unless:

    (a) someone has already done this, or something very much like it.
    (b) It's actually a terrible, awful, bad idea for reasons that
simply aren't obvious to me.

So, do (a) and/or (b) hold?

TIA,
Pillsy

From: Raffael Cavallaro
Subject: Re: A better syntax for type declaration?
Date: 
Message-ID: <2006113019035375249-raffaelcavallaro@pasdespamsilvousplaitmaccom>
On 2006-11-30 18:36:23 -0500, "Pillsy" <·········@gmail.com> said:

> (defun foo ((bar fixnum) (baz double-float))
>   ;; Do stuff here.
>   )

Oh, you want dylan.
From: Thomas A. Russ
Subject: Re: A better syntax for type declaration?
Date: 
Message-ID: <ymipsb39sw1.fsf@sevak.isi.edu>
Raffael Cavallaro <················@pas-d'espam-s'il-vous-plait-mac.com> writes:

> On 2006-11-30 18:36:23 -0500, "Pillsy" <·········@gmail.com> said:
> 
> > (defun foo ((bar fixnum) (baz double-float))
> >   ;; Do stuff here.
> >   )
> 
> Oh, you want dylan.

Or Stella.


-- 
Thomas A. Russ,  USC/Information Sciences Institute
From: Kaz Kylheku
Subject: Here it is, Pillsy!
Date: 
Message-ID: <1164961367.170445.178290@n67g2000cwd.googlegroups.com>
I hacked this up this evening. It contains the longest LOOP I have ever
seen, never mind written myself, and also an instance of ,@,@
distributive splicing.

;;;
;;; DEFINE-DECL-MACRO
;;;
;;; A Common Lisp macro which provides a concise, easy notation for
writing
;;; macros which insert declarations into binding constructs.
;;;
;;; Kaz Kylheku <········@gmail.com>
;;; November 30, 2006
;;;

#|

;;; Best explained with an example!

;;; Write a macro called DECLARATIVE-LET which expands into LET.
;;; The &VARLIST symbol tells DEFINE-DECL-MACRO where in the LET
;;; form is the list of variable bindings located. The &BODY
;;; symbol indicates where the body of declarations and forms is.
;;; That's it!

(define-decl-macro declarative-let
  (let &varlist &body))

;;; Now use the macro

(declarative-let ((x integer 3) (y string) z)
 (setf y "abc")
 (push x z))

;;; What is the expansion?

(macroexpand '(declarative-let ((x integer 3) (y string) z)
                (setf y "abc")
                (push x z)))

-->  (LET (X Y Z)
       (DECLARE (TYPE INTEGER X) (TYPE STRING Y) NIL)
       (SETF Y "abc")
       (PUSH X Z))

;;; Aha!!!

;;;
;;; Let's illustrate deeper nesting by wrapping DESTRUCTURING-BIND.
;;; Without destructuring lambda list support in our macro, we can't do
;;; this in a general way for all possible instances of
;;; DESTRUCTURING-BIND, but we can add declarations to particular kinds
of
;;; instances of DESTRUCTURING-BIND.
;;;

;;;
;;; Add declarations to forms patterned after:
;;;
;;;  (destructuring-bind ((a b c ...) (i j k ...)) ...)
;;;

(define-decl-macro decl-double-destructure
  (destructuring-bind (&varlist &varlist) &body))

(macroexpand-1 '(decl-double-destructure (((a fixnum 3) (b fixnum 4))
					  ((c string) (d string)))
					 some-list))

--> (DESTRUCTURING-BIND ((A B) (C D))
			 (DECLARE (TYPE FIXNUM A) (TYPE FIXNUM B)
				  (TYPE STRING C) (TYPE STRING D))
			  SOME-LIST)

;;;
;;; Limitations:
;;;
;;; The only keywords that are implemented are:
;;; - &var, which indicates a simple variable that can be
;;    SYM (SYM TYPE) or (SYM TYPE INITVAL); and
;;; - &varlist, which indicates a list of these.
;;;
;;; The code should easily extend to support ordinary function lambda
;;; lists and even macro and destrcuctruing lambda lists.  For each new
;;; kind of labmda list you have to introduce a var spec variant
;;; (identified by a keyword like :simple-var, etc).  You have to write
;;; the logic which generates the code that pulls out the list of
;;; variables from a lambda list, and the logic which generates the
;;; declaration elements from such a list.
;;;

|#

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defun simple-var-extract-sym-code (sym)
    `(if (consp ,sym) (first ,sym) ,sym)))

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defun var-init-list-extract-sym-code (sym)
    `(loop for item in ,sym
	   collecting (if (consp item) (first item) item))))

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defun parse-decl-syntax (arguments)
    (loop for arg in arguments
	  for sym = (gensym)
	  with body-sym = 'missing-&body-spec
	  with recursed-target-args
	  with recursed-replacement-form
	  with recursed-var-list
	  with recursed-body-sym
	  if (eq arg '&var)
	    collect sym into target-macro-args and
	    collect `(list ,(simple-var-extract-sym-code sym))
	      into replacement-form and
	    collect `(:simple-var ,sym) into var-specs
	  else if (eq arg '&varlist)
	    collect `(&rest ,sym) into target-macro-args and
	    collect `(list ,(var-init-list-extract-sym-code sym))
	      into replacement-form and
	    collect `(:var-inits ,sym) into var-specs
	  else if (eq arg '&rest)
	    collect '&rest into target-macro-args and
	    collect sym into target-macro-args and
	    collect sym into replacement-form
	  else if (eq arg '&body)
	    collect '&body into target-macro-args and
	    collect sym into target-macro-args and
	    do (setf body-sym sym)
	  else if (consp arg)
	    do (multiple-value-setq (recursed-target-args
				     recursed-replacement-form
				     recursed-var-list recursed-body-sym)
		 (parse-decl-syntax arg)) and
	    collect recursed-target-args into target-macro-args and
	    collect `(list (append ,@recursed-replacement-form))
	      into replacement-form and
	    append recursed-var-list into var-specs and
	    do (setf body-sym recursed-body-sym)
	  else
	    collect arg into target-macro-args and
	    collect `(list ',arg) into replacement-form
	  finally
	    (return (values target-macro-args replacement-form
			    var-specs body-sym)))))

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defun var-specs-to-decls (var-specs)
    (loop for (spec-type sym) in var-specs
	  collecting (case spec-type
		       (:simple-var
			 `(if (consp ,sym)
			    `((type ,(second ,sym) ,(first ,sym)))))
		       (:var-inits
			 `(loop for var-init in ,sym
				collecting
				(if (consp var-init)
				   `(type ,(second var-init)
					  ,(first var-init)))))))))


(defmacro define-decl-macro (macro-name pattern-form)
  (destructuring-bind (form-name &rest source-decl-args) pattern-form
    (multiple-value-bind (target-macro-args replacement-form
		          var-specs body-sym)
                         (parse-decl-syntax source-decl-args)
      `(defmacro ,macro-name ,target-macro-args
	 (append (list ',form-name) ,@replacement-form
	       (list `(declare ,@,@(var-specs-to-decls var-specs)))
	       ,body-sym)))))
From: Kaz Kylheku
Subject: Re: Here it is, Pillsy!
Date: 
Message-ID: <1164966564.356899.161310@l12g2000cwl.googlegroups.com>
Kaz Kylheku wrote:
> I hacked this up this evening.

A few fixes and improvements, plus more documentation. The &param
keyword is implemented.

;;;
;;; DEFINE-DECL-MACRO
;;;
;;; A Common Lisp macro which provides a concise, easy notation for
;;; writing macros which insert declarations into binding constructs.
;;;
;;; Kaz Kylheku <········@gmail.com>
;;; November 30, 2006
;;;

#|

;;; Best explained with an example!

;;; Write a macro called DECLARATIVE-LET which expands into LET.
;;; The &VARLIST symbol tells DEFINE-DECL-MACRO where in the LET
;;; form is the list of variable bindings located. The &BODY
;;; symbol indicates where the body of declarations and forms is.
;;; That's it!

(define-decl-macro declarative-let
  (let &varlist &body))

;;; Now use the macro

(declarative-let ((x integer 3) (y string) z)
 (setf y "abc")
 (push x z))

;;; What is the expansion?

(macroexpand '(declarative-let ((x integer 3) (y string) z)
                (setf y "abc")
                (push x z)))

-->  (LET (X Y Z)
       (DECLARE (TYPE INTEGER X) (TYPE STRING Y))
       (SETF Y "abc")
       (PUSH X Z))

;;; Aha!!!

;;;
;;; Let's illustrate deeper nesting by wrapping DESTRUCTURING-BIND.
;;; Without destructuring lambda list support in our macro, we can't do
;;; this in a general way for all possible instances of
;;; DESTRUCTURING-BIND, but we can add declarations to particular kinds
;;; of instances of DESTRUCTURING-BIND.
;;;

;;;
;;; Add declarations to forms patterned after:
;;;
;;;  (destructuring-bind ((a b c ...) (i j k ...)) ...)
;;;

(define-decl-macro decl-double-destructure
  (destructuring-bind (&varlist &varlist) &param &body))

(macroexpand-1 '(decl-double-destructure (((a fixnum 3) (b fixnum 4))
                                          ((c string) (d string)))
                                         some-list
                                         (form1)
                                         (form2)))

--> (DESTRUCTURING-BIND ((A B) (C D))
                         (DECLARE (TYPE FIXNUM A) (TYPE FIXNUM B)
                                  (TYPE STRING C) (TYPE STRING D))
                          SOME-LIST
                          (FORM1) (FORM2))

;;;
;;; Limitations:
;;;
;;; The only keywords that are implemented are:
;;; - &param, which indicates a meta-variable anywhere in the
;;;   binding construct which is not one of the binding variables.
;;;   For instance, a filename in a WITH-OPEN-FILE, the object
;;;   expression in WITH-SLOTS, or the list in DESTRUCTURING-BIND.
;;;   Code is generated in the wrapping macro to capture the
;;;   parameter as an argument and pass it to the wrapped macro.
;;; - &rest, which is a sequence of &param-type parameters.
;;;   This can be used to capture the whole lot of them at once
;;;   like the filename and OPEN keyword arguments in WITH-OPEN-FILE.
;;; - &var, which indicates a simple variable that can be
;;;   SYM (SYM TYPE) or (SYM TYPE INITVAL); and
;;; - &varlist, which indicates a list of these.
;;;
;;; There is serious fudging with respect to the placement of the
;;; &body; although the &body can appear anywhere in the pattern
;;; form, and should be extracted properly from that place, it is not
;;; put into the corresponding place in the target form, but rather
;;; moved to the end.
;;;
;;; The code should easily extend to support ordinary function lambda
;;; lists and even macro and destructuring lambda lists.  For each new
;;; kind of lambda list you have to introduce a var spec variant
;;; (identified by a keyword like :simple-var, etc).  You have to write
;;; the logic which generates the code that pulls out the list of
;;; variables from a lambda list, and the logic which generates the
;;; declaration elements from such a list.
;;;

|#

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defun simple-var-extract-sym-code (sym)
    `(if (consp ,sym) (first ,sym) ,sym)))

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defun var-init-list-extract-sym-code (sym)
    `(loop for item in ,sym
           collecting (if (consp item) (first item) item))))

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defun parse-decl-syntax (arguments)
    (loop for arg in arguments
          for sym = (gensym)
          with body-sym = 'missing-&body-spec
          with recursed-target-args
          with recursed-replacement-form
          with recursed-var-list
          with recursed-body-sym
          if (eq arg '&var)
            collect sym into target-macro-args and
            collect `(list ,(simple-var-extract-sym-code sym))
              into replacement-form and
            collect `(:simple-var ,sym) into var-specs
          else if (eq arg '&varlist)
            collect `(&rest ,sym) into target-macro-args and
            collect `(list ,(var-init-list-extract-sym-code sym))
              into replacement-form and
            collect `(:var-inits ,sym) into var-specs
          else if (eq arg '&rest)
            collect '&rest into target-macro-args and
            collect sym into target-macro-args and
            collect sym into replacement-form
          else if (eq arg '&param)
            collect sym into target-macro-args and
            collect `(list ,sym) into replacement-form
          else if (eq arg '&body)
            collect '&body into target-macro-args and
            collect sym into target-macro-args and
            do (setf body-sym sym)
          else if (consp arg)
            do (multiple-value-setq (recursed-target-args
                                     recursed-replacement-form
                                     recursed-var-list
                                     recursed-body-sym)
                 (parse-decl-syntax arg)) and
            collect recursed-target-args into target-macro-args and
            collect `(list (append ,@recursed-replacement-form))
              into replacement-form and
            append recursed-var-list into var-specs and
            do (setf body-sym recursed-body-sym)
          else
            collect arg into target-macro-args and
            collect `(list ',arg) into replacement-form
          finally
            (return (values target-macro-args replacement-form
                            var-specs body-sym)))))

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defun var-specs-to-decls (var-specs)
    (loop for (spec-type sym) in var-specs
          collecting (case spec-type
                       (:simple-var
                         `(if (consp ,sym)
                            `((type ,(second ,sym) ,(first ,sym)))))
                       (:var-inits
                         `(loop for var-init in ,sym
                                appending
                                (if (consp var-init)
                                   `((type ,(second var-init)
                                          ,(first var-init))))))))))


(defmacro define-decl-macro (macro-name pattern-form)
  (destructuring-bind (form-name &rest source-decl-args) pattern-form
    (multiple-value-bind (target-macro-args replacement-form
                          var-specs body-sym)
                         (parse-decl-syntax source-decl-args)
      `(defmacro ,macro-name ,target-macro-args
         `(,',form-name ,@,@replacement-form
            (declare ,@,@(var-specs-to-decls var-specs))
            ,@,body-sym)))))
From: Kaz Kylheku
Subject: Re: Here it is, Pillsy!
Date: 
Message-ID: <1164998509.696586.177460@16g2000cwy.googlegroups.com>
I removed the &body placement limitation with an easy fix. The body is
inserted in the place where &body occurs in the pattern, with
declarations of all variables gathered from the form wrapped around it.

Now what is left is to write support for &lambdalist and
&destructuring-lambda-list and &macro-lambda-list keywords which would
indicate that such lists occur in the given place in the original form.
Then the extra declaration bit would be pulled out over all of the
variables in these lists, at any level of nesting.

;;;
;;; DEFINE-DECL-MACRO
;;;
;;; A Common Lisp macro which provides a concise, easy notation for
;;; writing macros which insert declarations into binding constructs.
;;;
;;; Written by Kaz Kylheku <········@gmail.com>
;;; Version 1
;;; December 1, 2006
;;;

#|

;;; Best explained with an example!

;;; Write a macro called DECLARATIVE-LET which expands into LET.
;;; The &VARLIST symbol tells DEFINE-DECL-MACRO where in the LET
;;; form is the list of variable bindings located. The &BODY
;;; symbol indicates where the body of declarations and forms is.
;;; That's it!

(define-decl-macro declarative-let
  (let &varlist &body))

;;; Now use the macro

(declarative-let ((x integer 3) (y string) z)
 (setf y "abc")
 (push x z))

;;; What is the expansion?

(macroexpand '(declarative-let ((x integer 3) (y string) z)
                (setf y "abc")
                (push x z)))

-->  (LET (X Y Z)
       (DECLARE (TYPE INTEGER X) (TYPE STRING Y))
       (SETF Y "abc")
       (PUSH X Z))

;;; Aha!!!

;;;
;;; Let's illustrate deeper nesting by wrapping DESTRUCTURING-BIND.
;;; Without destructuring lambda list support in our macro, we can't do
;;; this in a general way for all possible instances of
;;; DESTRUCTURING-BIND, but we can add declarations to particular kinds
;;; of instances of DESTRUCTURING-BIND.
;;;

;;;
;;; Add declarations to forms patterned after:
;;;
;;;  (destructuring-bind ((a b c ...) (i j k ...)) ...)
;;;

(define-decl-macro decl-double-destructure
  (destructuring-bind (&varlist &varlist) &param &body))

(macroexpand-1 '(decl-double-destructure (((a fixnum 3) (b fixnum 4))
                                          ((c string) (d string)))
                                         some-list
                                         (form1)
                                         (form2)))

--> (DESTRUCTURING-BIND ((A B) (C D))
                         (DECLARE (TYPE FIXNUM A) (TYPE FIXNUM B)
                                  (TYPE STRING C) (TYPE STRING D))
                          SOME-LIST
                          (FORM1) (FORM2))

;;;
;;; Limitations:
;;;
;;; The only keywords that are implemented are:
;;;
;;; - &PARAM, which indicates a meta-variable anywhere in the
;;;   binding construct which is not one of the binding variables.
;;;   For instance, a filename in a WITH-OPEN-FILE, the object
;;;   expression in WITH-SLOTS, or the list in DESTRUCTURING-BIND.
;;;   Code is generated in the wrapping macro to capture the
;;;   parameter as an argument and pass it to the wrapped macro.
;;;
;;; - &REST, which is a sequence of &param-type parameters.
;;;   This can be used to capture the whole lot of them at once
;;;   like the filename and OPEN keyword arguments in WITH-OPEN-FILE.
;;;
;;; - &VAR, which indicates a simple variable that can be
;;;   SYM (SYM TYPE) or (SYM TYPE INITVAL); and
;;;
;;; - &VARLIST, which indicates a list of these.
;;;
;;; - &BODY, which indicates where in the form the body occurs.
;;;   This behaves a lot like &REST except that the declarations
;;;   are wrapped around its expansion. Specifying the &BODY
;;;   more than once has unspecified consquences. Only one body
;;;   will have declarations put around it, for all of the variables
;;;   identified in the form.
;;;
;;;
;;; There is serious fudging with respect to the placement of the
;;; &body; although the &body can appear anywhere in the pattern
;;; form, and should be extracted properly from that place, it is not
;;; put into the corresponding place in the target form, but rather
;;; moved to the end.
;;;
;;; The code should easily extend to support ordinary function lambda
;;; lists and even macro and destructuring lambda lists.  For each new
;;; kind of lambda list you have to introduce a var spec variant
;;; (identified by a keyword like :simple-var, etc).  You have to write
;;; the logic which generates the code that pulls out the list of
;;; variables from a lambda list, and the logic which generates the
;;; declaration elements from such a list.
;;;

|#

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defun simple-var-extract-sym-code (sym)
    `(if (consp ,sym) (first ,sym) ,sym)))

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defun var-init-list-extract-sym-code (sym)
    `(loop for item in ,sym
           collecting (if (consp item) (first item) item))))

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defun parse-decl-syntax (arguments)
    (loop for arg in arguments
          for sym = (gensym)
          with body-sym = 'missing-&body-spec
          with recursed-target-args
          with recursed-replacement-form
          with recursed-var-list
          with recursed-body-sym
          if (eq arg '&var)
            collect sym into target-macro-args and
            collect `(list ,(simple-var-extract-sym-code sym))
              into replacement-form and
            collect `(:simple-var ,sym) into var-specs
          else if (eq arg '&varlist)
            collect `(&rest ,sym) into target-macro-args and
            collect `(list ,(var-init-list-extract-sym-code sym))
              into replacement-form and
            collect `(:var-inits ,sym) into var-specs
          else if (eq arg '&rest)
            collect '&rest into target-macro-args and
            collect sym into target-macro-args and
            collect sym into replacement-form
          else if (eq arg '&param)
            collect sym into target-macro-args and
            collect `(list ,sym) into replacement-form
          else if (eq arg '&body)
            collect '&body into target-macro-args and
            collect sym into target-macro-args and
            collect `(list ,sym) into replacement-form and
            do (setf body-sym sym)
          else if (consp arg)
            do (multiple-value-setq (recursed-target-args
                                     recursed-replacement-form
                                     recursed-var-list
                                     recursed-body-sym)
                 (parse-decl-syntax arg)) and
            collect recursed-target-args into target-macro-args and
            collect `(list (append ,@recursed-replacement-form))
              into replacement-form and
            append recursed-var-list into var-specs and
            do (setf body-sym recursed-body-sym)
          else
            collect arg into target-macro-args and
            collect `(list ',arg) into replacement-form
          finally
            (return (values target-macro-args replacement-form
                            var-specs body-sym)))))

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defun var-specs-to-decls (var-specs)
    (loop for (spec-type sym) in var-specs
          collecting (case spec-type
                       (:simple-var
                         `(if (consp ,sym)
                            `((type ,(second ,sym) ,(first ,sym)))))
                       (:var-inits
                         `(loop for var-init in ,sym
                                appending
                                (if (consp var-init)
                                   `((type ,(second var-init)
                                          ,(first var-init))))))))))

(defmacro define-decl-macro (macro-name pattern-form)
  (destructuring-bind (form-name &rest source-decl-args) pattern-form
    (multiple-value-bind (target-macro-args replacement-form
                          var-specs body-sym)
                         (parse-decl-syntax source-decl-args)
      `(defmacro ,macro-name ,target-macro-args
         (let* ((declarations ,@(var-specs-to-decls var-specs))
                (,body-sym `((declare ,@declarations) ,@,body-sym)))
           `(,',form-name ,@,@replacement-form))))))
From: Kaz Kylheku
Subject: Re: Here it is, Pillsy!
Date: 
Message-ID: <1165028711.380372.55840@j72g2000cwa.googlegroups.com>
Argh, silly &body mistake. Also, suppress emission of (DECLARE) when
there are no declarations.

--- define-decl-macro.lisp.ORIG 2006-12-01 18:58:58.000000000 -0800
+++ define-decl-macro.lisp      2006-12-01 18:57:25.000000000 -0800
@@ -5,7 +5,7 @@
 ;;; writing macros which insert declarations into binding constructs.
 ;;;
 ;;; Written by Kaz Kylheku <········@gmail.com>
-;;; Version 2
+;;; Version 3
 ;;; December 1, 2006
 ;;;

@@ -147,7 +147,7 @@ (define-decl-macro decl-double-destructu
           else if (eq arg '&body)
             collect '&body into target-macro-args and
             collect sym into target-macro-args and
-            collect `(list ,sym) into replacement-form and
+            collect sym into replacement-form and
             do (setf body-sym sym)
           else if (consp arg)
             do (multiple-value-setq (recursed-target-args
@@ -188,5 +188,7 @@ (defmacro define-decl-macro (macro-name
                          (parse-decl-syntax source-decl-args)
       `(defmacro ,macro-name ,target-macro-args
          (let* ((declarations ,@(var-specs-to-decls var-specs))
-                (,body-sym `((declare ,@declarations) ,@,body-sym)))
+                (,body-sym (if declarations
+                             `((declare ,@declarations) ,@,body-sym)
+                             ,body-sym)))
            `(,',form-name ,@,@replacement-form))))))
From: Kaz Kylheku
Subject: Re: Here it is, Pillsy!
Date: 
Message-ID: <1165033393.097511.8610@l12g2000cwl.googlegroups.com>
Version 4

- Bugfix: propagate variable initializers to the target form.
- Bugfix: do not generate (declare (type nil name)) for names
  specified as (name); treat them just like name.
- Feature: implement decl-macrolet.

;;;
;;; DEFINE-DECL-MACRO
;;;
;;; A Common Lisp macro which provides a concise, easy notation for
;;; writing macros which insert declarations into binding constructs.
;;;
;;; Written by Kaz Kylheku <········@gmail.com>
;;; Version 4
;;; December 1, 2006
;;;

#|

;;; Best explained with an example!

;;; Write a macro called DECLARATIVE-LET which expands into LET.
;;; The &VARLIST symbol tells DEFINE-DECL-MACRO where in the LET
;;; form is the list of variable bindings located. The &BODY
;;; symbol indicates where the body of declarations and forms is.
;;; That's it!

(define-decl-macro declarative-let
  (let &varlist &body))

;;; Now use the macro

(declarative-let ((x integer 3) (y string) z)
 (setf y "abc")
 (push x z))

;;; What is the expansion?

(macroexpand '(declarative-let ((x integer 3) (y string) z)
                (setf y "abc")
                (push x z)))

-->  (LET (X Y Z)
       (DECLARE (TYPE INTEGER X) (TYPE STRING Y))
       (SETF Y "abc")
       (PUSH X Z))

;;; Aha!!!

;;;
;;; Let's illustrate deeper nesting by wrapping DESTRUCTURING-BIND.
;;; Without destructuring lambda list support in our macro, we can't do
;;; this in a general way for all possible instances of
;;; DESTRUCTURING-BIND, but we can add declarations to particular kinds
;;; of instances of DESTRUCTURING-BIND.
;;;

;;;
;;; Add declarations to forms patterned after:
;;;
;;;  (destructuring-bind ((a b c ...) (i j k ...)) ...)
;;;

(define-decl-macro decl-double-destructure
  (destructuring-bind (&varlist &varlist) &param &body))

(macroexpand-1 '(decl-double-destructure (((a fixnum 3) (b fixnum 4))
                                          ((c string) (d string)))
                                         some-list
                                         (form1)
                                         (form2)))

--> (DESTRUCTURING-BIND ((A B) (C D))
                         (DECLARE (TYPE FIXNUM A) (TYPE FIXNUM B)
                                  (TYPE STRING C) (TYPE STRING D))
                          SOME-LIST
                          (FORM1) (FORM2))

;;;
;;; Limitations:
;;;
;;; The only keywords that are implemented are:
;;;
;;; - &PARAM, which indicates a meta-variable anywhere in the
;;;   binding construct which is not one of the binding variables.
;;;   For instance, a filename in a WITH-OPEN-FILE, the object
;;;   expression in WITH-SLOTS, or the list in DESTRUCTURING-BIND.
;;;   Code is generated in the wrapping macro to capture the
;;;   parameter as an argument and pass it to the wrapped macro.
;;;
;;; - &REST, which is a sequence of &param-type parameters.
;;;   This can be used to capture the whole lot of them at once
;;;   like the filename and OPEN keyword arguments in WITH-OPEN-FILE.
;;;
;;; - &VAR, which indicates a simple variable that can be
;;;   SYM (SYM TYPE) or (SYM TYPE INITVAL); and
;;;
;;; - &VARLIST, which indicates a list of these.
;;;
;;; - &BODY, which indicates where in the form the body occurs.
;;;   This behaves a lot like &REST except that the declarations
;;;   are wrapped around its expansion. Specifying the &BODY
;;;   more than once has unspecified consquences. Only one body
;;;   will have declarations put around it, for all of the variables
;;;   identified in the form.
;;;
;;; The code should easily extend to support ordinary function lambda
;;; lists and even macro and destructuring lambda lists.  For each new
;;; kind of lambda list you have to introduce a var spec variant
;;; (identified by a keyword like :simple-var, etc).  You have to write
;;; the logic which generates the code that pulls out the list of
;;; variables from a lambda list, and the logic which generates the
;;; declaration elements from such a list.
;;;

|#

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defun simple-var-extract-sym-code (var-form)
    `(cond
       ((atom ,var-form) ,var-form)
       ((rest (rest ,var-form)) `(,(first ,var-form) ,(third
,var-form)))
       (t (first ,var-form)))))

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defun var-init-list-extract-sym-code (var-form-list)
    `(loop for var-form in ,var-form-list
           collecting (cond
                        ((atom var-form) var-form)
                        ((rest (rest var-form))
                         `(,(first var-form) ,(third var-form)))
                        (t (first var-form))))))

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defun parse-decl-syntax (arguments)
    (loop for arg in arguments
          for sym = (gensym)
          with body-sym = 'missing-&body-spec
          with recursed-target-args
          with recursed-replacement-form
          with recursed-var-list
          with recursed-body-sym
          if (eq arg '&var)
            collect sym into target-macro-args and
            collect `(list ,(simple-var-extract-sym-code sym))
              into replacement-form and
            collect `(:simple-var ,sym) into var-specs
          else if (eq arg '&varlist)
            collect `(&rest ,sym) into target-macro-args and
            collect `(list ,(var-init-list-extract-sym-code sym))
              into replacement-form and
            collect `(:var-inits ,sym) into var-specs
          else if (eq arg '&rest)
            collect '&rest into target-macro-args and
            collect sym into target-macro-args and
            collect sym into replacement-form
          else if (eq arg '&param)
            collect sym into target-macro-args and
            collect `(list ,sym) into replacement-form
          else if (eq arg '&body)
            collect '&body into target-macro-args and
            collect sym into target-macro-args and
            collect sym into replacement-form and
            do (setf body-sym sym)
          else if (consp arg)
            do (multiple-value-setq (recursed-target-args
                                     recursed-replacement-form
                                     recursed-var-list
                                     recursed-body-sym)
                 (parse-decl-syntax arg)) and
            collect recursed-target-args into target-macro-args and
            collect `(list (append ,@recursed-replacement-form))
              into replacement-form and
            append recursed-var-list into var-specs and
            do (setf body-sym recursed-body-sym)
          else
            collect arg into target-macro-args and
            collect `(list ',arg) into replacement-form
          finally
            (return (values target-macro-args replacement-form
                            var-specs body-sym)))))

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defun var-specs-to-decls (var-specs)
    (loop for (spec-type sym) in var-specs
          collecting (case spec-type
                       (:simple-var
                         `(if (and (consp ,sym) (rest ,sym))
                            `((type ,(second ,sym) ,(first ,sym)))))
                       (:var-inits
                         `(loop for var-init in ,sym
                                appending
                                (if (and (consp var-init) (rest
var-init))
                                   `((type ,(second var-init)
                                          ,(first var-init))))))))))

(defmacro define-decl-macro (macro-name pattern-form)
  (destructuring-bind (form-name &rest source-decl-args) pattern-form
    (multiple-value-bind (target-macro-args replacement-form
                          var-specs body-sym)
                         (parse-decl-syntax source-decl-args)
      `(defmacro ,macro-name ,target-macro-args
         (let* ((declarations ,@(var-specs-to-decls var-specs))
                (,body-sym (if declarations
                             `((declare ,@declarations) ,@,body-sym)
                             ,body-sym)))
           `(,',form-name ,@,@replacement-form))))))

(defmacro decl-macrolet ((&rest name-pattern-pairs) &body body)
  (loop for (name (form-name . decl-args)) in name-pattern-pairs
        collecting name into macrolet-names
        collecting
          (multiple-value-bind (target-macro-args replacement-form
                                var-specs body-sym)
                                (parse-decl-syntax decl-args)
            `(,target-macro-args
               (let* ((declarations ,@(var-specs-to-decls var-specs))
                      (,body-sym (if declarations
                                   `((declare ,@declarations)
,@,body-sym)
                                   ,body-sym)))
                 `(,',form-name ,@,@replacement-form))))
        into macrolet-bodies
        finally
          (return `(macrolet (,@(mapcar #'cons macrolet-names
macrolet-bodies))
                     ,@body))))
From: Pascal Bourguignon
Subject: Re: A better syntax for type declaration?
Date: 
Message-ID: <87odqo5vdw.fsf@thalassa.informatimago.com>
"Pillsy" <·········@gmail.com> writes:
> Ideally, I think I'd like something like this:
>
> (let ((foo 3 fixnum) (bar 1.7d0 double-float) (baz))
>   ;; Do stuff here.
>   )
>
> This keeps variables together with their type information and is
> gratifyingly concise. 

So, what's the problem?


> A similar syntax, with the initial values
> omitted, could work nicely:
>
> (defun foo ((bar fixnum) (baz double-float))
>   ;; Do stuff here.
>   )

Again, what's the problem?


> The "let" style declarations would have to make a comeback for
> &optional and &key parameters with default values, which strikes me as
> a minor wart at worst. 

Not really.


> Now, since CL provides defmacro so I can write
> my own syntax, I'm not just whining---I plan on implementing some stuff
> that works like this unless:
>
>     (a) someone has already done this, or something very much like it.
>     (b) It's actually a terrible, awful, bad idea for reasons that
> simply aren't obvious to me.
>
> So, do (a) and/or (b) hold?

I don't know for (a), but (b) doesn't hold at all.  Go ahead!

 (defunt foo ((bar fixnum) (baz double-float)
              &optional (opt 0 opt-p fixnum)
              &key (key 0 keyp-p fixnum))  float
   "This function returns a float!"
   (lett ((foo 3 fixnum) (bar 1.7d0 double-float) (baz))
       ;; Do stuff here.
       1.0
      ))


-- 
__Pascal Bourguignon__                     http://www.informatimago.com/

"Specifications are for the weak and timid!"
From: verec
Subject: Re: A better syntax for type declaration?
Date: 
Message-ID: <456f8ae9$0$634$5a6aecb4@news.aaisp.net.uk>
On 2006-11-30 23:36:23 +0000, "Pillsy" <·········@gmail.com> said:

> One of my less favorite things about Common Lisp is the way variable
> types are declared. As it stands, it is awkward and verbose, because
> you often have to type stuff like
> 
> (let ((foo 3) (bar 1.7d0) baz)
>   (declare (type fixnum foo)
> 	   (type double-float bar))
>   ;; Do stuff here.
>   )
> 
> This is a bunch of extra typing, with "declare", a bunch of "type"s, a
> bunch of parens, and a bunch of repeated variable names. It's also,
> IMO, hard to read, since the type information is placed relatively far
> away from the introduction of the variables.
> 
> Pretty much every language I can think of where types can be declared
> has, IMO, a better way of doing this.
> 
> Ideally, I think I'd like something like this:
> 
> (let ((foo 3 fixnum) (bar 1.7d0 double-float) (baz))
>   ;; Do stuff here.
>   )
> 
> This keeps variables together with their type information and is
> gratifyingly concise. A similar syntax, with the initial values
> omitted, could work nicely:
> 
> (defun foo ((bar fixnum) (baz double-float))
>   ;; Do stuff here.
>   )
> 
> The "let" style declarations would have to make a comeback for
> &optional and &key parameters with default values, which strikes me as
> a minor wart at worst. Now, since CL provides defmacro so I can write
> my own syntax, I'm not just whining---I plan on implementing some stuff
> that works like this unless:
> 
>     (a) someone has already done this, or something very much like it.
>     (b) It's actually a terrible, awful, bad idea for reasons that
> simply aren't obvious to me.
> 
> So, do (a) and/or (b) hold?

Despite Pascal Bourguignon cold irony (?) I do see value
in the argument of clarity and brevity, though, as he points
out, (defunT ... and (letT ... would be really terrible.

But as I understand it, redefining (defun and (let is a big
no-no, yet that's what would be required to have them detect
and honor an _optional_ _last_ argument either recognized
as a type spec, or generating some error.

Maybe it could be possible to provide them inside some
:cl-typed package you would have to switch to when using
them, but that would allow to redefine them locally

The question of the return type is interesting, as are the
optional and rest parameters, but a first version that would
allow to optionally declare types on regular parameters or
local bindings would already be greatly useful.

I'd be happy to hear about your progress.
--
JFB
From: Pillsy
Subject: Re: A better syntax for type declaration?
Date: 
Message-ID: <1164939077.351418.139850@80g2000cwy.googlegroups.com>
verec wrote:
> On 2006-11-30 23:36:23 +0000, "Pillsy" <·········@gmail.com> said:

> > The "let" style declarations would have to make a comeback for
> > &optional and &key parameters with default values, which strikes me as
> > a minor wart at worst. Now, since CL provides defmacro so I can write
> > my own syntax, I'm not just whining---I plan on implementing some stuff
> > that works like this unless:
> >
> >     (a) someone has already done this, or something very much like it.
> >     (b) It's actually a terrible, awful, bad idea for reasons that
> > simply aren't obvious to me.
> >
> > So, do (a) and/or (b) hold?

> Despite Pascal Bourguignon cold irony (?) I do see value
> in the argument of clarity and brevity,

I couldn't tell whether he was being ironic either....

> though, as he points
> out, (defunT ... and (letT ... would be really terrible.

Anyway, after a bit of noodling and remembering how to use LOOP (I
usually use ITERATE), I got this for TLET (if FLET is OK, TLET must be
OK).

(defmacro tlet (binds &body body)
  (let ((bind-list
	 (mapcar #'(lambda (a)
		     (if (atom a)
			 a
			 (destructuring-bind (var val . type) a
			   (declare (ignore type))
			   `(,var ,val))))
		 binds))
	(types
	 (loop
	    :for (var val . type) :in (remove-if-not #'consp tbinds)
	    :collect `(type ,@type ,var))))
    `(let ,bind-list
       (declare ,@types)
       ,@body)))

It seems to work fine, at least according to desultory testing. I also
have a DEFTFUN (as names go, it blows, but I can't think of a vastly
better one at the moment) but it only works with bare-bones arglists at
the moment. It's very close to TLET, really.

> But as I understand it, redefining (defun and (let is a big
> no-no, yet that's what would be required to have them detect
> and honor an _optional_ _last_ argument either recognized
> as a type spec, or generating some error.

Yes. I was wondering whether

(shadow 'defun)
(defmacro defun ...)

and the like were seriously frowned upon.

> The question of the return type is interesting, as are the
> optional and rest parameters, but a first version that would
> allow to optionally declare types on regular parameters or
> local bindings would already be greatly useful.

Cool. Thanks for the input.

Pillsy
From: Pascal Costanza
Subject: Re: A better syntax for type declaration?
Date: 
Message-ID: <4ta2h4F12tb1kU1@mid.individual.net>
Pillsy wrote:
> One of my less favorite things about Common Lisp is the way variable
> types are declared. As it stands, it is awkward and verbose, because
> you often have to type stuff like
> 
> (let ((foo 3) (bar 1.7d0) baz)
>   (declare (type fixnum foo)
> 	   (type double-float bar))
>   ;; Do stuff here.
>   )
> 
[...]

>     (a) someone has already done this, or something very much like it.
>     (b) It's actually a terrible, awful, bad idea for reasons that
> simply aren't obvious to me.
> 
> So, do (a) and/or (b) hold?

(a) holds to a certain degree. IIRC, LinJ has a more compact way of 
declaring types for variables. Bigloo's approach also seems quite nice. 
There are probably other existing approaches for Lisp-like languages 
(Stella?).

(b) I don't know. A CL implementation is allowed to ignore type 
declarations. The declare forms make it easier to do so. Your suggested 
approach suggests that types are not optional in that sense (although 
that's just a fuzzy impression). I don't really care too much about 
types, so I don't have a strong opinion here.

(c) It should be relatively straightforward to implement what you 
suggest as a bunch of macros that expand into the CL-style declarations. 
I would be surprised if you wouldn't find something similar in some 
library or the other. No need to force such a change onto others...


Pascal

-- 
My website: http://p-cos.net
Common Lisp Document Repository: http://cdr.eurolisp.org
Closer to MOP & ContextL: http://common-lisp.net/project/closer/
From: Pillsy
Subject: Re: A better syntax for type declaration?
Date: 
Message-ID: <1164957620.040921.24400@l12g2000cwl.googlegroups.com>
Pascal Costanza wrote:
> Pillsy wrote:
[...]
> >     (a) someone has already done this, or something very much like it.
> >     (b) It's actually a terrible, awful, bad idea for reasons that
> > simply aren't obvious to me.

> > So, do (a) and/or (b) hold?
>
> (a) holds to a certain degree. IIRC, LinJ has a more compact way of
> declaring types for variables. Bigloo's approach also seems quite nice.

I'll look into them. Thanks for the tip.
[...]
> (b) I don't know. A CL implementation is allowed to ignore type
> declarations. The declare forms make it easier to do so. Your suggested
> approach suggests that types are not optional in that sense (although
> that's just a fuzzy impression).

That's an interesting point. I suppose if I ever get this to a point
where I would provide it to others to use, I'll be sure to point out in
the documentation that CL implementations may just ignore the type
declarations like everything else.

> (c) It should be relatively straightforward to implement what you
> suggest as a bunch of macros that expand into the CL-style declarations.

"Relatively straightforward" is right, since I've been able to whip a
potentially functional implementation up in a few hours. The trickiest
part was parsing the lambda list for &key, &aux and friends, and I may
have completely botched the job.

I think I'll leave testing it until tomorrow though....

> No need to force such a change onto others...

I have no idea how to do that, even if I wanted to. ;^)

Cheers, Pillsy
From: Rob Warnock
Subject: Re: A better syntax for type declaration?
Date: 
Message-ID: <7JGdnQV_qf95bu3YnZ2dnUVZ_qGdnZ2d@speakeasy.net>
Pillsy <·········@gmail.com> wrote:
+---------------
| Pascal Costanza wrote:
| > (c) It should be relatively straightforward to implement what you
| > suggest as a bunch of macros that expand into the CL-style declarations.
| 
| "Relatively straightforward" is right, since I've been able to whip a
| potentially functional implementation up in a few hours. The trickiest
| part was parsing the lambda list for &key, &aux and friends, and I may
| have completely botched the job.
+---------------

You might want to look at what, if any, implementation-specific
functions you have available to you that you can piggyback on
[and then if you're interested in portability, provide feature-tested
wrappers around the particular functionality you need]. For example,
CMUCL provides the function KERNEL:PARSE-LAMBDA-LIST, which does this:

    ;;; Parse-Lambda-List  --  Interface
    ;;;
    ;;;  Break a lambda-list into its component parts.
    ;;;  We return eleven values:
    ;;;  1] A list of the required args.
    ;;;  2] A list of the optional arg specs.
    ;;;  3] True if a rest arg was specified.
    ;;;  4] The rest arg.
    ;;;  5] A boolean indicating whether keywords args are present.
    ;;;  6] A list of the keyword arg specs.
    ;;;  7] True if &allow-other-keys was specified.
    ;;;  8] A list of the &aux specifiers.
    ;;;  9] True if a more arg was specified.
    ;;; 10] The &more context var
    ;;; 11] The &more count var
    ;;;
    ;;; The top-level lambda-list syntax is checked for validity,
    ;;; but the arg specifiers are just passed through untouched.
    ;;; If something is wrong, we use Compiler-Error, aborting
    ;;; compilation to the last recovery point.
    ;;;
    (defun parse-lambda-list (list)
      (declare (list list)
	       (values list list boolean t boolean list boolean list
		       boolean t t))
      ...[rest of function]... )

For example:

    cmu> (kernel:parse-lambda-list
	  '(a b &optional c (d 37) (e (+ d 12) e-p)
		&rest the-rest
		&key f (g 32) (h (/ g 1.2) h-p)
		&allow-other-keys
		&aux i (j (+ d (* e g)))))

    (A B)
    (C (D 37) (E (+ D 12) E-P))
    T
    THE-REST
    T
    (F (G 32) (H (/ G 1.2) H-P))
    T
    (I (J (+ D (* E G))))
    NIL
    NIL
    NIL
    cmu> 

I'm sure most other implementations have something similar.


-Rob

-----
Rob Warnock			<····@rpw3.org>
627 26th Avenue			<URL:http://rpw3.org/>
San Mateo, CA 94403		(650)572-2607
From: Kaz Kylheku
Subject: Re: A better syntax for type declaration?
Date: 
Message-ID: <1165041595.275646.64130@79g2000cws.googlegroups.com>
Rob Warnock wrote:
> wrappers around the particular functionality you need]. For example,
> CMUCL provides the function KERNEL:PARSE-LAMBDA-LIST, which does this:
>
>     ;;; Parse-Lambda-List  --  Interface
>     ;;;
>     ;;;  Break a lambda-list into its component parts.
>     ;;;  We return eleven values:

That's right! Because when you're returning only ten values, and you
need that extra push over the edge, where do you go?
From: Förster vom Silberwald
Subject: Re: A better syntax for type declaration?
Date: 
Message-ID: <1165074722.756027.107720@80g2000cwy.googlegroups.com>
Pascal Costanza wrote:

> (a) holds to a certain degree. IIRC, LinJ has a more compact way of
> declaring types for variables. Bigloo's approach also seems quite nice.
> There are probably other existing approaches for Lisp-like languages
> (Stella?).

Bigloo is my favorite language. However, one has to note that it offers
only some basic types. Okay, classes in Bigloo are types too, but I
think Common Lisp has more "type facilities" in its store.

However, giving types in Bigloo is really starightforward and does not
clutter up code and redability:

(let ((salsa::vector (vector 1 2 23))
       (s::bint 2)
       (sw::my_class ...))

or: (define (what::pair-nil n::double s::bint w::vector))

That's being one of the reasons why I like Bigloo. Common Lisp would do
good if it would adopt the type-syntax of Bigloo.

Bigloo its interpreter will not recognize types, but the compiled
Bigloo spots a lot of type mismatches (not as much as a strictly typed
languages ala OCaml, but Bigloo goes a way towards).

Schneewittchen
From: rydis (Martin Rydstr|m) @CD.Chalmers.SE
Subject: Re: A better syntax for type declaration?
Date: 
Message-ID: <w4czma7nca3.fsf@rackham.cd.chalmers.se>
"Pillsy" <·········@gmail.com> writes:
>     (a) someone has already done this, or something very much like it.
>     (b) It's actually a terrible, awful, bad idea for reasons that
> simply aren't obvious to me.
> 
> So, do (a) and/or (b) hold?

There is, at least, Mark Tarver's Qi and Drew McDermott's Nisp, which
go in similar directions; they are both more or less statically typed
by default, AFAIK, though, so possibly mostly useful as starting
points.

',mr

-- 
rydis (Martin Rydstr�m) @CD.Chalmers.SE             http://www.rydis.se

[Emacs] is written in Lisp, which is the only computer language that is
beautiful.  -- Neal Stephenson, _In the Beginning was the Command Line_
From: Thomas Atkins
Subject: Re: A better syntax for type declaration?
Date: 
Message-ID: <1165105176.116382.315920@73g2000cwn.googlegroups.com>
Pillsy wrote:

>     (a) someone has already done this, or something very much like it.
>     (b) It's actually a terrible, awful, bad idea for reasons that
> simply aren't obvious to me.
>
> So, do (a) and/or (b) hold?
>
> TIA,
> Pillsy

Bruno Haible wrote a package called TYPEDVAR-COMMON-LISP, it's
available as part of CLOCC. The resulting code looks like
(defun foo ([a fixnum] [b fixnum]) [fixnum]
     (body-of-the-function))

Tom
From: Pillsy
Subject: Re: A better syntax for type declaration?
Date: 
Message-ID: <1165361836.470269.144170@16g2000cwy.googlegroups.com>
So, after more work than I expected, I have my own implementation of a
more concise set of type declarations. It's not as neat, IMO, as Kaz
Kylheku's version, but it gets the job done. The basic set-up was
pretty easy, but I wanted to provide a lot of pretty similar macros
(like a typed LET and a typed LET*), which led me to do a lot of
refactoring and write a bunch of higher-order macros. This sort of took
on a life of its own, but  I'm glad I did it. This is my first bit of
non-trivial macrology, and I think I learned quite a bit doing it.

There are a few of limitations of the set-up I have now. One is
extremely trivial IMO: there's no way to declare that a function
returns type NIL. The other is less trivial: there's no way to extend
this syntax so it will work with something like DESTRUCTURING-BIND. I
don't see anything that would work in that context that doesn't involve
some sort of reader macros (like Bruno Haible's package) or parsing
atoms as strings (by having a name like VAR/TYPE), both of which I'd
prefer to avoid.

I also haven't gotten around to writing versions of MULTIPLE-VALUE-BIND
and LAMBDA that work with the new syntax. I'm not 100% sure how I want
the last to work.

The code depends on the ITERATE package and something called
PILLSY-UTILITIES. The latter is just trivial stuff I've picked up or
written. I tried to do everything with LOOP, and was quickly reminded
why I always use ITERATE instead. MAPPEND is nondestructive MAPCAN,
WITH-UNIQUE-NAMES is from somewhere (CLOCC?) and MVBIND and DBIND are
just abbreviations for MULTIPLE-VALUE-BIND and DESTUCTURING-BIND.

Thanks for all your suggestions. And Kaz, thanks for posting your
version.

Cheers,
Pillsy

===

;;;
;;; TYPED-LAMBDA-LISTS, a CL extension that provides less verbose,
;;; more localized syntax for (optional!) type declarations.  This
consists of
;;;
;;;   (1) Typed bindings, for declaring the types of lexical
;;;   variables. The syntax for typed bindings is
;;;
;;;      ({VAR | (VAR INIT-FORM [TYPE])}*)
;;;
;;;   where VAR is the variable name, INIT-FORM is VAR's initial value
;;;   and TYPE is the optional type to declare for VAR. This syntax is
;;;   used with the macros TLET and TLET*, which work like LET and
;;;   LET* respectively.
;;;
;;;   (2) Typed lambda lists, for declaring the types of function
;;;   arguments. The syntax is given by
;;;
;;;      ({FORM | (FORM TYPE)}*)
;;;
;;;   where FORM is a valid element of a lambda list. Examples include
;;;   a symbol for a required argument for an ordinary function, or a
;;;   list of a name, a default value, and a predicate for an optional
;;;   or keyword argument. This syntax is used fod declaring the
;;;   argument types in the macros TFLET and TLABELS (which establish
;;;   local function bindings as LET and LABELS respectively) and for
;;;   the macros DEFINE-FUN, DEFINE-TGENERIC and DEFINE-TMETHOD,
;;;   (which act like DEFUN, DEFMETHOD and DEFGENERIC
;;;   respectively). Note that DEFINE-TMETHOD takes a specialized,
;;;   typed lambda list, so FORM will be either a symbol or a list of
;;;   a symbol and a class name. This may useful if there's
;;;   additional, more restrictive type information available. E.g.,
;;;
;;;      ((X INTEGER) FIXNUM)
;;;
;;;   would specialize on integer values of X, but also make the
;;;   stronger declaration that integer values of X are also fixnums.
;;;
;;;   (3) Typed function names, for declaring the return types of
;;;   functions. The syntax is
;;;      {STD-NAME | (STD-NAME TYPE)}
;;;   where STD-NAME is an ordinary function name, i.e.,
;;;      {NAME | (SETF NAME)}
;;;   This syntax is used with the the binding macros TFLET and
;;;   TLABELS as well as the definition macros DEFINE-TFUN,
;;;   DEFINE-TGENERIC and DEFINE-METHOD.
;;;

(defpackage #:typed-lambda-lists
  (:use #:common-lisp #:pillsy-utilities #:iterate)
  (:nicknames #:cl-tll)
  (:export #:define-tfun #:define-tgeneric #:define-tmethod
	   #:tlet #:tlet* #:tflet #:tlabels))




(in-package :typed-lambda-lists)

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defparameter *parsing-functions*
    '((:atom     . 'identity)
      (:simple   . 'parse-simple-var)
      (:compound . 'parse-compound-var)
      (:binding  . 'parse-binding)
      (:value    . 'parse-value)
      (:function . 'parse-function-def))
    "An alist that pairs each sort of typed specifications with
the name of the function required which parses them by returning
two values:

  (1) A standard specification.
  (2) The associated type, if any."))

(defmacro define-entry-parser (name (form) &body body
			       &key test spec var-name type)
  "Defines a function named NAME, which acts on a variable FORM, and
returns two values, as described in the documentation for
*PARSING-FUNCTIONS*."
  (declare (ignore body))
  `(defun ,name (,form)
     (if ,test
	 (values ,form nil)
	 (values ,spec (list ,type ,var-name)))))

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defun make-clause-parser (proc var)
    #'(lambda (clause)
	(let ((key  (car clause))
	      (func (cdr (assoc (cdr clause) *parsing-functions*))))
	  `(,key (,proc ,func ,var)))))

  (define-entry-parser parse-simple-var (var)
    :test (atom var) :spec (car var) :var-name (car var) :type (cadr
var))

  (define-entry-parser parse-compound-var (var)
    :test (or (atom var) (atom (car var)))
    :spec (car var) :var-name (caar var) :type (cadr var))

  (define-entry-parser parse-binding (binding)
    :test (or (atom binding) (<= (length binding) 2))
    :spec (butlast binding)
    :var-name (car binding) :type (car (last binding)))

  (define-entry-parser parse-typed-function-name (form)
    :test (or (atom form) (eql (car form) 'setf))
    :spec (car form) :var-name (car form) :type (cadr form)))

(defmacro do-lambda-list
    ((var lambda-list) &body key-clauses)
  "Sets up a loop to walk through LAMBDA-LIST, binding each
element in it to VAR in turn. KEY-CLAUSES are of the form (KEY
. PROCESS), where KEY is either a lambda list keyword, or one
of :KEYWORD or :REQUIRED, and PROCESS is another implicit PROGN
for processing VARs of the appropriate sort."
  (let (body-required body-keyword)
    (mvbind (keys bodies)
	(iter
	  (for (key . body) :in key-clauses)
	  (case key
	    (:required (setf body-required body))
	    (:keyword  (setf body-keyword  body))
	    (otherwise
	     (collect body :into bodies)
	     (collect key  :into keys)))
	  (finally (return (values keys bodies))))
      (with-unique-names (state)
	`(let ((,state :required))
	   (dolist (,var ,lambda-list)
	     (case ,var
	       ,@(mapcar #'(lambda (k)
			     `(,k (setf ,state ',k)
				  ,@body-keyword))
			 keys)
	       (otherwise
		(case ,state
		  (:required ,@body-required)
		  ,@(mapcar #'(lambda (state body)
				`(,state ,@body))
			    keys bodies))))))))))

(defmacro do-lambda-parsing (lambda-list &body key-parsers)
  (with-unique-names (proc var fn spec spec-list type type-list)
    (let* ((clause-parser (make-clause-parser proc var))
	   (parse-clauses (mapcar clause-parser key-parsers)))
      `(let ((,spec-list ()) (,type-list ()))
	 (flet ((,proc (,fn ,var)
		  (mvbind (,spec ,type) (funcall ,fn ,var)
		    (push ,spec ,spec-list)
		    (push ,type ,type-list))))
	   (do-lambda-list (,var ,lambda-list)
	     ,@parse-clauses))
	 (values (nreverse ,spec-list) (nreverse ,type-list))))))

(defmacro define-typed-parser (name (&rest rules))
  (with-unique-names (lambda-list)
    `(defun ,name (,lambda-list)
       (do-lambda-parsing ,lambda-list
	 ,@rules))))

  (define-typed-parser parse-standard-typed-lambda-list
      ((:required . :simple)
       (:keyword  . :atom)
       (&optional . :compound)
       (&rest     . :atom)
       (&key      . :compound)
       (&aux      . :compound)))

 (define-typed-parser parse-specialized-typed-lambda-list
     ((:required . :compound)
      (:keyword  . :atom)
      (&optional . :compound)
      (&rest     . :atom)
      (&key      . :compound)
      (&aux      . :compound)))

 (define-typed-parser parse-let-bindings
     ((:required . :binding)))

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defun make-typed-function-parser (lambda-parser)
    #'(lambda (spec)
	(dbind (typed-name typed-args &rest body) spec
	  (mvbind (lambda-list types) (funcall lambda-parser typed-args)
	    (mvbind (fn-name return-type) (parse-typed-function-name
typed-name)
	      (values
	       `(,fn-name ,lambda-list
			  (declare ,@(make-type-declaration types))
			  ,@body)
	       (if return-type
		   `((function ,(make-arg-type types)
			       ,(car return-type)) ,fn-name)
		   nil)))))))

  (defun parse-function-def (fdef)
    (funcall
     (make-typed-function-parser
      #'parse-standard-typed-lambda-list) fdef))

  (defun parse-generic-def (gdef)
    (funcall
     (make-typed-function-parser
      #'parse-specialized-typed-lambda-list) gdef))

  (defun make-type-declaration (types)
    (mappend #'(lambda (ts) (when ts `((type ,@ts)))) types))

  (defun make-ftype-declaration (ftypes)
    (mappend #'(lambda (fts) (when fts `((ftype ,@fts)))) ftypes))

  (defun make-arg-type (types)
    (mapcar #'(lambda (ts) (if ts (car ts) '*)) types)))

(define-typed-parser parse-flet-bindings
    ((:required . :function)))

(defmacro define-typed-binder
    ((name original)
     &key (parser 'parse-let-bindings) (declarer
'make-type-declaration))
  "Define a macro NAME, which will set up bindings the same way
as ORIGINAL, while extracting the type information from the list
of bindings and generating type declarations from them. PARSER
should name the function that retrieves the type information from
the list of typed bindings, and DECLARER should be a function
that can turn that type information into declarations."
  (with-unique-names (bind-list types)
    `(defmacro ,name (typed-bindings &body body)
       (mvbind (,bind-list ,types) (,parser typed-bindings)
	 `(,',original
	   ,,bind-list
	   (declare ,@(,declarer ,types))
	   ,@body)))))

(define-typed-binder (tlet let))

(define-typed-binder (tlet* let*))

(define-typed-binder (tflet flet)
    :parser parse-flet-bindings :declarer make-ftype-declaration)

(define-typed-binder (tlabels labels)
    :parser parse-flet-bindings :declarer make-ftype-declaration)

(defmacro define-typed-definer ((name original)
				&key (parser 'parse-function-def))
  "Define a macro NAME, which will declare functions/methods like
ORIGINAL, while extracting type information from typed function
names and typed lambda lists. The type information from the
lambda list is used to set up a declaration inside the body of
the function, and the type from the function name is used (with
the other type information] to DECLAIM the FTYPE of the
function."
  (with-unique-names (form fn-spec fn-type)
    `(defmacro ,name (&whole ,form typed-name typed-args &body body)
       ,(format nil
	 "Defines a function or method in the manner of ~A, but ~
	 TYPED-NAME and TYPED-ARGS are a typed name and a typed ~
	 lambda list respectively." original)
       (declare (ignore typed-name typed-args body))
       (mvbind (,fn-spec ,fn-type) (,parser (rest ,form))
	 `(progn
	    (declaim ,@(make-ftype-declaration (list ,fn-type)))
	    (,',original ,@,fn-spec))))))

(define-typed-definer (define-tfun defun))

(define-typed-definer (define-tgeneric defgeneric)
    :parser parse-generic-def)

(define-typed-definer (define-tmethod defmethod)
    :parser parse-generic-def)
From: Kaz Kylheku
Subject: Re: A better syntax for type declaration?
Date: 
Message-ID: <1165363319.009470.97880@j44g2000cwa.googlegroups.com>
Pillsy wrote:
> There are a few of limitations of the set-up I have now. One is
> extremely trivial IMO: there's no way to declare that a function
> returns type NIL.

That could be because NIL isn't a type. NIL is an instance of the type
NULL, and also of the class NULL.

> The other is less trivial: there's no way to extend
> this syntax so it will work with something like DESTRUCTURING-BIND.

Sure there is; you extend your parsing to handle destructuring lambda
lists, and write a type-declared destructuring bind. The hard part is
how to decide whether some list is declaring a type-declared variable,
or whether it represents structure to be broken down. This decision is
syntactically easy in the case of lambda lists.

Instead of some atom A that matches a substructure, you now have
something like (A INTEGER). But that just looks like a destructuring
pattern which matches a two-element list to be bound to the variables A
and INTEGER.

> I don't see anything that would work in that context that doesn't involve
> some sort of reader macros (like Bruno Haible's package) or parsing
> atoms as strings (by having a name like VAR/TYPE), both of which I'd
> prefer to avoid.

There are other ways. For instance you could declare, no pun intended,
that an expression of the form (:type X Y) occuring in the
destructuring pattern specifies a match for an object which is bound to
variable Y, declared to type X.

Another idea is to simply not use atoms at all in the declarative
destructuring pattern. All matching is done by list expressions. So for
instance the pattern ((A) (B)) would match (list 1 2), initializing A
with 1 and B with 2. Now you can add optional types: ((A STRING) (B
FLOAT)). The rule is that anything form which looks like (SYMBOL ...)
is an atom match and not substructure.

Another idea is, at least for destructuring lambda lists, to relax the
requirement that the declarations must be together with the variables.
Put the declarations into a separate pattern which occurs next to the
destructuring pattern, and must be an exact mirror of it, with all the
places that have atoms in the destructuring pattern being required to
have type declarations (or T) in the type pattern.

So  (A (B C (D))) together with (INTEGER (STRING STRING (FLOAT))))
constitute a type-agumented destructuring job. This might ultimately be
more readable than combining these two trees together using extra
nesting, yet does not compromise readability to the extent that
(DECLARE (TYPE ...))) would; it still relies on a useful visual
association. When reading the code, the programmer can consider the two
patterns independently against the input being matched, or against each
other.
From: Pillsy
Subject: Re: A better syntax for type declaration?
Date: 
Message-ID: <1165363789.882700.64850@l12g2000cwl.googlegroups.com>
Kaz Kylheku wrote:

> Pillsy wrote:

> > There are a few of limitations of the set-up I have now. One is
> > extremely trivial IMO: there's no way to declare that a function
> > returns type NIL.

> That could be because NIL isn't a type. NIL is an instance of the type
> NULL, and also of the class NULL.

I'm still thinking about the rest of your post, but I couldn't let the
language lawyering wait. :^)

I learned, no so long ago and to my surprise, that NIL is a type.

http://www.lispworks.com/documentation/HyperSpec/Body/t_nil.htm

ERROR returns type NIL.

Cheers,
Pillsy
From: Kaz Kylheku
Subject: Re: A better syntax for type declaration?
Date: 
Message-ID: <1165364258.069473.140230@j44g2000cwa.googlegroups.com>
Pillsy wrote:
> Kaz Kylheku wrote:
>
> > Pillsy wrote:
>
> > > There are a few of limitations of the set-up I have now. One is
> > > extremely trivial IMO: there's no way to declare that a function
> > > returns type NIL.
>
> > That could be because NIL isn't a type. NIL is an instance of the type
> > NULL, and also of the class NULL.
>
> I'm still thinking about the rest of your post, but I couldn't let the
> language lawyering wait. :^)
>
> I learned, no so long ago and to my surprise, that NIL is a type.
>
> http://www.lispworks.com/documentation/HyperSpec/Body/t_nil.htm
>
> ERROR returns type NIL.

Ah right, thanks for the refresher.

 So it really is NIL that you want, right? If a function returns type
NIL, it means it returns nothing, that is to say, (VALUES).

In an FTYPE declaration, can't you just omit the return type?

 ;; does this mean x is declared to return nothing?
 ;; or does it mean x is declared to return anything?
 (declaim (ftype (function (integer)) x))

 (defun foo (i) (values))
From: rydis (Martin Rydstr|m) @CD.Chalmers.SE
Subject: Re: A better syntax for type declaration?
Date: 
Message-ID: <w4cvekona2w.fsf@rackham.cd.chalmers.se>
"Kaz Kylheku" <········@gmail.com> writes:
> Pillsy wrote:
> > Kaz Kylheku wrote:
> > I learned, no so long ago and to my surprise, that NIL is a type.
> >
> > http://www.lispworks.com/documentation/HyperSpec/Body/t_nil.htm
> >
> > ERROR returns type NIL.
> 
> Ah right, thanks for the refresher.
> 
>  So it really is NIL that you want, right? If a function returns type
> NIL, it means it returns nothing, that is to say, (VALUES).

No, for a function to (be declared to) return type NIL, it means it
doesn't return, AFAICT.

Regards,

',mr

-- 
rydis (Martin Rydstr�m) @CD.Chalmers.SE             http://www.rydis.se

[Emacs] is written in Lisp, which is the only computer language that is
beautiful.  -- Neal Stephenson, _In the Beginning was the Command Line_