Merge branch 'master' of git://factorcode.org/git/factor

db4
Doug Coleman 2008-04-06 21:07:38 -05:00
commit 7392bcbeed
9 changed files with 81 additions and 23 deletions

View File

@ -7,14 +7,15 @@ ARTICLE: "file-streams" "Reading and writing files"
{ $subsection <file-reader> } { $subsection <file-reader> }
{ $subsection <file-writer> } { $subsection <file-writer> }
{ $subsection <file-appender> } { $subsection <file-appender> }
"Reading and writing the entire contents of a file; this is only recommended for smaller files:"
{ $subsection file-contents }
{ $subsection set-file-contents }
{ $subsection file-lines }
{ $subsection set-file-lines }
"Utility combinators:" "Utility combinators:"
{ $subsection with-file-reader } { $subsection with-file-reader }
{ $subsection with-file-writer } { $subsection with-file-writer }
{ $subsection with-file-appender } { $subsection with-file-appender } ;
{ $subsection set-file-contents }
{ $subsection file-contents }
{ $subsection set-file-lines }
{ $subsection file-lines } ;
ARTICLE: "pathnames" "Pathname manipulation" ARTICLE: "pathnames" "Pathname manipulation"
"Pathname manipulation:" "Pathname manipulation:"

View File

@ -70,6 +70,9 @@ PREDICATE: method-body < word
M: method-body stack-effect M: method-body stack-effect
"multi-method" word-prop method-generic stack-effect ; "multi-method" word-prop method-generic stack-effect ;
M: method-body crossref?
drop t ;
: method-word-name ( classes generic -- string ) : method-word-name ( classes generic -- string )
[ [
word-name % word-name %

View File

@ -173,7 +173,7 @@ HELP: range-pattern
"of characters separated with a dash (-) represents the " "of characters separated with a dash (-) represents the "
"range of characters from the first to the second, inclusive." "range of characters from the first to the second, inclusive."
{ $examples { $examples
{ $example "USING: peg peg.parsers prettyprint ;" "\"a\" \"_a-zA-Z\" range-pattern parse parse-result-ast 1string ." "\"a\"" } { $example "USING: peg peg.parsers prettyprint strings ;" "\"a\" \"_a-zA-Z\" range-pattern parse parse-result-ast 1string ." "\"a\"" }
{ $example "USING: peg peg.parsers prettyprint ;" "\"0\" \"^0-9\" range-pattern parse ." "f" } { $example "USING: peg peg.parsers prettyprint ;\n\"0\" \"^0-9\" range-pattern parse ." "f" }
} }
} ; } ;

View File

@ -1,7 +1,7 @@
! Copyright (C) 2007, 2008 Chris Double, Doug Coleman. ! Copyright (C) 2007, 2008 Chris Double, Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel sequences strings namespaces math assocs shuffle USING: kernel sequences strings namespaces math assocs shuffle
vectors arrays combinators.lib math.parser match vectors arrays combinators.lib math.parser
unicode.categories sequences.deep peg peg.private unicode.categories sequences.deep peg peg.private
peg.search math.ranges words memoize ; peg.search math.ranges words memoize ;
IN: peg.parsers IN: peg.parsers

View File

@ -104,8 +104,8 @@ HELP: semantic
"Returns a parser that succeeds if the 'p1' parser succeeds and the quotation called with " "Returns a parser that succeeds if the 'p1' parser succeeds and the quotation called with "
"the AST produced by 'p1' on the stack returns true." } "the AST produced by 'p1' on the stack returns true." }
{ $examples { $examples
{ $example "\"A\" [ drop t ] satisfy [ 66 > ] semantic parse" "f" } { $example "USING: kernel math peg prettyprint ;" "\"A\" [ drop t ] satisfy [ 66 > ] semantic parse ." "f" }
{ $example "\"C\" [ drop t ] satisfy [ 66 > ] semantic parse parse-result-ast " "67" } { $example "USING: kernel math peg prettyprint ;" "\"C\" [ drop t ] satisfy [ 66 > ] semantic parse parse-result-ast ." "67" }
} ; } ;
HELP: ensure HELP: ensure

View File

