Adding brainf*ck implementation.
parent
e0df03bfb1
commit
d99ae5af92
|
@ -0,0 +1 @@
|
|||
John Benediktsson
|
|
@ -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 } ;
|
|
@ -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
|
||||
|
|
@ -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 ;
|
||||
|
||||
|
|
@ -0,0 +1 @@
|
|||
Brainfuck programming language.
|
Loading…
Reference in New Issue