From 06996e7af7c24b8b6adc16b13c183dcc46b5362c Mon Sep 17 00:00:00 2001 From: Thierry Banel Date: Sun, 8 Jun 2014 22:01:56 +0200 Subject: [PATCH] Babel C, C++, D support for non-homogeneous input tables * ob-C.el: handling of non-homogeneous tables, support for table header, support for iterating over table cells. (org-babel-expand-body:C++): uncomment (org-babel-C-execute): cosmetic changes (org-babel-C-expand-C): add support for table columns names, add support for table dimensions, add standard includes (org-babel-C-val-to-C-type): rewrite to support non-homogeneous tables cells (org-babel-C-table-sizes-to-C): new function to gain access to the table dimensions (org-babel-C-utility-header-to-C): (org-babel-C-header-to-C): new functions to generate support for table header. * ob-C-test.org: added D sibling tests similar to C++, added non-homogeneous table example for C++ and D * test-ob-C.el: new tests for D and non-homogeneous tables (ob-C/simple-program): (ob-C/simple-program): (ob-D/simple-program): (ob-C/integer-var): (ob-D/integer-var): (ob-C/two-integer-var): (ob-D/two-integer-var): (ob-C/string-var): (ob-D/string-var): (ob-C/preprocessor): (ob-C/table): (ob-D/table): (ob-C/list-var): (ob-D/list-var): (ob-C/vector-var): (ob-D/vector-var): (ob-C/list-list-var): (ob-D/list-list-var): (ob-C/inhomogeneous_table): (ob-D/inhomogeneous_table): add compiler availability check (ob-D/simple-program): (ob-D/integer-var): (ob-D/two-integer-var): (ob-D/string-var): (ob-D/table): (ob-D/list-var): (ob-D/vector-var): (ob-D/list-list-var): (ob-D/inhomogeneous_table): add D unit tests (ob-C/inhomogeneous_table): (ob-D/inhomogeneous_table): add non-homogeneous table unit tests --- lisp/ob-C.el | 292 +++++++++++++++++++++++++++------------- testing/examples/ob-C-test.org | 88 ++++++++++++ testing/lisp/test-ob-C.el | 161 +++++++++++++++++----- 3 files changed, 416 insertions(+), 125 deletions(-) diff --git a/lisp/ob-C.el b/lisp/ob-C.el index 793981a..dd03fa7 100644 --- a/lisp/ob-C.el +++ b/lisp/ob-C.el @@ -34,8 +34,6 @@ (require 'cl)) (require 'ob) (require 'cc-mode) -(eval-when-compile - (require 'cl)) (declare-function org-entry-get "org" (pom property &optional inherit literal-nil)) @@ -72,40 +70,40 @@ This function calls `org-babel-execute:C++'." 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) ;; unused -;; "Expand a block of C++ code with org-babel according to it's -;;header arguments (calls `org-babel-C-expand')." -;; (let ((org-babel-c-variant 'cpp)) (org-babel-C-expand body params))) +(defun org-babel-expand-body:C++ (body params) + "Expand a block of C++ code with org-babel according to it's +header arguments." + (let ((org-babel-c-variant 'cpp)) (org-babel-C-expand-C++ body params))) (defun org-babel-execute:D (body params) "Execute a block of D code with org-babel. This function is called by `org-babel-execute-src-block'." (let ((org-babel-c-variant 'd)) (org-babel-C-execute body params))) -;; (defun org-babel-expand-body:D (body params) ;; unused -;; "Expand a block of D code with org-babel according to it's -;;header arguments (calls `org-babel-C-expand')." -;; (let ((org-babel-c-variant 'd)) (org-babel-C-expand body params))) +(defun org-babel-expand-body:D (body params) + "Expand a block of D code with org-babel according to it's +header arguments." + (let ((org-babel-c-variant 'd)) (org-babel-C-expand-D 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'." (let ((org-babel-c-variant 'c)) (org-babel-C-execute body params))) -;; (defun org-babel-expand-body:c (body params) ;; unused -;; "Expand a block of C code with org-babel according to it's -;;header arguments (calls `org-babel-C-expand')." -;; (let ((org-babel-c-variant 'c)) (org-babel-C-expand body params))) +(defun org-babel-expand-body:C (body params) + "Expand a block of C code with org-babel according to it's +header arguments." + (let ((org-babel-c-variant 'c)) (org-babel-C-expand-C body params))) (defun org-babel-C-execute (body params) "This function should only be called by `org-babel-execute:C' or `org-babel-execute:C++' or `org-babel-execute:D'." (let* ((tmp-src-file (org-babel-temp-file "C-src-" - (cond - ((equal org-babel-c-variant 'c ) ".c" ) - ((equal org-babel-c-variant 'cpp) ".cpp") - ((equal org-babel-c-variant 'd ) ".d" )))) + (case org-babel-c-variant + (c ".c" ) + (cpp ".cpp") + (d ".d" )))) (tmp-bin-file (org-babel-temp-file "C-bin-" org-babel-exeext)) ;; not used for D (cmdline (cdr (assoc :cmdline params))) (cmdline (if cmdline (concat " " cmdline) "")) @@ -113,43 +111,47 @@ or `org-babel-execute:C++' or `org-babel-execute:D'." (flags (mapconcat 'identity (if (listp flags) flags (list flags)) " ")) (full-body - (cond ((equal org-babel-c-variant 'c ) (org-babel-C-expand-C body params)) - ((equal org-babel-c-variant 'cpp) (org-babel-C-expand-C++ body params)) - ((equal org-babel-c-variant 'd ) (org-babel-C-expand-D body params))))) + (case org-babel-c-variant + (c (org-babel-C-expand-C body params)) + (cpp (org-babel-C-expand-C++ body params)) + (d (org-babel-C-expand-D body params))))) (with-temp-file tmp-src-file (insert full-body)) - (if (memq org-babel-c-variant '(c cpp)) ;; no separate compilation for D - (org-babel-eval - (format "%s -o %s %s %s" - (cond - ((equal org-babel-c-variant 'c ) org-babel-C-compiler) - ((equal org-babel-c-variant 'cpp) org-babel-C++-compiler)) - (org-babel-process-file-name tmp-bin-file) - flags - (org-babel-process-file-name tmp-src-file)) "")) + (case org-babel-c-variant + ((c cpp) + (org-babel-eval + (format "%s -o %s %s %s" + (case org-babel-c-variant + (c org-babel-C-compiler) + (cpp org-babel-C++-compiler)) + (org-babel-process-file-name tmp-bin-file) + flags + (org-babel-process-file-name tmp-src-file)) "")) + (d nil)) ;; no separate compilation for D (let ((results - (org-babel-trim - (org-remove-indentation - (org-babel-eval - (cond ((memq org-babel-c-variant '(c cpp)) - (concat tmp-bin-file cmdline)) - ((equal org-babel-c-variant 'd) - (format "%s %s %s %s" - org-babel-D-compiler - flags - (org-babel-process-file-name tmp-src-file) - cmdline))) - ""))))) - (org-babel-reassemble-table - (org-babel-result-cond (cdr (assoc :result-params params)) - (org-babel-read results t) - (let ((tmp-file (org-babel-temp-file "c-"))) - (with-temp-file tmp-file (insert results)) - (org-babel-import-elisp-from-file tmp-file))) - (org-babel-pick-name - (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) - (org-babel-pick-name - (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))) - )) + (org-babel-eval + (case org-babel-c-variant + ((c cpp) + (concat tmp-bin-file cmdline)) + (d + (format "%s %s %s %s" + org-babel-D-compiler + flags + (org-babel-process-file-name tmp-src-file) + cmdline))) + ""))) + (when results + (setq results (org-babel-trim (org-remove-indentation results))) + (org-babel-reassemble-table + (org-babel-result-cond (cdr (assoc :result-params params)) + (org-babel-read results t) + (let ((tmp-file (org-babel-temp-file "c-"))) + (with-temp-file tmp-file (insert results)) + (org-babel-import-elisp-from-file tmp-file))) + (org-babel-pick-name + (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) + (org-babel-pick-name + (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))) + ))) (defun org-babel-C-expand-C++ (body params) "Expand a block of C or C++ code with org-babel according to @@ -160,24 +162,34 @@ it's header arguments." "Expand a block of C or C++ code with org-babel according to it's header arguments." (let ((vars (mapcar #'cdr (org-babel-get-header params :var))) + (colnames (cdar (org-babel-get-header params :colname-names))) (main-p (not (string= (cdr (assoc :main params)) "no"))) (includes (or (cdr (assoc :includes params)) (org-babel-read (org-entry-get nil "includes" t)))) (defines (org-babel-read (or (cdr (assoc :defines params)) (org-babel-read (org-entry-get nil "defines" t)))))) + (unless (listp includes) (setq includes (list includes))) + (setq includes (append includes '("" "" ""))) (mapconcat 'identity (list ;; includes (mapconcat (lambda (inc) (format "#include %s" inc)) - (if (listp includes) includes (list includes)) "\n") + includes "\n") ;; defines (mapconcat (lambda (inc) (format "#define %s" inc)) (if (listp defines) defines (list defines)) "\n") ;; variables (mapconcat 'org-babel-C-var-to-C vars "\n") + ;; table sizes + (mapconcat 'org-babel-C-table-sizes-to-C vars "\n") + ;; tables headers utility + (when colnames + (org-babel-C-utility-header-to-C)) + ;; tables headers + (mapconcat 'org-babel-C-header-to-C colnames "\n") ;; body (if main-p (org-babel-C-ensure-main-wrap body) @@ -187,18 +199,28 @@ it's header arguments." "Expand a block of D code with org-babel according to it's header arguments." (let ((vars (mapcar #'cdr (org-babel-get-header params :var))) + (colnames (cdar (org-babel-get-header params :colname-names))) (main-p (not (string= (cdr (assoc :main params)) "no"))) (imports (or (cdr (assoc :imports params)) (org-babel-read (org-entry-get nil "imports" t))))) + (unless (listp imports) (setq imports (list imports))) + (setq imports (append imports '("std.stdio" "std.conv"))) (mapconcat 'identity (list "module mmm;" ;; imports (mapconcat (lambda (inc) (format "import %s;" inc)) - (if (listp imports) imports (list imports)) "\n") + imports "\n") ;; variables (mapconcat 'org-babel-C-var-to-C vars "\n") + ;; table sizes + (mapconcat 'org-babel-C-table-sizes-to-C vars "\n") + ;; tables headers utility + (when colnames + (org-babel-C-utility-header-to-C)) + ;; tables headers + (mapconcat 'org-babel-C-header-to-C colnames "\n") ;; body (if main-p (org-babel-C-ensure-main-wrap body) @@ -233,46 +255,68 @@ support for sessions" "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." + (let* ((basetype (org-babel-C-val-to-base-type val)) + (type + (case basetype + (integerp '("int" "%d")) + (floatp '("double" "%f")) + (stringp + (list + (if (equal org-babel-c-variant 'd) "string" "const char*") + "\"%s\"")) + (t (error "unknown type %S" type))))) + (cond + ((integerp val) type) ;; an integer declared in the #+begin_src line + ((floatp val) type) ;; a numeric declared in the #+begin_src line + ((and (listp val) (listp (car val))) ;; a table + `(,(car type) + (lambda (val) + (cons + (format "[%d][%d]" (length val) (length (car val))) + (concat + (if (equal org-babel-c-variant 'd) "[\n" "{\n") + (mapconcat + (lambda (v) + (concat + (if (equal org-babel-c-variant 'd) " [" " {") + (mapconcat (lambda (w) (format ,(cadr type) w)) v ",") + (if (equal org-babel-c-variant 'd) "]" "}"))) + val + ",\n") + (if (equal org-babel-c-variant 'd) "\n]" "\n}")))))) + ((or (listp val) (vectorp val)) ;; a list declared in the #+begin_src line + `(,(car type) + (lambda (val) + (cons + (format "[%d]" (length val)) + (concat + (if (equal org-babel-c-variant 'd) "[" "{") + (mapconcat (lambda (v) (format ,(cadr type) v)) val ",") + (if (equal org-babel-c-variant 'd) "]" "}")))))) + (t ;; treat unknown types as string + type)))) + +(defun org-babel-C-val-to-base-type (val) + "Determine the base type of VAL which may be +'integerp if all base values are integers +'floatp if all base values are either floating points or integers +'stringp otherwise." (cond - ((integerp val) '("int" "%d")) - ((floatp val) '("double" "%f")) + ((integerp val) 'integerp) + ((floatp val) 'floatp) ((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 (if (equal org-babel-c-variant 'd) "[ " "{ ") - (mapconcat (lambda (v) - (cdr (org-babel-C-format-val type v))) - val - ", ") - (if (equal org-babel-c-variant 'd) " ]" " }"))))))) - (t ;; treat unknown types as string - (list - (if (equal org-babel-c-variant 'd) "string" "const char*") - "\"%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)) + (let ((type nil)) + (mapc (lambda (v) + (case (org-babel-C-val-to-base-type v) + (stringp (setq type 'stringp)) + (floatp + (if (or (not type) (eq type 'integerp)) + (setq type 'floatp))) + (integerp + (unless type (setq type 'integerp))))) + val) + type)) + (t 'stringp))) (defun org-babel-C-var-to-C (pair) "Convert an elisp val into a string of C code specifying a var @@ -295,6 +339,68 @@ of the same value." suffix data)))) +(defun org-babel-C-table-sizes-to-C (pair) + "Create constants of table dimensions, if PAIR is a table." + (when (listp (cdr pair)) + (cond + ((listp (cadr pair)) ;; a table + (concat + (format "const int %s_rows = %d;" (car pair) (length (cdr pair))) + "\n" + (format "const int %s_cols = %d;" (car pair) (length (cadr pair))))) + (t ;; a list declared in the #+begin_src line + (format "const int %s_cols = %d;" (car pair) (length (cdr pair))))))) + +(defun org-babel-C-utility-header-to-C () + "Generate a utility function to convert a column name +into a column number." + (case org-babel-c-variant + ((c cpp) + "int get_column_num (int nbcols, const char** header, const char* column) +{ + int c; + for (c=0; c" :results silent std::cout << q; return 0; #+end_src +#+source: integer_var +#+begin_src D :var q=12 :results silent + writefln ("%s", q); +#+end_src + #+source: two_var #+begin_src cpp :var q=12 :var p=10 :includes "" :results silent std::cout << p+q; return 0; #+end_src +#+source: two_var +#+begin_src D :var q=12 :var p=10 :results silent + writefln ("%s", p+q); +#+end_src + #+source: string_var #+begin_src cpp :var q="word" :includes '( ) :results silent std::cout << q << ' ' << std::strlen(q); return 0; #+end_src +#+source: string_var +#+begin_src D :var q="word" :results silent + writefln ("%s %s", q, q.length); +#+end_src + #+source: define #+begin_src cpp :defines N 42 :includes "" :results silent std::cout << N; @@ -45,6 +65,13 @@ } return 0; #+end_src + +#+source: array +#+begin_src D :results vector :results silent + foreach (i; 1..3) + writefln ("%s", i); +#+end_src + * Matrix :PROPERTIES: :ID: cc65d6b3-8e8e-4f9c-94cd-f5a00cdeceb5 @@ -58,13 +85,74 @@ std::cout << a[0] << a[1] << sizeof(a)/sizeof(*a) << '\n'; #+end_src +#+source: list_var +#+begin_src D :var a='("abc" "def") :results silent + writefln ("%s%s%s", a[0], a[1], a.length); +#+end_src + #+source: vector_var #+begin_src cpp :var a='[1 2] :includes "" :results silent std::cout << a[0] << a[1] << sizeof(a)/sizeof(*a) << '\n'; #+end_src +#+source: vector_var +#+begin_src D :var a='[1 2] :results silent + writefln ("%s%s%s", a[0], a[1], a.length); +#+end_src + #+source: list_list_var #+begin_src cpp :var q=C-matrix :includes "" :results silent std::cout << q[0][0] << ' ' << q[1][0] << '\n' << q[0][1] << ' ' << q[1][1] << '\n'; // transpose #+end_src + +#+source: list_list_var +#+begin_src D :var q=C-matrix :results silent + writefln ("%s %s", q[0][0], q[1][0]); + writefln ("%s %s", q[0][1], q[1][1]); // transpose +#+end_src + +* Inhomogeneous table + :PROPERTIES: + :ID: e112bc2e-419a-4890-99c2-7ac4779531cc + :END: + +#+tblname: tinomogen + | day | quty | + |-----------+------| + | monday | 34 | + | tuesday | 41 | + | wednesday | 56 | + | thursday | 17 | + | friday | 12 | + | saturday | 7 | + | sunday | 4 | + +#+source: inhomogeneous_table +#+begin_src cpp :var tinomogen=tinomogen :results silent +int main() +{ + int i, j; + for (i=0; i