diff options
Diffstat (limited to 'Examples/guile')
38 files changed, 1188 insertions, 0 deletions
diff --git a/Examples/guile/Makefile.in b/Examples/guile/Makefile.in new file mode 100644 index 0000000..a110955 --- /dev/null +++ b/Examples/guile/Makefile.in @@ -0,0 +1,40 @@ +# Makefile for Guile. Used by all of the example programs. + +subdirs = simple matrix port constants multimap multivalue + +top_srcdir = @top_srcdir@ +SWIG = ../$(top_srcdir)/preinst-swig +CC = @CC@ +CXX = @CXX@ +CFLAGS = @PLATFLAGS@ +GUILEINCLUDE = @GUILEINCLUDE@ +GUILELINK = @GUILELINK@ +SWIGOPT = + +WRAP = $(IFILE:.i=_wrap.c) +CXXWRAP = $(IFILE:.i=_wrap.cxx) + +SO = @SO@ + +all: + for d in $(subdirs) ; do (cd $$d ; $(MAKE)) ; done + +clean:: + for d in $(subdirs) ; do (cd $$d ; $(MAKE) clean) ; done + rm -f *~ .~* + +guile_clean: + rm -f *.@OBJEXT@ *$(SO) *_wrap* *~ .~* core my-guile $(TARGET) + +# This is meant to be used w/ "make -f ../Makefile" from subdirs. +# Doesn't make sense to use it from here. + +sub-all:: + $(SWIG) -guile $(SWIGOPT) $(IFILE) + $(CC) $(CFLAGS) -o $(TARGET) $(SRCS) $(WRAP) $(GUILEINCLUDE) $(GUILELINK) + +sub-all-cxx:: + $(SWIG) -c++ -guile $(SWIGOPT) $(IFILE) + $(CXX) $(CFLAGS) -o $(TARGET) $(SRCS) $(CXXWRAP) $(GUILEINCLUDE) $(GUILELINK) + +# Makefile ends here diff --git a/Examples/guile/README b/Examples/guile/README new file mode 100644 index 0000000..acec777 --- /dev/null +++ b/Examples/guile/README @@ -0,0 +1,17 @@ +This directory contains examples for Guile. + +constants -- handling #define and %constant literals +matrix -- a very simple Matrix example +multimap -- typemaps with multiple sub-types +multivalue -- using the %values_as_list directive +port -- scheme ports as temporary FILE streams +simple -- the simple example from the user manual +std_vector -- C++ STL vector<int> and vector<double> + + +Note that the examples in this directory build a special version of +Guile which includes the wrapped functions in the top-level module. + +If you want to put the wrapped functions into an own module, +statically or dynamically linked, see the Examples/GIFPlot/Guile +directory. diff --git a/Examples/guile/check.list b/Examples/guile/check.list new file mode 100644 index 0000000..d35b2d6 --- /dev/null +++ b/Examples/guile/check.list @@ -0,0 +1,7 @@ +# see top-level Makefile.in +constants +matrix +simple +port +multimap +multivalue diff --git a/Examples/guile/constants/Makefile b/Examples/guile/constants/Makefile new file mode 100644 index 0000000..70243c7 --- /dev/null +++ b/Examples/guile/constants/Makefile @@ -0,0 +1,17 @@ +SRCS = +TARGET = my-guile +IFILE = example.i +MKDIR = .. + +all:: + $(MAKE) -f $(MKDIR)/Makefile \ + SRCS='$(SRCS)' \ + TARGET=$(TARGET) \ + IFILE=$(IFILE) \ + sub-all + +clean:: + $(MAKE) -f $(MKDIR)/Makefile TARGET='$(TARGET)' guile_clean + +check: all + ./my-guile -s constants.scm diff --git a/Examples/guile/constants/constants.scm b/Examples/guile/constants/constants.scm new file mode 100644 index 0000000..5220150 --- /dev/null +++ b/Examples/guile/constants/constants.scm @@ -0,0 +1,10 @@ +(or (= (ICONST) 42) (exit 1)) +(or (< (abs (- (FCONST) 2.1828)) 0.00001) (exit 1)) +(or (char=? (CCONST) #\x) (exit 1)) +(or (char=? (CCONST2) #\newline) (exit 1)) +(or (string=? (SCONST) "Hello World") (exit 1)) +(or (string=? (SCONST2) "\"Hello World\"") (exit 1)) +(or (< (abs (- (EXPR) (+ (ICONST) (* 3 (FCONST))))) 0.00001) (exit 1)) +(or (= (iconst) 37) (exit 1)) +(or (< (abs (- (fconst) 3.14)) 0.00001) (exit 1)) +(exit 0) diff --git a/Examples/guile/constants/example.i b/Examples/guile/constants/example.i new file mode 100644 index 0000000..0b602e5 --- /dev/null +++ b/Examples/guile/constants/example.i @@ -0,0 +1,27 @@ +/* File : example.i */ +%module example + +/* A few preprocessor macros */ + +#define ICONST 42 +#define FCONST 2.1828 +#define CCONST 'x' +#define CCONST2 '\n' +#define SCONST "Hello World" +#define SCONST2 "\"Hello World\"" + +/* This should work just fine */ +#define EXPR ICONST + 3*(FCONST) + +/* This shouldn't do anything */ +#define EXTERN extern + +/* Neither should this (BAR isn't defined) */ +#define FOO (ICONST + BAR) + +/* The following directives also produce constants */ + +%constant int iconst = 37; +%constant double fconst = 3.14; + +%include guilemain.i diff --git a/Examples/guile/matrix/Makefile b/Examples/guile/matrix/Makefile new file mode 100644 index 0000000..5df2c65 --- /dev/null +++ b/Examples/guile/matrix/Makefile @@ -0,0 +1,18 @@ +SRCS = matrix.c vector.c +TARGET = matrix +IFILE = package.i +MKDIR = .. + + +all:: + $(MAKE) -f $(MKDIR)/Makefile \ + SRCS='$(SRCS)' \ + TARGET=$(TARGET) \ + IFILE=$(IFILE) \ + MODULE=$(MODULE) \ + sub-all + +clean:: + $(MAKE) -f $(MKDIR)/Makefile TARGET='$(TARGET)' guile_clean + +check: all diff --git a/Examples/guile/matrix/README b/Examples/guile/matrix/README new file mode 100644 index 0000000..dc19577 --- /dev/null +++ b/Examples/guile/matrix/README @@ -0,0 +1,13 @@ +Matrix example. To run the example, execute the program 'matrix' and +type the following : + + (load "matrix.scm") + (do-test 0) + +Alternatively, use the command-line: + + ./matrix -e do-test -s matrix.scm + +Or, if your operating system is spiffy enough: + + ./matrix.scm diff --git a/Examples/guile/matrix/main.c b/Examples/guile/matrix/main.c new file mode 100644 index 0000000..88209ae --- /dev/null +++ b/Examples/guile/matrix/main.c @@ -0,0 +1,24 @@ +#include <tcl.h> +extern int matrix_init(Tcl_Interp *); /* Init function from matrix.i */ + +int main() { + + int code; + char input[1024]; + Tcl_Interp *interp; + + interp = Tcl_CreateInterp(); + + /* Initialize the wrappers */ + + if (matrix_init(interp) == TCL_ERROR) + exit(0); + + fprintf(stdout,"matrix > "); + while(fgets(input, 1024, stdin) != NULL) { + code = Tcl_Eval(interp, input); + fprintf(stdout,"%s\n",interp->result); + fprintf(stdout,"matrix > "); + } +} + diff --git a/Examples/guile/matrix/matrix.c b/Examples/guile/matrix/matrix.c new file mode 100644 index 0000000..6ce1009 --- /dev/null +++ b/Examples/guile/matrix/matrix.c @@ -0,0 +1,61 @@ +/* FILE : matrix.c : some simple 4x4 matrix operations */ +#include <stdlib.h> +#include <stdio.h> + +double **new_matrix() { + + int i; + double **M; + + M = (double **) malloc(4*sizeof(double *)); + M[0] = (double *) malloc(16*sizeof(double)); + + for (i = 0; i < 4; i++) { + M[i] = M[0] + 4*i; + } + return M; +} + +void destroy_matrix(double **M) { + + free(M[0]); + free(M); + +} + +void print_matrix(double **M) { + + int i,j; + + for (i = 0; i < 4; i++) { + for (j = 0; j < 4; j++) { + printf("%10g ", M[i][j]); + } + printf("\n"); + } + +} + +void mat_mult(double **m1, double **m2, double **m3) { + + int i,j,k; + double temp[4][4]; + + for (i = 0; i < 4; i++) + for (j = 0; j < 4; j++) { + temp[i][j] = 0; + for (k = 0; k < 4; k++) + temp[i][j] += m1[i][k]*m2[k][j]; + } + + for (i = 0; i < 4; i++) + for (j = 0; j < 4; j++) + m3[i][j] = temp[i][j]; +} + + + + + + + diff --git a/Examples/guile/matrix/matrix.i b/Examples/guile/matrix/matrix.i new file mode 100644 index 0000000..d61f0dc --- /dev/null +++ b/Examples/guile/matrix/matrix.i @@ -0,0 +1,36 @@ +// +// FILE : matrix.i + +%{ + +void set_m(double **M, int i, int j, double val) { + M[i][j] = val; +} + +double get_m(double **M, int i, int j) { + return M[i][j]; +} +%} + +%inline { +/*** Matrix Operations ***/ + +extern double **new_matrix(); +/* Creates a new matrix and returns a pointer to it */ + +extern void destroy_matrix(double **M); +/* Destroys the matrix M */ + +extern void print_matrix(double **M); +/* Prints out the matrix M */ + +extern void set_m(double **M, int i, int j, double val); +/* Sets M[i][j] = val*/ + +extern double get_m(double **M, int i, int j); +/* Returns M[i][j] */ + +extern void mat_mult(double **a, double **b, double **c); +/* Multiplies matrix a by b and places the result in c*/ + +} diff --git a/Examples/guile/matrix/matrix.scm b/Examples/guile/matrix/matrix.scm new file mode 100644 index 0000000..18e5284 --- /dev/null +++ b/Examples/guile/matrix/matrix.scm @@ -0,0 +1,210 @@ +#!./matrix \ +-e do-test -s +!# +;;; Authors: David Beazley <beazley@cs.uchicago.edu>, 1999 +;;; Martin Froehlich <MartinFroehlich@ACM.org>, 2000 +;;; +;;; PURPOSE OF THIS FILE: This file is an example for how to use the guile +;;; scripting options with a little more than trivial script. Example +;;; derived from David Beazley's matrix evaluation example. David +;;; Beazley's annotation: >>Guile script for testing out matrix +;;; operations. Disclaimer : I'm not a very good scheme +;;; programmer<<. Martin Froehlich's annotation: >>I'm not a very good +;;; scheme programmer, too<<. +;;; +;;; Explanation: The three lines at the beginning of this script are +;;; telling the kernel to load the enhanced guile interpreter named +;;; "matrix"; to execute the function "do-test" (-e option) after loading +;;; this script (-s option). There are a lot more options wich allow for +;;; even finer tuning. SEE ALSO: Section "Guile Scripts" in the "Guile +;;; reference manual -- Part I: Preliminaries". +;;; +;;; +;;; This program is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + +;;; Create a zero matrix + +(define (zero M) + (define (zero-loop M i j) + (if (< i 4) + (if (< j 4) (begin + (set-m M i j 0.0) + (zero-loop M i (+ j 1))) + (zero-loop M (+ i 1) 0)))) + (zero-loop M 0 0)) + +;;; Create an identity matrix + +(define (identity M) + (define (iloop M i) + (if (< i 4) (begin + (set-m M i i 1.0) + (iloop M (+ i 1))))) + (zero M) + (iloop M 0)) + +;;; Rotate around x axis + +(define (rotx M r) + (define temp (new-matrix)) + (define rd (/ (* r 3.14159) 180.0)) + (zero temp) + (set-m temp 0 0 1.0) + (set-m temp 1 1 (cos rd)) + (set-m temp 1 2 (- 0 (sin rd))) + (set-m temp 2 1 (sin rd)) + (set-m temp 2 2 (cos rd)) + (set-m temp 3 3 1.0) + (mat-mult M temp M) + (destroy-matrix temp)) + +;;; Rotate around y axis + +(define (roty M r) + (define temp (new-matrix)) + (define rd (/ (* r 3.14159) 180.0)) + (zero temp) + (set-m temp 1 1 1.0) + (set-m temp 0 0 (cos rd)) + (set-m temp 0 2 (sin rd)) + (set-m temp 2 0 (- 0 (sin rd))) + (set-m temp 2 2 (cos rd)) + (set-m temp 3 3 1.0) + (mat-mult M temp M) + (destroy-matrix temp)) + +;;; Rotate around z axis + +(define (rotz M r) + (define temp (new-matrix)) + (define rd (/ (* r 3.14159) 180.0)) + (zero temp) + (set-m temp 0 0 (cos rd)) + (set-m temp 0 1 (- 0 (sin rd))) + (set-m temp 1 0 (sin rd)) + (set-m temp 1 1 (cos rd)) + (set-m temp 2 2 1.0) + (set-m temp 3 3 1.0) + (mat-mult M temp M) + (destroy-matrix temp)) + +;;; Scale a matrix + +(define (scale M s) + (define temp (new-matrix)) + (define (sloop m i s) + (if (< i 4) (begin + (set-m m i i s) + (sloop m (+ i 1) s)))) + (zero temp) + (sloop temp 0 s) + (mat-mult M temp M) + (destroy-matrix temp)) + +;;; Make a matrix with random elements + +(define (randmat M) + (define (rand-loop M i j) + (if (< i 4) + (if (< j 4) + (begin + (set-m M i j (drand48)) + (rand-loop M i (+ j 1))) + (rand-loop M (+ i 1) 0)))) + (rand-loop M 0 0)) + +;;; stray definitions collected here + +(define (rot-test M v t i) + (if (< i 360) (begin + (rotx M 1) + (rotz M -0.5) + (transform M v t) + (rot-test M v t (+ i 1))))) + +(define (create-matrix) ; Create some matrices + (let loop ((i 0) (result '())) + (if (< i 200) + (loop (+ i 1) (cons (new-matrix) result)) + result))) + +(define (add-mat M ML) + (define (add-two m1 m2 i j) + (if (< i 4) + (if (< j 4) + (begin + (set-m m1 i j (+ (get-m m1 i j) (get-m m2 i j))) + (add-two m1 m2 i (+ j 1))) + (add-two m1 m2 (+ i 1) 0)))) + (if (null? ML) () (begin + (add-two M (car ML) 0 0) + (add-mat M (cdr ML))))) + +(define (cleanup ML) + (if (null? ML) () (begin + (destroy-matrix (car ML)) + (cleanup (cdr ML))))) + +(define (make-random ML) ; Put random values in them + (if (null? ML) () (begin + (randmat (car ML)) + (make-random (cdr ML))))) + +(define (mul-mat m ML) + (if (null? ML) () (begin + (mat-mult m (car ML) m) + (mul-mat m (cdr ML))))) + +;;; Now we'll hammer on things a little bit just to make +;;; sure everything works. +(define M1 (new-matrix)) ; a matrix +(define v (createv 1 2 3 4)) ; a vector +(define t (createv 0 0 0 0)) ; the zero-vector +(define M-list (create-matrix)) ; get list of marices +(define M (new-matrix)) ; yet another matrix + +(display "variables defined\n") +(define (do-test x) + (display "Testing matrix program...\n") + + (identity M1) + (print-matrix M1) + (display "Rotate-x 45 degrees\n") + (rotx M1 45) + (print-matrix M1) + (display "Rotate y 30 degrees\n") + (roty M1 30) + (print-matrix M1) + (display "Rotate z 15 degrees\n") + (rotz M1 15) + (print-matrix M1) + (display "Scale 0.5\n") + (scale M1 0.5) + (print-matrix M1) + + ;; Rotating ... + (display "Rotating...\n") + (rot-test M1 v t 0) + (printv t) + + (make-random M-list) + + (zero M1) + + (display "Adding them together (in Guile)\n") + + (add-mat M1 M-list) + (print-matrix M1) + + (display "Doing 200 multiplications (mostly in C)\n") + (randmat M) + + (mul-mat M M-list) + + (display "Cleaning up\n") + + (cleanup M-list)) + +;;; matrix.scm ends here diff --git a/Examples/guile/matrix/package.i b/Examples/guile/matrix/package.i new file mode 100644 index 0000000..aaa5551 --- /dev/null +++ b/Examples/guile/matrix/package.i @@ -0,0 +1,20 @@ +// FILE : package.i +// See the SWIG users manual + +/*** Matrix and vector package ***/ + +%module Matrix +%{ +#include <math.h> +%} + +%include guilemain.i +%include matrix.i +%include vector.i + +// Include the math library so we can get some random numbers and +// other stuff + +%include math.i + +extern double drand48(); diff --git a/Examples/guile/matrix/vector.c b/Examples/guile/matrix/vector.c new file mode 100644 index 0000000..3012993 --- /dev/null +++ b/Examples/guile/matrix/vector.c @@ -0,0 +1,44 @@ +/* File : vector.c */ + +#include <stdlib.h> +#include <stdio.h> +#include "vector.h" + +Vector *createv(double x, double y, double z, double w) { + + Vector *n; + n = (Vector *) malloc(sizeof(Vector)); + n->x = x; + n->y = y; + n->z = z; + n->w = w; + return n; + +} + +/* Destroy vector */ + +void destroyv(Vector *v) { + free(v); +} + +/* Print a vector */ + +void printv(Vector *v) { + + printf("x = %g, y = %g, z = %g, w = %g\n", v->x, v->y, v->z, v->w); + +} + +/* Do a transformation */ +void transform(double **m, Vector *v, Vector *r) { + + r->x = m[0][0]*v->x + m[0][1]*v->y + m[0][2]*v->z + m[0][3]*v->w; + r->y = m[1][0]*v->x + m[1][1]*v->y + m[1][2]*v->z + m[1][3]*v->w; + r->z = m[2][0]*v->x + m[2][1]*v->y + m[2][2]*v->z + m[2][3]*v->w; + r->w = m[3][0]*v->x + m[3][1]*v->y + m[3][2]*v->z + m[3][3]*v->w; + +} + + + diff --git a/Examples/guile/matrix/vector.h b/Examples/guile/matrix/vector.h new file mode 100644 index 0000000..a6b5f35 --- /dev/null +++ b/Examples/guile/matrix/vector.h @@ -0,0 +1,10 @@ + +#include <math.h> + +typedef struct { + double x; + double y; + double z; + double w; +} Vector; + diff --git a/Examples/guile/matrix/vector.i b/Examples/guile/matrix/vector.i new file mode 100644 index 0000000..b6c2ef9 --- /dev/null +++ b/Examples/guile/matrix/vector.i @@ -0,0 +1,22 @@ +// +// FILE : vector.i + +%{ +#include "vector.h" +%} + +%inline { + +extern Vector *createv(double x,double y,double z,double w); +/* Creates a new vector v(x,y,z,w) */ + +extern void destroyv(Vector *v); +/* Destroys the vector v */ + +extern void printv(Vector *v); +/* Prints out the vector v */ + +extern void transform(double **T, Vector *v, Vector *t); +/* Transforms vector c to vector t by M*v --> t */ + +} diff --git a/Examples/guile/multimap/Makefile b/Examples/guile/multimap/Makefile new file mode 100644 index 0000000..dc9c66d --- /dev/null +++ b/Examples/guile/multimap/Makefile @@ -0,0 +1,18 @@ +TOP = ../.. +SWIG = $(TOP)/../preinst-swig +SRCS = example.c +TARGET = example +INTERFACE = example.i + +all:: + $(MAKE) -f $(TOP)/Makefile SRCS='$(SRCS)' SWIG='$(SWIG)' \ + TARGET='$(TARGET)' INTERFACE='$(INTERFACE)' guile + +static:: + $(MAKE) -f $(TOP)/Makefile SRCS='$(SRCS)' SWIG='$(SWIG)' \ + TARGET='my-guile' INTERFACE='$(INTERFACE)' guile_static + +clean:: + $(MAKE) -f $(TOP)/Makefile TARGET='$(TARGET)' guile_clean + +check: all diff --git a/Examples/guile/multimap/example.c b/Examples/guile/multimap/example.c new file mode 100644 index 0000000..b8360fa --- /dev/null +++ b/Examples/guile/multimap/example.c @@ -0,0 +1,53 @@ +/* File : example.c */ +#include <stdio.h> +#include <stdlib.h> +#include <ctype.h> + +/* Compute the greatest common divisor of positive integers */ +int gcd(int x, int y) { + int g; + g = y; + while (x > 0) { + g = x; + x = y % x; + y = g; + } + return g; +} + +int gcdmain(int argc, char *argv[]) { + int x,y; + if (argc != 3) { + printf("usage: gcd x y\n"); + return -1; + } + x = atoi(argv[1]); + y = atoi(argv[2]); + printf("gcd(%d,%d) = %d\n", x,y,gcd(x,y)); + return 0; +} + +int count(char *bytes, int len, char c) { + int i; + int count = 0; + for (i = 0; i < len; i++) { + if (bytes[i] == c) count++; + } + return count; +} + +void capitalize(char *str, int len) { + int i; + for (i = 0; i < len; i++) { + str[i] = (char)toupper(str[i]); + } +} + +void circle(double x, double y) { + double a = x*x + y*y; + if (a > 1.0) { + printf("Bad points %g, %g\n", x,y); + } else { + printf("Good points %g, %g\n", x,y); + } +} diff --git a/Examples/guile/multimap/example.i b/Examples/guile/multimap/example.i new file mode 100644 index 0000000..7337d1e --- /dev/null +++ b/Examples/guile/multimap/example.i @@ -0,0 +1,87 @@ +/* File : example.i */ +%module example + +%{ +extern int gcd(int x, int y); +extern int gcdmain(int argc, char *argv[]); +extern int count(char *bytes, int len, char c); +extern void capitalize (char *str, int len); +extern void circle (double cx, double cy); +extern int squareCubed (int n, int *OUTPUT); +%} + +%include exception.i +%include typemaps.i + +extern int gcd(int x, int y); + +%typemap(in) (int argc, char *argv[]) { + int i; + SCM *v; + if (!(SCM_NIMP($input) && SCM_VECTORP($input))) { + SWIG_exception(SWIG_ValueError, "Expecting a vector"); + return 0; + } + $1 = SCM_LENGTH($input); + if ($1 == 0) { + SWIG_exception(SWIG_ValueError, "Vector must contain at least 1 element"); + } + $2 = (char **) malloc(($1+1)*sizeof(char *)); + v = SCM_VELTS($input); + for (i = 0; i < $1; i++) { + if (!(SCM_NIMP(v[i]) && SCM_STRINGP(v[i]))) { + free($2); + SWIG_exception(SWIG_ValueError, "Vector items must be strings"); + return 0; + } + $2[i] = SCM_CHARS(v[i]); + } + $2[i] = 0; +} + +%typemap(freearg) (int argc, char *argv[]) { + free($2); +} + +extern int gcdmain(int argc, char *argv[]); + +%typemap(in) (char *bytes, int len) { + if (!(SCM_NIMP($input) && SCM_STRINGP($input))) { + SWIG_exception(SWIG_ValueError, "Expecting a string"); + } + $1 = SCM_CHARS($input); + $2 = SCM_LENGTH($input); +} + +extern int count(char *bytes, int len, char c); + +/* This example shows how to wrap a function that mutates a string */ + +%typemap(in) (char *str, int len) { + size_t temp; + $1 = gh_scm2newstr($input,&temp); + $2 = temp; +} + +/* Return the mutated string as a new object. */ + +%typemap(argout) (char *str, int len) { + SWIG_APPEND_VALUE(gh_str2scm($1,$2)); + if ($1) scm_must_free($1); +} + +extern void capitalize(char *str, int len); + +/* A multi-valued constraint. Force two arguments to lie + inside the unit circle */ + +%typemap(check) (double cx, double cy) { + double a = $1*$1 + $2*$2; + if (a > 1.0) { + SWIG_exception(SWIG_ValueError,"$1_name and $2_name must be in unit circle"); + } +} + +extern void circle(double cx, double cy); + + diff --git a/Examples/guile/multimap/runme.scm b/Examples/guile/multimap/runme.scm new file mode 100644 index 0000000..edc1972 --- /dev/null +++ b/Examples/guile/multimap/runme.scm @@ -0,0 +1,30 @@ +;;; Test out some multi-argument typemaps + +(use-modules (example)) + +; Call the GCD function + +(define x 42) +(define y 105) +(define g (gcd x y)) + +(display "The gcd of ") +(display x) +(display " and ") +(display y) +(display " is ") +(display g) +(newline) + +; Call the gcdmain() function +(gcdmain #("gcdmain" "42" "105")) + +; Call the count function +(display (count "Hello World" #\l)) +(newline) + +; Call the capitalize function +(display (capitalize "hello world")) +(newline) + + diff --git a/Examples/guile/multivalue/Makefile b/Examples/guile/multivalue/Makefile new file mode 100644 index 0000000..dc9c66d --- /dev/null +++ b/Examples/guile/multivalue/Makefile @@ -0,0 +1,18 @@ +TOP = ../.. +SWIG = $(TOP)/../preinst-swig +SRCS = example.c +TARGET = example +INTERFACE = example.i + +all:: + $(MAKE) -f $(TOP)/Makefile SRCS='$(SRCS)' SWIG='$(SWIG)' \ + TARGET='$(TARGET)' INTERFACE='$(INTERFACE)' guile + +static:: + $(MAKE) -f $(TOP)/Makefile SRCS='$(SRCS)' SWIG='$(SWIG)' \ + TARGET='my-guile' INTERFACE='$(INTERFACE)' guile_static + +clean:: + $(MAKE) -f $(TOP)/Makefile TARGET='$(TARGET)' guile_clean + +check: all diff --git a/Examples/guile/multivalue/example.c b/Examples/guile/multivalue/example.c new file mode 100644 index 0000000..c9ebad1 --- /dev/null +++ b/Examples/guile/multivalue/example.c @@ -0,0 +1,18 @@ +void divide_l(int a, int b, int *quotient_p, int *remainder_p) +{ + *quotient_p = a/b; + *remainder_p = a%b; +} + +void divide_v(int a, int b, int *quotient_p, int *remainder_p) +{ + *quotient_p = a/b; + *remainder_p = a%b; +} + +void divide_mv(int a, int b, int *quotient_p, int *remainder_p) +{ + *quotient_p = a/b; + *remainder_p = a%b; +} + diff --git a/Examples/guile/multivalue/example.i b/Examples/guile/multivalue/example.i new file mode 100644 index 0000000..1353894 --- /dev/null +++ b/Examples/guile/multivalue/example.i @@ -0,0 +1,32 @@ +/* -*- c -*- */ + +%module example; + +%{ +void divide_l(int a, int b, int *quotient_p, int *remainder_p); +void divide_v(int a, int b, int *quotient_p, int *remainder_p); +void divide_mv(int a, int b, int *quotient_p, int *remainder_p); +%} + +/* Multiple values as lists. By default, if more than one value is to +be returned, a list of the values is created and returned; to switch +back to this behavior, use: */ +%values_as_list; + +void divide_l(int a, int b, int *OUTPUT, int *OUTPUT); + +/* Multiple values as vectors. By issueing: */ +%values_as_vector; +/* vectors instead of lists will be used. */ + +void divide_v(int a, int b, int *OUTPUT, int *OUTPUT); + +/* Multiple values for multiple-value continuations. + (This is the most elegant way.) By issueing: */ +%multiple_values; +/* multiple values are passed to the multiple-value + continuation, as created by `call-with-values' or the + convenience macro `receive'. (See the Scheme file.) */ + +void divide_mv(int a, int b, int *OUTPUT, int *OUTPUT); + diff --git a/Examples/guile/multivalue/runme.scm b/Examples/guile/multivalue/runme.scm new file mode 100644 index 0000000..73eb5af --- /dev/null +++ b/Examples/guile/multivalue/runme.scm @@ -0,0 +1,66 @@ +;;;; Show the three different ways to deal with multiple return values + +(use-modules (example)) + +;;; Multiple values as lists. By default, if more than one value is to +;;; be returned, a list of the values is created and returned. The +;;; procedure divide-l does so: + +(let* ((quotient/remainder (divide-l 37 5)) + ;; divide-l returns a list of the two values, so get them: + (quotient (car quotient/remainder)) + (remainder (cadr quotient/remainder))) + (display "37 divided by 5 is ") + (display quotient) + (display ", remainder ") + (display remainder) + (newline)) + +;;; Multiple values as vectors. You can get vectors instead of lists +;;; if you want: + +(let* ((quotient-remainder-vector (divide-v 40 7)) + ;; divide-v returns a vector of two values, so get them: + (quotient (vector-ref quotient-remainder-vector 0)) + (remainder (vector-ref quotient-remainder-vector 1))) + (display "40 divided by 7 is ") + (display quotient) + (display ", remainder ") + (display remainder) + (newline)) + +;;; Multiple values for multiple-value continuations. (The most +;;; elegant way.) You can get multiple values passed to the +;;; multiple-value continuation, as created by `call-with-values'. + +(call-with-values (lambda () + ;; the "producer" procedure + (divide-mv 91 13)) + (lambda (quotient remainder) + ;; the "consumer" procedure + (display "91 divided by 13 is ") + (display quotient) + (display ", remainder ") + (display remainder) + (newline))) + +;;; SRFI-8 has a very convenient macro for this construction: + +(use-modules (srfi srfi-8)) + +;;; If your Guile is too old, you can define the receive macro yourself: +;;; +;;; (define-macro (receive vars vals . body) +;;; `(call-with-values (lambda () ,vals) +;;; (lambda ,vars ,@body))) + +(receive (quotient remainder) + (divide-mv 111 19) ; the "producer" form + ;; In the body, `quotient' and `remainder' are bound to the two + ;; values. + (display "111 divided by 19 is ") + (display quotient) + (display ", remainder ") + (display remainder) + (newline)) + diff --git a/Examples/guile/port/Makefile b/Examples/guile/port/Makefile new file mode 100644 index 0000000..824f3f8 --- /dev/null +++ b/Examples/guile/port/Makefile @@ -0,0 +1,18 @@ +SRCS = port.c +TARGET = port +IFILE = port.i +MKDIR = .. + + +all:: + $(MAKE) -f $(MKDIR)/Makefile \ + SRCS='$(SRCS)' \ + TARGET=$(TARGET) \ + IFILE=$(IFILE) \ + MODULE=$(MODULE) \ + sub-all + +clean:: + $(MAKE) -f $(MKDIR)/Makefile TARGET='$(TARGET)' guile_clean + +check: all diff --git a/Examples/guile/port/README b/Examples/guile/port/README new file mode 100644 index 0000000..5ed0199 --- /dev/null +++ b/Examples/guile/port/README @@ -0,0 +1,2 @@ +This example illustrates the translation from Scheme file ports to +temporary FILE streams. Read the source and run ./port -s port.scm diff --git a/Examples/guile/port/port.c b/Examples/guile/port/port.c new file mode 100644 index 0000000..95867b6 --- /dev/null +++ b/Examples/guile/port/port.c @@ -0,0 +1,18 @@ +#include <stdio.h> +#include <errno.h> + +void print_int(FILE *f, int i) +{ + if (fprintf(f, "%d\n", i)<0) + perror("print_int"); +} + +int read_int(FILE *f) +{ + int i; + if (fscanf(f, "%d", &i)!=1) { + fprintf(stderr, "read_int: error reading from file\n"); + perror("read_int"); + } + return i; +} diff --git a/Examples/guile/port/port.i b/Examples/guile/port/port.i new file mode 100644 index 0000000..eb75391 --- /dev/null +++ b/Examples/guile/port/port.i @@ -0,0 +1,15 @@ +%module port + +%include guilemain.i + +/* Include the required FILE * typemaps */ +%include ports.i + +%{ +#include <stdio.h> +%} + +%inline %{ +void print_int(FILE *f, int i); +int read_int(FILE *f); +%} diff --git a/Examples/guile/port/port.scm b/Examples/guile/port/port.scm new file mode 100644 index 0000000..68e9b8e --- /dev/null +++ b/Examples/guile/port/port.scm @@ -0,0 +1,32 @@ +;; Call with standard output +(print-int (current-output-port) 314159) + +;; Redirection to a file. Note that the port is automatically flushed +;; (via force-output) before calling the C function, and that the C +;; function gets a temporary "FILE" stream, which is closed after the +;; call. So you can simply mix Scheme and C output. +(with-output-to-file "test.out" + (lambda () + (display 4711) + (newline) + (print-int (current-output-port) 314159) + (display 815) + (newline))) + +;; Redirection to a string or soft port won't work -- +;; we can only handle file ports. +(catch #t + (lambda () + (with-output-to-string + (lambda () + (print-int (current-output-port) 314159)))) + (lambda args + (write args) (newline))) + +;; Read from a file port. Note that it is a bad idea to mix Scheme and +;; C input because of buffering. +(with-input-from-file "test.out" + (lambda () + (display (read-int (current-input-port))) + (newline))) + diff --git a/Examples/guile/simple/Makefile b/Examples/guile/simple/Makefile new file mode 100644 index 0000000..702b5bb --- /dev/null +++ b/Examples/guile/simple/Makefile @@ -0,0 +1,19 @@ +SRCS = example.c +TARGET = my-guile +IFILE = example.i +MKDIR = .. + +all: $(TARGET) + +$(TARGET): + $(MAKE) -f $(MKDIR)/Makefile \ + SRCS='$(SRCS)' \ + TARGET=$(TARGET) \ + IFILE=$(IFILE) \ + sub-all + +clean:: + $(MAKE) -f $(MKDIR)/Makefile TARGET='$(TARGET)' guile_clean + +check: $(TARGET) + ./$(TARGET) -s example.scm > /dev/null diff --git a/Examples/guile/simple/README b/Examples/guile/simple/README new file mode 100644 index 0000000..982216e --- /dev/null +++ b/Examples/guile/simple/README @@ -0,0 +1,9 @@ +A very simple example. + +To run it, start the program 'my-guile' and type: + + (load "example.scm") + +Alternatively, you can use the shell command: + + ./my-guile -s example.scm diff --git a/Examples/guile/simple/example.c b/Examples/guile/simple/example.c new file mode 100644 index 0000000..dcafc4d --- /dev/null +++ b/Examples/guile/simple/example.c @@ -0,0 +1,21 @@ +/* Simple example from documentation */ +/* File : example.c */ + +#include <time.h> + +double My_variable = 3.0; + +int fact(int n) { + if (n <= 1) return 1; + else return n*fact(n-1); +} + +int mod(int n, int m) { + return (n % m); +} + +char *get_time() { + long ltime; + time(<ime); + return ctime(<ime); +} diff --git a/Examples/guile/simple/example.i b/Examples/guile/simple/example.i new file mode 100644 index 0000000..1a9930a --- /dev/null +++ b/Examples/guile/simple/example.i @@ -0,0 +1,14 @@ +/* File : example.i */ +%module Example +%{ +/* Put headers and other declarations here */ +%} + +%inline %{ +extern double My_variable; +extern int fact(int); +extern int mod(int n, int m); +extern char *get_time(); +%} + +%include guile/guilemain.i diff --git a/Examples/guile/simple/example.scm b/Examples/guile/simple/example.scm new file mode 100644 index 0000000..9408b1a --- /dev/null +++ b/Examples/guile/simple/example.scm @@ -0,0 +1,28 @@ +;;; example.scm + +(define (mdisplay-newline . args) ; does guile-1.3.4 have `format #t'? + (for-each display args) + (newline)) + +(mdisplay-newline (get-time) "My variable = " (My-variable)) + +(do ((i 0 (1+ i))) + ((= 14 i)) + (mdisplay-newline i " factorial is " (fact i))) + +(define (mods i imax j jmax) + (if (< i imax) + (if (< j jmax) + (begin + (My-variable (+ (My-variable) (mod i j))) + (mods i imax (+ j 1) jmax)) + (mods (+ i 1) imax 1 jmax)))) + +(mods 1 150 1 150) + +(mdisplay-newline "My-variable = " (My-variable)) + +(exit (and (= 1932053504 (fact 13)) + (= 745470.0 (My-variable)))) + +;;; example.scm ends here diff --git a/Examples/guile/std_vector/Makefile b/Examples/guile/std_vector/Makefile new file mode 100644 index 0000000..2733fb0 --- /dev/null +++ b/Examples/guile/std_vector/Makefile @@ -0,0 +1,18 @@ +TOP = ../.. +SWIG = $(TOP)/../preinst-swig +SRCS = +TARGET = example +INTERFACE = example.i + +all:: + $(MAKE) -f $(TOP)/Makefile SRCS='$(SRCS)' SWIG='$(SWIG)' \ + TARGET='$(TARGET)' INTERFACE='$(INTERFACE)' guile_cpp + +static:: + $(MAKE) -f $(TOP)/Makefile SRCS='$(SRCS)' SWIG='$(SWIG)' \ + TARGET='my-guile' INTERFACE='$(INTERFACE)' guile_static_cpp + +clean:: + $(MAKE) -f $(TOP)/Makefile TARGET='$(TARGET)' guile_clean + +check: all diff --git a/Examples/guile/std_vector/example.h b/Examples/guile/std_vector/example.h new file mode 100644 index 0000000..4f0dac7 --- /dev/null +++ b/Examples/guile/std_vector/example.h @@ -0,0 +1,25 @@ +/* File : example.h */ + +#include <vector> +#include <algorithm> +#include <functional> +#include <numeric> + +double average(std::vector<int> v) { + return std::accumulate(v.begin(),v.end(),0.0)/v.size(); +} + +std::vector<double> half(const std::vector<double>& v) { + std::vector<double> w(v); + for (unsigned int i=0; i<w.size(); i++) + w[i] /= 2.0; + return w; +} + +void halve_in_place(std::vector<double>& v) { + // would you believe this is the same as the above? + std::transform(v.begin(),v.end(),v.begin(), + std::bind2nd(std::divides<double>(),2.0)); +} + + diff --git a/Examples/guile/std_vector/example.i b/Examples/guile/std_vector/example.i new file mode 100644 index 0000000..aa58b66 --- /dev/null +++ b/Examples/guile/std_vector/example.i @@ -0,0 +1,17 @@ +/* File : example.i */ +%module example + +%{ +#include "example.h" +%} + +%include stl.i +/* instantiate the required template specializations */ +namespace std { + %template(IntVector) vector<int>; + %template(DoubleVector) vector<double>; +} + +/* Let's just grab the original header file here */ +%include "example.h" + diff --git a/Examples/guile/std_vector/runme.scm b/Examples/guile/std_vector/runme.scm new file mode 100644 index 0000000..77443a1 --- /dev/null +++ b/Examples/guile/std_vector/runme.scm @@ -0,0 +1,54 @@ +;; run with mzscheme -r example.scm + +(use-modules (example)) + +; repeatedly invoke a procedure with v and an index as arguments +(define (with-vector v proc size-proc) + (let ((size (size-proc v))) + (define (with-vector-item v i) + (if (< i size) + (begin + (proc v i) + (with-vector-item v (+ i 1))))) + (with-vector-item v 0))) + +(define (with-IntVector v proc) + (with-vector v proc IntVector-length)) +(define (with-DoubleVector v proc) + (with-vector v proc DoubleVector-length)) + +(define (print-DoubleVector v) + (with-DoubleVector v (lambda (v i) (display (DoubleVector-ref v i)) + (display " "))) + (newline)) + + +; Call average with a Scheme list... + +(display (average '(1 2 3 4))) +(newline) + +; ... or a wrapped std::vector<int> +(define v (new-IntVector 4)) +(with-IntVector v (lambda (v i) (IntVector-set! v i (+ i 1)))) +(display (average v)) +(newline) +(delete-IntVector v) + +; half will return a Scheme vector. +; Call it with a Scheme vector... + +(display (half #(1 1.5 2 2.5 3))) +(newline) + +; ... or a wrapped std::vector<double> +(define v (new-DoubleVector)) +(map (lambda (i) (DoubleVector-push! v i)) '(1 2 3 4)) +(display (half v)) +(newline) + +; now halve a wrapped std::vector<double> in place +(halve-in-place v) +(print-DoubleVector v) +(delete-DoubleVector v) + |