emacs-orgmode@gnu.org archives
 help / color / mirror / code / Atom feed
From: "Rüdiger Sonderfeld" <ruediger@c-plusplus.de>
To: emacs-orgmode@gnu.org
Cc: Eric Schulte <schulte.eric@gmail.com>
Subject: [PATCH] ob-C: Add list support.
Date: Thu, 06 Jun 2013 19:49:03 +0200	[thread overview]
Message-ID: <2536552.JaI2attv7o@descartes> (raw)
In-Reply-To: <87vc5ri259.fsf@gmail.com>

* lisp/ob-C.el (org-babel-C-var-to-C): Add list support
(org-babel-C-val-to-C-list-type, org-babel-C-val-to-C-type,
org-babel-C-format-val): New functions.
(org-babel-C-ensure-main-wrap, org-babel-execute:C,
org-babel-execute:C++, rg-babel-execute:cpp, org-babel-C++-compiler,
org-babel-C-compiler): Improve docstring.
* testing/examples/ob-C-test.org (string_var): Add required std::
(Array): Add missing ID.
(Matrix): Add tests for list support.
* testing/lisp/test-ob-C.el (ob-C/table): Test succeeds.
(ob-C/list-var, ob-C/vector-var, ob-C/list-list-var): Add tests for
list support.

Signed-off-by: Rüdiger Sonderfeld <ruediger@c-plusplus.de>
---
 lisp/ob-C.el                   | 98 +++++++++++++++++++++++++++++++-----------
 testing/examples/ob-C-test.org | 28 +++++++++++-
 testing/lisp/test-ob-C.el      | 20 ++++++++-
 3 files changed, 118 insertions(+), 28 deletions(-)

diff --git a/lisp/ob-C.el b/lisp/ob-C.el
index b1e8a06..e9eec93 100644
--- a/lisp/ob-C.el
+++ b/lisp/ob-C.el
@@ -44,24 +44,24 @@ (defvar org-babel-default-header-args:C '())
 
 (defvar org-babel-C-compiler "gcc"
   "Command used to compile a C source code file into an
-  executable.")
+executable.")
 
 (defvar org-babel-C++-compiler "g++"
   "Command used to compile a C++ source code file into an
-  executable.")
+executable.")
 
 (defvar org-babel-c-variant nil
   "Internal variable used to hold which type of C (e.g. C or C++)
 is currently being evaluated.")
 
 (defun org-babel-execute:cpp (body params)
-  "Execute BODY according to PARAMS.  This function calls
-`org-babel-execute:C++'."
+  "Execute BODY according to PARAMS.
+This function calls `org-babel-execute:C++'."
   (org-babel-execute:C++ body params))
 
 (defun org-babel-execute:C++ (body params)
-  "Execute a block of C++ code with org-babel.  This function is
-called by `org-babel-execute-src-block'."
+  "Execute a block of C++ code with org-babel.
+This function is called by `org-babel-execute-src-block'."
   (let ((org-babel-c-variant 'cpp)) (org-babel-C-execute body params)))
 
 (defun org-babel-expand-body:C++ (body params)
@@ -70,8 +70,8 @@ (defun org-babel-expand-body:C++ (body params)
   (let ((org-babel-c-variant 'cpp)) (org-babel-C-expand body params)))
 
 (defun org-babel-execute:C (body params)
-  "Execute a block of C code with org-babel.  This function is
-called by `org-babel-execute-src-block'."
+  "Execute a block of C code with org-babel.
+This function is called by `org-babel-execute-src-block'."
   (let ((org-babel-c-variant 'c)) (org-babel-C-execute body params)))
 
 (defun org-babel-expand-body:c (body params)
@@ -146,10 +146,10 @@ (defun org-babel-C-expand (body params)
 		  body) "\n") "\n")))
 
 (defun org-babel-C-ensure-main-wrap (body)
-  "Wrap body in a \"main\" function call if none exists."
+  "Wrap BODY in a \"main\" function call if none exists."
   (if (string-match "^[ \t]*[intvod]+[ \t\n\r]*main[ \t]*(.*)" body)
       body
-    (format "int main() {\n%s\nreturn(0);\n}\n" body)))
+    (format "int main() {\n%s\nreturn 0;\n}\n" body)))
 
 (defun org-babel-prep-session:C (session params)
   "This function does nothing as C is a compiled language with no
@@ -163,6 +163,59 @@ (defun org-babel-load-session:C (session body params)
 
 ;; helper functions
 
+(defun org-babel-C-format-val (type val)
+  "Handle the FORMAT part of TYPE with the data from VAL."
+  (let ((format-data (cadr type)))
+    (if (stringp format-data)
+	(cons "" (format format-data val))
+      (funcall format-data val))))
+
+(defun org-babel-C-val-to-C-type (val)
+  "Determine the type of VAL.
+Return a list (TYPE-NAME FORMAT).  TYPE-NAME should be the name of the type.
+FORMAT can be either a format string or a function which is called with VAL."
+  (cond
+   ((integerp val) '("int" "%d"))
+   ((floatp val) '("double" "%f"))
+   ((or (listp val) (vectorp val))
+    (lexical-let ((type (org-babel-C-val-to-C-list-type val)))
+      (list (car type)
+	    (lambda (val)
+	      (cons
+	       (format "[%d]%s"
+		       (length val)
+		       (car (org-babel-C-format-val type (elt val 0))))
+	       (concat "{ "
+		       (mapconcat (lambda (v)
+				    (cdr (org-babel-C-format-val type v)))
+				  val
+				  ", ")
+		       " }"))))))
+   (t ;; treat unknown types as string
+    '("char" (lambda (val)
+	       (let ((s (format "%s" val))) ;; convert to string for unknown types
+		 (cons (format "[%d]" (1+ (length s)))
+		       (concat "\"" s "\""))))))))
+
+(defun org-babel-C-val-to-C-list-type (val)
+  "Determine the C array type of a VAL."
+  (let (type)
+    (mapc
+     #'(lambda (i)
+	 (let* ((tmp-type (org-babel-C-val-to-C-type i))
+		(type-name (car type))
+		(tmp-type-name (car tmp-type)))
+	   (when (and type (not (string= type-name tmp-type-name)))
+	     (if (and (member type-name '("int" "double" "int32_t"))
+		      (member tmp-type-name '("int" "double" "int32_t")))
+		 (setq tmp-type '("double" "" "%f"))
+	       (error "Only homogeneous lists are supported by C.  You can not mix %s and %s"
+		      type-name
+		      tmp-type-name)))
+	   (setq type tmp-type)))
+     val)
+    type))
+
 (defun org-babel-C-var-to-C (pair)
   "Convert an elisp val into a string of C code specifying a var
 of the same value."
@@ -173,22 +226,17 @@ (defun org-babel-C-var-to-C (pair)
       (setq val (symbol-name val))
       (when (= (length val) 1)
         (setq val (string-to-char val))))
-    (cond
-     ((integerp val)
-      (format "int %S = %S;" var val))
-     ((floatp val)
-      (format "double %S = %S;" var val))
-     ((or (integerp val))
-      (format "char %S = '%S';" var val))
-     ((stringp val)
-      (format "char %S[%d] = \"%s\";"
-              var (+ 1 (length val)) val))
-     (t
-      (format "u32 %S = %S;" var val)))))
-
+    (let* ((type-data (org-babel-C-val-to-C-type val))
+	   (type (car type-data))
+	   (formated (org-babel-C-format-val type-data val))
+	   (suffix (car formated))
+	   (data (cdr formated)))
+      (format "%s %s%s = %s;"
+	      type
+	      var
+	      suffix
+	      data))))
 
 (provide 'ob-C)
 
-
-
 ;;; ob-C.el ends here
diff --git a/testing/examples/ob-C-test.org b/testing/examples/ob-C-test.org
index 32ab88b..1d0a83f 100644
--- a/testing/examples/ob-C-test.org
+++ b/testing/examples/ob-C-test.org
@@ -24,7 +24,7 @@ * Simple tests
 
 #+source: string_var
 #+begin_src cpp :var q="word" :includes '(<iostream> <cstring>) :results silent
-  std::cout << q << ' ' << strlen(q);
+  std::cout << q << ' ' << std::strlen(q);
   return 0;
 #+end_src
 
@@ -35,6 +35,9 @@ * Simple tests
 #+end_src
 
 * Array
+  :PROPERTIES:
+  :ID:       2df1ab83-3fa3-462a-a1f3-3aef6044a874
+  :END:
 #+source: array
 #+begin_src cpp :includes "<iostream>" :results vector :results silent
   for (int i=1; i<3; i++) {
@@ -42,3 +45,26 @@ * Array
   }
   return 0;
 #+end_src
+* Matrix
+  :PROPERTIES:
+  :ID:       cc65d6b3-8e8e-4f9c-94cd-f5a00cdeceb5
+  :END:
+#+name: C-matrix
+| 1 | 2 |
+| 3 | 4 |
+
+#+source: list_var
+#+begin_src cpp :var a='("abc" "def") :includes "<iostream>" :results silent
+  std::cout << a[0] << a[1] << sizeof(a)/sizeof(*a) << '\n';
+#+end_src
+
+#+source: vector_var
+#+begin_src cpp :var a='[1 2] :includes "<iostream>" :results silent
+  std::cout << a[0] << a[1] << sizeof(a)/sizeof(*a) << '\n';
+#+end_src
+
+#+source: list_list_var
+#+begin_src cpp :var q=C-matrix :includes "<iostream>" :results silent
+  std::cout << q[0][0] << ' ' << q[1][0] << '\n'
+            << q[0][1] << ' ' << q[1][1] << '\n'; // transpose
+#+end_src
diff --git a/testing/lisp/test-ob-C.el b/testing/lisp/test-ob-C.el
index 4243bb6..4430ceb 100644
--- a/testing/lisp/test-ob-C.el
+++ b/testing/lisp/test-ob-C.el
@@ -57,10 +57,26 @@ (ert-deftest ob-C/preprocessor ()
 
 (ert-deftest ob-C/table ()
   "Test of a table output"
-  :expected-result :failed
   (org-test-at-id "2df1ab83-3fa3-462a-a1f3-3aef6044a874"
     (org-babel-next-src-block)
     (should (equal '((1) (2)) (org-babel-execute-src-block)))))
 
+(ert-deftest ob-C/list-var ()
+"Test of a list input variable"
+  (org-test-at-id "cc65d6b3-8e8e-4f9c-94cd-f5a00cdeceb5"
+    (org-babel-next-src-block 1)
+    (should (string= "abcdef2" (org-babel-execute-src-block)))))
+
+(ert-deftest ob-C/vector-var ()
+"Test of a vector input variable"
+  (org-test-at-id "cc65d6b3-8e8e-4f9c-94cd-f5a00cdeceb5"
+    (org-babel-next-src-block 2)
+    (should (equal 122 (org-babel-execute-src-block)))))
+
+(ert-deftest ob-C/list-list-var ()
+  "Test of a list list input variable"
+  (org-test-at-id "cc65d6b3-8e8e-4f9c-94cd-f5a00cdeceb5"
+    (org-babel-next-src-block 3)
+    (should (equal '((1 3) (2 4)) (org-babel-execute-src-block)))))
+
 ;;; test-ob-C.el ends here
- 
-- 
1.8.3

  reply	other threads:[~2013-06-06 17:49 UTC|newest]

Thread overview: 7+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2013-06-05 21:20 [PATCH] ob-C: Add list support Rüdiger Sonderfeld
2013-06-06 16:21 ` Eric Schulte
2013-06-06 17:15   ` Rüdiger Sonderfeld
2013-06-06 17:23     ` Eric Schulte
2013-06-06 17:49       ` Rüdiger Sonderfeld [this message]
2013-06-06 18:10         ` Eric Schulte
2013-06-06 18:38           ` Rüdiger Sonderfeld

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.orgmode.org/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=2536552.JaI2attv7o@descartes \
    --to=ruediger@c-plusplus.de \
    --cc=emacs-orgmode@gnu.org \
    --cc=schulte.eric@gmail.com \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs/org-mode.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).