steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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

db4
John Benediktsson 2008-10-05 16:19:43 -07:00
parent df646074bd ccdcacfd04
commit 476f0abd61
10 changed files with 74 additions and 69 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
basis/calendar/calendar-docs.factor
View File

@ -165,7 +165,15 @@ HELP: milliseconds
{ $values { "x" number } { "duration" duration } }
{ $description "Creates a duration object with the specified number of milliseconds." } ;
{ years months days hours minutes seconds milliseconds } related-words
HELP: microseconds
{ $values { "x" number } { "duration" duration } }
{ $description "Creates a duration object with the specified number of microseconds." } ;
HELP: nanoseconds
{ $values { "x" number } { "duration" duration } }
{ $description "Creates a duration object with the specified number of nanoseconds." } ;
{ years months days hours minutes seconds milliseconds microseconds nanoseconds } related-words
HELP: leap-year?
{ $values { "obj" object } { "?" "a boolean" } }
@ -263,7 +271,27 @@ HELP: duration>milliseconds
}
} ;
{ duration>years duration>months duration>days duration>hours duration>minutes duration>seconds duration>milliseconds } related-words
HELP: duration>microseconds
{ $values { "duration" duration } { "x" number } }
{ $description "Calculates the length of a duration in microseconds." }
{ $examples
{ $example "USING: calendar prettyprint ;"
"6 seconds duration>microseconds ."
"6000000"
}
} ;
HELP: duration>nanoseconds
{ $values { "duration" duration } { "x" number } }
{ $description "Calculates the length of a duration in nanoseconds." }
{ $examples
{ $example "USING: calendar prettyprint ;"
"6 seconds duration>nanoseconds ."
"6000000000"
}
} ;
{ duration>years duration>months duration>days duration>hours duration>minutes duration>seconds duration>milliseconds duration>microseconds duration>nanoseconds } related-words
HELP: time-
@ -528,6 +556,8 @@ ARTICLE: "using-durations" "Using durations"
{ $subsection minutes }
{ $subsection seconds }
{ $subsection milliseconds }
{ $subsection microseconds }
{ $subsection nanoseconds }
{ $subsection instant }
"Converting a duration to a number:"
{ $subsection duration>years }
@ -536,7 +566,9 @@ ARTICLE: "using-durations" "Using durations"
{ $subsection duration>hours }
{ $subsection duration>minutes }
{ $subsection duration>seconds }
{ $subsection duration>milliseconds } ;
{ $subsection duration>milliseconds }
{ $subsection duration>microseconds }
{ $subsection duration>nanoseconds } ;
ARTICLE: "relative-timestamps" "Relative timestamps"
"In the future:"

10
basis/calendar/calendar.factor
View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: arrays kernel math math.functions namespaces sequences
strings system vocabs.loader threads accessors combinators
locals classes.tuple math.order summary
locals classes.tuple math.order summary structs
combinators.short-circuit ;
IN: calendar
@ -129,6 +129,8 @@ PRIVATE>
: minutes ( x -- duration ) instant clone swap >>minute ;
: seconds ( x -- duration ) instant clone swap >>second ;
: milliseconds ( x -- duration ) 1000 / seconds ;
: microseconds ( x -- duration ) 1000000 / seconds ;
: nanoseconds ( x -- duration ) 1000000000 / seconds ;
GENERIC: leap-year? ( obj -- ? )
@ -261,6 +263,8 @@ M: duration <=> [ duration>years ] compare ;
: duration>minutes ( duration -- x ) duration>years minutes-per-year * ;
: duration>seconds ( duration -- x ) duration>years seconds-per-year * ;
: duration>milliseconds ( duration -- x ) duration>seconds 1000 * ;
: duration>microseconds ( duration -- x ) duration>seconds 1000000 * ;
: duration>nanoseconds ( duration -- x ) duration>seconds 1000000000 * ;
GENERIC: time- ( time1 time2 -- time3 )
@ -398,6 +402,10 @@ PRIVATE>
: time-since-midnight ( timestamp -- duration )
dup midnight time- ;
: timeval>unix-time ( timeval -- timestamp )
[ timeval-sec seconds ] [ timeval-usec microseconds ] bi
time+ unix-1970 time+ >local-time ;
M: timestamp sleep-until timestamp>millis sleep-until ;
M: duration sleep hence sleep-until ;

