1 ! Copyright (C) 2009 John Benediktsson
2 ! See http://factorcode.org/license.txt for BSD license
4 USING: accessors assocs io io.streams.string kernel macros
5 math peg.ebnf prettyprint sequences strings ;
11 TUPLE: brainfuck pointer memory ;
13 : <brainfuck> ( -- brainfuck )
14 0 H{ } clone brainfuck boa ;
16 : get-memory ( brainfuck -- brainfuck value )
17 dup [ pointer>> ] [ memory>> ] bi at 0 or ;
19 : set-memory ( brainfuck value -- brainfuck )
20 over [ pointer>> ] [ memory>> ] bi set-at ;
22 : (+) ( brainfuck n -- brainfuck )
23 [ get-memory ] dip + 255 bitand set-memory ;
25 : (-) ( brainfuck n -- brainfuck )
26 [ get-memory ] dip - 255 bitand set-memory ;
28 : (?) ( brainfuck -- brainfuck t/f )
29 get-memory zero? not ;
31 : (.) ( brainfuck -- brainfuck )
34 : (,) ( brainfuck -- brainfuck )
37 : (>) ( brainfuck n -- brainfuck )
38 [ + ] curry change-pointer ;
40 : (<) ( brainfuck n -- brainfuck )
41 [ - ] curry change-pointer ;
43 : (#) ( brainfuck -- brainfuck )
45 [ "ptr=" write pointer>> pprint ]
46 [ ",mem=" write memory>> pprint nl ] bi ;
48 : compose-all ( seq -- quot )
49 [ ] [ compose ] reduce ;
53 inc-ptr = (">")+ => [[ length [ (>) ] curry ]]
54 dec-ptr = ("<")+ => [[ length [ (<) ] curry ]]
55 inc-mem = ("+")+ => [[ length [ (+) ] curry ]]
56 dec-mem = ("-")+ => [[ length [ (-) ] curry ]]
57 output = "." => [[ [ (.) ] ]]
58 input = "," => [[ [ (,) ] ]]
59 debug = "#" => [[ [ (#) ] ]]
60 space = (" "|"\t"|"\r\n"|"\n")+ => [[ [ ] ]]
61 unknown = (.) => [[ "Invalid input" throw ]]
63 ops = inc-ptr|dec-ptr|inc-mem|dec-mem|output|input|debug|space
64 loop = "[" {loop|ops}+ "]" => [[ second compose-all [ while ] curry [ (?) ] prefix ]]
66 code = (loop|ops|unknown)* => [[ compose-all ]]
72 MACRO: run-brainfuck ( code -- )
73 [ <brainfuck> ] swap parse-brainfuck [ drop flush ] 3append ;
75 : get-brainfuck ( code -- result )
76 [ run-brainfuck ] with-string-writer ; inline