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 [ ] (call) unimplemented ;
[ total-failure-2 ] must-fail [ 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 [ 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 { 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 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 [ { 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 [ [ dup 2^ 2array ] 5 napply ] must-infer

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

@ -36,8 +36,6 @@ MACRO: napply ( n -- )
'[ , ntuck , nslip ] ] '[ , ntuck , nslip ] ]
map concat >quotation [ call ] append ; map concat >quotation [ call ] append ;
: 3apply ( obj obj obj quot -- ) 3 napply ; inline
: 2with ( param1 param2 obj quot -- obj curry ) : 2with ( param1 param2 obj quot -- obj curry )
with with ; inline 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 io.windows kernel math splitting
windows windows.kernel32 windows.time calendar combinators windows windows.kernel32 windows.time calendar combinators
math.functions sequences namespaces words symbols system math.functions sequences namespaces words symbols system
combinators.lib io.ports destructors accessors io.ports destructors accessors
math.bitfields math.bitfields.lib ; math.bitfields math.bitfields.lib ;
IN: io.windows.files IN: io.windows.files
@ -216,11 +216,11 @@ M: winnt link-info ( path -- info )
"FILETIME" <c-object> "FILETIME" <c-object>
"FILETIME" <c-object> "FILETIME" <c-object>
[ GetFileTime win32-error=0/f ] 3keep [ GetFileTime win32-error=0/f ] 3keep
[ FILETIME>timestamp >local-time ] 3apply [ FILETIME>timestamp >local-time ] tri@
] with-destructors ; ] with-destructors ;
: (set-file-times) ( handle timestamp/f timestamp/f timestamp/f -- ) : (set-file-times) ( handle timestamp/f timestamp/f timestamp/f -- )
[ timestamp>FILETIME ] 3apply [ timestamp>FILETIME ] tri@
SetFileTime win32-error=0/f ; SetFileTime win32-error=0/f ;
: set-file-times ( path timestamp/f timestamp/f timestamp/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 io.windows io.windows.files libc kernel math namespaces
sequences threads classes.tuple.lib windows windows.errors sequences threads classes.tuple.lib windows windows.errors
windows.kernel32 strings splitting io.files windows.kernel32 strings splitting io.files
io.buffers qualified ascii combinators.lib system io.buffers qualified ascii system
accessors locals ; accessors locals ;
QUALIFIED: windows.winsock QUALIFIED: windows.winsock
IN: io.windows.nt.backend IN: io.windows.nt.backend

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

@ -31,11 +31,11 @@ IN: project-euler.032
: 1and4 ( n -- ? ) : 1and4 ( n -- ? )
number>string 1 cut-slice 4 cut-slice number>string 1 cut-slice 4 cut-slice
[ string>number ] 3apply [ * ] dip = ; [ string>number ] tri@ [ * ] dip = ;
: 2and3 ( n -- ? ) : 2and3 ( n -- ? )
number>string 2 cut-slice 3 cut-slice number>string 2 cut-slice 3 cut-slice
[ string>number ] 3apply [ * ] dip = ; [ string>number ] tri@ [ * ] dip = ;
: valid? ( n -- ? ) : valid? ( n -- ? )
dup 1and4 swap 2and3 or ; dup 1and4 swap 2and3 or ;
@ -65,7 +65,7 @@ PRIVATE>
! multiplicand/multiplier/product ! multiplicand/multiplier/product
: mmp ( pair -- n ) : mmp ( pair -- n )
first2 2dup * [ number>string ] 3apply 3append string>number ; first2 2dup * [ number>string ] tri@ 3append string>number ;
PRIVATE> 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 max-p < [
dup sum adjust-p-count dup sum adjust-p-count
[ u-transform ] [ a-transform ] [ d-transform ] tri [ u-transform ] [ a-transform ] [ d-transform ] tri
[ (count-perimeters) ] 3apply [ (count-perimeters) ] tri@
] [ ] [
drop drop
] if ; ] 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 max-p < [
dup sum adjust-p-count dup sum adjust-p-count
[ u-transform ] [ a-transform ] [ d-transform ] tri [ u-transform ] [ a-transform ] [ d-transform ] tri
[ (count-perimeters) ] 3apply [ (count-perimeters) ] tri@
] [ ] [
drop drop
] if ; ] if ;

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

@ -20,7 +20,6 @@ IN: reports.noise
{ 2swap 3 } { 2swap 3 }
{ 2with 2 } { 2with 2 }
{ 2with* 3 } { 2with* 3 }
{ 3apply 1/2 }
{ 3curry 2 } { 3curry 2 }
{ 3drop 1 } { 3drop 1 }
{ 3dup 2 } { 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 ; : delete-arc ( arc -- ) delete-tuples ;
: create-arc ( subject object relation -- ) : create-arc ( subject object relation -- )
[ id>> ] 3apply <arc> insert-tuple ; [ id>> ] tri@ <arc> insert-tuple ;
: nodes>arc ( subject object relation -- arc ) : nodes>arc ( subject object relation -- arc )
[ [ id>> ] [ f ] if* ] 3apply <arc> ; [ [ id>> ] [ f ] if* ] tri@ <arc> ;
: select-arcs ( subject object relation -- arcs ) : select-arcs ( subject object relation -- arcs )
nodes>arc select-tuples ; 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 parser lexer splitting grouping sequences.lib sequences namespaces
assocs quotations shuffle accessors words macros alien.syntax assocs quotations shuffle accessors words macros alien.syntax
fry arrays ; 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 windows.com.syntax.private windows.com continuations kernel
sequences.lib namespaces windows.ole32 libc vocabs sequences.lib namespaces windows.ole32 libc vocabs
assocs accessors arrays sequences quotations combinators assocs accessors arrays sequences quotations combinators
math combinators.lib words compiler.units destructors fry math words compiler.units destructors fry
math.parser ; math.parser combinators.lib ;
IN: windows.com.wrapper IN: windows.com.wrapper
TUPLE: com-wrapper vtbls disposed ; TUPLE: com-wrapper vtbls disposed ;
@ -84,7 +84,7 @@ unless
swap append ; swap append ;
: compile-alien-callback ( word return parameters abi quot -- alien ) : compile-alien-callback ( word return parameters abi quot -- alien )
[ alien-callback ] 4 ncurry '[ , , , , alien-callback ]
[ [ (( -- alien )) define-declared ] pick slip ] [ [ (( -- alien )) define-declared ] pick slip ]
with-compilation-unit with-compilation-unit
execute ; 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 USING: alien alien.syntax alien.c-types alien.strings math
kernel sequences windows windows.types combinators.lib kernel sequences windows windows.types
math.order ; math.order ;
IN: windows.ole32 IN: windows.ole32
@ -132,5 +132,5 @@ FUNCTION: void ReleaseStgMedium ( LPSTGMEDIUM pmedium ) ;
utf16n string>alien "GUID" <c-object> [ CLSIDFromString ole32-error ] keep ; utf16n string>alien "GUID" <c-object> [ CLSIDFromString ole32-error ] keep ;
: guid>string ( guid -- string ) : guid>string ( guid -- string )
GUID-STRING-LENGTH 1+ [ "ushort" <c-array> ] keep GUID-STRING-LENGTH 1+ [ "ushort" <c-array> ] keep
[ StringFromGUID2 drop ] { 2 } multikeep utf16n alien>string ; [ StringFromGUID2 drop ] 2keep drop utf16n alien>string ;