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

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

db4
Slava Pestov 2008-09-02 02:02:14 -05:00
parent 110a5e5162 4f08a2caf6
commit 362f7d1343
10 changed files with 131 additions and 70 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -5,10 +5,10 @@ math.order ;
IN: calendar
HELP: duration
{ $description "A duration is a period of time years, months, days, hours, minutes, and seconds. All duration slots can store " { $link real } " numbers. Compare two timestamps with the " { $link <=> } " word." } ;
{ $description "A duration is a period of time years, months, days, hours, minutes, and seconds. All duration slots can store " { $link real } " numbers. Compare two durations with the " { $link <=> } " word." } ;
HELP: timestamp
{ $description "A timestamp is a date and a time with a timezone offset. Timestamp slots must store integers except for " { $snippet "seconds" } ", which stores reals, and " { $snippet "gmt-offset" } ", which stores a " { $link duration } ". Compare two timestamps with the " { $link <=> } " word." } ;
{ $description "A timestamp is a date and a time with a timezone offset. Timestamp slots must store integers except for " { $snippet "seconds" } ", which stores reals, and " { $snippet "gmt-offset" } ", which stores a " { $link duration } ". Compare two duarionts with the " { $link <=> } " word." } ;
{ timestamp duration } related-words
@ -135,35 +135,37 @@ HELP: instant
HELP: years
{ $values { "x" number } { "duration" duration } }
{ $description } ;
{ $description "Creates a duration object with the specified number of years." } ;
HELP: months
{ $values { "x" number } { "duration" duration } }
{ $description } ;
{ $description "Creates a duration object with the specified number of months." } ;
HELP: days
{ $values { "x" number } { "duration" duration } }
{ $description } ;
{ $description "Creates a duration object with the specified number of days." } ;
HELP: weeks
{ $values { "x" number } { "duration" duration } }
{ $description } ;
{ $description "Creates a duration object with the specified number of weeks." } ;
HELP: hours
{ $values { "x" number } { "duration" duration } }
{ $description } ;
{ $description "Creates a duration object with the specified number of hours." } ;
HELP: minutes
{ $values { "x" number } { "duration" duration } }
{ $description } ;
{ $description "Creates a duration object with the specified number of minutes." } ;
HELP: seconds
{ $values { "x" number } { "duration" duration } }
{ $description } ;
{ $description "Creates a duration object with the specified number of seconds." } ;
HELP: milliseconds
{ $values { "x" number } { "duration" duration } }
{ $description } ;
{ $description "Creates a duration object with the specified number of milliseconds." } ;
{ years months days hours minutes seconds milliseconds } related-words
HELP: leap-year?
{ $values { "obj" object } { "?" "a boolean" } }
@ -193,75 +195,75 @@ HELP: time+
}
} ;
HELP: dt>years
HELP: duration>years
{ $values { "duration" duration } { "x" number } }
{ $description "Calculates the length of a duration in years." }
{ $examples
{ $example "USING: calendar prettyprint ;"
"6 months dt>years ."
"6 months duration>years ."
"1/2"
}
} ;
HELP: dt>months
HELP: duration>months
{ $values { "duration" duration } { "x" number } }
{ $description "Calculates the length of a duration in months." }
{ $examples
{ $example "USING: calendar prettyprint ;"
"30 days dt>months ."
"30 days duration>months ."
"16000/16233"
}
} ;
HELP: dt>days
HELP: duration>days
{ $values { "duration" duration } { "x" number } }
{ $description "Calculates the length of a duration in days." }
{ $examples
{ $example "USING: calendar prettyprint ;"
"6 hours dt>days ."
"6 hours duration>days ."
"1/4"
}
} ;
HELP: dt>hours
HELP: duration>hours
{ $values { "duration" duration } { "x" number } }
{ $description "Calculates the length of a duration in hours." }
{ $examples
{ $example "USING: calendar prettyprint ;"
"3/4 days dt>hours ."
"3/4 days duration>hours ."
"18"
}
} ;
HELP: dt>minutes
HELP: duration>minutes
{ $values { "duration" duration } { "x" number } }
{ $description "Calculates the length of a duration in minutes." }
{ $examples
{ $example "USING: calendar prettyprint ;"
"6 hours dt>minutes ."
"6 hours duration>minutes ."
"360"
}
} ;
HELP: dt>seconds
HELP: duration>seconds
{ $values { "duration" duration } { "x" number } }
{ $description "Calculates the length of a duration in seconds." }
{ $examples
{ $example "USING: calendar prettyprint ;"
"6 minutes dt>seconds ."
"6 minutes duration>seconds ."
"360"
}
} ;
HELP: dt>milliseconds
HELP: duration>milliseconds
{ $values { "duration" duration } { "x" number } }
{ $description "Calculates the length of a duration in milliseconds." }
{ $examples
{ $example "USING: calendar prettyprint ;"
"6 seconds dt>milliseconds ."
"6 seconds duration>milliseconds ."
"6000"
}
} ;
{ dt>years dt>months dt>days dt>hours dt>minutes dt>seconds dt>milliseconds } related-words
{ duration>years duration>months duration>days duration>hours duration>minutes duration>seconds duration>milliseconds } related-words
HELP: time-
@ -491,3 +493,59 @@ HELP: beginning-of-year
HELP: time-since-midnight
{ $values { "timestamp" timestamp } { "duration" duration } }
{ $description "Calculates a " { $snippet "duration" } " that represents the elapsed time since midnight of the input " { $snippet "timestamp" } "." } ;
ARTICLE: "calendar" "Calendar"
"The two data types used throughout the calendar library:"
{ $subsection timestamp }
{ $subsection duration }
"Durations represent spans of time:"
{ $subsection "using-durations" }
"Arithmetic on timestamps and durations:"
{ $subsection time+ }
{ $subsection time- }
{ $subsection time* }
"Getting the current timestamp:"
{ $subsection now }
{ $subsection gmt }
"Converting between timestamps:"
{ $subsection >local-time }
{ $subsection >gmt }
"Timestamps relative to each other:"
{ $subsection "relative-timestamps" }
;
ARTICLE: "using-durations" "Using durations"
"Creating a duration object:"
{ $subsection years }
{ $subsection months }
{ $subsection weeks }
{ $subsection days }
{ $subsection hours }
{ $subsection minutes }
{ $subsection seconds }
{ $subsection milliseconds }
"Converting a duration to a number:"
{ $subsection duration>years }
{ $subsection duration>months }
{ $subsection duration>days }
{ $subsection duration>hours }
{ $subsection duration>minutes }
{ $subsection duration>seconds }
{ $subsection duration>milliseconds } ;
ARTICLE: "relative-timestamps" "Relative timestamps"
"Getting a relative timestamp:"
{ $subsection hence }
{ $subsection ago }
{ $subsection before }
"Days of the week relative to " { $link now } ":"
{ $subsection sunday }
{ $subsection monday }
{ $subsection tuesday }
{ $subsection wednesday }
{ $subsection thursday }
{ $subsection friday }
{ $subsection saturday }
;
ABOUT: "calendar"

