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

combinators.lib 3apply is kernel's tri@; remove and update usages

db4
U-SLAVA-DFB8FF805\Slava 2008-06-27 02:17:19 -05:00
parent 8930162251
commit 358c09d204
13 changed files with 22 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
core/kernel/kernel-tests.factor
View File

@ -117,3 +117,8 @@ IN: kernel.tests
: total-failure-2 [ ] (call) unimplemented ;
[ total-failure-2 ] must-fail
! From combinators.lib
[ 1 1 2 2 3 3 ] [ 1 2 3 [ dup ] tri@ ] unit-test
[ 1 4 9 ] [ 1 2 3 [ sq ] tri@ ] unit-test
[ [ sq ] tri@ ] must-infer

3
extra/combinators/lib/lib-tests.factor
View File

@ -10,9 +10,6 @@ IN: combinators.lib.tests
[ 1 2 3 4 5 [ drop drop drop drop drop 2 ] 5 nkeep ] must-infer
{ 2 1 2 3 4 5 } [ 1 2 3 4 5 [ drop drop drop drop drop 2 ] 5 nkeep ] unit-test
[ [ 1 2 3 + ] ] [ 1 2 3 [ + ] 3 ncurry ] unit-test
[ 1 1 2 2 3 3 ] [ 1 2 3 [ dup ] 3apply ] unit-test
[ 1 4 9 ] [ 1 2 3 [ sq ] 3apply ] unit-test
[ [ sq ] 3apply ] must-infer
[ { 1 2 } { 2 4 } { 3 8 } { 4 16 } { 5 32 } ] [ 1 2 3 4 5 [ dup 2^ 2array ] 5 napply ] unit-test
[ [ dup 2^ 2array ] 5 napply ] must-infer

2
extra/combinators/lib/lib.factor
View File

@ -36,8 +36,6 @@ MACRO: napply ( n -- )
'[ , ntuck , nslip ] ]
map concat >quotation [ call ] append ;
: 3apply ( obj obj obj quot -- ) 3 napply ; inline
: 2with ( param1 param2 obj quot -- obj curry )
with with ; inline

6
extra/io/windows/files/files.factor
View File

@ -4,7 +4,7 @@ USING: alien.c-types io.binary io.backend io.files io.buffers
io.windows kernel math splitting
windows windows.kernel32 windows.time calendar combinators
math.functions sequences namespaces words symbols system
combinators.lib io.ports destructors accessors
io.ports destructors accessors
math.bitfields math.bitfields.lib ;
IN: io.windows.files
@ -216,11 +216,11 @@ M: winnt link-info ( path -- info )
"FILETIME" <c-object>
"FILETIME" <c-object>
[ GetFileTime win32-error=0/f ] 3keep
[ FILETIME>timestamp >local-time ] 3apply
[ FILETIME>timestamp >local-time ] tri@
] with-destructors ;
: (set-file-times) ( handle timestamp/f timestamp/f timestamp/f -- )
[ timestamp>FILETIME ] 3apply
[ timestamp>FILETIME ] tri@
SetFileTime win32-error=0/f ;
: set-file-times ( path timestamp/f timestamp/f timestamp/f -- )

2
extra/io/windows/nt/backend/backend.factor
View File

@ -3,7 +3,7 @@ continuations destructors io io.backend io.ports io.timeouts
io.windows io.windows.files libc kernel math namespaces
sequences threads classes.tuple.lib windows windows.errors
windows.kernel32 strings splitting io.files
io.buffers qualified ascii combinators.lib system
io.buffers qualified ascii system
accessors locals ;
QUALIFIED: windows.winsock
IN: io.windows.nt.backend

6
extra/project-euler/032/032.factor
View File

@ -31,11 +31,11 @@ IN: project-euler.032
: 1and4 ( n -- ? )
number>string 1 cut-slice 4 cut-slice
[ string>number ] 3apply [ * ] dip = ;
[ string>number ] tri@ [ * ] dip = ;
: 2and3 ( n -- ? )
number>string 2 cut-slice 3 cut-slice
[ string>number ] 3apply [ * ] dip = ;
[ string>number ] tri@ [ * ] dip = ;
: valid? ( n -- ? )
dup 1and4 swap 2and3 or ;
@ -65,7 +65,7 @@ PRIVATE>
! multiplicand/multiplier/product
: mmp ( pair -- n )
first2 2dup * [ number>string ] 3apply 3append string>number ;
first2 2dup * [ number>string ] tri@ 3append string>number ;
PRIVATE>

