Re: [PATCH] ob-C: Add list support.

[Eric Schulte <schulte.eric@gmail.com>]

Hi Rüdiger,

Thanks for sharing this patch.  I looks great, however as it is >10
lines long to apply it we'll need you to sign the FSF papers.  Please
see the following page for more information.

  http://orgmode.org/worg/org-contribute.html

Thanks,

Rüdiger Sonderfeld <ruediger@c-plusplus.de> writes:

> * 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
> - 

-- 
Eric Schulte
http://cs.unm.edu/~eschulte