ob-C.el 15 KB

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