1 ! Copyright (C) 2009 John Benediktsson
2 ! See http://factorcode.org/license.txt for BSD license
4 USING: accessors assocs command-line fry io io.encodings.binary
5 io.files io.streams.string kernel macros math namespaces
6 peg.ebnf prettyprint sequences ;
12 TUPLE: brainfuck pointer memory ;
14 : <brainfuck> ( -- brainfuck )
15 0 H{ } clone brainfuck boa ;
17 : get-memory ( brainfuck -- brainfuck value )
18 dup [ pointer>> ] [ memory>> ] bi at 0 or ;
20 : set-memory ( brainfuck value -- brainfuck )
21 over [ pointer>> ] [ memory>> ] bi set-at ;
23 : (+) ( brainfuck n -- brainfuck )
24 [ get-memory ] dip + 255 bitand set-memory ;
26 : (-) ( brainfuck n -- brainfuck )
27 [ get-memory ] dip - 255 bitand set-memory ;
29 : (?) ( brainfuck -- brainfuck t/f )
30 get-memory zero? not ;
32 : (.) ( brainfuck -- brainfuck )
35 : (,) ( brainfuck -- brainfuck )
38 : (>) ( brainfuck n -- brainfuck )
39 '[ _ + ] change-pointer ;
41 : (<) ( brainfuck n -- brainfuck )
42 '[ _ - ] change-pointer ;
44 : (#) ( brainfuck -- brainfuck )
46 [ "ptr=" write pointer>> pprint ]
47 [ ",mem=" write memory>> pprint nl ] bi ;
49 : compose-all ( seq -- quot )
50 [ ] [ compose ] reduce ;
54 inc-ptr = (">")+ => [[ length '[ _ (>) ] ]]
55 dec-ptr = ("<")+ => [[ length '[ _ (<) ] ]]
56 inc-mem = ("+")+ => [[ length '[ _ (+) ] ]]
57 dec-mem = ("-")+ => [[ length '[ _ (-) ] ]]
58 output = "." => [[ [ (.) ] ]]
59 input = "," => [[ [ (,) ] ]]
60 debug = "#" => [[ [ (#) ] ]]
61 space = (" "|"\t"|"\r\n"|"\n")+ => [[ [ ] ]]
62 unknown = (.) => [[ "Invalid input" throw ]]
64 ops = inc-ptr|dec-ptr|inc-mem|dec-mem|output|input|debug|space
65 loop = "[" {loop|ops}+ "]" => [[ second compose-all '[ [ (?) ] _ while ] ]]
67 code = (loop|ops|unknown)* => [[ compose-all ]]
73 MACRO: run-brainfuck ( code -- )
74 parse-brainfuck '[ <brainfuck> @ drop flush ] ;
76 : get-brainfuck ( code -- result )
77 [ run-brainfuck ] with-string-writer ; inline
81 : (run-brainfuck) ( code -- )
82 [ <brainfuck> ] dip parse-brainfuck call( x -- x ) drop flush ;
86 : brainfuck-main ( -- )
88 contents (run-brainfuck)
90 [ binary file-contents (run-brainfuck) ] each