tuples.lisp

   1 ;;;; tuples.lisp
   2
   3 (in-package :cl-tuples)
   4
   5 (defmacro def-tuple (type-name)
   6   "Create an alias for values for this tuple.eg (vector3d-values* 1.0 0.0 0.0) => #{ 1.0 0.0 0.0 }"
   7   (tuple-expansion-fn type-name :def-tuple-values))
   8
   9 (defmacro def-tuple-key (type-name)
  10   "Create an alias for values for this tuple.eg (vector3d-key-values z 1.0 x 2.0) => #{ 2.0 0.0 1.0 }"
  11   (tuple-expansion-fn type-name :def-tuple-key-values))
  12
  13 (defmacro def-tuple-typespec (type-name)
  14   "Create an alias typespec eg. (deftype vector3d* () `(values 'single-float 'single-float 'single-float))"
  15   (tuple-expansion-fn type-name :def-tuple-type))
  16
  17 (defmacro def-tuple-array-typespec (type-name)
  18   (tuple-expansion-fn type-name :def-tuple-array-type))
  19
  20 (defmacro def-tuple-struct (type-name)
  21   (tuple-expansion-fn type-name :def-tuple-struct))
  22
  23 (defmacro def-tuple-getter (type-name)
  24   "Create an access macro such as (vector3d vec) that takes a tuple place and unpacks it to tuples (aka multiple values)"
  25   (tuple-expansion-fn type-name :def-tuple-getter))
  26
  27 (defmacro def-tuple-set (type-name)
  28   (tuple-expansion-fn type-name :def-tuple-set))
  29
  30 (defmacro def-tuple-aref (type-name)
  31   "Create a tuple aref macro for unpacking individual tuple from an array of tuples. eg (vector3d-aref up 5) => #(0.0 1.0 0.0)"
  32   (tuple-expansion-fn type-name :def-tuple-aref))
  33
  34 (defmacro def-tuple-aref* (type-name)
  35   "Create a tuple aref macro for unpacking individual tuple from an array of tuples. eg (vector3d-aref up 5) => (values 0.0 1.0 0.0)"
  36   (tuple-expansion-fn type-name :def-tuple-aref*))
  37
  38 (defmacro def-with-tuple (type-name)
  39   "Create a macro that can be used to bind members of a value tuple to symbols to symbols e-g (with-vector thing-vec (x y z w)  &body forms)"
  40   (tuple-expansion-fn type-name :def-with-tuple))
  41
  42 (defmacro def-with-tuple* (type-name)
  43   "Create a macro that can be used to bind members of the tuples place to symbols to symbols e-g (with-vector* thing-vec #(x y z w)  &body forms)"
  44   (tuple-expansion-fn type-name :def-with-tuple*))
  45
  46 (defmacro def-with-tuple-aref (type-name)
  47   "Create a macro that can be used to bind elements of an array of tuples to symbols e-g (with-vector3d-aref (thing-vec 5 (x y z w))  (+ x y z w))"
  48   (tuple-expansion-fn type-name :def-with-tuple-aref))
  49
  50 (defmacro def-tuple-setter (type-name)
  51   "Creates a tuple-setter for setting a tuple place from a mutiple-value tuple. eg (vector3d-setter up #{ 0.0 1.0 0.0 })"
  52   (tuple-expansion-fn type-name :def-tuple-setter))
  53
  54 (defmacro def-tuple-aref-setter (type-name)
  55   "Create an aref-setter macro for setting an element in an array of tuples from a multiple-value tuple. eg (vector3d-aref-setter up 2 #( 0.0 1.0 0.0 ))"
  56   (tuple-expansion-fn type-name :def-tuple-aref-setter))
  57
  58 (defmacro def-tuple-aref-setter* (type-name)
  59   "Create an aref-setter macro for setting an element in an array of tuples from a multiple-value tuple. eg (vector3d-aref-setter up 2 #{ 0.0 1.0 0.0 })"
  60   (tuple-expansion-fn type-name :def-tuple-aref-setter*))
  61
  62 (defmacro def-tuple-vector-push (type-name)
  63     (tuple-expansion-fn type-name :def-tuple-vector-push))
  64
  65 (defmacro def-tuple-vector-push-extend (type-name)
  66     (tuple-expansion-fn type-name :def-tuple-vector-push-extend))
  67
  68 (defmacro def-tuple-vector-push* (type-name)
  69     (tuple-expansion-fn type-name :def-tuple-vector-push*))
  70
  71 (defmacro def-tuple-vector-push-extend* (type-name)
  72     (tuple-expansion-fn type-name :def-tuple-vector-push-extend*))
  73
  74 (defmacro def-new-tuple (type-name)
  75   "Create a function to create a place suitable for holding an individual tuple. eg (new-vector3d)"
  76   (tuple-expansion-fn type-name :def-new-tuple))
  77
  78 (defmacro def-tuple-maker (type-name)
  79   "Create a function to create an place suitable for holding an individual tuple, and initialise elements from multiple-value tuple. eg (make-vector3d (values 1.0 2.0 2.0 ))"
  80   (tuple-expansion-fn type-name :def-tuple-maker))
  81
  82 (defmacro def-tuple-maker* (type-name)
  83   "Create a function to create an place suitable for holding an individual tuple, and initialise elements from array tuple. eg (make-vector3d* #( 1.0 2.0 2.0 ))"
  84   (tuple-expansion-fn type-name :def-tuple-maker*))
  85
  86 (defmacro def-tuple-array-maker (type-name)
  87   "Create a function to create an array suitable for holding an number of individual tuples. ie an array of tuple places. eg (make-vector3d-array 5 :adjustable t)"
  88   (tuple-expansion-fn type-name :def-tuple-array-maker))
  89
  90 (defmacro def-tuple-array-dimensions (type-name)
  91   "Create a function that will return the number of tuples in the array of tuple places."
  92   (tuple-expansion-fn type-name :def-tuple-array-dimensions))
  93
  94 (defmacro def-tuple-fill-pointer (type-name)
  95   "Create a function that will return a vector fill pointer in terms of tuple size"
  96   (tuple-expansion-fn type-name :def-tuple-fill-pointer))
  97
  98 (defmacro def-tuple-setf-fill-pointer (type-name)
  99   "Create a function that will adjust a vector fill pointer in terms of tuple size"
 100   (tuple-expansion-fn type-name :def-tuple-setf-fill-pointer))
 101
 102 (defmacro def-tuple-setf* (type-name)
 103   "Create generalised variable macros for tuple of type-name with the given elements."
 104   (tuple-expansion-fn type-name :def-tuple-setf*))
 105
 106 (defmacro def-tuple-array-setf* (type-name)
 107   "Create generalised variable macros for an array of  tuples of type-name with the given elements."
 108   (tuple-expansion-fn type-name :def-tuple-array-setf*))
 109
 110 (defmacro def-tuple-array-setf (type-name)
 111   "Create generalised variable macros for an array of  tuples of type-name with the given elements."
 112   (tuple-expansion-fn type-name :def-tuple-array-setf))
 113
 114 (defmacro def-tuple-map (type-name)
 115   (tuple-expansion-fn type-name :def-tuple-map))
 116
 117 (defmacro def-tuple-reduce (type-name)
 118   (tuple-expansion-fn type-name :def-tuple-reduce))
 119
 120 (defun document-tuple-type (type-name)
 121   `(progn
 122      ;; instead of setf, need some form that can use the symbol in the format
 123      (setf (documentation ',(tuple-symbol type-name :def-tuple-values) 'function)
 124            (format nil "Convert ~A forms to multiple values." ,(string type-name)))
 125      (setf (documentation ',(tuple-symbol type-name :def-tuple-getter) 'function)
 126            (format nil "Unpack array representation of an ~A and convert to multiple values." ,(string type-name)))
 127      (setf (documentation ',(tuple-symbol type-name :def-tuple-aref*) 'function)
 128            (format nil "Unpack individual ~A to multiple values from an array of ~As." ,(string type-name) ,(string type-name)))
 129      (setf (documentation ',(tuple-symbol type-name :def-with-tuple) 'function)
 130            (format nil "Bind elements of a ~A multiple value to symbols."  ,(string type-name)))
 131      (setf (documentation ',(tuple-symbol type-name :def-with-tuple*) 'function)
 132            (format nil "Bind elements of a ~A vector to symbols."  ',(string type-name)))
 133      (setf (documentation ',(tuple-symbol type-name :def-with-tuple-aref) 'function)
 134            (format nil  "Bind the elements of a ~A from vector of ~A's to symbols" ,(string type-name) ,(string type-name)))
 135      (setf (documentation ',(tuple-symbol type-name :def-tuple-setter) 'function)
 136            (format nil "Creates a macro for setting an ~A vector from a multiple values ~A" ,(string type-name) ,(string type-name)))
 137      (setf (documentation ',(tuple-symbol type-name :def-tuple-aref-setter*) 'function)
 138            (format nil "Creates a macro for setting an ~A vector in a vector of ~As from a multiple values ~A" ,(string type-name) ,(string type-name) ,(string type-name)))
 139      (setf (documentation ',(tuple-symbol type-name :def-tuple-vector-push*) 'function)
 140            (format nil "Push a ~A multiple value onto the end of a vector of ~A's " ,(string type-name) ,(string type-name)))
 141      (setf (documentation ',(tuple-symbol type-name :def-tuple-vector-push-extend*) 'function)
 142            (format nil  "Push a ~A multiple value onto the end of a vector of ~A's with the possibility of extension" ,(string type-name) ,(string type-name)))
 143      (setf (documentation ',(tuple-symbol type-name :def-new-tuple) 'function)
 144            (format nil  "Create an array suitable for holding a single ~A" ,(string type-name)))
 145      (setf (documentation ',(tuple-symbol type-name :def-tuple-maker) 'function)
 146            (format nil  "Create an array sutable for holding a single ~A and initialize it from a multiple-values form" ,(string type-name)))
 147      (setf (documentation ',(tuple-symbol type-name :def-tuple-maker*) 'function)
 148            (format nil   "Create an array sutable for holding a single ~A and initialize it from a  form" ,(string type-name)))
 149      (setf (documentation ',(tuple-symbol type-name :def-tuple-array-maker) 'function)
 150            (format nil  "Create an array suitable for holding a number of ~A's " ,(string type-name)))
 151      (setf (documentation ',(tuple-symbol type-name :def-tuple-array-dimensions) 'function)
 152            (format nil  "Return the size of a vector of ~A's (ie how many ~A's it contains)" ,(string type-name) ,(string type-name)))
 153      (values)))
 154
 155 (defmacro def-tuple-documentation (type-name)
 156   (document-tuple-type type-name))
 157
 158 (defmacro make-tuple-operations (type-name)
 159   `(progn
 160      (def-tuple ,type-name)
 161      (def-tuple-key ,type-name)
 162          (def-tuple-struct ,type-name)
 163      (def-tuple-getter ,type-name)
 164      (def-tuple-aref* ,type-name)
 165          (def-tuple-aref ,type-name)
 166      (def-tuple-aref-setter*  ,type-name)
 167          (def-tuple-aref-setter ,type-name)
 168      (def-tuple-array-dimensions ,type-name)
 169      (def-tuple-fill-pointer ,type-name)
 170      (def-tuple-setf-fill-pointer ,type-name)
 171      (def-with-tuple ,type-name)
 172      (def-with-tuple* ,type-name)
 173      (def-with-tuple-aref ,type-name)
 174      (def-tuple-setter  ,type-name)
 175      (def-tuple-vector-push ,type-name)
 176      (def-tuple-vector-push-extend ,type-name)
 177      (def-tuple-vector-push* ,type-name)
 178      (def-tuple-vector-push-extend* ,type-name)
 179      (def-new-tuple ,type-name)
 180      (def-tuple-maker ,type-name)
 181      (def-tuple-maker* ,type-name)
 182      (def-tuple-array-maker ,type-name)
 183      (def-tuple-setf*  ,type-name)
 184      (def-tuple-array-setf*  ,type-name)
 185      (def-tuple-array-setf ,type-name)
 186      (def-tuple-map ,type-name)
 187      (def-tuple-reduce ,type-name)))
 188
 189 (defmacro export-tuple-operations (type-name)
 190   `(progn
 191      ,@(loop for kw in *tuple-expander-keywords* collect `(export (tuple-symbol (quote ,type-name) ,kw)))))
 192
 193
 194 ;; possibly we also need a deftype form to describe a tuple array?
 195
 196 (defmacro def-tuple-type (tuple-type-name &key tuple-element-type initial-element elements)
 197   "Create a tuple type. To be used from the top level.
 198  For example (def-tuple-type vector3d single-float (x y z)) will create several macros and functions.
 199  Firstly, the accessor functions (vector3d array) (vector3d-aref array index).
 200  Secondly, the context macros (with-vector3d tuple (element-symbols) forms..) and  (with-vector3d-array tuple (element-symbols) index forms..),
 201  Thirdly the constructors (new-vector3d) and (make-vector3d tuple),  (make-vector3d-array dimensions &key adjustable fill-pointer),
 202  Forthly generalised access as in  (setf (vector3d array) tuple) and (setf (vector3d-aref array) index tuple),"
 203   `(eval-when (:compile-toplevel :execute :load-toplevel)
 204      (cl-tuples::make-tuple-symbol ',tuple-type-name ',tuple-element-type ',initial-element ',elements)
 205      (cl-tuples::make-tuple-operations ,tuple-type-name)
 206      (cl-tuples::def-tuple-documentation ,tuple-type-name)))
 207
 208
 209 ;; full syntax (def-tuple-op name ((name type (elements)) ..) (
 210 ;; this needs some way of having the names as meaningful symbols
 211 ;; also a way of specifying type of return value and non-tuple parameters
 212 (defmacro def-tuple-op (name param-list  &body forms)
 213   "Macro to define a tuple operator. The name of the operator is
 214    name. The operator arguments are determined by args, which is a
 215    list of the form ((argument-name argument-type (elements)   ..)).
 216    Within the forms the tuple value form is bound to the argument-name
 217    and the tuple elements are bound to the symbols in the element list"
 218   (let* ((param-names (mapcar #'car param-list))
 219          (param-typenames (mapcar #'cadr  param-list))
 220          (param-elements (mapcar (lambda (param)
 221                                    (let* ((type-name (cadr param))
 222                                           (size (and (tuple-typep type-name) (tuple-size type-name)))
 223                                           (elements (caddr param)))
 224                                      (or
 225                                       (if (eq elements :default)
 226                                           (tuple-elements type-name)
 227                                           elements)
 228                                       (and size (make-gensym-list size)))))
 229                                  param-list))
 230          (doc (if (stringp (first forms))
 231                   (first forms)
 232                   (format nil "DEF-TUPLE-OP ~A ~A" name param-typenames))))
 233     `(defmacro ,name ,param-names
 234        ,doc
 235        ,(def-tuple-expander-fn param-names param-typenames param-elements forms))))