16
basis/calendar/calendar.factor
View File

@ -240,7 +240,7 @@ M: duration time+
2drop <duration>
] if ;
: dt>years ( duration -- x )
: duration>years ( duration -- x )
#! Uses average month/year length since duration loses calendar
#! data
0 swap
@ -253,14 +253,14 @@ M: duration time+
[ second>> seconds-per-year / + ]
} cleave ;
M: duration <=> [ dt>years ] compare ;
M: duration <=> [ duration>years ] compare ;
: dt>months ( duration -- x ) dt>years months-per-year * ;
: dt>days ( duration -- x ) dt>years days-per-year * ;
: dt>hours ( duration -- x ) dt>years hours-per-year * ;
: dt>minutes ( duration -- x ) dt>years minutes-per-year * ;
: dt>seconds ( duration -- x ) dt>years seconds-per-year * ;
: dt>milliseconds ( duration -- x ) dt>seconds 1000 * ;
: duration>months ( duration -- x ) duration>years months-per-year * ;
: duration>days ( duration -- x ) duration>years days-per-year * ;
: duration>hours ( duration -- x ) duration>years hours-per-year * ;
: 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 * ;
GENERIC: time- ( time1 time2 -- time3 )

10
basis/calendar/format/format-tests.factor
View File

@ -3,23 +3,23 @@ io.streams.string accessors io math.order ;
IN: calendar.format.tests
[ 0 ] [
"Z" [ read1 read-rfc3339-gmt-offset ] with-string-reader dt>hours
"Z" [ read1 read-rfc3339-gmt-offset ] with-string-reader duration>hours
] unit-test
[ 1 ] [
"+01" [ read1 read-rfc3339-gmt-offset ] with-string-reader dt>hours
"+01" [ read1 read-rfc3339-gmt-offset ] with-string-reader duration>hours
] unit-test
[ -1 ] [
"-01" [ read1 read-rfc3339-gmt-offset ] with-string-reader dt>hours
"-01" [ read1 read-rfc3339-gmt-offset ] with-string-reader duration>hours
] unit-test
[ -1-1/2 ] [
"-01:30" [ read1 read-rfc3339-gmt-offset ] with-string-reader dt>hours
"-01:30" [ read1 read-rfc3339-gmt-offset ] with-string-reader duration>hours
] unit-test
[ 1+1/2 ] [
"+01:30" [ read1 read-rfc3339-gmt-offset ] with-string-reader dt>hours
"+01:30" [ read1 read-rfc3339-gmt-offset ] with-string-reader duration>hours
] unit-test
[ ] [ now timestamp>rfc3339 drop ] unit-test

