contrib/lisp/ob-D.el

   1 ;;; ob-D.el --- org-babel functions for the D language
   2
   3 ;; Copyright (C) 2013 Thierry Banel
   4
   5 ;; Author: Thierry Banel, derived from the Eric Schulte work
   6 ;; Keywords: literate programming, reproducible research
   7
   8 ;; This file is NOT (yet) part of GNU Emacs.
   9
  10 ;; ob-D.el is free software: you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation, either version 3 of the License, or
  13 ;; (at your option) any later version.
  14
  15 ;; ob-D.el is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; the GNU General Public License can be obtained here:
  21 ;; <http://www.gnu.org/licenses/>.
  22
  23 ;;; Commentary:
  24 ;; Org-Babel support for evaluating Digital Mars D Language code.
  25 ;; The D language home page is here:
  26 ;; http://dlang.org/
  27
  28 ;;; Code:
  29 (require 'ob)
  30 (require 'ob-eval)
  31
  32 (declare-function org-entry-get "org"
  33                   (pom property &optional inherit literal-nil))
  34
  35 (defvar org-babel-tangle-lang-exts)
  36 (add-to-list 'org-babel-tangle-lang-exts '("D" . "D"))
  37
  38 (defvar org-babel-default-header-args:D '())
  39
  40 (defvar org-babel-D-compiler "rdmd"
  41   "Command used to compile and run a D source code file into an
  42   executable.")
  43
  44 (defun org-babel-execute:D (body params)
  45   "Execute a block of D code with org-babel.  This function is
  46 called by `org-babel-execute-src-block'."
  47   (org-babel-D-execute body params))
  48
  49 (defun org-babel-D-execute (body params)
  50   "This function should only be called by `org-babel-execute:D'"
  51   (let* ((tmp-src-file (org-babel-temp-file "Dsrc" ".d"))
  52          (cmdline (cdr (assoc :cmdline params)))
  53          (flags (cdr (assoc :flags params)))
  54          (rdmd (format "%s %s %s"
  55                        org-babel-D-compiler
  56                        (mapconcat 'identity
  57                                   (if (listp flags) flags (list flags)) " ")
  58
  59                        ;; On Unix, keep directory separator
  60                        (org-babel-process-file-name tmp-src-file)))
  61
  62          (full-body (org-babel-D-expand body params)))
  63     (with-temp-file tmp-src-file (insert full-body))
  64
  65     (org-babel-eval rdmd "")))
  66
  67 (defun org-babel-D-expand (body params)
  68   "Expand a block of D code with org-babel according to
  69 its header arguments."
  70   (let ((vars (mapcar #'cdr (org-babel-get-header params :var)))
  71         (colname-names (cdr (car (org-babel-get-header params :colname-names))))
  72         (main-p (not (string= (cdr (assoc :main params)) "no")))
  73         (imports (mapcar #'cdr (org-babel-get-header params :import))))
  74     (mapconcat 'identity
  75                (list
  76                 "module aaa;\n"
  77                 ;; imports
  78                 (mapconcat
  79                  (lambda (inc) (format "import %s;" inc))
  80                  imports "\n")
  81                 ;; variables
  82                 (mapconcat 'org-babel-D-var-to-D vars "\n")
  83                 (mapconcat 'org-babel-D-colnames-to-D colname-names "\n")
  84                 ;; body
  85                 (if main-p
  86                     (org-babel-D-ensure-main-wrap body)
  87                   body) "\n") "\n")))
  88
  89 (defun org-babel-D-ensure-main-wrap (body)
  90   "Wrap body in a \"main\" function call if none exists."
  91   (if (string-match "^[ \t]*[intvod]+[ \t\n\r]*main[ \t]*(.*)" body)
  92       body
  93     (format "int main() {\n%s\nreturn(0);\n}\n" body)))
  94
  95 (defun org-babel-prep-session:D (session params)
  96   "This function does nothing as D is a compiled language with no
  97 support for sessions"
  98   (error "D is a compiled languages -- no support for sessions"))
  99
 100 (defun org-babel-load-session:D (session body params)
 101   "This function does nothing as D is a compiled language with no
 102 support for sessions"
 103   (error "D is a compiled languages -- no support for sessions"))
 104
 105 ;; helper functions
 106
 107 (defun org-babel-D-var-to-D (pair)
 108   "Convert an elisp value into a string of D code specifying a variable
 109 of the same value."
 110   (let ((var (car pair))
 111         (val (cdr pair)))
 112     (when (symbolp val)
 113       (setq val (symbol-name val))
 114       (when (= (length val) 1)
 115         (setq val (string-to-char val))))
 116     (cond
 117      ((integerp val)
 118       (format "int %S = %S;" var val))
 119      ((floatp val)
 120       (format "double %S = %S;" var val))
 121      ((stringp val)
 122       (format "string %S = \"%s\";" var val))
 123      ((listp val)
 124       (if (assoc var colname-names) ()
 125         (setq colname-names
 126               (cons (cons
 127                      var
 128                      (let ((i 0)) (mapcar (lambda (x) (setq i (1+ i)) (format
 129                                                                   "$%s" i))
 130                                           (car val))))
 131                     colname-names)))
 132       (format "string[][] %S = [\n[%s]];" var
 133               (mapconcat (lambda (row)
 134                            (if (listp row)
 135                                (mapconcat (lambda (v) (format "\"%s\"" v))
 136                                           row
 137                                           ",")))
 138                          val
 139                          "],\n[")))
 140      (t
 141       (format "u32 %S = %S;" var val)))))
 142
 143 (defun org-babel-D-colnames-to-D (pair)
 144   "Convert an elisp list of header table into a D vector
 145 specifying a variable with the name of the table"
 146   (let ((table (car pair))
 147         (headers (cdr pair)))
 148     (format "string[] %S_headers = [%s];"
 149             table
 150             (mapconcat (lambda (h) (format "%S" h)) headers ","))))
 151
 152 (provide 'ob-D)
 153
 154 ;;; ob-D.el ends here