10
basis/math/intervals/intervals-tests.factor
View File

@ -334,13 +334,3 @@ IN: math.intervals.tests
[ execute ] [ swapd execute ] 3bi =
] all?
] unit-test
[ t ] [ 1.0 1.0 epsilon + [a,b] random float? ] unit-test
[ t ] [ 1.0 1.0 epsilon + [a,b) random float? ] unit-test
[ t ] [ 1.0 1.0 epsilon + (a,b] random float? ] unit-test
[ 1.0 1.0 (a,b) random float? ] must-fail
[ 3 4 + (a,b) random ] must-fail
[ 3 ] [ 3 4 [a,b) random ] unit-test
[ 4 ] [ 3 4 (a,b] random ] unit-test
[ t ] [ 3 4 [a,b] random { 3 4 } member? ] unit-test

37
basis/math/intervals/intervals.factor
View File

@ -2,8 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
! Based on Slate's src/unfinished/interval.slate by Brian Rice.
USING: accessors kernel sequences arrays math math.order
combinators generic random math.constants qualified ;
FROM: math.ranges => <range> ;
combinators generic ;
IN: math.intervals
SYMBOL: empty-interval
@ -397,37 +396,3 @@ SYMBOL: incomparable
[ to>> first2 [ 1- ] unless ]
bi [a,b]
] unless ;
<PRIVATE
: open-left? ( interval -- ? ) from>> second not ;
: open-right? ( interval -- ? ) to>> second not ;
: integral-interval? ( interval -- ? )
[ from>> ] [ to>> ] bi [ first integer? ] both? ;
PRIVATE>
ERROR: empty-random-interval ;
: random-interval-integer ( interval -- n )
[ [ to>> first ] [ open-right? [ 1- ] when ] bi ]
[
[ from>> first ]
[ open-left? [ 1+ ] when ] bi
tuck - 1+ random +
] bi ;
: random-interval-float ( interval -- x )
[ [ from>> first ] [ open-left? [ epsilon + ] when ] bi ]
[ [ to>> first ] [ open-right? [ epsilon - ] when ] bi ] bi
epsilon <range> random [ empty-random-interval ] unless* ;
M: interval random ( interval -- x )
dup empty-interval = [ empty-random-interval ] when
dup integral-interval? [
random-interval-integer
] [
random-interval-float
] if ;

19
basis/random/random-docs.factor
View File

@ -16,8 +16,21 @@ HELP: random-bytes*
HELP: random
{ $values { "obj" object } { "elt" "a random element" } }
{ $description "Outputs a random element of the input object. If the object is an integer, an input of zero always returns a zero, a negative integer throws an error, and positive integers yield a random integer in the interval " { $snippet "[0,n)" } ". On a sequence, an empty sequence always outputs " { $link f } " while any other sequence outputs a random element." }
{ $notes "Since integers are sequences, passing an integer " { $snippet "n" } " yields a random integer in the interval " { $snippet "[0,n)" } "." } ;
{ $description "Outputs a random element of the input object. If the object is an integer, an input of zero always returns a zero, while any other integer integers yield a random integer in the interval between itself and zero, inclusive of zero. On a sequence, an empty sequence always outputs " { $link f } "." }
{ $examples
{ $unchecked-example "USING: random prettyprint ;"
"10 random ."
"3" }
{ $example "USING: random prettyprint ;"
"0 random ."
"0" }
{ $unchecked-example "USING: random prettyprint ;"
"-10 random ."
"-8" }
{ $unchecked-example "USING: random prettyprint ;"
"{ \"a\" \"b\" \"c\" } random ."
"\"a\"" }
} ;
HELP: random-bytes
{ $values { "n" "an integer" } { "byte-array" "a random integer" } }
@ -51,7 +64,7 @@ HELP: delete-random
{ $values
{ "seq" sequence }
{ "elt" object } }
{ $description "Delete a random number from a sequence using " { $link delete-nth } " and returns the deleted object." } ;
{ $description "Deletes a random number from a sequence using " { $link delete-nth } " and returns the deleted object." } ;
ARTICLE: "random-protocol" "Random protocol"
"A random number generator must implement one of these two words:"

