diff --git a/gsll.asd b/gsll.asd index f4b12f1c0d9a1a3113ff2bc0b3b3d4a0166bb9ba..f6c1ac3082840013cba00e1b60596ad63760d348 100644 --- a/gsll.asd +++ b/gsll.asd @@ -1,6 +1,6 @@ ;; Definition of GSLL system ;; Liam Healy -;; Time-stamp: <2009-03-07 22:31:35EST gsll.asd> +;; Time-stamp: <2009-03-14 11:27:10EDT gsll.asd> ;; $Id$ (asdf:defsystem "gsll" @@ -18,7 +18,8 @@ (:file "conditions" :depends-on (init)) (:file "number-conversion" :depends-on (init)) (:file "mobject" :depends-on (init)) - (:file "callback" :depends-on (init forms number-conversion mobject)) + (:file "callback" :depends-on (init forms number-conversion)) + (:file "callback-included" :depends-on (mobject)) (:file "types" :depends-on (init)) (:file "complex-types" :depends-on (types)) (:file "element-types" :depends-on (init complex-types)) diff --git a/init/callback-included.lisp b/init/callback-included.lisp new file mode 100644 index 0000000000000000000000000000000000000000..506c0bf3bd44026144da97502b03d95f83d3d8cb --- /dev/null +++ b/init/callback-included.lisp @@ -0,0 +1,76 @@ +;; The mobject that defines callbacks +;; Liam Healy 2009-03-14 11:20:03EDT callback-included.lisp +;; Time-stamp: <2009-03-14 11:29:41EDT callback-included.lisp> +;; $Id: $ + +(in-package :gsl) + +(defclass callback-included (mobject) + ((cbstruct-name + :initarg :cbstruct-name :reader cbstruct-name + :documentation + "The name of the GSL structure representing the callback(s).") + (array-type + :initarg :array-type :reader array-type + :documentation "A symbol 'marray or 'cvector.") + (callback-labels + :initarg :callback-labels :reader callback-labels + :documentation "The labels in the GSL struct for each callback function.") + (dimension-names + :initarg :dimension-names :reader dimension-names + :documentation "The names in the GSL struct for dimensions.") + (functions + :initarg :functions :reader functions + :documentation "The names of the function(s) put into + the callback. These should correspond in order to + callback-labels.") + (dimensions :initarg :dimensions :reader dimensions)) + (:documentation + "A mobject that includes a callback function or functions to GSL.")) + +(defclass callback-included-cl (callback-included) + ((callback :initarg :callback :reader callback-struct)) + (:documentation + "A mobject that includes a callback function or functions, in which + the pointer to the callback structure is stored in a CL class + slot.")) + +(defmacro def-ci-subclass + (class-name superclasses documentation + cbstruct-name array-type callback-labels + &optional (dimension-names '(dimensions))) + `(defclass ,class-name ,superclasses + ((cbstruct-name :initform ',cbstruct-name :allocation :class) + (array-type :initform ',array-type :allocation :class) + (callback-labels :initform ',callback-labels :allocation :class) + (dimension-names :initform ',dimension-names :allocation :class)) + (:documentation ,documentation))) + +(defmacro def-ci-subclass-1d + (class-name superclasses documentation + cbstruct-name array-type callback-labels) + `(defclass ,class-name ,superclasses + ((cbstruct-name :initform ',cbstruct-name :allocation :class) + (array-type :initform ',array-type :allocation :class) + (callback-labels :initform ',callback-labels :allocation :class) + (dimension-names :initform nil :allocation :class) + (dimensions :initform '(1) :allocation :class)) + (:documentation ,documentation))) + + +;;;;**************************************************************************** +;;;; For making mobjects +;;;;**************************************************************************** + +#| +(defun ci-subclass-cdddr-args (callbacks) + "Make the list + cbstruct-name array-type callback-labels + &optional (dimension-names '(dimensions) + for def-ci-subclass and def-ci-subclass-1d." + (list + (parse-callback-static callbacks 'callback-structure-type) + (callback-argument-function-argspec 'array-type)) + + ) +|# diff --git a/init/callback.lisp b/init/callback.lisp index bfb97ebc3be8441364c56c8e291c373bdb13cff4..9b19955bcbde10ab82d479ffedd178742c86b356 100644 --- a/init/callback.lisp +++ b/init/callback.lisp @@ -1,6 +1,6 @@ ;; Foreign callback functions. ;; Liam Healy -;; Time-stamp: <2009-03-14 10:28:25EDT callback.lisp> +;; Time-stamp: <2009-03-14 11:29:47EDT callback.lisp> ;; $Id$ (in-package :gsl) @@ -88,61 +88,9 @@ (mapcan 'list (callback-labels object) (functions object)))) ;;;;**************************************************************************** -;;;; Classes that include callback information +;;;; to be obsolete make-callbacks ;;;;**************************************************************************** -(defclass callback-included (mobject) - ((cbstruct-name - :initarg :cbstruct-name :reader cbstruct-name - :documentation - "The name of the GSL structure representing the callback(s).") - (array-type - :initarg :array-type :reader array-type - :documentation "A symbol 'marray or 'cvector.") - (callback-labels - :initarg :callback-labels :reader callback-labels - :documentation "The labels in the GSL struct for each callback function.") - (dimension-names - :initarg :dimension-names :reader dimension-names - :documentation "The names in the GSL struct for dimensions.") - (functions - :initarg :functions :reader functions - :documentation "The names of the function(s) put into - the callback. These should correspond in order to - callback-labels.") - (dimensions :initarg :dimensions :reader dimensions)) - (:documentation - "A mobject that includes a callback function or functions to GSL.")) - -(defclass callback-included-cl (callback-included) - ((callback :initarg :callback :reader callback-struct)) - (:documentation - "A mobject that includes a callback function or functions, in which - the pointer to the callback structure is stored in a CL class - slot.")) - -(defmacro def-ci-subclass - (class-name superclasses documentation - cbstruct-name array-type callback-labels - &optional (dimension-names '(dimensions))) - `(defclass ,class-name ,superclasses - ((cbstruct-name :initform ',cbstruct-name :allocation :class) - (array-type :initform ',array-type :allocation :class) - (callback-labels :initform ',callback-labels :allocation :class) - (dimension-names :initform ',dimension-names :allocation :class)) - (:documentation ,documentation))) - -(defmacro def-ci-subclass-1d - (class-name superclasses documentation - cbstruct-name array-type callback-labels) - `(defclass ,class-name ,superclasses - ((cbstruct-name :initform ',cbstruct-name :allocation :class) - (array-type :initform ',array-type :allocation :class) - (callback-labels :initform ',callback-labels :allocation :class) - (dimension-names :initform nil :allocation :class) - (dimensions :initform '(1) :allocation :class)) - (:documentation ,documentation))) - (defgeneric make-callbacks-fn (class args) (:documentation "Function to make forms that expand into defmcallback(s).")) @@ -422,20 +370,3 @@ FUNCTION user-fn-return (second arguments) (second dimensions) (second marrays)) (first user-fn-return))) (apply function arguments))) - -;;;;**************************************************************************** -;;;; For making mobjects -;;;;**************************************************************************** - -#| -(defun ci-subclass-cdddr-args (callbacks) - "Make the list - cbstruct-name array-type callback-labels - &optional (dimension-names '(dimensions) - for def-ci-subclass and def-ci-subclass-1d." - (list - (parse-callback-static callbacks 'callback-structure-type) - (callback-argument-function-argspec 'array-type)) - - ) -|#