03/20/2005: mutandiz

[allegrocl]
	    More tweaks to INPUT/OUTPUT typemaps for bool.

	    Fix constantWrapper for char and string literals.

	    find-definition keybindings should work in ELI/SLIME.
	    Output (in-package <module-name>) to lisp wrapper
	    instead of (in-package #.*swig-module-name*).

	    slight rework of multiple return values.

	    doc updates.


git-svn-id: https://swig.svn.sourceforge.net/svnroot/swig/trunk/SWIG@9026 626c5289-ae23-0410-ae9c-e8d60b6d4f22

Doc/Manual/Allegrocl.html

@@ -241,14 +241,6 @@ swig using the <tt>-allegrocl</tt> option, as below:
 </pre>
 </div>
 
-<p>
-In C mode, a single <tt>example.cl</tt> file will be generated,
-containing declarations that when compiled/loaded into the Allegro CL
-environment will define an interface for calling into the foreign
-library. To actually use the interface, you'll also need to load the
-foreign library into lisp.
-</p>
-
 <p>
 When building an interface to C++ code, include the <tt>-c++</tt> option:
 </p>
@@ -260,16 +252,26 @@ When building an interface to C++ code, include the <tt>-c++</tt> option:
 </div>
 
 <p>
-In C++ mode, the same <tt>example.cl</tt> file will be generated, but
+As a result of running one of the above commands, a file named <tt>example.cl</tt> 
-SWIG will also generate <tt>example_wrap.cxx</tt>, containing C/C++
+will be generated containing the lisp side of the interface. As well, a file 
-wrapper code to facilitate access to C++ methods and enumeration values.
+<tt>example_wrap.cxx</tt> is also generated, containing C/C++ wrapper code to
-Wrapper functions are necessary due to the lack of a standard for mangling 
+facilitate access to C++ methods, enumeration values, and constant values.
+Wrapper functions are necessary in C++ due to the lack of a standard for mangling 
 the names of symbols across all C++ compilers. These wrapper functions are
 exported from the shared library as appropriate, using the C name mangling
 convention. The lisp code that is generated will interface to your foreign
 library through these wrappers.
 </p>
 
+<p>
+It is possible to disable the creation of the .cxx file when generating a C
+interface by using the -nocwrap command-line argument. For interfaces that
+don't contain complex enum or constant expressions, contain nested struct/union
+declarations, or doesn't need to use many of the SWIG customization featuers, 
+this will result in a more streamlined, direct interface to the
+intended module.
+</p>
+
 <p>
 The generated wrapper file is below. It contains very simple
 wrappers by default, that simply pass the arguments to the
@@ -374,12 +376,12 @@ swig -allegrocl [ options ] filename
 				  This function is used to generate symbols
 				  for the lisp side of the interface. 
 
-   -cwrap - Generate a .cxx file containing C wrapper function when wrapping
+   -cwrap - [default] Generate a .cxx file containing C wrapper function when
-            C code. The default is to only generate such a file for C++ wrapping.
+            wrapping C code. The interface generated is similar to what is
-            This will change how the C interface is generated for many constructs,
+	    done for C++ code.
-            such as enums and global variables.
+   -nocwrap - Explicitly turn off generation of .cxx wrappers for C code. Reasonable
-
+              for modules with simple interfaces. Can not handle all legal enum
-   -nocwrap - explicitly turnoff generation of .cxx wrappers for C code.
+	      and constant constructs, or take advantage of SWIG customization features.
 
 </pre>
 </div>
@@ -468,7 +470,7 @@ interested in generating an interface to C++.
 	       |
         _______v______
        |              |  (foreign side)
-       | Wrapper code |  C++ only. extern "C" wrappers calling C++ 
+       | Wrapper code |  extern "C" wrappers calling C++ 
        |______________|  functions and methods.
                |
     .  . . - - + - - . .  .
@@ -619,11 +621,11 @@ char *xxx();
 
 
   <p>
-    Along with the described functional layering, this module will
+    Along with the described functional layering, when creating a .cxx wrapper, 
-    also generate <tt>defconstant</tt> and, for C,
+    this module will generate getter and--if not immutable--setter,
-    <tt>ff:def-foreign-variable</tt> forms for accessing constants and
+    functions for variables and constants. If the -nocwrap option is used,
-    global variables. For C++, getter and--if not immutable--setter,
+    <tt>defconstant</tt> and <tt>ff:def-foreign-variable</tt> forms will be
-    functions are generated for variables as well. These, along with
+    generated for accessing constants and global variables. These, along with
     the <tt>defuns</tt> listed above are the intended API for calling
     into the foreign module.
   </p>
@@ -632,13 +634,13 @@ char *xxx();
 
 
   <p>
-  All non-primitive types (Classes in C++, and types declared via
+  All non-primitive types (Classes, structs, unions, and typedefs
-  typedef) having a corresponding foreign-type defined on the lisp
+  involving same) have a corresponding foreign-type defined on the
-  side via ff:def-foreign-type.
+  lisp side via ff:def-foreign-type.
   </p>
 
   <p>
-  For C++, all classes are further represented by a CLOS class,
+  All non-primitive types are further represented by a CLOS class,
   created via defclass. An attempt is made to create the same class
   hierarchy, with all classes inheriting directly or indirectly from
   ff:foreign-pointer. Further, wherever it is apparent, all pointers
@@ -646,7 +648,8 @@ char *xxx();
   appropriate class. For ff:def-foreign-calls that have been defined
   to expect a :foreign-address type as argument, these CLOS instances
   can legally be passed and the pointer to the C++ object
-  automatically extracted.
+  automatically extracted. This is a natural feature of Allegro's
+  foreign function interface.
   </p>
 
 <H2><a name="Allegrocl_nn14"></a>16.3 Wrapping Details</H2>
@@ -732,10 +735,12 @@ namespace car {
       <tt>%constant</tt> directive, are included in SWIGs parse tree
       when it can be determined that they are, or could be reduced to,
       a literal value. Such values are translated into defconstant
-      forms in the generated lisp wrapper.
+      forms in the generated lisp wrapper when the -nocwrap command-line
+      options is used. Else, wrapper functions are generated as in the
+      case of variable access (see section below).
     </p>
     <p>
-      Here are examples of simple preprocessor constants.
+      Here are examples of simple preprocessor constants when using -nocwrap.
     </p>
       <div class="code">
       <pre>
@@ -760,8 +765,10 @@ namespace car {
       For preprocessor constants containing expressions which can be
       reduced to literal values, nodes are created, but with no simplification
       of the constant value. A very very simple infix to prefix converter
-      has been implemented that does the right thing for simple cases, but
+      has been implemented that tries to do the right thing for simple cases, but
-      does not for more complex expressoins.
+      does not for more complex expressoins. If the literal parser determines
+      that something is wrong, a warning will be generated and the literal 
+      expression will be included in the generated code, but commented out.
     </p>
       
       <div class="code">
@@ -865,18 +872,19 @@ globalvar> (globalvar.nnn::glob_float)
       enumeration value is implicitly convertible to an integer value,
       but can also be distinguished by it's enum type. For each enum
       declaration a def-foreign-type is generated, assigning the enum
-      a default type of :int.
+      a default type of :int. Users may adjust the foreign type of
+      enums via SWIG <tt>typemaps</tt>.
     </p>
 
     <p>
       Enum values are a bit trickier as they can be initialized using
-      any valid C/C++ expression. In C, we handle the typical cases
+      any valid C/C++ expression. In C with the -nocwrap command-line option,
-      (simple integer initialization) and generate a defconstant form
+      we handle the typical cases (simple integer initialization) and
-      for each enum value. This has the advantage of it not being necessary
+      generate a defconstant form for each enum value. This has the advantage
-      to probe into foreign space to retrieve enum values. For C++, a more
+      of it not being necessary to probe into foreign space to retrieve enum
-      general solution is employed. A wrapper variable is created in the
+      values. When generating a .cxx wrapper file, a more general solution is
-      module_wrap.cxx file, and a ff:def-foreign-variable call is
+      employed. A wrapper variable is created in the module_wrap.cxx file, and
-      generated to retrieve it's value into lisp. 
+      a ff:def-foreign-variable call is generated to retrieve it's value into lisp. 
     </p>
 
     <p>For example, the following header file
@@ -887,7 +895,7 @@ enum FOO { FOO1 = 10, FOO2, FOO3 };
       </pre>
       </div>
       <p>
-      Processed as a C header, generates
+      In -nocwrap mode, generates
       </p>
       <div class="targetlang">enum.cl:
       <pre>
@@ -903,7 +911,7 @@ enum FOO { FOO1 = 10, FOO2, FOO3 };
       </pre>
       </div>
 
-    <p>And for C++ generates
+    <p>And when generating a .cxx wrapper
       <div class="code">enum_wrap.cxx:
       <pre>
 EXPORT const int ACL_ENUM___RED__SWIG_0 = RED;
@@ -1176,7 +1184,7 @@ namespace BAR {
 
 
     <p>
-      In C++ it is possible, via typedef, to have many names refer to
+      In C/C++ it is possible, via typedef, to have many names refer to
       the same <tt>type</tt>. In general, this is not a problem, though
       it can lead to confusion.  Assume the below C++ header file:
     </p>
@@ -1610,7 +1618,9 @@ opoverload>
       Each C++ wrapper includes a handler to catch any exceptions that may
       be thrown while in foreign code. This helps prevent simple C++ errors
       from killing the entire lisp process. There is currently no mechanism
-      to have these exceptions forwarded to the lisp condition system.
+      to have these exceptions forwarded to the lisp condition system, nor
+      has any explicit support of the exception related SWIG typemaps been
+      implemented.
     </p>
 
 <H3><a name="Allegrocl_nn34"></a>16.3.13 Pass by value, pass by reference</H3>
@@ -1641,7 +1651,7 @@ opoverload>
 
     
     <p>
-      Every C++ wrapper generated by SWIG has the following form:
+      Every C++ wrapper generated by SWIG takes the following form:
     </p>
 
     <div class="diagram">

Lib/allegrocl/allegrocl.swg

@@ -251,6 +251,25 @@ $body)"
 (eval-when (:compile-toplevel :load-toplevel :execute)
    (defparameter *swig-export-list* nil))
 
+(defconstant *void* :..void..)
+
+;; parsers to aid in finding SWIG definitions in files.
+(defun scm-p1 (form)
+  (let* ((info (second form))
+	 (id (car info))
+	 (id-args (cddr info)))
+    (apply swig:*swig-identifier-converter* id id-args)))
+
+(defmacro defswig1 (name (&rest args) &body body)
+  `(progn (defmacro ,name ,args
+	    ,@body)
+	  (excl::define-simple-parser ,name scm-p1)) )
+
+(defmacro defswig2 (name (&rest args) &body body)
+  `(progn (defmacro ,name ,args
+	    ,@body)
+	  (excl::define-simple-parser ,name second)))
+
 (defun read-symbol-from-string (string)
   (multiple-value-bind (result position)
       (read-from-string string nil "eof" :preserve-whitespace t)
@@ -320,7 +339,7 @@ $body)"
   `(let ((*package* (find-package ,(package-name-for-namespace namespace))))
     (id-convert-and-export ,name :type ,type :class ,class)))
 
-(defmacro swig-defconstant (string value)
+(defswig2 swig-defconstant (string value)
   (let ((symbol (id-convert-and-export string :type :constant)))
     `(eval-when (compile load eval)
        (defconstant ,symbol ,value))))
@@ -342,7 +361,7 @@ $body)"
 (defun swig-anyvarargs-p (arglist)
   (member :SWIG__varargs_ arglist))
 
-(defmacro swig-defun ((name &optional (mangled-name name)
+(defswig1 swig-defun ((name &optional (mangled-name name)
                             &key (type :operator) class arity)
                       arglist kwargs
 		      &body body)
@@ -376,7 +395,7 @@ $body)"
            ,@body
            ,@(maybe-return-value symbol defun-args))))))
 
