diff --git a/basis/alarms/alarms.factor b/basis/alarms/alarms.factor index a72960f20f..cbbebde579 100755 --- a/basis/alarms/alarms.factor +++ b/basis/alarms/alarms.factor @@ -1,11 +1,15 @@ ! Copyright (C) 2005, 2008 Slava Pestov, Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: arrays calendar combinators generic init kernel math -namespaces sequences heaps boxes threads debugger quotations -assocs math.order ; +USING: accessors arrays calendar combinators generic init +kernel math namespaces sequences heaps boxes threads debugger +quotations assocs math.order ; IN: alarms -TUPLE: alarm quot time interval entry ; +TUPLE: alarm + { quot callable initial: [ ] } + { time timestamp } + interval + { entry box } ; ( quot time frequency -- alarm ) check-alarm alarm boa ; : register-alarm ( alarm -- ) - dup dup alarm-time alarms get-global heap-push* - swap alarm-entry >box + dup dup time>> alarms get-global heap-push* + swap entry>> >box notify-alarm-thread ; : alarm-expired? ( alarm now -- ? ) - >r alarm-time r> before=? ; + [ time>> ] dip before=? ; : reschedule-alarm ( alarm -- ) - dup alarm-time over alarm-interval time+ - over set-alarm-time - register-alarm ; + dup [ swap interval>> time+ ] change-time register-alarm ; : call-alarm ( alarm -- ) - dup alarm-entry box> drop - dup alarm-quot "Alarm execution" spawn drop - dup alarm-interval [ reschedule-alarm ] [ drop ] if ; + [ entry>> box> drop ] + [ quot>> "Alarm execution" spawn drop ] + [ dup interval>> [ reschedule-alarm ] [ drop ] if ] tri ; : (trigger-alarms) ( alarms now -- ) over heap-empty? [ @@ -57,7 +58,7 @@ SYMBOL: alarm-thread : next-alarm ( alarms -- timestamp/f ) dup heap-empty? - [ drop f ] [ heap-peek drop alarm-time ] if ; + [ drop f ] [ heap-peek drop time>> ] if ; : alarm-thread-loop ( -- ) alarms get-global @@ -66,7 +67,7 @@ SYMBOL: alarm-thread : cancel-alarms ( alarms -- ) [ - heap-pop-all [ nip alarm-entry box> drop ] assoc-each + heap-pop-all [ nip entry>> box> drop ] assoc-each ] when* ; : init-alarms ( -- ) @@ -88,4 +89,4 @@ PRIVATE> [ hence ] keep add-alarm ; : cancel-alarm ( alarm -- ) - alarm-entry [ alarms get-global heap-delete ] if-box? ; + entry>> [ alarms get-global heap-delete ] if-box? ; diff --git a/basis/alias/alias-docs.factor b/basis/alias/alias-docs.factor new file mode 100644 index 0000000000..024c6ea491 --- /dev/null +++ b/basis/alias/alias-docs.factor @@ -0,0 +1,15 @@ +USING: kernel words help.markup help.syntax ; +IN: alias + +HELP: ALIAS: +{ $syntax "ALIAS: new-word existing-word" } +{ $values { "new-word" word } { "existing-word" word } } +{ $description "Creates a " { $snippet "new" } " inlined word that calls the " { $snippet "existing" } " word." } +{ $examples + { $example "ALIAS: sequence-nth nth" + "0 { 10 20 30 } sequence-nth" + "10" + } +} ; + + diff --git a/basis/ascii/ascii.factor b/basis/ascii/ascii.factor index 30b801a950..c009c66cde 100755 --- a/basis/ascii/ascii.factor +++ b/basis/ascii/ascii.factor @@ -1,6 +1,7 @@ ! Copyright (C) 2005, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel math math.order sequences ; +USING: kernel math math.order sequences +combinators.short-circuit ; IN: ascii : blank? ( ch -- ? ) " \t\n\r" member? ; inline @@ -20,7 +21,7 @@ IN: ascii dup printable? [ "\"\\" member? not ] [ drop f ] if ; inline : Letter? ( ch -- ? ) - dup letter? [ drop t ] [ LETTER? ] if ; inline + [ [ letter? ] [ LETTER? ] ] 1|| ; : alpha? ( ch -- ? ) - dup Letter? [ drop t ] [ digit? ] if ; inline + [ [ Letter? ] [ digit? ] ] 1|| ; diff --git a/basis/base64/base64-tests.factor b/basis/base64/base64-tests.factor index 86c58af505..9958e7943f 100644 --- a/basis/base64/base64-tests.factor +++ b/basis/base64/base64-tests.factor @@ -1,4 +1,5 @@ USING: kernel tools.test base64 strings ; +IN: base64.tests [ "abcdefghijklmnopqrstuvwxyz" ] [ "abcdefghijklmnopqrstuvwxyz" >base64 base64> >string ] unit-test diff --git a/basis/base64/base64.factor b/basis/base64/base64.factor index d48abc2014..3bf1a527ea 100644 --- a/basis/base64/base64.factor +++ b/basis/base64/base64.factor @@ -1,3 +1,5 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. USING: kernel math sequences io.binary splitting grouping ; IN: base64 diff --git a/basis/biassocs/biassocs.factor b/basis/biassocs/biassocs.factor index cd1e57f6ec..a9f0cabd10 100644 --- a/basis/biassocs/biassocs.factor +++ b/basis/biassocs/biassocs.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel assocs accessors ; +USING: kernel assocs accessors summary ; IN: biassocs TUPLE: biassoc from to ; @@ -23,8 +23,13 @@ M: biassoc value-at* to>> at* ; M: biassoc set-at [ from>> set-at ] [ swapd to>> once-at ] 3bi ; +ERROR: no-biassoc-deletion ; + +M: no-biassoc-deletion summary + drop "biassocs do not support deletion" ; + M: biassoc delete-at - "biassocs do not support deletion" throw ; + no-biassoc-deletion ; M: biassoc >alist from>> >alist ; diff --git a/basis/bootstrap/handbook/handbook.factor b/basis/bootstrap/handbook/handbook.factor index 2ffb77de7a..51aa9eefaf 100755 --- a/basis/bootstrap/handbook/handbook.factor +++ b/basis/bootstrap/handbook/handbook.factor @@ -1,3 +1,4 @@ USING: vocabs.loader vocabs kernel ; +IN: bootstrap.handbook "bootstrap.help" vocab [ "help.handbook" require ] when diff --git a/basis/bootstrap/random/random.factor b/basis/bootstrap/random/random.factor index 5f5e11d913..3782d517cf 100755 --- a/basis/bootstrap/random/random.factor +++ b/basis/bootstrap/random/random.factor @@ -1,6 +1,7 @@ USING: vocabs.loader sequences system random random.mersenne-twister combinators init namespaces random ; +IN: bootstrap.random "random.mersenne-twister" require diff --git a/basis/bootstrap/tools/tools.factor b/basis/bootstrap/tools/tools.factor index f9d51b3dfc..c6ec7f0b99 100755 --- a/basis/bootstrap/tools/tools.factor +++ b/basis/bootstrap/tools/tools.factor @@ -1,4 +1,5 @@ USING: vocabs.loader sequences ; +IN: bootstrap.tools { "inspector" diff --git a/basis/bootstrap/ui/ui.factor b/basis/bootstrap/ui/ui.factor index 5aa7683efc..0cdf3137f6 100644 --- a/basis/bootstrap/ui/ui.factor +++ b/basis/bootstrap/ui/ui.factor @@ -1,5 +1,6 @@ USING: alien namespaces system combinators kernel sequences vocabs vocabs.loader ; +IN: bootstrap.ui "bootstrap.compiler" vocab [ "ui-backend" get [ diff --git a/basis/bootstrap/unicode/unicode.factor b/basis/bootstrap/unicode/unicode.factor index 3c65669ea7..1046d41bdc 100755 --- a/basis/bootstrap/unicode/unicode.factor +++ b/basis/bootstrap/unicode/unicode.factor @@ -1,4 +1,5 @@ USING: strings.parser kernel namespaces unicode.data ; +IN: bootstrap.unicode [ name>char [ "Invalid character" throw ] unless* ] name>char-hook set-global diff --git a/basis/calendar/calendar-docs.factor b/basis/calendar/calendar-docs.factor new file mode 100644 index 0000000000..19427b7c79 --- /dev/null +++ b/basis/calendar/calendar-docs.factor @@ -0,0 +1,31 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: arrays kernel math strings help.markup help.syntax +calendar.backend ; +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." } ; + +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 } "." } ; + +{ timestamp duration } related-words + +HELP: gmt-offset-duration +{ $values { "duration" duration } } +{ $description "Returns a " { $link duration } " object with the GMT offset returned by " { $link gmt-offset } "." } ; + +HELP: +{ $values { "year" integer } { "month" integer } { "day" integer } { "timestamp" timestamp } } +{ $description "Returns a timestamp object representing the start of the specified day in your current timezone." } +{ $examples + { $example "USING: calendar prettyprint ;" + "12 25 2010 ." + "T{ timestamp f 12 25 2010 0 0 0 T{ duration f 0 0 0 -5 0 0 } }" + } +} ; + +HELP: month-names +{ $values { "array" array } } +{ $description "Returns an array with the English names of all the months. January has a index of 1 instead of 0." } ; diff --git a/basis/calendar/calendar.factor b/basis/calendar/calendar.factor index 0abc00b4a4..402542de3b 100755 --- a/basis/calendar/calendar.factor +++ b/basis/calendar/calendar.factor @@ -1,52 +1,90 @@ ! Copyright (C) 2007 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. - USING: arrays kernel math math.functions namespaces sequences strings system vocabs.loader calendar.backend threads accessors combinators locals classes.tuple math.order -memoize ; +memoize summary combinators.short-circuit ; IN: calendar -TUPLE: timestamp year month day hour minute second gmt-offset ; - -C: timestamp - -TUPLE: duration year month day hour minute second ; +TUPLE: duration + { year real } + { month real } + { day real } + { hour real } + { minute real } + { second real } ; C: duration +TUPLE: timestamp + { year integer } + { month integer } + { day integer } + { hour integer } + { minute integer } + { second real } + { gmt-offset duration } ; + +C: timestamp + : gmt-offset-duration ( -- duration ) 0 0 0 gmt-offset ; : ( year month day -- timestamp ) 0 0 0 gmt-offset-duration ; -: month-names +ERROR: not-a-month n ; +M: not-a-month summary + drop "Months are indexed starting at 1" ; + + + +: month-names ( -- array ) { - "Not a month" "January" "February" "March" "April" "May" "June" + "January" "February" "March" "April" "May" "June" "July" "August" "September" "October" "November" "December" } ; -: month-abbreviations +: month-name ( n -- string ) + check-month 1- month-names nth ; + +: month-abbreviations ( -- array ) { - "Not a month" - "Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug" "Sep" "Oct" "Nov" "Dec" + "Jan" "Feb" "Mar" "Apr" "May" "Jun" + "Jul" "Aug" "Sep" "Oct" "Nov" "Dec" } ; -: day-names +: month-abbreviation ( n -- array ) + check-month 1- month-abbreviations nth ; + +: day-names ( -- array ) { "Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday" } ; -: day-abbreviations2 { "Su" "Mo" "Tu" "We" "Th" "Fr" "Sa" } ; -: day-abbreviations3 { "Sun" "Mon" "Tue" "Wed" "Thu" "Fri" "Sat" } ; +: day-name ( n -- string ) day-names nth ; -: average-month 30+5/12 ; inline -: months-per-year 12 ; inline -: days-per-year 3652425/10000 ; inline -: hours-per-year 876582/100 ; inline -: minutes-per-year 5259492/10 ; inline -: seconds-per-year 31556952 ; inline +: day-abbreviations2 ( -- array ) + { "Su" "Mo" "Tu" "We" "Th" "Fr" "Sa" } ; + +: day-abbreviation2 ( n -- string ) + day-abbreviations2 nth ; + +: day-abbreviations3 ( -- array ) + { "Sun" "Mon" "Tue" "Wed" "Thu" "Fri" "Sat" } ; + +: day-abbreviation3 ( n -- string ) + day-abbreviations3 nth ; + +: average-month ( -- ratio ) 30+5/12 ; inline +: months-per-year ( -- integer ) 12 ; inline +: days-per-year ( -- ratio ) 3652425/10000 ; inline +: hours-per-year ( -- ratio ) 876582/100 ; inline +: minutes-per-year ( -- ratio ) 5259492/10 ; inline +: seconds-per-year ( -- integer ) 31556952 ; inline :: julian-day-number ( year month day -- n ) #! Returns a composite date number @@ -113,10 +151,12 @@ GENERIC: +second ( timestamp x -- timestamp ) [ floor >integer ] keep over - ; : adjust-leap-year ( timestamp -- timestamp ) - dup day>> 29 = over month>> 2 = pick leap-year? not and and + dup + { [ day>> 29 = ] [ month>> 2 = ] [ leap-year? not ] } 1&& [ 3 >>month 1 >>day ] when ; -: unless-zero >r dup zero? [ drop ] r> if ; inline +: unless-zero ( n quot -- ) + [ dup zero? [ drop ] ] dip if ; inline M: integer +year ( timestamp n -- timestamp ) [ [ + ] curry change-year adjust-leap-year ] unless-zero ; diff --git a/basis/calendar/format/format.factor b/basis/calendar/format/format.factor index e2b6a280ef..36849d4ae3 100755 --- a/basis/calendar/format/format.factor +++ b/basis/calendar/format/format.factor @@ -26,11 +26,11 @@ IN: calendar.format : DD ( time -- ) day>> write-00 ; -: DAY ( time -- ) day-of-week day-abbreviations3 nth write ; +: DAY ( time -- ) day-of-week day-abbreviation3 write ; : MM ( time -- ) month>> write-00 ; -: MONTH ( time -- ) month>> month-abbreviations nth write ; +: MONTH ( time -- ) month>> month-abbreviation write ; : YYYY ( time -- ) year>> write-0000 ; @@ -57,7 +57,7 @@ GENERIC: month. ( obj -- ) M: array month. ( pair -- ) first2 - [ month-names nth write bl number>string print ] + [ month-name write bl number>string print ] [ 1 zeller-congruence ] [ (days-in-month) day-abbreviations2 " " join print ] 2tri over " " concat write @@ -191,7 +191,7 @@ ERROR: invalid-timestamp-format ; "," read-token day-abbreviations3 member? check-timestamp drop read1 CHAR: \s assert= read-sp checked-number >>day - read-sp month-abbreviations index check-timestamp >>month + read-sp month-abbreviations index 1+ check-timestamp >>month read-sp checked-number >>year ":" read-token checked-number >>hour ":" read-token checked-number >>minute @@ -206,7 +206,7 @@ ERROR: invalid-timestamp-format ; "," read-token day-abbreviations3 member? check-timestamp drop read1 CHAR: \s assert= "-" read-token checked-number >>day - "-" read-token month-abbreviations index check-timestamp >>month + "-" read-token month-abbreviations index 1+ check-timestamp >>month read-sp checked-number >>year ":" read-token checked-number >>hour ":" read-token checked-number >>minute @@ -219,7 +219,7 @@ ERROR: invalid-timestamp-format ; : (cookie-string>timestamp-2) ( -- timestamp ) timestamp new read-sp day-abbreviations3 member? check-timestamp drop - read-sp month-abbreviations index check-timestamp >>month + read-sp month-abbreviations index 1+ check-timestamp >>month read-sp checked-number >>day ":" read-token checked-number >>hour ":" read-token checked-number >>minute diff --git a/basis/cocoa/messages/messages.factor b/basis/cocoa/messages/messages.factor index 94c5f05887..ea7280b5a6 100755 --- a/basis/cocoa/messages/messages.factor +++ b/basis/cocoa/messages/messages.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2006, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: alien alien.c-types alien.strings +USING: accessors alien alien.c-types alien.strings arrays assocs combinators compiler kernel math namespaces parser prettyprint prettyprint.sections quotations sequences strings words cocoa.runtime io macros @@ -46,11 +46,11 @@ TUPLE: selector name object ; MEMO: ( name -- sel ) f \ selector boa ; : selector ( selector -- alien ) - dup selector-object expired? [ - dup selector-name sel_registerName - dup rot set-selector-object + dup object>> expired? [ + dup name>> sel_registerName + [ >>object drop ] keep ] [ - selector-object + object>> ] if ; SYMBOL: objc-methods diff --git a/basis/compiler/generator/fixup/fixup.factor b/basis/compiler/generator/fixup/fixup.factor index e1b4e42e67..ae30502524 100755 --- a/basis/compiler/generator/fixup/fixup.factor +++ b/basis/compiler/generator/fixup/fixup.factor @@ -15,7 +15,7 @@ TUPLE: frame-required n ; : stack-frame-size ( code -- n ) no-stack-frame [ - dup frame-required? [ frame-required-n max ] [ drop ] if + dup frame-required? [ n>> max ] [ drop ] if ] reduce ; GENERIC: fixup* ( frame-size obj -- frame-size ) @@ -29,7 +29,7 @@ TUPLE: label offset ; :