! Copyright (C) 2009 John Benediktsson
! See http://factorcode.org/license.txt for BSD license
-USING: accessors assocs fry io io.streams.string kernel macros
-math peg.ebnf prettyprint sequences strings ;
+USING: accessors assocs command-line io io.encodings.binary
+io.files io.streams.string kernel macros math namespaces
+peg.ebnf prettyprint sequences multiline ;
IN: brainfuck
: (-) ( brainfuck n -- brainfuck )
[ get-memory ] dip - 255 bitand set-memory ;
-: (?) ( brainfuck -- brainfuck t/f )
- get-memory 0 = not ;
-
: (.) ( brainfuck -- brainfuck )
- get-memory 1string write ;
+ get-memory write1 ;
: (,) ( brainfuck -- brainfuck )
read1 set-memory ;
: (>) ( brainfuck n -- brainfuck )
- [ + ] curry change-pointer ;
+ '[ _ + ] change-pointer ;
: (<) ( brainfuck n -- brainfuck )
- [ - ] curry change-pointer ;
+ '[ _ - ] change-pointer ;
: (#) ( brainfuck -- brainfuck )
dup
: compose-all ( seq -- quot )
[ ] [ compose ] reduce ;
-EBNF: parse-brainfuck
+EBNF: parse-brainfuck [=[
-inc-ptr = (">")+ => [[ length [ (>) ] curry ]]
-dec-ptr = ("<")+ => [[ length [ (<) ] curry ]]
-inc-mem = ("+")+ => [[ length [ (+) ] curry ]]
-dec-mem = ("-")+ => [[ length [ (-) ] curry ]]
+inc-ptr = (">")+ => [[ length '[ _ (>) ] ]]
+dec-ptr = ("<")+ => [[ length '[ _ (<) ] ]]
+inc-mem = ("+")+ => [[ length '[ _ (+) ] ]]
+dec-mem = ("-")+ => [[ length '[ _ (-) ] ]]
output = "." => [[ [ (.) ] ]]
input = "," => [[ [ (,) ] ]]
debug = "#" => [[ [ (#) ] ]]
-space = (" "|"\t"|"\r\n"|"\n")+ => [[ [ ] ]]
+space = [ \t\n\r]+ => [[ [ ] ]]
unknown = (.) => [[ "Invalid input" throw ]]
ops = inc-ptr|dec-ptr|inc-mem|dec-mem|output|input|debug|space
-loop = "[" {loop|ops}+ "]" => [[ second compose-all [ while ] curry [ (?) ] prefix ]]
+loop = "[" {loop|ops}+ "]" => [[ second compose-all '[ [ get-memory zero? ] _ until ] ]]
code = (loop|ops|unknown)* => [[ compose-all ]]
-;EBNF
+]=]
PRIVATE>
-MACRO: run-brainfuck ( code -- )
- [ <brainfuck> ] swap parse-brainfuck [ drop flush ] 3append ;
+MACRO: run-brainfuck ( code -- quot )
+ parse-brainfuck '[ <brainfuck> @ drop flush ] ;
: get-brainfuck ( code -- result )
[ run-brainfuck ] with-string-writer ; inline
+<PRIVATE
+
+: (run-brainfuck) ( code -- )
+ [ <brainfuck> ] dip parse-brainfuck call( x -- x ) drop flush ;
+
+PRIVATE>
+
+: brainfuck-main ( -- )
+ command-line get [
+ read-contents (run-brainfuck)
+ ] [
+ [ binary file-contents (run-brainfuck) ] each
+ ] if-empty ;
+
+MAIN: brainfuck-main