-(defmacro swig-defmethod ((name &optional (mangled-name name)
+(defswig1 swig-defmethod ((name &optional (mangled-name name)
                            &key (type :operator) class arity)
                           ffargs kwargs
                           &body body)
@@ -402,7 +421,7 @@ $body)"
            ,@body
            ,@(maybe-return-value symbol defmethod-args))))))
 
-(defmacro swig-dispatcher ((name &key (type :operator) class arities))
+(defswig1 swig-dispatcher ((name &key (type :operator) class arities))
   (let ((symbol (id-convert-and-export name
                          :type type :class class)))
     `(eval-when (compile load eval)
@@ -415,14 +434,14 @@ $body)"
 	   (t (error "No applicable wrapper-methods for foreign call ~a with args ~a of classes ~a" ',symbol args (mapcar #'(lambda (x) (class-name (class-of x))) args)))
 	   )))))
 
-(defmacro swig-def-foreign-stub (name)
+(defswig2 swig-def-foreign-stub (name)
   (let ((lsymbol (id-convert-and-export name :type :class))
 	(symbol (id-convert-and-export name :type :type)))
     `(eval-when (compile load eval)
 	(ff:def-foreign-type ,symbol (:class ))
 	(defclass ,lsymbol (ff:foreign-pointer) ()))))
 
-(defmacro swig-def-foreign-class (name supers &rest rest)
+(defswig2 swig-def-foreign-class (name supers &rest rest)
   (let ((lsymbol (id-convert-and-export name :type :class))
 	(symbol (id-convert-and-export name :type :type)))
     `(eval-when (compile load eval)
@@ -431,12 +450,12 @@ $body)"
 	 ((foreign-type :initform ',symbol :initarg :foreign-type
 			:accessor foreign-pointer-type))))))
 
-(defmacro swig-def-foreign-type (name &rest rest)
+(defswig2 swig-def-foreign-type (name &rest rest)
   (let ((symbol (id-convert-and-export name :type :type)))
     `(eval-when (compile load eval)
        (ff:def-foreign-type ,symbol ,@rest))))
 
-(defmacro swig-def-synonym-type (synonym of ff-synonym)
+(defswig2 swig-def-synonym-type (synonym of ff-synonym)
   `(eval-when (compile load eval)
      (setf (find-class ',synonym) (find-class ',of))
      (ff:def-foreign-type ,ff-synonym (:struct ))))
@@ -466,7 +485,7 @@ $body)"
   `(eval-when (compile load eval)
     (in-package ,(package-name-for-namespace namespace))))
 
-(defmacro swig-defvar (name mangled-name &key type)
+(defswig2 swig-defvar (name mangled-name &key type)
   (let ((symbol (id-convert-and-export name :type type)))
     `(eval-when (compile load eval)
       (ff:def-foreign-variable (,symbol ,mangled-name)))))
@@ -482,8 +501,6 @@ $body)"
                            (starts-with-p (symbol-name sym) (symbol-name :identifier-convert-)))
                   collect sym))))
 
-(in-package #.*swig-module-name*)
-
 %}
 
 

Lib/allegrocl/inout_typemaps.i

@@ -66,6 +66,8 @@ INOUT_TYPEMAP(bool,
 		    ACL_result),
 	      (setf (ff:fslot-value-typed (quote $*in_fftype) :c $out) (if $in 1 0)));
 
+%typemap(lisptype) bool *INPUT, bool &INPUT "boolean";
+
 // long long support not yet complete
 // INOUT_TYPEMAP(long long);
 // INOUT_TYPEMAP(unsigned long long);

Source/Modules/allegrocl.cxx

@@ -25,6 +25,7 @@ static File *f_cxx;
 static File *f_cxx_header=0;
 static File *f_cxx_wrapper=0;
 
+static String *module_name=0;
 const char *identifier_converter="identifier-convert-null";
 
 static bool CWrap = true;  // generate wrapper file for C code by default. most correct.
@@ -1519,11 +1520,11 @@ void ALLEGROCL :: main(int argc, char *argv[]) {
 }
 
 int ALLEGROCL :: top(Node *n) {
-  String *module=Getattr(n, "name");  
+  module_name=Getattr(n, "name");  
   String *cxx_filename=Getattr(n, "outfile");  
   String *cl_filename=NewString("");
 
-  Printf(cl_filename, "%s%s.cl", SWIG_output_directory(), module);
+  Printf(cl_filename, "%s%s.cl", SWIG_output_directory(), module_name);
 
   f_cl=NewFile(cl_filename, "w");
   if (!f_cl) {
@@ -1557,15 +1558,18 @@ int ALLEGROCL :: top(Node *n) {
                ";; the definition file, not here.\n\n"
                "(defpackage :swig\n"
                "  (:use :common-lisp :ff :excl)\n"
-               "  (:export #:*swig-identifier-converter* #:*swig-module-name*))\n"
+               "  (:export #:*swig-identifier-converter* #:*swig-module-name*\n"
+	       "           #:*void*))\n"
                "(in-package :swig)\n\n"  
                "(eval-when (compile load eval)\n"
                "  (defparameter *swig-identifier-converter* '%s)\n"
                "  (defparameter *swig-module-name* :%s))\n\n",
-         identifier_converter, module);
+         identifier_converter, module_name);
   Printf(f_cl, "(defpackage :%s\n"
                "  (:use :common-lisp :swig :ff :excl))\n\n",
-         module);
+         module_name);
+
+  Printf(f_clhead, "(in-package :%s)\n", module_name);
 
   // Swig_print_tree(n);
 
@@ -2325,11 +2329,7 @@ int ALLEGROCL :: emit_defun(Node *n, File *f_cl) {
 
   SwigType *result_type = Swig_cparse_type(Getattr(n,"tmap:ctype"));
   // prime the pump, with support for OUTPUT, INOUT typemaps.
-  if(Strcmp(result_type,"void")) {
+  Printf(wrap->code,"(let ((ACL_ffresult swig:*void*)\n        ACL_result)\n  $body\n  (if (eq ACL_ffresult swig:*void*)\n    (values-list ACL_result)\n   (values-list (cons ACL_ffresult ACL_result))))");
-    Printf(wrap->code,"(let (ACL_result ACL_ffresult)\n  $body\n  (values-list (cons ACL_ffresult ACL_result)))");
-  } else {
-    Printf(wrap->code,"(let (ACL_result ACL_ffresult)\n  $body\n  (values-list ACL_result))");
-  }
 
   Parm *p;
   int largnum = 0, argnum=0, first=1;
@@ -2381,7 +2381,6 @@ int ALLEGROCL :: emit_defun(Node *n, File *f_cl) {
 	String *argname=NewStringf("PARM%d_%s", largnum, Getattr(p, "name"));
 
 	String *ffitype = compose_foreign_type(argtype);
-
 	String *deref_ffitype;
 	String *temp = Copy(argtype);
 
@@ -2396,8 +2395,9 @@ int ALLEGROCL :: emit_defun(Node *n, File *f_cl) {
 
 	// String *lisptype=get_lisp_type(argtype, argname);
 	String *lisptype=get_lisp_type(Getattr(p,"type"), Getattr(p,"name"));
+	
 #ifdef ALLEGROCL_DEBUG
-	Printf(stderr,"lisptype of '%s' '%s' = '%s'\n", argtype, Getattr(p,"name"), lisptype);
+	Printf(stderr,"lisptype of '%s' '%s' = '%s'\n", Getattr(p,"type"), Getattr(p,"name"), lisptype);
 #endif
 	
 	// while we're walking the parameters, generating LIN
@@ -2742,12 +2742,30 @@ int ALLEGROCL :: constantWrapper(Node *n) {
 
   if(Generate_Wrapper) {
     // Setattr(n,"wrap:name",mangle_name(n, "ACLPP"));
+    String *const_type = Getattr(n,"type");
+
+    String *const_val = 0;
+    String *raw_const = Getattr(n,"value");
+
+    if(SwigType_type(const_type) == T_STRING) {
+      const_val = NewStringf("\"%s\"",raw_const);
+    } else if (SwigType_type(const_type) == T_CHAR) {
+      const_val = NewStringf("'%s'",raw_const);
+    } else {
+      const_val = Copy(raw_const);
+    }
+
+    SwigType_add_qualifier(const_type,"const");
+    SwigType_add_qualifier(const_type,"static");
+   
     String *ppcname = NewStringf("ACLppc_%s",Getattr(n,"name"));
-    Printf(f_cxx,"static const %s %s = %s;\n", Getattr(n,"type"),
+    Printf(f_cxx,"static const %s = %s;\n", SwigType_lstr(const_type,ppcname),
-	   ppcname, Getattr(n,"value"));
+	   const_val);
 
     Setattr(n,"name",ppcname);
     SetFlag(n,"feature:immutable");
+
+    Delete(const_val);
     return variableWrapper(n);
   }