@ -1,7 +1,7 @@
! Copyright (C) 2007, 2008 Chris Double. ! Copyright (C) 2007, 2008 Chris Double.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel sequences strings fry namespaces math assocs shuffle USING: kernel sequences strings fry namespaces math assocs shuffle
vectors arrays combinators.lib math.parser match vectors arrays combinators.lib math.parser
unicode.categories sequences.lib compiler.units parser unicode.categories sequences.lib compiler.units parser
words quotations effects memoize accessors locals effects splitting ; words quotations effects memoize accessors locals effects splitting ;
IN: peg IN: peg
@ -241,7 +241,7 @@ GENERIC: (compile) ( parser -- quot )
: compiled-parse ( state word -- result ) : compiled-parse ( state word -- result )
swap [ execute ] with-packrat ; inline swap [ execute ] with-packrat ; inline
: parse ( state parser -- result ) : parse ( input parser -- result )
dup word? [ compile ] unless compiled-parse ; dup word? [ compile ] unless compiled-parse ;
<PRIVATE <PRIVATE
@ -265,8 +265,6 @@ SYMBOL: id
TUPLE: token-parser symbol ; TUPLE: token-parser symbol ;
MATCH-VARS: ?token ;
: parse-token ( input string -- result ) : parse-token ( input string -- result )
#! Parse the string, returning a parse result #! Parse the string, returning a parse result
dup >r ?head-slice [ dup >r ?head-slice [
@ -388,9 +386,6 @@ M: optional-parser (compile) ( parser -- quot )
p1>> compiled-parser 1quotation '[ @ check-optional ] ; p1>> compiled-parser 1quotation '[ @ check-optional ] ;
TUPLE: semantic-parser p1 quot ; TUPLE: semantic-parser p1 quot ;
MATCH-VARS: ?quot ;
MATCH-VARS: ?parser ;
: check-semantic ( result quot -- result ) : check-semantic ( result quot -- result )
over [ over [
@ -421,8 +416,6 @@ M: ensure-not-parser (compile) ( parser -- quot )
TUPLE: action-parser p1 quot ; TUPLE: action-parser p1 quot ;
MATCH-VARS: ?action ;
: check-action ( result quot -- result ) : check-action ( result quot -- result )
over [ over [
over ast>> swap call >>ast over ast>> swap call >>ast

View File

@ -21,7 +21,7 @@ USING: kernel namespaces sequences combinators arrays threads
processing.gadget processing.gadget
processing.color ; processing.color ;
IN: bubble-chamber IN: processing.gallery.bubble-chamber
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@ -472,6 +472,6 @@ METHOD: move { axion }
; ;
: go ( -- ) [ bubble-chamber 500 sleep run ] with-ui ; : go ( -- ) [ bubble-chamber run ] with-ui ;
MAIN: go MAIN: go

View File

@ -0,0 +1,62 @@
USING: kernel arrays sequences math qualified circular processing ui ;
IN: processing.gallery.trails
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Example 33-15 from the Processing book
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
QUALIFIED: circular
: push-circular ( seq elt -- seq ) over circular:push-circular ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: each-percent ( seq quot -- )
>r
dup length
dup [ / ] curry
[ 1+ ] swap compose
r> compose
2each ; inline
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: point-list ( n -- seq ) [ drop 0 0 2array ] map <circular> ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: dot ( pos percent -- ) 1 swap - 25 * 5 max circle ;
: step ( seq -- )
no-stroke
{ 1 0.4 } fill
0 background
mouse push-circular
[ dot ]
each-percent ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: go* ( -- )
500 500 size*
[
100 point-list
[ step ]
curry
draw
] setup
run ;
: go ( -- ) [ go* ] with-ui ;
MAIN: go

View File

@ -26,8 +26,7 @@ M: pair make-disassemble-cmd
M: method-spec make-disassemble-cmd M: method-spec make-disassemble-cmd
first2 method make-disassemble-cmd ; first2 method make-disassemble-cmd ;
: gdb-binary ( -- string ) : gdb-binary ( -- string ) "gdb" ;
os freebsd? "gdb66" "gdb" ? ;
: run-gdb ( -- lines ) : run-gdb ( -- lines )
<process> <process>