Re: [Gcl-devel] C library support [ was Re: BLAS and GCL ]

[Camm Maguire]

Greetings, and thanks for this!  Looks pretty sophisticated.  I had
taken a quick stab at a readtable based solution, which is clearly
still quite limited.  Wonder which approach might be better.

Take care,

=============================================================================
(defun do-comment (s c n) 
  (do ((b nil a) 
       (a nil (read-char s t nil t))) 
      ((and (eql a #\/) (eql b #\*)) (values))))

(defun do-sharp-i (s c n)
  (unless (eq 'nclude (read s t nil t))
    (error "Bad include~%"))
  (do () ((char= (read-char s nil #\Newline t) #\Newline)))
  (values))

(defun do-sharp-d (s c n)
  (unless (eq 'efine (read s t nil t))
    (error "Bad define~%"))
  (do () ((char= (read-char s nil #\Newline t) #\Newline)))
  (values))

(defun do-comma (s c)
  'comma)

(defun do-star (s c)
  'star)

(defun do-eparen (s c)
  nil)

(defun do-semi (s c)
  (values))

(defun do-paren (s c)
  (let ((*readtable* (copy-readtable)))
    (set-macro-character #\, #'do-comma)
    (set-macro-character #\* #'do-star)
    (massage-arg-list (read-delimited-list #\) s) nil 0)))

(defun massage-arg-list (a b c) 
  
  (case c
    (0
     (when (null a)
       (return-from massage-arg-list (nreverse b)))
     (case (car a)
       (const
        (massage-arg-list (cdr a) b 0))
       (star
        (return-from massage-arg-list 'func))
       ((double float int char)
        (massage-arg-list (cdr a) (cons (car a) b) 1))
       (void
        (massage-arg-list (cdr a) (cons (car a) b) 4))
       (otherwise
        (error "Bad list ~S, state ~S~%" a c))))
    (1
     (when (null a)
       (return-from massage-arg-list (nreverse b)))
     (case (car a)
       (comma
        (massage-arg-list (cdr a) b 0))
       (func
        (massage-arg-list a b 4))
       (star
        (let ((b (cons (intern (concatenate 'string (symbol-name (car b)) "*")) 
(cdr b))))
;         (massage-arg-list (cdr a) b 2)
          (massage-arg-list (cdr a) b 1)))
       (otherwise
        (massage-arg-list (cdr a) b 3))))
    (2
     (when (null a)
       (return-from massage-arg-list (nreverse b)))
     (case (car a)
       (comma
        (massage-arg-list (cdr a) b 0))
       (star
        (error "Cannot handle double stars~%"))
       (otherwise
        (massage-arg-list (cdr a) b 3))))
    (3
     (when (null a)
       (return-from massage-arg-list (nreverse b)))
     (unless (eq (car a) 'comma)
       (error "Bad list ~S~%" a))
     (massage-arg-list (cdr a) b 0))
    (4
     (when (null a)
       (return-from massage-arg-list (values)))
     (unless (eq (car a) 'func)
       (error "Bad list ~S~%" a))
     (unless (consp (cadr a))
       (error "Missing function args ~S~%" a))
     (massage-arg-list (cddr a) (cons (cons (car b) (cons 'func (cadr a))) (cdr 
b)) 3))))

(defun parse-c-header (fn)
  (with-open-file 
   (st fn :direction :input)
   (let ((*readtable* (copy-readtable)))
     (make-dispatch-macro-character #\/ #\*)
     (set-dispatch-macro-character #\/ #\* #'do-comment)
     (set-dispatch-macro-character #\# #\i #'do-sharp-i)
     (set-dispatch-macro-character #\# #\d #'do-sharp-d)
     (set-macro-character #\( #'do-paren)
     (set-macro-character #\; #'do-semi)

       (do () ((not (setq a (read-delimited-list #\; st))))
         
         (format t "~S~%" a)))))
=============================================================================
num.h:
=============================================================================
/*  #ifndef LIBSTD_DEFINED */
/*  #include "std.h" */
/*  #endif */

#include "misc.h"

int
gaussj(double **,int,double **,int);

int
mrqmin(double *,double *,double *,int,double *,int,int *,int,
       double **,double **,double *,
       void (*)(double,double *,double *,double *,int),double *);
int
mrqcof(double *,double *,double *,int,double *,int,int *,int,
       double **,double *,double *,
       void (*)(double,double *,double *,double *,int));

int
mpoismin(double *,double *,int,double *,int,int *,int,
       double **,double **,double *,
       void (*)(double,double *,double *,double *,int),double *);
int
mpoiscof(double *,double *,int,double *,int,int *,int,
       double **,double *,double *,
       void (*)(double,double *,double *,double *,int));

int
polint(double *,double *,int,double,double *,double *);

double 
midinf(double (*)(double),double,double,int);

double 
midpnt(double (*)(double),double,double,int);

double 
midsql(double (*)(double),double,double,int);

double 
midsqu(double (*)(double),double,double,int);

double 
midexp(double (*)(double),double,double,int);

double
trapzd(double (*)(double),double,double,int);

double 
qromb(double (*)(double),double,double);

double 
qromo(double (*)(double),double,double,
      double (*)(double (*)(double),double,double,int));

int 
randnorB(double *,int,double);

int 
randflatB(double *,int,double);

/*  double *  */
/*  wdec(const double *,int,int); */

/*  double *  */
/*  wrec(const double *,int,int); */

/*  double *  */
/*  wdec1(const double *,int); */

/*  double *  */
/*  wrec1(const double *,int); */

int
wdec2(const double *,double *,int,int);

int
wdec2f(const float *,float *,int,int);

int
wrec2(const double *,double *,int,int);

double 
ave(double *, int);

double 
cvar(double *, double *, int);

double 
var(double *, int);

void 
mean_err(double *, int n,double *,double *);

void 
ftest(double *, int, double *, int, double *,double *); 

int 
invert(double **, double **, int);

void 
sdiag(double **,int,double *,double *);

int
spline(double *,double *,int,double,double,double *);

void
splint(double *,double *,double *,int,double,double *);

double
pdgammaln(double);

double 
betai(double, double, double);

double 
pgammln(double);

void
mnbrak(double *,double *,double *,
       double *,double *,double *,
       double (*)(double));

double
brent(double,double ,double ,
      double (*)(double),double,double *);

int
amoeba(double **,double *,int,double,
       double (*)(double *),int *);

int 
amoeba0(double *,int,double,
        double (*)(double *),int *);

int
zbrac(double (*)(double),double *,double *);

double
zbrent(double (*)(double),double,double,double);

void
set_seedB(double);

void
covsrt(double **,int,int *,int);

int
bsstep(double *,double *,int,double *,double,double,
       double *,double *,double *,
       int (*)(double,double *,double *));

int
rkqc(double *,double *,int,double *,double,double,
       double *,double *,double *,
       int (*)(double,double *,double *));


int
odeint(double *,int,double,double,double,double,double,
       int *,int *,int (*)(double,double *,double *),
       int (*)(double *,double *,int,double *,double,
                   double,double *,double *,double *,
                   int (*)(double,double *,double *)),
       int,double *,double **,double);

int
four1(double *,int,int);

int
realft(double *,int,int);

int
randnorMT(double *,int,double);

int 
randflatMT(double *,int,double);

void
set_seedMT(unsigned);

extern int (*randnor)(double *,int,double);
extern int (*randflat)(double *,int,double);
=============================================================================
>(parse-c-header "/home/camm/include/num.h")
(INT GAUSSJ (DOUBLE** INT DOUBLE** INT))
(INT MRQMIN
     (DOUBLE* DOUBLE* DOUBLE* INT DOUBLE* INT INT* INT DOUBLE**
              DOUBLE** DOUBLE*
              (VOID FUNC DOUBLE DOUBLE* DOUBLE* DOUBLE* INT) DOUBLE*))
(INT MRQCOF
     (DOUBLE* DOUBLE* DOUBLE* INT DOUBLE* INT INT* INT DOUBLE** DOUBLE*
              DOUBLE* (VOID FUNC DOUBLE DOUBLE* DOUBLE* DOUBLE* INT)))
(INT MPOISMIN
     (DOUBLE* DOUBLE* INT DOUBLE* INT INT* INT DOUBLE** DOUBLE**
              DOUBLE* (VOID FUNC DOUBLE DOUBLE* DOUBLE* DOUBLE* INT)
              DOUBLE*))
(INT MPOISCOF
     (DOUBLE* DOUBLE* INT DOUBLE* INT INT* INT DOUBLE** DOUBLE* DOUBLE*
              (VOID FUNC DOUBLE DOUBLE* DOUBLE* DOUBLE* INT)))
(INT POLINT (DOUBLE* DOUBLE* INT DOUBLE DOUBLE* DOUBLE*))
(DOUBLE MIDINF ((DOUBLE FUNC DOUBLE) DOUBLE DOUBLE INT))
(DOUBLE MIDPNT ((DOUBLE FUNC DOUBLE) DOUBLE DOUBLE INT))
(DOUBLE MIDSQL ((DOUBLE FUNC DOUBLE) DOUBLE DOUBLE INT))
(DOUBLE MIDSQU ((DOUBLE FUNC DOUBLE) DOUBLE DOUBLE INT))
(DOUBLE MIDEXP ((DOUBLE FUNC DOUBLE) DOUBLE DOUBLE INT))
(DOUBLE TRAPZD ((DOUBLE FUNC DOUBLE) DOUBLE DOUBLE INT))
(DOUBLE QROMB ((DOUBLE FUNC DOUBLE) DOUBLE DOUBLE))
(DOUBLE QROMO
        ((DOUBLE FUNC DOUBLE) DOUBLE DOUBLE
         (DOUBLE FUNC (DOUBLE FUNC DOUBLE) DOUBLE DOUBLE INT)))
(INT RANDNORB (DOUBLE* INT DOUBLE))
(INT RANDFLATB (DOUBLE* INT DOUBLE))
(INT WDEC2 (DOUBLE* DOUBLE* INT INT))
(INT WDEC2F (FLOAT* FLOAT* INT INT))
(INT WREC2 (DOUBLE* DOUBLE* INT INT))
(DOUBLE AVE (DOUBLE* INT))
(DOUBLE CVAR (DOUBLE* DOUBLE* INT))
(DOUBLE VAR (DOUBLE* INT))
(VOID MEAN_ERR (DOUBLE* INT DOUBLE* DOUBLE*))
(VOID FTEST (DOUBLE* INT DOUBLE* INT DOUBLE* DOUBLE*))
(INT INVERT (DOUBLE** DOUBLE** INT))
(VOID SDIAG (DOUBLE** INT DOUBLE* DOUBLE*))
(INT SPLINE (DOUBLE* DOUBLE* INT DOUBLE DOUBLE DOUBLE*))
(VOID SPLINT (DOUBLE* DOUBLE* DOUBLE* INT DOUBLE DOUBLE*))
(DOUBLE PDGAMMALN (DOUBLE))
(DOUBLE BETAI (DOUBLE DOUBLE DOUBLE))
(DOUBLE PGAMMLN (DOUBLE))
(VOID MNBRAK
      (DOUBLE* DOUBLE* DOUBLE* DOUBLE* DOUBLE* DOUBLE*
               (DOUBLE FUNC DOUBLE)))
(DOUBLE BRENT
        (DOUBLE DOUBLE DOUBLE (DOUBLE FUNC DOUBLE) DOUBLE DOUBLE*))
(INT AMOEBA (DOUBLE** DOUBLE* INT DOUBLE (DOUBLE FUNC DOUBLE*) INT*))
(INT AMOEBA0 (DOUBLE* INT DOUBLE (DOUBLE FUNC DOUBLE*) INT*))
(INT ZBRAC ((DOUBLE FUNC DOUBLE) DOUBLE* DOUBLE*))
(DOUBLE ZBRENT ((DOUBLE FUNC DOUBLE) DOUBLE DOUBLE DOUBLE))
(VOID SET_SEEDB (DOUBLE))
(VOID COVSRT (DOUBLE** INT INT* INT))
(INT BSSTEP
     (DOUBLE* DOUBLE* INT DOUBLE* DOUBLE DOUBLE DOUBLE* DOUBLE* DOUBLE*
              (INT FUNC DOUBLE DOUBLE* DOUBLE*)))
(INT RKQC
     (DOUBLE* DOUBLE* INT DOUBLE* DOUBLE DOUBLE DOUBLE* DOUBLE* DOUBLE*
              (INT FUNC DOUBLE DOUBLE* DOUBLE*)))
(INT ODEINT
     (DOUBLE* INT DOUBLE DOUBLE DOUBLE DOUBLE DOUBLE INT* INT*
              (INT FUNC DOUBLE DOUBLE* DOUBLE*)
              (INT FUNC DOUBLE* DOUBLE* INT DOUBLE* DOUBLE DOUBLE
                   DOUBLE* DOUBLE* DOUBLE*
                   (INT FUNC DOUBLE DOUBLE* DOUBLE*))
              INT DOUBLE* DOUBLE** DOUBLE))
(INT FOUR1 (DOUBLE* INT INT))
(INT REALFT (DOUBLE* INT INT))
(INT RANDNORMT (DOUBLE* INT DOUBLE))
(INT RANDFLATMT (DOUBLE* INT DOUBLE))
...
=============================================================================

Take care,


Dennis Decker Jensen <address@hidden> writes:

> On Tue Jun  8 20:41:24 2004 Dennis Decker Jensen wrote:
> 
>       Camm writes:
>       > The biggest complaint about lisp is the (lack of)
>       > library support, and the idea of reimplementing
>       > everything in lisp appears to me to be a definite
>       > non-starter.  Were such a modular approach to external
>       > C libs attainable, one could dispense with separate
>       > support for xgcl, pargcl, etc. and greatly simplify
>       > future maintenance.
> 
>       That would really rock!!  I know ASDF-install is very
>       dynamic, cool and useful, but having all C libs at
>       your fingertips with more ease than anything else is
>       not only cool, it is a killer feature.
> 
> I just stumbled upon http://www.cliki.net/cparse which is a
> Lisp library for parsing C header files in the context of FFI.
> It understands structs, unions, &c.  The Cliki page mentions
> http://www.gccxml.org as well as nm.  It was made to be used
> with UFFI (CMUCL), but it might not be difficult to modify or
> get an general idea from.  The library was made by Tim Moore.
>  
> Ciao,
> 
> Dennis Decker Jensen
> 
> 
> 

-- 
Camm Maguire                                            address@hidden
==========================================================================
"The earth is but one country, and mankind its citizens."  --  Baha'u'llah