14
basis/cpu/ppc/architecture/architecture.factor
View File

@ -18,13 +18,13 @@ IN: cpu.ppc.architecture
: ds-reg 14 ; inline
: rs-reg 15 ; inline
: reserved-area-size
: reserved-area-size ( -- n )
os {
{ linux [ 2 ] }
{ macosx [ 6 ] }
} case cells ; foldable
: lr-save
: lr-save ( -- n )
os {
{ linux [ 1 ] }
{ macosx [ 2 ] }
@ -32,12 +32,12 @@ IN: cpu.ppc.architecture
: param@ ( n -- x ) reserved-area-size + ; inline
: param-save-size 8 cells ; foldable
: param-save-size ( -- n ) 8 cells ; foldable
: local@ ( n -- x )
reserved-area-size param-save-size + + ; inline
: factor-area-size 2 cells ;
: factor-area-size ( -- n ) 2 cells ; foldable
: next-save ( n -- i ) cell - ;
@ -96,9 +96,9 @@ M: ppc %epilogue ( n -- )
1 1 rot ADDI
0 MTLR ;
: (%call) 11 MTLR BLRL ;
: (%call) ( -- ) 11 MTLR BLRL ;
: (%jump) 11 MTCTR BCTR ;
: (%jump) ( -- ) 11 MTCTR BCTR ;
: %load-dlsym ( symbol dll register -- )
0 swap LOAD32 rc-absolute-ppc-2/2 rel-dlsym ;
@ -218,7 +218,7 @@ M: ppc %box-long-long ( n func -- )
4 1 rot cell + local@ LWZ
] when* r> f %alien-invoke ;
: temp@ stack-frame* factor-area-size - swap - ;
: temp@ ( m -- n ) stack-frame* factor-area-size - swap - ;
: struct-return@ ( size n -- n ) [ local@ ] [ temp@ ] ?if ;

10
basis/cpu/ppc/intrinsics/intrinsics.factor
View File

@ -11,17 +11,17 @@ math.floats.private classes slots.private combinators
compiler.constants ;
IN: cpu.ppc.intrinsics
: %slot-literal-known-tag
: %slot-literal-known-tag ( -- out value offset )
"val" operand
"obj" operand
"n" get cells
"obj" get operand-tag - ;
: %slot-literal-any-tag
: %slot-literal-any-tag ( -- out value offset )
"obj" operand "scratch1" operand %untag
"val" operand "scratch1" operand "n" get cells ;
: %slot-any
: %slot-any ( -- out value offset )
"obj" operand "scratch1" operand %untag
"offset" operand "n" operand 1 SRAWI
"scratch1" operand "val" operand "offset" operand ;
@ -188,7 +188,7 @@ IN: cpu.ppc.intrinsics
}
} define-intrinsics
: generate-fixnum-mod
: generate-fixnum-mod ( -- )
#! PowerPC doesn't have a MOD instruction; so we compute
#! x-(x/y)*y. Puts the result in "s" operand.
"s" operand "r" operand "y" operand MULLW
@ -259,7 +259,7 @@ IN: cpu.ppc.intrinsics
\ fixnum+ \ ADD \ ADDO. overflow-template
\ fixnum- \ SUBF \ SUBFO. overflow-template
: generate-fixnum/i
: generate-fixnum/i ( -- )
#! This VOP is funny. If there is an overflow, it falls
#! through to the end, and the result is in "x" operand.
#! Otherwise it jumps to the "no-overflow" label and the

34
basis/ui/windows/windows.factor
View File

