94 lines
2.3 KiB
Factor
94 lines
2.3 KiB
Factor
|
! 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 ;
|
||
|
|
|
||
|
|
|