steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

brainfuck: some cleanup and make the ebnf simpler.

db4
John Benediktsson 2011-08-26 18:42:17 -07:00
parent dd280eae9a
commit 02181a5d50
1 changed files with 16 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
extra/brainfuck/brainfuck.factor
View File

@ -1,8 +1,8 @@
! Copyright (C) 2009 John Benediktsson ! Copyright (C) 2009 John Benediktsson
! See http://factorcode.org/license.txt for BSD license ! See http://factorcode.org/license.txt for BSD license
USING: accessors assocs fry io io.streams.string kernel macros math USING: accessors assocs fry io io.streams.string kernel macros
peg.ebnf prettyprint quotations sequences strings ; math peg.ebnf prettyprint sequences strings ;
IN: brainfuck IN: brainfuck
@ -10,7 +10,7 @@ IN: brainfuck
TUPLE: brainfuck pointer memory ; TUPLE: brainfuck pointer memory ;
: <brainfuck> ( -- brainfuck ) : <brainfuck> ( -- brainfuck )
0 H{ } clone brainfuck boa ; 0 H{ } clone brainfuck boa ;
: get-memory ( brainfuck -- brainfuck value ) : get-memory ( brainfuck -- brainfuck value )
@ -37,31 +37,31 @@ TUPLE: brainfuck pointer memory ;
: (>) ( brainfuck n -- brainfuck ) : (>) ( brainfuck n -- brainfuck )
[ dup pointer>> ] dip + >>pointer ; [ dup pointer>> ] dip + >>pointer ;
: (<) ( brainfuck n -- brainfuck ) : (<) ( brainfuck n -- brainfuck )
[ dup pointer>> ] dip - >>pointer ; [ dup pointer>> ] dip - >>pointer ;
: (#) ( brainfuck -- brainfuck ) : (#) ( brainfuck -- brainfuck )
dup dup
[ "ptr=" write pointer>> pprint ] [ "ptr=" write pointer>> pprint ]
[ ",mem=" write memory>> pprint nl ] bi ; [ ",mem=" write memory>> pprint nl ] bi ;
: compose-all ( seq -- quot ) : compose-all ( seq -- quot )
[ ] [ compose ] reduce ; [ ] [ compose ] reduce ;
EBNF: parse-brainfuck EBNF: parse-brainfuck
inc-ptr = (">")+ => [[ length 1quotation [ (>) ] append ]] inc-ptr = (">")+ => [[ length [ (>) ] curry ]]
dec-ptr = ("<")+ => [[ length 1quotation [ (<) ] append ]] dec-ptr = ("<")+ => [[ length [ (<) ] curry ]]
inc-mem = ("+")+ => [[ length 1quotation [ (+) ] append ]] inc-mem = ("+")+ => [[ length [ (+) ] curry ]]
dec-mem = ("-")+ => [[ length 1quotation [ (-) ] append ]] dec-mem = ("-")+ => [[ length [ (-) ] curry ]]
output = "." => [[ [ (.) ] ]] output = "." => [[ [ (.) ] ]]
input = "," => [[ [ (,) ] ]] input = "," => [[ [ (,) ] ]]
debug = "#" => [[ [ (#) ] ]] debug = "#" => [[ [ (#) ] ]]
space = (" "|"\t"|"\r\n"|"\n")+ => [[ [ ] ]] space = (" "|"\t"|"\r\n"|"\n")+ => [[ [ ] ]]
unknown = (.) => [[ "Invalid input" throw ]] unknown = (.) => [[ "Invalid input" throw ]]
ops = inc-ptr|dec-ptr|inc-mem|dec-mem|output|input|debug|space ops = inc-ptr|dec-ptr|inc-mem|dec-mem|output|input|debug|space
loop = "[" {loop|ops}+ "]" => [[ second compose-all 1quotation [ [ (?) ] ] prepend [ while ] append ]] loop = "[" {loop|ops}+ "]" => [[ second compose-all [ while ] curry [ (?) ] prefix ]]
code = (loop|ops|unknown)* => [[ compose-all ]] code = (loop|ops|unknown)* => [[ compose-all ]]
@ -72,6 +72,6 @@ PRIVATE>
MACRO: run-brainfuck ( code -- ) MACRO: run-brainfuck ( code -- )
[ <brainfuck> ] swap parse-brainfuck [ drop flush ] 3append ; [ <brainfuck> ] swap parse-brainfuck [ drop flush ] 3append ;
: get-brainfuck ( code -- result ) : get-brainfuck ( code -- result )
[ run-brainfuck ] with-string-writer ; inline [ run-brainfuck ] with-string-writer ; inline