diff --git a/CHANGES.current b/CHANGES.current index 928e0befd..e391be97e 100644 --- a/CHANGES.current +++ b/CHANGES.current @@ -7,6 +7,11 @@ the issue number to the end of the URL: https://github.com/swig/swig/issues/ Version 4.1.0 (in progress) =========================== +2021-05-13: olly + [S-EXP] #2009 Remove code for Common Lisp S-Exp. We dropped + support for it in SWIG 4.0.0 and nobody has stepped forward to + revive it in over 2 years. + 2021-05-13: olly [Pike] #2009 Remove code for Pike. We dropped support for it in SWIG 4.0.0 and nobody has stepped forward to revive it in over 2 diff --git a/Examples/ocaml/shapes/example.i b/Examples/ocaml/shapes/example.i index ac0fa4a56..a261b92e7 100644 --- a/Examples/ocaml/shapes/example.i +++ b/Examples/ocaml/shapes/example.i @@ -1,10 +1,8 @@ /* File : example.i */ %module(directors="1") example -#ifndef SWIGSEXP %{ #include "example.h" %} -#endif %feature("director"); %include "example.h" diff --git a/Examples/s-exp/uffi.lisp b/Examples/s-exp/uffi.lisp deleted file mode 100644 index aea9a1405..000000000 --- a/Examples/s-exp/uffi.lisp +++ /dev/null @@ -1,389 +0,0 @@ -;;; This is experimental code that uses the s-expression -;;; representation of a C/C++ library interface to generate Foreign -;;; Function Interface definitions for use with Kevin Rosenberg's -;;; UFFI. -;;; -;;; Written by Matthias Koeppe - -(eval-when (:compile-toplevel :load-toplevel :execute) - (require 'port) ; from CLOCC - (require 'uffi)) - -(in-package :cl-user) - -;; Interaction with the SWIG binary - -(defvar *swig-source-directory* #p"/home/mkoeppe/s/swig1.3/") - -(defvar *swig-program* (merge-pathnames "swig" *swig-source-directory*)) - -(defun run-swig (swig-interface-file-name &key directory-search-list module - ignore-errors c++) - (let ((temp-file-name "/tmp/swig.lsp")) - (let ((process - (port:run-prog (namestring *swig-program*) - :output t - :args `(,@(and c++ '("-c++")) - "-sexp" - ,@(mapcar (lambda (dir) - (concatenate 'string - "-I" (namestring dir))) - directory-search-list) - ,@(and module - `("-module" ,module)) - "-o" ,temp-file-name - ,(namestring swig-interface-file-name))))) - #+cmu (unless (or (zerop (ext:process-exit-code process)) - ignore-errors) - (error "Process swig exited abnormally")) - (with-open-file (s temp-file-name) - (read s))))) - -;; Type system - -(defun parse-swigtype (type-string &key start end junk-ok) - "Parse TYPE-STRING as SWIG's internal representation of C/C++ -types. Return two values: The type description (an improper list) and -the terminating index into TYPE-STRING." - ;; SWIG's internal representation is described in Source/Swig/stype.c - (unless start - (setq start 0)) - (unless end - (setq end (length type-string))) - (flet ((prefix-match (prefix) - (let ((position (mismatch prefix type-string :start2 start :end2 end))) - (or (not position) - (= position (length prefix))))) - (bad-type-error (reason) - (error "Bad SWIG type (~A): ~A" reason - (subseq type-string start end))) - (type-char (index) - (and (< index (length type-string)) - (char type-string index))) - (cons-and-recurse (prefix start end) - (multiple-value-bind (type-description index) - (parse-swigtype type-string :start start :end end - :junk-ok junk-ok) - (values (cons prefix type-description) - index)))) - (cond - ((prefix-match "p.") ; pointer - (cons-and-recurse '* (+ start 2) end)) - ((prefix-match "r.") ; C++ reference - (cons-and-recurse '& (+ start 2) end)) - ((prefix-match "a(") ; array - (let ((closing-paren (position #\) type-string - :start (+ start 2) - :end end))) - (unless closing-paren - (bad-type-error "missing right paren")) - (unless (eql (type-char (+ closing-paren 1)) #\.) - (bad-type-error "missing dot")) - (cons-and-recurse (list 'ARRAY (subseq type-string (+ start 2) closing-paren)) - (+ closing-paren 2) end))) - ((prefix-match "q(") ; qualifier (const, volatile) - (let ((closing-paren (position #\) type-string - :start (+ start 2) - :end end))) - (unless closing-paren - (bad-type-error "missing right paren")) - (unless (eql (type-char (+ closing-paren 1)) #\.) - (bad-type-error "missing dot")) - (cons-and-recurse (list 'QUALIFIER (subseq type-string (+ start 2) closing-paren)) - (+ closing-paren 2) end))) - ((prefix-match "m(") ; C++ member pointer - (multiple-value-bind (class-type class-end-index) - (parse-swigtype type-string :junk-ok t - :start (+ start 2) :end end) - (unless (eql (type-char class-end-index) #\)) - (bad-type-error "missing right paren")) - (unless (eql (type-char (+ class-end-index 1)) #\.) - (bad-type-error "missing dot")) - (cons-and-recurse (list 'MEMBER-POINTER class-type) - (+ class-end-index 2) end))) - ((prefix-match "f(") ; function - (loop with index = (+ start 2) - until (eql (type-char index) #\)) - collect (multiple-value-bind (arg-type arg-end-index) - (parse-swigtype type-string :junk-ok t - :start index :end end) - (case (type-char arg-end-index) - (#\, (setq index (+ arg-end-index 1))) - (#\) (setq index arg-end-index)) - (otherwise (bad-type-error "comma or right paren expected"))) - arg-type) - into arg-types - finally (unless (eql (type-char (+ index 1)) #\.) - (bad-type-error "missing dot")) - (return (cons-and-recurse (cons 'FUNCTION arg-types) - (+ index 2) end)))) - ((prefix-match "v(") ;varargs - (let ((closing-paren (position #\) type-string - :start (+ start 2) - :end end))) - (unless closing-paren - (bad-type-error "missing right paren")) - (values (list 'VARARGS (subseq type-string (+ start 2) closing-paren)) - (+ closing-paren 1)))) - (t (let ((junk-position (position-if (lambda (char) - (member char '(#\, #\( #\) #\.))) - type-string - :start start :end end))) - (cond (junk-position ; found junk - (unless junk-ok - (bad-type-error "trailing junk")) - (values (subseq type-string start junk-position) - junk-position)) - (t - (values (subseq type-string start end) - end)))))))) - -(defun swigtype-function-p (swigtype) - "Check whether SWIGTYPE designates a function. If so, the second -value is the list of argument types, and the third value is the return -type." - (if (and (consp swigtype) - (consp (first swigtype)) - (eql (first (first swigtype)) 'FUNCTION)) - (values t (rest (first swigtype)) (rest swigtype)) - (values nil nil nil))) - - -;; UFFI - -(defvar *uffi-definitions* '()) - -(defconstant *uffi-default-primitive-type-alist* - '(("char" . :char) - ("unsigned char" . :unsigned-byte) - ("signed char" . :byte) - ("short" . :short) - ("signed short" . :short) - ("unsigned short" . :unsigned-short) - ("int" . :int) - ("signed int" . :int) - ("unsigned int" . :unsigned-int) - ("long" . :long) - ("signed long" . :long) - ("unsigned long" . :unsigned-long) - ("float" . :float) - ("double" . :double) - ((* . "char") . :cstring) - ((* . "void") . :pointer-void) - ("void" . :void))) - -(defvar *uffi-primitive-type-alist* *uffi-default-primitive-type-alist*) - -(defun uffi-type-spec (type-list) - "Return the UFFI type spec equivalent to TYPE-LIST, or NIL if there -is no representation." - (let ((primitive-type-pair - (assoc type-list *uffi-primitive-type-alist* :test 'equal))) - (cond - (primitive-type-pair - (cdr primitive-type-pair)) - ((and (consp type-list) - (eql (first type-list) '*)) - (let ((base-type-spec (uffi-type-spec (rest type-list)))) - (cond - ((not base-type-spec) - :pointer-void) - (t - (list '* base-type-spec))))) - (t nil)))) - -;; Parse tree - -(defvar *uffi-output* nil) - -(defun emit-uffi-definition (uffi-definition) - (format *uffi-output* "~&~S~%" uffi-definition) - (push uffi-definition *uffi-definitions*)) - -(defun make-cl-symbol (c-identifier &key uninterned) - (let ((name (substitute #\- #\_ (string-upcase c-identifier)))) - (if uninterned - (make-symbol name) - (intern name)))) - -(defvar *class-scope* '() "A stack of names of nested C++ classes.") - -(defvar *struct-fields* '()) - -(defvar *linkage* :C "NIL or :C") - -(defgeneric handle-node (node-type &key &allow-other-keys) - (:documentation "Handle a node of SWIG's parse tree of a C/C++ program")) - -(defmethod handle-node ((node-type t) &key &allow-other-keys) - ;; do nothing for unknown node types - nil) - -(defmethod handle-node ((node-type (eql 'cdecl)) &key name decl storage parms type &allow-other-keys) - (let ((swigtype (parse-swigtype (concatenate 'string decl type)))) - (let ((*print-pretty* nil) ; or FUNCTION would be printed as #' by cmucl - (*print-circle* t)) - (format *uffi-output* "~&;; C Declaration: ~A ~A ~A ~A~%;; with-parms ~W~%;; of-type ~W~%" - storage type name decl parms swigtype)) - (multiple-value-bind (function-p arg-swigtype-list return-swigtype) - (swigtype-function-p swigtype) - (declare (ignore arg-swigtype-list)) - (cond - ((and (null *class-scope*) function-p - (or (eql *linkage* :c) - (string= storage "externc"))) - ;; ordinary top-level function with C linkage - (let ((argnum 0) - (argname-list '())) - (flet ((unique-argname (name) - ;; Sometimes the functions in SWIG interfaces - ;; do not have unique names. Make them unique - ;; by adding a suffix. Also avoid symbols - ;; that are specially bound. - (unless name - (setq name (format nil "arg~D" argnum))) - (let ((argname (make-cl-symbol name))) - (when (boundp argname) ;specially bound - (setq argname (make-cl-symbol name :uninterned t))) - (push argname argname-list) - argname))) - (let ((uffi-arg-list - (mapcan (lambda (param) - (incf argnum) - (destructuring-bind (&key name type &allow-other-keys) param - (let ((uffi-type (uffi-type-spec (parse-swigtype type)))) - (cond - ((not uffi-type) - (format *uffi-output* "~&;; Warning: Cannot handle type ~S of argument `~A'~%" - type name) - (return-from handle-node)) - ((eq uffi-type :void) - '()) - (t - (let ((symbol (unique-argname name))) - (list `(,symbol ,uffi-type)))))))) - parms)) - (uffi-return-type - (uffi-type-spec return-swigtype))) - (unless uffi-return-type - (format *uffi-output* "~&;; Warning: Cannot handle return type `~S'~%" - return-swigtype) - (return-from handle-node)) - (emit-uffi-definition `(UFFI:DEF-FUNCTION ,name ,uffi-arg-list :RETURNING ,uffi-return-type)))))) - ((and (not (null *class-scope*)) (null (rest *class-scope*)) - (not function-p)) ; class/struct member (no nested structs) - (let ((uffi-type (uffi-type-spec swigtype))) - (unless uffi-type - (format *uffi-output* "~&;; Warning: Cannot handle type ~S of struct field `~A'~%" - type name) - (return-from handle-node)) - (push `(,(make-cl-symbol name) ,uffi-type) *struct-fields*))))))) - -(defmethod handle-node ((node-type (eql 'class)) &key name children kind &allow-other-keys) - (format *uffi-output* "~&;; Class ~A~%" name) - (let ((*class-scope* (cons name *class-scope*)) - (*struct-fields* '())) - (dolist (child children) - (apply 'handle-node child)) - (emit-uffi-definition `(,(if (string= kind "union") - 'UFFI:DEF-UNION - 'UFFI:DEF-STRUCT) - ,(make-cl-symbol name) ,@(nreverse *struct-fields*))))) - -(defmethod handle-node ((node-type (eql 'top)) &key children &allow-other-keys) - (dolist (child children) - (apply 'handle-node child))) - -(defmethod handle-node ((node-type (eql 'include)) &key name children &allow-other-keys) - (format *uffi-output* ";; INCLUDE ~A~%" name) - (dolist (child children) - (apply 'handle-node child))) - -(defmethod handle-node ((node-type (eql 'extern)) &key name children &allow-other-keys) - (format *uffi-output* ";; EXTERN \"C\" ~A~%" name) - (let ((*linkage* :c)) - (dolist (child children) - (apply 'handle-node child)))) - -;;(defun compute-uffi-definitions (swig-interface) -;; (let ((*uffi-definitions* '())) -;; (handle-node swig-interface) -;; *uffi-definitions*)) - -;; Test instances - -;;; Link to SWIG itself - -#|| - -(defparameter *c++-compiler* "g++") - -(defun stdc++-library (&key env) - (let ((error-output (make-string-output-stream))) - (let ((name-output (make-string-output-stream))) - (let ((proc (ext:run-program - *c++-compiler* - '("-print-file-name=libstdc++.so") - :env env - :input nil - :output name-output - :error error-output))) - (unless proc - (error "Could not run ~A" *c++-compiler*)) - (unless (zerop (ext:process-exit-code proc)) - (system:serve-all-events 0) - (error "~A failed:~%~A" *c++-compiler* - (get-output-stream-string error-output)))) - (string-right-trim '(#\Newline) (get-output-stream-string name-output))))) - -(defvar *swig-interface* nil) - -(defvar *swig-uffi-pathname* #p"/tmp/swig-uffi.lisp") - -(defun link-swig () - (setq *swig-interface* - (run-swig (merge-pathnames "Source/swig.i" *swig-source-directory*) - :directory-search-list - (list (merge-pathnames "Source/" *swig-source-directory*)) - :module "swig" - :ignore-errors t - :c++ t)) - (with-open-file (f *swig-uffi-pathname* :direction :output) - (let ((*linkage* :c++) - (*uffi-definitions* '()) - (*uffi-output* f) - (*uffi-primitive-type-alist* *uffi-default-primitive-type-alist*)) - (apply 'handle-node *swig-interface*))) - (compile-file *swig-uffi-pathname*) - (alien:load-foreign (merge-pathnames "Source/libswig.a" - *swig-source-directory*) - :libraries (list (stdc++-library))) - ;; FIXME: UFFI stuffes a "-l" in front of the passed library names - ;; (uffi:load-foreign-library (merge-pathnames "Source/libswig.a" - ;; *swig-source-directory*) - ;; :supporting-libraries - ;; (list (stdc++-library))) - (load (compile-file-pathname *swig-uffi-pathname*))) - -||# - -;;;; TODO: - -;; * How to do type lookups? Is everything important that SWIG knows -;; about the types written out? What to make of typemaps? -;; -;; * Wrapped functions should probably automatically COERCE their -;; arguments (as of type DOUBLE-FLOAT), to make the functions more -;; flexible? -;; -;; * Why are the functions created by FFI interpreted? -;; -;; * We can't deal with more complicated structs and C++ classes -;; directly with the FFI; we have to emit SWIG wrappers that access -;; those classes. -;; -;; * A CLOS layer where structure fields are mapped as slots. It -;; looks like we need MOP functions to implement this. -;; -;; * Maybe modify SWIG so that key-value hashes are distinguished from -;; value-value hashes. diff --git a/Source/Modules/s-exp.cxx b/Source/Modules/s-exp.cxx deleted file mode 100644 index fe3b1facc..000000000 --- a/Source/Modules/s-exp.cxx +++ /dev/null @@ -1,402 +0,0 @@ -/* ----------------------------------------------------------------------------- - * This file is part of SWIG, which is licensed as a whole under version 3 - * (or any later version) of the GNU General Public License. Some additional - * terms also apply to certain portions of SWIG. The full details of the SWIG - * license and copyrights can be found in the LICENSE and COPYRIGHT files - * included with the SWIG source code as distributed by the SWIG developers - * and at http://www.swig.org/legal.html. - * - * s-exp.cxx - * - * A parse tree represented as Lisp s-expressions. - * ----------------------------------------------------------------------------- */ - -#include "swigmod.h" -#include "dohint.h" - -static const char *usage = "\ -S-Exp Options (available with -sexp)\n\ - -typemaplang - Typemap language\n\n"; - -//static Node *view_top = 0; -static File *out = 0; - -class Sexp:public Language { - int indent_level; - DOHHash *print_circle_hash; - int print_circle_count; - int hanging_parens; - bool need_whitespace; - bool need_newline; - -public: - Sexp(): - indent_level(0), - print_circle_hash(0), - print_circle_count(0), - hanging_parens(0), - need_whitespace(0), - need_newline(0) { - } - - virtual ~ Sexp() { - } - - virtual void main(int argc, char *argv[]) { - // Add a symbol to the parser for conditional compilation - Preprocessor_define("SWIGSEXP 1", 0); - - SWIG_typemap_lang("sexp"); - for (int iX = 0; iX < argc; iX++) { - if (strcmp(argv[iX], "-typemaplang") == 0) { - Swig_mark_arg(iX); - iX++; - SWIG_typemap_lang(argv[iX]); - Swig_mark_arg(iX); - continue; - } - if (strcmp(argv[iX], "-help") == 0) { - fputs(usage, stdout); - } - } - } - - /* Top of the parse tree */ - virtual int top(Node *n) { - if (out == 0) { - String *outfile = Getattr(n, "outfile"); - Replaceall(outfile, "_wrap.cxx", ".lisp"); - Replaceall(outfile, "_wrap.c", ".lisp"); - out = NewFile(outfile, "w", SWIG_output_files()); - if (!out) { - FileErrorDisplay(outfile); - SWIG_exit(EXIT_FAILURE); - } - } - String *f_sink = NewString(""); - Swig_register_filebyname("header", f_sink); - Swig_register_filebyname("wrapper", f_sink); - Swig_register_filebyname("begin", f_sink); - Swig_register_filebyname("runtime", f_sink); - Swig_register_filebyname("init", f_sink); - - Swig_banner_target_lang(out, ";;;"); - - Language::top(n); - Printf(out, "\n"); - Printf(out, ";;; Lisp parse tree produced by SWIG\n"); - print_circle_hash = NewHash(); - print_circle_count = 0; - hanging_parens = 0; - need_whitespace = 0; - need_newline = 0; - Sexp_print_node(n); - flush_parens(); - return SWIG_OK; - } - - void print_indent() { - int i; - for (i = 0; i < indent_level; i++) { - Printf(out, " "); - } - } - - void open_paren(const String *oper) { - flush_parens(); - Printf(out, "("); - if (oper) - Printf(out, "%s ", oper); - indent_level += 2; - } - - void close_paren(bool neednewline = false) { - hanging_parens++; - if (neednewline) - print_lazy_whitespace(); - indent_level -= 2; - } - - void flush_parens() { - int i; - if (hanging_parens) { - for (i = 0; i < hanging_parens; i++) - Printf(out, ")"); - hanging_parens = 0; - need_newline = true; - need_whitespace = true; - } - if (need_newline) { - Printf(out, "\n"); - print_indent(); - need_newline = false; - need_whitespace = false; - } else if (need_whitespace) { - Printf(out, " "); - need_whitespace = false; - } - } - - void print_lazy_whitespace() { - need_whitespace = 1; - } - - void print_lazy_newline() { - need_newline = 1; - } - - bool internal_key_p(DOH *key) { - return ((Cmp(key, "nodeType") == 0) - || (Cmp(key, "firstChild") == 0) - || (Cmp(key, "lastChild") == 0) - || (Cmp(key, "parentNode") == 0) - || (Cmp(key, "nextSibling") == 0) - || (Cmp(key, "previousSibling") == 0) - || (Cmp(key, "csym:nextSibling") == 0) - || (Cmp(key, "csym:previousSibling") == 0) - || (Cmp(key, "typepass:visit") == 0) - || (Cmp(key, "allocate:visit") == 0) - || (*(Char(key)) == '$')); - } - - bool boolean_key_p(DOH *key) { - return ((Cmp(key, "allocate:default_constructor") == 0) - || (Cmp(key, "allocate:default_destructor") == 0) - || (Cmp(key, "allows_typedef") == 0) - || (Cmp(key, "feature:immutable") == 0)); - } - - bool list_key_p(DOH *key) { - return ((Cmp(key, "parms") == 0) - || (Cmp(key, "baselist") == 0)); - } - - bool plist_key_p(DOH *key) - // true if KEY is the name of data that is a mapping from keys to - // values, which should be printed as a plist. - { - return ((Cmp(key, "typescope") == 0)); - } - - bool maybe_plist_key_p(DOH *key) { - return (Strncmp(key, "tmap:", 5) == 0); - } - - bool print_circle(DOH *obj, bool list_p) - // We have a complex object, which might be referenced several - // times, or even recursively. Use Lisp's reader notation for - // circular structures (#n#, #n=). - // - // An object can be printed in list-mode or object-mode; LIST_P toggles. - // return TRUE if OBJ still needs to be printed - { - flush_parens(); - // Following is a silly hack. It works around the limitation of - // DOH's hash tables that only work with string keys! - char address[32]; - sprintf(address, "%p%c", obj, list_p ? 'L' : 'O'); - DOH *placeholder = Getattr(print_circle_hash, address); - if (placeholder) { - Printv(out, placeholder, NIL); - return false; - } else { - String *placeholder = NewStringf("#%d#", ++print_circle_count); - Setattr(print_circle_hash, address, placeholder); - Printf(out, "#%d=", print_circle_count); - return true; - } - } - - void Sexp_print_value_of_key(DOH *value, DOH *key) { - if ((Cmp(key, "parms") == 0) || (Cmp(key, "wrap:parms") == 0) - || (Cmp(key, "kwargs") == 0) || (Cmp(key, "pattern") == 0)) - Sexp_print_parms(value); - else if (plist_key_p(key)) - Sexp_print_plist(value); - else if (maybe_plist_key_p(key)) { - if (DohIsMapping(value)) - Sexp_print_plist(value); - else - Sexp_print_doh(value); - } else if (list_key_p(key)) - Sexp_print_list(value); - else if (boolean_key_p(key)) - Sexp_print_boolean(value); - else - Sexp_print_doh(value); - } - - void Sexp_print_boolean(DOH *obj) { - flush_parens(); - /* See DOH/Doh/base.c, DohGetInt() */ - if (DohIsString(obj)) { - if (atoi(Char(obj)) != 0) - Printf(out, "t"); - else - Printf(out, "nil"); - } else - Printf(out, "nil"); - } - - void Sexp_print_list(DOH *obj) { - if (print_circle(obj, true)) { - open_paren(NIL); - for (; obj; obj = nextSibling(obj)) { - Sexp_print_doh(obj); - print_lazy_whitespace(); - } - close_paren(true); - } - } - - void Sexp_print_parms(DOH *obj) { - // print it as a list of plists - if (print_circle(obj, true)) { - open_paren(NIL); - for (; obj; obj = nextSibling(obj)) { - if (DohIsMapping(obj)) { - Iterator k; - open_paren(NIL); - for (k = First(obj); k.key; k = Next(k)) { - if (!internal_key_p(k.key)) { - DOH *value = Getattr(obj, k.key); - Sexp_print_as_keyword(k.key); - Sexp_print_value_of_key(value, k.key); - print_lazy_whitespace(); - } - } - close_paren(true); - } else - Sexp_print_doh(obj); - print_lazy_whitespace(); - } - close_paren(true); - } - } - - void Sexp_print_doh(DOH *obj) { - flush_parens(); - if (DohIsString(obj)) { - String *o = Str(obj); - Replaceall(o, "\\", "\\\\"); - Replaceall(o, "\"", "\\\""); - Printf(out, "\"%s\"", o); - Delete(o); - } else { - if (print_circle(obj, false)) { - // Dispatch type - if (nodeType(obj)) { - Sexp_print_node(obj); - } - - else if (DohIsMapping(obj)) { - Iterator k; - open_paren(NIL); - for (k = First(obj); k.key; k = Next(k)) { - if (!internal_key_p(k.key)) { - DOH *value = Getattr(obj, k.key); - flush_parens(); - open_paren(NIL); - Sexp_print_doh(k.key); - Printf(out, " . "); - Sexp_print_value_of_key(value, k.key); - close_paren(); - } - } - close_paren(); - } else if (strcmp(ObjType(obj)->objname, "List") == 0) { - int i; - open_paren(NIL); - for (i = 0; i < Len(obj); i++) { - DOH *item = Getitem(obj, i); - Sexp_print_doh(item); - } - close_paren(); - } else { - // What is it? - Printf(out, "#", ObjType(obj)->objname, obj); - } - } - } - } - - void Sexp_print_as_keyword(const DOH *k) { - /* Print key, replacing ":" with "-" because : is CL's package prefix */ - flush_parens(); - String *key = NewString(k); - Replaceall(key, ":", "-"); - Replaceall(key, "_", "-"); - Printf(out, ":%s ", key); - Delete(key); - } - - void Sexp_print_plist_noparens(DOH *obj) { - /* attributes map names to objects */ - Iterator k; - bool first; - for (k = First(obj), first = true; k.key; k = Next(k), first = false) { - if (!internal_key_p(k.key)) { - DOH *value = Getattr(obj, k.key); - flush_parens(); - if (!first) { - Printf(out, " "); - } - Sexp_print_as_keyword(k.key); - /* Print value */ - Sexp_print_value_of_key(value, k.key); - } - } - } - - void Sexp_print_plist(DOH *obj) { - flush_parens(); - if (print_circle(obj, true)) { - open_paren(NIL); - Sexp_print_plist_noparens(obj); - close_paren(); - } - } - - void Sexp_print_attributes(Node *obj) { - Sexp_print_plist_noparens(obj); - } - - void Sexp_print_node(Node *obj) { - Node *cobj; - open_paren(nodeType(obj)); - /* A node has an attribute list... */ - Sexp_print_attributes(obj); - /* ... and child nodes. */ - cobj = firstChild(obj); - if (cobj) { - print_lazy_newline(); - flush_parens(); - Sexp_print_as_keyword("children"); - open_paren(NIL); - for (; cobj; cobj = nextSibling(cobj)) { - Sexp_print_node(cobj); - } - close_paren(); - } - close_paren(); - } - - - virtual int functionWrapper(Node *n) { - ParmList *l = Getattr(n, "parms"); - Wrapper *f = NewWrapper(); - emit_attach_parmmaps(l, f); - Setattr(n, "wrap:parms", l); - DelWrapper(f); - return SWIG_OK; - } - -}; - - -static Language *new_swig_sexp() { - return new Sexp(); -} -extern "C" Language *swig_sexp(void) { - return new_swig_sexp(); -}