Rewrite tags setting functions
[org-mode/org-tableheadings.git] / lisp / ob-C.el
blobff5be349676899d9909cc2dd1b5d63a8e00adf9d
1 ;;; ob-C.el --- Babel Functions for C and Similar Languages -*- lexical-binding: t; -*-
3 ;; Copyright (C) 2010-2018 Free Software Foundation, Inc.
5 ;; Author: Eric Schulte
6 ;; Thierry Banel
7 ;; Keywords: literate programming, reproducible research
8 ;; Homepage: https://orgmode.org
10 ;; This file is part of GNU Emacs.
12 ;; GNU Emacs is free software: you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation, either version 3 of the License, or
15 ;; (at your option) any later version.
17 ;; GNU Emacs is distributed in the hope that it will be useful,
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;; GNU General Public License for more details.
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
25 ;;; Commentary:
27 ;; Org-Babel support for evaluating C, C++, D code.
29 ;; very limited implementation:
30 ;; - currently only support :results output
31 ;; - not much in the way of error feedback
33 ;;; Code:
35 (require 'cc-mode)
36 (require 'ob)
39 (declare-function org-entry-get "org" (pom property &optional inherit literal-nil))
40 (declare-function org-remove-indentation "org" (code &optional n))
41 (declare-function org-trim "org" (s &optional keep-lead))
43 (defvar org-babel-tangle-lang-exts)
44 (add-to-list 'org-babel-tangle-lang-exts '("C++" . "cpp"))
45 (add-to-list 'org-babel-tangle-lang-exts '("D" . "d"))
47 (defvar org-babel-default-header-args:C '())
49 (defconst org-babel-header-args:C '((includes . :any)
50 (defines . :any)
51 (main . :any)
52 (flags . :any)
53 (cmdline . :any)
54 (libs . :any))
55 "C/C++-specific header arguments.")
57 (defconst org-babel-header-args:C++
58 (append '((namespaces . :any))
59 org-babel-header-args:C)
60 "C++-specific header arguments.")
62 (defcustom org-babel-C-compiler "gcc"
63 "Command used to compile a C source code file into an executable.
64 May be either a command in the path, like gcc
65 or an absolute path name, like /usr/local/bin/gcc
66 parameter may be used, like gcc -v"
67 :group 'org-babel
68 :version "24.3"
69 :type 'string)
71 (defcustom org-babel-C++-compiler "g++"
72 "Command used to compile a C++ source code file into an executable.
73 May be either a command in the path, like g++
74 or an absolute path name, like /usr/local/bin/g++
75 parameter may be used, like g++ -v"
76 :group 'org-babel
77 :version "24.3"
78 :type 'string)
80 (defcustom org-babel-D-compiler "rdmd"
81 "Command used to compile and execute a D source code file.
82 May be either a command in the path, like rdmd
83 or an absolute path name, like /usr/local/bin/rdmd
84 parameter may be used, like rdmd --chatty"
85 :group 'org-babel
86 :version "24.3"
87 :type 'string)
89 (defvar org-babel-c-variant nil
90 "Internal variable used to hold which type of C (e.g. C or C++ or D)
91 is currently being evaluated.")
93 (defun org-babel-execute:cpp (body params)
94 "Execute BODY according to PARAMS.
95 This function calls `org-babel-execute:C++'."
96 (org-babel-execute:C++ body params))
98 (defun org-babel-expand-body:cpp (body params)
99 "Expand a block of C++ code with org-babel according to its
100 header arguments."
101 (org-babel-expand-body:C++ body params))
103 (defun org-babel-execute:C++ (body params)
104 "Execute a block of C++ code with org-babel.
105 This function is called by `org-babel-execute-src-block'."
106 (let ((org-babel-c-variant 'cpp)) (org-babel-C-execute body params)))
108 (defun org-babel-expand-body:C++ (body params)
109 "Expand a block of C++ code with org-babel according to its
110 header arguments."
111 (let ((org-babel-c-variant 'cpp)) (org-babel-C-expand-C++ body params)))
113 (defun org-babel-execute:D (body params)
114 "Execute a block of D code with org-babel.
115 This function is called by `org-babel-execute-src-block'."
116 (let ((org-babel-c-variant 'd)) (org-babel-C-execute body params)))
118 (defun org-babel-expand-body:D (body params)
119 "Expand a block of D code with org-babel according to its
120 header arguments."
121 (let ((org-babel-c-variant 'd)) (org-babel-C-expand-D body params)))
123 (defun org-babel-execute:C (body params)
124 "Execute a block of C code with org-babel.
125 This function is called by `org-babel-execute-src-block'."
126 (let ((org-babel-c-variant 'c)) (org-babel-C-execute body params)))
128 (defun org-babel-expand-body:C (body params)
129 "Expand a block of C code with org-babel according to its
130 header arguments."
131 (let ((org-babel-c-variant 'c)) (org-babel-C-expand-C body params)))
133 (defun org-babel-C-execute (body params)
134 "This function should only be called by `org-babel-execute:C'
135 or `org-babel-execute:C++' or `org-babel-execute:D'."
136 (let* ((tmp-src-file (org-babel-temp-file
137 "C-src-"
138 (pcase org-babel-c-variant
139 (`c ".c") (`cpp ".cpp") (`d ".d"))))
140 (tmp-bin-file ;not used for D
141 (org-babel-process-file-name
142 (org-babel-temp-file "C-bin-" org-babel-exeext)))
143 (cmdline (cdr (assq :cmdline params)))
144 (cmdline (if cmdline (concat " " cmdline) ""))
145 (flags (cdr (assq :flags params)))
146 (flags (mapconcat 'identity
147 (if (listp flags) flags (list flags)) " "))
148 (libs (org-babel-read
149 (or (cdr (assq :libs params))
150 (org-entry-get nil "libs" t))
151 nil))
152 (libs (mapconcat #'identity
153 (if (listp libs) libs (list libs))
154 " "))
155 (full-body
156 (pcase org-babel-c-variant
157 (`c (org-babel-C-expand-C body params))
158 (`cpp (org-babel-C-expand-C++ body params))
159 (`d (org-babel-C-expand-D body params)))))
160 (with-temp-file tmp-src-file (insert full-body))
161 (pcase org-babel-c-variant
162 ((or `c `cpp)
163 (org-babel-eval
164 (format "%s -o %s %s %s %s"
165 (pcase org-babel-c-variant
166 (`c org-babel-C-compiler)
167 (`cpp org-babel-C++-compiler))
168 tmp-bin-file
169 flags
170 (org-babel-process-file-name tmp-src-file)
171 libs)
172 ""))
173 (`d nil)) ;; no separate compilation for D
174 (let ((results
175 (org-babel-eval
176 (pcase org-babel-c-variant
177 ((or `c `cpp)
178 (concat tmp-bin-file cmdline))
180 (format "%s %s %s %s"
181 org-babel-D-compiler
182 flags
183 (org-babel-process-file-name tmp-src-file)
184 cmdline)))
185 "")))
186 (when results
187 (setq results (org-trim (org-remove-indentation results)))
188 (org-babel-reassemble-table
189 (org-babel-result-cond (cdr (assq :result-params params))
190 (org-babel-read results t)
191 (let ((tmp-file (org-babel-temp-file "c-")))
192 (with-temp-file tmp-file (insert results))
193 (org-babel-import-elisp-from-file tmp-file)))
194 (org-babel-pick-name
195 (cdr (assq :colname-names params)) (cdr (assq :colnames params)))
196 (org-babel-pick-name
197 (cdr (assq :rowname-names params)) (cdr (assq :rownames params)))))
200 (defun org-babel-C-expand-C++ (body params)
201 "Expand a block of C or C++ code with org-babel according to
202 its header arguments."
203 (org-babel-C-expand-C body params))
205 (defun org-babel-C-expand-C (body params)
206 "Expand a block of C or C++ code with org-babel according to
207 its header arguments."
208 (let ((vars (org-babel--get-vars params))
209 (colnames (cdr (assq :colname-names params)))
210 (main-p (not (string= (cdr (assq :main params)) "no")))
211 (includes (org-babel-read
212 (cdr (assq :includes params))
213 nil))
214 (defines (org-babel-read
215 (cdr (assq :defines params))
216 nil))
217 (namespaces (org-babel-read
218 (cdr (assq :namespaces params))
219 nil)))
220 (when (stringp includes)
221 (setq includes (split-string includes)))
222 (when (stringp namespaces)
223 (setq namespaces (split-string namespaces)))
224 (when (stringp defines)
225 (let ((y nil)
226 (result (list t)))
227 (dolist (x (split-string defines))
228 (if (null y)
229 (setq y x)
230 (nconc result (list (concat y " " x)))
231 (setq y nil)))
232 (setq defines (cdr result))))
233 (mapconcat 'identity
234 (list
235 ;; includes
236 (mapconcat
237 (lambda (inc) (format "#include %s" inc))
238 includes "\n")
239 ;; defines
240 (mapconcat
241 (lambda (inc) (format "#define %s" inc))
242 (if (listp defines) defines (list defines)) "\n")
243 ;; namespaces
244 (mapconcat
245 (lambda (inc) (format "using namespace %s;" inc))
246 namespaces
247 "\n")
248 ;; variables
249 (mapconcat 'org-babel-C-var-to-C vars "\n")
250 ;; table sizes
251 (mapconcat 'org-babel-C-table-sizes-to-C vars "\n")
252 ;; tables headers utility
253 (when colnames
254 (org-babel-C-utility-header-to-C))
255 ;; tables headers
256 (mapconcat 'org-babel-C-header-to-C colnames "\n")
257 ;; body
258 (if main-p
259 (org-babel-C-ensure-main-wrap body)
260 body) "\n") "\n")))
262 (defun org-babel-C-expand-D (body params)
263 "Expand a block of D code with org-babel according to
264 its header arguments."
265 (let ((vars (org-babel--get-vars params))
266 (colnames (cdr (assq :colname-names params)))
267 (main-p (not (string= (cdr (assq :main params)) "no")))
268 (imports (or (cdr (assq :imports params))
269 (org-babel-read (org-entry-get nil "imports" t)))))
270 (when (stringp imports)
271 (setq imports (split-string imports)))
272 (setq imports (append imports '("std.stdio" "std.conv")))
273 (mapconcat 'identity
274 (list
275 "module mmm;"
276 ;; imports
277 (mapconcat
278 (lambda (inc) (format "import %s;" inc))
279 imports "\n")
280 ;; variables
281 (mapconcat 'org-babel-C-var-to-C vars "\n")
282 ;; table sizes
283 (mapconcat 'org-babel-C-table-sizes-to-C vars "\n")
284 ;; tables headers utility
285 (when colnames
286 (org-babel-C-utility-header-to-C))
287 ;; tables headers
288 (mapconcat 'org-babel-C-header-to-C colnames "\n")
289 ;; body
290 (if main-p
291 (org-babel-C-ensure-main-wrap body)
292 body) "\n") "\n")))
294 (defun org-babel-C-ensure-main-wrap (body)
295 "Wrap BODY in a \"main\" function call if none exists."
296 (if (string-match "^[ \t]*[intvod]+[ \t\n\r]*main[ \t]*(.*)" body)
297 body
298 (format "int main() {\n%s\nreturn 0;\n}\n" body)))
300 (defun org-babel-prep-session:C (_session _params)
301 "This function does nothing as C is a compiled language with no
302 support for sessions"
303 (error "C is a compiled language -- no support for sessions"))
305 (defun org-babel-load-session:C (_session _body _params)
306 "This function does nothing as C is a compiled language with no
307 support for sessions"
308 (error "C is a compiled language -- no support for sessions"))
310 ;; helper functions
312 (defun org-babel-C-format-val (type val)
313 "Handle the FORMAT part of TYPE with the data from VAL."
314 (let ((format-data (cadr type)))
315 (if (stringp format-data)
316 (cons "" (format format-data val))
317 (funcall format-data val))))
319 (defun org-babel-C-val-to-C-type (val)
320 "Determine the type of VAL.
321 Return a list (TYPE-NAME FORMAT). TYPE-NAME should be the name of the type.
322 FORMAT can be either a format string or a function which is called with VAL."
323 (let* ((basetype (org-babel-C-val-to-base-type val))
324 (type
325 (pcase basetype
326 (`integerp '("int" "%d"))
327 (`floatp '("double" "%f"))
328 (`stringp
329 (list
330 (if (eq org-babel-c-variant 'd) "string" "const char*")
331 "\"%s\""))
332 (_ (error "unknown type %S" basetype)))))
333 (cond
334 ((integerp val) type) ;; an integer declared in the #+begin_src line
335 ((floatp val) type) ;; a numeric declared in the #+begin_src line
336 ((and (listp val) (listp (car val))) ;; a table
337 `(,(car type)
338 (lambda (val)
339 (cons
340 (format "[%d][%d]" (length val) (length (car val)))
341 (concat
342 (if (eq org-babel-c-variant 'd) "[\n" "{\n")
343 (mapconcat
344 (lambda (v)
345 (concat
346 (if (eq org-babel-c-variant 'd) " [" " {")
347 (mapconcat (lambda (w) (format ,(cadr type) w)) v ",")
348 (if (eq org-babel-c-variant 'd) "]" "}")))
350 ",\n")
351 (if (eq org-babel-c-variant 'd) "\n]" "\n}"))))))
352 ((or (listp val) (vectorp val)) ;; a list declared in the #+begin_src line
353 `(,(car type)
354 (lambda (val)
355 (cons
356 (format "[%d]" (length val))
357 (concat
358 (if (eq org-babel-c-variant 'd) "[" "{")
359 (mapconcat (lambda (v) (format ,(cadr type) v)) val ",")
360 (if (eq org-babel-c-variant 'd) "]" "}"))))))
361 (t ;; treat unknown types as string
362 type))))
364 (defun org-babel-C-val-to-base-type (val)
365 "Determine the base type of VAL which may be
366 `integerp' if all base values are integers
367 `floatp' if all base values are either floating points or integers
368 `stringp' otherwise."
369 (cond
370 ((integerp val) 'integerp)
371 ((floatp val) 'floatp)
372 ((or (listp val) (vectorp val))
373 (let ((type nil))
374 (mapc (lambda (v)
375 (pcase (org-babel-C-val-to-base-type v)
376 (`stringp (setq type 'stringp))
377 (`floatp
378 (if (or (not type) (eq type 'integerp))
379 (setq type 'floatp)))
380 (`integerp
381 (unless type (setq type 'integerp)))))
382 val)
383 type))
384 (t 'stringp)))
386 (defun org-babel-C-var-to-C (pair)
387 "Convert an elisp val into a string of C code specifying a var
388 of the same value."
389 ;; TODO list support
390 (let ((var (car pair))
391 (val (cdr pair)))
392 (when (symbolp val)
393 (setq val (symbol-name val))
394 (when (= (length val) 1)
395 (setq val (string-to-char val))))
396 (let* ((type-data (org-babel-C-val-to-C-type val))
397 (type (car type-data))
398 (formated (org-babel-C-format-val type-data val))
399 (suffix (car formated))
400 (data (cdr formated)))
401 (format "%s %s%s = %s;"
402 type
404 suffix
405 data))))
407 (defun org-babel-C-table-sizes-to-C (pair)
408 "Create constants of table dimensions, if PAIR is a table."
409 (when (listp (cdr pair))
410 (cond
411 ((listp (cadr pair)) ;; a table
412 (concat
413 (format "const int %s_rows = %d;" (car pair) (length (cdr pair)))
414 "\n"
415 (format "const int %s_cols = %d;" (car pair) (length (cadr pair)))))
416 (t ;; a list declared in the #+begin_src line
417 (format "const int %s_cols = %d;" (car pair) (length (cdr pair)))))))
419 (defun org-babel-C-utility-header-to-C ()
420 "Generate a utility function to convert a column name
421 into a column number."
422 (pcase org-babel-c-variant
423 ((or `c `cpp)
424 "int get_column_num (int nbcols, const char** header, const char* column)
426 int c;
427 for (c=0; c<nbcols; c++)
428 if (strcmp(header[c],column)==0)
429 return c;
430 return -1;
434 "int get_column_num (string[] header, string column)
436 foreach (c, h; header)
437 if (h==column)
438 return to!int(c);
439 return -1;
441 ")))
443 (defun org-babel-C-header-to-C (head)
444 "Convert an elisp list of header table into a C or D vector
445 specifying a variable with the name of the table."
446 (let ((table (car head))
447 (headers (cdr head)))
448 (concat
449 (format
450 (pcase org-babel-c-variant
451 ((or `c `cpp) "const char* %s_header[%d] = {%s};")
452 (`d "string %s_header[%d] = [%s];"))
453 table
454 (length headers)
455 (mapconcat (lambda (h) (format "%S" h)) headers ","))
456 "\n"
457 (pcase org-babel-c-variant
458 ((or `c `cpp)
459 (format
460 "const char* %s_h (int row, const char* col) { return %s[row][get_column_num(%d,%s_header,col)]; }"
461 table table (length headers) table))
463 (format
464 "string %s_h (size_t row, string col) { return %s[row][get_column_num(%s_header,col)]; }"
465 table table table))))))
467 (provide 'ob-C)
469 ;;; ob-C.el ends here