4
basis/random/random-tests.factor
View File

@ -1,5 +1,5 @@
USING: random sequences tools.test kernel math math.functions
sets math.constants ;
sets ;
IN: random.tests
[ 4 ] [ 4 random-bytes length ] unit-test
@ -16,6 +16,4 @@ IN: random.tests
[ t ] [ 1000 [ 400 random ] replicate prune length 256 > ] unit-test
[ t ] [ pi random float? ] unit-test
[ 0 ] [ 0 random ] unit-test

5
basis/random/random.factor
View File

@ -55,13 +55,10 @@ ERROR: negative-random n ;
M: integer random ( integer -- integer' )
{
{ [ dup 0 = ] [ ] }
{ [ dup 0 < ] [ negative-random ] }
{ [ dup 0 < ] [ neg random-integer neg ] }
[ random-integer ]
} cond ;
M: float random ( float -- elt )
64 random-bits 64 2^ 1- / * ;
: delete-random ( seq -- elt )
[ length random-integer ] keep [ nth ] 2keep delete-nth ;

2
basis/unix/linux/linux.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2005, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
IN: unix
USING: alien.syntax ;
IN: unix
! Linux.

16
basis/unix/unix.factor
View File

@ -1,12 +1,10 @@
! Copyright (C) 2005, 2007 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types alien.syntax kernel libc structs sequences
continuations byte-arrays strings
math namespaces system combinators vocabs.loader qualified
accessors stack-checker macros locals generalizations
unix.types debugger io prettyprint ;
USING: alien alien.c-types alien.syntax kernel libc structs
sequences continuations byte-arrays strings math namespaces
system combinators vocabs.loader qualified accessors
stack-checker macros locals generalizations unix.types
debugger io prettyprint ;
IN: unix
TYPEDEF: uint in_addr_t
@ -109,8 +107,12 @@ FUNCTION: uid_t geteuid ;
FUNCTION: gid_t getgid ;
FUNCTION: int getgrgid_r ( gid_t gid, group* grp, char* buffer, size_t bufsize, group** result ) ;
FUNCTION: int getgrnam_r ( char* name, group* grp, char* buffer, size_t bufsize, group** result ) ;
FUNCTION: passwd* getpwent ( ) ;
FUNCTION: int getpwnam_r ( char* login, passwd* pwd, char* buffer, size_t bufsize, passwd** result ) ;
FUNCTION: int getgroups ( int gidsetlen, gid_t* gidset ) ;
FUNCTION: int getgrouplist ( char* name, int basegid, int* groups, int* ngroups ) ;
FUNCTION: group* getgrent ;
FUNCTION: int gethostname ( char* name, int len ) ;
FUNCTION: int getsockname ( int socket, sockaddr* address, socklen_t* address_len ) ;
FUNCTION: int getpeername ( int socket, sockaddr* address, socklen_t* address_len ) ;

2
basis/urls/urls-docs.factor
View File

@ -139,7 +139,7 @@ HELP: relative-url?
{ $values
{ "url" url }
{ "?" "a boolean" } }
{ $description "Tests whether a given URL is relative to a domain." } ;
{ $description "Tests whether a URL is relative." } ;
HELP: secure-protocol?
{ $values { "protocol" string } { "?" "a boolean" } }