2
extra/project-euler/039/039.factor Normal file → Executable file
View File

@ -44,7 +44,7 @@ SYMBOL: p-count
dup sum max-p < [
dup sum adjust-p-count
[ u-transform ] [ a-transform ] [ d-transform ] tri
[ (count-perimeters) ] 3apply
[ (count-perimeters) ] tri@
] [
drop
] if ;

2
extra/project-euler/075/075.factor Normal file → Executable file
View File

@ -57,7 +57,7 @@ SYMBOL: p-count
dup sum max-p < [
dup sum adjust-p-count
[ u-transform ] [ a-transform ] [ d-transform ] tri
[ (count-perimeters) ] 3apply
[ (count-perimeters) ] tri@
] [
drop
] if ;

1
extra/reports/noise/noise.factor
View File

@ -20,7 +20,6 @@ IN: reports.noise
{ 2swap 3 }
{ 2with 2 }
{ 2with* 3 }
{ 3apply 1/2 }
{ 3curry 2 }
{ 3drop 1 }
{ 3dup 2 }

4
extra/semantic-db/semantic-db.factor
View File

@ -36,10 +36,10 @@ TUPLE: arc id subject object relation ;
: delete-arc ( arc -- ) delete-tuples ;
: create-arc ( subject object relation -- )
[ id>> ] 3apply <arc> insert-tuple ;
[ id>> ] tri@ <arc> insert-tuple ;
: nodes>arc ( subject object relation -- arc )
[ [ id>> ] [ f ] if* ] 3apply <arc> ;
[ [ id>> ] [ f ] if* ] tri@ <arc> ;
: select-arcs ( subject object relation -- arcs )
nodes>arc select-tuples ;

2
extra/windows/com/syntax/syntax.factor
View File

@ -1,4 +1,4 @@
USING: alien alien.c-types effects kernel windows.ole32 combinators.lib
USING: alien alien.c-types effects kernel windows.ole32
parser lexer splitting grouping sequences.lib sequences namespaces
assocs quotations shuffle accessors words macros alien.syntax
fry arrays ;

6
extra/windows/com/wrapper/wrapper.factor
View File

@ -2,8 +2,8 @@ USING: alien alien.c-types windows.com.syntax
windows.com.syntax.private windows.com continuations kernel
sequences.lib namespaces windows.ole32 libc vocabs
assocs accessors arrays sequences quotations combinators
math combinators.lib words compiler.units destructors fry
math.parser ;
math words compiler.units destructors fry
math.parser combinators.lib ;
IN: windows.com.wrapper
TUPLE: com-wrapper vtbls disposed ;
@ -84,7 +84,7 @@ unless
swap append ;
: compile-alien-callback ( word return parameters abi quot -- alien )
[ alien-callback ] 4 ncurry
'[ , , , , alien-callback ]
[ [ (( -- alien )) define-declared ] pick slip ]
with-compilation-unit
execute ;

4
extra/windows/ole32/ole32.factor Normal file → Executable file
View File

@ -1,5 +1,5 @@
USING: alien alien.syntax alien.c-types alien.strings math
kernel sequences windows windows.types combinators.lib
kernel sequences windows windows.types
math.order ;
IN: windows.ole32
@ -132,5 +132,5 @@ FUNCTION: void ReleaseStgMedium ( LPSTGMEDIUM pmedium ) ;
utf16n string>alien "GUID" <c-object> [ CLSIDFromString ole32-error ] keep ;
: guid>string ( guid -- string )
GUID-STRING-LENGTH 1+ [ "ushort" <c-array> ] keep
[ StringFromGUID2 drop ] { 2 } multikeep utf16n alien>string ;
[ StringFromGUID2 drop ] 2keep drop utf16n alien>string ;