Commit 86d01196 authored by Liam Healy's avatar Liam Healy

Number symbols sequentially; intern specials for defmfun

Created file init/utility.lisp, which now includes
make-symbol-cardinal and make-symbol-cardinals.  These functions in
turn will now take a list for name, and join the symbols together with
"-", and will optionally intern in a package.  In #'callback-args in
callback.lisp, the args are now numbered sequentionally (still
uninterned, but no longer gensymmed).  In #'expand-defmfun-wrap in
defmfun.lisp, the symbols for specials "dynfn" and "cbfn" that are
made are now interned, numbered sequentially, and named after the
function in which they occur.  This doesn't affect the functionality
of the functions, it is just for readability of the macroexpansion.
Expected tests pass.
parent 26a5e307
;; Definition of GSLL system
;; Liam Healy
;; Time-stamp: <2009-03-31 22:11:14EDT gsll.asd>
;; Time-stamp: <2009-04-02 22:34:36EDT gsll.asd>
;; $Id$
(asdf:defsystem "gsll"
......@@ -14,14 +14,16 @@
((:module init
:components
((:file "init")
(:file "utility")
(:file "forms")
(:file "conditions" :depends-on (init))
(:file "number-conversion" :depends-on (init))
(:file "callback-compile-defs" :depends-on (init))
(:file "mobject" :depends-on (init callback-compile-defs))
(:file "callback-included" :depends-on (mobject))
(:file "callback" :depends-on (init forms number-conversion callback-included))
(:file "funcallable")
(:file "callback"
:depends-on (init utility forms number-conversion callback-included))
(:file "funcallable" :depends-on (utility))
(:file "types" :depends-on (init))
(:file "complex-types" :depends-on (types))
(:file "element-types" :depends-on (init complex-types))
......
;; Foreign callback functions.
;; Liam Healy
;; Time-stamp: <2009-03-31 22:50:57EDT callback.lisp>
;; Time-stamp: <2009-04-02 22:32:19EDT callback.lisp>
;; $Id$
(in-package :gsl)
......@@ -200,15 +200,15 @@
(defun callback-args (argspec)
"The arguments passed by GSL to the callback function."
(mapcar (lambda (arg)
(if (listp arg)
(let ((symbol (gensym "ARG")))
(list symbol
(if (parse-callback-argspec arg 'array-type)
:pointer ; C array
(parse-callback-argspec arg 'element-type))))
arg))
argspec))
(loop for arg in argspec
with count = -1
collect
(if (listp arg)
(list (make-symbol-cardinal "ARG" (incf count))
(if (parse-callback-argspec arg 'array-type)
:pointer ; C array
(parse-callback-argspec arg 'element-type)))
arg)))
;;;;****************************************************************************
;;;; Macro defmcallback
......
;; Macro for defining GSL functions.
;; Liam Healy 2008-04-16 20:49:50EDT defmfun.lisp
;; Time-stamp: <2009-03-29 16:28:26EDT defmfun.lisp>
;; Time-stamp: <2009-04-02 22:48:34EDT defmfun.lisp>
;; $Id$
(in-package :gsl)
......@@ -106,17 +106,20 @@
;; A list of variable names, and a list of callback names
(when (or callbacks callback-object)
(if callback-object
(let ((class (if (listp callback-object)
(second (first callback-object))
(category-for-argument arglist callback-object))))
(let ((class
(if (listp callback-object)
(second (first callback-object))
(category-for-argument arglist callback-object))))
(list (mobject-fnvnames
class
(number-of-callbacks (get-callbacks-for-class class)))
nil))
(let ((num-callbacks (number-of-callbacks callbacks)))
(list
(loop repeat num-callbacks collect (gensym "DYNFN"))
(loop repeat num-callbacks collect (gensym "CBFN")))))))
(make-symbol-cardinals
(list name 'dynfn) num-callbacks :gsl)
(make-symbol-cardinals
(list name 'cbfn) num-callbacks :gsl))))))
(wrap-index-export
(cond
((eq definition :generic)
......
;; Lisp forms
;; Liam Healy 2009-03-07 15:49:25EST forms.lisp
;; Time-stamp: <2009-04-01 21:33:58EDT forms.lisp>
;; Time-stamp: <2009-04-02 22:34:03EDT forms.lisp>
(in-package :gsl)
......@@ -40,11 +40,3 @@
(when pos
(nth pos cats)))))
;;;;****************************************************************************
;;;; Utility
;;;;****************************************************************************
;;; http://common-lisp.net/project/bdb/qbook/mycl-util/api/function_005FMYCL-UTIL_003A_003AMAPPEND.html
(defun mappend (fn &rest lsts)
"maps elements in list and finally appends all resulted lists."
(apply #'append (apply #'mapcar fn lsts)))
;; Generate a lambda that calls the user function; will be called by callback.
;; Liam Healy
;; Time-stamp: <2009-03-31 22:22:50EDT funcallable.lisp>
;; Time-stamp: <2009-04-02 22:34:03EDT funcallable.lisp>
;; $Id$
(in-package :gsl)
......@@ -9,13 +9,6 @@
;;;; Utility
;;;;****************************************************************************
(defun make-symbol-cardinal (name i)
(make-symbol (format nil "~:@(~a~)~d" name i)))
(defun make-symbol-cardinals (name max-count)
(loop for i from 0 below max-count
collect (make-symbol-cardinal name i)))
(defun value-from-dimensions (argspec dimension-values &optional total)
"Return a list of numerical sizes for dimensions of an array. If
total = T, then return the product of those dimensions."
......
;; Utility definitions
;; Liam Healy 2009-04-02 22:33:15EDT utility.lisp
;; Time-stamp: <2009-04-02 22:49:53EDT utility.lisp>
;; $Id: $
(in-package :gsl)
;;; http://common-lisp.net/project/bdb/qbook/mycl-util/api/function_005FMYCL-UTIL_003A_003AMAPPEND.html
(defun mappend (fn &rest lsts)
"maps elements in list and finally appends all resulted lists."
(apply #'append (apply #'mapcar fn lsts)))
(defun make-symbol-cardinal (name i &optional intern-package)
(if (listp name)
(make-symbol-cardinal (format nil "~{~a~^-~}" name) i intern-package)
(if intern-package
(intern (format nil "~:@(~a~)~d" name i) intern-package)
(make-symbol (format nil "~:@(~a~)~d" name i)))))
(defun make-symbol-cardinals (name max-count &optional intern-package)
(loop for i from 0 below max-count
collect (make-symbol-cardinal name i intern-package)))
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