├── README.org ├── ob-prolog.el └── test ├── test-ob-prolog.el └── test-ob-prolog.org /README.org: -------------------------------------------------------------------------------- 1 | #+TITLE: Org-babel functions for prolog evaluation 2 | 3 | This project contains a set of functions that are need to evaluate 4 | prolog in org-babel. 5 | 6 | * Getting Started 7 | [[https://melpa.org/#/sparql-mode][file:https://melpa.org/packages/ob-prolog-badge.svg]] [[https://stable.melpa.org/#/sparql-mode][file:https://stable.melpa.org/packages/ob-prolog-badge.svg]] 8 | - Download ob-prolog and put it in a directory somewhere. 9 | - Add the following to your .emacs file 10 | - (or use melpa) 11 | 12 | #+BEGIN_SRC emacs-lisp 13 | (add-to-list 'load-path "/path/to/ob-prolog-dir") 14 | #+END_SRC 15 | 16 | You also need to add the next snippet or add =(prolog . t)= to 17 | languages org-babel can load: 18 | 19 | #+BEGIN_SRC emacs-lisp 20 | (org-babel-do-load-languages 21 | 'org-babel-load-languages 22 | '((prolog . t))) 23 | #+END_SRC 24 | 25 | You can then execute the query by pressing =C-c C-c= on the 26 | source-block header. 27 | -------------------------------------------------------------------------------- /ob-prolog.el: -------------------------------------------------------------------------------- 1 | ;;; ob-prolog.el --- org-babel functions for prolog evaluation. 2 | 3 | ;; Copyright (C) Bjarte Johansen 4 | 5 | ;; Author: Bjarte Johansen 6 | ;; Keywords: literate programming, reproducible research 7 | ;; URL: https://github.com/ljos/ob-prolog 8 | ;; Version: 1.0.2 9 | 10 | ;; This file is NOT part of GNU Emacs. 11 | 12 | ;; This program 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, or (at your option) 15 | ;; any later version. 16 | ;; 17 | ;; This program 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; see the file COPYING. If not, write to the 24 | ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 25 | ;; Boston, MA 02110-1301, USA. 26 | 27 | ;;; Commentary: 28 | 29 | ;; Org-babel support for prolog. 30 | ;; 31 | ;; To activate ob-prolog add the following to your init.el file: 32 | ;; 33 | ;; (add-to-list 'load-path "/path/to/ob-prolog-dir") 34 | ;; (org-babel-do-load-languages 35 | ;; 'org-babel-load-languages 36 | ;; '((prolog . t))) 37 | ;; 38 | ;; It is unnecessary to add the directory to the load path if you 39 | ;; install using the package manager. 40 | ;; 41 | ;; In addition to the normal header arguments ob-prolog also supports 42 | ;; the :goal argument. :goal is the goal that prolog will run when 43 | ;; executing the source block. Prolog needs a goal to know what it is 44 | ;; going to execute. 45 | ;; 46 | 47 | ;;; Code: 48 | (require 'ob) 49 | (require 'ob-ref) 50 | (require 'ob-comint) 51 | (require 'ob-eval) 52 | (require 'prolog) 53 | 54 | 55 | (add-to-list 'org-babel-tangle-lang-exts '("prolog" . "pl")) 56 | 57 | (defvar org-babel-prolog-command (prolog-find-value-by-system prolog-program-name) 58 | "Name of the prolog executable command.") 59 | 60 | (defconst org-babel-header-args:prolog 61 | '((:goal . :any)) 62 | "Prolog-specific header arguments.") 63 | 64 | 65 | (defvar org-babel-default-header-args:prolog 66 | `((:goal . nil))) 67 | 68 | (defun org-babel-prolog--elisp-to-pl (value) 69 | "Convert the Emacs Lisp VALUE to equivalent Prolog." 70 | (cond ((stringp value) 71 | (format "'%s'" 72 | (replace-regexp-in-string 73 | "'" "\\'" value))) 74 | ((listp value) 75 | (format "[%s]" 76 | (mapconcat #'org-babel-prolog--elisp-to-pl 77 | value 78 | ", "))) 79 | (t (prin1-to-string value)))) 80 | 81 | (defun org-babel-prolog--variable-assignment (pair) 82 | "Return a string of a recorda/2 assertion of (cdr PAIR) under (car PAIR). 83 | 84 | The Emacs Lisp value of the car of PAIR is used as the Key argument to 85 | recorda/2 without modification. The cdr of PAIR is converted to 86 | equivalent Prolog before being provided as the Term argument to 87 | recorda/2." 88 | (format ":- recorda('%s', %s)." 89 | (car pair) 90 | (org-babel-prolog--elisp-to-pl (cdr pair)))) 91 | 92 | (defun org-babel-variable-assignments:prolog (params) 93 | "Return the babel variable assignments in PARAMS. 94 | 95 | PARAMS is a quasi-alist of header args, which may contain 96 | multiple entries for the key `:var'. This function returns a 97 | list of the cdr of all the `:var' entries." 98 | (let (vars) 99 | (dolist (param params vars) 100 | (when (eq :var (car param)) 101 | (let ((var (org-babel-prolog--variable-assignment (cdr param)))) 102 | (setq vars (cons var vars))))))) 103 | 104 | (defun org-babel-prolog--parse-goal (goal) 105 | "Evaluate the inline Emacs Lisp in GOAL. 106 | 107 | Example: 108 | append(=(+ 2 3), =(quote a), B) 109 | => append(5, a, B)" 110 | (when goal 111 | (with-temp-buffer 112 | (insert goal) 113 | (while (search-backward "=" nil t) 114 | (delete-char 1 t) 115 | (let ((value (eval 116 | (read 117 | (thing-at-point 'sexp))))) 118 | (kill-sexp) 119 | (insert (format "%S" value)))) 120 | (buffer-string)))) 121 | 122 | (defun org-babel-execute:prolog (body params) 123 | "Execute the Prolog in BODY according to the block's header PARAMS. 124 | 125 | This function is called by `org-babel-execute-src-block.'" 126 | (message "executing Prolog source code block") 127 | (let* ((result-params (cdr (assq :result-params params))) 128 | (session (cdr (assq :session params))) 129 | (goal (org-babel-prolog--parse-goal 130 | (cdr (assq :goal params)))) 131 | (vars (org-babel-variable-assignments:prolog params)) 132 | (full-body (org-babel-expand-body:generic body params vars)) 133 | (results (if (string= "none" session) 134 | (org-babel-prolog-evaluate-external-process 135 | goal full-body) 136 | (org-babel-prolog-evaluate-session 137 | session goal full-body)))) 138 | (unless (string= "" results) 139 | (org-babel-reassemble-table 140 | (org-babel-result-cond result-params 141 | results 142 | (let ((tmp (org-babel-temp-file "prolog-results-"))) 143 | (with-temp-file tmp (insert results)) 144 | (org-babel-import-elisp-from-file tmp))) 145 | (org-babel-pick-name (cdr (assq :colname-names params)) 146 | (cdr (assq :colnames params))) 147 | (org-babel-pick-name (cdr (assq :rowname-names params)) 148 | (cdr (assq :rownames params))))))) 149 | 150 | (defun org-babel-prep-session:prolog (session params) 151 | (let ((var-lines (org-babel-variable-assignments:prolog params))) 152 | (org-babel-prolog--session-load-clauses session var-lines) 153 | session)) 154 | 155 | (defun org-babel-load-session:prolog (session body params) 156 | "Load the BODY into the SESSION given the PARAMS." 157 | (let* ((params (org-babel-process-params params)) 158 | (goal (org-babel-prolog--parse-goal (cdr (assq :goal params)))) 159 | (session (org-babel-prolog-initiate-session session))) 160 | (org-babel-prep-session:prolog session params) 161 | (org-babel-prolog-evaluate-session session goal body) 162 | (with-current-buffer session 163 | (goto-char (point-max))) 164 | session)) 165 | 166 | (defun org-babel-prolog-evaluate-external-process (goal body) 167 | "Evaluate the GOAL given the BODY in an external Prolog process. 168 | 169 | If no GOAL is given, the GOAL is replaced with HALT. This results in 170 | running just the body through the Prolog process." 171 | (let* ((tmp-file (org-babel-temp-file "prolog-")) 172 | (command (format "%s --quiet -l %s -g \"%s\" -t 'halt'" 173 | org-babel-prolog-command 174 | tmp-file 175 | (replace-regexp-in-string 176 | "\"" "\\\"" (or goal "halt"))))) 177 | (with-temp-file tmp-file 178 | (insert (org-babel-chomp body))) 179 | (or (org-babel-eval command "") ""))) 180 | 181 | (defun org-babel-prolog--session-load-clauses (session clauses) 182 | (with-current-buffer session 183 | (setq comint-prompt-regexp "^|: *")) 184 | (org-babel-comint-input-command session "consult(user).\n") 185 | (org-babel-comint-with-output (session "\n") 186 | (setq comint-prompt-regexp (prolog-prompt-regexp)) 187 | (dolist (line clauses) 188 | (insert line) 189 | (comint-send-input nil t) 190 | (accept-process-output 191 | (get-buffer-process session))) 192 | (comint-send-eof))) 193 | 194 | (defun org-babel-prolog-evaluate-session (session goal body) 195 | "In SESSION, evaluate GOAL given the BODY of the Prolog block. 196 | 197 | Create SESSION if it does not already exist." 198 | (let* ((session (org-babel-prolog-initiate-session session)) 199 | (body (split-string (org-babel-trim body) "\n"))) 200 | (with-temp-buffer 201 | (apply #'insert (org-babel-prolog--session-load-clauses session body)) 202 | (if (save-excursion 203 | (search-backward "ERROR: " nil t)) 204 | (progn 205 | (save-excursion 206 | (while (search-backward "|: " nil t) 207 | (replace-match "" nil t))) 208 | (search-backward "true." nil t) 209 | (kill-whole-line) 210 | (org-babel-eval-error-notify -1 (buffer-string)) 211 | (buffer-string)) 212 | (when goal 213 | (kill-region (point-min) (point-max)) 214 | (apply #'insert 215 | (org-babel-comint-with-output (session "") 216 | (insert (concat goal ", !.")) 217 | (comint-send-input nil t)))) 218 | (if (not (save-excursion 219 | (search-backward "ERROR: " nil t))) 220 | (let ((delete-trailing-lines t)) 221 | (delete-trailing-whitespace (point-min)) 222 | (org-babel-trim (buffer-string))) 223 | ;;(search-backward "?-" nil t) 224 | ;;(kill-whole-line) 225 | (org-babel-eval-error-notify -1 (buffer-string)) 226 | (org-babel-trim (buffer-string))))))) 227 | 228 | (defun org-babel-prolog--answer-correction (string) 229 | "If STRING is Prolog's \"Correct to:\" prompt, send a refusal." 230 | (when (string-match-p "Correct to: \".*\"\\?" string) 231 | (comint-send-input nil t))) 232 | 233 | (defun org-babel-prolog--exit-debug (string) 234 | "If STRING indicates an exception, continue Prolog execution in no debug mode." 235 | (when (string-match-p "\\(.\\|\n\\)*Exception.* \\? $" string) 236 | (comint-send-input nil t))) 237 | 238 | (defun org-babel-prolog-initiate-session (&optional session) 239 | "Return SESSION with a current inferior-process-buffer. 240 | 241 | Initialize SESSION if it has not already been initialized." 242 | (unless (equal "none" session) 243 | (let ((session (get-buffer-create (or session "*prolog*")))) 244 | (unless (comint-check-proc session) 245 | (with-current-buffer session 246 | (kill-region (point-min) (point-max)) 247 | (prolog-inferior-mode) 248 | (apply #'make-comint-in-buffer 249 | "prolog" 250 | (current-buffer) 251 | org-babel-prolog-command 252 | nil 253 | (cons "-q" (prolog-program-switches))) 254 | (add-hook 'comint-output-filter-functions 255 | #'org-babel-prolog--answer-correction nil t) 256 | (add-hook 'comint-output-filter-functions 257 | #'org-babel-prolog--exit-debug nil t) 258 | (add-hook 'comint-preoutput-filter-functions 259 | #'ansi-color-apply nil t) 260 | (while (progn 261 | (goto-char comint-last-input-end) 262 | (not (save-excursion 263 | (re-search-forward comint-prompt-regexp nil t)))) 264 | (accept-process-output 265 | (get-buffer-process session))))) 266 | session))) 267 | 268 | (provide 'ob-prolog) 269 | ;;; ob-prolog.el ends here 270 | -------------------------------------------------------------------------------- /test/test-ob-prolog.el: -------------------------------------------------------------------------------- 1 | ;;; test-ob-prolog.el --- tests for ob-prolog.el 2 | 3 | ;; Copyright (c) 2015 Bjarte Johansen 4 | ;; Authors: Bjarte Johansen 5 | 6 | ;; This file is not part of GNU Emacs. 7 | 8 | ;; This program 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 | 13 | ;; This program is distributed in the hope that it will be useful, 14 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | ;; GNU General Public License for more details. 17 | 18 | ;; You should have received a copy of the GNU General Public License 19 | ;; along with this program. If not, see . 20 | 21 | ;;; Code: 22 | 23 | (require 'ert) 24 | (require 'org-id) 25 | 26 | 27 | (unless (featurep 'ob-prolog) 28 | (signal 'missing-test-dependency "Support for Prolog code blocks")) 29 | 30 | (defmacro test-ob-prolog/test-src-block (name &rest body) 31 | (declare (indent 1)) 32 | (let ((buf (make-symbol "buf")) 33 | (visited-p (make-symbol "visited-p")) 34 | (file-pos (make-symbol "file-pos")) 35 | (active-session (make-symbol "active-session")) 36 | (file "test-ob-prolog.org")) 37 | `(let* ((,visited-p (get-file-buffer ,file)) 38 | (,buf (or ,visited-p 39 | (find-file-noselect ,file))) 40 | ,active-session) 41 | (with-current-buffer ,buf 42 | (unwind-protect 43 | (save-match-data 44 | (save-excursion 45 | (goto-char (point-min)) 46 | (condition-case nil 47 | (progn 48 | (org-show-subtree) 49 | (org-show-block-all)) 50 | (error nil)) 51 | (org-babel-goto-named-src-block ,(symbol-name name)) 52 | (save-excursion 53 | (ignore-errors ;; if there is no previous src block. 54 | (let* ((info (nth 2 (org-babel-get-src-block-info))) 55 | (session (cdr (assq :session info))) 56 | (bound (progn 57 | (org-babel-previous-src-block) 58 | (end-of-line) 59 | (point)))) 60 | (setq ,active-session 61 | (unless (string= "none" session) 62 | session)) 63 | (goto-char (point-min)) 64 | (while (search-forward 65 | (concat ":session " session) bound t) 66 | (org-babel-execute-src-block))))) 67 | (save-restriction ,@body))) 68 | (unless ,visited-p 69 | (kill-buffer ,buf)) 70 | (when ,active-session 71 | (kill-buffer ,active-session))))))) 72 | (def-edebug-spec test-ob-prolog/test-src-block (form body)) 73 | 74 | (ert-deftest test-ob-prolog/simple-execution () 75 | "Test simple execution of prolog source block." 76 | (test-ob-prolog/test-src-block basic-test 77 | (should (string= "Hello, org_mode." 78 | (org-babel-execute-src-block))))) 79 | 80 | (ert-deftest test-ob-prolog/goal-execution () 81 | "Test execution of goal argument to prolog source block." 82 | (test-ob-prolog/test-src-block goal-test 83 | (should (string= "Hello, world!" 84 | (org-babel-execute-src-block))))) 85 | 86 | (ert-deftest test-ob-prolog/simple-running-session () 87 | "Test running a session." 88 | (test-ob-prolog/test-src-block session-test 89 | (should (string= "A = 41." 90 | (org-babel-execute-src-block))))) 91 | 92 | (ert-deftest test-ob-prolog/call-predicate-in-session () 93 | "Test calling a predicate in the session that is defined in 94 | another block." 95 | (test-ob-prolog/test-src-block other-predicate-test 96 | (should (string= "A = 42." 97 | (org-babel-execute-src-block))))) 98 | 99 | (ert-deftest test-ob-prolog/interacting-with-other-block () 100 | "Test interacting with source block that is not a prolog 101 | block." 102 | (test-ob-prolog/test-src-block interaction-test 103 | (should (string= "A = [0, 1, 2, 3]." 104 | (org-babel-execute-src-block))))) 105 | 106 | ;;; test-ob-prolog ends here 107 | -------------------------------------------------------------------------------- /test/test-ob-prolog.org: -------------------------------------------------------------------------------- 1 | #+PROPERTY: results silent scalar 2 | #+TITLE: Tests for ob-prolog 3 | 4 | * Basic prolog source block 5 | #+NAME: basic-test 6 | #+BEGIN_SRC prolog 7 | :- format('Hello, ~a.', org_mode). 8 | #+END_SRC 9 | 10 | * Source block with goal 11 | #+NAME: goal-test 12 | #+BEGIN_SRC prolog :goal main 13 | main :- 14 | write('Hello, world!'). 15 | #+END_SRC 16 | 17 | * Simple running session 18 | #+NAME: session-test 19 | #+HEADER: :session *prolog-1* 20 | #+HEADER: :goal fourtyone(A) 21 | #+BEGIN_SRC prolog 22 | fourtyone(A) :- A is 41. 23 | #+END_SRC 24 | 25 | * Calling predicate from session 26 | #+NAME: other-predicate-test 27 | #+HEADER: :goal answer(A) 28 | #+HEADER: :session *prolog-1* 29 | #+BEGIN_SRC prolog 30 | answer(C) :- 31 | fourtyone(B), 32 | C is B+1. 33 | #+END_SRC 34 | 35 | 36 | * Test interaction with other blocks 37 | #+NAME: f 38 | #+BEGIN_SRC elisp :results vector 39 | '(1 2 3) 40 | #+END_SRC 41 | 42 | #+NAME: interaction-test 43 | #+HEADER: :var a=f() 44 | #+HEADER: :var b=0 45 | #+HEADER: :goal main(A) 46 | #+HEADER: :session *prolog-1* 47 | #+BEGIN_SRC prolog 48 | main(B) :- recorded(a, A), recorded(b, C), append([C], A, B). 49 | #+END_SRC 50 | --------------------------------------------------------------------------------