Skip to content
Snippets Groups Projects
Commit ed5ce113 authored by Liam Healy's avatar Liam Healy
Browse files

Prototype defmobject

In gsl-objects, define a prototype defmobject which defines:
 - the class for the gsl object
 - initialize-instance :after method to correspond to GSL
  "alloc" and attach the finalizer,
 - define reinitialize-instance :after method to correspond to a setter
  or intialize in GSL,
 - define a make-<class-name> function that will be the customary user
  interface, and will call make-instance and possibly
  reinitialize-instance if defined.
Worked up example in hankel.lisp.  This compiles successfully and
looks correct, but has not been tested.
parent d207414c
No related branches found
No related tags found
No related merge requests found
;; Discrete Hankel Transforms. ;; Discrete Hankel Transforms.
;; Liam Healy, Sat Dec 8 2007 - 16:50 ;; Liam Healy, Sat Dec 8 2007 - 16:50
;; Time-stamp: <2008-08-23 11:48:13EDT hankel.lisp> ;; Time-stamp: <2008-12-14 23:16:48EST hankel.lisp>
;; $Id$ ;; $Id$
(in-package :gsl) (in-package :gsl)
#|
;;; Create the Hankel transform object and essential methods/functions.
(defmobject hankel "gsl_dht"
((size sizet))
"discrete Hankel Transform"
"new"
((nu :double) (xmax :double)))
|#
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Everything compiles, but not tested -- need example. ;;; Everything compiles, but not tested -- need example.
(defgo-s (hankel size nu xmax) allocate-hankel free-hankel init-hankel) (defgo-s (hankel size nu xmax) allocate-hankel free-hankel init-hankel)
......
;; Definition of GSL objects and ways to use them. ;; Definition of GSL objects and ways to use them.
;; Liam Healy, Sun Dec 3 2006 - 10:21 ;; Liam Healy, Sun Dec 3 2006 - 10:21
;; Time-stamp: <2008-08-31 11:35:19EDT gsl-objects.lisp> ;; Time-stamp: <2008-12-14 23:15:01EST gsl-objects.lisp>
;; $Id$ ;; $Id$
(in-package :gsl) (in-package :gsl)
#|
(defclass gsl-object ()
((mpointer :accessor mpointer
:documentation "A pointer to the GSL representation of the object.")))
(defmacro defmobject
(class prefix allocation-args description
&optional initialize-suffix initialize-args)
(let ((mptr (make-symbol "MPOINTER"))
(maker (intern (format nil "MAKE-~:@(~a~)" class) :gsl))
(cl-alloc-args
(variables-used-in-c-arguments allocation-args))
(cl-initialize-args
(variables-used-in-c-arguments initialize-args)))
`(progn
(defclass ,class (gsl-object)
()
(:documentation
,(format nil "The GSL representation of the ~a." description)))
(defmfun initialize-instance ((object ,class) &key ,@cl-alloc-args)
,(format nil "~a_alloc" prefix)
,allocation-args
:definition :method
:qualifier :after
:c-return (,mptr :pointer)
:after ((setf (slot-value object 'mpointer) ,mptr)
(tg:finalize
object
(lambda ()
(foreign-funcall ,(format nil "~a_free" prefix) :pointer ,mptr :void))))
:return (object)
:export nil
:index ,maker)
(defmfun reinitialize-instance ((object ,class) &key ,@cl-initialize-args)
,(format nil "~a_~a" prefix initialize-suffix)
(((mpointer object) :pointer) ,@initialize-args)
:definition :method
:qualifier :after
:return (object)
:export nil
:index (reinitialize-instance ,class))
(defun ,maker
(,@cl-alloc-args
&optional
,@(cons (list (first cl-initialize-args) nil 'settingp)
(rest cl-initialize-args)))
(let ((object (make-instance 'hankel size)))
(when settingp
(reinitialize-instance
object
,@(mapcan
(lambda (sym)
(list (intern (symbol-name sym) :keyword) sym))
cl-initialize-args)))
object)))))
;;; To make-load-form
;;; (make-basis-spline (bspline-order bspline) (number-of-breakpoints bspline))
;;; Then initialize by making a vector from (breakpoint i bspline)
;;; and calling knots.
|#
;;;;;;;;;;;;;;;;;;;;;;;; OLD ;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; There are numerous "GSL objects" which need to by manually ;;; There are numerous "GSL objects" which need to by manually
;;; memory-managed. The macro letm takes care of this. ;;; memory-managed. The macro letm takes care of this.
;;; A method #'letm-expansion which eql specializes on the object name ;;; A method #'letm-expansion which eql specializes on the object name
...@@ -23,6 +91,7 @@ ...@@ -23,6 +91,7 @@
;;; it is defined and exported for the benefit of arglist ;;; it is defined and exported for the benefit of arglist
;;; displayers like slime. ;;; displayers like slime.
(export 'letm) (export 'letm)
(defmacro letm (bindings &body body) (defmacro letm (bindings &body body)
(first (letm-expand bindings body))) (first (letm-expand bindings body)))
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment