| commit | author | age | ||
| 76bbd0 | 1 | ;;; ob-C.el --- Babel Functions for C and Similar Languages -*- lexical-binding: t; -*- |
| C | 2 | |
| 3 | ;; Copyright (C) 2010-2018 Free Software Foundation, Inc. | |
| 4 | ||
| 5 | ;; Author: Eric Schulte | |
| 6 | ;; Thierry Banel | |
| 7 | ;; Keywords: literate programming, reproducible research | |
| 8 | ;; Homepage: https://orgmode.org | |
| 9 | ||
| 10 | ;; This file is part of GNU Emacs. | |
| 11 | ||
| 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. | |
| 16 | ||
| 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. | |
| 21 | ||
| 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/>. | |
| 24 | ||
| 25 | ;;; Commentary: | |
| 26 | ||
| 27 | ;; Org-Babel support for evaluating C, C++, D code. | |
| 28 | ;; | |
| 29 | ;; very limited implementation: | |
| 30 | ;; - currently only support :results output | |
| 31 | ;; - not much in the way of error feedback | |
| 32 | ||
| 33 | ;;; Code: | |
| 34 | ||
| 35 | (require 'cc-mode) | |
| 36 | (require 'ob) | |
| 37 | ||
| 38 | ||
| 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)) | |
| 42 | ||
| 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")) | |
| 46 | ||
| 47 | (defvar org-babel-default-header-args:C '()) | |
| 48 | ||
| 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.") | |
| 56 | ||
| 57 | (defconst org-babel-header-args:C++ | |
| 58 | (append '((namespaces . :any)) | |
| 59 | org-babel-header-args:C) | |
| 60 | "C++-specific header arguments.") | |
| 61 | ||
| 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) | |
| 70 | ||
| 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) | |
| 79 | ||
| 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) | |
| 88 | ||
| 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.") | |
| 92 | ||
| 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)) | |
| 97 | ||
| 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)) | |
| 102 | ||
| 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))) | |
| 107 | ||
| 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))) | |
| 112 | ||
| 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))) | |
| 117 | ||
| 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))) | |
| 122 | ||
| 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))) | |
| 127 | ||
| 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))) | |
| 132 | ||
| 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)) | |
| 179 | (`d | |
| 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))))) | |
| 198 | ))) | |
| 199 | ||
| 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)) | |
| 204 | ||
| 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"))) | |
| 261 | ||
| 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"))) | |
| 293 | ||
| 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))) | |
| 299 | ||
| 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")) | |
| 304 | ||
| 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")) | |
| 309 | ||
| 310 | ;; helper functions | |
| 311 | ||
| 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)))) | |
| 318 | ||
| 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) "]" "}"))) | |
| 349 | val | |
| 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)))) | |
| 363 | ||
| 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))) | |
| 385 | ||
| 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 | |
| 403 | var | |
| 404 | suffix | |
| 405 | data)))) | |
| 406 | ||
| 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))))))) | |
| 418 | ||
| 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) | |
| 425 | { | |
| 426 | int c; | |
| 427 | for (c=0; c<nbcols; c++) | |
| 428 | if (strcmp(header[c],column)==0) | |
| 429 | return c; | |
| 430 | return -1; | |
| 431 | } | |
| 432 | ") | |
| 433 | (`d | |
| 434 | "int get_column_num (string[] header, string column) | |
| 435 | { | |
| 436 | foreach (c, h; header) | |
| 437 | if (h==column) | |
| 438 | return to!int(c); | |
| 439 | return -1; | |
| 440 | } | |
| 441 | "))) | |
| 442 | ||
| 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)) | |
| 462 | (`d | |
| 463 | (format | |
| 464 | "string %s_h (size_t row, string col) { return %s[row][get_column_num(%s_header,col)]; }" | |
| 465 | table table table)))))) | |
| 466 | ||
| 467 | (provide 'ob-C) | |
| 468 | ||
| 469 | ;;; ob-C.el ends here | |
