Merge branches 'master' and 'cleanup' into cleanup
commit
5dcd6b36d4
|
@ -108,14 +108,6 @@ $nl
|
||||||
"If this condition is not satisfied, " { $link "malloc" } " must be used instead."
|
"If this condition is not satisfied, " { $link "malloc" } " must be used instead."
|
||||||
{ $warning "Failure to comply with these requirements can lead to crashes, data corruption, and security exploits." } ;
|
{ $warning "Failure to comply with these requirements can lead to crashes, data corruption, and security exploits." } ;
|
||||||
|
|
||||||
ARTICLE: "c-out-params" "Output parameters in C"
|
|
||||||
"A frequently-occurring idiom in C code is the \"out parameter\". If a C function returns more than one value, the caller passes pointers of the correct type, and the C function writes its return values to those locations."
|
|
||||||
$nl
|
|
||||||
"To wrap Factor data for consumption by the FFI, we use a utility word that constructs a byte array of the correct size and converts the Factor object to a C value stored into that byte array:"
|
|
||||||
{ $subsections <ref> }
|
|
||||||
"You call the out parameter constructor with the required initial value, then pass the byte array to the C function, which receives a pointer to the start of the byte array's data area. The C function then returns, leaving the result in the byte array; you read it back using this word:"
|
|
||||||
{ $subsections deref } ;
|
|
||||||
|
|
||||||
ARTICLE: "c-types.primitives" "Primitive C types"
|
ARTICLE: "c-types.primitives" "Primitive C types"
|
||||||
"The following numerical types are defined in the " { $vocab-link "alien.c-types" } " vocabulary; a " { $snippet "u" } " prefix denotes an unsigned type:"
|
"The following numerical types are defined in the " { $vocab-link "alien.c-types" } " vocabulary; a " { $snippet "u" } " prefix denotes an unsigned type:"
|
||||||
{ $table
|
{ $table
|
||||||
|
|
|
@ -9,19 +9,6 @@ CONSTANT: xyz 123
|
||||||
|
|
||||||
[ 492 ] [ { int xyz } heap-size ] unit-test
|
[ 492 ] [ { int xyz } heap-size ] unit-test
|
||||||
|
|
||||||
[ -1 ] [ -1 char <ref> char deref ] unit-test
|
|
||||||
[ -1 ] [ -1 short <ref> short deref ] unit-test
|
|
||||||
[ -1 ] [ -1 int <ref> int deref ] unit-test
|
|
||||||
|
|
||||||
! I don't care if this throws an error or works, but at least
|
|
||||||
! it should be consistent between platforms
|
|
||||||
[ -1 ] [ -1.0 int <ref> int deref ] unit-test
|
|
||||||
[ -1 ] [ -1.0 long <ref> long deref ] unit-test
|
|
||||||
[ -1 ] [ -1.0 longlong <ref> longlong deref ] unit-test
|
|
||||||
[ 1 ] [ 1.0 uint <ref> uint deref ] unit-test
|
|
||||||
[ 1 ] [ 1.0 ulong <ref> ulong deref ] unit-test
|
|
||||||
[ 1 ] [ 1.0 ulonglong <ref> ulonglong deref ] unit-test
|
|
||||||
|
|
||||||
UNION-STRUCT: foo
|
UNION-STRUCT: foo
|
||||||
{ a int }
|
{ a int }
|
||||||
{ b int } ;
|
{ b int } ;
|
||||||
|
@ -62,14 +49,6 @@ TYPEDEF: int* MyIntArray
|
||||||
|
|
||||||
[ t ] [ void* c-type MyIntArray c-type = ] unit-test
|
[ t ] [ void* c-type MyIntArray c-type = ] unit-test
|
||||||
|
|
||||||
[
|
|
||||||
0 B{ 1 2 3 4 } <displaced-alien> void* <ref>
|
|
||||||
] must-fail
|
|
||||||
|
|
||||||
os windows? cpu x86.64? and [
|
|
||||||
[ -2147467259 ] [ 2147500037 long <ref> long deref ] unit-test
|
|
||||||
] when
|
|
||||||
|
|
||||||
[ 0 ] [ -10 uchar c-type-clamp ] unit-test
|
[ 0 ] [ -10 uchar c-type-clamp ] unit-test
|
||||||
[ 12 ] [ 12 uchar c-type-clamp ] unit-test
|
[ 12 ] [ 12 uchar c-type-clamp ] unit-test
|
||||||
[ -10 ] [ -10 char c-type-clamp ] unit-test
|
[ -10 ] [ -10 char c-type-clamp ] unit-test
|
||||||
|
|
|
@ -468,12 +468,3 @@ M: double-2-rep rep-component-type drop double ;
|
||||||
: c-type-clamp ( value c-type -- value' )
|
: c-type-clamp ( value c-type -- value' )
|
||||||
dup { float double } member-eq?
|
dup { float double } member-eq?
|
||||||
[ drop ] [ c-type-interval clamp ] if ; inline
|
[ drop ] [ c-type-interval clamp ] if ; inline
|
||||||
|
|
||||||
: <ref> ( value c-type -- c-ptr )
|
|
||||||
[ heap-size <byte-array> ] keep
|
|
||||||
'[ 0 _ set-alien-value ] keep ; inline
|
|
||||||
|
|
||||||
: deref ( c-ptr c-type -- value )
|
|
||||||
[ 0 ] dip alien-value ; inline
|
|
||||||
|
|
||||||
: little-endian? ( -- ? ) 1 int <ref> char deref 1 = ; foldable
|
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
USING: alien alien.c-types help.syntax help.markup libc
|
USING: alien alien.c-types help.syntax help.markup libc
|
||||||
kernel.private byte-arrays math strings hashtables alien.syntax
|
kernel.private byte-arrays math strings hashtables alien.syntax
|
||||||
alien.strings sequences io.encodings.string debugger destructors
|
alien.strings sequences io.encodings.string debugger destructors
|
||||||
vocabs.loader classes.struct quotations ;
|
vocabs.loader classes.struct quotations kernel ;
|
||||||
IN: alien.data
|
IN: alien.data
|
||||||
|
|
||||||
HELP: <c-array>
|
HELP: <c-array>
|
||||||
|
@ -10,11 +10,6 @@ HELP: <c-array>
|
||||||
{ $notes "The appropriate specialized array vocabulary must be loaded; otherwise, an error will be thrown. The vocabulary can be loaded with the " { $link require-c-array } " word. See the " { $vocab-link "specialized-arrays" } " vocabulary for details on the underlying sequence type constructed." }
|
{ $notes "The appropriate specialized array vocabulary must be loaded; otherwise, an error will be thrown. The vocabulary can be loaded with the " { $link require-c-array } " word. See the " { $vocab-link "specialized-arrays" } " vocabulary for details on the underlying sequence type constructed." }
|
||||||
{ $errors "Throws an error if the type does not exist, the necessary specialized array vocabulary is not loaded, or the requested size is negative." } ;
|
{ $errors "Throws an error if the type does not exist, the necessary specialized array vocabulary is not loaded, or the requested size is negative." } ;
|
||||||
|
|
||||||
HELP: <c-object>
|
|
||||||
{ $values { "type" "a C type" } { "array" byte-array } }
|
|
||||||
{ $description "Creates a byte array suitable for holding a value with the given C type." }
|
|
||||||
{ $errors "Throws an " { $link no-c-type } " error if the type does not exist." } ;
|
|
||||||
|
|
||||||
HELP: memory>byte-array
|
HELP: memory>byte-array
|
||||||
{ $values { "alien" c-ptr } { "len" "a non-negative integer" } { "byte-array" byte-array } }
|
{ $values { "alien" c-ptr } { "len" "a non-negative integer" } { "byte-array" byte-array } }
|
||||||
{ $description "Reads " { $snippet "len" } " bytes starting from " { $snippet "base" } " and stores them in a new byte array." } ;
|
{ $description "Reads " { $snippet "len" } " bytes starting from " { $snippet "base" } " and stores them in a new byte array." } ;
|
||||||
|
@ -125,6 +120,10 @@ ARTICLE: "c-pointers" "Passing pointers to C functions"
|
||||||
{ $warning
|
{ $warning
|
||||||
"The Factor garbage collector can move byte arrays around, and code passing byte arrays, or objects backed by byte arrays, must obey important guidelines. See " { $link "byte-arrays-gc" } "." } ;
|
"The Factor garbage collector can move byte arrays around, and code passing byte arrays, or objects backed by byte arrays, must obey important guidelines. See " { $link "byte-arrays-gc" } "." } ;
|
||||||
|
|
||||||
|
ARTICLE: "c-boxes" "C value boxes"
|
||||||
|
"Sometimes it is useful to create a byte array storing a single C value, like a struct with a single field. A pair of utility macros exist to make this more convenient:"
|
||||||
|
{ $subsections <ref> deref } ;
|
||||||
|
|
||||||
ARTICLE: "c-data" "Passing data between Factor and C"
|
ARTICLE: "c-data" "Passing data between Factor and C"
|
||||||
"Two defining characteristics of Factor are dynamic typing and automatic memory management, which are somewhat incompatible with the machine-level data model exposed by C. Factor's C library interface defines its own set of C data types, distinct from Factor language types, together with automatic conversion between Factor values and C types. For example, C integer types must be declared and are fixed-width, whereas Factor supports arbitrary-precision integers."
|
"Two defining characteristics of Factor are dynamic typing and automatic memory management, which are somewhat incompatible with the machine-level data model exposed by C. Factor's C library interface defines its own set of C data types, distinct from Factor language types, together with automatic conversion between Factor values and C types. For example, C integer types must be declared and are fixed-width, whereas Factor supports arbitrary-precision integers."
|
||||||
$nl
|
$nl
|
||||||
|
@ -135,13 +134,12 @@ $nl
|
||||||
"malloc"
|
"malloc"
|
||||||
"c-strings"
|
"c-strings"
|
||||||
"c-out-params"
|
"c-out-params"
|
||||||
|
"c-boxes"
|
||||||
}
|
}
|
||||||
"Important guidelines for passing data in byte arrays:"
|
"Important guidelines for passing data in byte arrays:"
|
||||||
{ $subsections "byte-arrays-gc" }
|
{ $subsections "byte-arrays-gc" }
|
||||||
"C-style enumerated types are supported:"
|
"C-style enumerated types are supported:"
|
||||||
{ $subsections "alien.enums" POSTPONE: ENUM: }
|
{ $subsections "alien.enums" }
|
||||||
"C types can be aliased for convenience and consistency with native library documentation:"
|
|
||||||
{ $subsections POSTPONE: TYPEDEF: }
|
|
||||||
"A utility for defining " { $link "destructors" } " for deallocating memory:"
|
"A utility for defining " { $link "destructors" } " for deallocating memory:"
|
||||||
{ $subsections "alien.destructors" }
|
{ $subsections "alien.destructors" }
|
||||||
"C struct and union types can be defined with " { $link POSTPONE: STRUCT: } " and " { $link POSTPONE: UNION: } ". See " { $link "classes.struct" } " for details. For passing arrays to and from C, use the " { $link "specialized-arrays" } " vocabulary." ;
|
"C struct and union types can be defined with " { $link POSTPONE: STRUCT: } " and " { $link POSTPONE: UNION: } ". See " { $link "classes.struct" } " for details. For passing arrays to and from C, use the " { $link "specialized-arrays" } " vocabulary." ;
|
||||||
|
@ -190,3 +188,20 @@ $nl
|
||||||
{ $subsections alien>string }
|
{ $subsections alien>string }
|
||||||
"For example, if a C function returns a " { $link c-string } " but stipulates that the caller must deallocate the memory afterward, you must define the function as returning " { $snippet "char*" } " and call " { $link (free) } " yourself." ;
|
"For example, if a C function returns a " { $link c-string } " but stipulates that the caller must deallocate the memory afterward, you must define the function as returning " { $snippet "char*" } " and call " { $link (free) } " yourself." ;
|
||||||
|
|
||||||
|
HELP: <ref>
|
||||||
|
{ $values { "value" object } { "c-type" "a C type" } { "c-ptr" c-ptr } }
|
||||||
|
{ $description "Creates a new byte array to store a Factor object as a C value." }
|
||||||
|
{ $examples
|
||||||
|
{ $example "USING: alien.c-types alien.data prettyprint sequences ;" "123 int <ref> length ." "4" }
|
||||||
|
} ;
|
||||||
|
|
||||||
|
HELP: deref
|
||||||
|
{ $values { "c-ptr" c-ptr } { "c-type" "a C type" } { "value" object } }
|
||||||
|
{ $description "Loads a C value from a byte array." }
|
||||||
|
{ $examples
|
||||||
|
{ $example "USING: alien.c-types alien.data prettyprint sequences ;" "321 int <ref> int deref ." "321" }
|
||||||
|
} ;
|
||||||
|
|
||||||
|
ARTICLE: "c-out-params" "Output parameters in C"
|
||||||
|
"A frequently-occurring idiom in C code is the \"out parameter\". If a C function returns more than one value, the caller passes pointers of the correct type, and the C function writes its return values to those locations."
|
||||||
|
{ $subsection with-out-parameters } ;
|
||||||
|
|
|
@ -1,9 +1,32 @@
|
||||||
USING: alien alien.c-types alien.data alien.syntax
|
USING: alien alien.data alien.syntax
|
||||||
classes.struct kernel sequences specialized-arrays
|
classes.struct kernel sequences specialized-arrays
|
||||||
specialized-arrays.private tools.test compiler.units vocabs ;
|
specialized-arrays.private tools.test compiler.units vocabs
|
||||||
|
system ;
|
||||||
|
QUALIFIED-WITH: alien.c-types c
|
||||||
IN: alien.data.tests
|
IN: alien.data.tests
|
||||||
|
|
||||||
STRUCT: foo { a int } { b void* } { c bool } ;
|
[ -1 ] [ -1 c:char <ref> c:char deref ] unit-test
|
||||||
|
[ -1 ] [ -1 c:short <ref> c:short deref ] unit-test
|
||||||
|
[ -1 ] [ -1 c:int <ref> c:int deref ] unit-test
|
||||||
|
|
||||||
|
! I don't care if this throws an error or works, but at least
|
||||||
|
! it should be consistent between platforms
|
||||||
|
[ -1 ] [ -1.0 c:int <ref> c:int deref ] unit-test
|
||||||
|
[ -1 ] [ -1.0 c:long <ref> c:long deref ] unit-test
|
||||||
|
[ -1 ] [ -1.0 c:longlong <ref> c:longlong deref ] unit-test
|
||||||
|
[ 1 ] [ 1.0 c:uint <ref> c:uint deref ] unit-test
|
||||||
|
[ 1 ] [ 1.0 c:ulong <ref> c:ulong deref ] unit-test
|
||||||
|
[ 1 ] [ 1.0 c:ulonglong <ref> c:ulonglong deref ] unit-test
|
||||||
|
|
||||||
|
[
|
||||||
|
0 B{ 1 2 3 4 } <displaced-alien> c:void* <ref>
|
||||||
|
] must-fail
|
||||||
|
|
||||||
|
os windows? cpu x86.64? and [
|
||||||
|
[ -2147467259 ] [ 2147500037 c:long <ref> c:long deref ] unit-test
|
||||||
|
] when
|
||||||
|
|
||||||
|
STRUCT: foo { a c:int } { b c:void* } { c c:bool } ;
|
||||||
|
|
||||||
SPECIALIZED-ARRAY: foo
|
SPECIALIZED-ARRAY: foo
|
||||||
|
|
||||||
|
|
|
@ -7,6 +7,15 @@ stack-checker.dependencies combinators.short-circuit ;
|
||||||
QUALIFIED: math
|
QUALIFIED: math
|
||||||
IN: alien.data
|
IN: alien.data
|
||||||
|
|
||||||
|
: <ref> ( value c-type -- c-ptr )
|
||||||
|
[ heap-size <byte-array> ] keep
|
||||||
|
'[ 0 _ set-alien-value ] keep ; inline
|
||||||
|
|
||||||
|
: deref ( c-ptr c-type -- value )
|
||||||
|
[ 0 ] dip alien-value ; inline
|
||||||
|
|
||||||
|
: little-endian? ( -- ? ) 1 int <ref> char deref 1 = ; foldable
|
||||||
|
|
||||||
GENERIC: require-c-array ( c-type -- )
|
GENERIC: require-c-array ( c-type -- )
|
||||||
|
|
||||||
M: array require-c-array first require-c-array ;
|
M: array require-c-array first require-c-array ;
|
||||||
|
@ -44,15 +53,6 @@ M: pointer <c-direct-array>
|
||||||
: malloc-array ( n type -- array )
|
: malloc-array ( n type -- array )
|
||||||
[ heap-size calloc ] [ <c-direct-array> ] 2bi ; inline
|
[ heap-size calloc ] [ <c-direct-array> ] 2bi ; inline
|
||||||
|
|
||||||
: (malloc-array) ( n type -- alien )
|
|
||||||
[ heap-size * malloc ] [ <c-direct-array> ] 2bi ; inline
|
|
||||||
|
|
||||||
: <c-object> ( type -- array )
|
|
||||||
heap-size <byte-array> ; inline
|
|
||||||
|
|
||||||
: (c-object) ( type -- array )
|
|
||||||
heap-size (byte-array) ; inline
|
|
||||||
|
|
||||||
: malloc-byte-array ( byte-array -- alien )
|
: malloc-byte-array ( byte-array -- alien )
|
||||||
binary-object [ nip malloc dup ] 2keep memcpy ;
|
binary-object [ nip malloc dup ] 2keep memcpy ;
|
||||||
|
|
||||||
|
|
|
@ -23,14 +23,6 @@ HELP: number>enum
|
||||||
}
|
}
|
||||||
{ $description "Convert a number to an enum." } ;
|
{ $description "Convert a number to an enum." } ;
|
||||||
|
|
||||||
ARTICLE: "alien.enums" "Enumeration types"
|
|
||||||
"The " { $vocab-link "alien.enums" } " vocab contains the implementation for " { $link POSTPONE: ENUM: } " C types, and provides words for converting between enum singletons and integers. It is possible to dispatch off of members of an enum."
|
|
||||||
$nl
|
|
||||||
"Defining enums at run-time:"
|
|
||||||
{ $subsection define-enum }
|
|
||||||
"Conversions between enums and integers:"
|
|
||||||
{ $subsections enum>number number>enum } ;
|
|
||||||
|
|
||||||
{ POSTPONE: ENUM: define-enum enum>number number>enum } related-words
|
{ POSTPONE: ENUM: define-enum enum>number number>enum } related-words
|
||||||
|
|
||||||
ABOUT: "alien.enums"
|
ABOUT: "alien.enums"
|
||||||
|
|
|
@ -239,7 +239,7 @@ intel-unix-abi fortran-abi [
|
||||||
|
|
||||||
[ [
|
[ [
|
||||||
! [<fortran-result>]
|
! [<fortran-result>]
|
||||||
[ complex-float <c-object> ] 1 ndip
|
[ complex-float heap-size <byte-array> ] 1 ndip
|
||||||
! [fortran-args>c-args]
|
! [fortran-args>c-args]
|
||||||
{ [ { [ ] } spread ] [ { [ drop ] } spread ] } 1 ncleave
|
{ [ { [ ] } spread ] [ { [ drop ] } spread ] } 1 ncleave
|
||||||
! [fortran-invoke]
|
! [fortran-invoke]
|
||||||
|
|
|
@ -310,7 +310,7 @@ M: misc-type (fortran-result>)
|
||||||
GENERIC: (<fortran-result>) ( type -- quot )
|
GENERIC: (<fortran-result>) ( type -- quot )
|
||||||
|
|
||||||
M: fortran-type (<fortran-result>)
|
M: fortran-type (<fortran-result>)
|
||||||
(fortran-type>c-type) \ <c-object> [ ] 2sequence ;
|
(fortran-type>c-type) \ heap-size \ <byte-array> [ ] 3sequence ;
|
||||||
|
|
||||||
M: character-type (<fortran-result>)
|
M: character-type (<fortran-result>)
|
||||||
fix-character-type dims>> product dup
|
fix-character-type dims>> product dup
|
||||||
|
@ -427,8 +427,11 @@ MACRO: fortran-invoke ( return library function parameters -- )
|
||||||
{ [ 2drop nip set-fortran-abi ] [ (fortran-invoke) ] } 4 ncleave ;
|
{ [ 2drop nip set-fortran-abi ] [ (fortran-invoke) ] } 4 ncleave ;
|
||||||
|
|
||||||
: parse-arglist ( parameters return -- types effect )
|
: parse-arglist ( parameters return -- types effect )
|
||||||
[ 2 group unzip [ "," ?tail drop ] map ]
|
[
|
||||||
[ [ { } ] [ 1array ] if-void ]
|
2 group
|
||||||
|
[ unzip [ "," ?tail drop ] map ]
|
||||||
|
[ [ first "!" head? ] filter [ second "," ?tail drop "'" append ] map ] bi
|
||||||
|
] [ [ ] [ prefix ] if-void ]
|
||||||
bi* <effect> ;
|
bi* <effect> ;
|
||||||
|
|
||||||
:: define-fortran-function ( return library function parameters -- )
|
:: define-fortran-function ( return library function parameters -- )
|
||||||
|
|
|
@ -123,3 +123,13 @@ HELP: C-GLOBAL:
|
||||||
{ $syntax "C-GLOBAL: type name" }
|
{ $syntax "C-GLOBAL: type name" }
|
||||||
{ $values { "type" "a C type" } { "name" "a C global variable name" } }
|
{ $values { "type" "a C type" } { "name" "a C global variable name" } }
|
||||||
{ $description "Defines a new word named " { $snippet "name" } " which accesses a global variable in the current library, set with " { $link POSTPONE: LIBRARY: } "." } ;
|
{ $description "Defines a new word named " { $snippet "name" } " which accesses a global variable in the current library, set with " { $link POSTPONE: LIBRARY: } "." } ;
|
||||||
|
|
||||||
|
ARTICLE: "alien.enums" "Enumeration types"
|
||||||
|
"The " { $vocab-link "alien.enums" } " vocab contains the implementation for " { $link POSTPONE: ENUM: } " C types, and provides words for converting between enum singletons and integers. It is possible to dispatch off of members of an enum."
|
||||||
|
$nl
|
||||||
|
"Defining enums:"
|
||||||
|
{ $subsection POSTPONE: ENUM: }
|
||||||
|
"Defining enums at run-time:"
|
||||||
|
{ $subsection define-enum }
|
||||||
|
"Conversions between enums and integers:"
|
||||||
|
{ $subsections enum>number number>enum } ;
|
||||||
|
|
|
@ -64,3 +64,8 @@ IN: bit-sets.tests
|
||||||
|
|
||||||
[ T{ bit-set f ?{ f } } T{ bit-set f ?{ t } } ]
|
[ T{ bit-set f ?{ f } } T{ bit-set f ?{ t } } ]
|
||||||
[ 1 <bit-set> dup clone 0 over adjoin ] unit-test
|
[ 1 <bit-set> dup clone 0 over adjoin ] unit-test
|
||||||
|
|
||||||
|
[ 0 ] [ T{ bit-set f ?{ } } cardinality ] unit-test
|
||||||
|
[ 0 ] [ T{ bit-set f ?{ f f f f } } cardinality ] unit-test
|
||||||
|
[ 1 ] [ T{ bit-set f ?{ f t f f } } cardinality ] unit-test
|
||||||
|
[ 2 ] [ T{ bit-set f ?{ f t f t } } cardinality ] unit-test
|
||||||
|
|
|
@ -1,6 +1,7 @@
|
||||||
! Copyright (C) 2009 Slava Pestov.
|
! Copyright (C) 2009 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: kernel accessors sequences byte-arrays bit-arrays math hints sets ;
|
USING: kernel accessors sequences byte-arrays bit-arrays math
|
||||||
|
math.bitwise hints sets ;
|
||||||
IN: bit-sets
|
IN: bit-sets
|
||||||
|
|
||||||
TUPLE: bit-set { table bit-array read-only } ;
|
TUPLE: bit-set { table bit-array read-only } ;
|
||||||
|
@ -14,19 +15,21 @@ M: bit-set in?
|
||||||
over integer? [ table>> ?nth ] [ 2drop f ] if ; inline
|
over integer? [ table>> ?nth ] [ 2drop f ] if ; inline
|
||||||
|
|
||||||
M: bit-set adjoin
|
M: bit-set adjoin
|
||||||
! This is allowed to crash when the elt couldn't go in the set
|
! This is allowed to throw an error when the elt couldn't
|
||||||
|
! go in the set
|
||||||
[ t ] 2dip table>> set-nth ;
|
[ t ] 2dip table>> set-nth ;
|
||||||
|
|
||||||
M: bit-set delete
|
M: bit-set delete
|
||||||
! This isn't allowed to crash if the elt wasn't in the set
|
! This isn't allowed to throw an error if the elt wasn't
|
||||||
|
! in the set
|
||||||
over integer? [
|
over integer? [
|
||||||
table>> 2dup bounds-check? [
|
table>> 2dup bounds-check? [
|
||||||
[ f ] 2dip set-nth
|
[ f ] 2dip set-nth
|
||||||
] [ 2drop ] if
|
] [ 2drop ] if
|
||||||
] [ 2drop ] if ;
|
] [ 2drop ] if ;
|
||||||
|
|
||||||
! If you do binary set operations with a bitset, it's expected
|
! If you do binary set operations with a bit-set, it's expected
|
||||||
! that the other thing can also be represented as a bitset
|
! that the other thing can also be represented as a bit-set
|
||||||
! of the same length.
|
! of the same length.
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
|
||||||
|
@ -70,7 +73,8 @@ M: bit-set members
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
|
||||||
: bit-set-like ( set bit-set -- bit-set' )
|
: bit-set-like ( set bit-set -- bit-set' )
|
||||||
! This crashes if there are keys that can't be put in the bit set
|
! Throws an error if there are keys that can't be put
|
||||||
|
! in the bit set
|
||||||
over bit-set? [ 2dup [ table>> length ] bi@ = ] [ f ] if
|
over bit-set? [ 2dup [ table>> length ] bi@ = ] [ f ] if
|
||||||
[ drop ] [
|
[ drop ] [
|
||||||
[ members ] dip table>> length <bit-set>
|
[ members ] dip table>> length <bit-set>
|
||||||
|
@ -84,3 +88,6 @@ M: bit-set set-like
|
||||||
|
|
||||||
M: bit-set clone
|
M: bit-set clone
|
||||||
table>> clone bit-set boa ;
|
table>> clone bit-set boa ;
|
||||||
|
|
||||||
|
M: bit-set cardinality
|
||||||
|
table>> bit-count ;
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
! Copyright (C) 2008 Doug Coleman.
|
! Copyright (C) 2008 Doug Coleman.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: alien alien.c-types alien.syntax arrays calendar
|
USING: alien alien.c-types alien.data alien.syntax arrays
|
||||||
kernel math unix unix.time unix.types namespaces system
|
calendar kernel math unix unix.time unix.types namespaces system
|
||||||
accessors classes.struct ;
|
accessors classes.struct ;
|
||||||
IN: calendar.unix
|
IN: calendar.unix
|
||||||
|
|
||||||
|
|
|
@ -1,11 +1,11 @@
|
||||||
! Copyright (C) 2006, 2008 Doug Coleman.
|
! Copyright (C) 2006, 2008 Doug Coleman.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: alien.c-types kernel io io.binary io.files io.streams.byte-array math
|
USING: alien.c-types alien.data kernel io io.binary io.files
|
||||||
math.functions math.parser namespaces splitting grouping strings
|
io.streams.byte-array math math.functions math.parser namespaces
|
||||||
sequences byte-arrays locals sequences.private macros fry
|
splitting grouping strings sequences byte-arrays locals
|
||||||
io.encodings.binary math.bitwise checksums accessors
|
sequences.private macros fry io.encodings.binary math.bitwise
|
||||||
checksums.common checksums.stream combinators combinators.smart
|
checksums accessors checksums.common checksums.stream
|
||||||
specialized-arrays literals hints ;
|
combinators combinators.smart specialized-arrays literals hints ;
|
||||||
SPECIALIZED-ARRAY: uint
|
SPECIALIZED-ARRAY: uint
|
||||||
IN: checksums.md5
|
IN: checksums.md5
|
||||||
|
|
||||||
|
|
|
@ -3,7 +3,7 @@ kernel.private math hashtables.private math.private namespaces
|
||||||
sequences tools.test namespaces.private slots.private
|
sequences tools.test namespaces.private slots.private
|
||||||
sequences.private byte-arrays alien alien.accessors layouts
|
sequences.private byte-arrays alien alien.accessors layouts
|
||||||
words definitions compiler.units io combinators vectors grouping
|
words definitions compiler.units io combinators vectors grouping
|
||||||
make alien.c-types combinators.short-circuit math.order
|
make alien.c-types alien.data combinators.short-circuit math.order
|
||||||
math.libm math.parser math.functions alien.syntax memory
|
math.libm math.parser math.functions alien.syntax memory
|
||||||
stack-checker ;
|
stack-checker ;
|
||||||
FROM: math => float ;
|
FROM: math => float ;
|
||||||
|
|
|
@ -1,11 +1,11 @@
|
||||||
USING: tools.test kernel.private kernel arrays sequences
|
USING: tools.test kernel.private kernel arrays sequences
|
||||||
math.private math generic words quotations alien alien.c-types
|
math.private math generic words quotations alien alien.c-types
|
||||||
strings sbufs sequences.private slots.private combinators
|
alien.data strings sbufs sequences.private slots.private
|
||||||
definitions system layouts vectors math.partial-dispatch
|
combinators definitions system layouts vectors
|
||||||
math.order math.functions accessors hashtables classes assocs
|
math.partial-dispatch math.order math.functions accessors
|
||||||
io.encodings.utf8 io.encodings.ascii io.encodings fry slots
|
hashtables classes assocs io.encodings.utf8 io.encodings.ascii
|
||||||
sorting.private combinators.short-circuit grouping prettyprint
|
io.encodings fry slots sorting.private combinators.short-circuit
|
||||||
generalizations
|
grouping prettyprint generalizations
|
||||||
compiler.tree
|
compiler.tree
|
||||||
compiler.tree.combinators
|
compiler.tree.combinators
|
||||||
compiler.tree.cleanup
|
compiler.tree.cleanup
|
||||||
|
@ -521,8 +521,6 @@ cell-bits 32 = [
|
||||||
] cleaned-up-tree nodes>quot
|
] cleaned-up-tree nodes>quot
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
USING: alien alien.c-types ;
|
|
||||||
|
|
||||||
[ t ] [
|
[ t ] [
|
||||||
[ int { } cdecl [ 2 2 + ] alien-callback ]
|
[ int { } cdecl [ 2 2 + ] alien-callback ]
|
||||||
{ + } inlined?
|
{ + } inlined?
|
||||||
|
|
|
@ -1,8 +1,8 @@
|
||||||
! Copyright (C) 2009 Doug Coleman.
|
! Copyright (C) 2009 Doug Coleman.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: alien alien.c-types alien.syntax byte-arrays combinators
|
USING: alien alien.c-types alien.data alien.syntax byte-arrays
|
||||||
kernel math math.functions sequences system accessors
|
combinators kernel math math.functions sequences system
|
||||||
libc ;
|
accessors libc ;
|
||||||
QUALIFIED: compression.zlib.ffi
|
QUALIFIED: compression.zlib.ffi
|
||||||
IN: compression.zlib
|
IN: compression.zlib
|
||||||
|
|
||||||
|
|
|
@ -43,6 +43,6 @@ $nl
|
||||||
parallel-spread
|
parallel-spread
|
||||||
parallel-napply
|
parallel-napply
|
||||||
}
|
}
|
||||||
"The " { $vocab-link "concurrency.semaphores" } " vocabulary can be used in conjuction with the above combinators to limit the maximum number of concurrent operations." ;
|
"The " { $vocab-link "concurrency.semaphores" } " vocabulary can be used in conjunction with the above combinators to limit the maximum number of concurrent operations." ;
|
||||||
|
|
||||||
ABOUT: "concurrency.combinators"
|
ABOUT: "concurrency.combinators"
|
||||||
|
|
|
@ -60,7 +60,7 @@ ARTICLE: "concurrency.locks.rw" "Read-write locks"
|
||||||
$nl
|
$nl
|
||||||
"While this can be achieved with a simple " { $link "concurrency.locks.mutex" } ", performance will suffer, since in fact multiple threads can view the structure at the same time; serialization must only be enforced for writes."
|
"While this can be achieved with a simple " { $link "concurrency.locks.mutex" } ", performance will suffer, since in fact multiple threads can view the structure at the same time; serialization must only be enforced for writes."
|
||||||
$nl
|
$nl
|
||||||
"Read/write locks allow any number of threads to hold the read lock simulateneously, however attempting to acquire a write lock blocks until all other threads release read locks and write locks."
|
"Read/write locks allow any number of threads to hold the read lock simultaneously, however attempting to acquire a write lock blocks until all other threads release read locks and write locks."
|
||||||
$nl
|
$nl
|
||||||
"Read/write locks are reentrant. A thread holding a write lock may acquire a read lock or a write lock without blocking. However a thread holding a read lock may not acquire a write lock recursively since that could break invariants assumed by the code executing with the read lock held."
|
"Read/write locks are reentrant. A thread holding a write lock may acquire a read lock or a write lock without blocking. However a thread holding a read lock may not acquire a write lock recursively since that could break invariants assumed by the code executing with the read lock held."
|
||||||
{ $subsections
|
{ $subsections
|
||||||
|
|
|
@ -1,35 +1,35 @@
|
||||||
! Copyright (C) 2006 Chris Double.
|
! Copyright (C) 2006 Chris Double.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: help.syntax help.markup
|
USING: help.syntax help.markup
|
||||||
threads kernel arrays quotations strings ;
|
threads kernel arrays quotations strings ;
|
||||||
IN: concurrency.messaging
|
IN: concurrency.messaging
|
||||||
|
|
||||||
HELP: send
|
HELP: send
|
||||||
{ $values { "message" object }
|
{ $values { "message" object }
|
||||||
{ "thread" thread }
|
{ "thread" thread }
|
||||||
}
|
}
|
||||||
{ $description "Send the message to the thread by placing it in the threads mailbox. This is an asynchronous operation and will return immediately. The receving thread will act on the message the next time it retrieves that item from its mailbox (usually using the " { $link receive } " word. The message can be any Factor object. For destinations that are instances of remote-thread the message must be a serializable Factor type." }
|
{ $description "Send the message to the thread by placing it in the threads mailbox. This is an asynchronous operation and will return immediately. The receiving thread will act on the message the next time it retrieves that item from its mailbox (usually using the " { $link receive } " word. The message can be any Factor object. For destinations that are instances of remote-thread the message must be a serializable Factor type." }
|
||||||
{ $see-also receive receive-if } ;
|
{ $see-also receive receive-if } ;
|
||||||
|
|
||||||
HELP: receive
|
HELP: receive
|
||||||
{ $values { "message" object }
|
{ $values { "message" object }
|
||||||
}
|
}
|
||||||
{ $description "Return a message from the current threads mailbox. If the box is empty, suspend the thread until another thread places an item in the mailbox (usually via the " { $link send } " word." }
|
{ $description "Return a message from the current threads mailbox. If the box is empty, suspend the thread until another thread places an item in the mailbox (usually via the " { $link send } " word." }
|
||||||
{ $see-also send receive-if } ;
|
{ $see-also send receive-if } ;
|
||||||
|
|
||||||
HELP: receive-if
|
HELP: receive-if
|
||||||
{ $values { "pred" "a predicate with stack effect " { $snippet "( obj -- ? )" } }
|
{ $values { "pred" "a predicate with stack effect " { $snippet "( obj -- ? )" } }
|
||||||
{ "message" object }
|
{ "message" object }
|
||||||
}
|
}
|
||||||
{ $description "Return the first message from the current threads mailbox that satisfies the predicate. To satisfy the predicate, " { $snippet "pred" } " is called with the item on the stack and the predicate should leave a boolean indicating whether it was satisfied or not. If nothing in the mailbox satisfies the predicate then the thread will block until something does." }
|
{ $description "Return the first message from the current threads mailbox that satisfies the predicate. To satisfy the predicate, " { $snippet "pred" } " is called with the item on the stack and the predicate should leave a boolean indicating whether it was satisfied or not. If nothing in the mailbox satisfies the predicate then the thread will block until something does." }
|
||||||
{ $see-also send receive } ;
|
{ $see-also send receive } ;
|
||||||
|
|
||||||
HELP: spawn-linked
|
HELP: spawn-linked
|
||||||
{ $values { "quot" quotation }
|
{ $values { "quot" quotation }
|
||||||
{ "name" string }
|
{ "name" string }
|
||||||
{ "thread" thread }
|
{ "thread" thread }
|
||||||
}
|
}
|
||||||
{ $description "Start a thread which runs the given quotation. If that quotation throws an error which is not caught then the error will get propagated to the thread that spawned it. This can be used to set up 'supervisor' threads that restart child threads that crash due to uncaught errors.\n" }
|
{ $description "Start a thread which runs the given quotation. If that quotation throws an error which is not caught then the error will get propagated to the thread that spawned it. This can be used to set up 'supervisor' threads that restart child threads that crash due to uncaught errors.\n" }
|
||||||
{ $see-also spawn } ;
|
{ $see-also spawn } ;
|
||||||
|
|
||||||
ARTICLE: { "concurrency" "messaging" } "Sending and receiving messages"
|
ARTICLE: { "concurrency" "messaging" } "Sending and receiving messages"
|
||||||
|
@ -65,15 +65,15 @@ ARTICLE: { "concurrency" "synchronous-sends" } "Synchronous sends"
|
||||||
} ;
|
} ;
|
||||||
|
|
||||||
ARTICLE: { "concurrency" "exceptions" } "Linked exceptions"
|
ARTICLE: { "concurrency" "exceptions" } "Linked exceptions"
|
||||||
"A thread can handle exceptions using the standard Factor exception handling mechanism. If an exception is uncaught the thread will terminate. For example:"
|
"A thread can handle exceptions using the standard Factor exception handling mechanism. If an exception is uncaught the thread will terminate. For example:"
|
||||||
{ $code "[ 1 0 / \"This will not print\" print ] \"division-by-zero\" spawn" }
|
{ $code "[ 1 0 / \"This will not print\" print ] \"division-by-zero\" spawn" }
|
||||||
"Processes can be linked so that a parent thread can receive the exception that caused the child thread to terminate. In this way 'supervisor' threads can be created that are notified when child threads terminate and possibly restart them."
|
"Processes can be linked so that a parent thread can receive the exception that caused the child thread to terminate. In this way 'supervisor' threads can be created that are notified when child threads terminate and possibly restart them."
|
||||||
{ $subsections spawn-linked }
|
{ $subsections spawn-linked }
|
||||||
"This will create a unidirectional link, such that if an uncaught exception causes the child to terminate, the parent thread can catch it:"
|
"This will create a unidirectional link, such that if an uncaught exception causes the child to terminate, the parent thread can catch it:"
|
||||||
{ $code "["
|
{ $code "["
|
||||||
" [ 1 0 / \"This will not print\" print ] \"linked-division\" spawn-linked drop"
|
" [ 1 0 / \"This will not print\" print ] \"linked-division\" spawn-linked drop"
|
||||||
" receive"
|
" receive"
|
||||||
"] [ \"Exception caught.\" print ] recover" }
|
"] [ \"Exception caught.\" print ] recover" }
|
||||||
"Exceptions are only raised in the parent when the parent does a " { $link receive } " or " { $link receive-if } ". This is because the exception is sent from the child to the parent as a message." ;
|
"Exceptions are only raised in the parent when the parent does a " { $link receive } " or " { $link receive-if } ". This is because the exception is sent from the child to the parent as a message." ;
|
||||||
|
|
||||||
ARTICLE: "concurrency.messaging" "Message-passing concurrency"
|
ARTICLE: "concurrency.messaging" "Message-passing concurrency"
|
||||||
|
|
|
@ -1,6 +1,7 @@
|
||||||
! Copyright (C) 2009 Slava Pestov.
|
! Copyright (C) 2009 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: alien.c-types alien.syntax kernel math core-foundation ;
|
USING: alien.c-types alien.data alien.syntax kernel math
|
||||||
|
core-foundation ;
|
||||||
FROM: math => float ;
|
FROM: math => float ;
|
||||||
IN: core-foundation.numbers
|
IN: core-foundation.numbers
|
||||||
|
|
||||||
|
|
|
@ -1,9 +1,9 @@
|
||||||
! Copyright (C) 2009 Slava Pestov.
|
! Copyright (C) 2009 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: alien alien.c-types alien.destructors alien.syntax accessors
|
USING: alien alien.c-types alien.data alien.destructors
|
||||||
destructors fry kernel math math.bitwise sequences libc colors
|
alien.syntax accessors destructors fry kernel math math.bitwise
|
||||||
images images.memory core-graphics.types core-foundation.utilities
|
sequences libc colors images images.memory core-graphics.types
|
||||||
opengl.gl literals ;
|
core-foundation.utilities opengl.gl literals ;
|
||||||
IN: core-graphics
|
IN: core-graphics
|
||||||
|
|
||||||
TYPEDEF: int CGImageAlphaInfo
|
TYPEDEF: int CGImageAlphaInfo
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
! Copyright (C) 2009, 2010 Joe Groff, Slava Pestov.
|
! Copyright (C) 2009, 2010 Joe Groff, Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: alien.c-types arrays assocs combinators fry kernel locals
|
USING: alien.data arrays assocs combinators fry kernel locals
|
||||||
macros math math.vectors namespaces quotations sequences system
|
macros math math.vectors namespaces quotations sequences system
|
||||||
compiler.cfg.comparisons compiler.cfg.intrinsics
|
compiler.cfg.comparisons compiler.cfg.intrinsics
|
||||||
compiler.codegen.fixup cpu.architecture cpu.x86
|
compiler.codegen.fixup cpu.architecture cpu.x86
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
! Copyright (C) 2010 Slava Pestov.
|
! Copyright (C) 2010 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: alien.c-types combinators kernel locals system namespaces
|
USING: alien.c-types alien.data combinators kernel locals system
|
||||||
compiler.codegen.fixup compiler.constants
|
namespaces compiler.codegen.fixup compiler.constants
|
||||||
compiler.cfg.comparisons compiler.cfg.intrinsics
|
compiler.cfg.comparisons compiler.cfg.intrinsics
|
||||||
cpu.architecture cpu.x86 cpu.x86.assembler
|
cpu.architecture cpu.x86 cpu.x86.assembler
|
||||||
cpu.x86.assembler.operands ;
|
cpu.x86.assembler.operands ;
|
||||||
|
|
|
@ -271,24 +271,21 @@ ARTICLE: "db-lowlevel-tutorial" "Low-level database tutorial"
|
||||||
{ $subsections sql-query }
|
{ $subsections sql-query }
|
||||||
"Here's an example usage where we'll make a book table, insert some objects, and query them." $nl
|
"Here's an example usage where we'll make a book table, insert some objects, and query them." $nl
|
||||||
"First, let's set up a custom combinator for using our database. See " { $link "db-custom-database-combinators" } " for more details."
|
"First, let's set up a custom combinator for using our database. See " { $link "db-custom-database-combinators" } " for more details."
|
||||||
{ $code """
|
{ $code """USING: db.sqlite db io.files io.files.temp ;
|
||||||
USING: db.sqlite db io.files io.files.temp ;
|
|
||||||
: with-book-db ( quot -- )
|
: with-book-db ( quot -- )
|
||||||
"book.db" temp-file <sqlite-db> swap with-db ; inline" }
|
"book.db" temp-file <sqlite-db> swap with-db ; inline""" }
|
||||||
"Now let's create the table manually:"
|
"Now let's create the table manually:"
|
||||||
{ $code " "create table books
|
{ $code """"create table books
|
||||||
(id integer primary key, title text, author text, date_published timestamp,
|
(id integer primary key, title text, author text, date_published timestamp,
|
||||||
edition integer, cover_price double, condition text)"
|
edition integer, cover_price double, condition text)"
|
||||||
[ sql-command ] with-book-db""" }
|
[ sql-command ] with-book-db""" }
|
||||||
"Time to insert some books:"
|
"Time to insert some books:"
|
||||||
{ $code """
|
{ $code """"insert into books
|
||||||
"insert into books
|
|
||||||
(title, author, date_published, edition, cover_price, condition)
|
(title, author, date_published, edition, cover_price, condition)
|
||||||
values('Factor for Sheeple', 'Mister Stacky Pants', date('now'), 1, 13.37, 'mint')"
|
values('Factor for Sheeple', 'Mister Stacky Pants', date('now'), 1, 13.37, 'mint')"
|
||||||
[ sql-command ] with-book-db""" }
|
[ sql-command ] with-book-db""" }
|
||||||
"Now let's select the book:"
|
"Now let's select the book:"
|
||||||
{ $code """
|
{ $code """"select id, title, cover_price from books;" [ sql-query ] with-book-db""" }
|
||||||
"select id, title, cover_price from books;" [ sql-query ] with-book-db""" }
|
|
||||||
"Notice that the result of this query is a Factor array containing the database rows as arrays of strings. We would have to convert the " { $snippet "cover_price" } " from a string to a number in order to use it in a calculation." $nl
|
"Notice that the result of this query is a Factor array containing the database rows as arrays of strings. We would have to convert the " { $snippet "cover_price" } " from a string to a number in order to use it in a calculation." $nl
|
||||||
"In conclusion, this method of accessing a database is supported, but it is fairly low-level and generally specific to a single database. The " { $vocab-link "db.tuples" } " vocabulary is a good alternative to writing SQL by hand." ;
|
"In conclusion, this method of accessing a database is supported, but it is fairly low-level and generally specific to a single database. The " { $vocab-link "db.tuples" } " vocabulary is a good alternative to writing SQL by hand." ;
|
||||||
|
|
||||||
|
@ -298,10 +295,9 @@ ARTICLE: "db-custom-database-combinators" "Custom database combinators"
|
||||||
"Make a " { $snippet "with-" } " combinator to open and close a database so that resources are not leaked." $nl
|
"Make a " { $snippet "with-" } " combinator to open and close a database so that resources are not leaked." $nl
|
||||||
|
|
||||||
"SQLite example combinator:"
|
"SQLite example combinator:"
|
||||||
{ $code """
|
{ $code """USING: db.sqlite db io.files io.files.temp ;
|
||||||
USING: db.sqlite db io.files io.files.temp ;
|
|
||||||
: with-sqlite-db ( quot -- )
|
: with-sqlite-db ( quot -- )
|
||||||
"my-database.db" temp-file <sqlite-db> swap with-db ; inline""" }
|
"my-database.db" temp-file <sqlite-db> swap with-db ; inline""" }
|
||||||
|
|
||||||
"PostgreSQL example combinator:"
|
"PostgreSQL example combinator:"
|
||||||
{ $code """USING: db.postgresql db ;
|
{ $code """USING: db.postgresql db ;
|
||||||
|
|
|
@ -233,8 +233,7 @@ T{ book
|
||||||
{ date-published T{ timestamp { year 2009 } { month 3 } { day 3 } } }
|
{ date-published T{ timestamp { year 2009 } { month 3 } { day 3 } } }
|
||||||
{ edition 1 }
|
{ edition 1 }
|
||||||
{ cover-price 13.37 }
|
{ cover-price 13.37 }
|
||||||
} book set
|
} book set""" }
|
||||||
""" }
|
|
||||||
"Now we've created a book. Let's save it to the database."
|
"Now we've created a book. Let's save it to the database."
|
||||||
{ $code """USING: db db.sqlite fry io.files.temp ;
|
{ $code """USING: db db.sqlite fry io.files.temp ;
|
||||||
: with-book-tutorial ( quot -- )
|
: with-book-tutorial ( quot -- )
|
||||||
|
@ -243,8 +242,7 @@ T{ book
|
||||||
[
|
[
|
||||||
book recreate-table
|
book recreate-table
|
||||||
book get insert-tuple
|
book get insert-tuple
|
||||||
] with-book-tutorial
|
] with-book-tutorial""" }
|
||||||
""" }
|
|
||||||
"Is it really there?"
|
"Is it really there?"
|
||||||
{ $code """[
|
{ $code """[
|
||||||
T{ book { title "Factor for Sheeple" } } select-tuples .
|
T{ book { title "Factor for Sheeple" } } select-tuples .
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
! Copyright (C) 2009 Doug Coleman.
|
! Copyright (C) 2009 Doug Coleman.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: alien.c-types namespaces io.binary fry
|
USING: alien.c-types alien.data namespaces io.binary fry
|
||||||
kernel math grouping sequences math.bitwise ;
|
kernel math grouping sequences math.bitwise ;
|
||||||
IN: endian
|
IN: endian
|
||||||
|
|
||||||
|
|
|
@ -50,7 +50,7 @@ $nl
|
||||||
{ $code
|
{ $code
|
||||||
"""USING: eval listener vocabs.parser ;
|
"""USING: eval listener vocabs.parser ;
|
||||||
[
|
[
|
||||||
"cad-objects" use-vocab
|
"cad.objects" use-vocab
|
||||||
(( -- seq )) (eval)
|
(( -- seq )) (eval)
|
||||||
] with-interactive-vocabs"""
|
] with-interactive-vocabs"""
|
||||||
}
|
}
|
||||||
|
|
|
@ -1,12 +1,12 @@
|
||||||
USING: accessors alien alien.c-types alien.strings arrays assocs
|
USING: accessors alien alien.c-types alien.data alien.strings
|
||||||
byte-arrays combinators combinators.short-circuit continuations
|
arrays assocs byte-arrays combinators combinators.short-circuit
|
||||||
game.input game.input.dinput.keys-array io.encodings.utf16
|
continuations game.input game.input.dinput.keys-array
|
||||||
io.encodings.utf16n kernel locals math math.bitwise
|
io.encodings.utf16 io.encodings.utf16n kernel locals math
|
||||||
math.rectangles namespaces parser sequences shuffle
|
math.bitwise math.rectangles namespaces parser sequences shuffle
|
||||||
specialized-arrays ui.backend.windows vectors windows.com
|
specialized-arrays ui.backend.windows vectors windows.com
|
||||||
windows.directx.dinput windows.directx.dinput.constants
|
windows.directx.dinput windows.directx.dinput.constants
|
||||||
windows.kernel32 windows.messages windows.ole32 windows.errors
|
windows.kernel32 windows.messages windows.ole32 windows.errors
|
||||||
windows.user32 classes.struct alien.data ;
|
windows.user32 classes.struct ;
|
||||||
SPECIALIZED-ARRAY: DIDEVICEOBJECTDATA
|
SPECIALIZED-ARRAY: DIDEVICEOBJECTDATA
|
||||||
IN: game.input.dinput
|
IN: game.input.dinput
|
||||||
|
|
||||||
|
|
|
@ -45,7 +45,7 @@ $nl
|
||||||
$nl
|
$nl
|
||||||
"Some generic words have " { $strong "Description" } " headings, and others have " { $strong "Contract" } " headings. A distinction is made between words which are not intended to be extended with user-defined methods, and those that are."
|
"Some generic words have " { $strong "Description" } " headings, and others have " { $strong "Contract" } " headings. A distinction is made between words which are not intended to be extended with user-defined methods, and those that are."
|
||||||
{ $heading "Vocabulary naming conventions" }
|
{ $heading "Vocabulary naming conventions" }
|
||||||
"A vocabulary name ending in " { $snippet ".private" } " contains words which are either implementation details, unsafe, or both. For example, the " { $snippet "sequence.private" } " vocabulary contains words which access sequence elements without bounds checking (" { $link "sequences-unsafe" } "). You should avoid using private words from the Factor library unless absolutely necessary. Similarly, your own code can place words in private vocabularies using " { $link POSTPONE: <PRIVATE } " if you do not want other people using them without good reason."
|
"A vocabulary name ending in " { $snippet ".private" } " contains words which are either implementation details, unsafe, or both. For example, the " { $snippet "sequences.private" } " vocabulary contains words which access sequence elements without bounds checking (" { $link "sequences-unsafe" } "). You should avoid using private words from the Factor library unless absolutely necessary. Similarly, your own code can place words in private vocabularies using " { $link POSTPONE: <PRIVATE } " if you do not want other people using them without good reason."
|
||||||
{ $heading "Word naming conventions" }
|
{ $heading "Word naming conventions" }
|
||||||
"These conventions are not hard and fast, but are usually a good first step in understanding a word's behavior:"
|
"These conventions are not hard and fast, but are usually a good first step in understanding a word's behavior:"
|
||||||
{ $table
|
{ $table
|
||||||
|
|
|
@ -476,7 +476,8 @@ HELP: HELP:
|
||||||
{ $description "Defines documentation for a word." }
|
{ $description "Defines documentation for a word." }
|
||||||
{ $examples
|
{ $examples
|
||||||
{ $code
|
{ $code
|
||||||
": foo 2 + ;"
|
"USING: help help.markup help.syntax math ;"
|
||||||
|
": foo ( m -- n ) 2 + ;"
|
||||||
"HELP: foo"
|
"HELP: foo"
|
||||||
"{ $values { \"m\" \"an integer\" } { \"n\" \"an integer\" } }"
|
"{ $values { \"m\" \"an integer\" } { \"n\" \"an integer\" } }"
|
||||||
"{ $description \"Increments a value by 2.\" } ;"
|
"{ $description \"Increments a value by 2.\" } ;"
|
||||||
|
|
|
@ -24,20 +24,25 @@ HELP: HINTS:
|
||||||
{ $description "Defines specialization hints for a word or a method."
|
{ $description "Defines specialization hints for a word or a method."
|
||||||
$nl
|
$nl
|
||||||
"Each sequence in the list will cause a specialized version of the word to be compiled. Classes are tested for using their predicate, and literals are tested using " { $link eq? } "." }
|
"Each sequence in the list will cause a specialized version of the word to be compiled. Classes are tested for using their predicate, and literals are tested using " { $link eq? } "." }
|
||||||
{ $examples "The " { $link append } " word has a specializer for the very common case where two strings or two arrays are appended:"
|
{ $examples
|
||||||
{ $code "HINTS: append { string string } { array array } ;" }
|
"The " { $link append } " word has a specializer for the very common case where two strings or two arrays are appended:"
|
||||||
"Specializers can also be defined on methods:"
|
{ $code
|
||||||
{ $code
|
"USING: arrays hints sequences strings ;"
|
||||||
"GENERIC: count-occurrences ( elt obj -- n )"
|
"HINTS: append { string string } { array array } ;"
|
||||||
""
|
}
|
||||||
"M: sequence count-occurrences [ = ] with count ;"
|
"Specializers can also be defined on methods:"
|
||||||
""
|
{ $code
|
||||||
"M: assoc count-occurrences"
|
"USING: assocs hashtables hints kernel sequences ;"
|
||||||
" swap [ = nip ] curry assoc-filter assoc-size ;"
|
"GENERIC: count-occurrences ( elt obj -- n )"
|
||||||
""
|
""
|
||||||
"HINTS: M\ sequence count-occurrences { object array } ;"
|
"M: sequence count-occurrences [ = ] with count ;"
|
||||||
"HINTS: M\ assoc count-occurrences { object hashtable } ;"
|
""
|
||||||
}
|
"M: assoc count-occurrences"
|
||||||
|
" swap [ = nip ] curry assoc-filter assoc-size ;"
|
||||||
|
""
|
||||||
|
"HINTS: M\\ sequence count-occurrences { object array } ;"
|
||||||
|
"HINTS: M\\ assoc count-occurrences { object hashtable } ;"
|
||||||
|
}
|
||||||
} ;
|
} ;
|
||||||
|
|
||||||
ABOUT: "hints"
|
ABOUT: "hints"
|
||||||
|
|
|
@ -3,9 +3,9 @@
|
||||||
USING: accessors arrays assocs byte-arrays byte-vectors classes
|
USING: accessors arrays assocs byte-arrays byte-vectors classes
|
||||||
combinators definitions effects fry generic generic.single
|
combinators definitions effects fry generic generic.single
|
||||||
generic.standard hashtables io.binary io.encodings
|
generic.standard hashtables io.binary io.encodings
|
||||||
io.streams.string kernel kernel.private math
|
io.streams.string kernel kernel.private math math.parser
|
||||||
math.integers.private math.parser namespaces parser sbufs
|
namespaces parser sbufs sequences splitting splitting.private
|
||||||
sequences splitting splitting.private strings vectors words ;
|
strings vectors words ;
|
||||||
IN: hints
|
IN: hints
|
||||||
|
|
||||||
GENERIC: specializer-predicate ( spec -- quot )
|
GENERIC: specializer-predicate ( spec -- quot )
|
||||||
|
@ -130,6 +130,4 @@ M\ hashtable at* { { fixnum object } { word object } } "specializer" set-word-pr
|
||||||
|
|
||||||
M\ hashtable set-at { { object fixnum object } { object word object } } "specializer" set-word-prop
|
M\ hashtable set-at { { object fixnum object } { object word object } } "specializer" set-word-prop
|
||||||
|
|
||||||
\ bignum/f { { bignum bignum } { bignum fixnum } { fixnum bignum } { fixnum fixnum } } "specializer" set-word-prop
|
|
||||||
|
|
||||||
\ encode-string { string object object } "specializer" set-word-prop
|
\ encode-string { string object object } "specializer" set-word-prop
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
! Copyright (C) 2004, 2008 Slava Pestov.
|
! Copyright (C) 2004, 2008 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: alien.c-types kernel bit-arrays sequences assocs math
|
USING: alien.data kernel bit-arrays sequences assocs math
|
||||||
namespaces accessors math.order locals fry io.ports
|
namespaces accessors math.order locals fry io.ports
|
||||||
io.backend.unix io.backend.unix.multiplexers unix unix.ffi
|
io.backend.unix io.backend.unix.multiplexers unix unix.ffi
|
||||||
unix.time ;
|
unix.time ;
|
||||||
|
|
|
@ -1,12 +1,12 @@
|
||||||
! Copyright (C) 2004, 2008 Slava Pestov.
|
! Copyright (C) 2004, 2008 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: alien alien.c-types alien.syntax generic assocs kernel
|
USING: alien alien.c-types alien.data alien.syntax generic
|
||||||
kernel.private math io.ports sequences strings sbufs threads
|
assocs kernel kernel.private math io.ports sequences strings
|
||||||
unix unix.ffi vectors io.buffers io.backend io.encodings math.parser
|
sbufs threads unix unix.ffi vectors io.buffers io.backend
|
||||||
continuations system libc namespaces make io.timeouts
|
io.encodings math.parser continuations system libc namespaces
|
||||||
io.encodings.utf8 destructors destructors.private accessors
|
make io.timeouts io.encodings.utf8 destructors
|
||||||
summary combinators locals unix.time unix.types fry
|
destructors.private accessors summary combinators locals
|
||||||
io.backend.unix.multiplexers ;
|
unix.time unix.types fry io.backend.unix.multiplexers ;
|
||||||
QUALIFIED: io
|
QUALIFIED: io
|
||||||
IN: io.backend.unix
|
IN: io.backend.unix
|
||||||
|
|
||||||
|
|
|
@ -52,7 +52,7 @@ HELP: with-directory-files
|
||||||
{ $examples
|
{ $examples
|
||||||
"Print all files in your home directory which are larger than a megabyte:"
|
"Print all files in your home directory which are larger than a megabyte:"
|
||||||
{ $code
|
{ $code
|
||||||
"""USING: io.directoies io.files.info io.pathnames ;
|
"""USING: io.directories io.files.info io.pathnames ;
|
||||||
home [
|
home [
|
||||||
[
|
[
|
||||||
dup link-info size>> 20 2^ >
|
dup link-info size>> 20 2^ >
|
||||||
|
|
|
@ -64,7 +64,7 @@ HELP: find-by-extension
|
||||||
}
|
}
|
||||||
{ $description "Searches a directory for all files with the given extension. File extension and filenames are converted to lower-case and compared using the " { $link tail? } " word. The file extension should contain the period." }
|
{ $description "Searches a directory for all files with the given extension. File extension and filenames are converted to lower-case and compared using the " { $link tail? } " word. The file extension should contain the period." }
|
||||||
{ $examples
|
{ $examples
|
||||||
{ $unchecked-example
|
{ $code
|
||||||
"USING: io.directories.search ;"
|
"USING: io.directories.search ;"
|
||||||
"\"/\" \".mp3\" find-by-extension"
|
"\"/\" \".mp3\" find-by-extension"
|
||||||
}
|
}
|
||||||
|
@ -77,7 +77,7 @@ HELP: find-by-extensions
|
||||||
}
|
}
|
||||||
{ $description "Searches a directory for all files in the given list of extensions. File extensions and filenames are converted to lower-case and compared using the " { $link tail? } " word. File extensions should contain the period." }
|
{ $description "Searches a directory for all files in the given list of extensions. File extensions and filenames are converted to lower-case and compared using the " { $link tail? } " word. File extensions should contain the period." }
|
||||||
{ $examples
|
{ $examples
|
||||||
{ $unchecked-example
|
{ $code
|
||||||
"USING: io.directories.search ;"
|
"USING: io.directories.search ;"
|
||||||
"\"/\" { \".jpg\" \".gif\" \".tiff\" \".png\" \".bmp\" } find-by-extensions"
|
"\"/\" { \".jpg\" \".gif\" \".tiff\" \".png\" \".bmp\" } find-by-extensions"
|
||||||
}
|
}
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
! Copyright (C) 2009 Doug Coleman.
|
! Copyright (C) 2009 Doug Coleman.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: alien.c-types io.directories.unix kernel system unix
|
USING: alien.c-types alien.data io.directories.unix kernel
|
||||||
classes.struct unix.ffi ;
|
system unix classes.struct unix.ffi ;
|
||||||
IN: io.directories.unix.linux
|
IN: io.directories.unix.linux
|
||||||
|
|
||||||
M: linux find-next-file ( DIR* -- dirent )
|
M: linux find-next-file ( DIR* -- dirent )
|
||||||
|
|
|
@ -1,10 +1,11 @@
|
||||||
! 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: accessors alien.c-types alien.strings combinators
|
USING: accessors alien.c-types alien.data alien.strings
|
||||||
continuations destructors fry io io.backend io.backend.unix
|
combinators continuations destructors fry io io.backend
|
||||||
io.directories io.encodings.binary io.encodings.utf8 io.files
|
io.backend.unix io.directories io.encodings.binary
|
||||||
io.pathnames io.files.types kernel math.bitwise sequences system
|
io.encodings.utf8 io.files io.pathnames io.files.types kernel
|
||||||
unix unix.stat vocabs.loader classes.struct unix.ffi literals ;
|
math.bitwise sequences system unix unix.stat vocabs.loader
|
||||||
|
classes.struct unix.ffi literals ;
|
||||||
IN: io.directories.unix
|
IN: io.directories.unix
|
||||||
|
|
||||||
CONSTANT: touch-mode flags{ O_WRONLY O_APPEND O_CREAT O_EXCL }
|
CONSTANT: touch-mode flags{ O_WRONLY O_APPEND O_CREAT O_EXCL }
|
||||||
|
|
|
@ -1,10 +1,10 @@
|
||||||
! Copyright (C) 2008 Doug Coleman.
|
! Copyright (C) 2008 Doug Coleman.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: accessors alien.c-types alien.strings combinators
|
USING: accessors alien.c-types alien.data alien.strings
|
||||||
grouping io.encodings.utf8 io.files kernel math sequences system
|
combinators grouping io.encodings.utf8 io.files kernel math
|
||||||
unix io.files.unix arrays unix.statfs.macosx unix.statvfs.macosx
|
sequences system unix io.files.unix arrays unix.statfs.macosx
|
||||||
unix.getfsstat.macosx io.files.info.unix io.files.info
|
unix.statvfs.macosx unix.getfsstat.macosx io.files.info.unix
|
||||||
classes.struct specialized-arrays ;
|
io.files.info classes.struct specialized-arrays ;
|
||||||
SPECIALIZED-ARRAY: uint
|
SPECIALIZED-ARRAY: uint
|
||||||
SPECIALIZED-ARRAY: statfs64
|
SPECIALIZED-ARRAY: statfs64
|
||||||
IN: io.files.info.unix.macosx
|
IN: io.files.info.unix.macosx
|
||||||
|
|
|
@ -2,7 +2,7 @@
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: classes help.markup help.syntax io.streams.string
|
USING: classes help.markup help.syntax io.streams.string
|
||||||
strings math calendar io.files.info io.files.info.unix ;
|
strings math calendar io.files.info io.files.info.unix ;
|
||||||
IN: io.files.unix
|
IN: io.files.info.unix
|
||||||
|
|
||||||
HELP: add-file-permissions
|
HELP: add-file-permissions
|
||||||
{ $values
|
{ $values
|
||||||
|
@ -102,16 +102,15 @@ HELP: set-file-permissions
|
||||||
{ "path" "a pathname string" } { "n" "an integer, interepreted as a string of bits" } }
|
{ "path" "a pathname string" } { "n" "an integer, interepreted as a string of bits" } }
|
||||||
{ $description "Sets the file permissions for a given file with the supplied Unix permissions integer. Supplying an octal number with " { $link POSTPONE: OCT: } " is recommended." }
|
{ $description "Sets the file permissions for a given file with the supplied Unix permissions integer. Supplying an octal number with " { $link POSTPONE: OCT: } " is recommended." }
|
||||||
{ $examples "Using the tradidional octal value:"
|
{ $examples "Using the tradidional octal value:"
|
||||||
{ $unchecked-example "USING: io.files.unix kernel ;"
|
{ $code "USING: io.files.info.unix kernel ;"
|
||||||
"\"resource:license.txt\" OCT: 755 set-file-permissions"
|
"\"resource:license.txt\" OCT: 755 set-file-permissions"
|
||||||
""
|
|
||||||
}
|
}
|
||||||
"Higher-level, setting named bits:"
|
"Higher-level, setting named bits:"
|
||||||
{ $unchecked-example "USING: io.files.unix kernel math.bitwise ;"
|
{ $code "USING: io.files.info.unix kernel literals ;"
|
||||||
"\"resource:license.txt\""
|
"\"resource:license.txt\""
|
||||||
"{ USER-ALL GROUP-READ GROUP-EXECUTE OTHER-READ OTHER-EXECUTE }"
|
"flags{ USER-ALL GROUP-READ GROUP-EXECUTE OTHER-READ OTHER-EXECUTE }"
|
||||||
"flags set-file-permissions"
|
"set-file-permissions"
|
||||||
"" }
|
}
|
||||||
} ;
|
} ;
|
||||||
|
|
||||||
HELP: set-file-times
|
HELP: set-file-times
|
||||||
|
|
|
@ -3,13 +3,13 @@
|
||||||
USING: accessors alien alien.c-types alien.data alien.strings
|
USING: accessors alien alien.c-types alien.data alien.strings
|
||||||
alien.syntax arrays assocs classes.struct combinators
|
alien.syntax arrays assocs classes.struct combinators
|
||||||
combinators.short-circuit continuations destructors environment
|
combinators.short-circuit continuations destructors environment
|
||||||
io io.backend io.binary io.buffers
|
io io.backend io.binary io.buffers io.encodings.utf16n io.files
|
||||||
io.encodings.utf16n io.files io.files.private io.files.types
|
io.files.private io.files.types io.pathnames io.ports
|
||||||
io.pathnames io.ports io.streams.c io.streams.null io.timeouts
|
io.streams.c io.streams.null io.timeouts kernel libc literals
|
||||||
kernel libc literals locals make math math.bitwise namespaces
|
locals make math math.bitwise namespaces sequences
|
||||||
sequences specialized-arrays system
|
specialized-arrays system threads tr windows windows.errors
|
||||||
threads tr windows windows.errors windows.handles
|
windows.handles windows.kernel32 windows.shell32 windows.time
|
||||||
windows.kernel32 windows.shell32 windows.time windows.types ;
|
windows.types ;
|
||||||
SPECIALIZED-ARRAY: ushort
|
SPECIALIZED-ARRAY: ushort
|
||||||
IN: io.files.windows
|
IN: io.files.windows
|
||||||
|
|
||||||
|
@ -52,7 +52,7 @@ C: <FileArgs> FileArgs
|
||||||
[ handle>> handle>> ]
|
[ handle>> handle>> ]
|
||||||
[ buffer>> ]
|
[ buffer>> ]
|
||||||
[ buffer>> buffer-length ]
|
[ buffer>> buffer-length ]
|
||||||
[ drop DWORD <c-object> ]
|
[ drop 0 DWORD <ref> ]
|
||||||
[ FileArgs-overlapped ]
|
[ FileArgs-overlapped ]
|
||||||
} cleave <FileArgs> ;
|
} cleave <FileArgs> ;
|
||||||
|
|
||||||
|
|
|
@ -99,7 +99,7 @@ M: winnt WSASocket-flags ( -- DWORD )
|
||||||
{ void* }
|
{ void* }
|
||||||
[
|
[
|
||||||
void* heap-size
|
void* heap-size
|
||||||
DWORD <c-object>
|
0 DWORD <ref>
|
||||||
f
|
f
|
||||||
f
|
f
|
||||||
WSAIoctl SOCKET_ERROR = [
|
WSAIoctl SOCKET_ERROR = [
|
||||||
|
|
|
@ -61,6 +61,7 @@ $nl
|
||||||
"The " { $snippet "style" } " hashtable holds table style information. See " { $link "table-styles" } "." }
|
"The " { $snippet "style" } " hashtable holds table style information. See " { $link "table-styles" } "." }
|
||||||
{ $examples
|
{ $examples
|
||||||
{ $code
|
{ $code
|
||||||
|
"USING: io.styles prettyprint sequences ;"
|
||||||
"{ { 1 2 } { 3 4 } }"
|
"{ { 1 2 } { 3 4 } }"
|
||||||
"H{ { table-gap { 10 10 } } } ["
|
"H{ { table-gap { 10 10 } } } ["
|
||||||
" [ [ [ [ . ] with-cell ] each ] with-row ] each"
|
" [ [ [ [ . ] with-cell ] each ] with-row ] each"
|
||||||
|
@ -201,12 +202,13 @@ HELP: bold-italic
|
||||||
{ $description "A value for the " { $link font-style } " character style denoting boldface italicized text." } ;
|
{ $description "A value for the " { $link font-style } " character style denoting boldface italicized text." } ;
|
||||||
|
|
||||||
HELP: foreground
|
HELP: foreground
|
||||||
{ $description "Character style. An instance of " { $link color } ". See " { $link "colors" } "." }
|
{ $description "Character style. An instance of " { $link color } ". See " { $link "colors" } "." }
|
||||||
{ $examples
|
{ $examples
|
||||||
{ $code
|
{ $code
|
||||||
|
"USING: colors.gray io.styles hashtables sequences kernel math ;"
|
||||||
"10 iota ["
|
"10 iota ["
|
||||||
" \"Hello world\\n\""
|
" \"Hello world\\n\""
|
||||||
" swap 10 / 1 <gray> foreground associate format"
|
" swap 10 / 1 <gray> foreground associate format"
|
||||||
"] each"
|
"] each"
|
||||||
}
|
}
|
||||||
} ;
|
} ;
|
||||||
|
@ -215,10 +217,11 @@ HELP: background
|
||||||
{ $description "Character style. An instance of " { $link color } ". See " { $link "colors" } "." }
|
{ $description "Character style. An instance of " { $link color } ". See " { $link "colors" } "." }
|
||||||
{ $examples
|
{ $examples
|
||||||
{ $code
|
{ $code
|
||||||
|
"USING: colors hashtables io io.styles kernel math sequences ;"
|
||||||
"10 iota ["
|
"10 iota ["
|
||||||
" \"Hello world\\n\""
|
" \"Hello world\\n\""
|
||||||
" swap 10 / 1 over - over 1 <rgba>"
|
" swap 10 / 1 over - over 1 <rgba>"
|
||||||
" background associate format nl"
|
" background associate format nl"
|
||||||
"] each"
|
"] each"
|
||||||
}
|
}
|
||||||
} ;
|
} ;
|
||||||
|
@ -227,14 +230,20 @@ HELP: font-name
|
||||||
{ $description "Character style. Font family named by a string." }
|
{ $description "Character style. Font family named by a string." }
|
||||||
{ $examples
|
{ $examples
|
||||||
"This example outputs some different font sizes:"
|
"This example outputs some different font sizes:"
|
||||||
{ $code "{ \"monospace\" \"serif\" \"sans-serif\" }\n[ dup font-name associate format nl ] each" }
|
{ $code
|
||||||
|
"USING: hashtables io io.styles kernel sequences ;"
|
||||||
|
"{ \"monospace\" \"serif\" \"sans-serif\" }"
|
||||||
|
"[ dup font-name associate format nl ] each"
|
||||||
|
}
|
||||||
} ;
|
} ;
|
||||||
|
|
||||||
HELP: font-size
|
HELP: font-size
|
||||||
{ $description "Character style. Font size, an integer." }
|
{ $description "Character style. Font size, an integer." }
|
||||||
{ $examples
|
{ $examples
|
||||||
"This example outputs some different font sizes:"
|
"This example outputs some different font sizes:"
|
||||||
{ $code "{ 12 18 24 72 }"
|
{ $code
|
||||||
|
"USING: hashtables io io.styles kernel sequences ;"
|
||||||
|
"{ 12 18 24 72 }"
|
||||||
"[ \"Bigger\" swap font-size associate format nl ] each"
|
"[ \"Bigger\" swap font-size associate format nl ] each"
|
||||||
}
|
}
|
||||||
} ;
|
} ;
|
||||||
|
@ -243,28 +252,44 @@ HELP: font-style
|
||||||
{ $description "Character style. Font style, one of " { $link plain } ", " { $link bold } ", " { $link italic } ", or " { $link bold-italic } "." }
|
{ $description "Character style. Font style, one of " { $link plain } ", " { $link bold } ", " { $link italic } ", or " { $link bold-italic } "." }
|
||||||
{ $examples
|
{ $examples
|
||||||
"This example outputs text in all three styles:"
|
"This example outputs text in all three styles:"
|
||||||
{ $code "{ plain bold italic bold-italic }\n[ [ name>> ] keep font-style associate format nl ] each" }
|
{ $code
|
||||||
|
"USING: accessors hashtables io io.styles kernel sequences ;"
|
||||||
|
"{ plain bold italic bold-italic }"
|
||||||
|
"[ [ name>> ] keep font-style associate format nl ] each"
|
||||||
|
}
|
||||||
} ;
|
} ;
|
||||||
|
|
||||||
HELP: presented
|
HELP: presented
|
||||||
{ $description "Character and paragraph style. An object associated with the text. In the Factor UI, this is shown as a clickable presentation of the object; left-clicking invokes a default command, and right-clicking shows a menu of commands." } ;
|
{ $description "Character and paragraph style. An object associated with the text. In the Factor UI, this is shown as a clickable presentation of the object; left-clicking invokes a default command, and right-clicking shows a menu of commands." } ;
|
||||||
|
|
||||||
HELP: page-color
|
HELP: page-color
|
||||||
{ $description "Paragraph style. An instance of " { $link color } ". See " { $link "colors" } "." }
|
{ $description "Paragraph style. An instance of " { $link color } ". See " { $link "colors" } "." }
|
||||||
{ $examples
|
{ $examples
|
||||||
{ $code "H{ { page-color T{ rgba f 1 0.8 0.5 1 } } }\n[ \"A background\" write ] with-nesting nl" }
|
{ $code
|
||||||
|
"USING: colors io io.styles ;"
|
||||||
|
"H{ { page-color T{ rgba f 1 0.8 0.5 1 } } }"
|
||||||
|
"[ \"A background\" write ] with-nesting nl"
|
||||||
|
}
|
||||||
} ;
|
} ;
|
||||||
|
|
||||||
HELP: border-color
|
HELP: border-color
|
||||||
{ $description "Paragraph style. An instance of " { $link color } ". See " { $link "colors" } "." }
|
{ $description "Paragraph style. An instance of " { $link color } ". See " { $link "colors" } "." }
|
||||||
{ $examples
|
{ $examples
|
||||||
{ $code "H{ { border-color T{ rgba f 1 0 0 1 } } }\n[ \"A border\" write ] with-nesting nl" }
|
{ $code
|
||||||
|
"USING: colors io io.styles ;"
|
||||||
|
"H{ { border-color T{ rgba f 1 0 0 1 } } }"
|
||||||
|
"[ \"A border\" write ] with-nesting nl"
|
||||||
|
}
|
||||||
} ;
|
} ;
|
||||||
|
|
||||||
HELP: inset
|
HELP: inset
|
||||||
{ $description "Paragraph style. A pair of integers representing the number of pixels that the content should be inset from the border. The first number is the horizontal inset, and the second is the vertical inset." }
|
{ $description "Paragraph style. A pair of integers representing the number of pixels that the content should be inset from the border. The first number is the horizontal inset, and the second is the vertical inset." }
|
||||||
{ $examples
|
{ $examples
|
||||||
{ $code "H{ { inset { 10 10 } } }\n[ \"Some inset text\" write ] with-nesting nl" }
|
{ $code
|
||||||
|
"USING: io io.styles ;"
|
||||||
|
"H{ { inset { 10 10 } } }"
|
||||||
|
"[ \"Some inset text\" write ] with-nesting nl"
|
||||||
|
}
|
||||||
} ;
|
} ;
|
||||||
|
|
||||||
HELP: wrap-margin
|
HELP: wrap-margin
|
||||||
|
@ -284,7 +309,10 @@ HELP: input
|
||||||
{ $class-description "Class of input text presentations. Instances can be used passed to " { $link write-object } " to output a clickable piece of input. Input text presentations are created by calling " { $link <input> } "." }
|
{ $class-description "Class of input text presentations. Instances can be used passed to " { $link write-object } " to output a clickable piece of input. Input text presentations are created by calling " { $link <input> } "." }
|
||||||
{ $examples
|
{ $examples
|
||||||
"This presentation class is used for the code examples you see in the online help:"
|
"This presentation class is used for the code examples you see in the online help:"
|
||||||
{ $code "\"2 3 + .\" dup <input> write-object nl" }
|
{ $code
|
||||||
|
"USING: io io.styles kernel ;"
|
||||||
|
"\"2 3 + .\" dup <input> write-object nl"
|
||||||
|
}
|
||||||
} ;
|
} ;
|
||||||
|
|
||||||
HELP: <input>
|
HELP: <input>
|
||||||
|
@ -302,4 +330,4 @@ ARTICLE: "io.streams.plain" "Plain writer streams"
|
||||||
{ $link make-span-stream } ", "
|
{ $link make-span-stream } ", "
|
||||||
{ $link make-block-stream } " and "
|
{ $link make-block-stream } " and "
|
||||||
{ $link make-cell-stream } "."
|
{ $link make-cell-stream } "."
|
||||||
{ $subsections plain-writer } ;
|
{ $subsections plain-writer } ;
|
||||||
|
|
|
@ -8,23 +8,22 @@ HELP: $
|
||||||
{ $description "Executes " { $snippet "word" } " at parse time and adds the result(s) to the parser accumulator." }
|
{ $description "Executes " { $snippet "word" } " at parse time and adds the result(s) to the parser accumulator." }
|
||||||
{ $notes { $snippet "word" } "'s definition is looked up and " { $link call } "ed at parse time, so words that reference words in the current compilation unit cannot be used with " { $snippet "$" } "." }
|
{ $notes { $snippet "word" } "'s definition is looked up and " { $link call } "ed at parse time, so words that reference words in the current compilation unit cannot be used with " { $snippet "$" } "." }
|
||||||
{ $examples
|
{ $examples
|
||||||
|
{ $example
|
||||||
{ $example """
|
"USING: kernel literals prettyprint ;"
|
||||||
USING: kernel literals prettyprint ;
|
"IN: scratchpad"
|
||||||
IN: scratchpad
|
""
|
||||||
|
"CONSTANT: five 5"
|
||||||
CONSTANT: five 5
|
"{ $ five } ."
|
||||||
{ $ five } .
|
"{ 5 }"
|
||||||
""" "{ 5 }" }
|
}
|
||||||
|
{ $example
|
||||||
{ $example """
|
"USING: kernel literals prettyprint ;"
|
||||||
USING: kernel literals prettyprint ;
|
"IN: scratchpad"
|
||||||
IN: scratchpad
|
""
|
||||||
|
": seven-eleven ( -- a b ) 7 11 ;"
|
||||||
: seven-eleven ( -- a b ) 7 11 ;
|
"{ $ seven-eleven } ."
|
||||||
{ $ seven-eleven } .
|
"{ 7 11 }"
|
||||||
""" "{ 7 11 }" }
|
}
|
||||||
|
|
||||||
} ;
|
} ;
|
||||||
|
|
||||||
HELP: $[
|
HELP: $[
|
||||||
|
@ -32,15 +31,14 @@ HELP: $[
|
||||||
{ $description "Calls " { $snippet "code" } " at parse time and adds the result(s) to the parser accumulator." }
|
{ $description "Calls " { $snippet "code" } " at parse time and adds the result(s) to the parser accumulator." }
|
||||||
{ $notes "Since " { $snippet "code" } " is " { $link call } "ed at parse time, it cannot reference any words defined in the same compilation unit." }
|
{ $notes "Since " { $snippet "code" } " is " { $link call } "ed at parse time, it cannot reference any words defined in the same compilation unit." }
|
||||||
{ $examples
|
{ $examples
|
||||||
|
{ $example
|
||||||
{ $example """
|
"USING: kernel literals math prettyprint ;"
|
||||||
USING: kernel literals math prettyprint ;
|
"IN: scratchpad"
|
||||||
IN: scratchpad
|
""
|
||||||
|
"<< CONSTANT: five 5 >>"
|
||||||
<< CONSTANT: five 5 >>
|
"{ $[ five dup 1 + dup 2 + ] } ."
|
||||||
{ $[ five dup 1 + dup 2 + ] } .
|
"{ 5 6 8 }"
|
||||||
""" "{ 5 6 8 }" }
|
}
|
||||||
|
|
||||||
} ;
|
} ;
|
||||||
|
|
||||||
HELP: ${
|
HELP: ${
|
||||||
|
@ -48,15 +46,14 @@ HELP: ${
|
||||||
{ $description "Outputs an array containing the results of executing " { $snippet "code" } " at parse time." }
|
{ $description "Outputs an array containing the results of executing " { $snippet "code" } " at parse time." }
|
||||||
{ $notes { $snippet "code" } "'s definition is looked up and " { $link call } "ed at parse time, so words that reference words in the current compilation unit cannot be used with " { $snippet "$" } "." }
|
{ $notes { $snippet "code" } "'s definition is looked up and " { $link call } "ed at parse time, so words that reference words in the current compilation unit cannot be used with " { $snippet "$" } "." }
|
||||||
{ $examples
|
{ $examples
|
||||||
|
{ $example
|
||||||
{ $example """
|
"USING: kernel literals math prettyprint ;"
|
||||||
USING: kernel literals math prettyprint ;
|
"IN: scratchpad"
|
||||||
IN: scratchpad
|
""
|
||||||
|
"CONSTANT: five 5"
|
||||||
CONSTANT: five 5
|
"CONSTANT: six 6"
|
||||||
CONSTANT: six 6
|
"${ five six 7 } ."
|
||||||
${ five six 7 } .
|
"{ 5 6 7 }"
|
||||||
""" "{ 5 6 7 }"
|
|
||||||
}
|
}
|
||||||
} ;
|
} ;
|
||||||
|
|
||||||
|
@ -66,7 +63,8 @@ HELP: flags{
|
||||||
{ $values { "values" sequence } }
|
{ $values { "values" sequence } }
|
||||||
{ $description "Constructs a constant flag value from a sequence of integers or words that output integers. The resulting constant is computed at parse-time, which makes this word as efficient as using a literal integer." }
|
{ $description "Constructs a constant flag value from a sequence of integers or words that output integers. The resulting constant is computed at parse-time, which makes this word as efficient as using a literal integer." }
|
||||||
{ $examples
|
{ $examples
|
||||||
{ $example "USING: literals kernel prettyprint ;"
|
{ $example
|
||||||
|
"USING: literals kernel prettyprint ;"
|
||||||
"IN: scratchpad"
|
"IN: scratchpad"
|
||||||
"CONSTANT: x HEX: 1"
|
"CONSTANT: x HEX: 1"
|
||||||
"flags{ HEX: 20 x BIN: 100 } .h"
|
"flags{ HEX: 20 x BIN: 100 } .h"
|
||||||
|
@ -77,13 +75,14 @@ HELP: flags{
|
||||||
|
|
||||||
ARTICLE: "literals" "Interpolating code results into literal values"
|
ARTICLE: "literals" "Interpolating code results into literal values"
|
||||||
"The " { $vocab-link "literals" } " vocabulary contains words to run code at parse time and insert the results into more complex literal values."
|
"The " { $vocab-link "literals" } " vocabulary contains words to run code at parse time and insert the results into more complex literal values."
|
||||||
{ $example """
|
{ $example
|
||||||
USE: literals
|
"USING: kernel literals math prettyprint ;"
|
||||||
IN: scratchpad
|
"IN: scratchpad"
|
||||||
|
""
|
||||||
CONSTANT: five 5
|
"<< CONSTANT: five 5 >>"
|
||||||
{ $ five $[ five dup 1 + dup 2 + ] } .
|
"{ $ five $[ five dup 1 + dup 2 + ] } ."
|
||||||
""" "{ 5 5 6 8 }" }
|
"{ 5 5 6 8 }"
|
||||||
|
}
|
||||||
{ $subsections
|
{ $subsections
|
||||||
POSTPONE: $
|
POSTPONE: $
|
||||||
POSTPONE: $[
|
POSTPONE: $[
|
||||||
|
|
|
@ -17,7 +17,7 @@ HELP: /*
|
||||||
HELP: HEREDOC:
|
HELP: HEREDOC:
|
||||||
{ $syntax "HEREDOC: marker\n...text...\nmarker" }
|
{ $syntax "HEREDOC: marker\n...text...\nmarker" }
|
||||||
{ $values { "marker" "a word (token)" } { "text" "arbitrary text" } { "value" string } }
|
{ $values { "marker" "a word (token)" } { "text" "arbitrary text" } { "value" string } }
|
||||||
{ $description "Returns a string delimited by an arbitrary user-defined token. This delimiter must be exactly the text beginning at the first non-blank character after " { $link POSTPONE: HEREDOC: } " until the end of the line containing " { $link POSTPONE: HEREDOC: } ". Text is captured until a line is found conatining exactly this delimter string." }
|
{ $description "Returns a string delimited by an arbitrary user-defined token. This delimiter must be exactly the text beginning at the first non-blank character after " { $link POSTPONE: HEREDOC: } " until the end of the line containing " { $link POSTPONE: HEREDOC: } ". Text is captured until a line is found containing exactly this delimiter string." }
|
||||||
{ $warning "Whitespace is significant." }
|
{ $warning "Whitespace is significant." }
|
||||||
{ $examples
|
{ $examples
|
||||||
{ $example "USING: multiline prettyprint ;"
|
{ $example "USING: multiline prettyprint ;"
|
||||||
|
|
|
@ -1,9 +1,9 @@
|
||||||
! Copyright (C) 2008 Joe Groff.
|
! Copyright (C) 2008 Joe Groff.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: kernel opengl.gl alien.c-types continuations namespaces
|
USING: kernel opengl.gl alien.c-types continuations namespaces
|
||||||
assocs alien alien.data alien.strings libc opengl math sequences combinators
|
assocs alien alien.data alien.strings libc opengl math sequences
|
||||||
macros arrays io.encodings.ascii fry specialized-arrays
|
combinators macros arrays io.encodings.ascii fry
|
||||||
destructors accessors ;
|
specialized-arrays destructors accessors ;
|
||||||
SPECIALIZED-ARRAY: uint
|
SPECIALIZED-ARRAY: uint
|
||||||
IN: opengl.shaders
|
IN: opengl.shaders
|
||||||
|
|
||||||
|
|
|
@ -1,9 +1,9 @@
|
||||||
! Copyright (C) 2008 Doug Coleman.
|
! Copyright (C) 2008 Doug Coleman.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: accessors alien.c-types arrays assocs byte-arrays
|
USING: accessors alien.c-types alien.data arrays assocs
|
||||||
byte-vectors combinators fry io.backend io.binary kernel locals
|
byte-arrays byte-vectors combinators fry io.backend io.binary
|
||||||
math math.bitwise math.constants math.functions math.order
|
kernel locals math math.bitwise math.constants math.functions
|
||||||
math.ranges namespaces sequences sets summary system
|
math.order math.ranges namespaces sequences sets summary system
|
||||||
vocabs.loader ;
|
vocabs.loader ;
|
||||||
IN: random
|
IN: random
|
||||||
|
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
! Copyright (C) 2009 Doug Coleman.
|
! Copyright (C) 2009 Doug Coleman.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: accessors alien.c-types kernel locals math math.ranges
|
USING: accessors alien.c-types alien.data kernel locals math
|
||||||
math.bitwise math.vectors math.vectors.simd random
|
math.ranges math.bitwise math.vectors math.vectors.simd random
|
||||||
sequences specialized-arrays sequences.private classes.struct
|
sequences specialized-arrays sequences.private classes.struct
|
||||||
combinators.short-circuit fry ;
|
combinators.short-circuit fry ;
|
||||||
SPECIALIZED-ARRAY: uint
|
SPECIALIZED-ARRAY: uint
|
||||||
|
|
|
@ -41,7 +41,7 @@ ARTICLE: "specialized-array-words" "Specialized array words"
|
||||||
{ { $snippet "T-array" } { "The class of arrays with elements of type " { $snippet "T" } } }
|
{ { $snippet "T-array" } { "The class of arrays with elements of type " { $snippet "T" } } }
|
||||||
{ { $snippet "<T-array>" } { "Constructor for arrays with elements of type " { $snippet "T" } "; stack effect " { $snippet "( len -- array )" } } }
|
{ { $snippet "<T-array>" } { "Constructor for arrays with elements of type " { $snippet "T" } "; stack effect " { $snippet "( len -- array )" } } }
|
||||||
{ { $snippet "(T-array)" } { "Constructor for arrays with elements of type " { $snippet "T" } ", where the initial contents are uninitialized; stack effect " { $snippet "( len -- array )" } } }
|
{ { $snippet "(T-array)" } { "Constructor for arrays with elements of type " { $snippet "T" } ", where the initial contents are uninitialized; stack effect " { $snippet "( len -- array )" } } }
|
||||||
{ { $snippet "malloc-T-array" } { "Constructor for arrays with elements of type " { $snippet "T" } " backed by newly-allocated unmanaged memory; stack effect " { $snippet "( alien len -- array )" } } }
|
{ { $snippet "malloc-T-array" } { "Constructor for arrays with elements of type " { $snippet "T" } " backed by newly-allocated, zeroed out, unmanaged memory; stack effect " { $snippet "( len -- array )" } } }
|
||||||
{ { $snippet "<direct-T-array>" } { "Constructor for arrays with elements of type " { $snippet "T" } " backed by raw memory; stack effect " { $snippet "( alien len -- array )" } } }
|
{ { $snippet "<direct-T-array>" } { "Constructor for arrays with elements of type " { $snippet "T" } " backed by raw memory; stack effect " { $snippet "( alien len -- array )" } } }
|
||||||
{ { $snippet "T-array-cast" } { "Converts a byte array into a specialized array by interpreting the bytes in as machine-specific values. Code which uses this word is unportable" } }
|
{ { $snippet "T-array-cast" } { "Converts a byte array into a specialized array by interpreting the bytes in as machine-specific values. Code which uses this word is unportable" } }
|
||||||
{ { $snippet ">T-array" } { "Converts a sequence into a specialized array of type " { $snippet "T" } "; stack effect " { $snippet "( seq -- array )" } } }
|
{ { $snippet ">T-array" } { "Converts a sequence into a specialized array of type " { $snippet "T" } "; stack effect " { $snippet "( seq -- array )" } } }
|
||||||
|
@ -86,7 +86,7 @@ $nl
|
||||||
}
|
}
|
||||||
"Finally, sometimes a C library returns a pointer to an array in unmanaged memory, together with a length. In this case, a specialized array can be constructed to view this memory using " { $snippet "<direct-T-array>" } ":"
|
"Finally, sometimes a C library returns a pointer to an array in unmanaged memory, together with a length. In this case, a specialized array can be constructed to view this memory using " { $snippet "<direct-T-array>" } ":"
|
||||||
{ $code
|
{ $code
|
||||||
"USING: alien.c-types classes.struct ;"
|
"USING: alien.c-types alien.data classes.struct ;"
|
||||||
""
|
""
|
||||||
"STRUCT: device_info"
|
"STRUCT: device_info"
|
||||||
" { id int }"
|
" { id int }"
|
||||||
|
|
|
@ -6,7 +6,8 @@ multiline eval words vocabs namespaces assocs prettyprint
|
||||||
alien.data math.vectors definitions compiler.test ;
|
alien.data math.vectors definitions compiler.test ;
|
||||||
FROM: specialized-arrays.private => specialized-array-vocab ;
|
FROM: specialized-arrays.private => specialized-array-vocab ;
|
||||||
FROM: alien.c-types => int float bool char float ulonglong ushort uint
|
FROM: alien.c-types => int float bool char float ulonglong ushort uint
|
||||||
heap-size little-endian? ;
|
heap-size ;
|
||||||
|
FROM: alien.data => little-endian? ;
|
||||||
IN: specialized-arrays.tests
|
IN: specialized-arrays.tests
|
||||||
|
|
||||||
SPECIALIZED-ARRAY: int
|
SPECIALIZED-ARRAY: int
|
||||||
|
|
|
@ -338,7 +338,6 @@ M: object infer-call* \ call bad-macro-input ;
|
||||||
\ bignum> { bignum bignum } { object } define-primitive \ bignum> make-foldable
|
\ bignum> { bignum bignum } { object } define-primitive \ bignum> make-foldable
|
||||||
\ bignum>= { bignum bignum } { object } define-primitive \ bignum>= make-foldable
|
\ bignum>= { bignum bignum } { object } define-primitive \ bignum>= make-foldable
|
||||||
\ bignum>fixnum { bignum } { fixnum } define-primitive \ bignum>fixnum make-foldable
|
\ bignum>fixnum { bignum } { fixnum } define-primitive \ bignum>fixnum make-foldable
|
||||||
\ bignum>float { bignum } { float } define-primitive \ bignum>float make-foldable
|
|
||||||
\ bits>double { integer } { float } define-primitive \ bits>double make-foldable
|
\ bits>double { integer } { float } define-primitive \ bits>double make-foldable
|
||||||
\ bits>float { integer } { float } define-primitive \ bits>float make-foldable
|
\ bits>float { integer } { float } define-primitive \ bits>float make-foldable
|
||||||
\ both-fixnums? { object object } { object } define-primitive
|
\ both-fixnums? { object object } { object } define-primitive
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
! Copyright (C) 2008 Doug Coleman.
|
! Copyright (C) 2008 Doug Coleman.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: alien alien.c-types alien.strings alien.syntax
|
USING: alien alien.c-types alien.data alien.strings alien.syntax
|
||||||
byte-arrays kernel namespaces sequences unix
|
byte-arrays kernel namespaces sequences unix
|
||||||
system-info.backend system io.encodings.utf8 ;
|
system-info.backend system io.encodings.utf8 ;
|
||||||
IN: system-info.macosx
|
IN: system-info.macosx
|
||||||
|
|
|
@ -1,10 +1,9 @@
|
||||||
! Copyright (C) 2008 Doug Coleman.
|
! Copyright (C) 2008 Doug Coleman.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: accessors alien alien.c-types alien.strings byte-arrays
|
USING: accessors alien alien.c-types alien.data alien.strings
|
||||||
classes.struct combinators kernel math namespaces
|
byte-arrays classes.struct combinators kernel math namespaces
|
||||||
specialized-arrays system
|
specialized-arrays system system-info.backend vocabs.loader
|
||||||
system-info.backend vocabs.loader windows windows.advapi32
|
windows windows.advapi32 windows.errors windows.kernel32 words ;
|
||||||
windows.errors windows.kernel32 words ;
|
|
||||||
SPECIALIZED-ARRAY: ushort
|
SPECIALIZED-ARRAY: ushort
|
||||||
IN: system-info.windows
|
IN: system-info.windows
|
||||||
|
|
||||||
|
|
|
@ -28,7 +28,7 @@ HELP: uses
|
||||||
{ $notes "The sequence might include the definition itself, if it is a recursive word." }
|
{ $notes "The sequence might include the definition itself, if it is a recursive word." }
|
||||||
{ $examples
|
{ $examples
|
||||||
"We can ask the " { $link sq } " word to produce a list of words it calls:"
|
"We can ask the " { $link sq } " word to produce a list of words it calls:"
|
||||||
{ $unchecked-example "\ sq uses ." "{ dup * }" }
|
{ $unchecked-example "\\ sq uses ." "{ dup * }" }
|
||||||
} ;
|
} ;
|
||||||
|
|
||||||
HELP: crossref
|
HELP: crossref
|
||||||
|
|
|
@ -40,13 +40,15 @@ HELP: deploy-c-types?
|
||||||
$nl
|
$nl
|
||||||
"Off by default."
|
"Off by default."
|
||||||
$nl
|
$nl
|
||||||
"The optimizing compiler is able to fold away calls to various words which take a C type as an input if the C type is a literal string:"
|
"The optimizing compiler is able to fold away calls to various words which take a C type as an input if the C type is a literal string, for example,"
|
||||||
{ $list
|
{ $list
|
||||||
{ $link c-type }
|
{ $link c-type }
|
||||||
{ $link heap-size }
|
{ $link heap-size }
|
||||||
{ $link <c-object> }
|
|
||||||
{ $link <c-array> }
|
{ $link <c-array> }
|
||||||
|
{ $link <c-direct-array> }
|
||||||
{ $link malloc-array }
|
{ $link malloc-array }
|
||||||
|
{ $link <ref> }
|
||||||
|
{ $link deref }
|
||||||
}
|
}
|
||||||
"If your program looks up C types dynamically or from words which do not have a stack effect, you must enable this flag, because in these situations the C type lookup code is not folded away and the word properties must be consulted at runtime." } ;
|
"If your program looks up C types dynamically or from words which do not have a stack effect, you must enable this flag, because in these situations the C type lookup code is not folded away and the word properties must be consulted at runtime." } ;
|
||||||
|
|
||||||
|
|
|
@ -1,19 +1,19 @@
|
||||||
! Copyright (C) 2005, 2006 Doug Coleman.
|
! Copyright (C) 2005, 2006 Doug Coleman.
|
||||||
! Portions copyright (C) 2007, 2010 Slava Pestov.
|
! Portions copyright (C) 2007, 2010 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: alien alien.c-types alien.strings arrays assocs ui
|
USING: alien alien.data alien.strings arrays assocs ui
|
||||||
ui.private ui.gadgets ui.gadgets.private ui.backend
|
ui.private ui.gadgets ui.gadgets.private ui.backend
|
||||||
ui.clipboards ui.gadgets.worlds ui.gestures ui.event-loop io
|
ui.clipboards ui.gadgets.worlds ui.gestures ui.event-loop io
|
||||||
kernel math math.vectors namespaces make sequences strings
|
kernel math math.vectors namespaces make sequences strings
|
||||||
vectors words windows.dwmapi system-info.windows windows.kernel32
|
vectors words windows.dwmapi system-info.windows
|
||||||
windows.gdi32 windows.user32 windows.opengl32 windows.messages
|
windows.kernel32 windows.gdi32 windows.user32 windows.opengl32
|
||||||
windows.types windows.offscreen windows threads libc combinators
|
windows.messages windows.types windows.offscreen windows threads
|
||||||
fry combinators.short-circuit continuations command-line shuffle
|
libc combinators fry combinators.short-circuit continuations
|
||||||
opengl ui.render math.bitwise locals accessors math.rectangles
|
command-line shuffle opengl ui.render math.bitwise locals
|
||||||
math.order calendar ascii sets io.encodings.utf16n
|
accessors math.rectangles math.order calendar ascii sets
|
||||||
windows.errors literals ui.pixel-formats
|
io.encodings.utf16n windows.errors literals ui.pixel-formats
|
||||||
ui.pixel-formats.private memoize classes colors
|
ui.pixel-formats.private memoize classes colors
|
||||||
specialized-arrays classes.struct alien.data ;
|
specialized-arrays classes.struct ;
|
||||||
FROM: namespaces => set ;
|
FROM: namespaces => set ;
|
||||||
SPECIALIZED-ARRAY: POINT
|
SPECIALIZED-ARRAY: POINT
|
||||||
QUALIFIED-WITH: alien.c-types c
|
QUALIFIED-WITH: alien.c-types c
|
||||||
|
@ -60,14 +60,14 @@ PIXEL-FORMAT-ATTRIBUTE-TABLE: WGL_ARB { $ WGL_SUPPORT_OPENGL_ARB 1 } H{
|
||||||
drop f ;
|
drop f ;
|
||||||
|
|
||||||
: arb-make-pixel-format ( world attributes -- pf )
|
: arb-make-pixel-format ( world attributes -- pf )
|
||||||
[ handle>> hDC>> ] dip >WGL_ARB-int-array f 1 { int int }
|
[ handle>> hDC>> ] dip >WGL_ARB-int-array f 1 { c:int c:int }
|
||||||
[ wglChoosePixelFormatARB win32-error=0/f ] with-out-parameters drop ;
|
[ wglChoosePixelFormatARB win32-error=0/f ] with-out-parameters drop ;
|
||||||
|
|
||||||
: arb-pixel-format-attribute ( pixel-format attribute -- value )
|
: arb-pixel-format-attribute ( pixel-format attribute -- value )
|
||||||
>WGL_ARB
|
>WGL_ARB
|
||||||
[ drop f ] [
|
[ drop f ] [
|
||||||
[ [ world>> handle>> hDC>> ] [ handle>> ] bi 0 1 ] dip
|
[ [ world>> handle>> hDC>> ] [ handle>> ] bi 0 1 ] dip
|
||||||
first int <ref> { int }
|
first c:int <ref> { c:int }
|
||||||
[ wglGetPixelFormatAttribivARB win32-error=0/f ]
|
[ wglGetPixelFormatAttribivARB win32-error=0/f ]
|
||||||
with-out-parameters
|
with-out-parameters
|
||||||
] if-empty ;
|
] if-empty ;
|
||||||
|
@ -96,7 +96,7 @@ CONSTANT: pfd-flag-map H{
|
||||||
: >pfd ( attributes -- pfd )
|
: >pfd ( attributes -- pfd )
|
||||||
[ PIXELFORMATDESCRIPTOR <struct> ] dip
|
[ PIXELFORMATDESCRIPTOR <struct> ] dip
|
||||||
{
|
{
|
||||||
[ drop PIXELFORMATDESCRIPTOR heap-size >>nSize ]
|
[ drop PIXELFORMATDESCRIPTOR c:heap-size >>nSize ]
|
||||||
[ drop 1 >>nVersion ]
|
[ drop 1 >>nVersion ]
|
||||||
[ >pfd-flags >>dwFlags ]
|
[ >pfd-flags >>dwFlags ]
|
||||||
[ drop PFD_TYPE_RGBA >>iPixelType ]
|
[ drop PFD_TYPE_RGBA >>iPixelType ]
|
||||||
|
@ -122,12 +122,12 @@ CONSTANT: pfd-flag-map H{
|
||||||
|
|
||||||
: get-pfd ( pixel-format -- pfd )
|
: get-pfd ( pixel-format -- pfd )
|
||||||
[ world>> handle>> hDC>> ] [ handle>> ] bi
|
[ world>> handle>> hDC>> ] [ handle>> ] bi
|
||||||
PIXELFORMATDESCRIPTOR heap-size
|
PIXELFORMATDESCRIPTOR c:heap-size
|
||||||
PIXELFORMATDESCRIPTOR <struct>
|
PIXELFORMATDESCRIPTOR <struct>
|
||||||
[ DescribePixelFormat win32-error=0/f ] keep ;
|
[ DescribePixelFormat win32-error=0/f ] keep ;
|
||||||
|
|
||||||
: pfd-flag? ( pfd flag -- ? )
|
: pfd-flag? ( pfd flag -- ? )
|
||||||
[ dwFlags>> ] dip bitand c-bool> ;
|
[ dwFlags>> ] dip bitand c:c-bool> ;
|
||||||
|
|
||||||
: (pfd-pixel-format-attribute) ( pfd attribute -- value )
|
: (pfd-pixel-format-attribute) ( pfd attribute -- value )
|
||||||
{
|
{
|
||||||
|
@ -525,7 +525,7 @@ SYMBOL: nc-buttons
|
||||||
: make-TRACKMOUSEEVENT ( hWnd -- alien )
|
: make-TRACKMOUSEEVENT ( hWnd -- alien )
|
||||||
TRACKMOUSEEVENT <struct>
|
TRACKMOUSEEVENT <struct>
|
||||||
swap >>hwndTrack
|
swap >>hwndTrack
|
||||||
TRACKMOUSEEVENT heap-size >>cbSize ;
|
TRACKMOUSEEVENT c:heap-size >>cbSize ;
|
||||||
|
|
||||||
: handle-wm-mousemove ( hWnd uMsg wParam lParam -- )
|
: handle-wm-mousemove ( hWnd uMsg wParam lParam -- )
|
||||||
2nip
|
2nip
|
||||||
|
@ -614,7 +614,7 @@ SYMBOL: trace-messages?
|
||||||
|
|
||||||
! return 0 if you handle the message, else just let DefWindowProc return its val
|
! return 0 if you handle the message, else just let DefWindowProc return its val
|
||||||
: ui-wndproc ( -- object )
|
: ui-wndproc ( -- object )
|
||||||
uint { void* uint long long } stdcall [
|
c:uint { c:void* c:uint c:long c:long } stdcall [
|
||||||
pick
|
pick
|
||||||
|
|
||||||
trace-messages? get-global
|
trace-messages? get-global
|
||||||
|
@ -636,7 +636,7 @@ M: windows-ui-backend do-events
|
||||||
:: register-window-class ( class-name-ptr -- )
|
:: register-window-class ( class-name-ptr -- )
|
||||||
WNDCLASSEX <struct> f GetModuleHandle
|
WNDCLASSEX <struct> f GetModuleHandle
|
||||||
class-name-ptr pick GetClassInfoEx 0 = [
|
class-name-ptr pick GetClassInfoEx 0 = [
|
||||||
WNDCLASSEX heap-size >>cbSize
|
WNDCLASSEX c:heap-size >>cbSize
|
||||||
flags{ CS_HREDRAW CS_VREDRAW CS_OWNDC } >>style
|
flags{ CS_HREDRAW CS_VREDRAW CS_OWNDC } >>style
|
||||||
ui-wndproc >>lpfnWndProc
|
ui-wndproc >>lpfnWndProc
|
||||||
0 >>cbClsExtra
|
0 >>cbClsExtra
|
||||||
|
@ -799,7 +799,7 @@ M: windows-ui-backend system-alert
|
||||||
: fullscreen-RECT ( hwnd -- RECT )
|
: fullscreen-RECT ( hwnd -- RECT )
|
||||||
MONITOR_DEFAULTTONEAREST MonitorFromWindow
|
MONITOR_DEFAULTTONEAREST MonitorFromWindow
|
||||||
MONITORINFOEX <struct>
|
MONITORINFOEX <struct>
|
||||||
MONITORINFOEX heap-size >>cbSize
|
MONITORINFOEX c:heap-size >>cbSize
|
||||||
[ GetMonitorInfo win32-error=0/f ] keep rcMonitor>> ;
|
[ GetMonitorInfo win32-error=0/f ] keep rcMonitor>> ;
|
||||||
|
|
||||||
: client-area>RECT ( hwnd -- RECT )
|
: client-area>RECT ( hwnd -- RECT )
|
||||||
|
|
|
@ -45,8 +45,7 @@ ARTICLE: "ui.pixel-formats-attributes" "Pixel format attributes"
|
||||||
}
|
}
|
||||||
{ $examples
|
{ $examples
|
||||||
"The following " { $link world } " subclass will request a double-buffered window with minimum 24-bit color and depth buffers, and will throw an error if the requirements aren't met:"
|
"The following " { $link world } " subclass will request a double-buffered window with minimum 24-bit color and depth buffers, and will throw an error if the requirements aren't met:"
|
||||||
{ $code """
|
{ $code """USING: kernel ui.gadgets.worlds ui.pixel-formats ;
|
||||||
USING: kernel ui.worlds ui.pixel-formats ;
|
|
||||||
IN: ui.pixel-formats.examples
|
IN: ui.pixel-formats.examples
|
||||||
|
|
||||||
TUPLE: picky-depth-buffered-world < world ;
|
TUPLE: picky-depth-buffered-world < world ;
|
||||||
|
@ -63,8 +62,7 @@ M: picky-depth-buffered-world check-world-pixel-format
|
||||||
[ double-buffered pixel-format-attribute 0 = [ "Not double buffered!" throw ] when ]
|
[ double-buffered pixel-format-attribute 0 = [ "Not double buffered!" throw ] when ]
|
||||||
[ color-bits pixel-format-attribute 24 < [ "Not enough color bits!" throw ] when ]
|
[ color-bits pixel-format-attribute 24 < [ "Not enough color bits!" throw ] when ]
|
||||||
[ depth-bits pixel-format-attribute 24 < [ "Not enough depth bits!" throw ] when ]
|
[ depth-bits pixel-format-attribute 24 < [ "Not enough depth bits!" throw ] when ]
|
||||||
tri ;
|
tri ;""" } }
|
||||||
""" } }
|
|
||||||
;
|
;
|
||||||
|
|
||||||
HELP: double-buffered
|
HELP: double-buffered
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
! Copyright (C) 2008 Doug Coleman.
|
! Copyright (C) 2008 Doug Coleman.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: accessors alien alien.c-types alien.strings assocs
|
USING: accessors alien alien.c-types alien.data alien.strings
|
||||||
byte-arrays classes.struct combinators
|
assocs byte-arrays classes.struct combinators
|
||||||
combinators.short-circuit continuations fry io.backend.unix
|
combinators.short-circuit continuations fry io.backend.unix
|
||||||
io.encodings.utf8 kernel math math.parser namespaces sequences
|
io.encodings.utf8 kernel math math.parser namespaces sequences
|
||||||
splitting strings unix unix.ffi unix.users unix.utilities ;
|
splitting strings unix unix.ffi unix.users unix.utilities ;
|
||||||
|
|
|
@ -31,5 +31,3 @@ TYPEDEF: ulonglong __fsblkcnt64_t
|
||||||
TYPEDEF: ulonglong __fsfilcnt64_t
|
TYPEDEF: ulonglong __fsfilcnt64_t
|
||||||
TYPEDEF: ulonglong ino64_t
|
TYPEDEF: ulonglong ino64_t
|
||||||
TYPEDEF: ulonglong off64_t
|
TYPEDEF: ulonglong off64_t
|
||||||
|
|
||||||
: <time_t> ( n -- long ) long <ref> ;
|
|
||||||
|
|
|
@ -1,4 +1,4 @@
|
||||||
USING: strings help.markup help.syntax assocs ;
|
USING: strings help.markup help.syntax assocs urls ;
|
||||||
IN: urls.encoding
|
IN: urls.encoding
|
||||||
|
|
||||||
HELP: url-decode
|
HELP: url-decode
|
||||||
|
|
|
@ -1,7 +1,8 @@
|
||||||
USING: kernel windows.com windows.com.syntax windows.ole32
|
USING: kernel windows.com windows.com.syntax windows.ole32
|
||||||
windows.types alien alien.syntax tools.test libc alien.c-types
|
windows.types alien alien.data alien.syntax tools.test libc
|
||||||
namespaces arrays continuations accessors math windows.com.wrapper
|
alien.c-types namespaces arrays continuations accessors math
|
||||||
windows.com.wrapper.private destructors effects compiler.units ;
|
windows.com.wrapper windows.com.wrapper.private destructors
|
||||||
|
effects compiler.units ;
|
||||||
IN: windows.com.tests
|
IN: windows.com.tests
|
||||||
|
|
||||||
COM-INTERFACE: ISimple IUnknown {216fb341-0eb2-44b1-8edb-60b76e353abc}
|
COM-INTERFACE: ISimple IUnknown {216fb341-0eb2-44b1-8edb-60b76e353abc}
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
USING: alien alien.c-types alien.accessors alien.parser
|
USING: alien alien.c-types alien.data alien.accessors
|
||||||
effects kernel windows.ole32 parser lexer splitting grouping
|
alien.parser effects kernel windows.ole32 parser lexer splitting
|
||||||
sequences namespaces assocs quotations generalizations
|
grouping sequences namespaces assocs quotations generalizations
|
||||||
accessors words macros alien.syntax fry arrays layouts math
|
accessors words macros alien.syntax fry arrays layouts math
|
||||||
classes.struct windows.kernel32 locals ;
|
classes.struct windows.kernel32 locals ;
|
||||||
FROM: alien.parser.private => parse-pointers return-type-name ;
|
FROM: alien.parser.private => parse-pointers return-type-name ;
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
! Copyright (C) 2010 Doug Coleman.
|
! Copyright (C) 2010 Doug Coleman.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: accessors alien alien.c-types alien.syntax
|
USING: accessors alien alien.c-types alien.data alien.syntax
|
||||||
classes.struct io.encodings.string io.encodings.utf8 kernel
|
classes.struct io.encodings.string io.encodings.utf8 kernel
|
||||||
make sequences windows.errors windows.types ;
|
make sequences windows.errors windows.types ;
|
||||||
IN: windows.iphlpapi
|
IN: windows.iphlpapi
|
||||||
|
|
|
@ -13,7 +13,7 @@ samDesired lpSecurityAttributes phkResult lpdwDisposition ;
|
||||||
CONSTANT: registry-value-max-length 16384
|
CONSTANT: registry-value-max-length 16384
|
||||||
|
|
||||||
:: open-key ( key subkey mode -- hkey )
|
:: open-key ( key subkey mode -- hkey )
|
||||||
key subkey 0 mode HKEY <c-object>
|
key subkey 0 mode 0 HKEY <ref>
|
||||||
[
|
[
|
||||||
RegOpenKeyEx dup ERROR_SUCCESS = [
|
RegOpenKeyEx dup ERROR_SUCCESS = [
|
||||||
drop
|
drop
|
||||||
|
@ -21,16 +21,16 @@ CONSTANT: registry-value-max-length 16384
|
||||||
[ key subkey mode ] dip n>win32-error-string
|
[ key subkey mode ] dip n>win32-error-string
|
||||||
open-key-failed
|
open-key-failed
|
||||||
] if
|
] if
|
||||||
] keep uint deref ;
|
] keep HKEY deref ;
|
||||||
|
|
||||||
:: create-key* ( hKey lpSubKey lpClass dwOptions samDesired lpSecurityAttributes -- hkey new? )
|
:: create-key* ( hKey lpSubKey lpClass dwOptions samDesired lpSecurityAttributes -- hkey new? )
|
||||||
hKey lpSubKey 0 lpClass dwOptions samDesired lpSecurityAttributes
|
|
||||||
HKEY <c-object>
|
|
||||||
DWORD <c-object>
|
|
||||||
f :> ret!
|
f :> ret!
|
||||||
|
hKey lpSubKey 0 lpClass dwOptions samDesired lpSecurityAttributes
|
||||||
|
0 HKEY <ref>
|
||||||
|
0 DWORD <ref>
|
||||||
[ RegCreateKeyEx ret! ] 2keep
|
[ RegCreateKeyEx ret! ] 2keep
|
||||||
[ uint deref ]
|
[ HKEY deref ]
|
||||||
[ uint deref REG_CREATED_NEW_KEY = ] bi*
|
[ DWORD deref REG_CREATED_NEW_KEY = ] bi*
|
||||||
ret ERROR_SUCCESS = [
|
ret ERROR_SUCCESS = [
|
||||||
[
|
[
|
||||||
hKey lpSubKey 0 lpClass dwOptions samDesired
|
hKey lpSubKey 0 lpClass dwOptions samDesired
|
||||||
|
@ -103,9 +103,9 @@ TUPLE: registry-enum-key ;
|
||||||
registry-value-max-length TCHAR <c-array> dup :> registry-value
|
registry-value-max-length TCHAR <c-array> dup :> registry-value
|
||||||
registry-value length dup :> registry-value-length
|
registry-value length dup :> registry-value-length
|
||||||
f
|
f
|
||||||
DWORD <c-object> dup :> type
|
0 DWORD <ref> dup :> type
|
||||||
f ! BYTE <c-object> dup :> data
|
f ! 0 BYTE <ref> dup :> data
|
||||||
f ! BYTE <c-object> dup :> buffer
|
f ! 0 BYTE <ref> dup :> buffer
|
||||||
RegEnumKeyEx dup ERROR_SUCCESS = [
|
RegEnumKeyEx dup ERROR_SUCCESS = [
|
||||||
|
|
||||||
] [
|
] [
|
||||||
|
@ -118,13 +118,13 @@ TUPLE: registry-enum-key ;
|
||||||
dup TCHAR <c-array> dup :> class-buffer
|
dup TCHAR <c-array> dup :> class-buffer
|
||||||
swap int <ref> dup :> class-buffer-length
|
swap int <ref> dup :> class-buffer-length
|
||||||
f
|
f
|
||||||
DWORD <c-object> dup :> sub-keys
|
0 DWORD <ref> dup :> sub-keys
|
||||||
DWORD <c-object> dup :> longest-subkey
|
0 DWORD <ref> dup :> longest-subkey
|
||||||
DWORD <c-object> dup :> longest-class-string
|
0 DWORD <ref> dup :> longest-class-string
|
||||||
DWORD <c-object> dup :> #values
|
0 DWORD <ref> dup :> #values
|
||||||
DWORD <c-object> dup :> max-value
|
0 DWORD <ref> dup :> max-value
|
||||||
DWORD <c-object> dup :> max-value-data
|
0 DWORD <ref> dup :> max-value-data
|
||||||
DWORD <c-object> dup :> security-descriptor
|
0 DWORD <ref> dup :> security-descriptor
|
||||||
FILETIME <struct> dup :> last-write-time
|
FILETIME <struct> dup :> last-write-time
|
||||||
RegQueryInfoKey :> ret
|
RegQueryInfoKey :> ret
|
||||||
ret ERROR_SUCCESS = [
|
ret ERROR_SUCCESS = [
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
! Copyright (C) 2006, 2010 Slava Pestov
|
! Copyright (C) 2006, 2010 Slava Pestov
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: accessors alien.c-types alien.strings classes.struct
|
USING: accessors alien.c-types alien.data alien.strings
|
||||||
io.encodings.utf8 kernel namespaces sequences
|
classes.struct io.encodings.utf8 kernel namespaces sequences
|
||||||
specialized-arrays x11 x11.constants x11.xlib ;
|
specialized-arrays x11 x11.constants x11.xlib ;
|
||||||
SPECIALIZED-ARRAY: int
|
SPECIALIZED-ARRAY: int
|
||||||
IN: x11.clipboard
|
IN: x11.clipboard
|
||||||
|
|
|
@ -1,8 +1,9 @@
|
||||||
! Copyright (C) 2005, 2010 Eduardo Cavazos, Slava Pestov.
|
! Copyright (C) 2005, 2010 Eduardo Cavazos, Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: accessors alien.c-types kernel math math.bitwise
|
USING: accessors alien.c-types alien.data kernel math
|
||||||
math.vectors namespaces sequences arrays fry classes.struct
|
math.bitwise math.vectors namespaces sequences arrays fry
|
||||||
literals x11 x11.xlib x11.constants x11.events x11.glx ;
|
classes.struct literals x11 x11.xlib x11.constants x11.events
|
||||||
|
x11.glx ;
|
||||||
IN: x11.windows
|
IN: x11.windows
|
||||||
|
|
||||||
CONSTANT: create-window-mask
|
CONSTANT: create-window-mask
|
||||||
|
|
|
@ -1,8 +1,8 @@
|
||||||
! Copyright (C) 2007, 2008 Slava Pestov
|
! Copyright (C) 2007, 2008 Slava Pestov
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: alien alien.c-types alien.strings arrays byte-arrays
|
USING: alien alien.c-types alien.data alien.strings arrays
|
||||||
hashtables io io.encodings.string kernel math namespaces
|
byte-arrays hashtables io io.encodings.string kernel math
|
||||||
sequences strings continuations x11 x11.xlib
|
namespaces sequences strings continuations x11 x11.xlib
|
||||||
specialized-arrays accessors io.encodings.utf16n ;
|
specialized-arrays accessors io.encodings.utf16n ;
|
||||||
SPECIALIZED-ARRAY: uint
|
SPECIALIZED-ARRAY: uint
|
||||||
IN: x11.xim
|
IN: x11.xim
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
! Copyright (C) 2010 Niklas Waern.
|
! Copyright (C) 2010 Niklas Waern.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: alien.c-types combinators kernel namespaces x11
|
USING: alien.c-types alien.data combinators kernel namespaces
|
||||||
x11.constants x11.xinput2.ffi ;
|
x11 x11.constants x11.xinput2.ffi ;
|
||||||
IN: x11.xinput2
|
IN: x11.xinput2
|
||||||
|
|
||||||
: (xi2-available?) ( display -- ? )
|
: (xi2-available?) ( display -- ? )
|
||||||
|
|
|
@ -491,7 +491,6 @@ tuple
|
||||||
{ "bignum>" "math.private" "primitive_bignum_greater" (( x y -- ? )) }
|
{ "bignum>" "math.private" "primitive_bignum_greater" (( x y -- ? )) }
|
||||||
{ "bignum>=" "math.private" "primitive_bignum_greatereq" (( x y -- ? )) }
|
{ "bignum>=" "math.private" "primitive_bignum_greatereq" (( x y -- ? )) }
|
||||||
{ "bignum>fixnum" "math.private" "primitive_bignum_to_fixnum" (( x -- y )) }
|
{ "bignum>fixnum" "math.private" "primitive_bignum_to_fixnum" (( x -- y )) }
|
||||||
{ "bignum>float" "math.private" "primitive_bignum_to_float" (( x -- y )) }
|
|
||||||
{ "fixnum-shift" "math.private" "primitive_fixnum_shift" (( x y -- z )) }
|
{ "fixnum-shift" "math.private" "primitive_fixnum_shift" (( x y -- z )) }
|
||||||
{ "fixnum/i" "math.private" "primitive_fixnum_divint" (( x y -- z )) }
|
{ "fixnum/i" "math.private" "primitive_fixnum_divint" (( x y -- z )) }
|
||||||
{ "fixnum/mod" "math.private" "primitive_fixnum_divmod" (( x y -- z w )) }
|
{ "fixnum/mod" "math.private" "primitive_fixnum_divmod" (( x y -- z w )) }
|
||||||
|
|
|
@ -190,7 +190,7 @@ $nl
|
||||||
{ $subsections
|
{ $subsections
|
||||||
"tuple-inheritance-example"
|
"tuple-inheritance-example"
|
||||||
"tuple-inheritance-anti-example"
|
"tuple-inheritance-anti-example"
|
||||||
}
|
}
|
||||||
"Declaring a tuple class final prohibits other classes from subclassing it:"
|
"Declaring a tuple class final prohibits other classes from subclassing it:"
|
||||||
{ $subsections POSTPONE: final }
|
{ $subsections POSTPONE: final }
|
||||||
{ $see-also "call-next-method" "parametrized-constructors" "unions" "mixins" } ;
|
{ $see-also "call-next-method" "parametrized-constructors" "unions" "mixins" } ;
|
||||||
|
@ -215,12 +215,14 @@ ARTICLE: "tuple-examples" "Tuple examples"
|
||||||
{ $table
|
{ $table
|
||||||
{ "Reader" "Writer" "Setter" "Changer" }
|
{ "Reader" "Writer" "Setter" "Changer" }
|
||||||
{ { $snippet "name>>" } { $snippet "name<<" } { $snippet ">>name" } { $snippet "change-name" } }
|
{ { $snippet "name>>" } { $snippet "name<<" } { $snippet ">>name" } { $snippet "change-name" } }
|
||||||
|
{ { $snippet "position>>" } { $snippet "position<<" } { $snippet ">>position" } { $snippet "change-position" } }
|
||||||
{ { $snippet "salary>>" } { $snippet "salary<<" } { $snippet ">>salary" } { $snippet "change-salary" } }
|
{ { $snippet "salary>>" } { $snippet "salary<<" } { $snippet ">>salary" } { $snippet "change-salary" } }
|
||||||
{ { $snippet "position>>" } { $snippet "position<<" } { $snippet ">>position" } { $snippet "change-position" } }
|
|
||||||
}
|
}
|
||||||
"We can define a constructor which makes an empty employee:"
|
"We can define a constructor which makes an empty employee:"
|
||||||
{ $code ": <employee> ( -- employee )"
|
{ $code
|
||||||
" employee new ;" }
|
": <employee> ( -- employee )"
|
||||||
|
" employee new ;"
|
||||||
|
}
|
||||||
"Or we may wish the default constructor to always give employees a starting salary:"
|
"Or we may wish the default constructor to always give employees a starting salary:"
|
||||||
{ $code
|
{ $code
|
||||||
": <employee> ( -- employee )"
|
": <employee> ( -- employee )"
|
||||||
|
|
|
@ -129,7 +129,7 @@ HELP: define-generic
|
||||||
HELP: M\
|
HELP: M\
|
||||||
{ $syntax "M\\ class generic" }
|
{ $syntax "M\\ class generic" }
|
||||||
{ $class-description "Pushes a method on the stack." }
|
{ $class-description "Pushes a method on the stack." }
|
||||||
{ $examples { $code "M\\ fixnum + see" } { $code "USING: ui.gadgets ui.gadgets.editors ;" "M\\ editor draw-gadget* edit" } } ;
|
{ $examples { $code "M\\ fixnum + see" } { $code "USING: ui.gadgets.editors ui.render ;" "M\\ editor draw-gadget* edit" } } ;
|
||||||
|
|
||||||
HELP: method
|
HELP: method
|
||||||
{ $values { "class" class } { "generic" generic } { "method/f" { $maybe method } } }
|
{ $values { "class" class } { "generic" generic } { "method/f" { $maybe method } } }
|
||||||
|
|
|
@ -19,6 +19,7 @@ M: hash-set members table>> keys ; inline
|
||||||
M: hash-set set-like drop dup hash-set? [ members <hash-set> ] unless ;
|
M: hash-set set-like drop dup hash-set? [ members <hash-set> ] unless ;
|
||||||
M: hash-set clone table>> clone hash-set boa ;
|
M: hash-set clone table>> clone hash-set boa ;
|
||||||
M: hash-set null? table>> assoc-empty? ;
|
M: hash-set null? table>> assoc-empty? ;
|
||||||
|
M: hash-set cardinality table>> assoc-size ;
|
||||||
|
|
||||||
M: sequence fast-set <hash-set> ;
|
M: sequence fast-set <hash-set> ;
|
||||||
M: f fast-set drop H{ } clone hash-set boa ;
|
M: f fast-set drop H{ } clone hash-set boa ;
|
||||||
|
|
|
@ -1,4 +1,4 @@
|
||||||
USING: accessors alien.c-types kernel
|
USING: accessors alien.c-types alien.data kernel
|
||||||
io.encodings.utf16 io.streams.byte-array tools.test ;
|
io.encodings.utf16 io.streams.byte-array tools.test ;
|
||||||
IN: io.encodings.utf16n
|
IN: io.encodings.utf16n
|
||||||
|
|
||||||
|
|
|
@ -106,7 +106,7 @@ HELP: absolute-path
|
||||||
{ "path" "a pathname string" }
|
{ "path" "a pathname string" }
|
||||||
{ "path'" "a pathname string" }
|
{ "path'" "a pathname string" }
|
||||||
}
|
}
|
||||||
{ $description "Prepends the " { $link current-directory } " to the pathname and resolves a " { $snippet "resource:" } " or " { $snippet "voacb:" } " prefix, if present (see " { $link "io.pathnames.special" } ")." }
|
{ $description "Prepends the " { $link current-directory } " to the pathname and resolves a " { $snippet "resource:" } " or " { $snippet "vocab:" } " prefix, if present (see " { $link "io.pathnames.special" } ")." }
|
||||||
{ $notes "This word is exaclty the same as " { $link normalize-path } ", except on Windows NT platforms, where it does not prepend the Unicode path prefix. Most code should call " { $link normalize-path } " instead." } ;
|
{ $notes "This word is exaclty the same as " { $link normalize-path } ", except on Windows NT platforms, where it does not prepend the Unicode path prefix. Most code should call " { $link normalize-path } " instead." } ;
|
||||||
|
|
||||||
HELP: resolve-symlinks
|
HELP: resolve-symlinks
|
||||||
|
|
|
@ -7,9 +7,6 @@ IN: math.floats.private
|
||||||
: float-min ( x y -- z ) [ float< ] most ; foldable
|
: float-min ( x y -- z ) [ float< ] most ; foldable
|
||||||
: float-max ( x y -- z ) [ float> ] most ; foldable
|
: float-max ( x y -- z ) [ float> ] most ; foldable
|
||||||
|
|
||||||
M: fixnum >float fixnum>float ; inline
|
|
||||||
M: bignum >float bignum>float ; inline
|
|
||||||
|
|
||||||
M: float >fixnum float>fixnum ; inline
|
M: float >fixnum float>fixnum ; inline
|
||||||
M: float >bignum float>bignum ; inline
|
M: float >bignum float>bignum ; inline
|
||||||
M: float >float ; inline
|
M: float >float ; inline
|
||||||
|
|
|
@ -240,3 +240,12 @@ unit-test
|
||||||
|
|
||||||
[ 17 ] [ 17 >bignum 5 max ] unit-test
|
[ 17 ] [ 17 >bignum 5 max ] unit-test
|
||||||
[ 5 ] [ 17 >bignum 5 min ] unit-test
|
[ 5 ] [ 17 >bignum 5 min ] unit-test
|
||||||
|
|
||||||
|
[ 1 ] [ 1 202402253307310618352495346718917307049556649764142118356901358027430339567995346891960383701437124495187077864316811911389808737385793476867013399940738509921517424276566361364466907742093216341239767678472745068562007483424692698618103355649159556340810056512358769552333414615230502532186327508646006263307707741093494784 /f double>bits ] unit-test
|
||||||
|
[ 12 ] [ 3 50600563326827654588123836679729326762389162441035529589225339506857584891998836722990095925359281123796769466079202977847452184346448369216753349985184627480379356069141590341116726935523304085309941919618186267140501870856173174654525838912289889085202514128089692388083353653807625633046581877161501565826926935273373696 /f double>bits ] unit-test
|
||||||
|
[ 123 ] [ 123 202402253307310618352495346718917307049556649764142118356901358027430339567995346891960383701437124495187077864316811911389808737385793476867013399940738509921517424276566361364466907742093216341239767678472745068562007483424692698618103355649159556340810056512358769552333414615230502532186327508646006263307707741093494784 /f double>bits ] unit-test
|
||||||
|
[ 1234 ] [ 617 101201126653655309176247673359458653524778324882071059178450679013715169783997673445980191850718562247593538932158405955694904368692896738433506699970369254960758712138283180682233453871046608170619883839236372534281003741712346349309051677824579778170405028256179384776166707307615251266093163754323003131653853870546747392 /f double>bits ] unit-test
|
||||||
|
[ 1/0. ] [ 2048 2^ 1 /f ] unit-test
|
||||||
|
[ -1/0. ] [ 2048 2^ -1 /f ] unit-test
|
||||||
|
[ -1/0. ] [ 2048 2^ neg 1 /f ] unit-test
|
||||||
|
[ 1/0. ] [ 2048 2^ neg -1 /f ] unit-test
|
||||||
|
|
|
@ -14,6 +14,7 @@ M: integer denominator drop 1 ; inline
|
||||||
M: fixnum >fixnum ; inline
|
M: fixnum >fixnum ; inline
|
||||||
M: fixnum >bignum fixnum>bignum ; inline
|
M: fixnum >bignum fixnum>bignum ; inline
|
||||||
M: fixnum >integer ; inline
|
M: fixnum >integer ; inline
|
||||||
|
M: fixnum >float fixnum>float ; inline
|
||||||
|
|
||||||
M: fixnum hashcode* nip ; inline
|
M: fixnum hashcode* nip ; inline
|
||||||
M: fixnum equal? over bignum? [ >bignum bignum= ] [ 2drop f ] if ; inline
|
M: fixnum equal? over bignum? [ >bignum bignum= ] [ 2drop f ] if ; inline
|
||||||
|
@ -37,16 +38,6 @@ M: fixnum - fixnum- ; inline
|
||||||
M: fixnum * fixnum* ; inline
|
M: fixnum * fixnum* ; inline
|
||||||
M: fixnum /i fixnum/i ; inline
|
M: fixnum /i fixnum/i ; inline
|
||||||
|
|
||||||
DEFER: bignum/f
|
|
||||||
CONSTANT: bignum/f-threshold HEX: 20,0000,0000,0000
|
|
||||||
|
|
||||||
: fixnum/f ( m n -- m/n )
|
|
||||||
[ >float ] bi@ float/f ; inline
|
|
||||||
|
|
||||||
M: fixnum /f
|
|
||||||
2dup [ abs bignum/f-threshold >= ] either?
|
|
||||||
[ bignum/f ] [ fixnum/f ] if ; inline
|
|
||||||
|
|
||||||
M: fixnum mod fixnum-mod ; inline
|
M: fixnum mod fixnum-mod ; inline
|
||||||
|
|
||||||
M: fixnum /mod fixnum/mod ; inline
|
M: fixnum /mod fixnum/mod ; inline
|
||||||
|
@ -130,15 +121,16 @@ M: bignum (log2) bignum-log2 ; inline
|
||||||
[ /mod ] dip ; inline
|
[ /mod ] dip ; inline
|
||||||
|
|
||||||
! Third step: post-scaling
|
! Third step: post-scaling
|
||||||
: unscaled-float ( mantissa -- n )
|
|
||||||
52 2^ 1 - bitand 1022 52 shift bitor bits>double ; inline
|
|
||||||
|
|
||||||
: scale-float ( mantissa scale -- float' )
|
: scale-float ( mantissa scale -- float' )
|
||||||
dup 0 < [ neg 2^ recip ] [ 2^ ] if * ; inline
|
{
|
||||||
|
{ [ dup 1024 > ] [ 2drop 1/0. ] }
|
||||||
|
{ [ dup -1023 < ] [ 1021 + shift bits>double ] }
|
||||||
|
[ [ 52 2^ 1 - bitand ] dip 1022 + 52 shift bitor bits>double ]
|
||||||
|
} cond ; inline
|
||||||
|
|
||||||
: post-scale ( mantissa scale -- n )
|
: post-scale ( mantissa scale -- n )
|
||||||
[ 2/ ] dip over log2 52 > [ [ 2/ ] [ 1 + ] bi* ] when
|
[ 2/ ] dip over log2 52 > [ [ 2/ ] [ 1 + ] bi* ] when
|
||||||
[ unscaled-float ] dip scale-float ; inline
|
scale-float ; inline
|
||||||
|
|
||||||
: round-to-nearest ( fraction-and-guard rem -- fraction-and-guard' )
|
: round-to-nearest ( fraction-and-guard rem -- fraction-and-guard' )
|
||||||
over odd?
|
over odd?
|
||||||
|
@ -157,7 +149,21 @@ M: bignum (log2) bignum-log2 ; inline
|
||||||
] if ; inline
|
] if ; inline
|
||||||
|
|
||||||
: bignum/f ( m n -- f )
|
: bignum/f ( m n -- f )
|
||||||
[ [ abs ] bi@ /f-abs ] [ [ 0 < ] bi@ xor ] 2bi [ neg ] when ;
|
[ [ abs ] bi@ /f-abs ] [ [ 0 < ] bi@ xor ] 2bi [ neg ] when ; inline
|
||||||
|
|
||||||
M: bignum /f ( m n -- f )
|
M: bignum /f ( m n -- f ) { bignum bignum } declare bignum/f ;
|
||||||
bignum/f ;
|
|
||||||
|
CONSTANT: bignum/f-threshold HEX: 20,0000,0000,0000
|
||||||
|
|
||||||
|
: fixnum/f ( m n -- m/n )
|
||||||
|
[ >float ] bi@ float/f ; inline
|
||||||
|
|
||||||
|
M: fixnum /f
|
||||||
|
{ fixnum fixnum } declare
|
||||||
|
2dup [ abs bignum/f-threshold >= ] either?
|
||||||
|
[ bignum/f ] [ fixnum/f ] if ; inline
|
||||||
|
|
||||||
|
: bignum>float ( bignum -- float )
|
||||||
|
{ bignum } declare 1 >bignum bignum/f ;
|
||||||
|
|
||||||
|
M: bignum >float bignum>float ; inline
|
||||||
|
|
|
@ -59,11 +59,7 @@ PRIVATE>
|
||||||
ERROR: log2-expects-positive x ;
|
ERROR: log2-expects-positive x ;
|
||||||
|
|
||||||
: log2 ( x -- n )
|
: log2 ( x -- n )
|
||||||
dup 0 <= [
|
dup 0 <= [ log2-expects-positive ] [ (log2) ] if ; inline
|
||||||
log2-expects-positive
|
|
||||||
] [
|
|
||||||
(log2)
|
|
||||||
] if ; inline
|
|
||||||
|
|
||||||
: zero? ( x -- ? ) 0 number= ; inline
|
: zero? ( x -- ? ) 0 number= ; inline
|
||||||
: 2/ ( x -- y ) -1 shift ; inline
|
: 2/ ( x -- y ) -1 shift ; inline
|
||||||
|
@ -74,8 +70,8 @@ ERROR: log2-expects-positive x ;
|
||||||
: ?1+ ( x -- y ) [ 1 + ] [ 0 ] if* ; inline
|
: ?1+ ( x -- y ) [ 1 + ] [ 0 ] if* ; inline
|
||||||
: rem ( x y -- z ) abs [ mod ] [ + ] [ mod ] tri ; foldable
|
: rem ( x y -- z ) abs [ mod ] [ + ] [ mod ] tri ; foldable
|
||||||
: 2^ ( n -- 2^n ) 1 swap shift ; inline
|
: 2^ ( n -- 2^n ) 1 swap shift ; inline
|
||||||
: even? ( n -- ? ) 1 bitand zero? ;
|
: even? ( n -- ? ) 1 bitand zero? ; inline
|
||||||
: odd? ( n -- ? ) 1 bitand 1 number= ;
|
: odd? ( n -- ? ) 1 bitand 1 number= ; inline
|
||||||
|
|
||||||
: if-zero ( ..a n quot1: ( ..a -- ..b ) quot2: ( ..a n -- ..b ) -- ..b )
|
: if-zero ( ..a n quot1: ( ..a -- ..b ) quot2: ( ..a n -- ..b ) -- ..b )
|
||||||
[ dup zero? ] [ [ drop ] prepose ] [ ] tri* if ; inline
|
[ dup zero? ] [ [ drop ] prepose ] [ ] tri* if ; inline
|
||||||
|
|
|
@ -15,7 +15,7 @@ HELP: length
|
||||||
HELP: set-length
|
HELP: set-length
|
||||||
{ $values { "n" "a non-negative integer" } { "seq" "a resizable sequence" } }
|
{ $values { "n" "a non-negative integer" } { "seq" "a resizable sequence" } }
|
||||||
{ $contract "Resizes a sequence. The initial contents of the new area is undefined." }
|
{ $contract "Resizes a sequence. The initial contents of the new area is undefined." }
|
||||||
{ $errors "Throws a " { $link no-method } " error if the sequence is not resizable, and a " { $link bounds-error } " if the new length is negative." }
|
{ $errors "Throws a " { $link no-method } " error if the sequence is not resizable, and a " { $link bounds-error } " if the new length is negative." }
|
||||||
{ $side-effects "seq" } ;
|
{ $side-effects "seq" } ;
|
||||||
|
|
||||||
HELP: lengthen
|
HELP: lengthen
|
||||||
|
@ -45,7 +45,7 @@ HELP: nths
|
||||||
{ "indices" sequence } { "seq" sequence }
|
{ "indices" sequence } { "seq" sequence }
|
||||||
{ "seq'" sequence } }
|
{ "seq'" sequence } }
|
||||||
{ $description "Outputs a sequence of elements from the input sequence indexed by the indices." }
|
{ $description "Outputs a sequence of elements from the input sequence indexed by the indices." }
|
||||||
{ $examples
|
{ $examples
|
||||||
{ $example "USING: prettyprint sequences ;"
|
{ $example "USING: prettyprint sequences ;"
|
||||||
"{ 0 2 } { \"a\" \"b\" \"c\" } nths ."
|
"{ 0 2 } { \"a\" \"b\" \"c\" } nths ."
|
||||||
"{ \"a\" \"c\" }"
|
"{ \"a\" \"c\" }"
|
||||||
|
@ -248,7 +248,7 @@ HELP: array-nth
|
||||||
{ $warning "This word is in the " { $vocab-link "sequences.private" } " vocabulary because it is unsafe. It does not check types or array bounds, and improper use can corrupt memory. User code must use " { $link nth } " instead." } ;
|
{ $warning "This word is in the " { $vocab-link "sequences.private" } " vocabulary because it is unsafe. It does not check types or array bounds, and improper use can corrupt memory. User code must use " { $link nth } " instead." } ;
|
||||||
|
|
||||||
HELP: set-array-nth
|
HELP: set-array-nth
|
||||||
{ $values { "elt" object } { "n" "a non-negative fixnum" } { "array" "an array" } }
|
{ $values { "elt" object } { "n" "a non-negative fixnum" } { "array" "an array" } }
|
||||||
{ $description "Low-level array element mutator." }
|
{ $description "Low-level array element mutator." }
|
||||||
{ $warning "This word is in the " { $vocab-link "sequences.private" } " vocabulary because it is unsafe. It does not check types or array bounds, and improper use can corrupt memory. User code must use " { $link set-nth } " instead." } ;
|
{ $warning "This word is in the " { $vocab-link "sequences.private" } " vocabulary because it is unsafe. It does not check types or array bounds, and improper use can corrupt memory. User code must use " { $link set-nth } " instead." } ;
|
||||||
|
|
||||||
|
@ -430,7 +430,7 @@ HELP: all?
|
||||||
|
|
||||||
HELP: push-if
|
HELP: push-if
|
||||||
{ $values { "elt" object } { "quot" { $quotation "( ..a elt -- ..b ? )" } } { "accum" "a resizable mutable sequence" } }
|
{ $values { "elt" object } { "quot" { $quotation "( ..a elt -- ..b ? )" } } { "accum" "a resizable mutable sequence" } }
|
||||||
{ $description "Adds the element at the end of the sequence if the quotation yields a true value." }
|
{ $description "Adds the element at the end of the sequence if the quotation yields a true value." }
|
||||||
{ $notes "This word is a factor of " { $link filter } "." } ;
|
{ $notes "This word is a factor of " { $link filter } "." } ;
|
||||||
|
|
||||||
HELP: filter
|
HELP: filter
|
||||||
|
@ -557,7 +557,7 @@ HELP: append!
|
||||||
HELP: prefix
|
HELP: prefix
|
||||||
{ $values { "seq" sequence } { "elt" object } { "newseq" sequence } }
|
{ $values { "seq" sequence } { "elt" object } { "newseq" sequence } }
|
||||||
{ $description "Outputs a new sequence obtained by adding " { $snippet "elt" } " at the beginning of " { $snippet "seq" } "." }
|
{ $description "Outputs a new sequence obtained by adding " { $snippet "elt" } " at the beginning of " { $snippet "seq" } "." }
|
||||||
{ $errors "Throws an error if the type of " { $snippet "elt" } " is not permitted in sequences of the same class as " { $snippet "seq1" } "." }
|
{ $errors "Throws an error if the type of " { $snippet "elt" } " is not permitted in sequences of the same class as " { $snippet "seq1" } "." }
|
||||||
{ $examples
|
{ $examples
|
||||||
{ $example "USING: prettyprint sequences ;" "{ 1 2 3 } 0 prefix ." "{ 0 1 2 3 }" }
|
{ $example "USING: prettyprint sequences ;" "{ 1 2 3 } 0 prefix ." "{ 0 1 2 3 }" }
|
||||||
} ;
|
} ;
|
||||||
|
@ -713,7 +713,7 @@ HELP: append
|
||||||
{ $values { "seq1" sequence } { "seq2" sequence } { "newseq" sequence } }
|
{ $values { "seq1" sequence } { "seq2" sequence } { "newseq" sequence } }
|
||||||
{ $description "Outputs a new sequence of the same type as " { $snippet "seq1" } " consisting of the elements of " { $snippet "seq1" } " followed by " { $snippet "seq2" } "." }
|
{ $description "Outputs a new sequence of the same type as " { $snippet "seq1" } " consisting of the elements of " { $snippet "seq1" } " followed by " { $snippet "seq2" } "." }
|
||||||
{ $errors "Throws an error if " { $snippet "seq2" } " contains elements not permitted in sequences of the same class as " { $snippet "seq1" } "." }
|
{ $errors "Throws an error if " { $snippet "seq2" } " contains elements not permitted in sequences of the same class as " { $snippet "seq1" } "." }
|
||||||
{ $examples
|
{ $examples
|
||||||
{ $example "USING: prettyprint sequences ;"
|
{ $example "USING: prettyprint sequences ;"
|
||||||
"{ 1 2 } B{ 3 4 } append ."
|
"{ 1 2 } B{ 3 4 } append ."
|
||||||
"{ 1 2 3 4 }"
|
"{ 1 2 3 4 }"
|
||||||
|
@ -728,7 +728,7 @@ HELP: append-as
|
||||||
{ $values { "seq1" sequence } { "seq2" sequence } { "exemplar" sequence } { "newseq" sequence } }
|
{ $values { "seq1" sequence } { "seq2" sequence } { "exemplar" sequence } { "newseq" sequence } }
|
||||||
{ $description "Outputs a new sequence of the same type as " { $snippet "exemplar" } " consisting of the elements of " { $snippet "seq1" } " followed by " { $snippet "seq2" } "." }
|
{ $description "Outputs a new sequence of the same type as " { $snippet "exemplar" } " consisting of the elements of " { $snippet "seq1" } " followed by " { $snippet "seq2" } "." }
|
||||||
{ $errors "Throws an error if " { $snippet "seq1" } " or " { $snippet "seq2" } " contain elements not permitted in sequences of the same class as " { $snippet "exemplar" } "." }
|
{ $errors "Throws an error if " { $snippet "seq1" } " or " { $snippet "seq2" } " contain elements not permitted in sequences of the same class as " { $snippet "exemplar" } "." }
|
||||||
{ $examples
|
{ $examples
|
||||||
{ $example "USING: prettyprint sequences ;"
|
{ $example "USING: prettyprint sequences ;"
|
||||||
"{ 1 2 } B{ 3 4 } B{ } append-as ."
|
"{ 1 2 } B{ 3 4 } B{ } append-as ."
|
||||||
"B{ 1 2 3 4 }"
|
"B{ 1 2 3 4 }"
|
||||||
|
@ -992,7 +992,7 @@ HELP: selector
|
||||||
{ $values
|
{ $values
|
||||||
{ "quot" { $quotation "( ... elt -- ... ? )" } }
|
{ "quot" { $quotation "( ... elt -- ... ? )" } }
|
||||||
{ "selector" { $quotation "( ... elt -- ... )" } } { "accum" vector } }
|
{ "selector" { $quotation "( ... elt -- ... )" } } { "accum" vector } }
|
||||||
{ $description "Creates a new vector to accumulate the values which return true for a predicate. Returns a new quotation which accepts an object to be tested and stored in the collector if the test yields true. The collector is left on the stack for convenience." }
|
{ $description "Creates a new vector to accumulate the values which return true for a predicate. Returns a new quotation which accepts an object to be tested and stored in the collector if the test yields true. The collector is left on the stack for convenience." }
|
||||||
{ $example "! Find all the even numbers:" "USING: prettyprint sequences math kernel ;"
|
{ $example "! Find all the even numbers:" "USING: prettyprint sequences math kernel ;"
|
||||||
"10 iota [ even? ] selector [ each ] dip ."
|
"10 iota [ even? ] selector [ each ] dip ."
|
||||||
"V{ 0 2 4 6 8 }"
|
"V{ 0 2 4 6 8 }"
|
||||||
|
@ -1004,7 +1004,7 @@ HELP: trim-head
|
||||||
{ "seq" sequence } { "quot" quotation }
|
{ "seq" sequence } { "quot" quotation }
|
||||||
{ "newseq" sequence } }
|
{ "newseq" sequence } }
|
||||||
{ $description "Removes elements starting from the left side of a sequence if they match a predicate. Once an element does not match, the test stops and the rest of the sequence is left on the stack as a new sequence." }
|
{ $description "Removes elements starting from the left side of a sequence if they match a predicate. Once an element does not match, the test stops and the rest of the sequence is left on the stack as a new sequence." }
|
||||||
{ $example "" "USING: prettyprint math sequences ;"
|
{ $example "USING: prettyprint math sequences ;"
|
||||||
"{ 0 0 1 2 3 0 0 } [ zero? ] trim-head ."
|
"{ 0 0 1 2 3 0 0 } [ zero? ] trim-head ."
|
||||||
"{ 1 2 3 0 0 }"
|
"{ 1 2 3 0 0 }"
|
||||||
} ;
|
} ;
|
||||||
|
@ -1014,7 +1014,7 @@ HELP: trim-head-slice
|
||||||
{ "seq" sequence } { "quot" quotation }
|
{ "seq" sequence } { "quot" quotation }
|
||||||
{ "slice" slice } }
|
{ "slice" slice } }
|
||||||
{ $description "Removes elements starting from the left side of a sequence if they match a predicate. Once an element does not match, the test stops and the rest of the sequence is left on the stack as a slice" }
|
{ $description "Removes elements starting from the left side of a sequence if they match a predicate. Once an element does not match, the test stops and the rest of the sequence is left on the stack as a slice" }
|
||||||
{ $example "" "USING: prettyprint math sequences ;"
|
{ $example "USING: prettyprint math sequences ;"
|
||||||
"{ 0 0 1 2 3 0 0 } [ zero? ] trim-head-slice ."
|
"{ 0 0 1 2 3 0 0 } [ zero? ] trim-head-slice ."
|
||||||
"T{ slice { from 2 } { to 7 } { seq { 0 0 1 2 3 0 0 } } }"
|
"T{ slice { from 2 } { to 7 } { seq { 0 0 1 2 3 0 0 } } }"
|
||||||
} ;
|
} ;
|
||||||
|
@ -1024,7 +1024,7 @@ HELP: trim-tail
|
||||||
{ "seq" sequence } { "quot" quotation }
|
{ "seq" sequence } { "quot" quotation }
|
||||||
{ "newseq" sequence } }
|
{ "newseq" sequence } }
|
||||||
{ $description "Removes elements starting from the right side of a sequence if they match a predicate. Once an element does not match, the test stops and the rest of the sequence is left on the stack as a new sequence." }
|
{ $description "Removes elements starting from the right side of a sequence if they match a predicate. Once an element does not match, the test stops and the rest of the sequence is left on the stack as a new sequence." }
|
||||||
{ $example "" "USING: prettyprint math sequences ;"
|
{ $example "USING: prettyprint math sequences ;"
|
||||||
"{ 0 0 1 2 3 0 0 } [ zero? ] trim-tail ."
|
"{ 0 0 1 2 3 0 0 } [ zero? ] trim-tail ."
|
||||||
"{ 0 0 1 2 3 }"
|
"{ 0 0 1 2 3 }"
|
||||||
} ;
|
} ;
|
||||||
|
@ -1034,7 +1034,7 @@ HELP: trim-tail-slice
|
||||||
{ "seq" sequence } { "quot" quotation }
|
{ "seq" sequence } { "quot" quotation }
|
||||||
{ "slice" slice } }
|
{ "slice" slice } }
|
||||||
{ $description "Removes elements starting from the right side of a sequence if they match a predicate. Once an element does not match, the test stops and the rest of the sequence is left on the stack as a slice." }
|
{ $description "Removes elements starting from the right side of a sequence if they match a predicate. Once an element does not match, the test stops and the rest of the sequence is left on the stack as a slice." }
|
||||||
{ $example "" "USING: prettyprint math sequences ;"
|
{ $example "USING: prettyprint math sequences ;"
|
||||||
"{ 0 0 1 2 3 0 0 } [ zero? ] trim-tail-slice ."
|
"{ 0 0 1 2 3 0 0 } [ zero? ] trim-tail-slice ."
|
||||||
"T{ slice { from 0 } { to 5 } { seq { 0 0 1 2 3 0 0 } } }"
|
"T{ slice { from 0 } { to 5 } { seq { 0 0 1 2 3 0 0 } } }"
|
||||||
} ;
|
} ;
|
||||||
|
@ -1044,7 +1044,7 @@ HELP: trim
|
||||||
{ "seq" sequence } { "quot" quotation }
|
{ "seq" sequence } { "quot" quotation }
|
||||||
{ "newseq" sequence } }
|
{ "newseq" sequence } }
|
||||||
{ $description "Removes elements starting from the left and right sides of a sequence if they match a predicate. Once an element does not match, the test stops and the rest of the sequence is left on the stack as a new sequence." }
|
{ $description "Removes elements starting from the left and right sides of a sequence if they match a predicate. Once an element does not match, the test stops and the rest of the sequence is left on the stack as a new sequence." }
|
||||||
{ $example "" "USING: prettyprint math sequences ;"
|
{ $example "USING: prettyprint math sequences ;"
|
||||||
"{ 0 0 1 2 3 0 0 } [ zero? ] trim ."
|
"{ 0 0 1 2 3 0 0 } [ zero? ] trim ."
|
||||||
"{ 1 2 3 }"
|
"{ 1 2 3 }"
|
||||||
} ;
|
} ;
|
||||||
|
@ -1054,7 +1054,7 @@ HELP: trim-slice
|
||||||
{ "seq" sequence } { "quot" quotation }
|
{ "seq" sequence } { "quot" quotation }
|
||||||
{ "slice" slice } }
|
{ "slice" slice } }
|
||||||
{ $description "Removes elements starting from the left and right sides of a sequence if they match a predicate. Once an element does not match, the test stops and the rest of the sequence is left on the stack as a slice." }
|
{ $description "Removes elements starting from the left and right sides of a sequence if they match a predicate. Once an element does not match, the test stops and the rest of the sequence is left on the stack as a slice." }
|
||||||
{ $example "" "USING: prettyprint math sequences ;"
|
{ $example "USING: prettyprint math sequences ;"
|
||||||
"{ 0 0 1 2 3 0 0 } [ zero? ] trim-slice ."
|
"{ 0 0 1 2 3 0 0 } [ zero? ] trim-slice ."
|
||||||
"T{ slice { from 2 } { to 5 } { seq { 0 0 1 2 3 0 0 } } }"
|
"T{ slice { from 2 } { to 5 } { seq { 0 0 1 2 3 0 0 } } }"
|
||||||
} ;
|
} ;
|
||||||
|
@ -1065,8 +1065,8 @@ HELP: sift
|
||||||
{ $values
|
{ $values
|
||||||
{ "seq" sequence }
|
{ "seq" sequence }
|
||||||
{ "newseq" sequence } }
|
{ "newseq" sequence } }
|
||||||
{ $description "Outputs a new sequence with all instance of " { $link f } " removed." }
|
{ $description "Outputs a new sequence with all instance of " { $link f } " removed." }
|
||||||
{ $examples
|
{ $examples
|
||||||
{ $example "USING: prettyprint sequences ;"
|
{ $example "USING: prettyprint sequences ;"
|
||||||
"{ \"a\" 3 { } f } sift ."
|
"{ \"a\" 3 { } f } sift ."
|
||||||
"{ \"a\" 3 { } }"
|
"{ \"a\" 3 { } }"
|
||||||
|
@ -1078,7 +1078,7 @@ HELP: harvest
|
||||||
{ "seq" sequence }
|
{ "seq" sequence }
|
||||||
{ "newseq" sequence } }
|
{ "newseq" sequence } }
|
||||||
{ $description "Outputs a new sequence with all empty sequences removed." }
|
{ $description "Outputs a new sequence with all empty sequences removed." }
|
||||||
{ $examples
|
{ $examples
|
||||||
{ $example "USING: prettyprint sequences ;"
|
{ $example "USING: prettyprint sequences ;"
|
||||||
"{ { } { 2 3 } { 5 } { } } harvest ."
|
"{ { } { 2 3 } { 5 } { } } harvest ."
|
||||||
"{ { 2 3 } { 5 } }"
|
"{ { 2 3 } { 5 } }"
|
||||||
|
@ -1091,9 +1091,9 @@ HELP: set-first
|
||||||
{ $values
|
{ $values
|
||||||
{ "first" object } { "seq" sequence } }
|
{ "first" object } { "seq" sequence } }
|
||||||
{ $description "Sets the first element of a sequence." }
|
{ $description "Sets the first element of a sequence." }
|
||||||
{ $examples
|
{ $examples
|
||||||
{ $example "USING: prettyprint kernel sequences ;"
|
{ $example "USING: prettyprint kernel sequences ;"
|
||||||
"{ 1 2 3 4 } 5 over set-first ."
|
"{ 1 2 3 4 } 5 over set-first ."
|
||||||
"{ 5 2 3 4 }"
|
"{ 5 2 3 4 }"
|
||||||
}
|
}
|
||||||
} ;
|
} ;
|
||||||
|
@ -1102,9 +1102,9 @@ HELP: set-second
|
||||||
{ $values
|
{ $values
|
||||||
{ "second" object } { "seq" sequence } }
|
{ "second" object } { "seq" sequence } }
|
||||||
{ $description "Sets the second element of a sequence." }
|
{ $description "Sets the second element of a sequence." }
|
||||||
{ $examples
|
{ $examples
|
||||||
{ $example "USING: prettyprint kernel sequences ;"
|
{ $example "USING: prettyprint kernel sequences ;"
|
||||||
"{ 1 2 3 4 } 5 over set-second ."
|
"{ 1 2 3 4 } 5 over set-second ."
|
||||||
"{ 1 5 3 4 }"
|
"{ 1 5 3 4 }"
|
||||||
}
|
}
|
||||||
} ;
|
} ;
|
||||||
|
@ -1113,9 +1113,9 @@ HELP: set-third
|
||||||
{ $values
|
{ $values
|
||||||
{ "third" object } { "seq" sequence } }
|
{ "third" object } { "seq" sequence } }
|
||||||
{ $description "Sets the third element of a sequence." }
|
{ $description "Sets the third element of a sequence." }
|
||||||
{ $examples
|
{ $examples
|
||||||
{ $example "USING: prettyprint kernel sequences ;"
|
{ $example "USING: prettyprint kernel sequences ;"
|
||||||
"{ 1 2 3 4 } 5 over set-third ."
|
"{ 1 2 3 4 } 5 over set-third ."
|
||||||
"{ 1 2 5 4 }"
|
"{ 1 2 5 4 }"
|
||||||
}
|
}
|
||||||
} ;
|
} ;
|
||||||
|
@ -1124,9 +1124,9 @@ HELP: set-fourth
|
||||||
{ $values
|
{ $values
|
||||||
{ "fourth" object } { "seq" sequence } }
|
{ "fourth" object } { "seq" sequence } }
|
||||||
{ $description "Sets the fourth element of a sequence." }
|
{ $description "Sets the fourth element of a sequence." }
|
||||||
{ $examples
|
{ $examples
|
||||||
{ $example "USING: prettyprint kernel sequences ;"
|
{ $example "USING: prettyprint kernel sequences ;"
|
||||||
"{ 1 2 3 4 } 5 over set-fourth ."
|
"{ 1 2 3 4 } 5 over set-fourth ."
|
||||||
"{ 1 2 3 5 }"
|
"{ 1 2 3 5 }"
|
||||||
}
|
}
|
||||||
} ;
|
} ;
|
||||||
|
@ -1138,7 +1138,7 @@ HELP: replicate
|
||||||
{ "len" integer } { "quot" { $quotation "( ... -- ... newelt )" } }
|
{ "len" integer } { "quot" { $quotation "( ... -- ... newelt )" } }
|
||||||
{ "newseq" sequence } }
|
{ "newseq" sequence } }
|
||||||
{ $description "Calls the quotation " { $snippet "len" } " times, collecting results into a new array." }
|
{ $description "Calls the quotation " { $snippet "len" } " times, collecting results into a new array." }
|
||||||
{ $examples
|
{ $examples
|
||||||
{ $unchecked-example "USING: kernel prettyprint random sequences ;"
|
{ $unchecked-example "USING: kernel prettyprint random sequences ;"
|
||||||
"5 [ 100 random ] replicate ."
|
"5 [ 100 random ] replicate ."
|
||||||
"{ 52 10 45 81 30 }"
|
"{ 52 10 45 81 30 }"
|
||||||
|
@ -1150,7 +1150,7 @@ HELP: replicate-as
|
||||||
{ "len" integer } { "quot" { $quotation "( ... -- ... newelt )" } } { "exemplar" sequence }
|
{ "len" integer } { "quot" { $quotation "( ... -- ... newelt )" } } { "exemplar" sequence }
|
||||||
{ "newseq" sequence } }
|
{ "newseq" sequence } }
|
||||||
{ $description "Calls the quotation " { $snippet "len" } " times, collecting results into a new sequence of the same type as the exemplar sequence." }
|
{ $description "Calls the quotation " { $snippet "len" } " times, collecting results into a new sequence of the same type as the exemplar sequence." }
|
||||||
{ $examples
|
{ $examples
|
||||||
{ $unchecked-example "USING: prettyprint kernel sequences ;"
|
{ $unchecked-example "USING: prettyprint kernel sequences ;"
|
||||||
"5 [ 100 random ] B{ } replicate-as ."
|
"5 [ 100 random ] B{ } replicate-as ."
|
||||||
"B{ 44 8 2 33 18 }"
|
"B{ 44 8 2 33 18 }"
|
||||||
|
@ -1163,8 +1163,8 @@ HELP: partition
|
||||||
{ $values
|
{ $values
|
||||||
{ "seq" sequence } { "quot" quotation }
|
{ "seq" sequence } { "quot" quotation }
|
||||||
{ "trueseq" sequence } { "falseseq" sequence } }
|
{ "trueseq" sequence } { "falseseq" sequence } }
|
||||||
{ $description "Calls a predicate quotation on each element of the input sequence. If the test yields true, the element is added to " { $snippet "trueseq" } "; if false, it's added to " { $snippet "falseseq" } "." }
|
{ $description "Calls a predicate quotation on each element of the input sequence. If the test yields true, the element is added to " { $snippet "trueseq" } "; if false, it's added to " { $snippet "falseseq" } "." }
|
||||||
{ $examples
|
{ $examples
|
||||||
{ $example "USING: prettyprint kernel math sequences ;"
|
{ $example "USING: prettyprint kernel math sequences ;"
|
||||||
"{ 1 2 3 4 5 } [ even? ] partition [ . ] bi@"
|
"{ 1 2 3 4 5 } [ even? ] partition [ . ] bi@"
|
||||||
"{ 2 4 }\n{ 1 3 5 }"
|
"{ 2 4 }\n{ 1 3 5 }"
|
||||||
|
@ -1343,10 +1343,9 @@ HELP: assert-sequence=
|
||||||
{ $description "Throws an error if all the elements of two sequences, taken pairwise, are not equal." }
|
{ $description "Throws an error if all the elements of two sequences, taken pairwise, are not equal." }
|
||||||
{ $notes "The sequences need not be of the same type." }
|
{ $notes "The sequences need not be of the same type." }
|
||||||
{ $examples
|
{ $examples
|
||||||
{ $example
|
{ $code
|
||||||
"USING: prettyprint sequences ;"
|
"USING: prettyprint sequences ;"
|
||||||
"{ 1 2 3 } V{ 1 2 3 } assert-sequence="
|
"{ 1 2 3 } V{ 1 2 3 } assert-sequence="
|
||||||
""
|
|
||||||
}
|
}
|
||||||
} ;
|
} ;
|
||||||
|
|
||||||
|
|
|
@ -18,6 +18,8 @@ ARTICLE: "set-operations" "Operations on sets"
|
||||||
{ $subsections in? }
|
{ $subsections in? }
|
||||||
"All sets can be represented as a sequence, without duplicates, of their members:"
|
"All sets can be represented as a sequence, without duplicates, of their members:"
|
||||||
{ $subsections members }
|
{ $subsections members }
|
||||||
|
"To get the number of elements in a set:"
|
||||||
|
{ $subsections cardinality }
|
||||||
"Sets can have members added or removed destructively:"
|
"Sets can have members added or removed destructively:"
|
||||||
{ $subsections
|
{ $subsections
|
||||||
adjoin
|
adjoin
|
||||||
|
@ -184,3 +186,7 @@ HELP: without
|
||||||
HELP: null?
|
HELP: null?
|
||||||
{ $values { "set" set } { "?" "a boolean" } }
|
{ $values { "set" set } { "?" "a boolean" } }
|
||||||
{ $description "Tests whether the given set is empty. This outputs " { $snippet "t" } " when given a null set of any type." } ;
|
{ $description "Tests whether the given set is empty. This outputs " { $snippet "t" } " when given a null set of any type." } ;
|
||||||
|
|
||||||
|
HELP: cardinality
|
||||||
|
{ $values { "set" set } { "n" "a non-negative integer" } }
|
||||||
|
{ $description "Returns the number of elements in the set. All sets support this operation." } ;
|
||||||
|
|
|
@ -3,7 +3,7 @@
|
||||||
USING: sets tools.test kernel prettyprint hash-sets sorting ;
|
USING: sets tools.test kernel prettyprint hash-sets sorting ;
|
||||||
IN: sets.tests
|
IN: sets.tests
|
||||||
|
|
||||||
[ { } ] [ { } { } intersect ] unit-test
|
[ { } ] [ { } { } intersect ] unit-test
|
||||||
[ { 2 3 } ] [ { 1 2 3 } { 2 3 4 } intersect ] unit-test
|
[ { 2 3 } ] [ { 1 2 3 } { 2 3 4 } intersect ] unit-test
|
||||||
[ { 2 3 } ] [ { 1 2 2 3 } { 2 3 3 4 } intersect ] unit-test
|
[ { 2 3 } ] [ { 1 2 2 3 } { 2 3 3 4 } intersect ] unit-test
|
||||||
|
|
||||||
|
@ -11,7 +11,7 @@ IN: sets.tests
|
||||||
[ { 1 } ] [ { 1 2 3 } { 2 3 4 } diff ] unit-test
|
[ { 1 } ] [ { 1 2 3 } { 2 3 4 } diff ] unit-test
|
||||||
[ { 1 } ] [ { 1 1 2 3 } { 2 3 4 4 } diff ] unit-test
|
[ { 1 } ] [ { 1 1 2 3 } { 2 3 4 4 } diff ] unit-test
|
||||||
|
|
||||||
[ { } ] [ { } { } within ] unit-test
|
[ { } ] [ { } { } within ] unit-test
|
||||||
[ { 2 3 } ] [ { 1 2 3 } { 2 3 4 } within ] unit-test
|
[ { 2 3 } ] [ { 1 2 3 } { 2 3 4 } within ] unit-test
|
||||||
[ { 2 2 3 } ] [ { 1 2 2 3 } { 2 3 3 4 } within ] unit-test
|
[ { 2 2 3 } ] [ { 1 2 2 3 } { 2 3 3 4 } within ] unit-test
|
||||||
|
|
||||||
|
@ -64,3 +64,9 @@ IN: sets.tests
|
||||||
|
|
||||||
[ t ] [ f null? ] unit-test
|
[ t ] [ f null? ] unit-test
|
||||||
[ f ] [ { 4 } null? ] unit-test
|
[ f ] [ { 4 } null? ] unit-test
|
||||||
|
|
||||||
|
[ 0 ] [ f cardinality ] unit-test
|
||||||
|
[ 0 ] [ { } cardinality ] unit-test
|
||||||
|
[ 1 ] [ { 1 } cardinality ] unit-test
|
||||||
|
[ 1 ] [ HS{ 1 } cardinality ] unit-test
|
||||||
|
[ 3 ] [ HS{ 1 2 3 } cardinality ] unit-test
|
||||||
|
|
|
@ -22,12 +22,17 @@ GENERIC: set= ( set1 set2 -- ? )
|
||||||
GENERIC: duplicates ( set -- seq )
|
GENERIC: duplicates ( set -- seq )
|
||||||
GENERIC: all-unique? ( set -- ? )
|
GENERIC: all-unique? ( set -- ? )
|
||||||
GENERIC: null? ( set -- ? )
|
GENERIC: null? ( set -- ? )
|
||||||
|
GENERIC: cardinality ( set -- n )
|
||||||
|
|
||||||
|
M: f cardinality drop 0 ;
|
||||||
|
|
||||||
! Defaults for some methods.
|
! Defaults for some methods.
|
||||||
! Override them for efficiency
|
! Override them for efficiency
|
||||||
|
|
||||||
M: set null? members null? ; inline
|
M: set null? members null? ; inline
|
||||||
|
|
||||||
|
M: set cardinality members length ;
|
||||||
|
|
||||||
M: set set-like drop ; inline
|
M: set set-like drop ; inline
|
||||||
|
|
||||||
M: set union
|
M: set union
|
||||||
|
@ -54,7 +59,7 @@ M: set intersects?
|
||||||
|
|
||||||
M: set subset?
|
M: set subset?
|
||||||
sequence/tester all? ;
|
sequence/tester all? ;
|
||||||
|
|
||||||
M: set set=
|
M: set set=
|
||||||
2dup subset? [ swap subset? ] [ 2drop f ] if ;
|
2dup subset? [ swap subset? ] [ 2drop f ] if ;
|
||||||
|
|
||||||
|
@ -94,10 +99,13 @@ M: sequence set-like
|
||||||
|
|
||||||
M: sequence members
|
M: sequence members
|
||||||
[ pruned ] keep like ;
|
[ pruned ] keep like ;
|
||||||
|
|
||||||
M: sequence null?
|
M: sequence null?
|
||||||
empty? ; inline
|
empty? ; inline
|
||||||
|
|
||||||
|
M: sequence cardinality
|
||||||
|
length ;
|
||||||
|
|
||||||
: combine ( sets -- set )
|
: combine ( sets -- set )
|
||||||
[ f ]
|
[ f ]
|
||||||
[ [ [ members ] map concat ] [ first ] bi set-like ]
|
[ [ [ members ] map concat ] [ first ] bi set-like ]
|
||||||
|
|
|
@ -195,7 +195,7 @@ ARTICLE: "syntax-hash-sets" "Hash set syntax"
|
||||||
|
|
||||||
ARTICLE: "syntax-tuples" "Tuple syntax"
|
ARTICLE: "syntax-tuples" "Tuple syntax"
|
||||||
{ $subsections POSTPONE: T{ }
|
{ $subsections POSTPONE: T{ }
|
||||||
"Tuples are documented in " { $link "tuples" } "." ;
|
"Tuples are documented in " { $link "tuples" } "." ;
|
||||||
|
|
||||||
ARTICLE: "syntax-quots" "Quotation syntax"
|
ARTICLE: "syntax-quots" "Quotation syntax"
|
||||||
{ $subsections
|
{ $subsections
|
||||||
|
@ -340,37 +340,37 @@ $nl
|
||||||
HELP: {
|
HELP: {
|
||||||
{ $syntax "{ elements... }" }
|
{ $syntax "{ elements... }" }
|
||||||
{ $values { "elements" "a list of objects" } }
|
{ $values { "elements" "a list of objects" } }
|
||||||
{ $description "Marks the beginning of a literal array. Literal arrays are terminated by " { $link POSTPONE: } } "." }
|
{ $description "Marks the beginning of a literal array. Literal arrays are terminated by " { $link POSTPONE: } } "." }
|
||||||
{ $examples { $code "{ 1 2 3 }" } } ;
|
{ $examples { $code "{ 1 2 3 }" } } ;
|
||||||
|
|
||||||
HELP: V{
|
HELP: V{
|
||||||
{ $syntax "V{ elements... }" }
|
{ $syntax "V{ elements... }" }
|
||||||
{ $values { "elements" "a list of objects" } }
|
{ $values { "elements" "a list of objects" } }
|
||||||
{ $description "Marks the beginning of a literal vector. Literal vectors are terminated by " { $link POSTPONE: } } "." }
|
{ $description "Marks the beginning of a literal vector. Literal vectors are terminated by " { $link POSTPONE: } } "." }
|
||||||
{ $examples { $code "V{ 1 2 3 }" } } ;
|
{ $examples { $code "V{ 1 2 3 }" } } ;
|
||||||
|
|
||||||
HELP: B{
|
HELP: B{
|
||||||
{ $syntax "B{ elements... }" }
|
{ $syntax "B{ elements... }" }
|
||||||
{ $values { "elements" "a list of integers" } }
|
{ $values { "elements" "a list of integers" } }
|
||||||
{ $description "Marks the beginning of a literal byte array. Literal byte arrays are terminated by " { $link POSTPONE: } } "." }
|
{ $description "Marks the beginning of a literal byte array. Literal byte arrays are terminated by " { $link POSTPONE: } } "." }
|
||||||
{ $examples { $code "B{ 1 2 3 }" } } ;
|
{ $examples { $code "B{ 1 2 3 }" } } ;
|
||||||
|
|
||||||
HELP: H{
|
HELP: H{
|
||||||
{ $syntax "H{ { key value }... }" }
|
{ $syntax "H{ { key value }... }" }
|
||||||
{ $values { "key" "an object" } { "value" "an object" } }
|
{ $values { "key" "an object" } { "value" "an object" } }
|
||||||
{ $description "Marks the beginning of a literal hashtable, given as a list of two-element arrays holding key/value pairs. Literal hashtables are terminated by " { $link POSTPONE: } } "." }
|
{ $description "Marks the beginning of a literal hashtable, given as a list of two-element arrays holding key/value pairs. Literal hashtables are terminated by " { $link POSTPONE: } } "." }
|
||||||
{ $examples { $code "H{ { \"tuna\" \"fish\" } { \"jalapeno\" \"vegetable\" } }" } } ;
|
{ $examples { $code "H{ { \"tuna\" \"fish\" } { \"jalapeno\" \"vegetable\" } }" } } ;
|
||||||
|
|
||||||
HELP: HS{
|
HELP: HS{
|
||||||
{ $syntax "HS{ members ... }" }
|
{ $syntax "HS{ members ... }" }
|
||||||
{ $values { "members" "a list of objects" } }
|
{ $values { "members" "a list of objects" } }
|
||||||
{ $description "Marks the beginning of a literal hash set, given as a list of its members. Literal hashtables are terminated by " { $link POSTPONE: } } "." }
|
{ $description "Marks the beginning of a literal hash set, given as a list of its members. Literal hashtables are terminated by " { $link POSTPONE: } } "." }
|
||||||
{ $examples { $code "HS{ 3 \"foo\" }" } } ;
|
{ $examples { $code "HS{ 3 \"foo\" }" } } ;
|
||||||
|
|
||||||
HELP: C{
|
HELP: C{
|
||||||
{ $syntax "C{ real-part imaginary-part }" }
|
{ $syntax "C{ real-part imaginary-part }" }
|
||||||
{ $values { "real-part" "a real number" } { "imaginary-part" "a real number" } }
|
{ $values { "real-part" "a real number" } { "imaginary-part" "a real number" } }
|
||||||
{ $description "Parses a complex number given in rectangular form as a pair of real numbers. Literal complex numbers are terminated by " { $link POSTPONE: } } "." } ;
|
{ $description "Parses a complex number given in rectangular form as a pair of real numbers. Literal complex numbers are terminated by " { $link POSTPONE: } } "." } ;
|
||||||
|
|
||||||
HELP: T{
|
HELP: T{
|
||||||
{ $syntax "T{ class }" "T{ class f slot-values... }" "T{ class { slot-name slot-value } ... }" }
|
{ $syntax "T{ class }" "T{ class f slot-values... }" "T{ class { slot-name slot-value } ... }" }
|
||||||
|
@ -453,7 +453,7 @@ HELP: SINGLETON:
|
||||||
{ $examples
|
{ $examples
|
||||||
{ $example "USING: classes.singleton kernel io ;" "IN: singleton-demo" "USE: prettyprint SINGLETON: foo\nGENERIC: bar ( obj -- )\nM: foo bar drop \"a foo!\" print ;\nfoo bar" "a foo!" }
|
{ $example "USING: classes.singleton kernel io ;" "IN: singleton-demo" "USE: prettyprint SINGLETON: foo\nGENERIC: bar ( obj -- )\nM: foo bar drop \"a foo!\" print ;\nfoo bar" "a foo!" }
|
||||||
} ;
|
} ;
|
||||||
|
|
||||||
HELP: SINGLETONS:
|
HELP: SINGLETONS:
|
||||||
{ $syntax "SINGLETONS: words... ;" }
|
{ $syntax "SINGLETONS: words... ;" }
|
||||||
{ $values { "words" "a sequence of new words to define" } }
|
{ $values { "words" "a sequence of new words to define" } }
|
||||||
|
@ -533,13 +533,14 @@ HELP: QUALIFIED:
|
||||||
{ $examples { $example
|
{ $examples { $example
|
||||||
"USING: prettyprint ;"
|
"USING: prettyprint ;"
|
||||||
"QUALIFIED: math"
|
"QUALIFIED: math"
|
||||||
"1 2 math:+ ." "3"
|
"1 2 math:+ ."
|
||||||
|
"3"
|
||||||
} } ;
|
} } ;
|
||||||
|
|
||||||
HELP: QUALIFIED-WITH:
|
HELP: QUALIFIED-WITH:
|
||||||
{ $syntax "QUALIFIED-WITH: vocab word-prefix" }
|
{ $syntax "QUALIFIED-WITH: vocab word-prefix" }
|
||||||
{ $description "Like " { $link POSTPONE: QUALIFIED: } " but uses " { $snippet "word-prefix" } " as prefix." }
|
{ $description "Like " { $link POSTPONE: QUALIFIED: } " but uses " { $snippet "word-prefix" } " as prefix." }
|
||||||
{ $examples { $code
|
{ $examples { $example
|
||||||
"USING: prettyprint ;"
|
"USING: prettyprint ;"
|
||||||
"QUALIFIED-WITH: math m"
|
"QUALIFIED-WITH: math m"
|
||||||
"1 2 m:+ ."
|
"1 2 m:+ ."
|
||||||
|
@ -559,7 +560,7 @@ HELP: FROM:
|
||||||
|
|
||||||
HELP: EXCLUDE:
|
HELP: EXCLUDE:
|
||||||
{ $syntax "EXCLUDE: vocab => words ... ;" }
|
{ $syntax "EXCLUDE: vocab => words ... ;" }
|
||||||
{ $description "Adds all words except for " { $snippet "words" } " from " { $snippet "vocab" } " to the search path." }
|
{ $description "Adds all words except for " { $snippet "words" } " from " { $snippet "vocab" } " to the search path." }
|
||||||
{ $examples { $code
|
{ $examples { $code
|
||||||
"EXCLUDE: math.parser => bin> hex> ;" "! imports everything but bin> and hex>" } } ;
|
"EXCLUDE: math.parser => bin> hex> ;" "! imports everything but bin> and hex>" } } ;
|
||||||
|
|
||||||
|
@ -727,7 +728,7 @@ HELP: HOOK:
|
||||||
"TUPLE: air-transport ;"
|
"TUPLE: air-transport ;"
|
||||||
"HOOK: deliver transport ( destination -- )"
|
"HOOK: deliver transport ( destination -- )"
|
||||||
"M: land-transport deliver \"Land delivery to \" write print ;"
|
"M: land-transport deliver \"Land delivery to \" write print ;"
|
||||||
"M: air-transport deliver \"Air delivery to \" write print ;"
|
"M: air-transport deliver \"Air delivery to \" write print ;"
|
||||||
"T{ air-transport } transport set"
|
"T{ air-transport } transport set"
|
||||||
"\"New York City\" deliver"
|
"\"New York City\" deliver"
|
||||||
"Air delivery to New York City"
|
"Air delivery to New York City"
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
USING: help.markup help.syntax parser strings words assocs vocabs ;
|
USING: help.markup help.syntax parser strings words assocs vocabs ;
|
||||||
IN: vocabs.parser
|
IN: vocabs.parser
|
||||||
|
|
||||||
ARTICLE: "word-search-errors" "Word lookup errors"
|
ARTICLE: "word-search-errors" "Word lookup errors"
|
||||||
"If the parser cannot not find a word in the current vocabulary search path, it attempts to look for the word in all loaded vocabularies."
|
"If the parser cannot not find a word in the current vocabulary search path, it attempts to look for the word in all loaded vocabularies."
|
||||||
$nl
|
$nl
|
||||||
"If " { $link auto-use? } " mode is off, a restartable error is thrown with a restart for each vocabulary in question, together with a restart which defers the word in the current vocabulary, as if " { $link POSTPONE: DEFER: } " was used."
|
"If " { $link auto-use? } " mode is off, a restartable error is thrown with a restart for each vocabulary in question, together with a restart which defers the word in the current vocabulary, as if " { $link POSTPONE: DEFER: } " was used."
|
||||||
|
@ -142,7 +142,7 @@ HELP: add-words-from
|
||||||
|
|
||||||
HELP: add-words-excluding
|
HELP: add-words-excluding
|
||||||
{ $values { "vocab" "a vocabulary specifier" } { "words" "a sequence of word names" } }
|
{ $values { "vocab" "a vocabulary specifier" } { "words" "a sequence of word names" } }
|
||||||
{ $description "Adds all words except for " { $snippet "words" } " from " { $snippet "vocab" } " to the manifest." }
|
{ $description "Adds all words except for " { $snippet "words" } " from " { $snippet "vocab" } " to the manifest." }
|
||||||
{ $notes "This word is used to implement " { $link POSTPONE: EXCLUDE: } "." } ;
|
{ $notes "This word is used to implement " { $link POSTPONE: EXCLUDE: } "." } ;
|
||||||
|
|
||||||
HELP: add-renamed-word
|
HELP: add-renamed-word
|
||||||
|
|
|
@ -77,7 +77,7 @@ HELP: forget-vocab
|
||||||
{ $notes "This word must be called from inside " { $link with-compilation-unit } "." } ;
|
{ $notes "This word must be called from inside " { $link with-compilation-unit } "." } ;
|
||||||
|
|
||||||
HELP: load-vocab-hook
|
HELP: load-vocab-hook
|
||||||
{ $var-description { $quotation "( name -- vocab )" } " which loads a vocabulary. This quotation is called by " { $link load-vocab } ". The default value should not need to be changed; this functinality is implemented via a hook stored in a variable to break a circular dependency which would otherwise exist from " { $vocab-link "vocabs" } " to " { $vocab-link "vocabs.loader" } " to " { $vocab-link "parser" } " back to " { $vocab-link "vocabs" } "." } ;
|
{ $var-description { $quotation "( name -- vocab )" } " which loads a vocabulary. This quotation is called by " { $link load-vocab } ". The default value should not need to be changed; this functionality is implemented via a hook stored in a variable to break a circular dependency which would otherwise exist from " { $vocab-link "vocabs" } " to " { $vocab-link "vocabs.loader" } " to " { $vocab-link "parser" } " back to " { $vocab-link "vocabs" } "." } ;
|
||||||
|
|
||||||
HELP: words-named
|
HELP: words-named
|
||||||
{ $values { "str" string } { "seq" "a sequence of words" } }
|
{ $values { "str" string } { "seq" "a sequence of words" } }
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
! (c)2010 Joe Groff bsd license
|
! (c)2010 Joe Groff bsd license
|
||||||
USING: alien alien.c-types alien.libraries alien.strings
|
USING: alien alien.c-types alien.data alien.libraries
|
||||||
alien.syntax combinators destructors io.encodings.ascii kernel
|
alien.strings alien.syntax combinators destructors
|
||||||
libc locals sequences system ;
|
io.encodings.ascii kernel libc locals sequences system ;
|
||||||
IN: alien.cxx.demangle.libstdcxx
|
IN: alien.cxx.demangle.libstdcxx
|
||||||
|
|
||||||
FUNCTION: char* __cxa_demangle ( char* mangled_name, char* output_buffer, size_t* length, int* status ) ;
|
FUNCTION: char* __cxa_demangle ( char* mangled_name, char* output_buffer, size_t* length, int* status ) ;
|
||||||
|
|
|
@ -1,8 +1,8 @@
|
||||||
! (c)2009 Joe Groff bsd license
|
! (c)2009 Joe Groff bsd license
|
||||||
USING: accessors alien audio classes.struct fry calendar timers
|
USING: accessors alien alien.data audio classes.struct fry
|
||||||
combinators combinators.short-circuit destructors generalizations
|
calendar timers combinators combinators.short-circuit
|
||||||
kernel literals locals math openal sequences
|
destructors generalizations kernel literals locals math openal
|
||||||
sequences.generalizations specialized-arrays strings ;
|
sequences sequences.generalizations specialized-arrays strings ;
|
||||||
QUALIFIED-WITH: alien.c-types c
|
QUALIFIED-WITH: alien.c-types c
|
||||||
SPECIALIZED-ARRAYS: c:float c:uchar c:uint ;
|
SPECIALIZED-ARRAYS: c:float c:uchar c:uint ;
|
||||||
IN: audio.engine
|
IN: audio.engine
|
||||||
|
@ -122,7 +122,7 @@ ERROR: audio-context-not-available device-name ;
|
||||||
|
|
||||||
:: flush-source ( al-source -- )
|
:: flush-source ( al-source -- )
|
||||||
al-source alSourceStop
|
al-source alSourceStop
|
||||||
0 c:uint c:<ref> :> dummy-buffer
|
0 c:uint <ref> :> dummy-buffer
|
||||||
al-source AL_BUFFERS_PROCESSED get-source-param [
|
al-source AL_BUFFERS_PROCESSED get-source-param [
|
||||||
al-source 1 dummy-buffer alSourceUnqueueBuffers
|
al-source 1 dummy-buffer alSourceUnqueueBuffers
|
||||||
] times
|
] times
|
||||||
|
@ -161,7 +161,7 @@ ERROR: audio-context-not-available device-name ;
|
||||||
audio-clip t >>done? drop
|
audio-clip t >>done? drop
|
||||||
] [
|
] [
|
||||||
al-buffer audio-clip openal-format data size audio-clip sample-rate>> alBufferData
|
al-buffer audio-clip openal-format data size audio-clip sample-rate>> alBufferData
|
||||||
al-source 1 al-buffer c:uint c:<ref> alSourceQueueBuffers
|
al-source 1 al-buffer c:uint <ref> alSourceQueueBuffers
|
||||||
] if
|
] if
|
||||||
] unless ;
|
] unless ;
|
||||||
|
|
||||||
|
@ -190,10 +190,10 @@ M: static-audio-clip (update-audio-clip)
|
||||||
|
|
||||||
M:: streaming-audio-clip (update-audio-clip) ( audio-clip -- )
|
M:: streaming-audio-clip (update-audio-clip) ( audio-clip -- )
|
||||||
audio-clip al-source>> :> al-source
|
audio-clip al-source>> :> al-source
|
||||||
0 c:uint c:<ref> :> buffer
|
0 c:uint <ref> :> buffer
|
||||||
al-source AL_BUFFERS_PROCESSED get-source-param [
|
al-source AL_BUFFERS_PROCESSED get-source-param [
|
||||||
al-source 1 buffer alSourceUnqueueBuffers
|
al-source 1 buffer alSourceUnqueueBuffers
|
||||||
audio-clip buffer c:uint c:deref queue-clip-buffer
|
audio-clip buffer c:uint deref queue-clip-buffer
|
||||||
] times ;
|
] times ;
|
||||||
|
|
||||||
: update-audio-clip ( audio-clip -- )
|
: update-audio-clip ( audio-clip -- )
|
||||||
|
@ -256,7 +256,7 @@ M: audio-engine dispose*
|
||||||
audio-engine get-available-source :> al-source
|
audio-engine get-available-source :> al-source
|
||||||
|
|
||||||
al-source [
|
al-source [
|
||||||
1 0 c:uint c:<ref> [ alGenBuffers ] keep c:uint c:deref :> al-buffer
|
1 0 c:uint <ref> [ alGenBuffers ] keep c:uint deref :> al-buffer
|
||||||
al-buffer audio { [ openal-format ] [ data>> ] [ size>> ] [ sample-rate>> ] } cleave
|
al-buffer audio { [ openal-format ] [ data>> ] [ size>> ] [ sample-rate>> ] } cleave
|
||||||
alBufferData
|
alBufferData
|
||||||
|
|
||||||
|
@ -301,7 +301,7 @@ M: audio-clip dispose*
|
||||||
|
|
||||||
M: static-audio-clip dispose*
|
M: static-audio-clip dispose*
|
||||||
[ call-next-method ]
|
[ call-next-method ]
|
||||||
[ [ 1 ] dip al-buffer>> c:uint c:<ref> alDeleteBuffers ] bi ;
|
[ [ 1 ] dip al-buffer>> c:uint <ref> alDeleteBuffers ] bi ;
|
||||||
|
|
||||||
M: streaming-audio-clip dispose*
|
M: streaming-audio-clip dispose*
|
||||||
[ call-next-method ]
|
[ call-next-method ]
|
||||||
|
|
|
@ -1,9 +1,9 @@
|
||||||
! (c)2007, 2010 Chris Double, Joe Groff bsd license
|
! (c)2007, 2010 Chris Double, Joe Groff bsd license
|
||||||
USING: accessors alien alien.c-types audio.engine byte-arrays
|
USING: accessors alien alien.c-types alien.data audio.engine
|
||||||
classes.struct combinators destructors fry io io.files
|
byte-arrays classes.struct combinators destructors fry io
|
||||||
io.encodings.binary kernel libc locals make math math.order
|
io.files io.encodings.binary kernel libc locals make math
|
||||||
math.parser ogg ogg.vorbis sequences specialized-arrays
|
math.order math.parser ogg ogg.vorbis sequences
|
||||||
specialized-vectors ;
|
specialized-arrays specialized-vectors ;
|
||||||
FROM: alien.c-types => float short void* ;
|
FROM: alien.c-types => float short void* ;
|
||||||
SPECIALIZED-ARRAYS: float void* ;
|
SPECIALIZED-ARRAYS: float void* ;
|
||||||
SPECIALIZED-VECTOR: short
|
SPECIALIZED-VECTOR: short
|
||||||
|
|
|
@ -9,14 +9,14 @@ IN: cuda.contexts
|
||||||
|
|
||||||
: create-context ( device flags -- context )
|
: create-context ( device flags -- context )
|
||||||
swap
|
swap
|
||||||
[ CUcontext <c-object> ] 2dip
|
[ { CUcontext } ] 2dip
|
||||||
[ cuCtxCreate cuda-error ] 3keep 2drop void* deref ; inline
|
'[ _ _ cuCtxCreate cuda-error ] with-out-parameters ; inline
|
||||||
|
|
||||||
: sync-context ( -- )
|
: sync-context ( -- )
|
||||||
cuCtxSynchronize cuda-error ; inline
|
cuCtxSynchronize cuda-error ; inline
|
||||||
|
|
||||||
: context-device ( -- n )
|
: context-device ( -- n )
|
||||||
CUdevice <c-object> [ cuCtxGetDevice cuda-error ] keep int deref ; inline
|
{ CUdevice } [ cuCtxGetDevice cuda-error ] with-out-parameters ; inline
|
||||||
|
|
||||||
: destroy-context ( context -- ) cuCtxDestroy cuda-error ; inline
|
: destroy-context ( context -- ) cuCtxDestroy cuda-error ; inline
|
||||||
|
|
||||||
|
|
|
@ -16,7 +16,7 @@ TUPLE: cuda-error code ;
|
||||||
dup CUDA_SUCCESS = [ drop ] [ \ cuda-error boa throw ] if ;
|
dup CUDA_SUCCESS = [ drop ] [ \ cuda-error boa throw ] if ;
|
||||||
|
|
||||||
: cuda-version ( -- n )
|
: cuda-version ( -- n )
|
||||||
c:int <c-object> [ cuDriverGetVersion cuda-error ] keep c:int c:deref ;
|
{ c:int } [ cuDriverGetVersion cuda-error ] with-out-parameters ;
|
||||||
|
|
||||||
: init-cuda ( -- )
|
: init-cuda ( -- )
|
||||||
0 cuInit cuda-error ; inline
|
0 cuInit cuda-error ; inline
|
||||||
|
|
|
@ -8,11 +8,10 @@ prettyprint sequences ;
|
||||||
IN: cuda.devices
|
IN: cuda.devices
|
||||||
|
|
||||||
: #cuda-devices ( -- n )
|
: #cuda-devices ( -- n )
|
||||||
int <c-object> [ cuDeviceGetCount cuda-error ] keep int deref ;
|
{ int } [ cuDeviceGetCount cuda-error ] with-out-parameters ;
|
||||||
|
|
||||||
: n>cuda-device ( n -- device )
|
: n>cuda-device ( n -- device )
|
||||||
[ CUdevice <c-object> ] dip [ cuDeviceGet cuda-error ] 2keep
|
[ { CUdevice } ] dip '[ _ cuDeviceGet cuda-error ] with-out-parameters ;
|
||||||
drop int deref ;
|
|
||||||
|
|
||||||
: enumerate-cuda-devices ( -- devices )
|
: enumerate-cuda-devices ( -- devices )
|
||||||
#cuda-devices iota [ n>cuda-device ] map ;
|
#cuda-devices iota [ n>cuda-device ] map ;
|
||||||
|
@ -33,19 +32,17 @@ IN: cuda.devices
|
||||||
[ 2drop utf8 alien>string ] 3bi ;
|
[ 2drop utf8 alien>string ] 3bi ;
|
||||||
|
|
||||||
: cuda-device-capability ( n -- pair )
|
: cuda-device-capability ( n -- pair )
|
||||||
[ int <c-object> int <c-object> ] dip
|
[ { int int } ] dip
|
||||||
[ cuDeviceComputeCapability cuda-error ]
|
'[ _ cuDeviceComputeCapability cuda-error ] with-out-parameters
|
||||||
[ drop [ int deref ] bi@ ] 3bi 2array ;
|
2array ;
|
||||||
|
|
||||||
: cuda-device-memory ( n -- bytes )
|
: cuda-device-memory ( n -- bytes )
|
||||||
[ uint <c-object> ] dip
|
[ { uint } ] dip
|
||||||
[ cuDeviceTotalMem cuda-error ]
|
'[ _ cuDeviceTotalMem cuda-error ] with-out-parameters ;
|
||||||
[ drop uint deref ] 2bi ;
|
|
||||||
|
|
||||||
: cuda-device-attribute ( attribute n -- n )
|
: cuda-device-attribute ( attribute n -- n )
|
||||||
[ int <c-object> ] 2dip
|
[ { int } ] 2dip
|
||||||
[ cuDeviceGetAttribute cuda-error ]
|
'[ _ _ cuDeviceGetAttribute cuda-error ] with-out-parameters ;
|
||||||
[ 2drop int deref ] 3bi ;
|
|
||||||
|
|
||||||
: cuda-device. ( n -- )
|
: cuda-device. ( n -- )
|
||||||
{
|
{
|
||||||
|
|
|
@ -6,25 +6,25 @@ IN: cuda.gl
|
||||||
|
|
||||||
: create-gl-cuda-context ( device flags -- context )
|
: create-gl-cuda-context ( device flags -- context )
|
||||||
swap
|
swap
|
||||||
[ CUcontext <c-object> ] 2dip
|
[ { CUcontext } ] 2dip
|
||||||
[ cuGLCtxCreate cuda-error ] 3keep 2drop void* deref ; inline
|
'[ _ _ cuGLCtxCreate cuda-error ] with-out-parameters ; inline
|
||||||
|
|
||||||
: with-gl-cuda-context ( device flags quot -- )
|
: with-gl-cuda-context ( device flags quot -- )
|
||||||
[ set-up-cuda-context create-gl-cuda-context ] dip (with-cuda-context) ; inline
|
[ set-up-cuda-context create-gl-cuda-context ] dip (with-cuda-context) ; inline
|
||||||
|
|
||||||
: gl-buffer>resource ( gl-buffer flags -- resource )
|
: gl-buffer>resource ( gl-buffer flags -- resource )
|
||||||
enum>number
|
enum>number
|
||||||
[ CUgraphicsResource <c-object> ] 2dip
|
[ { CUgraphicsResource } ] 2dip
|
||||||
[ cuGraphicsGLRegisterBuffer cuda-error ] 3keep 2drop void* deref ; inline
|
'[ _ _ cuGraphicsGLRegisterBuffer cuda-error ] with-out-parameters ; inline
|
||||||
|
|
||||||
: buffer>resource ( buffer flags -- resource )
|
: buffer>resource ( buffer flags -- resource )
|
||||||
[ handle>> ] dip gl-buffer>resource ; inline
|
[ handle>> ] dip gl-buffer>resource ; inline
|
||||||
|
|
||||||
: map-resource ( resource -- device-ptr size )
|
: map-resource ( resource -- device-ptr size )
|
||||||
[ 1 swap void* <ref> f cuGraphicsMapResources cuda-error ] [
|
[ 1 swap void* <ref> f cuGraphicsMapResources cuda-error ] [
|
||||||
[ CUdeviceptr <c-object> uint <c-object> ] dip
|
[ { CUdeviceptr uint } ] dip
|
||||||
[ cuGraphicsResourceGetMappedPointer cuda-error ] 3keep drop
|
'[ _ cuGraphicsResourceGetMappedPointer cuda-error ]
|
||||||
[ uint deref ] [ uint deref ] bi*
|
with-out-parameters
|
||||||
] bi ; inline
|
] bi ; inline
|
||||||
|
|
||||||
: unmap-resource ( resource -- )
|
: unmap-resource ( resource -- )
|
||||||
|
|
|
@ -74,8 +74,8 @@ M: sequence grid-dim
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
||||||
: load-module ( path -- module )
|
: load-module ( path -- module )
|
||||||
[ CUmodule <c-object> ] dip
|
[ { CUmodule } ] dip
|
||||||
[ cuModuleLoad cuda-error ] 2keep drop c:void* c:deref ;
|
'[ _ cuModuleLoad cuda-error ] with-out-parameters ;
|
||||||
|
|
||||||
: unload-module ( module -- )
|
: unload-module ( module -- )
|
||||||
cuModuleUnload cuda-error ;
|
cuModuleUnload cuda-error ;
|
||||||
|
@ -151,8 +151,8 @@ MACRO: cuda-arguments ( c-types abi -- quot: ( args... function -- ) )
|
||||||
[ [ 0 cuda-param-size ] ] swap '[ _ [cuda-arguments] ] if-empty ;
|
[ [ 0 cuda-param-size ] ] swap '[ _ [cuda-arguments] ] if-empty ;
|
||||||
|
|
||||||
: get-function-ptr ( module string -- function )
|
: get-function-ptr ( module string -- function )
|
||||||
[ CUfunction <c-object> ] 2dip
|
[ { CUfunction } ] 2dip
|
||||||
[ cuModuleGetFunction cuda-error ] 3keep 2drop c:void* c:deref ;
|
'[ _ _ cuModuleGetFunction cuda-error ] with-out-parameters ;
|
||||||
|
|
||||||
: cached-module ( module-name -- alien )
|
: cached-module ( module-name -- alien )
|
||||||
lookup-cuda-library
|
lookup-cuda-library
|
||||||
|
@ -170,9 +170,9 @@ MACRO: cuda-invoke ( module-name function-name arguments -- )
|
||||||
] ;
|
] ;
|
||||||
|
|
||||||
: cuda-global* ( module-name symbol-name -- device-ptr size )
|
: cuda-global* ( module-name symbol-name -- device-ptr size )
|
||||||
[ CUdeviceptr <c-object> c:uint <c-object> ] 2dip
|
[ { CUdeviceptr { c:uint initial: 0 } } ] 2dip
|
||||||
[ cached-module ] dip
|
[ cached-module ] dip
|
||||||
'[ _ _ cuModuleGetGlobal cuda-error ] 2keep [ c:uint c:deref ] bi@ ; inline
|
'[ _ _ cuModuleGetGlobal cuda-error ] with-out-parameters ; inline
|
||||||
|
|
||||||
: cuda-global ( module-name symbol-name -- device-ptr )
|
: cuda-global ( module-name symbol-name -- device-ptr )
|
||||||
cuda-global* drop ; inline
|
cuda-global* drop ; inline
|
||||||
|
|
|
@ -8,9 +8,8 @@ QUALIFIED-WITH: alien.c-types c
|
||||||
IN: cuda.memory
|
IN: cuda.memory
|
||||||
|
|
||||||
: cuda-malloc ( n -- ptr )
|
: cuda-malloc ( n -- ptr )
|
||||||
[ CUdeviceptr <c-object> ] dip
|
[ { CUdeviceptr } ] dip
|
||||||
'[ _ cuMemAlloc cuda-error ] keep
|
'[ _ cuMemAlloc cuda-error ] with-out-parameters ; inline
|
||||||
c:int c:deref ; inline
|
|
||||||
|
|
||||||
: cuda-malloc-type ( n type -- ptr )
|
: cuda-malloc-type ( n type -- ptr )
|
||||||
c:heap-size * cuda-malloc ; inline
|
c:heap-size * cuda-malloc ; inline
|
||||||
|
|
|
@ -1,8 +1,8 @@
|
||||||
! (c)2009 Joe Groff bsd license
|
! (c)2009 Joe Groff bsd license
|
||||||
USING: accessors alien.c-types arrays byte-arrays combinators
|
USING: accessors alien.c-types alien.data arrays byte-arrays
|
||||||
destructors gpu gpu.buffers gpu.private gpu.textures
|
combinators destructors gpu gpu.buffers gpu.private gpu.textures
|
||||||
gpu.textures.private images kernel locals math math.rectangles opengl
|
gpu.textures.private images kernel locals math math.rectangles
|
||||||
opengl.framebuffers opengl.gl opengl.textures sequences
|
opengl opengl.framebuffers opengl.gl opengl.textures sequences
|
||||||
specialized-arrays typed ui.gadgets.worlds variants ;
|
specialized-arrays typed ui.gadgets.worlds variants ;
|
||||||
SPECIALIZED-ARRAY: int
|
SPECIALIZED-ARRAY: int
|
||||||
SPECIALIZED-ARRAY: uint
|
SPECIALIZED-ARRAY: uint
|
||||||
|
|
|
@ -37,8 +37,8 @@ SYMBOL: js-context
|
||||||
|
|
||||||
: eval-js ( string -- result-string )
|
: eval-js ( string -- result-string )
|
||||||
[ js-context get dup ] dip
|
[ js-context get dup ] dip
|
||||||
JSStringCreateWithUTF8CString f f 0 JSValueRef <c-object>
|
JSStringCreateWithUTF8CString f f 0
|
||||||
[ JSEvaluateScript ] keep void* deref
|
{ { void* initial: f } } [ JSEvaluateScript ] with-out-parameters
|
||||||
dup [ nip JSValueRef>string javascriptcore-error ] [ drop JSValueRef>string ] if ;
|
dup [ nip JSValueRef>string javascriptcore-error ] [ drop JSValueRef>string ] if ;
|
||||||
|
|
||||||
: eval-js-standalone ( string -- result-string )
|
: eval-js-standalone ( string -- result-string )
|
||||||
|
|
|
@ -1,7 +1,8 @@
|
||||||
! Copyright (C) 2009 Matthew Willis.
|
! Copyright (C) 2009 Matthew Willis.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: accessors alien.c-types alien.syntax assocs destructors
|
USING: accessors alien.c-types alien.data alien.syntax assocs
|
||||||
kernel llvm.core llvm.engine llvm.wrappers namespaces ;
|
destructors kernel llvm.core llvm.engine llvm.wrappers
|
||||||
|
namespaces ;
|
||||||
|
|
||||||
IN: llvm.jit
|
IN: llvm.jit
|
||||||
|
|
||||||
|
|
|
@ -1,7 +1,8 @@
|
||||||
! Copyright (C) 2009 Matthew Willis.
|
! Copyright (C) 2009 Matthew Willis.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: accessors alien.c-types alien.syntax destructors kernel
|
USING: accessors alien.c-types alien.data alien.syntax
|
||||||
llvm.core llvm.engine llvm.jit llvm.wrappers ;
|
destructors kernel llvm.core llvm.engine llvm.jit llvm.wrappers
|
||||||
|
;
|
||||||
|
|
||||||
IN: llvm.reader
|
IN: llvm.reader
|
||||||
|
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
! Copyright (C) 2009 Matthew Willis.
|
! Copyright (C) 2009 Matthew Willis.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: accessors alien.c-types alien.strings
|
USING: accessors alien.c-types alien.data alien.strings
|
||||||
io.encodings.utf8 destructors kernel
|
io.encodings.utf8 destructors kernel
|
||||||
llvm.core llvm.engine ;
|
llvm.core llvm.engine ;
|
||||||
|
|
||||||
|
|
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in New Issue