@ -208,7 +208,7 @@ SYMBOLS: msg-obj class-name-ptr mouse-captured ;
hWnd window-focus send-gesture drop ;
:: set-window-active ( hwnd uMsg wParam lParam ? -- n )
? hwnd window set-world-active?
? hwnd window (>>active?)
hwnd uMsg wParam lParam DefWindowProc ;
: handle-wm-syscommand ( hWnd uMsg wParam lParam -- n )
@ -221,14 +221,14 @@ SYMBOLS: msg-obj class-name-ptr mouse-captured ;
} cond ;
: cleanup-window ( handle -- )
dup win-title [ free ] when*
dup win-hRC wglDeleteContext win32-error=0/f
dup win-hWnd swap win-hDC ReleaseDC win32-error=0/f ;
dup title>> [ free ] when*
dup hRC>> wglDeleteContext win32-error=0/f
dup hWnd>> swap hDC>> ReleaseDC win32-error=0/f ;
M: windows-ui-backend (close-window)
dup win-hWnd unregister-window
dup hWnd>> unregister-window
dup cleanup-window
win-hWnd DestroyWindow win32-error=0/f ;
hWnd>> DestroyWindow win32-error=0/f ;
: handle-wm-close ( hWnd uMsg wParam lParam -- )
3drop window ungraft ;
@ -472,28 +472,28 @@ M: windows-ui-backend do-events
M: windows-ui-backend (open-window) ( world -- )
[ create-window dup setup-gl ] keep
[ f <win> ] keep
[ swap win-hWnd register-window ] 2keep
dupd set-world-handle
win-hWnd show-window ;
[ swap hWnd>> register-window ] 2keep
dupd (>>handle)
hWnd>> show-window ;
M: windows-ui-backend select-gl-context ( handle -- )
[ win-hDC ] keep win-hRC wglMakeCurrent win32-error=0/f ;
[ hDC>> ] keep hRC>> wglMakeCurrent win32-error=0/f ;
M: windows-ui-backend flush-gl-context ( handle -- )
win-hDC SwapBuffers win32-error=0/f ;
hDC>> SwapBuffers win32-error=0/f ;
! Move window to front
M: windows-ui-backend raise-window* ( world -- )
world-handle [
win-hWnd SetFocus drop
handle>> [
hWnd>> SetFocus drop
] when* ;
M: windows-ui-backend set-title ( string world -- )
world-handle
dup win-title [ free ] when*
handle>>
dup title>> [ free ] when*
>r utf16n malloc-string r>
2dup set-win-title
win-hWnd WM_SETTEXT 0 roll alien-address SendMessage drop ;
2dup (>>title)
hWnd>> WM_SETTEXT 0 roll alien-address SendMessage drop ;
M: windows-ui-backend ui
[

2
basis/xml/tests/test.factor
View File

@ -21,7 +21,7 @@ SYMBOL: xml-file
[ t ] [ xml-file get children>> second contained-tag? ] unit-test
[ "<a></b>" string>xml ] [ xml-parse-error? ] must-fail-with
[ T{ comment f "This is where the fun begins!" } ] [
xml-file get xml-before [ comment? ] find nip
xml-file get before>> [ comment? ] find nip
] unit-test
[ "xsl stylesheet=\"that-one.xsl\"" ] [
xml-file get after>> [ instruction? ] find nip text>>

3
basis/xml/writer/writer.factor
View File

@ -110,6 +110,9 @@ M: instruction write-item
[ after>> write-chunk ]
} cleave ;
M: xml write-item
body>> write-item ;
: print-xml ( xml -- )
write-xml nl ;

2
extra/animations/animations.factor
View File

@ -11,7 +11,7 @@ SYMBOL: sleep-period
! : my-progress ( -- progress ) millis
: progress ( -- progress ) millis last-loop get - reset-progress ;
: progress-peek ( -- progress ) millis last-loop get - ;
: set-end ( duration -- end-time ) dt>milliseconds millis + ;
: set-end ( duration -- end-time ) duration>milliseconds millis + ;
: loop ( quot end -- ) dup millis > [ [ dup call ] dip loop ] [ 2drop ] if ; inline
: animate ( quot duration -- ) reset-progress set-end loop ; inline
: sample ( revs quot -- avg ) reset-progress dupd times progress swap / ; inline

2
extra/http/http.factor
View File

@ -106,7 +106,7 @@ TUPLE: cookie name value version comment path domain expires max-age http-only s
[
{
{ [ dup timestamp? ] [ timestamp>cookie-string ] }
{ [ dup duration? ] [ dt>seconds number>string ] }
{ [ dup duration? ] [ duration>seconds number>string ] }
{ [ dup real? ] [ number>string ] }
[ ]
} cond