;;; brainfuck.el -- Brainfuck Compiler/Interpreter ;; ;;; Copyright (C) 2016 Kyle W T Sherman ;; ;; Author: Kyle W T Sherman <kylewsherman at gmail dot com> ;; Created: 2016-03-18 ;; Version: 1.0 ;; Keywords: brainfuck parser compiler interpreter mode ;; ;; This file is not part of GNU Emacs. ;; ;; This is free software; you can redistribute it and/or modify it under the ;; terms of the GNU General Public License as published by the Free Software ;; Foundation; either version 2, or (at your option) any later version. ;; ;; This is distributed in the hope that it will be useful, but WITHOUT ANY ;; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS ;; FOR A PARTICULAR PURPOSE. See the GNU General Public License for more ;; details. ;; ;; You should have received a copy of the GNU General Public License along ;; with GNU Emacs; see the file COPYING. If not, write to the Free Software ;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. ;; ;;; Commentary: ;; ;; Provides `brainfuck-mode' function that implements syntax highlighting. ;; ;; If `*brainfuck-debug*' is putting ellipsis' in the output, set the ;; following variables: ;; ;; (setq print-length nil) ;; (setq print-level nil) ;; ;;; Installation: ;; ;; Put `brainfuck.el' where you keep your elisp files and add something like ;; the following to your .emacs file: ;; ;; (autoload 'brainfuck-mode "brainfuck" "Major mode for editing Brainfuck code." t) ;; (add-to-list 'auto-mode-alist '("\\.bf$" . brainfuck-mode)) ;; ;;; Usage: ;; ;; Load a Brainfuck (.bf) file and press \C-cr or eval: ;; ;; (brainfuck-run) ;; ;; Example (Hello World! from https://en.wikipedia.org/wiki/Brainfuck): ;; ;; +++++ +++ Set Cell #0 to 8 ;; [ ;; >++++ Add 4 to Cell #1; this will always set Cell #1 to 4 ;; [ as the cell will be cleared by the loop ;; >++ Add 2 to Cell #2 ;; >+++ Add 3 to Cell #3 ;; >+++ Add 3 to Cell #4 ;; >+ Add 1 to Cell #5 ;; <<<<- Decrement the loop counter in Cell #1 ;; ] Loop till Cell #1 is zero; number of iterations is 4 ;; >+ Add 1 to Cell #2 ;; >+ Add 1 to Cell #3 ;; >- Subtract 1 from Cell #4 ;; >>+ Add 1 to Cell #6 ;; [<] Move back to the first zero cell you find; this will ;; be Cell #1 which was cleared by the previous loop ;; <- Decrement the loop Counter in Cell #0 ;; ] Loop till Cell #0 is zero; number of iterations is 8 ;; >>. Cell #2 has value 72 which is 'H' ;; >---. Subtract 3 from Cell #3 to get 101 which is 'e' ;; +++++++..+++. Likewise for 'llo' from Cell #3 ;; >>. Cell #5 is 32 for the space ;; <-. Subtract 1 from Cell #4 for 87 to give a 'W' ;; <. Cell #3 was set to 'o' from the end of 'Hello' ;; +++.------.--------. Cell #3 for 'rl' and 'd' ;; >>+. Add 1 to Cell #5 gives us an exclamation point ;; >++. And finally a newline from Cell #6 ;; ;; Or just: ;; ;; ++++++++[>++++[>++>+++>+++>+<<<<-]>+>+>->>+[<]<-]>>.>---.+++++++..+++.>>.<-.<.+++.------.--------.>>+.>++. ;;; Code: ;; customize group (defgroup brainfuck nil "Brainfuck compiler/interpreter." :prefix "brainfuck-" :group 'programming) ;; initial data size (defconst brainfuck-data-size 10000 "Initial program data side in bytes.") ;;; Keywords and Font Locking ;; commands regexp (defconst brainfuck-keywords-commands-regexp "[][><+-.,]" "Brainfuck commands.") ;; comments regexp (i.e. everything else) (defconst brainfuck-keywords-comments-regexp "[^][><+-.,]" "Brainfuck comments.") ;; commands (defconst brainfuck-keywords-commands '(?> ?< ?+ ?- ?. ?, ?\[ ?\]) "Brainfuck commands.") ;; font lock settings (defconst brainfuck-mode-font-lock-keywords `(("[><]" 0 font-lock-builtin-face) ("[+-]" 0 nil) ("[.,]" 0 font-lock-keyword-face) ("[][]" 0 font-lock-variable-name-face) (,brainfuck-keywords-comments-regexp 0 font-lock-comment-face)) "Brainfuck keywords used by font-lock.") ;; brainfuck output buffer name (defconst brainfuck-output-buffer-name "*brainfuck-output*" "Buffer name to use for Brainfuck output.") ;;; Brainfuck Mode ;; mode map (defvar brainfuck-mode-map (let ((map (make-sparse-keymap))) ;; (define-key map (kbd "C-c C-c") 'brainfuck-send-paragraph) ;; (define-key map (kbd "C-c C-r") 'brainfuck-send-region) ;; (define-key map (kbd "C-c C-s") 'brainfuck-send-string) ;; (define-key map (kbd "C-c C-b") 'brainfuck-send-buffer) ;;(define-key map (kbd "C-c C-c") 'brainfuck-compile) (define-key map (kbd "C-c C-i") 'brainfuck-interpret-run) (define-key map (kbd "C-c C-c") 'brainfuck-run) (define-key map (kbd "C-c C-r") 'brainfuck-run) map) "Mode map used for `brainfuck-mode'.") ;;;###autoload ;;(define-derived-mode brainfuck-mode fundamental-mode "Brainfuck" (defun brainfuck-mode () "Major mode to edit, compile, and execute Brainfuck programs." (interactive) (kill-all-local-variables) (setq major-mode 'brainfuck-mode) (setq mode-name "Brainfuck") ;; set local key map (use-local-map brainfuck-mode-map) ;; set font lock (case insensitive) (setq font-lock-defaults '((brainfuck-mode-font-lock-keywords) nil t)) ;; set buffer to case insensitive (setq case-fold-search t) ;; run hooks (run-hooks 'brainfuck-mode-hook)) ;;; Parser ;; list of relevant ascii character codes and their enumerated types (defvar brainfuck-parse-grammar-char-type `(,(cons (string-to-char ">") :greater-than) ,(cons (string-to-char "<") :less-than) ,(cons (string-to-char "+") :plus) ,(cons (string-to-char "-") :minus) ,(cons (string-to-char ".") :period) ,(cons (string-to-char ",") :comma) ,(cons (string-to-char "[") :left-bracket) ,(cons (string-to-char "]") :right-bracket)) "List of characters and their types.") ;; hash table of codes to types (defvar brainfuck-parse-grammar-char-type-hash (make-hash-table) "Map of characters to their types.") (dolist (item brainfuck-parse-grammar-char-type) (setf (gethash (car item) brainfuck-parse-grammar-char-type-hash) (cdr item))) ;; map of enumerated types to their ascii character codes (defvar brainfuck-parse-grammar-type-char-hash (make-hash-table) "Map of types to their characters.") (dolist (item brainfuck-parse-grammar-char-type) (let ((entry (gethash (cdr item) brainfuck-parse-grammar-type-char-hash))) (if entry (if (listp entry) (setf (gethash (cdr item) brainfuck-parse-grammar-type-char-hash) (append entry (list (car item)))) (setf (gethash (cdr item) brainfuck-parse-grammar-type-char-hash) (list entry (car item)))) (setf (gethash (cdr item) brainfuck-parse-grammar-type-char-hash) (car item))))) ;; parse statement (defun brainfuck-parse-statement (statement) "Parse Brainfuck STATEMENT into a list of tokens." (let (tokens ; generated token list current ; current string (jump 0)) ; nested jump count ;; loop over all characters in statement (cl-loop for char across statement do (let ((type (gethash char brainfuck-parse-grammar-char-type-hash))) (when type (cond ((eq type :left-bracket) (setq jump (1+ jump))) ((eq type :right-bracket) (setq jump (1- jump)))) (push type tokens) (when (< jump 0) (error "Parsed ']' command without a matching '['"))))) (when (> jump 0) (error "Parsed '[' command without a matching ']'")) ;; return tokens (nreverse tokens))) ;; parse buffer or region (defun brainfuck-parse (&optional start end) "Parse current buffer or region and return a list of tokens." (let ((start (or start (point-min))) (end (or end (point-max)))) ;; parse buffer and convert syntax to tokens (brainfuck-parse-statement (buffer-substring-no-properties start end)))) ;;; Interpreter ;; interpret tokens and run brainfuck program (defun brainfuck-interpret (tokens &optional input) "Interpret TOKENS with optional INPUT and run Brainfuck program." (let ((data (make-vector brainfuck-data-size 0)) ; initial data block (data-pointer 0) ; data pointer jump-stack ; jump stack output ; output (input (if (stringp input) ; input as a list of bytes (nconc (string-to-list input) (list -1)) input))) ;; iterate over tokens (while tokens ;;(message "%S %S %S" (aref data 0) (aref data 1) (aref data 2)) (let ((token (pop tokens))) ;; interpret token (cond ((eq token :greater-than) ; '>' (incf data-pointer) (when (= data-pointer (length data)) (setq data (vconcat data (make-vector brainfuck-data-size 0))))) ((eq token :less-than) ; '<' (decf data-pointer) (when (minusp data-pointer) (error "Data pointer cannot go below zero"))) ((eq token :plus) ; '+' ;;(aset data data-pointer (1+ (aref data data-pointer)))) (incf (aref data data-pointer))) ((eq token :minus) ; '-' ;;(aset data data-pointer (1- (aref data data-pointer)))) (decf (aref data data-pointer))) ((eq token :period) ; '.' (push (aref data data-pointer) output)) ((eq token :comma) ; ',' (aset data data-pointer (progn (unless input ; if input is empty, prompt for more (setq input (string-to-list (read-from-minibuffer "? ")))) (if input (pop input) ; return next input character -1)))) ; default to -1 if no input given ((eq token :left-bracket) ; '[' (if (zerop (aref data data-pointer)) ;; if data at point is zero then skip to end of jump (let ((js 1)) (while (plusp js) (setq token (pop tokens)) (cond ((eq token :left-bracket) (incf js)) ((eq token :right-bracket) (decf js))))) ;; otherwise, loop through code block (push (cons token tokens) jump-stack))) ((eq token :right-bracket) ; ']' ;; loop (setq tokens (pop jump-stack)))))) ;; return output (concat (nreverse output)))) ;; run buffer with interpreter ;;;###autoload (defun brainfuck-interpret-run (&optional input buffer) "Interpret a Brainfuck program in BUFFER with optional INPUT. \nBUFFER defaults to `current-buffer'." (interactive) (let ((buffer (or buffer (current-buffer))) output-buffer) (save-current-buffer (set-buffer buffer) ;; parse buffer (condition-case err (let ((output-buffer (get-buffer-create brainfuck-output-buffer-name)) ; output buffer (tokens (brainfuck-parse))) ; parse tokens ;; setup output buffer (delete-other-windows) (split-window-vertically) (other-window 1) (set-buffer output-buffer) (switch-to-buffer output-buffer) (setq buffer-read-only nil) (erase-buffer) ;; compile and run program (condition-case err (insert (brainfuck-interpret tokens input)) ('error (insert (format "Compiler Error: %s" err))))) ('error (insert (format "Parser Error: %s" err))) ;; make output buffer read-only (setq buffer-read-only t))))) ;;; Compiler ;; compile tokens into elisp code (defun brainfuck-compile (tokens) "Compile TOKENS and return a block of Emacs Lisp code." (cl-labels ((while-loop () (let (done code) (while (and (not done) tokens) ; iterate over tokens generating code (let ((token (pop tokens))) (cond ((eq token :greater-than) (push `(funcall data-pointer-incr) code)) ((eq token :less-than) (push `(funcall data-pointer-decr) code)) ((eq token :plus) (push `(funcall data-incr) code)) ((eq token :minus) (push `(funcall data-decr) code)) ((eq token :period) (push `(funcall data-output) code)) ((eq token :comma) (push `(funcall data-input) code)) ((eq token :left-bracket) ; start new loop (push `(while (not (zerop (aref data data-pointer))) ,@(while-loop)) code)) ((eq token :right-bracket) ; return from loop (setq done t))))) (nreverse code)))) ;; return generated code `(lambda (&optional input) ;; global data (let ((data (make-vector brainfuck-data-size 0)) ; initial data block (data-pointer 0) ; data pointer jump-stack ; jump stack output ; output stream (input (if (stringp input) ; input as a list of bytes (nconc (string-to-list input) (list -1)) input))) ;; functions (let ((data-pointer-incr ; '>' (lambda () (incf data-pointer) (when (= data-pointer (length data)) (setq data (vconcat data (make-vector brainfuck-data-size 0)))))) (data-pointer-decr ; '<' (lambda () (decf data-pointer) (when (minusp data-pointer) (error "Data pointer cannot go below zero")))) (data-incr ; '+' (lambda () (incf (aref data data-pointer)))) (data-decr ; '-' (lambda () (decf (aref data data-pointer)))) (data-output ; '.' (lambda () (push (aref data data-pointer) output))) (data-input ; ',' (lambda () (aset data data-pointer (progn (unless input ; if input is empty, prompt for more (setq input (string-to-list (read-from-minibuffer "? ")))) (if input (pop input) ; return next input character -1)))))) ; default to -1 if no input given ,@(while-loop) ;; return output (concat (nreverse output))))))) ;; compile and run buffer ;;;###autoload (defun brainfuck-run (&optional input buffer) "Compile and run a Brainfuck program in BUFFER with optional INPUT. \nBUFFER defaults to `current-buffer'." (interactive) (let ((buffer (or buffer (current-buffer))) output-buffer) (save-current-buffer (set-buffer buffer) ;; parse buffer (condition-case err (let ((output-buffer (get-buffer-create brainfuck-output-buffer-name)) ; output buffer (tokens (brainfuck-parse))) ; parse tokens ;; setup output buffer (delete-other-windows) (split-window-vertically) (other-window 1) (set-buffer output-buffer) (switch-to-buffer output-buffer) (setq buffer-read-only nil) (erase-buffer) ;; compile and run program (condition-case err (let ((code (brainfuck-compile tokens))) (message "Brainfuck compiled code: %S" code) (insert (funcall code input))) ('error (insert (format "Compiler Error: %s" err))))) ('error (insert (format "Parser Error: %s" err))) ;; make output buffer read-only (setq buffer-read-only t))))) (provide 'brainfuck) ;;; brainfuck.el ends here