Commit ed5ce113 authored by Liam Healy's avatar Liam Healy

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
;; Discrete Hankel Transforms.
;; 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$
(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.
(defgo-s (hankel size nu xmax) allocate-hankel free-hankel init-hankel)
......
;; Definition of GSL objects and ways to use them.
;; 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$
(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
;;; memory-managed. The macro letm takes care of this.
;;; A method #'letm-expansion which eql specializes on the object name
......@@ -23,6 +91,7 @@
;;; it is defined and exported for the benefit of arglist
;;; displayers like slime.
(export 'letm)
(defmacro letm (bindings &body body)
(first (letm-expand bindings body)))
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment