factor: trim using lists

[factor.git] / extra / brainfuck / brainfuck.factor

diff --git a/extra/brainfuck/brainfuck.factor b/extra/brainfuck/brainfuck.factor
index 6e7f158165c6847a79d3895f4211531729d5d619..045cf03c1269e0a1546c7b8ce0c9c2616d988b98 100644 (file)
--- a/extra/brainfuck/brainfuck.factor
+++ b/extra/brainfuck/brainfuck.factor
@@ -1,20 +1,18 @@
 ! Copyright (C) 2009 John Benediktsson
 ! See http://factorcode.org/license.txt for BSD license
 
-USING: accessors assocs fry io io.streams.string kernel macros math 
-peg.ebnf quotations sequences strings ;
+USING: accessors assocs command-line io io.encodings.binary
+io.files io.streams.string kernel macros math namespaces
+peg.ebnf prettyprint sequences multiline ;
 
 IN: brainfuck
 
 <PRIVATE
 
-TUPLE: brainfuck pointer memory ops ;
+TUPLE: brainfuck pointer memory ;
 
-: <brainfuck> ( -- brainfuck ) 
-    0 H{ } clone 0 brainfuck boa ;
-
-: max-ops? ( brainfuck -- brainfuck ) 
-    [ 1 + dup 10000 > [ "Max operations" throw ] when ] change-ops ;
+: <brainfuck> ( -- brainfuck )
+    0 H{ } clone brainfuck boa ;
 
 : get-memory ( brainfuck -- brainfuck value )
     dup [ pointer>> ] [ memory>> ] bi at 0 or ;
@@ -22,53 +20,71 @@ TUPLE: brainfuck pointer memory ops ;
 : set-memory ( brainfuck value -- brainfuck )
     over [ pointer>> ] [ memory>> ] bi set-at ;
 
-: (+) ( brainfuck -- brainfuck )
-    get-memory 1 + 255 bitand set-memory max-ops? ;
-
-: (-) ( brainfuck -- brainfuck )
-    get-memory 1 - 255 bitand set-memory max-ops? ;
+: (+) ( brainfuck n -- brainfuck )
+    [ get-memory ] dip + 255 bitand set-memory ;
 
-: (?) ( brainfuck -- brainfuck t/f )
-    max-ops? get-memory 0 = not ;
+: (-) ( brainfuck n -- brainfuck )
+    [ get-memory ] dip - 255 bitand set-memory ;
 
 : (.) ( brainfuck -- brainfuck )
-    get-memory 1string write max-ops? ;
+    get-memory write1 ;
 
 : (,) ( brainfuck -- brainfuck )
-    read1 set-memory max-ops? ;
+    read1 set-memory ;
+
+: (>) ( brainfuck n -- brainfuck )
+    '[ _ + ] change-pointer ;
 
-: (>) ( brainfuck -- brainfuck )
-    [ 1 + ] change-pointer max-ops? ;
+: (<) ( brainfuck n -- brainfuck )
+    '[ _ - ] change-pointer ;
 
-: (<) ( brainfuck -- brainfuck ) 
-    [ 1 - ] change-pointer max-ops? ;
+: (#) ( brainfuck -- brainfuck )
+    dup
+    [ "ptr=" write pointer>> pprint ]
+    [ ",mem=" write memory>> pprint nl ] bi ;
 
-: compose-all ( seq -- quot ) 
+: compose-all ( seq -- quot )
     [ ] [ compose ] reduce ;
 
-EBNF: parse-brainfuck
+EBNF: parse-brainfuck [=[
 
-inc-ptr  = ">"  => [[ [ (>) ] ]]
-dec-ptr  = "<"  => [[ [ (<) ] ]]
-inc-mem  = "+"  => [[ [ (+) ] ]]
-dec-mem  = "-"  => [[ [ (-) ] ]]
+inc-ptr  = (">")+  => [[ length '[ _ (>) ] ]]
+dec-ptr  = ("<")+  => [[ length '[ _ (<) ] ]]
+inc-mem  = ("+")+  => [[ length '[ _ (+) ] ]]
+dec-mem  = ("-")+  => [[ length '[ _ (-) ] ]]
 output   = "."  => [[ [ (.) ] ]]
 input    = ","  => [[ [ (,) ] ]]
-space    = (" "|"\t"|"\r\n"|"\n") => [[ [ ] ]] 
+debug    = "#"  => [[ [ (#) ] ]]
+space    = [ \t\n\r]+ => [[ [ ] ]]
 unknown  = (.)  => [[ "Invalid input" throw ]]
 
-ops   = inc-ptr | dec-ptr | inc-mem | dec-mem | output | input | space
-loop  = "[" {loop|ops}* "]" => [[ second compose-all 1quotation [ [ (?) ] ] prepend [ while ] append ]]
+ops   = inc-ptr|dec-ptr|inc-mem|dec-mem|output|input|debug|space
+loop  = "[" {loop|ops}+ "]" => [[ second compose-all '[ [ get-memory zero? ] _ until ] ]]
 
 code  = (loop|ops|unknown)*  => [[ compose-all ]]
 
-;EBNF
+]=]
 
 PRIVATE>
 
-MACRO: run-brainfuck ( code -- )
-    [ <brainfuck> ] swap parse-brainfuck [ drop flush ] 3append ;
+MACRO: run-brainfuck ( code -- quot )
+    parse-brainfuck '[ <brainfuck> @ drop flush ] ;
+
+: get-brainfuck ( code -- result )
+    [ run-brainfuck ] with-string-writer ; inline
+
+<PRIVATE
+
+: (run-brainfuck) ( code -- )
+    [ <brainfuck> ] dip parse-brainfuck call( x -- x ) drop flush ;
+
+PRIVATE>
 
-: get-brainfuck ( code -- result ) 
-    [ run-brainfuck ] with-string-writer ; inline 
+: brainfuck-main ( -- )
+    command-line get [
+        read-contents (run-brainfuck)
+    ] [
+        [ binary file-contents (run-brainfuck) ] each
+    ] if-empty ;
 
+MAIN: brainfuck-main