lisp/ob-C.el

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