ob-C.el 14 KB

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