1 ! Copyright (C) 2009 John Benediktsson
2 ! See http://factorcode.org/license.txt for BSD license
4 USING: accessors assocs fry io io.streams.string kernel macros math peg.ebnf sequences strings ;
10 TUPLE: brainfuck ptr mem ops ;
12 : <brainfuck> ( -- brainfuck )
13 0 H{ } clone 0 brainfuck boa ;
15 : ops? ( brainfuck -- brainfuck )
17 dup ops>> 10000 > [ "Max operations" throw ] when ;
19 : (get-mem) ( brainfuck -- brainfuck value )
20 dup [ ptr>> ] [ mem>> ] bi at 0 or ;
22 : (set-mem) ( brainfuck value -- brainfuck )
23 over [ ptr>> ] [ mem>> ] bi set-at ;
25 : mem++ ( brainfuck -- brainfuck )
26 (get-mem) 1 + 255 bitand (set-mem) ops? ;
28 : mem-- ( brainfuck -- brainfuck )
29 (get-mem) 1 - 255 bitand (set-mem) ops? ;
31 : mem? ( brainfuck -- brainfuck t/f )
32 ops? (get-mem) 0 = not ;
34 : out ( brainfuck -- brainfuck )
35 (get-mem) 1string write ops? ;
37 : in ( brainfuck -- brainfuck )
38 read1 (set-mem) ops? ;
40 : ptr++ ( brainfuck -- brainfuck )
41 [ 1 + ] change-ptr ops? ;
43 : ptr-- ( brainfuck -- brainfuck )
44 [ 1 - ] change-ptr ops? ;
46 : compose-all ( seq -- quot )
47 [ ] [ compose ] reduce ;
51 inc-ptr = ">" => [[ [ ptr++ ] ]]
52 dec-ptr = "<" => [[ [ ptr-- ] ]]
53 inc-mem = "+" => [[ [ mem++ ] ]]
54 dec-mem = "-" => [[ [ mem-- ] ]]
55 output = "." => [[ [ out ] ]]
56 input = "," => [[ [ in ] ]]
57 space = (" "|"\t"|"\r\n"|"\n") => [[ [ ] ]]
58 unknown = (.) => [[ "Invalid input" throw ]]
60 ops = inc-ptr | dec-ptr | inc-mem | dec-mem | output | input | space
61 loop = "[" {loop|ops}* "]" => [[ second compose-all '[ [ mem? ] _ while ] ]]
63 code = (loop|ops|unknown)* => [[ compose-all ]]
69 MACRO: run-brainfuck ( code -- )
70 [ <brainfuck> ] swap parse-brainfuck [ drop flush ] 3append ;
72 : get-brainfuck ( code -- result )
73 [ run-brainfuck ] with-string-writer ; inline