Merge branch 'master' of git://factorcode.org/git/factor
commit
cf9105c056
|
@ -352,6 +352,8 @@ TUPLE: bad-number ;
|
|||
: parse-definition ( -- quot )
|
||||
\ ; parse-until >quotation ;
|
||||
|
||||
: (:) CREATE dup reset-generic parse-definition ;
|
||||
|
||||
GENERIC: expected>string ( obj -- str )
|
||||
|
||||
M: f expected>string drop "end of input" ;
|
||||
|
|
|
@ -107,7 +107,7 @@ IN: bootstrap.syntax
|
|||
] define-syntax
|
||||
|
||||
":" [
|
||||
CREATE dup reset-generic parse-definition define
|
||||
(:) define
|
||||
] define-syntax
|
||||
|
||||
"GENERIC:" [
|
||||
|
|
|
@ -51,7 +51,7 @@ HINTS: random fixnum ;
|
|||
dup keys >byte-array
|
||||
swap values >float-array unclip [ + ] accumulate swap add ;
|
||||
|
||||
:: select-random | seed chars floats |
|
||||
:: select-random ( seed chars floats -- elt )
|
||||
floats seed random -rot
|
||||
[ >= ] curry find drop
|
||||
chars nth-unsafe ; inline
|
||||
|
@ -62,7 +62,7 @@ HINTS: random fixnum ;
|
|||
: write-description ( desc id -- )
|
||||
">" write write bl print ; inline
|
||||
|
||||
:: split-lines | n quot |
|
||||
:: split-lines ( n quot -- )
|
||||
n line-length /mod
|
||||
[ [ line-length quot call ] times ] dip
|
||||
dup zero? [ drop ] quot if ; inline
|
||||
|
@ -71,7 +71,7 @@ HINTS: random fixnum ;
|
|||
write-description
|
||||
[ make-random-fasta ] 2curry split-lines ; inline
|
||||
|
||||
:: make-repeat-fasta | k len alu |
|
||||
:: make-repeat-fasta ( k len alu -- )
|
||||
[let | kn [ alu length ] |
|
||||
len [ k + kn mod alu nth-unsafe ] B{ } map-as print
|
||||
k len +
|
||||
|
|
|
@ -1,14 +1,15 @@
|
|||
USING: arrays calendar kernel math sequences tools.test
|
||||
continuations system ;
|
||||
|
||||
! [ 2004 12 32 0 0 0 0 <timestamp> ] [ "invalid timestamp" = ] must-fail-with
|
||||
! [ 2004 2 30 0 0 0 0 <timestamp> ] [ "invalid timestamp" = ] must-fail-with
|
||||
! [ 2003 2 29 0 0 0 0 <timestamp> ] [ "invalid timestamp" = ] must-fail-with
|
||||
! [ 2004 -2 9 0 0 0 0 <timestamp> ] [ "invalid timestamp" = ] must-fail-with
|
||||
! [ 2004 12 0 0 0 0 0 <timestamp> ] [ "invalid timestamp" = ] must-fail-with
|
||||
! [ 2004 12 1 24 0 0 0 <timestamp> ] [ "invalid timestamp" = ] must-fail-with
|
||||
! [ 2004 12 1 23 60 0 0 <timestamp> ] [ "invalid timestamp" = ] must-fail-with
|
||||
! [ 2004 12 1 23 59 60 0 <timestamp> ] [ "invalid timestamp" = ] must-fail-with
|
||||
[ f ] [ 2004 12 32 0 0 0 0 <timestamp> valid-timestamp? ] unit-test
|
||||
[ f ] [ 2004 2 30 0 0 0 0 <timestamp> valid-timestamp? ] unit-test
|
||||
[ f ] [ 2003 2 29 0 0 0 0 <timestamp> valid-timestamp? ] unit-test
|
||||
[ f ] [ 2004 -2 9 0 0 0 0 <timestamp> valid-timestamp? ] unit-test
|
||||
[ f ] [ 2004 12 0 0 0 0 0 <timestamp> valid-timestamp? ] unit-test
|
||||
[ f ] [ 2004 12 1 24 0 0 0 <timestamp> valid-timestamp? ] unit-test
|
||||
[ f ] [ 2004 12 1 23 60 0 0 <timestamp> valid-timestamp? ] unit-test
|
||||
[ f ] [ 2004 12 1 23 59 60 0 <timestamp> valid-timestamp? ] unit-test
|
||||
[ t ] [ now valid-timestamp? ] unit-test
|
||||
|
||||
[ f ] [ 1900 leap-year? ] unit-test
|
||||
[ t ] [ 1904 leap-year? ] unit-test
|
||||
|
|
|
@ -37,9 +37,12 @@ C: <duration> duration
|
|||
: day-abbreviations2 { "Su" "Mo" "Tu" "We" "Th" "Fr" "Sa" } ;
|
||||
: day-abbreviations3 { "Sun" "Mon" "Tue" "Wed" "Thu" "Fri" "Sat" } ;
|
||||
|
||||
: average-month ( -- x )
|
||||
#! length of average month in days
|
||||
30.41666666666667 ;
|
||||
: 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
|
||||
|
||||
<PRIVATE
|
||||
|
||||
|
@ -129,7 +132,7 @@ M: integer +year ( timestamp n -- timestamp )
|
|||
[ [ + ] curry change-year adjust-leap-year ] unless-zero ;
|
||||
|
||||
M: real +year ( timestamp n -- timestamp )
|
||||
[ float>whole-part swapd 365.2425 * +day swap +year ] unless-zero ;
|
||||
[ float>whole-part swapd days-per-year * +day swap +year ] unless-zero ;
|
||||
|
||||
: months/years ( n -- months years )
|
||||
12 /rem dup zero? [ drop 1- 12 ] when swap ; inline
|
||||
|
@ -191,33 +194,37 @@ M: timestamp time+
|
|||
>r clone r> (time+) drop ;
|
||||
|
||||
M: duration time+
|
||||
[ year>> ] +slots
|
||||
[ month>> ] +slots
|
||||
[ day>> ] +slots
|
||||
[ hour>> ] +slots
|
||||
[ minute>> ] +slots
|
||||
[ second>> ] +slots
|
||||
2drop <duration> ;
|
||||
dup timestamp? [
|
||||
swap time+
|
||||
] [
|
||||
[ year>> ] +slots
|
||||
[ month>> ] +slots
|
||||
[ day>> ] +slots
|
||||
[ hour>> ] +slots
|
||||
[ minute>> ] +slots
|
||||
[ second>> ] +slots
|
||||
2drop <duration>
|
||||
] if ;
|
||||
|
||||
: dt>years ( dt -- x )
|
||||
#! Uses average month/year length since dt loses calendar
|
||||
#! data
|
||||
0 swap
|
||||
[ year>> + ] keep
|
||||
[ month>> 12 / + ] keep
|
||||
[ day>> 365.2425 / + ] keep
|
||||
[ hour>> 8765.82 / + ] keep
|
||||
[ minute>> 525949.2 / + ] keep
|
||||
second>> 31556952.0 / + ;
|
||||
[ month>> months-per-year / + ] keep
|
||||
[ day>> days-per-year / + ] keep
|
||||
[ hour>> hours-per-year / + ] keep
|
||||
[ minute>> minutes-per-year / + ] keep
|
||||
second>> seconds-per-year / + ;
|
||||
|
||||
M: duration <=> [ dt>years ] compare ;
|
||||
|
||||
: dt>months ( dt -- x ) dt>years 12 * ;
|
||||
: dt>days ( dt -- x ) dt>years 365.2425 * ;
|
||||
: dt>hours ( dt -- x ) dt>years 8765.82 * ;
|
||||
: dt>minutes ( dt -- x ) dt>years 525949.2 * ;
|
||||
: dt>seconds ( dt -- x ) dt>years 31556952 * ;
|
||||
: dt>milliseconds ( dt -- x ) dt>years 31556952000 * ;
|
||||
: dt>months ( dt -- x ) dt>years months-per-year * ;
|
||||
: dt>days ( dt -- x ) dt>years days-per-year * ;
|
||||
: dt>hours ( dt -- x ) dt>years hours-per-year * ;
|
||||
: dt>minutes ( dt -- x ) dt>years minutes-per-year * ;
|
||||
: dt>seconds ( dt -- x ) dt>years seconds-per-year * ;
|
||||
: dt>milliseconds ( dt -- x ) dt>seconds 1000 * ;
|
||||
|
||||
: convert-timezone ( timestamp n -- timestamp )
|
||||
over gmt-offset>> over = [ drop ] [
|
||||
|
@ -233,26 +240,16 @@ M: duration <=> [ dt>years ] compare ;
|
|||
M: timestamp <=> ( ts1 ts2 -- n )
|
||||
[ >gmt tuple-slots ] compare ;
|
||||
|
||||
: time- ( timestamp timestamp -- seconds )
|
||||
#! Exact calendar-time difference
|
||||
: (time-) ( timestamp timestamp -- n )
|
||||
[ >gmt ] 2apply
|
||||
[ [ >date< julian-day-number ] 2apply - 86400 * ] 2keep
|
||||
[ >time< >r >r 3600 * r> 60 * r> + + ] 2apply - + ;
|
||||
|
||||
: unix-1970 ( -- timestamp )
|
||||
1970 1 1 0 0 0 0 <timestamp> ; foldable
|
||||
GENERIC: time- ( time1 time2 -- time )
|
||||
|
||||
: millis>timestamp ( n -- timestamp )
|
||||
>r unix-1970 r> milliseconds time+ ;
|
||||
|
||||
: timestamp>millis ( timestamp -- n )
|
||||
unix-1970 time- 1000 * >integer ;
|
||||
|
||||
: gmt ( -- timestamp )
|
||||
#! GMT time, right now
|
||||
unix-1970 millis milliseconds time+ ;
|
||||
|
||||
: now ( -- timestamp ) gmt >local-time ;
|
||||
M: timestamp time-
|
||||
#! Exact calendar-time difference
|
||||
(time-) seconds ;
|
||||
|
||||
: before ( dt -- -dt )
|
||||
[ year>> neg ] keep
|
||||
|
@ -263,10 +260,34 @@ M: timestamp <=> ( ts1 ts2 -- n )
|
|||
second>> neg
|
||||
<duration> ;
|
||||
|
||||
: from-now ( dt -- timestamp ) now swap time+ ;
|
||||
: ago ( dt -- timestamp ) before from-now ;
|
||||
M: duration time-
|
||||
before time+ ;
|
||||
|
||||
: day-counts { 0 31 28 31 30 31 30 31 31 30 31 30 31 } ;
|
||||
: <zero> 0 0 0 0 0 0 0 <timestamp> ;
|
||||
|
||||
: valid-timestamp? ( timestamp -- ? )
|
||||
clone 0 >>gmt-offset
|
||||
dup <zero> time- <zero> time+ = ;
|
||||
|
||||
: unix-1970 ( -- timestamp )
|
||||
1970 1 1 0 0 0 0 <timestamp> ; foldable
|
||||
|
||||
: millis>timestamp ( n -- timestamp )
|
||||
>r unix-1970 r> milliseconds time+ ;
|
||||
|
||||
: timestamp>millis ( timestamp -- n )
|
||||
unix-1970 (time-) 1000 * >integer ;
|
||||
|
||||
: gmt ( -- timestamp )
|
||||
#! GMT time, right now
|
||||
unix-1970 millis milliseconds time+ ;
|
||||
|
||||
: now ( -- timestamp ) gmt >local-time ;
|
||||
|
||||
: from-now ( dt -- timestamp ) now swap time+ ;
|
||||
: ago ( dt -- timestamp ) now swap time- ;
|
||||
|
||||
: day-counts { 0 31 28 31 30 31 30 31 31 30 31 30 31 } ; inline
|
||||
|
||||
: zeller-congruence ( year month day -- n )
|
||||
#! Zeller Congruence
|
||||
|
@ -347,7 +368,7 @@ M: timestamp day-of-year ( timestamp -- n )
|
|||
: beginning-of-year ( timestamp -- new-timestamp )
|
||||
beginning-of-month 1 >>month ;
|
||||
|
||||
: seconds-since-midnight ( timestamp -- x )
|
||||
: time-since-midnight ( timestamp -- duration )
|
||||
dup beginning-of-day time- ;
|
||||
|
||||
M: timestamp sleep-until timestamp>millis sleep-until ;
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
IN: calendar.format
|
||||
USING: math math.parser kernel sequences io calendar
|
||||
accessors arrays io.streams.string combinators ;
|
||||
accessors arrays io.streams.string combinators accessors ;
|
||||
|
||||
GENERIC: day. ( obj -- )
|
||||
|
||||
|
|
|
@ -1,13 +0,0 @@
|
|||
USING: alien alien.c-types calendar calendar.unix
|
||||
kernel math tools.test ;
|
||||
|
||||
[ t ] [ 239293000 [
|
||||
unix-time>timestamp timestamp>timeval
|
||||
timeval>timestamp timestamp>timeval *ulong
|
||||
] keep = ] unit-test
|
||||
|
||||
|
||||
[ t ] [ 23929000.3 [
|
||||
unix-time>timestamp timestamp>timeval
|
||||
timeval>timestamp timestamp>timeval *ulong
|
||||
] keep >bignum = ] unit-test
|
|
@ -24,7 +24,7 @@ IN: channels.examples
|
|||
from swap dupd mod zero? not [ swap to ] [ 2drop ] if
|
||||
] 3keep filter ;
|
||||
|
||||
:: (sieve) | prime c | ( prime c -- )
|
||||
:: (sieve) ( prime c -- )
|
||||
[let | p [ c from ]
|
||||
newc [ <channel> ] |
|
||||
p prime to
|
||||
|
|
|
@ -2,6 +2,7 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: strings arrays hashtables assocs sequences
|
||||
xml.writer xml.utilities kernel namespaces ;
|
||||
IN: cocoa.plists
|
||||
|
||||
GENERIC: >plist ( obj -- tag )
|
||||
|
||||
|
|
|
@ -3,7 +3,7 @@ USING: sequences tools.test concurrency.exchangers
|
|||
concurrency.count-downs concurrency.promises locals kernel
|
||||
threads ;
|
||||
|
||||
:: exchanger-test | |
|
||||
:: exchanger-test ( -- )
|
||||
[let |
|
||||
ex [ <exchanger> ]
|
||||
c [ 2 <count-down> ]
|
||||
|
|
|
@ -3,7 +3,7 @@ USING: tools.test concurrency.locks concurrency.count-downs
|
|||
concurrency.messaging concurrency.mailboxes locals kernel
|
||||
threads sequences calendar ;
|
||||
|
||||
:: lock-test-0 | |
|
||||
:: lock-test-0 ( -- )
|
||||
[let | v [ V{ } clone ]
|
||||
c [ 2 <count-down> ] |
|
||||
|
||||
|
@ -27,7 +27,7 @@ threads sequences calendar ;
|
|||
v
|
||||
] ;
|
||||
|
||||
:: lock-test-1 | |
|
||||
:: lock-test-1 ( -- )
|
||||
[let | v [ V{ } clone ]
|
||||
l [ <lock> ]
|
||||
c [ 2 <count-down> ] |
|
||||
|
@ -79,7 +79,7 @@ threads sequences calendar ;
|
|||
|
||||
[ ] [ <rw-lock> dup [ [ ] with-read-lock ] with-write-lock ] unit-test
|
||||
|
||||
:: rw-lock-test-1 | |
|
||||
:: rw-lock-test-1 ( -- )
|
||||
[let | l [ <rw-lock> ]
|
||||
c [ 1 <count-down> ]
|
||||
c' [ 1 <count-down> ]
|
||||
|
@ -129,7 +129,7 @@ threads sequences calendar ;
|
|||
|
||||
[ V{ 1 2 3 4 5 6 } ] [ rw-lock-test-1 ] unit-test
|
||||
|
||||
:: rw-lock-test-2 | |
|
||||
:: rw-lock-test-2 ( -- )
|
||||
[let | l [ <rw-lock> ]
|
||||
c [ 1 <count-down> ]
|
||||
c' [ 2 <count-down> ]
|
||||
|
@ -160,7 +160,7 @@ threads sequences calendar ;
|
|||
[ V{ 1 2 3 } ] [ rw-lock-test-2 ] unit-test
|
||||
|
||||
! Test lock timeouts
|
||||
:: lock-timeout-test | |
|
||||
:: lock-timeout-test ( -- )
|
||||
[let | l [ <lock> ] |
|
||||
[
|
||||
l [ 1 seconds sleep ] with-lock
|
||||
|
|
|
@ -32,7 +32,7 @@ SYMBOL: old-d
|
|||
old-c c update-old-new
|
||||
old-d d update-old-new ;
|
||||
|
||||
:: (ABCD) | x s i k func a b c d |
|
||||
:: (ABCD) ( x s i k func a b c d -- )
|
||||
#! a = b + ((a + F(b,c,d) + X[k] + T[i]) <<< s)
|
||||
a [
|
||||
b get c get d get func call w+
|
||||
|
|
|
@ -1,26 +1,26 @@
|
|||
USING: help.markup help.syntax ;
|
||||
IN: help.lint
|
||||
|
||||
HELP: check-help
|
||||
{ $description "Checks all word and article help." } ;
|
||||
HELP: help-lint-all
|
||||
{ $description "Checks all word help and articles in all loaded vocabularies." } ;
|
||||
|
||||
HELP: check-vocab-help
|
||||
HELP: help-lint
|
||||
{ $values { "vocab" "a vocabulary specifier" } }
|
||||
{ $description "Checks all word help in the given vocabulary." } ;
|
||||
{ $description "Checks all word help and articles in the given vocabulary and all child vocabularies." } ;
|
||||
|
||||
ARTICLE: "help.lint" "Help lint tool"
|
||||
"The " { $vocab-link "help.lint" } " vocabulary implements a tool to check documentation in an automated fashion. You should use this tool to check any documentation that you write."
|
||||
$nl
|
||||
"To run help lint, use one of the following two words:"
|
||||
{ $subsection check-help }
|
||||
{ $subsection check-vocab-help }
|
||||
{ $subsection help-lint }
|
||||
{ $subsection help-lint-all }
|
||||
"Help lint performs the following checks:"
|
||||
{ $list
|
||||
"ensures examples run and produce stated output"
|
||||
{ "ensures " { $link $see-also } " elements don't contain duplicate entries" }
|
||||
{ "ensures " { $link $vocab-link } " elements point to modules which actually exist" }
|
||||
{ "ensures that " { $link $values } " match the stack effect declaration" }
|
||||
{ "ensures that word help articles actually render (this catches broken links, improper nesting, etc)" }
|
||||
{ "ensures that help topics actually render (this catches broken links, improper nesting, etc)" }
|
||||
} ;
|
||||
|
||||
ABOUT: "help.lint"
|
||||
|
|
|
@ -5,7 +5,7 @@ words strings classes tools.browser namespaces io
|
|||
io.streams.string prettyprint definitions arrays vectors
|
||||
combinators splitting debugger hashtables sorting effects vocabs
|
||||
vocabs.loader assocs editors continuations classes.predicate
|
||||
macros combinators.lib ;
|
||||
macros combinators.lib sequences.lib ;
|
||||
IN: help.lint
|
||||
|
||||
: check-example ( element -- )
|
||||
|
@ -84,7 +84,7 @@ M: help-error error.
|
|||
delegate error. ;
|
||||
|
||||
: check-something ( obj quot -- )
|
||||
over . flush [ <help-error> , ] recover ; inline
|
||||
flush [ <help-error> , ] recover ; inline
|
||||
|
||||
: check-word ( word -- )
|
||||
dup word-help [
|
||||
|
@ -106,22 +106,45 @@ M: help-error error.
|
|||
[ dup check-rendering ] assert-depth drop
|
||||
] check-something ;
|
||||
|
||||
: check-articles ( -- )
|
||||
articles get keys [ check-article ] each ;
|
||||
: group-articles ( -- assoc )
|
||||
articles get keys
|
||||
vocabs [ dup vocab-docs-path swap ] H{ } map>assoc
|
||||
H{ } clone [
|
||||
[
|
||||
>r >r dup >link where ?first r> at r> [ ?push ] change-at
|
||||
] 2curry each
|
||||
] keep ;
|
||||
|
||||
: with-help-lint ( quot -- )
|
||||
: check-vocab ( vocab -- seq )
|
||||
"Checking " write dup write "..." print
|
||||
[
|
||||
dup words [ check-word ] each
|
||||
"vocab-articles" get at [ check-article ] each
|
||||
] { } make ;
|
||||
|
||||
: run-help-lint ( prefix -- alist )
|
||||
[
|
||||
all-vocabs-seq [ vocab-name ] map "all-vocabs" set
|
||||
call
|
||||
] { } make [ nl error. ] each ; inline
|
||||
articles get keys "group-articles" set
|
||||
child-vocabs
|
||||
[ dup check-vocab ] { } map>assoc
|
||||
[ nip empty? not ] assoc-subset
|
||||
] with-scope ;
|
||||
|
||||
: check-help ( -- )
|
||||
[ all-words check-words check-articles ] with-help-lint ;
|
||||
: typos. ( assoc -- )
|
||||
dup empty? [
|
||||
drop
|
||||
"==== ALL CHECKS PASSED" print
|
||||
] [
|
||||
[
|
||||
swap vocab-heading.
|
||||
[ error. nl ] each
|
||||
] assoc-each
|
||||
] if ;
|
||||
|
||||
: check-vocab-help ( vocab -- )
|
||||
[
|
||||
child-vocabs [ words check-words ] each
|
||||
] with-help-lint ;
|
||||
: help-lint ( prefix -- ) run-help-lint typos. ;
|
||||
|
||||
: help-lint-all ( -- ) "" help-lint ;
|
||||
|
||||
: unlinked-words ( words -- seq )
|
||||
all-word-help [ article-parent not ] subset ;
|
||||
|
@ -132,4 +155,4 @@ M: help-error error.
|
|||
[ article-parent ] subset
|
||||
[ "predicating" word-prop not ] subset ;
|
||||
|
||||
MAIN: check-help
|
||||
MAIN: help-lint
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
USING: io.files kernel sequences new-slots accessors
|
||||
dlists arrays ;
|
||||
dlists arrays sequences.lib ;
|
||||
IN: io.paths
|
||||
|
||||
TUPLE: directory-iterator path bfs queue ;
|
||||
|
|
|
@ -24,7 +24,7 @@ C: <sniffer-spec> sniffer-spec
|
|||
: IOC_INOUT IOC_IN IOC_OUT bitor ; inline
|
||||
: IOC_DIRMASK HEX: e0000000 ; inline
|
||||
|
||||
:: ioc | inout group num len |
|
||||
:: ioc ( inout group num len -- n )
|
||||
group first 8 shift num bitor
|
||||
len IOCPARM_MASK bitand 16 shift bitor
|
||||
inout bitor ;
|
||||
|
|
|
@ -1,5 +1,6 @@
|
|||
USING: sequences kernel math io calendar calendar.model
|
||||
arrays models namespaces ui.gadgets ui.gadgets.labels
|
||||
USING: sequences kernel math io calendar calendar.format
|
||||
calendar.model arrays models namespaces ui.gadgets
|
||||
ui.gadgets.labels
|
||||
ui.gadgets.theme ui ;
|
||||
IN: lcd
|
||||
|
||||
|
|
|
@ -16,7 +16,7 @@ HELP: [|
|
|||
{ $examples
|
||||
{ $example
|
||||
"USE: locals"
|
||||
":: adder | n | [| m | m n + ] ;"
|
||||
":: adder ( n -- quot ) [| m | m n + ] ;"
|
||||
"3 5 adder call ."
|
||||
"8"
|
||||
}
|
||||
|
@ -29,7 +29,7 @@ HELP: [let
|
|||
{ $examples
|
||||
{ $example
|
||||
"USING: locals math.functions ;"
|
||||
":: frobnicate | n seq |"
|
||||
":: frobnicate ( n seq -- newseq )"
|
||||
" [let | n' [ n 6 * ] |"
|
||||
" seq [ n' gcd nip ] map ] ;"
|
||||
"6 { 36 14 } frobnicate ."
|
||||
|
@ -44,7 +44,7 @@ HELP: [wlet
|
|||
{ $examples
|
||||
{ $example
|
||||
"USE: locals"
|
||||
":: quuxify | n seq |"
|
||||
":: quuxify ( n seq -- newseq )"
|
||||
" [wlet | add-n [| m | m n + ] |"
|
||||
" seq [ add-n ] map ] ;"
|
||||
"2 { 1 2 3 } quuxify ."
|
||||
|
@ -57,13 +57,15 @@ HELP: with-locals
|
|||
{ $description "Performs closure conversion of a lexically-scoped form. All nested sub-forms are converted. This word must be applied to a " { $link POSTPONE: [| } ", " { $link POSTPONE: [let } " or " { $link POSTPONE: [wlet } " used in an ordinary definition, however forms in " { $link POSTPONE: :: } " and " { $link POSTPONE: MACRO:: } " definitions are automatically closure-converted and there is no need to use this word." } ;
|
||||
|
||||
HELP: ::
|
||||
{ $syntax ":: word | bindings... | body... ;" }
|
||||
{ $syntax ":: word ( bindings... -- outputs... ) body... ;" }
|
||||
{ $description "Defines a word with named inputs; it reads stack values into bindings from left to right, then executes the body with those bindings in lexical scope. Any " { $link POSTPONE: [| } ", " { $link POSTPONE: [let } " or " { $link POSTPONE: [wlet } " forms used in the body of the word definition are automatically closure-converted." }
|
||||
{ $notes "The output names do not affect the word's behavior, however the compiler attempts to check the stack effect as with other definitions." }
|
||||
{ $examples "See " { $link POSTPONE: [| } ", " { $link POSTPONE: [let } " and " { $link POSTPONE: [wlet } "." } ;
|
||||
|
||||
HELP: MACRO::
|
||||
{ $syntax "MACRO:: word | bindings... | body... ;" }
|
||||
{ $description "Defines a macro with named inputs; it reads stack values into bindings from left to right, then executes the body with those bindings in lexical scope. Any " { $link POSTPONE: [| } ", " { $link POSTPONE: [let } " or " { $link POSTPONE: [wlet } " forms used in the body of the word definition are automatically closure-converted." } ;
|
||||
{ $syntax "MACRO:: word ( bindings... -- outputs... ) body... ;" }
|
||||
{ $description "Defines a macro with named inputs; it reads stack values into bindings from left to right, then executes the body with those bindings in lexical scope. Any " { $link POSTPONE: [| } ", " { $link POSTPONE: [let } " or " { $link POSTPONE: [wlet } " forms used in the body of the word definition are automatically closure-converted." }
|
||||
{ $notes "The output names do not affect the word's behavior, however the compiler attempts to check the stack effect as with other definitions." } ;
|
||||
|
||||
{ POSTPONE: MACRO: POSTPONE: MACRO:: } related-words
|
||||
|
||||
|
@ -72,7 +74,7 @@ ARTICLE: "locals-mutable" "Mutable locals"
|
|||
$nl
|
||||
"Here is a example word which outputs a pair of quotations which increment and decrement an internal counter, and then return the new value. The quotations are closed over the counter and each invocation of the word yields new quotations with their unique internal counter:"
|
||||
{ $code
|
||||
":: counter | |"
|
||||
":: counter ( -- )"
|
||||
" [let | value! [ 0 ] |"
|
||||
" [ value 1+ dup value! ]"
|
||||
" [ value 1- dup value! ] ] ;"
|
||||
|
@ -86,7 +88,7 @@ ARTICLE: "locals-limitations" "Limitations of locals"
|
|||
$nl
|
||||
"Another limitation is that closure conversion does not descend into arrays, hashtables or other types of literals. For example, the following does not work:"
|
||||
{ $code
|
||||
":: bad-cond-usage | a |"
|
||||
":: bad-cond-usage ( a -- ... )"
|
||||
" { [ a 0 < ] [ ... ] }"
|
||||
" { [ a 0 > ] [ ... ] }"
|
||||
" { [ a 0 = ] [ ... ] } ;"
|
||||
|
|
|
@ -1,52 +1,52 @@
|
|||
USING: locals math sequences tools.test hashtables words kernel
|
||||
namespaces arrays ;
|
||||
namespaces arrays strings prettyprint ;
|
||||
IN: temporary
|
||||
|
||||
:: foo | a b | a a ;
|
||||
:: foo ( a b -- a a ) a a ;
|
||||
|
||||
[ 1 1 ] [ 1 2 foo ] unit-test
|
||||
|
||||
:: add-test | a b | a b + ;
|
||||
:: add-test ( a b -- c ) a b + ;
|
||||
|
||||
[ 3 ] [ 1 2 add-test ] unit-test
|
||||
|
||||
:: sub-test | a b | a b - ;
|
||||
:: sub-test ( a b -- c ) a b - ;
|
||||
|
||||
[ -1 ] [ 1 2 sub-test ] unit-test
|
||||
|
||||
:: map-test | a b | a [ b + ] map ;
|
||||
:: map-test ( a b -- seq ) a [ b + ] map ;
|
||||
|
||||
[ { 5 6 7 } ] [ { 1 2 3 } 4 map-test ] unit-test
|
||||
|
||||
:: map-test-2 | seq inc | seq [| elt | elt inc + ] map ;
|
||||
:: map-test-2 ( seq inc -- seq ) seq [| elt | elt inc + ] map ;
|
||||
|
||||
[ { 5 6 7 } ] [ { 1 2 3 } 4 map-test-2 ] unit-test
|
||||
|
||||
:: let-test | c |
|
||||
:: let-test ( c -- d )
|
||||
[let | a [ 1 ] b [ 2 ] | a b + c + ] ;
|
||||
|
||||
[ 7 ] [ 4 let-test ] unit-test
|
||||
|
||||
:: let-test-2 | |
|
||||
[let | a [ ] | [let | b [ a ] | a ] ] ;
|
||||
:: let-test-2 ( a -- a )
|
||||
a [let | a [ ] | [let | b [ a ] | a ] ] ;
|
||||
|
||||
[ 3 ] [ 3 let-test-2 ] unit-test
|
||||
|
||||
:: let-test-3 | |
|
||||
[let | a [ ] | [let | b [ [ a ] ] | [let | a [ 3 ] | b ] ] ] ;
|
||||
:: let-test-3 ( a -- a )
|
||||
a [let | a [ ] | [let | b [ [ a ] ] | [let | a [ 3 ] | b ] ] ] ;
|
||||
|
||||
:: let-test-4 | |
|
||||
[let | a [ 1 ] b [ ] | a b 2array ] ;
|
||||
:: let-test-4 ( a -- b )
|
||||
a [let | a [ 1 ] b [ ] | a b 2array ] ;
|
||||
|
||||
[ { 1 2 } ] [ 2 let-test-4 ] unit-test
|
||||
|
||||
:: let-test-5 | |
|
||||
[let | a [ ] b [ ] | a b 2array ] ;
|
||||
:: let-test-5 ( a -- b )
|
||||
a [let | a [ ] b [ ] | a b 2array ] ;
|
||||
|
||||
[ { 2 1 } ] [ 1 2 let-test-5 ] unit-test
|
||||
|
||||
:: let-test-6 | |
|
||||
[let | a [ ] b [ 1 ] | a b 2array ] ;
|
||||
:: let-test-6 ( a -- b )
|
||||
a [let | a [ ] b [ 1 ] | a b 2array ] ;
|
||||
|
||||
[ { 2 1 } ] [ 2 let-test-6 ] unit-test
|
||||
|
||||
|
@ -57,26 +57,26 @@ IN: temporary
|
|||
with-locals
|
||||
] unit-test
|
||||
|
||||
:: wlet-test-2 | a b |
|
||||
:: wlet-test-2 ( a b -- seq )
|
||||
[wlet | add-b [ b + ] |
|
||||
a [ add-b ] map ] ;
|
||||
|
||||
|
||||
[ { 4 5 6 } ] [ { 2 3 4 } 2 wlet-test-2 ] unit-test
|
||||
|
||||
:: wlet-test-3 | a |
|
||||
:: wlet-test-3 ( a -- b )
|
||||
[wlet | add-a [ a + ] | [ add-a ] ]
|
||||
[let | a [ 3 ] | a swap call ] ;
|
||||
|
||||
[ 5 ] [ 2 wlet-test-3 ] unit-test
|
||||
|
||||
:: wlet-test-4 | a |
|
||||
:: wlet-test-4 ( a -- b )
|
||||
[wlet | sub-a [| b | b a - ] |
|
||||
3 sub-a ] ;
|
||||
|
||||
[ -7 ] [ 10 wlet-test-4 ] unit-test
|
||||
|
||||
:: write-test-1 | n! |
|
||||
:: write-test-1 ( n! -- q )
|
||||
[| i | n i + dup n! ] ;
|
||||
|
||||
0 write-test-1 "q" set
|
||||
|
@ -89,7 +89,7 @@ IN: temporary
|
|||
|
||||
[ 5 ] [ 2 "q" get call ] unit-test
|
||||
|
||||
:: write-test-2 | |
|
||||
:: write-test-2 ( -- q )
|
||||
[let | n! [ 0 ] |
|
||||
[| i | n i + dup n! ] ] ;
|
||||
|
||||
|
@ -108,21 +108,55 @@ write-test-2 "q" set
|
|||
20 10 [| a! | [| b! | a b ] ] with-locals call call
|
||||
] unit-test
|
||||
|
||||
:: write-test-3 | a! | [| b | b a! ] ;
|
||||
:: write-test-3 ( a! -- q ) [| b | b a! ] ;
|
||||
|
||||
[ ] [ 1 2 write-test-3 call ] unit-test
|
||||
|
||||
:: write-test-4 | x! | [ [let | y! [ 0 ] | f x! ] ] ;
|
||||
:: write-test-4 ( x! -- q ) [ [let | y! [ 0 ] | f x! ] ] ;
|
||||
|
||||
[ ] [ 5 write-test-4 drop ] unit-test
|
||||
|
||||
SYMBOL: a
|
||||
|
||||
:: use-test | a b c |
|
||||
:: use-test ( a b c -- a b c )
|
||||
USE: kernel ;
|
||||
|
||||
[ t ] [ a symbol? ] unit-test
|
||||
|
||||
:: let-let-test | n | [let | n [ n 3 + ] | n ] ;
|
||||
:: let-let-test ( n -- n ) [let | n [ n 3 + ] | n ] ;
|
||||
|
||||
[ 13 ] [ 10 let-let-test ] unit-test
|
||||
|
||||
GENERIC: lambda-generic ( a b -- c )
|
||||
|
||||
GENERIC# lambda-generic-1 1 ( a b -- c )
|
||||
|
||||
M:: integer lambda-generic-1 ( a b -- c ) a b * ;
|
||||
|
||||
M:: string lambda-generic-1 ( a b -- c )
|
||||
a b CHAR: x <string> lambda-generic ;
|
||||
|
||||
M:: integer lambda-generic ( a b -- c ) a b lambda-generic-1 ;
|
||||
|
||||
GENERIC# lambda-generic-2 1 ( a b -- c )
|
||||
|
||||
M:: integer lambda-generic-2 ( a b -- c )
|
||||
a CHAR: x <string> b lambda-generic ;
|
||||
|
||||
M:: string lambda-generic-2 ( a b -- c ) a b append ;
|
||||
|
||||
M:: string lambda-generic ( a b -- c ) a b lambda-generic-2 ;
|
||||
|
||||
[ 10 ] [ 5 2 lambda-generic ] unit-test
|
||||
|
||||
[ "abab" ] [ "aba" "b" lambda-generic ] unit-test
|
||||
|
||||
[ "abaxxx" ] [ "aba" 3 lambda-generic ] unit-test
|
||||
|
||||
[ "xaba" ] [ 1 "aba" lambda-generic ] unit-test
|
||||
|
||||
[ ] [ \ lambda-generic-1 see ] unit-test
|
||||
|
||||
[ ] [ \ lambda-generic-2 see ] unit-test
|
||||
|
||||
[ ] [ \ lambda-generic see ] unit-test
|
||||
|
|
|
@ -4,7 +4,8 @@ USING: kernel namespaces sequences sequences.private assocs math
|
|||
inference.transforms parser words quotations debugger macros
|
||||
arrays macros splitting combinators prettyprint.backend
|
||||
definitions prettyprint hashtables combinators.lib
|
||||
prettyprint.sections sequences.private ;
|
||||
prettyprint.sections sequences.private effects generic
|
||||
compiler.units ;
|
||||
IN: locals
|
||||
|
||||
! Inspired by
|
||||
|
@ -208,9 +209,6 @@ M: object local-rewrite* , ;
|
|||
: push-locals ( assoc -- )
|
||||
use get push ;
|
||||
|
||||
: parse-locals ( -- words assoc )
|
||||
"|" parse-tokens make-locals ;
|
||||
|
||||
: pop-locals ( assoc -- )
|
||||
use get delete ;
|
||||
|
||||
|
@ -218,7 +216,7 @@ M: object local-rewrite* , ;
|
|||
over push-locals parse-until >quotation swap pop-locals ;
|
||||
|
||||
: parse-lambda ( -- lambda )
|
||||
parse-locals \ ] (parse-lambda) <lambda> ;
|
||||
"|" parse-tokens make-locals \ ] (parse-lambda) <lambda> ;
|
||||
|
||||
: (parse-bindings) ( -- )
|
||||
scan dup "|" = [
|
||||
|
@ -246,11 +244,18 @@ M: wlet local-rewrite*
|
|||
dup wlet-bindings values over wlet-vars rot wlet-body
|
||||
<lambda> [ call ] curry compose local-rewrite* \ call , ;
|
||||
|
||||
: (::) ( prop -- word quot n )
|
||||
>r CREATE dup reset-generic
|
||||
scan "|" assert= parse-locals \ ; (parse-lambda) <lambda>
|
||||
2dup r> set-word-prop
|
||||
[ lambda-rewrite first ] keep lambda-vars length ;
|
||||
: parse-locals
|
||||
parse-effect
|
||||
word [ over "declared-effect" set-word-prop ] when*
|
||||
effect-in make-locals ;
|
||||
|
||||
: ((::)) ( word -- word quot )
|
||||
scan "(" assert= parse-locals \ ; (parse-lambda) <lambda>
|
||||
2dup "lambda" set-word-prop
|
||||
lambda-rewrite first ;
|
||||
|
||||
: (::) ( -- word quot )
|
||||
CREATE dup reset-generic ((::)) ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
|
@ -268,9 +273,22 @@ PRIVATE>
|
|||
|
||||
MACRO: with-locals ( form -- quot ) lambda-rewrite ;
|
||||
|
||||
: :: "lambda" (::) drop define ; parsing
|
||||
: :: (::) define ; parsing
|
||||
|
||||
: MACRO:: "lambda-macro" (::) (MACRO:) ; parsing
|
||||
! This will be cleaned up when method tuples and method words
|
||||
! are unified
|
||||
: create-method ( class generic -- method )
|
||||
2dup method dup
|
||||
[ 2nip method-word ]
|
||||
[ drop 2dup [ ] -rot define-method create-method ] if ;
|
||||
|
||||
: CREATE-METHOD ( -- class generic body )
|
||||
scan-word bootstrap-word scan-word 2dup
|
||||
create-method f set-word dup save-location ;
|
||||
|
||||
: M:: CREATE-METHOD ((::)) nip -rot define-method ; parsing
|
||||
|
||||
: MACRO:: (::) define-macro ; parsing
|
||||
|
||||
<PRIVATE
|
||||
|
||||
|
@ -323,26 +341,42 @@ M: lambda-word definer drop \ :: \ ; ;
|
|||
M: lambda-word definition
|
||||
"lambda" word-prop lambda-body ;
|
||||
|
||||
: lambda-word-synopsis ( word prop -- )
|
||||
over definer.
|
||||
over seeing-word
|
||||
over pprint-word
|
||||
\ | pprint-word
|
||||
word-prop lambda-vars pprint-vars
|
||||
\ | pprint-word ;
|
||||
: lambda-word-synopsis ( word -- )
|
||||
dup definer.
|
||||
dup seeing-word
|
||||
dup pprint-word
|
||||
stack-effect. ;
|
||||
|
||||
M: lambda-word synopsis*
|
||||
"lambda" lambda-word-synopsis ;
|
||||
M: lambda-word synopsis* lambda-word-synopsis ;
|
||||
|
||||
PREDICATE: macro lambda-macro
|
||||
"lambda-macro" word-prop >boolean ;
|
||||
"lambda" word-prop >boolean ;
|
||||
|
||||
M: lambda-macro definer drop \ MACRO:: \ ; ;
|
||||
|
||||
M: lambda-macro definition
|
||||
"lambda-macro" word-prop lambda-body ;
|
||||
"lambda" word-prop lambda-body ;
|
||||
|
||||
M: lambda-macro synopsis*
|
||||
"lambda-macro" lambda-word-synopsis ;
|
||||
M: lambda-macro synopsis* lambda-word-synopsis ;
|
||||
|
||||
PREDICATE: method-body lambda-method
|
||||
"lambda" word-prop >boolean ;
|
||||
|
||||
M: lambda-method definer drop \ M:: \ ; ;
|
||||
|
||||
M: lambda-method definition
|
||||
"lambda" word-prop lambda-body ;
|
||||
|
||||
: method-stack-effect
|
||||
dup "lambda" word-prop lambda-vars
|
||||
swap "method" word-prop method-generic stack-effect dup [ effect-out ] when
|
||||
<effect> ;
|
||||
|
||||
M: lambda-method synopsis*
|
||||
dup definer.
|
||||
dup "method" word-prop dup
|
||||
method-specializer pprint*
|
||||
method-generic pprint*
|
||||
method-stack-effect effect>string comment. ;
|
||||
|
||||
PRIVATE>
|
||||
|
|
|
@ -3,7 +3,7 @@
|
|||
USING: parser-combinators memoize kernel sequences
|
||||
logging arrays words strings vectors io io.files
|
||||
namespaces combinators combinators.lib logging.server
|
||||
calendar ;
|
||||
calendar calendar.format ;
|
||||
IN: logging.parser
|
||||
|
||||
: string-of satisfy <!*> [ >string ] <@ ;
|
||||
|
|
|
@ -3,7 +3,7 @@
|
|||
USING: namespaces kernel io calendar sequences io.files
|
||||
io.sockets continuations prettyprint assocs math.parser
|
||||
words debugger math combinators concurrency.messaging
|
||||
threads arrays init math.ranges strings ;
|
||||
threads arrays init math.ranges strings calendar.format ;
|
||||
IN: logging.server
|
||||
|
||||
: log-root ( -- string )
|
||||
|
|
|
@ -1,26 +1,21 @@
|
|||
! Copyright (C) 2007 Slava Pestov.
|
||||
! Copyright (C) 2007, 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
|
||||
USING: parser kernel sequences words effects inference.transforms
|
||||
combinators assocs definitions quotations namespaces memoize ;
|
||||
|
||||
USING: parser kernel sequences words effects
|
||||
inference.transforms combinators assocs definitions quotations
|
||||
namespaces memoize ;
|
||||
IN: macros
|
||||
|
||||
: (:) ( -- word definition effect-in )
|
||||
CREATE dup reset-generic parse-definition
|
||||
over "declared-effect" word-prop effect-in length ;
|
||||
|
||||
: real-macro-effect ( word -- effect' )
|
||||
"declared-effect" word-prop effect-in 1 <effect> ;
|
||||
|
||||
: (MACRO:) ( word definition effect-in -- )
|
||||
>r 2dup "macro" set-word-prop
|
||||
2dup over real-macro-effect memoize-quot
|
||||
[ call ] append define
|
||||
: define-macro ( word definition -- )
|
||||
over "declared-effect" word-prop effect-in length >r
|
||||
2dup "macro" set-word-prop
|
||||
2dup over real-macro-effect memoize-quot [ call ] append define
|
||||
r> define-transform ;
|
||||
|
||||
: MACRO:
|
||||
(:) (MACRO:) ; parsing
|
||||
(:) define-macro ; parsing
|
||||
|
||||
PREDICATE: word macro "macro" word-prop >boolean ;
|
||||
|
||||
|
|
|
@ -30,7 +30,7 @@ TUPLE: positive-even-expected n ;
|
|||
#! factor an integer into s * 2^r
|
||||
0 swap (factor-2s) ;
|
||||
|
||||
:: (miller-rabin) | n prime?! |
|
||||
:: (miller-rabin) ( n prime?! -- ? )
|
||||
n 1- factor-2s s set r set
|
||||
trials get [
|
||||
n 1- [1,b] random a set
|
||||
|
|
|
@ -45,25 +45,20 @@ IN: project-euler.019
|
|||
<PRIVATE
|
||||
|
||||
: start-date ( -- timestamp )
|
||||
1901 1 1 0 0 0 0 make-timestamp ;
|
||||
1901 1 1 <date> ;
|
||||
|
||||
: end-date ( -- timestamp )
|
||||
2000 12 31 0 0 0 0 make-timestamp ;
|
||||
2000 12 31 <date> ;
|
||||
|
||||
: (first-days) ( end-date start-date -- )
|
||||
2dup timestamp- 0 >= [
|
||||
dup day-of-week , 1 +month (first-days)
|
||||
] [
|
||||
2drop
|
||||
] if ;
|
||||
|
||||
: first-days ( start-date end-date -- seq )
|
||||
[ swap (first-days) ] { } make ;
|
||||
: first-days ( end-date start-date -- days )
|
||||
[ 2dup after=? ]
|
||||
[ dup 1 months time+ swap day-of-week ]
|
||||
[ ] unfold 2nip ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: euler019a ( -- answer )
|
||||
start-date end-date first-days [ zero? ] count ;
|
||||
end-date start-date first-days [ zero? ] count ;
|
||||
|
||||
! [ euler019a ] 100 ave-time
|
||||
! 131 ms run / 3 ms GC ave time - 100 trials
|
||||
|
|
|
@ -3,7 +3,7 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: namespaces io io.timeouts kernel logging io.sockets
|
||||
sequences combinators sequences.lib splitting assocs strings
|
||||
math.parser random system calendar ;
|
||||
math.parser random system calendar calendar.format ;
|
||||
|
||||
IN: smtp
|
||||
|
||||
|
|
|
@ -5,7 +5,7 @@ sequences concurrency.messaging locals continuations
|
|||
threads namespaces namespaces.private ;
|
||||
IN: tools.walker.debug
|
||||
|
||||
:: test-walker | quot |
|
||||
:: test-walker ( quot -- data )
|
||||
[let | p [ <promise> ]
|
||||
s [ f <model> ]
|
||||
c [ f <model> ] |
|
||||
|
|
|
@ -5,22 +5,29 @@ USING: alien alien.c-types alien.syntax kernel libc structs
|
|||
math namespaces system combinators vocabs.loader ;
|
||||
|
||||
! ! ! Unix types
|
||||
TYPEDEF: int blksize_t
|
||||
TYPEDEF: int dev_t
|
||||
|
||||
TYPEDEF: long word
|
||||
TYPEDEF: ulong uword
|
||||
|
||||
TYPEDEF: long longword
|
||||
TYPEDEF: ulong ulongword
|
||||
|
||||
TYPEDEF: long ssize_t
|
||||
TYPEDEF: longlong blkcnt_t
|
||||
TYPEDEF: longword blksize_t
|
||||
TYPEDEF: longword blkcnt_t
|
||||
TYPEDEF: longlong quad_t
|
||||
TYPEDEF: ulonglong dev_t
|
||||
TYPEDEF: uint gid_t
|
||||
TYPEDEF: uint in_addr_t
|
||||
TYPEDEF: uint ino_t
|
||||
TYPEDEF: ulong ino_t
|
||||
TYPEDEF: int pid_t
|
||||
TYPEDEF: uint socklen_t
|
||||
TYPEDEF: uint time_t
|
||||
TYPEDEF: uint uid_t
|
||||
TYPEDEF: ulong size_t
|
||||
TYPEDEF: ulong u_long
|
||||
TYPEDEF: ushort mode_t
|
||||
TYPEDEF: ushort nlink_t
|
||||
TYPEDEF: uint mode_t
|
||||
TYPEDEF: uword nlink_t
|
||||
TYPEDEF: void* caddr_t
|
||||
|
||||
TYPEDEF: ulong off_t
|
||||
|
@ -226,3 +233,4 @@ FUNCTION: ssize_t write ( int fd, void* buf, size_t nbytes ) ;
|
|||
{ [ solaris? ] [ "unix.solaris" require ] }
|
||||
{ [ t ] [ ] }
|
||||
} cond
|
||||
|
||||
|
|
|
@ -14,7 +14,7 @@ SYMBOL: cgi-root
|
|||
[
|
||||
"CGI/1.0" "GATEWAY_INTERFACE" set
|
||||
"HTTP/1.0" "SERVER_PROTOCOL" set
|
||||
"Factor " version append "SERVER_SOFTWARE" set
|
||||
"Factor" "SERVER_SOFTWARE" set
|
||||
|
||||
dup "PATH_TRANSLATED" set
|
||||
"SCRIPT_FILENAME" set
|
||||
|
|
|
@ -3,7 +3,7 @@
|
|||
USING: calendar html io io.files kernel math math.parser
|
||||
http.server.responders http.server.templating namespaces parser
|
||||
sequences strings assocs hashtables debugger http.mime sorting
|
||||
html.elements logging ;
|
||||
html.elements logging calendar.format ;
|
||||
IN: webapps.file
|
||||
|
||||
SYMBOL: doc-root
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
USING: calendar furnace furnace.validator io.files kernel
|
||||
namespaces sequences http.server.responders html math.parser rss
|
||||
xml.writer xmode.code2html math ;
|
||||
xml.writer xmode.code2html math calendar.format ;
|
||||
IN: webapps.pastebin
|
||||
|
||||
TUPLE: pastebin pastes ;
|
||||
|
|
|
@ -2,7 +2,7 @@ USING: sequences rss arrays concurrency.combinators kernel
|
|||
sorting html.elements io assocs namespaces math threads vocabs
|
||||
html furnace http.server.templating calendar math.parser
|
||||
splitting continuations debugger system http.server.responders
|
||||
xml.writer prettyprint logging ;
|
||||
xml.writer prettyprint logging calendar.format ;
|
||||
IN: webapps.planet
|
||||
|
||||
: print-posting-summary ( posting -- )
|
||||
|
|
|
@ -23,7 +23,7 @@ IN: windows.time
|
|||
|
||||
: timestamp>windows-time ( timestamp -- n )
|
||||
#! 64bit number representing # of nanoseconds since Jan 1, 1601 (UTC)
|
||||
>gmt windows-1601 timestamp- >bignum 10000000 * ;
|
||||
>gmt windows-1601 (time-) 10000000 * >integer ;
|
||||
|
||||
: windows-time>FILETIME ( n -- FILETIME )
|
||||
"FILETIME" <c-object>
|
||||
|
|
|
@ -3,7 +3,8 @@
|
|||
IN: xml-rpc
|
||||
USING: kernel xml arrays math generic http.client combinators
|
||||
hashtables namespaces io base64 sequences strings calendar
|
||||
xml.data xml.writer xml.utilities assocs math.parser debugger ;
|
||||
xml.data xml.writer xml.utilities assocs math.parser debugger
|
||||
calendar.format ;
|
||||
|
||||
! * Sending RPC requests
|
||||
! TODO: time
|
||||
|
|
Loading…
Reference in New Issue