Adding brainf*ck implementation.

extra/brainfuck/authors.txt

@@ -0,0 +1 @@
+John Benediktsson

extra/brainfuck/brainfuck-docs.factor

@@ -0,0 +1,49 @@
+! Copyright (C) 2009 John Benediktsson
+! See http://factorcode.org/license.txt for BSD license
+
+USING: help.syntax help.markup brainfuck strings ;
+
+IN: brainfuck 
+
+HELP: run-brainfuck
+{ $values { "code" string } }
+{ $description
+    "A brainfuck program is a sequence of eight commands that are "
+    "executed sequentially.  An instruction pointer begins at the first "
+    "command, and each command is executed until the program terminates "
+    "when the instruction pointer moves beyond the last command.\n"
+    "\n"
+    "The eight language commands, each consisting of a single character, "
+    "are the following:\n"
+    { $table
+        { "Character" "Meaning" }
+        { ">" "increment the data pointer (to point to the next cell to the right)." }
+        { "<" "decrement the data pointer (to point to the next cell to the left)." }
+        { "+" "increment (increase by one) the byte at the data pointer." }
+        { "-" "decrement (decrease by one) the byte at the data pointer." }
+        { "." "output the value of the byte at the data pointer." }
+        { "," "accept one byte of input, storing its value in the byte at the data pointer." }
+        { "[" "if the byte at the data pointer is zero, then instead of moving the instruction pointer forward to the next command, jump it forward to the command after the matching ] command*." }
+        { "]" "if the byte at the data pointer is nonzero, then instead of moving the instruction pointer forward to the next command, jump it back to the command after the matching [ command*." }
+    }
+    "\n"
+    "Brainfuck programs can be translated into C using the following "
+    "substitutions, assuming ptr is of type unsigned char* and has been "
+    "initialized to point to an array of zeroed bytes:\n"
+    { $table
+        { "Character" "C equivalent" }
+        { ">" "++ptr;" }
+        { "<" "--ptr;" }
+        { "+" "++*ptr;" }
+        { "-" "--*ptr;" }
+        { "." "putchar(*ptr);" }
+        { "," "*ptr=getchar();" }
+        { "[" "while (*ptr) {" }
+        { "]" "}" }
+    }
+} ;
+
+HELP: get-brainfuck
+{ $values { "code" string } { "result" string } }
+{ $description "Returns the output from a brainfuck program as a result string." }  
+{ $see-also run-brainfuck } ;

extra/brainfuck/brainfuck-tests.factor

@@ -0,0 +1,10 @@
+! Copyright (C) 2009 John Benediktsson
+! See http://factorcode.org/license.txt for BSD license
+
+USING: brainfuck multiline tools.test ;
+
+
+[ "Hello World!\n" ] [ <" ++++++++++[>+++++++>++++++++++>+++>+<<<<-]
+                          >++.>+.+++++++..+++.>++.<<+++++++++++++++.>.+++.
+                          ------.--------.>+.>. "> get-brainfuck ] unit-test
+

extra/brainfuck/brainfuck.factor

@@ -0,0 +1,93 @@
+! Copyright (C) 2009 John Benediktsson
+! See http://factorcode.org/license.txt for BSD license
+
+USING: accessors assocs combinators io io.streams.string kernel math 
+namespaces sequences strings ;
+
+IN: brainfuck
+
+<PRIVATE
+
+TUPLE: brainfuck code cp dp steps memory loop ;
+
+: (set-loop) ( brainfuck in out -- brainfuck )
+    pick loop>> [ set-at ] [ [ swap ] dip set-at ] 3bi ;
+
+SYMBOL: tmp
+
+: <brainfuck> ( code -- brainfuck ) 
+    0 0 0 H{ } clone H{ } clone brainfuck boa 
+    V{ } clone tmp set
+    dup code>> <enum> [ 
+        {
+            { CHAR: [ [ tmp get push ] }
+            { CHAR: ] [ tmp get pop (set-loop) ] }
+            [ 2drop ]
+        } case
+    ] assoc-each ;
+
+
+: (get-memory) ( brainfuck -- brainfuck value ) 
+    dup [ dp>> ] [ memory>> ] bi at 0 or ;
+
+: (set-memory) ( intepreter value -- brainfuck ) 
+    over [ dp>> ] [ memory>> ] bi set-at ;
+
+: (inc-memory) ( brainfuck -- brainfuck ) 
+    (get-memory) 1 + 255 bitand (set-memory) ; 
+
+: (dec-memory) ( brainfuck -- brainfuck ) 
+    (get-memory) 1 - 255 bitand (set-memory)  ; 
+
+: (out-memory) ( brainfuck -- brainfuck )
+    (get-memory) 1string write ;
+
+
+: (inc-data) ( brainfuck -- brainfuck )
+    [ 1 + ] change-dp ;
+
+: (dec-data) ( brainfuck -- brainfuck )
+    [ 1 - ] change-dp ;
+
+
+: (loop-start) ( brainfuck -- brainfuck ) 
+    (get-memory) 0 = [ dup [ cp>> ] [ loop>> ] bi at >>cp ] when ;
+
+: (loop-end) ( brainfuck -- brainfuck ) 
+    dup [ cp>> ] [ loop>> ] bi at 1 - >>cp ;
+
+
+: (get-input) ( brainfuck -- brainfuck ) 
+    read1 (set-memory) ;
+
+
+: can-step ( brainfuck -- brainfuck t/f )
+    dup [ steps>> 100000 < ] [ cp>> ] [ code>> length ] tri < and ;
+
+: step ( brainfuck -- brainfuck ) 
+    dup [ cp>> ] [ code>> ] bi nth 
+    { 
+        { CHAR: >  [ (inc-data) ] }
+        { CHAR: <  [ (dec-data) ] }
+        { CHAR: +  [ (inc-memory) ] } 
+        { CHAR: -  [ (dec-memory) ] }
+        { CHAR: .  [ (out-memory) ] }
+        { CHAR: ,  [ (get-input) ] }
+        { CHAR: [  [ (loop-start) ] }
+        { CHAR: ]  [ (loop-end) ] }
+        { CHAR: \s [ ] }
+        { CHAR: \t [ ] }
+        { CHAR: \r [ ] }
+        { CHAR: \n [ ] }
+        [ "invalid input" throw ] 
+    } case [ 1 + ] change-cp [ 1 + ] change-steps ;
+
+PRIVATE>
+
+: run-brainfuck ( code -- )
+    <brainfuck> [ can-step ] [ step ] while drop ;
+
+: get-brainfuck ( code -- result )
+    [ run-brainfuck ] with-string-writer ;
+
+

extra/brainfuck/summary.txt

@@ -0,0 +1 @@
+Brainfuck programming language.