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

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

db4
Daniel Ehrenberg 2009-01-08 22:20:07 -06:00
parent ad53cb8635 527fa0e484
commit 43c18cd7fa
14 changed files with 227 additions and 72 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
basis/combinators/smart/authors.txt Normal file
View File

@ -0,0 +1 @@
Doug Coleman

91
basis/combinators/smart/smart-docs.factor Normal file
View File

@ -0,0 +1,91 @@
! Copyright (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: help.markup help.syntax kernel quotations math sequences
multiline ;
IN: combinators.smart
HELP: input<sequence
{ $values
{ "quot" quotation }
{ "newquot" quotation }
}
{ $description "Infers the number of inputs, " { $snippet "n" } ", to " { $snippet "quot" } " and calls the " { $snippet "quot" } " with the first " { $snippet "n" } " values from a sequence." }
{ $examples
{ $example
"USING: combinators.smart math prettyprint ;"
"{ 1 2 3 } [ + + ] input<sequence ."
"6"
}
} ;
HELP: output>array
{ $values
{ "quot" quotation }
{ "newquot" quotation }
}
{ $description "Infers the number or outputs from the quotation and constructs an array from those outputs." }
{ $examples
{ $example
<" USING: combinators combinators.smart math prettyprint ;
9 [
{ [ 1- ] [ 1+ ] [ sq ] } cleave
] output>array .">
"{ 8 10 81 }"
}
} ;
HELP: output>sequence
{ $values
{ "quot" quotation } { "exemplar" "an exemplar" }
{ "newquot" quotation }
}
{ $description "Infers the number of outputs from the quotation and constructs a new sequence from those objects of the same type as the exemplar." }
{ $examples
{ $example
"USING: combinators.smart kernel math prettyprint ;"
"4 [ [ 1 + ] [ 2 + ] [ 3 + ] tri ] V{ } output>sequence ."
"V{ 5 6 7 }"
}
} ;
HELP: reduce-output
{ $values
{ "quot" quotation } { "operation" quotation }
{ "newquot" quotation }
}
{ $description "Infers the number of outputs from " { $snippet "quot" } " and reduces them using " { $snippet "operation" } ". The identity for the " { $link reduce } " operation is the first output." }
{ $examples
{ $example
"USING: combinators.smart kernel math prettyprint ;"
"3 [ [ 4 * ] [ 4 / ] [ 4 - ] tri ] [ * ] reduce-output ."
"-9"
}
} ;
HELP: sum-outputs
{ $values
{ "quot" quotation }
{ "n" integer }
}
{ $description "Infers the number of outputs from " { $snippet "quot" } " and returns their sum." }
{ $examples
{ $example
"USING: combinators.smart kernel math prettyprint ;"
"10 [ [ 1- ] [ 1+ ] bi ] sum-outputs ."
"20"
}
} ;
ARTICLE: "combinators.smart" "Smart combinators"
"The " { $vocab-link "combinators.smart" } " vocabulary implements " { $emphasis "smart combinators" } ". A smart combinator is one whose behavior depends on the static stack effect of an input quotation." $nl
"Smart inputs from a sequence:"
{ $subsection input<sequence }
"Smart outputs to a sequence:"
{ $subsection output>sequence }
{ $subsection output>array }
"Reducing the output of a quotation:"
{ $subsection reduce-output }
"Summing the output of a quotation:"
{ $subsection sum-outputs } ;
ABOUT: "combinators.smart"

21
basis/combinators/smart/smart-tests.factor Normal file
View File

@ -0,0 +1,21 @@
! Copyright (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: tools.test combinators.smart math kernel ;
IN: combinators.smart.tests
: test-bi ( -- 9 11 )
10 [ 1- ] [ 1+ ] bi ;
[ [ test-bi ] output>array ] must-infer
[ { 9 11 } ] [ [ test-bi ] output>array ] unit-test
[ { 9 11 } [ + ] input<sequence ] must-infer
[ 20 ] [ { 9 11 } [ + ] input<sequence ] unit-test
[ 6 ] [ [ 1 2 3 ] [ + ] reduce-output ] unit-test
[ [ 1 2 3 ] [ + ] reduce-output ] must-infer
[ 6 ] [ [ 1 2 3 ] sum-outputs ] unit-test

22
basis/combinators/smart/smart.factor Normal file
View File

@ -0,0 +1,22 @@
! Copyright (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors fry generalizations kernel macros math.order
stack-checker math ;
IN: combinators.smart
MACRO: output>sequence ( quot exemplar -- newquot )
[ dup infer out>> ] dip
'[ @ _ _ nsequence ] ;
: output>array ( quot -- newquot )
{ } output>sequence ; inline
MACRO: input<sequence ( quot -- newquot )
[ infer in>> ] keep
'[ _ firstn @ ] ;
MACRO: reduce-output ( quot operation -- newquot )
[ dup infer out>> 1 [-] ] dip n*quot compose ;
: sum-outputs ( quot -- n )
[ + ] reduce-output ; inline

8
basis/io/files/info/unix/unix-docs.factor
View File

@ -22,11 +22,11 @@ HELP: file-permissions
{ "n" integer } } { "n" integer } }
{ $description "Returns the Unix file permissions for a given file." } ; { $description "Returns the Unix file permissions for a given file." } ;
HELP: file-username HELP: file-user-name
{ $values { $values
{ "path" "a pathname string" } { "path" "a pathname string" }
{ "string" string } } { "string" string } }
{ $description "Returns the username for a given file." } ; { $description "Returns the user-name for a given file." } ;
HELP: file-user-id HELP: file-user-id
{ $values { $values
@ -110,7 +110,7 @@ HELP: set-file-times
HELP: set-file-user HELP: set-file-user
{ $values { $values
{ "path" "a pathname string" } { "string/id" "a string or a user id" } } { "path" "a pathname string" } { "string/id" "a string or a user id" } }
{ $description "Sets a file's user id from the given user id or username." } ; { $description "Sets a file's user id from the given user id or user-name." } ;
HELP: set-file-modified-time HELP: set-file-modified-time
{ $values { $values
@ -258,7 +258,7 @@ ARTICLE: "unix-file-timestamps" "Unix file timestamps"
ARTICLE: "unix-file-ids" "Unix file user and group ids" ARTICLE: "unix-file-ids" "Unix file user and group ids"
"Reading file user data:" "Reading file user data:"
{ $subsection file-user-id } { $subsection file-user-id }
{ $subsection file-username } { $subsection file-user-name }
"Setting file user data:" "Setting file user data:"
{ $subsection set-file-user } { $subsection set-file-user }
"Reading file group data:" "Reading file group data:"

4
basis/io/files/info/unix/unix.factor
View File

@ -243,8 +243,8 @@ M: string set-file-group ( path string -- )
: file-user-id ( path -- uid ) : file-user-id ( path -- uid )
normalize-path file-info uid>> ; normalize-path file-info uid>> ;
: file-username ( path -- string ) : file-user-name ( path -- string )
file-user-id username ; file-user-id user-name ;
: file-group-id ( path -- gid ) : file-group-id ( path -- gid )
normalize-path file-info gid>> ; normalize-path file-info gid>> ;

4
basis/math/bitwise/bitwise-tests.factor
View File

@ -32,3 +32,7 @@ IN: math.bitwise.tests
[ 8 ] [ 0 3 toggle-bit ] unit-test [ 8 ] [ 0 3 toggle-bit ] unit-test
[ 0 ] [ 8 3 toggle-bit ] unit-test [ 0 ] [ 8 3 toggle-bit ] unit-test
[ 4 ] [ BIN: 1010101 bit-count ] unit-test
[ 0 ] [ BIN: 0 bit-count ] unit-test
[ 1 ] [ BIN: 1 bit-count ] unit-test

16
basis/math/bitwise/bitwise.factor
View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: arrays kernel math math.functions sequences USING: arrays kernel math math.functions sequences
sequences.private words namespaces macros hints sequences.private words namespaces macros hints
combinators fry io.binary ; combinators fry io.binary combinators.smart ;
IN: math.bitwise IN: math.bitwise
! utilities ! utilities
@ -76,12 +76,14 @@ DEFER: byte-bit-count
GENERIC: (bit-count) ( x -- n ) GENERIC: (bit-count) ( x -- n )
M: fixnum (bit-count) M: fixnum (bit-count)
{ [
[ byte-bit-count ] {
[ -8 shift byte-bit-count ] [ byte-bit-count ]
[ -16 shift byte-bit-count ] [ -8 shift byte-bit-count ]
[ -24 shift byte-bit-count ] [ -16 shift byte-bit-count ]
} cleave + + + ; [ -24 shift byte-bit-count ]
} cleave
] sum-outputs ;
M: bignum (bit-count) M: bignum (bit-count)
dup 0 = [ drop 0 ] [ dup 0 = [ drop 0 ] [

16
basis/tools/cocoa/cocoa.factor
View File

@ -1,16 +1,18 @@
! Copyright (C) 2008 Slava Pestov. ! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: arrays cocoa.messages cocoa.runtime combinators USING: arrays cocoa.messages cocoa.runtime combinators
prettyprint ; prettyprint combinators.smart ;
IN: tools.cocoa IN: tools.cocoa
: method. ( method -- ) : method. ( method -- )
{ [
[ method_getName sel_getName ] {
[ method-return-type ] [ method_getName sel_getName ]
[ method-arg-types ] [ method-return-type ]
[ method_getImplementation ] [ method-arg-types ]
} cleave 4array . ; [ method_getImplementation ]
} cleave
] output>array . ;
: methods. ( class -- ) : methods. ( class -- )
[ method. ] each-method-in-class ; [ method. ] each-method-in-class ;

50
basis/tools/files/unix/unix.factor
View File

@ -3,12 +3,9 @@
USING: accessors combinators kernel system unicode.case io.files USING: accessors combinators kernel system unicode.case io.files
io.files.info io.files.info.unix tools.files generalizations io.files.info io.files.info.unix tools.files generalizations
strings arrays sequences math.parser unix.groups unix.users strings arrays sequences math.parser unix.groups unix.users
tools.files.private unix.stat math fry macros ; tools.files.private unix.stat math fry macros combinators.smart ;
IN: tools.files.unix IN: tools.files.unix
MACRO: cleave>array ( array -- quot )
dup length '[ _ cleave _ narray ] ;
<PRIVATE <PRIVATE
: unix-execute>string ( str bools -- str' ) : unix-execute>string ( str bools -- str' )
@ -20,18 +17,20 @@ MACRO: cleave>array ( array -- quot )
} case ; } case ;
: permissions-string ( permissions -- str ) : permissions-string ( permissions -- str )
{ [
[ type>> file-type>ch 1string ] {
[ user-read? read>string ] [ type>> file-type>ch 1string ]
[ user-write? write>string ] [ user-read? read>string ]
[ [ uid? ] [ user-execute? ] bi 2array "s" unix-execute>string ] [ user-write? write>string ]
[ group-read? read>string ] [ [ uid? ] [ user-execute? ] bi 2array "s" unix-execute>string ]
[ group-write? write>string ] [ group-read? read>string ]
[ [ gid? ] [ group-execute? ] bi 2array "s" unix-execute>string ] [ group-write? write>string ]
[ other-read? read>string ] [ [ gid? ] [ group-execute? ] bi 2array "s" unix-execute>string ]
[ other-write? write>string ] [ other-read? read>string ]
[ [ sticky? ] [ other-execute? ] bi 2array "t" unix-execute>string ] [ other-write? write>string ]
} cleave>array concat ; [ [ sticky? ] [ other-execute? ] bi 2array "t" unix-execute>string ]
} cleave
] output>array concat ;
: mode>symbol ( mode -- ch ) : mode>symbol ( mode -- ch )
S_IFMT bitand S_IFMT bitand
@ -48,15 +47,16 @@ MACRO: cleave>array ( array -- quot )
M: unix (directory.) ( path -- lines ) M: unix (directory.) ( path -- lines )
[ [ [ [
[ [
dup file-info dup file-info [
{ {
[ permissions-string ] [ permissions-string ]
[ nlink>> number>string 3 CHAR: \s pad-left ] [ nlink>> number>string 3 CHAR: \s pad-left ]
[ uid>> user-name ] [ uid>> user-name ]
[ gid>> group-name ] [ gid>> group-name ]
[ size>> number>string 15 CHAR: \s pad-left ] [ size>> number>string 15 CHAR: \s pad-left ]
[ modified>> ls-timestamp ] [ modified>> ls-timestamp ]
} cleave>array swap suffix " " join } cleave
] output>array swap suffix " " join
] map ] map
] with-group-cache ] with-user-cache ; ] with-group-cache ] with-user-cache ;

16
basis/ui/gadgets/buttons/buttons.factor
View File

@ -6,7 +6,7 @@ classes.tuple opengl opengl.gl math.vectors ui.commands ui.gadgets
ui.gadgets.borders ui.gadgets.labels ui.gadgets.theme ui.gadgets.borders ui.gadgets.labels ui.gadgets.theme
ui.gadgets.tracks ui.gadgets.packs ui.gadgets.worlds ui.gestures ui.gadgets.tracks ui.gadgets.packs ui.gadgets.worlds ui.gestures
ui.render math.geometry.rect locals alien.c-types ui.render math.geometry.rect locals alien.c-types
specialized-arrays.float fry ; specialized-arrays.float fry combinators.smart ;
IN: ui.gadgets.buttons IN: ui.gadgets.buttons
TUPLE: button < border pressed? selected? quot ; TUPLE: button < border pressed? selected? quot ;
@ -111,12 +111,14 @@ TUPLE: checkmark-paint < caching-pen color last-vertices ;
<PRIVATE <PRIVATE
: checkmark-points ( dim -- points ) : checkmark-points ( dim -- points )
{ [
[ { 0 0 } v* { 0.5 0.5 } v+ ] {
[ { 1 1 } v* { 0.5 0.5 } v+ ] [ { 0 0 } v* { 0.5 0.5 } v+ ]
[ { 1 0 } v* { -0.3 0.5 } v+ ] [ { 1 1 } v* { 0.5 0.5 } v+ ]
[ { 0 1 } v* { -0.3 0.5 } v+ ] [ { 1 0 } v* { -0.3 0.5 } v+ ]
} cleave 4array ; [ { 0 1 } v* { -0.3 0.5 } v+ ]
} cleave
] output>array ;
: checkmark-vertices ( dim -- vertices ) : checkmark-vertices ( dim -- vertices )
checkmark-points concat >float-array ; checkmark-points concat >float-array ;

22
extra/geo-ip/geo-ip.factor
View File

@ -4,7 +4,7 @@ USING: kernel sequences io.files io.files.temp io.launcher
io.pathnames io.encodings.ascii io.streams.string http.client io.pathnames io.encodings.ascii io.streams.string http.client
generalizations combinators math.parser math.vectors generalizations combinators math.parser math.vectors
math.intervals interval-maps memoize csv accessors assocs math.intervals interval-maps memoize csv accessors assocs
strings math splitting grouping arrays ; strings math splitting grouping arrays combinators.smart ;
IN: geo-ip IN: geo-ip
: db-path ( -- path ) "IpToCountry.csv" temp-file ; : db-path ( -- path ) "IpToCountry.csv" temp-file ;
@ -20,15 +20,17 @@ IN: geo-ip
TUPLE: ip-entry from to registry assigned city cntry country ; TUPLE: ip-entry from to registry assigned city cntry country ;
: parse-ip-entry ( row -- ip-entry ) : parse-ip-entry ( row -- ip-entry )
7 firstn { [
[ string>number ] {
[ string>number ] [ string>number ]
[ ] [ string>number ]
[ ] [ ]
[ ] [ ]
[ ] [ ]
[ ] [ ]
} spread ip-entry boa ; [ ]
} spread
] input<sequence ip-entry boa ;
MEMO: ip-db ( -- seq ) MEMO: ip-db ( -- seq )
download-db ascii file-lines download-db ascii file-lines

6
extra/usa-cities/usa-cities-tests.factor Normal file
View File

@ -0,0 +1,6 @@
! Copyright (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel tools.test usa-cities ;
IN: usa-cities.tests
[ t ] [ 55406 find-zip-code name>> "Minneapolis" = ] unit-test

22
extra/usa-cities/usa-cities.factor
View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: io.files io.encodings.ascii sequences generalizations USING: io.files io.encodings.ascii sequences generalizations
math.parser combinators kernel memoize csv summary math.parser combinators kernel memoize csv summary
words accessors math.order binary-search ; words accessors math.order binary-search combinators.smart ;
IN: usa-cities IN: usa-cities
SINGLETONS: AK AL AR AS AZ CA CO CT DC DE FL GA HI IA ID IL IN SINGLETONS: AK AL AR AS AZ CA CO CT DC DE FL GA HI IA ID IL IN
@ -30,15 +30,17 @@ first-zip name state latitude longitude gmt-offset dst-offset ;
MEMO: cities ( -- seq ) MEMO: cities ( -- seq )
"resource:extra/usa-cities/zipcode.csv" ascii <file-reader> "resource:extra/usa-cities/zipcode.csv" ascii <file-reader>
csv rest-slice [ csv rest-slice [
7 firstn { [
[ string>number ] {
[ ] [ string>number ]
[ string>state ] [ ]
[ string>number ] [ string>state ]
[ string>number ] [ string>number ]
[ string>number ] [ string>number ]
[ string>number ] [ string>number ]
} spread city boa [ string>number ]
} spread
] input<sequence city boa
] map ; ] map ;
MEMO: cities-named ( name -- cities ) MEMO: cities-named ( name -- cities )