ob-C.el 15 KB

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