1/* Define a C preprocessor symbol that can be used in interface files 2 to distinguish between the SWIG language modules. */ 3 4#define SWIG_ALLEGRO_CL 5 6#define %ffargs(...) %feature("ffargs", "1", ##__VA_ARGS__) 7%ffargs(strings_convert="t"); 8 9/* typemaps for argument and result type conversions. */ 10%typemap(lin,numinputs=1) SWIGTYPE "(cl::let (($out $in))\n $body)"; 11 12%typemap(lout) bool, char, unsigned char, signed char, 13 short, signed short, unsigned short, 14 int, signed int, unsigned int, 15 long, signed long, unsigned long, 16 float, double, long double, char *, void *, 17 enum SWIGTYPE "(cl::setq ACL_ffresult $body)"; 18%typemap(lout) void "$body"; 19%typemap(lout) SWIGTYPE[ANY], SWIGTYPE *, 20 SWIGTYPE & 21%{ (cl:let* ((address $body) 22 (new-inst (cl:make-instance '$lclass :foreign-address address))) 23 (cl:when (cl:and $owner (cl:not (cl:zerop address))) 24 (excl:schedule-finalization new-inst #'$ldestructor)) 25 (cl:setq ACL_ffresult new-inst)) %} 26 27%typemap(lout) SWIGTYPE "(cl::let* ((address $body)\n (new-inst (cl::make-instance '$lclass :foreign-address address)))\n (cl::unless (cl::zerop address)\n (excl:schedule-finalization new-inst #'$ldestructor))\n (cl::setq ACL_ffresult new-inst))"; 28 29%typemap(lisptype) bool, const bool "cl:boolean"; 30%typemap(lisptype) char, const char "cl:character"; 31%typemap(lisptype) unsigned char, const unsigned char "cl:integer"; 32%typemap(lisptype) signed char, const signed char "cl:integer"; 33 34%typemap(ffitype) bool, const bool ":int"; 35%typemap(ffitype) char, const char, 36 signed char, const signed char ":char"; 37%typemap(ffitype) unsigned char, const unsigned char ":unsigned-char"; 38%typemap(ffitype) short, const short, 39 signed short, const signed short ":short"; 40%typemap(ffitype) unsigned short, const unsigned short ":unsigned-short"; 41%typemap(ffitype) int, const int, signed int, const signed int ":int"; 42%typemap(ffitype) unsigned int, const unsigned int ":unsigned-int"; 43%typemap(ffitype) long, const long, signed long, const signed long ":long"; 44%typemap(ffitype) unsigned long, const unsigned long ":unsigned-long"; 45%typemap(ffitype) float, const float ":float"; 46%typemap(ffitype) double, const double ":double"; 47%typemap(ffitype) char *, const char *, signed char *, 48 const signed char *, signed char &, 49 const signed char & "(* :char)"; 50%typemap(ffitype) unsigned char *, const unsigned char *, 51 unsigned char &, const unsigned char & "(* :unsigned-char)"; 52%typemap(ffitype) short *, const short *, short &, 53 const short & "(* :short)"; 54%typemap(ffitype) unsigned short *, const unsigned short *, 55 unsigned short &, const unsigned short & "(* :unsigned-short)"; 56%typemap(ffitype) int *, const int *, int &, const int & "(* :int)"; 57%typemap(ffitype) unsigned int *, const unsigned int *, 58 unsigned int &, const unsigned int & "(* :unsigned-int)"; 59%typemap(ffitype) void * "(* :void)"; 60%typemap(ffitype) void ":void"; 61%typemap(ffitype) enum SWIGTYPE ":int"; 62%typemap(ffitype) SWIGTYPE & "(* :void)"; 63 64/* const typemaps 65idea: marshall all primitive c types to their respective lisp types 66to maintain const corretness. For pointers/references, all bets 67are off if you try to modify them. 68 69idea: add a constant-p slot to the base foreign-pointer class. For 70constant pointer/references check this value when setting (around method?) 71and error if a setf operation is performed on the address of this object. 72 73*/ 74 75/* 76%exception %{ 77 try { 78 $action 79 } catch (...) { 80 return $null; 81 } 82%} 83 84*/ 85 86// %typemap(throws) SWIGTYPE { 87// (void)$1; 88// SWIG_fail; 89// } 90 91%typemap(ctype) bool, const bool "int"; 92%typemap(ctype) char, unsigned char, signed char, 93 short, signed short, unsigned short, 94 int, signed int, unsigned int, 95 long, signed long, unsigned long, 96 float, double, long double, char *, void *, void, 97 enum SWIGTYPE, SWIGTYPE *, SWIGTYPE[], 98 SWIGTYPE[ANY], SWIGTYPE &, const SWIGTYPE "$1_ltype"; 99%typemap(ctype) SWIGTYPE "$&1_type"; 100 101%typemap(in) bool "$1 = (bool)$input;"; 102%typemap(in) char, unsigned char, signed char, 103 short, signed short, unsigned short, 104 int, signed int, unsigned int, 105 long, signed long, unsigned long, 106 float, double, long double, char *, void *, void, 107 enum SWIGTYPE, SWIGTYPE *, SWIGTYPE[], 108 SWIGTYPE[ANY], SWIGTYPE & "$1 = $input;"; 109%typemap(in) SWIGTYPE "$1 = *$input;"; 110 111/* We don't need to do any actual C-side typechecking, but need to 112 use the precedence values to choose which overloaded function 113 interfaces to generate when conflicts arise. */ 114 115/* predefined precedence values 116 117Symbolic Name Precedence Value 118------------------------------ ------------------ 119SWIG_TYPECHECK_POINTER 0 120SWIG_TYPECHECK_VOIDPTR 10 121SWIG_TYPECHECK_BOOL 15 122SWIG_TYPECHECK_UINT8 20 123SWIG_TYPECHECK_INT8 25 124SWIG_TYPECHECK_UINT16 30 125SWIG_TYPECHECK_INT16 35 126SWIG_TYPECHECK_UINT32 40 127SWIG_TYPECHECK_INT32 45 128SWIG_TYPECHECK_UINT64 50 129SWIG_TYPECHECK_INT64 55 130SWIG_TYPECHECK_UINT128 60 131SWIG_TYPECHECK_INT128 65 132SWIG_TYPECHECK_INTEGER 70 133SWIG_TYPECHECK_FLOAT 80 134SWIG_TYPECHECK_DOUBLE 90 135SWIG_TYPECHECK_COMPLEX 100 136SWIG_TYPECHECK_UNICHAR 110 137SWIG_TYPECHECK_UNISTRING 120 138SWIG_TYPECHECK_CHAR 130 139SWIG_TYPECHECK_STRING 140 140SWIG_TYPECHECK_BOOL_ARRAY 1015 141SWIG_TYPECHECK_INT8_ARRAY 1025 142SWIG_TYPECHECK_INT16_ARRAY 1035 143SWIG_TYPECHECK_INT32_ARRAY 1045 144SWIG_TYPECHECK_INT64_ARRAY 1055 145SWIG_TYPECHECK_INT128_ARRAY 1065 146SWIG_TYPECHECK_FLOAT_ARRAY 1080 147SWIG_TYPECHECK_DOUBLE_ARRAY 1090 148SWIG_TYPECHECK_CHAR_ARRAY 1130 149SWIG_TYPECHECK_STRING_ARRAY 1140 150*/ 151 152%typecheck(SWIG_TYPECHECK_BOOL) bool { $1 = 1; }; 153%typecheck(SWIG_TYPECHECK_CHAR) char { $1 = 1; }; 154%typecheck(SWIG_TYPECHECK_FLOAT) float { $1 = 1; }; 155%typecheck(SWIG_TYPECHECK_DOUBLE) double { $1 = 1; }; 156%typecheck(SWIG_TYPECHECK_STRING) char * { $1 = 1; }; 157%typecheck(SWIG_TYPECHECK_INTEGER) 158 unsigned char, signed char, 159 short, signed short, unsigned short, 160 int, signed int, unsigned int, 161 long, signed long, unsigned long, 162 enum SWIGTYPE { $1 = 1; }; 163%typecheck(SWIG_TYPECHECK_POINTER) SWIGTYPE *, SWIGTYPE &, 164 SWIGTYPE[], SWIGTYPE[ANY], 165 SWIGTYPE { $1 = 1; }; 166 167/* This maps C/C++ types to Lisp classes for overload dispatch */ 168 169%typemap(lispclass) bool "t"; 170%typemap(lispclass) char "cl:character"; 171%typemap(lispclass) unsigned char, signed char, 172 short, signed short, unsigned short, 173 int, signed int, unsigned int, 174 long, signed long, unsigned long, 175 enum SWIGTYPE "cl:integer"; 176%typemap(lispclass) float "cl:single-float"; 177%typemap(lispclass) double "cl:double-float"; 178%typemap(lispclass) char * "cl:string"; 179 180%typemap(out) void ""; 181%typemap(out) bool "$result = (int)$1;"; 182%typemap(out) char, unsigned char, signed char, 183 short, signed short, unsigned short, 184 int, signed int, unsigned int, 185 long, signed long, unsigned long, 186 float, double, long double, char *, void *, 187 enum SWIGTYPE, SWIGTYPE *, 188 SWIGTYPE[ANY], SWIGTYPE & "$result = $1;"; 189#ifdef __cplusplus 190%typemap(out) SWIGTYPE "$result = new $1_ltype($1);"; 191#else 192%typemap(out) SWIGTYPE { 193 $result = ($&1_ltype) malloc(sizeof($1_type)); 194 memmove($result, &$1, sizeof($1_type)); 195} 196#endif 197 198////////////////////////////////////////////////////////////// 199// UCS-2 string conversion 200 201// should this be SWIG_TYPECHECK_CHAR? 202%typecheck(SWIG_TYPECHECK_UNICHAR) wchar_t { $1 = 1; }; 203 204%typemap(in) wchar_t "$1 = $input;"; 205%typemap(lin,numinputs=1) wchar_t "(cl::let (($out (cl:char-code $in)))\n $body)"; 206%typemap(lin,numinputs=1) wchar_t* "(excl:with-native-string ($out $in 207:external-format #+little-endian :fat-le #-little-endian :fat)\n 208$body)" 209 210%typemap(out) wchar_t "$result = $1;"; 211%typemap(lout) wchar_t "(cl::setq ACL_ffresult (cl::code-char $body))"; 212%typemap(lout) wchar_t* "(cl::setq ACL_ffresult (excl:native-to-string $body 213:external-format #+little-endian :fat-le #-little-endian :fat))"; 214 215%typemap(ffitype) wchar_t ":unsigned-short"; 216%typemap(lisptype) wchar_t ""; 217%typemap(ctype) wchar_t "wchar_t"; 218%typemap(lispclass) wchar_t "cl:character"; 219%typemap(lispclass) wchar_t* "cl:string"; 220////////////////////////////////////////////////////////////// 221 222/* name conversion for overloaded operators. */ 223#ifdef __cplusplus 224%rename(__add__) *::operator+; 225%rename(__pos__) *::operator+(); 226%rename(__pos__) *::operator+() const; 227 228%rename(__sub__) *::operator-; 229%rename(__neg__) *::operator-() const; 230%rename(__neg__) *::operator-(); 231 232%rename(__mul__) *::operator*; 233%rename(__deref__) *::operator*(); 234%rename(__deref__) *::operator*() const; 235 236%rename(__div__) *::operator/; 237%rename(__mod__) *::operator%; 238%rename(__logxor__) *::operator^; 239%rename(__logand__) *::operator&; 240%rename(__logior__) *::operator|; 241%rename(__lognot__) *::operator~(); 242%rename(__lognot__) *::operator~() const; 243 244%rename(__not__) *::operator!(); 245%rename(__not__) *::operator!() const; 246 247%rename(__assign__) *::operator=; 248 249%rename(__add_assign__) *::operator+=; 250%rename(__sub_assign__) *::operator-=; 251%rename(__mul_assign__) *::operator*=; 252%rename(__div_assign__) *::operator/=; 253%rename(__mod_assign__) *::operator%=; 254%rename(__logxor_assign__) *::operator^=; 255%rename(__logand_assign__) *::operator&=; 256%rename(__logior_assign__) *::operator|=; 257 258%rename(__lshift__) *::operator<<; 259%rename(__lshift_assign__) *::operator<<=; 260%rename(__rshift__) *::operator>>; 261%rename(__rshift_assign__) *::operator>>=; 262 263%rename(__eq__) *::operator==; 264%rename(__ne__) *::operator!=; 265%rename(__lt__) *::operator<; 266%rename(__gt__) *::operator>; 267%rename(__lte__) *::operator<=; 268%rename(__gte__) *::operator>=; 269 270%rename(__and__) *::operator&&; 271%rename(__or__) *::operator||; 272 273%rename(__preincr__) *::operator++(); 274%rename(__postincr__) *::operator++(int); 275%rename(__predecr__) *::operator--(); 276%rename(__postdecr__) *::operator--(int); 277 278%rename(__comma__) *::operator,(); 279%rename(__comma__) *::operator,() const; 280 281%rename(__member_ref__) *::operator->; 282%rename(__member_func_ref__) *::operator->*; 283 284%rename(__funcall__) *::operator(); 285%rename(__aref__) *::operator[]; 286 287%rename(__bool__) *::operator bool(); 288%rename(__bool__) *::operator bool() const; 289#endif 290 291%insert("lisphead") %{ 292;; $Id: allegrocl.swg 10885 2008-09-30 19:45:13Z mutandiz $ 293 294(eval-when (:compile-toplevel :load-toplevel :execute) 295 296 ;; avoid compiling ef-templates at runtime 297 (excl:find-external-format :fat) 298 (excl:find-external-format :fat-le) 299 300;;; You can define your own identifier converter if you want. 301;;; Use the -identifier-converter command line argument to 302;;; specify its name. 303 304(eval-when (:compile-toplevel :load-toplevel :execute) 305 (cl::defparameter *swig-export-list* nil)) 306 307(cl::defconstant *void* :..void..) 308 309;; parsers to aid in finding SWIG definitions in files. 310(cl::defun scm-p1 (form) 311 (let* ((info (cl::second form)) 312 (id (car info)) 313 (id-args (if (eq (cl::car form) 'swig-dispatcher) 314 (cl::cdr info) 315 (cl::cddr info)))) 316 (cl::apply *swig-identifier-converter* id 317 (cl::progn (cl::when (cl::eq (cl::car form) 'swig-dispatcher) 318 (cl::remf id-args :arities)) 319 id-args)))) 320 321(cl::defmacro defswig1 (name (&rest args) &body body) 322 `(cl::progn (cl::defmacro ,name ,args 323 ,@body) 324 (excl::define-simple-parser ,name scm-p1)) ) 325 326(cl::defmacro defswig2 (name (&rest args) &body body) 327 `(cl::progn (cl::defmacro ,name ,args 328 ,@body) 329 (excl::define-simple-parser ,name second))) 330 331(defun read-symbol-from-string (string) 332 (cl::multiple-value-bind (result position) 333 (cl::read-from-string string nil "eof" :preserve-whitespace t) 334 (cl::if (cl::and (cl::symbolp result) 335 (cl::eql position (cl::length string))) 336 result 337 (cl::multiple-value-bind (sym) 338 (cl::intern string) 339 sym)))) 340 341(cl::defun full-name (id type arity class) 342 ; We need some kind of a hack here to handle template classes 343 ; and other synonym types right. We need the original name. 344 (let*( (sym (read-symbol-from-string 345 (if (eq *swig-identifier-converter* 'identifier-convert-lispify) 346 (string-lispify id) 347 id))) 348 (sym-class (find-class sym nil)) 349 (id (cond ( (not sym-class) 350 id ) 351 ( (and sym-class 352 (not (eq (class-name sym-class) 353 sym))) 354 (class-name sym-class) ) 355 ( t 356 id ))) ) 357 (cl::case type 358 (:getter (cl::format nil "~@[~A_~]~A" class id)) 359 (:constructor (cl::format nil "new_~A~@[~A~]" id arity)) 360 (:destructor (cl::format nil "delete_~A" id)) 361 (:type (cl::format nil "ff_~A" id)) 362 (:slot id) 363 (:ff-operator (cl::format nil "ffi_~A" id)) 364 (otherwise (cl::format nil "~@[~A_~]~A~@[~A~]" 365 class id arity))))) 366 367(cl::defun identifier-convert-null (id &key type class arity) 368 (cl::if (cl::eq type :setter) 369 `(cl::setf ,(identifier-convert-null 370 id :type :getter :class class :arity arity)) 371 (read-symbol-from-string (full-name id type arity class)))) 372 373(cl::defun string-lispify (str) 374 (cl::let ( (cname (excl::replace-regexp str "_" "-")) 375 (lastcase :other) 376 newcase char res ) 377 (cl::dotimes (n (cl::length cname)) 378 (cl::setf char (cl::schar cname n)) 379 (excl::if* (cl::alpha-char-p char) 380 then 381 (cl::setf newcase (cl::if (cl::upper-case-p char) :upper :lower)) 382 (cl::when (cl::and (cl::eq lastcase :lower) 383 (cl::eq newcase :upper)) 384 ;; case change... add a dash 385 (cl::push #\- res) 386 (cl::setf newcase :other)) 387 (cl::push (cl::char-downcase char) res) 388 (cl::setf lastcase newcase) 389 else 390 (cl::push char res) 391 (cl::setf lastcase :other))) 392 (cl::coerce (cl::nreverse res) 'string))) 393 394(cl::defun identifier-convert-lispify (cname &key type class arity) 395 (cl::assert (cl::stringp cname)) 396 (cl::when (cl::eq type :setter) 397 (cl::return-from identifier-convert-lispify 398 `(cl::setf ,(identifier-convert-lispify 399 cname :type :getter :class class :arity arity)))) 400 (cl::setq cname (full-name cname type arity class)) 401 (cl::if (cl::eq type :constant) 402 (cl::setf cname (cl::format nil "*~A*" cname))) 403 (read-symbol-from-string (string-lispify cname))) 404 405(cl::defun id-convert-and-export (name &rest kwargs) 406 (cl::multiple-value-bind (symbol package) 407 (cl::apply *swig-identifier-converter* name kwargs) 408 (cl::let ((args (cl::list (cl::if (cl::consp symbol) 409 (cl::cadr symbol) symbol) 410 (cl::or package cl::*package*)))) 411 (cl::apply #'cl::export args) 412 (cl::pushnew args *swig-export-list*)) 413 symbol)) 414 415(cl::defmacro swig-insert-id (name namespace &key (type :type) class) 416 `(cl::let ((cl::*package* (cl::find-package ,(package-name-for-namespace namespace)))) 417 (id-convert-and-export ,name :type ,type :class ,class))) 418 419(defswig2 swig-defconstant (string value) 420 (cl::let ((symbol (id-convert-and-export string :type :constant))) 421 `(cl::eval-when (:compile-toplevel :load-toplevel :execute) 422 (cl::defconstant ,symbol ,value)))) 423 424(cl::defun maybe-reorder-args (funcname arglist) 425 ;; in the foreign setter function the new value will be the last argument 426 ;; in Lisp it needs to be the first 427 (cl::if (cl::consp funcname) 428 (cl::append (cl::last arglist) (cl::butlast arglist)) 429 arglist)) 430 431(cl::defun maybe-return-value (funcname arglist) 432 ;; setf functions should return the new value 433 (cl::when (cl::consp funcname) 434 `(,(cl::if (cl::consp (cl::car arglist)) 435 (cl::caar arglist) 436 (cl::car arglist))))) 437 438(cl::defun swig-anyvarargs-p (arglist) 439 (cl::member :SWIG__varargs_ arglist)) 440 441(defswig1 swig-defun ((name &optional (mangled-name name) 442 &key (type :operator) class arity) 443 arglist kwargs 444 &body body) 445 (cl::let* ((symbol (id-convert-and-export name :type type 446 :arity arity :class class)) 447 (mangle (excl::if* (cl::string-equal name mangled-name) 448 then (id-convert-and-export 449 (cl::cond 450 ((cl::eq type :setter) (cl::format nil "~A-set" name)) 451 ((cl::eq type :getter) (cl::format nil "~A-get" name)) 452 (t name)) 453 :type :ff-operator :arity arity :class class) 454 else (cl::intern mangled-name))) 455 (defun-args (maybe-reorder-args 456 symbol 457 (cl::mapcar #'cl::car (cl::and (cl::not (cl::equal arglist '(:void))) 458 (cl::loop as i in arglist 459 when (cl::eq (cl::car i) :p+) 460 collect (cl::cdr i)))))) 461 (ffargs (cl::if (cl::equal arglist '(:void)) 462 arglist 463 (cl::mapcar #'cl::cdr arglist))) 464 ) 465 (cl::when (swig-anyvarargs-p ffargs) 466 (cl::setq ffargs '())) 467 `(cl::eval-when (:compile-toplevel :load-toplevel :execute) 468 (excl::compiler-let ((*record-xref-info* nil)) 469 (ff:def-foreign-call (,mangle ,mangled-name) ,ffargs ,@kwargs)) 470 (cl::macrolet ((swig-ff-call (&rest args) 471 (cl::cons ',mangle args))) 472 (cl::defun ,symbol ,defun-args 473 ,@body 474 ,@(maybe-return-value symbol defun-args)))))) 475 476(defswig1 swig-defmethod ((name &optional (mangled-name name) 477 &key (type :operator) class arity) 478 ffargs kwargs 479 &body body) 480 (cl::let* ((symbol (id-convert-and-export name :type type 481 :arity arity :class class)) 482 (mangle (cl::intern mangled-name)) 483 (defmethod-args (maybe-reorder-args 484 symbol 485 (cl::unless (cl::equal ffargs '(:void)) 486 (cl::loop for (lisparg name dispatch) in ffargs 487 when (eq lisparg :p+) 488 collect `(,name ,dispatch))))) 489 (ffargs (cl::if (cl::equal ffargs '(:void)) 490 ffargs 491 (cl::loop for (nil name nil . ffi) in ffargs 492 collect `(,name ,@ffi))))) 493 `(cl::eval-when (:compile-toplevel :load-toplevel :execute) 494 (excl::compiler-let ((*record-xref-info* nil)) 495 (ff:def-foreign-call (,mangle ,mangled-name) ,ffargs ,@kwargs)) 496 (cl::macrolet ((swig-ff-call (&rest args) 497 (cl::cons ',mangle args))) 498 (cl::defmethod ,symbol ,defmethod-args 499 ,@body 500 ,@(maybe-return-value symbol defmethod-args)))))) 501 502(defswig1 swig-dispatcher ((name &key (type :operator) class arities)) 503 (cl::let ((symbol (id-convert-and-export name 504 :type type :class class))) 505 `(cl::eval-when (:compile-toplevel :load-toplevel :execute) 506 (cl::defun ,symbol (&rest args) 507 (cl::case (cl::length args) 508 ,@(cl::loop for arity in arities 509 for symbol-n = (id-convert-and-export name 510 :type type :class class :arity arity) 511 collect `(,arity (cl::apply #',symbol-n args))) 512 (t (cl::error "No applicable wrapper-methods for foreign call ~a with args ~a of classes ~a" ',symbol args (cl::mapcar #'(cl::lambda (x) (cl::class-name (cl::class-of x))) args))) 513 ))))) 514 515(defswig2 swig-def-foreign-stub (name) 516 (cl::let ((lsymbol (id-convert-and-export name :type :class)) 517 (symbol (id-convert-and-export name :type :type))) 518 `(cl::eval-when (:compile-toplevel :load-toplevel :execute) 519 (ff:def-foreign-type ,symbol (:class )) 520 (cl::defclass ,lsymbol (ff:foreign-pointer) ())))) 521 522(defswig2 swig-def-foreign-class (name supers &rest rest) 523 (cl::let ((lsymbol (id-convert-and-export name :type :class)) 524 (symbol (id-convert-and-export name :type :type))) 525 `(cl::eval-when (:compile-toplevel :load-toplevel :execute) 526 (ff:def-foreign-type ,symbol ,@rest) 527 (cl::defclass ,lsymbol ,supers 528 ((foreign-type :initform ',symbol :initarg :foreign-type 529 :accessor foreign-pointer-type)))))) 530 531(defswig2 swig-def-foreign-type (name &rest rest) 532 (cl::let ((symbol (id-convert-and-export name :type :type))) 533 `(cl::eval-when (:compile-toplevel :load-toplevel :execute) 534 (ff:def-foreign-type ,symbol ,@rest)))) 535 536(defswig2 swig-def-synonym-type (synonym of ff-synonym) 537 `(cl::eval-when (:compile-toplevel :load-toplevel :execute) 538 (cl::setf (cl::find-class ',synonym) (cl::find-class ',of)) 539 (ff:def-foreign-type ,ff-synonym (:struct )))) 540 541(cl::defun package-name-for-namespace (namespace) 542 (excl::list-to-delimited-string 543 (cl::cons *swig-module-name* 544 (cl::mapcar #'(cl::lambda (name) 545 (cl::string 546 (cl::funcall *swig-identifier-converter* 547 name 548 :type :namespace))) 549 namespace)) 550 ".")) 551 552(cl::defmacro swig-defpackage (namespace) 553 (cl::let* ((parent-namespaces (cl::maplist #'cl::reverse (cl::cdr (cl::reverse namespace)))) 554 (parent-strings (cl::mapcar #'package-name-for-namespace 555 parent-namespaces)) 556 (string (package-name-for-namespace namespace))) 557 `(cl::eval-when (:compile-toplevel :load-toplevel :execute) 558 (cl::defpackage ,string 559 (:use :swig :ff #+ignore '(:common-lisp :ff :excl) 560 ,@parent-strings ,*swig-module-name*) 561 (:import-from :cl :* :nil :t))))) 562 563(cl::defmacro swig-in-package (namespace) 564 `(cl::eval-when (:compile-toplevel :load-toplevel :execute) 565 (cl::in-package ,(package-name-for-namespace namespace)))) 566 567(defswig2 swig-defvar (name mangled-name &key type (ftype :unsigned-natural)) 568 (cl::let ((symbol (id-convert-and-export name :type type))) 569 `(cl::eval-when (:compile-toplevel :load-toplevel :execute) 570 (ff:def-foreign-variable (,symbol ,mangled-name) :type ,ftype)))) 571 572) ;; eval-when 573 574(cl::eval-when (:compile-toplevel :execute) 575 (cl::flet ((starts-with-p (str prefix) 576 (cl::and (cl::>= (cl::length str) (cl::length prefix)) 577 (cl::string= str prefix :end1 (cl::length prefix))))) 578 (cl::export (cl::loop for sym being each present-symbol of cl::*package* 579 when (cl::or (starts-with-p (cl::symbol-name sym) (cl::symbol-name :swig-)) 580 (starts-with-p (cl::symbol-name sym) (cl::symbol-name :identifier-convert-))) 581 collect sym)))) 582 583%} 584 585typedef void *__SWIGACL_FwdReference; 586 587%{ 588 589#ifdef __cplusplus 590# define EXTERN extern "C" 591#else 592# define EXTERN extern 593#endif 594 595#define EXPORT EXTERN SWIGEXPORT 596 597typedef void *__SWIGACL_FwdReference; 598 599#include <string.h> 600#include <stdlib.h> 601%} 602