diff --git a/extra/brainfuck/brainfuck.factor b/extra/brainfuck/brainfuck.factor index 4b4efd1ec3..6e7f158165 100644 --- a/extra/brainfuck/brainfuck.factor +++ b/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 ( -- 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 ]]