diff --git a/README.org b/README.org index 037ae46..b18c31a 100644 --- a/README.org +++ b/README.org @@ -1,63 +1,161 @@ * Org-Mode Babel Support for Racket -This Emacs module enables support for the [[https://racket-lang.org][Racket programming language]] in Emacs' -[[http://orgmode.org/worg/org-contrib/babel/][Org-mode Babel]]. This allows executing Racket code blocks directly from Org mode, -embedding the results of those code blocks in your Org files, and even chaining -the result from one code block into another code block. See the [[http://orgmode.org/worg/org-contrib/babel/intro.html][Babel intro]] for -more details on what's possible. + This Emacs module enables support for the [[https://racket-lang.org][Racket programming language]] in Emacs' + [[http://orgmode.org/worg/org-contrib/babel/][Org-mode Babel]]. This allows executing Racket code blocks directly from Org mode, + embedding the results of those code blocks in your Org files, and even chaining + the result from one code block into another code block. See the [[http://orgmode.org/worg/org-contrib/babel/intro.html][Babel intro]] for + more details on what's possible. ** Example Usage -This example shows how to add a code block implementing the classic recursive -factorial. With point inside the code block, press =C-c C-c= to execute the -block. The result will be inserted immediately beneath it. + This example shows how to add a code block implementing the classic recursive + factorial. With point inside the code block, press =C-c C-c= to execute the + block. The result will be inserted immediately beneath it. -#+BEGIN_SRC org - ,#+BEGIN_SRC racket :var input=10 - (define (factorial n) - (if (= n 1) - 1 - (* n (factorial (sub1 n))))) - (factorial input) - ,#+END_SRC + #+BEGIN_SRC org + ,#+BEGIN_SRC racket :var input=10 + (define (factorial n) + (if (= n 1) + 1 + (* n (factorial (sub1 n))))) + (factorial input) + ,#+END_SRC - ,#+RESULTS: - : 3628800 -#+END_SRC + ,#+RESULTS: + : 3628800 + #+END_SRC + + + This example shows how you can use custom languages. To run this you will need [[file:20200704153240-beautiful_racket.org][Beautiful Racket]] installed. + #+begin_src org + ,#+BEGIN_SRC racket :results output + #lang reader stacker-demo/stacker + 4 + 8 + + + 3 + ,,* + ,#+END_SRC + + ,#+RESULTS: + : 36 + #+end_src + +*** Custom Languages + To best implement and test a custom language we have to be able to emit the + language implementation in a known location next to its usage. We can do + this by naming a block and then referencing via the ~:adjacent-file~ header. + + + #+begin_src org + #+name: stacker-reader-expander.rkt + ,#+begin_src racket :eval no :noweb strip-export :tangle + #lang br/quicklang + + (define (read-syntax path port) + (define src-lines (port->lines port)) + (define src-datums (format-datums '(handle ~a) src-lines)) + (define module-datum `(module stacker-mod "./stacker-reader-expander.rkt" + ,@src-datums)) + (datum->syntax #f module-datum)) + (provide read-syntax) + + (define-macro (stacker-module-begin HANDLE-EXPR ...) + #'(#%module-begin + HANDLE-EXPR ... + (display (first stack)))) + (provide (rename-out [stacker-module-begin #%module-begin])) + + + (define stack empty) + + (define (pop-stack!) + (define item (first stack)) + (set! stack (rest stack)) + item) + + (define (push-stack! item) + (set! stack (cons item stack))) + + (define (handle [x #f]) + (when x + (cond + [(number? x) (push-stack! x)] + [(or (equal? + x) + (equal? * x)) + (define op-result (x (pop-stack!) (pop-stack!))) + (push-stack! op-result)]))) + (provide handle + *) + ,#+end_src + #+end_src + + This will now work! + + #+begin_src org + ,#+begin_src racket :adjacent-file stacker-reader-expander.rkt + #lang reader "./stacker-reader-expander.rkt" + 4 + 8 + + + 3 + ,* + ,#+end_src + + #+RESULTS: + : 36 + #+end_src ** Supported Header Arguments -- :results :: Can be set to either =value= or =output=. If set to =value=, the - code block will be wrapped in a (let ...) form, and only the result of the form - will recorded. If set to =output=, the code block will be run as a script, and - all standard output will be recorded. Defaults to =value=. -- :lang :: Specifies the language used in the =#lang= directive at the beginning - of the script. Defaults to "racket". -- :var :: Allows defining a variable for use in the block. If using the =value= - output type, the variable will be passed to the wrapping function as an argument. - Otherwise, it will be defined at the top level of the script using a =(define ...)= - form. + - :results :: Can be set to either =value= or =output=. If set to =value=, the + code block will be wrapped in a (let ...) form, and only the result of the form + will recorded. If set to =output=, the code block will be run as a script, and + all standard output will be recorded. Defaults to =value=. + - :var :: Allows defining a variable for use in the block. If using the =value= + output type, the variable will be passed to the wrapping function as an argument. + Otherwise, it will be defined at the top level of the script using a =(define ...)= + form. + - :require :: =DEPRECATED= Allows you to use require statements. Because the way =:results + value= works is by wrapping everything in a =let=, you cannot normally use + a =require= statement (these have to be top-level). To help, =:require + racket/date= will generate =(require racket/date)= outside the =let= block. + Multiple =require= statements can be used and they may or may not be + quoted. While not strictly necessary for =:results output=, will work + anyways to keep with the convention. + - :adjacent-file :: Should be the name of another (presumably Racket) block + in the same document. This block source will be expanded and emitted + adjacent to the main file during execution. This is especially useful for + implementing languages in one block and testing them in another. Note that + at the moment, multiple ~:adjacent-file~ blocks are not supported. You can + however pass a white-space-separated list to this argument eg + ~:adjacent-file foo1.rkt foo2.rkt~ where there are blocks named both + ~foo1.rkt~ and ~foo2.rkt~ in the same document. + ** Installation -- Install =ob-racket.el= in your Emacs [[https://www.gnu.org/software/emacs/manual/html_node/emacs/Lisp-Libraries.html#Lisp-Libraries][load path]] -- Add the following to your =.emacs.d= file: + - Install =ob-racket.el= in your Emacs [[https://www.gnu.org/software/emacs/manual/html_node/emacs/Lisp-Libraries.html#Lisp-Libraries][load path]] + - Add the following to your =.emacs.d= file: -#+BEGIN_SRC emacs-lisp - ;; Enable Racket in Org-mode Babel - (org-babel-do-load-languages - 'org-babel-load-languages - '((racket . t))) -#+END_SRC + #+BEGIN_SRC emacs-lisp + ;; Enable Racket in Org-mode Babel + (org-babel-do-load-languages + 'org-babel-load-languages + '((racket . t))) + #+END_SRC -- If your Racket interpreter is installed in a non-standard location (anywhere - other than =/usr/bin/racket=), also add the following to your =.emacs.d= file: + - If your Racket interpreter is installed in a non-standard location (anywhere + other than =/usr/bin/racket=), also add the following to your =.emacs.d= file: -#+BEGIN_SRC emacs-lisp - ;; Set path to racket interpreter - (setq org-babel-command:racket "/path/goes/here") -#+END_SRC + #+BEGIN_SRC emacs-lisp + ;; Set path to racket interpreter + (setq org-babel-command:racket "/path/goes/here") + #+END_SRC ** Author -Chris Vig (chris@invictus.so) + Chris Vig (chris@invictus.so) + +*** Contributors + + - [[http://georgemauer.net][George Mauer]] diff --git a/ob-racket.el b/ob-racket.el index f281bda..2383bb5 100644 --- a/ob-racket.el +++ b/ob-racket.el @@ -25,8 +25,6 @@ ;; org-babel functions for racket evaluation ;; -;; -- Provide -- - (provide 'ob-racket) ;; -- Requires -- @@ -40,53 +38,75 @@ (defvar org-babel-default-header-args:racket '((:lang . "racket")) "A list of default header args for Racket code blocks.") -(defvar org-babel-command:racket "/usr/bin/racket" - "The path to the Racket interpreter executable.") +(defun ob-racket--format-require (requirement) + "Format require statement for Racket" + (format "(require %s)" requirement)) + +(defun ob-racket--format-var (var-name var-value) + "Format variable assignment statement for racket" + (format "(define %s (quote %S))" var-name var-value)) + +(defun ob-racket--expand-named-src-block (blockname) + (save-excursion + (goto-char (org-babel-find-named-block blockname)) + (org-babel-expand-src-block))) + +(defcustom org-babel-command:racket "/usr/bin/racket" + "The path to the Racket interpreter executable." + :group 'org-babel + :type 'string) ;; -- Babel Functions -- (defun org-babel-expand-body:racket (body params) "Expands the body of a Racket code block." - ;; Currently we don't do any expansion for tangled blocks. Just return - ;; body unmodified as specified by the user. - body) - -(defun org-babel-execute:racket (body params) + (let* ((lines-of-body (split-string body "\n")) + (first-line (car lines-of-body)) + (output-lines-stack '()) + (print-length nil)) ;; Used by the format function which is invoked inside string formatting + (cl-flet* ((out (l) (push l output-lines-stack)) + (out-headers () + (when-let* ((requires (assoc 'requires params))) + (out (mapconcat 'ob-racket--format-require + (cadr requires) + "\n"))) + (when-let* ((vars (cadr (assoc 'vars params)))) + (out (mapconcat (lambda (var) (ob-racket--format-var (car var) (cdr var))) + vars + "\n"))))) + ;; actually not sure this next part is necessary + (cond ((string-match "#lang" first-line) + (out first-line) + (out-headers)) + (t + (out "#lang racket") + (out-headers) + (out first-line))) + (dolist (l (cdr lines-of-body)) + (out l)) + (string-join (reverse output-lines-stack) "\n")))) + + +(defun org-babel-execute:racket (body unparsed-params) "Executes a Racket code block." - ;; Round up the stuff we need - (let* ((parsed-params (ob-racket--parse-params params))) - (expanded-body (org-babel-expand-body:racket body params)) - (result-type (nth 0 parsed-params)) - (lang (nth 1 parsed-params)) - (vars (nth 2 parsed-params)) - (temp-file (make-temp-file "ob-racket-") - ;; Build script in temporary file - (with-temp-file temp-file - (cond - ;; Results type is "value" - run in let form - ((equal result-type 'value)))))) - (let ((vars-string) - (mapconcat (lambda (var) (format "[%s (quote %s)]" (car var) (cdr var))) vars " ")) - (insert (format "#lang %s\n(let (%s)\n%s)") - lang - vars-string - expanded-body - ;; Results type is "output" - run as script - ((equal result-type 'output)))) - (let ((vars-string - (mapconcat (lambda (var) (format "(define %s (quote %s))" (car var) (cdr var))) vars "\n"))) - (insert (format "#lang %s\n%s\n%s") - lang - vars-string - body - ;; Unknown result type?? - (t (error "Invalid result type: %s" result-type))) + (let* ((params (ob-racket--parse-params unparsed-params)) + (main-src (org-babel-expand-body:racket body params)) + (temporary-file-directory (file-name-as-directory (make-temp-file "ob-racket-" 'make-directory-only))) + (main-filename (concat temporary-file-directory (make-temp-name "ob-racket") ".rkt"))) + (dolist (blockname (cadr (assoc 'adjacent-files params))) + (let ((filename (concat temporary-file-directory blockname)) + (src (ob-racket--expand-named-src-block blockname))) + (with-temp-file filename + (insert src)))) + (with-temp-file main-filename + (insert main-src)) ;; Run script with Racket interpreter, delete temp file, and return output (with-temp-buffer - (prog2)) - (call-process org-babel-command:racket nil (current-buffer) nil temp-file) - (buffer-string)) - (delete-file temp-file)) + (prog2 + (let ((default-directory temporary-file-directory)) + (call-process org-babel-command:racket nil (current-buffer) nil main-filename)) + (buffer-string) + (delete-directory temporary-file-directory 'recursive))))) (defun org-babel-prep-session:racket (session params) (error "Racket does not currently support sessions.")) @@ -96,14 +116,20 @@ (defun ob-racket--parse-params (params) "Processes and parses parameters for an Org Babel code block. The results are returned as a list." - (let ((processed-params (org-babel-process-params params)))) - (result-type nil) - (lang nil) - (vars nil + (let ((processed-params (org-babel-process-params params)) + (result-type nil) + (requires nil) + (adjacent-files nil) + (vars nil)) (dolist (processed-param processed-params) - (let ((key (car processed-param)) (value (cdr processed-param)))))) - (cond - ((equal key :result-type) (setq result-type value)) - ((equal key :lang) (setq lang value)) - ((equal key :var) (push value vars) - (list result-type lang vars)))) + (let ((key (car processed-param)) + (value (cdr processed-param))) + (cond + ((equal key :result-type) (setq result-type value)) + ((equal key :var) (push value vars)) + ((equal key :adjacent-file) (setq adjacent-files (split-string value "\s+"))) + ((equal key :require) (push value requires))))) + `((result-type ,result-type) + (vars ,vars) + (adjacent-files ,adjacent-files) + (requires ,requires))))