Compile brainfuck a bit more stylishly.

extra/brainfuck/brainfuck.factor

@@ -1,64 +1,64 @@
 ! 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 sequences strings ;
+USING: accessors assocs fry io io.streams.string kernel macros math 
+peg.ebnf quotations sequences strings ;
 
 IN: brainfuck
 
 <PRIVATE
 
-TUPLE: brainfuck ptr mem ops ;
+TUPLE: brainfuck pointer memory ops ;
 
 : <brainfuck> ( -- brainfuck ) 
     0 H{ } clone 0 brainfuck boa ;
 
-: ops? ( brainfuck -- brainfuck ) 
-    [ 1 + ] change-ops
-    dup ops>> 10000 > [ "Max operations" throw ] when ;
+: max-ops? ( brainfuck -- brainfuck ) 
+    [ 1 + dup 10000 > [ "Max operations" throw ] when ] change-ops ;
 
-: (get-mem) ( brainfuck -- brainfuck value )
-    dup [ ptr>> ] [ mem>> ] bi at 0 or ;
+: get-memory ( brainfuck -- brainfuck value )
+    dup [ pointer>> ] [ memory>> ] bi at 0 or ;
 
-: (set-mem) ( brainfuck value -- brainfuck )
-    over [ ptr>> ] [ mem>> ] bi set-at ;
+: set-memory ( brainfuck value -- brainfuck )
+    over [ pointer>> ] [ memory>> ] bi set-at ;
 
-: mem++ ( brainfuck -- brainfuck )
-    (get-mem) 1 + 255 bitand (set-mem) ops? ;
+: (+) ( brainfuck -- brainfuck )
+    get-memory 1 + 255 bitand set-memory max-ops? ;
 
-: mem-- ( brainfuck -- brainfuck )
-    (get-mem) 1 - 255 bitand (set-mem) ops? ;
+: (-) ( brainfuck -- brainfuck )
+    get-memory 1 - 255 bitand set-memory max-ops? ;
 
-: mem? ( brainfuck -- brainfuck t/f )
-    ops? (get-mem) 0 = not ;
+: (?) ( brainfuck -- brainfuck t/f )
+    max-ops? get-memory 0 = not ;
 
-: out ( brainfuck -- brainfuck )
-    (get-mem) 1string write ops? ;
+: (.) ( brainfuck -- brainfuck )
+    get-memory 1string write max-ops? ;
 
-: in ( brainfuck -- brainfuck )
-    read1 (set-mem) ops? ;
+: (,) ( brainfuck -- brainfuck )
+    read1 set-memory max-ops? ;
 
-: ptr++ ( brainfuck -- brainfuck )
-    [ 1 + ] change-ptr ops? ;
+: (>) ( brainfuck -- brainfuck )
+    [ 1 + ] change-pointer max-ops? ;
 
-: ptr-- ( brainfuck -- brainfuck )
-    [ 1 - ] change-ptr ops? ;
+: (<) ( brainfuck -- brainfuck ) 
+    [ 1 - ] change-pointer max-ops? ;
 
 : compose-all ( seq -- quot ) 
     [ ] [ compose ] reduce ;
 
 EBNF: parse-brainfuck
 
-inc-ptr  = ">"  => [[ [ ptr++ ] ]]
-dec-ptr  = "<"  => [[ [ ptr-- ] ]]
-inc-mem  = "+"  => [[ [ mem++ ] ]]
-dec-mem  = "-"  => [[ [ mem-- ] ]]
-output   = "."  => [[ [ out ] ]]
-input    = ","  => [[ [ in ] ]]
+inc-ptr  = ">"  => [[ [ (>) ] ]]
+dec-ptr  = "<"  => [[ [ (<) ] ]]
+inc-mem  = "+"  => [[ [ (+) ] ]]
+dec-mem  = "-"  => [[ [ (-) ] ]]
+output   = "."  => [[ [ (.) ] ]]
+input    = ","  => [[ [ (,) ] ]]
 space    = (" "|"\t"|"\r\n"|"\n") => [[ [ ] ]] 
 unknown  = (.)  => [[ "Invalid input" throw ]]
 
 ops   = inc-ptr | dec-ptr | inc-mem | dec-mem | output | input | space
-loop  = "[" {loop|ops}* "]" => [[ second compose-all '[ [ mem? ] _ while ] ]]
+loop  = "[" {loop|ops}* "]" => [[ second compose-all 1quotation [ [ (?) ] ] prepend [ while ] append ]]
 
 code  = (loop|ops|unknown)*  => [[ compose-all ]]