Merge branch 'master' of git://github.com/mrjbq7/factor
commit
2b61f6c7ca
|
@ -77,6 +77,9 @@ IN: formatting.tests
|
||||||
[ t ] [ "[####monkey]" "monkey" "[%'#10s]" sprintf = ] unit-test
|
[ t ] [ "[####monkey]" "monkey" "[%'#10s]" sprintf = ] unit-test
|
||||||
[ t ] [ "[many monke]" "many monkeys" "[%10.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
|
[ "%H:%M:%S" strftime ] must-infer
|
||||||
|
|
||||||
|
@ -95,3 +98,4 @@ IN: formatting.tests
|
||||||
[ t ] [ "Thu Oct 09 12:03:15 2008" testtime "%c" strftime = ] unit-test
|
[ t ] [ "Thu Oct 09 12:03:15 2008" testtime "%c" strftime = ] unit-test
|
||||||
[ t ] [ "PM" testtime "%p" strftime = ] unit-test
|
[ t ] [ "PM" testtime "%p" strftime = ] unit-test
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -0,0 +1 @@
|
||||||
|
John Benediktsson
|
|
@ -0,0 +1,49 @@
|
||||||
|
! 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 } ;
|
|
@ -0,0 +1,62 @@
|
||||||
|
! Copyright (C) 2009 John Benediktsson
|
||||||
|
! See http://factorcode.org/license.txt for BSD license
|
||||||
|
|
||||||
|
USING: brainfuck kernel io.streams.string math math.parser math.ranges
|
||||||
|
multiline quotations sequences tools.test ;
|
||||||
|
|
||||||
|
|
||||||
|
[ "+" run-brainfuck ] must-infer
|
||||||
|
[ "+" get-brainfuck ] must-infer
|
||||||
|
|
||||||
|
! 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
|
||||||
|
|
||||||
|
! Squares of numbers from 0 to 100
|
||||||
|
|
||||||
|
100 [0,b] [ dup * number>string ] map "\n" join "\n" append 1quotation
|
||||||
|
[ <" ++++[>+++++<-]>[<+++++>-]+<+[
|
||||||
|
>[>+>+<<-]++>>[<<+>>-]>>>[-]++>[-]+
|
||||||
|
>>>+[[-]++++++>>>]<<<[[<++++++++<++>>-]+<.<[>----<-]<]
|
||||||
|
<<[>>>>>[>>>[-]+++++++++<[>-<-]+++++++++>
|
||||||
|
[-[<->-]+[<<<]]<[>+<-]>]<<-]<<-] ">
|
||||||
|
get-brainfuck ] unit-test
|
||||||
|
|
||||||
|
|
|
@ -0,0 +1,77 @@
|
||||||
|
! 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 prettyprint quotations sequences strings ;
|
||||||
|
|
||||||
|
IN: brainfuck
|
||||||
|
|
||||||
|
<PRIVATE
|
||||||
|
|
||||||
|
TUPLE: brainfuck pointer memory ;
|
||||||
|
|
||||||
|
: <brainfuck> ( -- brainfuck )
|
||||||
|
0 H{ } clone brainfuck boa ;
|
||||||
|
|
||||||
|
: get-memory ( brainfuck -- brainfuck value )
|
||||||
|
dup [ pointer>> ] [ memory>> ] bi at 0 or ;
|
||||||
|
|
||||||
|
: set-memory ( brainfuck value -- brainfuck )
|
||||||
|
over [ pointer>> ] [ memory>> ] bi set-at ;
|
||||||
|
|
||||||
|
: (+) ( brainfuck n -- brainfuck )
|
||||||
|
[ get-memory ] dip + 255 bitand set-memory ;
|
||||||
|
|
||||||
|
: (-) ( brainfuck n -- brainfuck )
|
||||||
|
[ get-memory ] dip - 255 bitand set-memory ;
|
||||||
|
|
||||||
|
: (?) ( brainfuck -- brainfuck t/f )
|
||||||
|
get-memory 0 = not ;
|
||||||
|
|
||||||
|
: (.) ( brainfuck -- brainfuck )
|
||||||
|
get-memory 1string write ;
|
||||||
|
|
||||||
|
: (,) ( brainfuck -- brainfuck )
|
||||||
|
read1 set-memory ;
|
||||||
|
|
||||||
|
: (>) ( brainfuck n -- brainfuck )
|
||||||
|
[ dup pointer>> ] dip + >>pointer ;
|
||||||
|
|
||||||
|
: (<) ( brainfuck n -- brainfuck )
|
||||||
|
[ dup pointer>> ] dip - >>pointer ;
|
||||||
|
|
||||||
|
: (#) ( brainfuck -- brainfuck )
|
||||||
|
dup
|
||||||
|
[ "ptr=" write pointer>> pprint ]
|
||||||
|
[ ",mem=" write memory>> pprint nl ] bi ;
|
||||||
|
|
||||||
|
: compose-all ( seq -- quot )
|
||||||
|
[ ] [ compose ] reduce ;
|
||||||
|
|
||||||
|
EBNF: parse-brainfuck
|
||||||
|
|
||||||
|
inc-ptr = (">")+ => [[ length 1quotation [ (>) ] append ]]
|
||||||
|
dec-ptr = ("<")+ => [[ length 1quotation [ (<) ] append ]]
|
||||||
|
inc-mem = ("+")+ => [[ length 1quotation [ (+) ] append ]]
|
||||||
|
dec-mem = ("-")+ => [[ length 1quotation [ (-) ] append ]]
|
||||||
|
output = "." => [[ [ (.) ] ]]
|
||||||
|
input = "," => [[ [ (,) ] ]]
|
||||||
|
debug = "#" => [[ [ (#) ] ]]
|
||||||
|
space = (" "|"\t"|"\r\n"|"\n")+ => [[ [ ] ]]
|
||||||
|
unknown = (.) => [[ "Invalid input" throw ]]
|
||||||
|
|
||||||
|
ops = inc-ptr|dec-ptr|inc-mem|dec-mem|output|input|debug|space
|
||||||
|
loop = "[" {loop|ops}+ "]" => [[ second compose-all 1quotation [ [ (?) ] ] prepend [ while ] append ]]
|
||||||
|
|
||||||
|
code = (loop|ops|unknown)* => [[ compose-all ]]
|
||||||
|
|
||||||
|
;EBNF
|
||||||
|
|
||||||
|
PRIVATE>
|
||||||
|
|
||||||
|
MACRO: run-brainfuck ( code -- )
|
||||||
|
[ <brainfuck> ] swap parse-brainfuck [ drop flush ] 3append ;
|
||||||
|
|
||||||
|
: get-brainfuck ( code -- result )
|
||||||
|
[ run-brainfuck ] with-string-writer ; inline
|
||||||
|
|
|
@ -0,0 +1 @@
|
||||||
|
Brainfuck programming language.
|
|
@ -0,0 +1,18 @@
|
||||||
|
#!/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
|
||||||
|
}
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue