[ t ] [ "[####monkey]" "monkey" "[%'#10s]" sprintf = ] unit-test
[ t ] [ "[many monke]" "many monkeys" "[%10.10s]" sprintf = ] unit-test
+[ t ] [ "{ 1, 2, 3 }" { 1 2 3 } "%[%s, %]" sprintf = ] unit-test
+[ t ] [ "{ 1:2, 3:4 }" H{ { 1 2 } { 3 4 } } "%[%s: %s %]" sprintf = ] unit-test
+
[ "%H:%M:%S" strftime ] must-infer
[ t ] [ "Thu Oct 09 12:03:15 2008" testtime "%c" strftime = ] unit-test
[ t ] [ "PM" testtime "%p" strftime = ] unit-test
+
--- /dev/null
+John Benediktsson
--- /dev/null
+! Copyright (C) 2009 John Benediktsson
+! See http://factorcode.org/license.txt for BSD license
+
+USING: help.syntax help.markup brainfuck strings ;
+
+IN: brainfuck
+
+HELP: run-brainfuck
+{ $values { "code" string } }
+{ $description
+ "A brainfuck program is a sequence of eight commands that are "
+ "executed sequentially. An instruction pointer begins at the first "
+ "command, and each command is executed until the program terminates "
+ "when the instruction pointer moves beyond the last command.\n"
+ "\n"
+ "The eight language commands, each consisting of a single character, "
+ "are the following:\n"
+ { $table
+ { "Character" "Meaning" }
+ { ">" "increment the data pointer (to point to the next cell to the right)." }
+ { "<" "decrement the data pointer (to point to the next cell to the left)." }
+ { "+" "increment (increase by one) the byte at the data pointer." }
+ { "-" "decrement (decrease by one) the byte at the data pointer." }
+ { "." "output the value of the byte at the data pointer." }
+ { "," "accept one byte of input, storing its value in the byte at the data pointer." }
+ { "[" "if the byte at the data pointer is zero, then instead of moving the instruction pointer forward to the next command, jump it forward to the command after the matching ] command*." }
+ { "]" "if the byte at the data pointer is nonzero, then instead of moving the instruction pointer forward to the next command, jump it back to the command after the matching [ command*." }
+ }
+ "\n"
+ "Brainfuck programs can be translated into C using the following "
+ "substitutions, assuming ptr is of type unsigned char* and has been "
+ "initialized to point to an array of zeroed bytes:\n"
+ { $table
+ { "Character" "C equivalent" }
+ { ">" "++ptr;" }
+ { "<" "--ptr;" }
+ { "+" "++*ptr;" }
+ { "-" "--*ptr;" }
+ { "." "putchar(*ptr);" }
+ { "," "*ptr=getchar();" }
+ { "[" "while (*ptr) {" }
+ { "]" "}" }
+ }
+} ;
+
+HELP: get-brainfuck
+{ $values { "code" string } { "result" string } }
+{ $description "Returns the output from a brainfuck program as a result string." }
+{ $see-also run-brainfuck } ;
--- /dev/null
+! Copyright (C) 2009 John Benediktsson
+! See http://factorcode.org/license.txt for BSD license
+
+USING: brainfuck io.streams.string multiline tools.test ;
+
+
+! Hello World!
+
+[ "Hello World!\n" ] [ <" ++++++++++[>+++++++>++++++++++>+++>+<<<<-]
+ >++.>+.+++++++..+++.>++.<<+++++++++++++++.>.+++.
+ ------.--------.>+.>. "> get-brainfuck ] unit-test
+
+! Addition (single-digit)
+
+[ "8" ] [ "35" [ ",>++++++[<-------->-],[<+>-]<."
+ get-brainfuck ] with-string-reader ] unit-test
+
+! Multiplication (single-digit)
+
+[ "8\0" ] [ "24" [ <" ,>,>++++++++[<------<------>>-]
+ <<[>[>+>+<<-]>>[<<+>>-]<<<-]
+ >>>++++++[<++++++++>-],<.>. ">
+ get-brainfuck ] with-string-reader ] unit-test
+
+! Division (single-digit, integer)
+
+[ "3" ] [ "62" [ <" ,>,>++++++[-<--------<-------->>]
+ <<[
+ >[->+>+<<]
+ >[-<<-
+ [>]>>>[<[>>>-<<<[-]]>>]<<]
+ >>>+
+ <<[-<<+>>]
+ <<<]
+ >[-]>>>>[-<<<<<+>>>>>]
+ <<<<++++++[-<++++++++>]<. ">
+ get-brainfuck ] with-string-reader ] unit-test
+
+! Uppercase
+
+[ "A" ] [ "a\n" [ ",----------[----------------------.,----------]"
+ get-brainfuck ] with-string-reader ] unit-test
+
+! cat
+
+[ "ABC" ] [ "ABC\0" [ ",[.,]" get-brainfuck ] with-string-reader ] unit-test
+
+
--- /dev/null
+! 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 ;
+
+
--- /dev/null
+Brainfuck programming language.
--- /dev/null
+#!/bin/bash
+
+# change directories to a factor module
+function cdfactor {
+ code=$(printf "USING: io io.pathnames vocabs vocabs.loader ; "
+ printf "\"%s\" <vocab> vocab-source-path (normalize-path) print" $1)
+ echo $code > $HOME/.cdfactor
+ fn=$(factor $HOME/.cdfactor)
+ dn=$(dirname $fn)
+ echo $dn
+ if [ -z "$dn" ]; then
+ echo "Warning: directory '$1' not found" 1>&2
+ else
+ cd $dn
+ fi
+}
+
+