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