Execute Brain****: Difference between revisions
Content deleted Content added
Added newLISP |
|||
Line 5,269: | Line 5,269: | ||
0 |
0 |
||
} |
} |
||
</lang> |
|||
=={{header|NewLISP}}== |
|||
<lang newlisp> |
|||
; This module translates a string containing a |
|||
; Brainf*** program into a list of NewLISP expressions. |
|||
; Attempts to optimize consecutive +, -, > and < operations |
|||
; as well as bracket loops. |
|||
; Create a namespace and put the following definitions in it |
|||
(context 'BF) |
|||
; If BF:quiet is true, BF:run will return the output of the |
|||
; Brainf*** program |
|||
(define quiet) |
|||
; If BF:show-timing is true, the amount of milliseconds spent |
|||
; in 'compiling' (actually translating) and running the |
|||
; resulting program will be shown |
|||
(define show-timing true) |
|||
; The Brainf*** program as a string of characters |
|||
(define src "") |
|||
; Checks for correct pairs of brackets |
|||
(define (well-formed?) |
|||
(let (p 0) |
|||
(dostring (i src (> 0 p)) |
|||
(case i |
|||
("[" (++ p)) |
|||
("]" (-- p)))) |
|||
(zero? p))) |
|||
; Translate the Brainf*** command into S-expressions |
|||
(define (_compile) |
|||
(let ((prog '()) |
|||
; Translate + |
|||
(incr '(++ (tape i) n)) |
|||
; Translate - |
|||
(decr '(-- (tape i) n)) |
|||
; Translate . |
|||
(emit (if quiet |
|||
'(push (char (tape i)) result -1) |
|||
'(print (char (tape i))))) |
|||
; Translate , |
|||
(store '(setf (tape i) (read-key))) |
|||
; Check for loop condition |
|||
(over? '(zero? (tape i))) |
|||
; Current character of the program |
|||
(m) |
|||
; Find how many times the same character occurs |
|||
(rep (fn ((n 1)) |
|||
(while (= m (src 0)) |
|||
(++ n) |
|||
(pop src)) |
|||
n))) |
|||
; Traverse the program and translate recursively |
|||
(until (or (empty? src) (= "]" (setq m (pop src)))) |
|||
(case m |
|||
(">" (push (list '++ 'i (rep)) prog -1)) |
|||
("<" (push (list '-- 'i (rep)) prog -1)) |
|||
("+" (push (expand incr '((n (rep))) true) prog -1)) |
|||
("-" (push (expand decr '((n (rep))) true) prog -1)) |
|||
("." (push emit prog -1)) |
|||
("," (push store prog -1)) |
|||
("[" (push (append (list 'until over?) |
|||
(_compile)) |
|||
prog -1)))) |
|||
prog)) |
|||
(define (compile str , tim code) |
|||
(setq src (join |
|||
(filter (fn (x) |
|||
(member x '("<" ">" "-" "+" |
|||
"." "," {[} {]}))) |
|||
(explode str)))) |
|||
; Throw an error if the program is ill-formed |
|||
(unless (well-formed?) |
|||
(throw-error "Unbalanced brackets in Brainf*** source string")) |
|||
(setq tim (time (setq code (cons 'begin (_compile))))) |
|||
(and show-timing (println "Compilation time: " tim)) |
|||
code) |
|||
; Translate and run |
|||
; Tape size is optional and defaults to 30000 cells |
|||
(define (run str (size 30000)) |
|||
(let ((tape (array size '(0))) |
|||
(i 0) |
|||
(result '()) |
|||
(tim 0) |
|||
(prog (compile str))) |
|||
(setq tim (time (eval prog))) |
|||
(and show-timing (println "Execution time: " tim)) |
|||
(and quiet (join result)))) |
|||
; test - run it with (BF:test) |
|||
(define (test) |
|||
(run "++++++++++[>+++++++>++++++++++>+++++++++++>+++>+<<<<<-]>++.>>+.---.<---.>>++.<+.++++++++.-------.<+++.>+.>+.>.")) |
|||
; to interpret a string of Brainf*** code, use (BF:run <string>) |
|||
; to interpret a Brainf*** code file, use (BF:run (read-file <path-to-file>)) |
|||
</lang> |
</lang> |
||