factor: char: postpone: color: hexcolor: flexhexcolor: decimal:

modern-harvey2
Doug Coleman 2017-08-26 12:27:25 -05:00
parent 9a94118c9d
commit c436f6dbad
483 changed files with 2431 additions and 2432 deletions

View File

@ -65,7 +65,7 @@ HELP: longlong
HELP: ulonglong HELP: ulonglong
{ $description "This C type represents an eight-byte unsigned integer type. Input values will be converted to " { $link math:integer } "s and truncated to 64 bits; output values will be returned as " { $link math:integer } "s." } ; { $description "This C type represents an eight-byte unsigned integer type. Input values will be converted to " { $link math:integer } "s and truncated to 64 bits; output values will be returned as " { $link math:integer } "s." } ;
HELP: void HELP: void
{ $description "This symbol is not a valid C type, but it can be used as the return type for a " { $link POSTPONE: FUNCTION: } " or " { $link POSTPONE: CALLBACK: } " definition or for an " { $link alien-invoke } " or " { $link alien-callback } " call." } ; { $description "This symbol is not a valid C type, but it can be used as the return type for a " { $link postpone: FUNCTION: } " or " { $link postpone: CALLBACK: } " definition or for an " { $link alien-invoke } " or " { $link alien-callback } " call." } ;
HELP: void* HELP: void*
{ $description "This C type represents a generic pointer to C memory. See " { $link pointer } " for information on pointer C types." } ; { $description "This C type represents a generic pointer to C memory. See " { $link pointer } " for information on pointer C types." } ;
HELP: c-string HELP: c-string
@ -84,7 +84,7 @@ HELP: pointer
$nl $nl
"Pointer output values are represented in Factor as " { $link alien } "s. If the pointed-to type is a struct, the alien will automatically be wrapped in a struct object if it is not null." "Pointer output values are represented in Factor as " { $link alien } "s. If the pointed-to type is a struct, the alien will automatically be wrapped in a struct object if it is not null."
$nl $nl
"In " { $link POSTPONE: TYPEDEF: } ", " { $link POSTPONE: FUNCTION: } ", " { $link POSTPONE: CALLBACK: } ", and " { $link POSTPONE: STRUCT: } " definitions, pointer types can be created by suffixing " { $snippet "*" } " to a C type name. Outside of FFI definitions, a pointer C type can be created using the " { $link POSTPONE: pointer: } " syntax word:" "In " { $link postpone: TYPEDEF: } ", " { $link postpone: FUNCTION: } ", " { $link postpone: CALLBACK: } ", and " { $link postpone: STRUCT: } " definitions, pointer types can be created by suffixing " { $snippet "*" } " to a C type name. Outside of FFI definitions, a pointer C type can be created using the " { $link postpone: pointer: } " syntax word:"
{ $unchecked-example "FUNCTION: int* foo ( char* bar ) ;" } { $unchecked-example "FUNCTION: int* foo ( char* bar ) ;" }
{ $unchecked-example ": foo ( bar -- int* ) { $unchecked-example ": foo ( bar -- int* )
pointer: int f \"foo\" { pointer: char } f alien-invoke ;" } } ; pointer: int f \"foo\" { pointer: char } f alien-invoke ;" } } ;
@ -148,7 +148,7 @@ ARTICLE: "c-types.ambiguity" "Word name clashes with C types"
"FUNCTION: float magic_number ( ) ;" "FUNCTION: float magic_number ( ) ;"
"magic_number 3.0 + ." "magic_number 3.0 + ."
} }
"The correct solution is to use one of " { $link POSTPONE: FROM: } ", " { $link POSTPONE: QUALIFIED: } " or " { $link POSTPONE: QUALIFIED-WITH: } " to disambiguate word lookup:" "The correct solution is to use one of " { $link postpone: FROM: } ", " { $link postpone: QUALIFIED: } " or " { $link postpone: QUALIFIED-WITH: } " to disambiguate word lookup:"
{ $code { $code
"USING: alien.syntax math prettyprint ;" "USING: alien.syntax math prettyprint ;"
"QUALIFIED-WITH: alien.c-types c" "QUALIFIED-WITH: alien.c-types c"
@ -165,10 +165,10 @@ ARTICLE: "c-types-specs" "C type specifiers"
$nl $nl
"Defining new C types:" "Defining new C types:"
{ $subsections { $subsections
POSTPONE: STRUCT: postpone: STRUCT:
POSTPONE: UNION-STRUCT: postpone: UNION-STRUCT:
POSTPONE: CALLBACK: postpone: CALLBACK:
POSTPONE: TYPEDEF: postpone: TYPEDEF:
} }
"Getting the c-type of a class:" "Getting the c-type of a class:"
{ $subsections lookup-c-type } { $subsections lookup-c-type }

View File

@ -503,7 +503,7 @@ M: double-2-rep rep-component-type drop double ;
GENERIC: pointer-string ( pointer -- string/f ) GENERIC: pointer-string ( pointer -- string/f )
M: object pointer-string drop f ; M: object pointer-string drop f ;
M: word pointer-string name>> ; M: word pointer-string name>> ;
M: pointer pointer-string to>> pointer-string [ CHAR: * suffix ] [ f ] if* ; M: pointer pointer-string to>> pointer-string [ char: * suffix ] [ f ] if* ;
GENERIC: c-type-string ( c-type -- string ) GENERIC: c-type-string ( c-type -- string )

View File

@ -182,7 +182,7 @@ $nl
{ $subsections "alien.enums" } { $subsections "alien.enums" }
"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-STRUCT: } ". 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-STRUCT: } ". See " { $link "classes.struct" } " for details. For passing arrays to and from C, use the " { $link "specialized-arrays" } " vocabulary." ;
HELP: malloc-string HELP: malloc-string
{ $values { "string" string } { "encoding" "an encoding descriptor" } { "alien" c-ptr } } { $values { "string" string } { "encoding" "an encoding descriptor" } { "alien" c-ptr } }
@ -202,7 +202,7 @@ HELP: <c-direct-array>
{ $notes "The appropriate specialized array vocabulary must be loaded; otherwise, an error will be thrown. 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. See the " { $vocab-link "specialized-arrays" } " vocabulary for details on the underlying sequence type constructed." } ;
ARTICLE: "c-strings" "C strings" ARTICLE: "c-strings" "C strings"
"C string types are arrays with shape " { $snippet "{ c-string encoding }" } ", where " { $snippet "encoding" } " is an encoding descriptor. The type " { $link c-string } " is an alias for " { $snippet "{ c-string utf8 }" } ". See " { $link "encodings-descriptors" } " for information about encoding descriptors. In " { $link POSTPONE: TYPEDEF: } ", " { $link POSTPONE: FUNCTION: } ", " { $link POSTPONE: CALLBACK: } ", and " { $link POSTPONE: STRUCT: } " definitions, the shorthand syntax " { $snippet "c-string[encoding]" } " can be used to specify the string encoding." "C string types are arrays with shape " { $snippet "{ c-string encoding }" } ", where " { $snippet "encoding" } " is an encoding descriptor. The type " { $link c-string } " is an alias for " { $snippet "{ c-string utf8 }" } ". See " { $link "encodings-descriptors" } " for information about encoding descriptors. In " { $link postpone: TYPEDEF: } ", " { $link postpone: FUNCTION: } ", " { $link postpone: CALLBACK: } ", and " { $link postpone: STRUCT: } " definitions, the shorthand syntax " { $snippet "c-string[encoding]" } " can be used to specify the string encoding."
$nl $nl
"Using C string types triggers automatic conversions:" "Using C string types triggers automatic conversions:"
{ $list { $list
@ -211,7 +211,7 @@ $nl
"Passing an already encoded " { $link byte-array } " also works and performs no conversion." "Passing an already encoded " { $link byte-array } " also works and performs no conversion."
} }
{ "Returning a C string from a C function allocates a Factor string in the Factor heap; the memory pointed to by the returned pointer is then decoded with the requested encoding into the Factor string." } { "Returning a C string from a C function allocates a Factor string in the Factor heap; the memory pointed to by the returned pointer is then decoded with the requested encoding into the Factor string." }
{ "Reading " { $link c-string } " slots of " { $link POSTPONE: STRUCT: } " or " { $link POSTPONE: UNION-STRUCT: } " returns Factor strings." } { "Reading " { $link c-string } " slots of " { $link postpone: STRUCT: } " or " { $link postpone: UNION-STRUCT: } " returns Factor strings." }
} }
$nl $nl
"Care must be taken if the C function expects a pointer to a string with its length represented by another parameter rather than a null terminator. Passing the result of calling " { $link length } " on the string object will not suffice. This is because a Factor string of " { $emphasis "n" } " characters will not necessarily encode to " { $emphasis "n" } " bytes. The correct idiom for C functions which take a string with a length is to first encode the string using " { $link encode } ", and then pass the resulting byte array together with the length of this byte array." "Care must be taken if the C function expects a pointer to a string with its length represented by another parameter rather than a null terminator. Passing the result of calling " { $link length } " on the string object will not suffice. This is because a Factor string of " { $emphasis "n" } " characters will not necessarily encode to " { $emphasis "n" } " bytes. The correct idiom for C functions which take a string with a length is to first encode the string using " { $link encode } ", and then pass the resulting byte array together with the length of this byte array."

View File

@ -25,6 +25,6 @@ HELP: DESTRUCTOR:
ARTICLE: "alien.destructors" "Alien destructors" ARTICLE: "alien.destructors" "Alien destructors"
"The " { $vocab-link "alien.destructors" } " vocabulary defines a utility parsing word for defining new disposable classes." "The " { $vocab-link "alien.destructors" } " vocabulary defines a utility parsing word for defining new disposable classes."
{ $subsections POSTPONE: DESTRUCTOR: } ; { $subsections postpone: DESTRUCTOR: } ;
ABOUT: "alien.destructors" ABOUT: "alien.destructors"

View File

@ -141,10 +141,10 @@ ARTICLE: "alien.endian" "Alien endian-aware types"
} }
"Syntax for making endian-aware structs out of native types:" "Syntax for making endian-aware structs out of native types:"
{ $subsections { $subsections
POSTPONE: LE-STRUCT: postpone: LE-STRUCT:
POSTPONE: BE-STRUCT: postpone: BE-STRUCT:
POSTPONE: LE-PACKED-STRUCT: postpone: LE-PACKED-STRUCT:
POSTPONE: BE-PACKED-STRUCT: postpone: BE-PACKED-STRUCT:
} ; } ;
ABOUT: "alien.endian" ABOUT: "alien.endian"

View File

@ -7,7 +7,7 @@ HELP: define-enum
{ $values { $values
{ "word" word } { "base-type" c-type } { "members" "sequence of word and value pairs" } { "word" word } { "base-type" c-type } { "members" "sequence of word and value pairs" }
} }
{ $description "Defines an enum. This is the run-time equivalent of " { $link POSTPONE: ENUM: } "." } ; { $description "Defines an enum. This is the run-time equivalent of " { $link postpone: ENUM: } "." } ;
HELP: enum>number HELP: enum>number
{ $values { $values
@ -23,6 +23,6 @@ HELP: number>enum
} }
{ $description "Convert a number to an enum." } ; { $description "Convert a number to an 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"

View File

@ -20,5 +20,5 @@ HELP: find-library
{ $code { $code
"<< \"sqlite\" \"sqlite3\" find-library cdecl add-library >>" "<< \"sqlite\" \"sqlite3\" find-library cdecl add-library >>"
} }
"Note the parse time evaluation with " { $link POSTPONE: << } "." "Note the parse time evaluation with " { $link postpone: << } "."
} ; } ;

View File

@ -32,7 +32,7 @@ CONSTANT: mach-map {
mach-map cpu of { "libc6" } or ; mach-map cpu of { "libc6" } or ;
: name-matches? ( lib triple -- ? ) : name-matches? ( lib triple -- ? )
first swap ?head [ ?first CHAR: . = ] [ drop f ] if ; first swap ?head [ ?first char: . = ] [ drop f ] if ;
: arch-matches? ( lib triple -- ? ) : arch-matches? ( lib triple -- ? )
[ drop ldconfig-arch ] [ second swap subset? ] bi* ; [ drop ldconfig-arch ] [ second swap subset? ] bi* ;

View File

@ -6,10 +6,10 @@ IN: alien.libraries
HELP: add-library HELP: add-library
{ $values { "name" string } { "path" string } { "abi" "one of " { $link cdecl } " or " { $link stdcall } } } { $values { "name" string } { "path" string } { "abi" "one of " { $link cdecl } " or " { $link stdcall } } }
{ $description "Defines a new logical library named " { $snippet "name" } " located in the file system at " { $snippet "path" } " and the specified ABI. You can find the location of the library via words in " { $vocab-link "alien.libraries.finder" } ". The logical library name can then be used by a " { $link POSTPONE: LIBRARY: } " form to specify the logical library for subsequent " { $link POSTPONE: FUNCTION: } " definitions." } { $description "Defines a new logical library named " { $snippet "name" } " located in the file system at " { $snippet "path" } " and the specified ABI. You can find the location of the library via words in " { $vocab-link "alien.libraries.finder" } ". The logical library name can then be used by a " { $link postpone: LIBRARY: } " form to specify the logical library for subsequent " { $link postpone: FUNCTION: } " definitions." }
{ $notes "Because the entire source file is parsed before top-level forms are executed, " { $link add-library } " must be placed within a " { $snippet "<< ... >>" } " parse-time evaluation block." { $notes "Because the entire source file is parsed before top-level forms are executed, " { $link add-library } " must be placed within a " { $snippet "<< ... >>" } " parse-time evaluation block."
$nl $nl
"This ensures that if the logical library is later used in the same file, for example by a " { $link POSTPONE: FUNCTION: } " definition. Otherwise, the " { $link add-library } " call will happen too late, after compilation, and the C function calls will not refer to the correct library." "This ensures that if the logical library is later used in the same file, for example by a " { $link postpone: FUNCTION: } " definition. Otherwise, the " { $link add-library } " call will happen too late, after compilation, and the C function calls will not refer to the correct library."
$nl $nl
"For details about parse-time evaluation, see " { $link "syntax-immediate" } "." } "For details about parse-time evaluation, see " { $link "syntax-immediate" } "." }
{ $examples "Here is a typical usage of " { $link add-library } ":" { $examples "Here is a typical usage of " { $link add-library } ":"
@ -24,7 +24,7 @@ $nl
" [ drop ]" " [ drop ]"
"} cond >>" "} cond >>"
} }
"Note the parse time evaluation with " { $link POSTPONE: << } "." } ; "Note the parse time evaluation with " { $link postpone: << } "." } ;
HELP: deploy-library HELP: deploy-library
{ $values { "name" string } } { $values { "name" string } }

View File

@ -21,7 +21,7 @@ ERROR: bad-array-type ;
: (parse-c-type) ( string -- type ) : (parse-c-type) ( string -- type )
{ {
{ [ "*" ?tail ] [ (parse-c-type) <pointer> ] } { [ "*" ?tail ] [ (parse-c-type) <pointer> ] }
{ [ CHAR: \] over member? ] [ parse-array-type ] } { [ char: \] over member? ] [ parse-array-type ] }
{ [ dup search ] [ parse-word ] } { [ dup search ] [ parse-word ] }
[ parse-word ] [ parse-word ]
} cond ; } cond ;

View File

@ -15,20 +15,20 @@ HELP: ALIEN:
ARTICLE: "syntax-aliens" "Alien object literal syntax" ARTICLE: "syntax-aliens" "Alien object literal syntax"
{ $subsections { $subsections
POSTPONE: ALIEN: postpone: ALIEN:
POSTPONE: DLL" postpone: DLL"
} ; } ;
HELP: LIBRARY: HELP: LIBRARY:
{ $syntax "LIBRARY: name" } { $syntax "LIBRARY: name" }
{ $values { "name" "a logical library name" } } { $values { "name" "a logical library name" } }
{ $description "Sets the logical library for consequent " { $link POSTPONE: FUNCTION: } ", " { $link POSTPONE: C-GLOBAL: } " and " { $link POSTPONE: CALLBACK: } " definitions, as well as " { $link POSTPONE: &: } " forms." } { $description "Sets the logical library for consequent " { $link postpone: FUNCTION: } ", " { $link postpone: C-GLOBAL: } " and " { $link postpone: CALLBACK: } " definitions, as well as " { $link postpone: &: } " forms." }
{ $notes "Logical library names are defined with the " { $link add-library } " word." } ; { $notes "Logical library names are defined with the " { $link add-library } " word." } ;
HELP: FUNCTION: HELP: FUNCTION:
{ $syntax "FUNCTION: return name ( parameters )" } { $syntax "FUNCTION: return name ( parameters )" }
{ $values { "return" "a C return type" } { "name" "a C function name" } { "parameters" "a comma-separated sequence of type/name pairs; " { $snippet "type1 arg1, type2 arg2, ..." } } } { $values { "return" "a C return type" } { "name" "a C function name" } { "parameters" "a comma-separated sequence of type/name pairs; " { $snippet "type1 arg1, type2 arg2, ..." } } }
{ $description "Defines a new word " { $snippet "name" } " which calls the C library function with the same " { $snippet "name" } " in the logical library given by the most recent " { $link POSTPONE: LIBRARY: } " declaration." { $description "Defines a new word " { $snippet "name" } " which calls the C library function with the same " { $snippet "name" } " in the logical library given by the most recent " { $link postpone: LIBRARY: } " declaration."
$nl $nl
"The new word must be compiled before being executed." } "The new word must be compiled before being executed." }
{ $examples { $examples
@ -45,18 +45,18 @@ $nl
"The answer to the question is 42." "The answer to the question is 42."
} } } }
"Using the " { $link c-string } " type instead of " { $snippet "char*" } " causes the FFI to automatically convert Factor strings to C strings. See " { $link "c-strings" } " for more information on using strings with the FFI." "Using the " { $link c-string } " type instead of " { $snippet "char*" } " causes the FFI to automatically convert Factor strings to C strings. See " { $link "c-strings" } " for more information on using strings with the FFI."
{ $notes "To make a Factor word with a name different from the C function, use " { $link POSTPONE: FUNCTION-ALIAS: } "." } ; { $notes "To make a Factor word with a name different from the C function, use " { $link postpone: FUNCTION-ALIAS: } "." } ;
HELP: FUNCTION-ALIAS: HELP: FUNCTION-ALIAS:
{ $syntax "FUNCTION-ALIAS: factor-name { $syntax "FUNCTION-ALIAS: factor-name
return c_name ( parameters ) ;" } return c_name ( parameters ) ;" }
{ $values { "factor-name" "a Factor word name" } { "return" "a C return type" } { "name" "a C function name" } { "parameters" "a comma-separated sequence of type/name pairs; " { $snippet "type1 arg1, type2 arg2, ..." } } } { $values { "factor-name" "a Factor word name" } { "return" "a C return type" } { "name" "a C function name" } { "parameters" "a comma-separated sequence of type/name pairs; " { $snippet "type1 arg1, type2 arg2, ..." } } }
{ $description "Defines a new word " { $snippet "factor-name" } " which calls the C library function named " { $snippet "c_name" } " in the logical library given by the most recent " { $link POSTPONE: LIBRARY: } " declaration." { $description "Defines a new word " { $snippet "factor-name" } " which calls the C library function named " { $snippet "c_name" } " in the logical library given by the most recent " { $link postpone: LIBRARY: } " declaration."
$nl $nl
"The new word must be compiled before being executed." } "The new word must be compiled before being executed." }
{ $notes "Note that the parentheses and commas are only syntax sugar and can be omitted. They serve no purpose other than to make the declaration easier to read." } ; { $notes "Note that the parentheses and commas are only syntax sugar and can be omitted. They serve no purpose other than to make the declaration easier to read." } ;
{ POSTPONE: FUNCTION: POSTPONE: FUNCTION-ALIAS: } related-words { postpone: FUNCTION: postpone: FUNCTION-ALIAS: } related-words
HELP: TYPEDEF: HELP: TYPEDEF:
{ $syntax "TYPEDEF: old new" } { $syntax "TYPEDEF: old new" }
@ -84,7 +84,7 @@ HELP: ENUM:
HELP: C-TYPE: HELP: C-TYPE:
{ $syntax "C-TYPE: type" } { $syntax "C-TYPE: type" }
{ $values { "type" "a new C type" } } { $values { "type" "a new C type" } }
{ $description "Defines a new, opaque C type. Since it is opaque, " { $snippet "type" } " will not be directly usable as a parameter or return type of a " { $link POSTPONE: FUNCTION: } " or as a slot of a " { $link POSTPONE: STRUCT: } ". However, it can be used as the type of a " { $link pointer } "." $nl { $description "Defines a new, opaque C type. Since it is opaque, " { $snippet "type" } " will not be directly usable as a parameter or return type of a " { $link postpone: FUNCTION: } " or as a slot of a " { $link postpone: STRUCT: } ". However, it can be used as the type of a " { $link pointer } "." $nl
{ $snippet "C-TYPE:" } " can also be used to forward declare C types, allowing circular dependencies to occur between types. For example:" { $snippet "C-TYPE:" } " can also be used to forward declare C types, allowing circular dependencies to occur between types. For example:"
{ $code "C-TYPE: forward { $code "C-TYPE: forward
STRUCT: backward { x forward* } ; STRUCT: backward { x forward* } ;
@ -94,7 +94,7 @@ STRUCT: forward { x backward* } ;" } }
HELP: CALLBACK: HELP: CALLBACK:
{ $syntax "CALLBACK: return type ( parameters )" } { $syntax "CALLBACK: return type ( parameters )" }
{ $values { "return" "a C return type" } { "type" "a type name" } { "parameters" "a comma-separated sequence of type/name pairs; " { $snippet "type1 arg1, type2 arg2, ..." } } } { $values { "return" "a C return type" } { "type" "a type name" } { "parameters" "a comma-separated sequence of type/name pairs; " { $snippet "type1 arg1, type2 arg2, ..." } } }
{ $description "Defines a new function pointer C type word " { $snippet "type" } ". The newly defined word works both as a C type and as a wrapper for " { $link alien-callback } " for callbacks that accept the given return type and parameters. The ABI of the callback is decided from the ABI of the active " { $link POSTPONE: LIBRARY: } " declaration." } { $description "Defines a new function pointer C type word " { $snippet "type" } ". The newly defined word works both as a C type and as a wrapper for " { $link alien-callback } " for callbacks that accept the given return type and parameters. The ABI of the callback is decided from the ABI of the active " { $link postpone: LIBRARY: } " declaration." }
{ $examples { $examples
{ $code { $code
"CALLBACK: bool FakeCallback ( int message, void* payload )" "CALLBACK: bool FakeCallback ( int message, void* payload )"
@ -111,25 +111,25 @@ HELP: CALLBACK:
HELP: &: HELP: &:
{ $syntax "&: symbol" } { $syntax "&: symbol" }
{ $values { "symbol" "A C global variable name" } } { $values { "symbol" "A C global variable name" } }
{ $description "Pushes the address of a symbol named " { $snippet "symbol" } " from the current library, set with " { $link POSTPONE: LIBRARY: } "." } ; { $description "Pushes the address of a symbol named " { $snippet "symbol" } " from the current library, set with " { $link postpone: LIBRARY: } "." } ;
HELP: typedef HELP: typedef
{ $values { "old" "a C type" } { "new" "a C type" } } { $values { "old" "a C type" } { "new" "a C type" } }
{ $description "Aliases the C type " { $snippet "old" } " under the name " { $snippet "new" } "." } { $description "Aliases the C type " { $snippet "old" } " under the name " { $snippet "new" } "." }
{ $notes "Using this word in the same source file which defines C bindings can cause problems, because words are compiled before top-level forms are run. Use the " { $link POSTPONE: TYPEDEF: } " word instead." } ; { $notes "Using this word in the same source file which defines C bindings can cause problems, because words are compiled before top-level forms are run. Use the " { $link postpone: TYPEDEF: } " word instead." } ;
{ POSTPONE: TYPEDEF: typedef } related-words { postpone: TYPEDEF: typedef } related-words
HELP: C-GLOBAL: 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 getter " { $snippet "name" } " and setter " { $snippet "set-name" } " for the global value in the current library, set with " { $link POSTPONE: LIBRARY: } "." } ; { $description "Defines a getter " { $snippet "name" } " and setter " { $snippet "set-name" } " for the global value in the current library, set with " { $link postpone: LIBRARY: } "." } ;
ARTICLE: "alien.enums" "Enumeration types" 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." "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 $nl
"Defining enums:" "Defining enums:"
{ $subsection POSTPONE: ENUM: } { $subsection postpone: ENUM: }
"Defining enums at run-time:" "Defining enums at run-time:"
{ $subsection define-enum } { $subsection define-enum }
"Conversions between enums and integers:" "Conversions between enums and integers:"

View File

@ -1,18 +1,18 @@
USING: ascii kernel math sequences strings tools.test ; USING: ascii kernel math sequences strings tools.test ;
{ t } [ CHAR: a letter? ] unit-test { t } [ char: a letter? ] unit-test
{ f } [ CHAR: A letter? ] unit-test { f } [ char: A letter? ] unit-test
{ f } [ CHAR: a LETTER? ] unit-test { f } [ char: a LETTER? ] unit-test
{ t } [ CHAR: A LETTER? ] unit-test { t } [ char: A LETTER? ] unit-test
{ t } [ CHAR: 0 digit? ] unit-test { t } [ char: 0 digit? ] unit-test
{ f } [ CHAR: x digit? ] unit-test { f } [ char: x digit? ] unit-test
{ 4 } [ { 4 } [
0 "There are Four Upper Case characters" 0 "There are Four Upper Case characters"
[ LETTER? [ 1 + ] when ] each [ LETTER? [ 1 + ] when ] each
] unit-test ] unit-test
{ t f } [ CHAR: \s ascii? 400 ascii? ] unit-test { t f } [ char: \s ascii? 400 ascii? ] unit-test
{ "HELLO HOW ARE YOU?" } [ "hellO hOw arE YOU?" >upper ] unit-test { "HELLO HOW ARE YOU?" } [ "hellO hOw arE YOU?" >upper ] unit-test
{ "i'm good thx bai" } [ "I'm Good THX bai" >lower ] unit-test { "i'm good thx bai" } [ "I'm Good THX bai" >lower ] unit-test

View File

@ -6,10 +6,10 @@ IN: ascii
: ascii? ( ch -- ? ) 0 127 between? ; inline : ascii? ( ch -- ? ) 0 127 between? ; inline
: blank? ( ch -- ? ) " \t\n\r" member? ; inline : blank? ( ch -- ? ) " \t\n\r" member? ; inline
: letter? ( ch -- ? ) CHAR: a CHAR: z between? ; inline : letter? ( ch -- ? ) char: a char: z between? ; inline
: LETTER? ( ch -- ? ) CHAR: A CHAR: Z between? ; inline : LETTER? ( ch -- ? ) char: A char: Z between? ; inline
: digit? ( ch -- ? ) CHAR: 0 CHAR: 9 between? ; inline : digit? ( ch -- ? ) char: 0 char: 9 between? ; inline
: printable? ( ch -- ? ) CHAR: \s CHAR: ~ between? ; inline : printable? ( ch -- ? ) char: \s char: ~ between? ; inline
: control? ( ch -- ? ) { [ 0 0x1F between? ] [ 0x7F = ] } 1|| ; inline : control? ( ch -- ? ) { [ 0 0x1F between? ] [ 0x7F = ] } 1|| ; inline
: quotable? ( ch -- ? ) { [ printable? ] [ "\"\\" member? not ] } 1&& ; inline : quotable? ( ch -- ? ) { [ printable? ] [ "\"\\" member? not ] } 1&& ; inline
: Letter? ( ch -- ? ) { [ letter? ] [ LETTER? ] } 1|| ; inline : Letter? ( ch -- ? ) { [ letter? ] [ LETTER? ] } 1|| ; inline

View File

@ -23,13 +23,13 @@ CONSTANT: alphabet
alphabet nth ; inline alphabet nth ; inline
: base64>ch ( ch -- ch ) : base64>ch ( ch -- ch )
$[ alphabet alphabet-inverse 0 CHAR: = pick set-nth ] nth $[ alphabet alphabet-inverse 0 char: = pick set-nth ] nth
[ malformed-base64 ] unless* ; inline [ malformed-base64 ] unless* ; inline
: (write-lines) ( column byte-array -- column' ) : (write-lines) ( column byte-array -- column' )
output-stream get dup '[ output-stream get dup '[
_ stream-write1 1 + dup 76 = [ _ stream-write1 1 + dup 76 = [
drop B{ CHAR: \r CHAR: \n } _ stream-write 0 drop B{ char: \r char: \n } _ stream-write 0
] when ] when
] each ; inline ] each ; inline
@ -43,7 +43,7 @@ CONSTANT: alphabet
: encode-pad ( seq n -- byte-array ) : encode-pad ( seq n -- byte-array )
[ 3 0 pad-tail encode3 ] [ 1 + ] bi* head-slice [ 3 0 pad-tail encode3 ] [ 1 + ] bi* head-slice
4 CHAR: = pad-tail ; inline 4 char: = pad-tail ; inline
: (encode-base64) ( stream column -- ) : (encode-base64) ( stream column -- )
3 pick stream-read dup length { 3 pick stream-read dup length {
@ -77,14 +77,14 @@ PRIVATE>
: decode4 ( seq -- ) : decode4 ( seq -- )
[ 0 [ base64>ch swap 6 shift bitor ] reduce 3 >be ] [ 0 [ base64>ch swap 6 shift bitor ] reduce 3 >be ]
[ [ CHAR: = = ] count ] bi [ [ char: = = ] count ] bi
[ write ] [ head-slice* write ] if-zero ; inline [ write ] [ head-slice* write ] if-zero ; inline
: (decode-base64) ( stream -- ) : (decode-base64) ( stream -- )
4 "\n\r" pick read-ignoring dup length { 4 "\n\r" pick read-ignoring dup length {
{ 0 [ 2drop ] } { 0 [ 2drop ] }
{ 4 [ decode4 (decode-base64) ] } { 4 [ decode4 (decode-base64) ] }
[ drop 4 CHAR: = pad-tail decode4 (decode-base64) ] [ drop 4 char: = pad-tail decode4 (decode-base64) ]
} case ; } case ;
PRIVATE> PRIVATE>

View File

@ -29,14 +29,14 @@ $nl
bit-array>integer bit-array>integer
} }
"Bit array literal syntax:" "Bit array literal syntax:"
{ $subsections POSTPONE: ?{ } ; { $subsections postpone: ?{ } ;
ABOUT: "bit-arrays" ABOUT: "bit-arrays"
HELP: ?{ HELP: ?{
{ $syntax "?{ elements... }" } { $syntax "?{ elements... }" }
{ $values { "elements" "a list of booleans" } } { $values { "elements" "a list of booleans" } }
{ $description "Marks the beginning of a literal bit array. Literal bit arrays are terminated by " { $link POSTPONE: } } "." } { $description "Marks the beginning of a literal bit array. Literal bit arrays are terminated by " { $link postpone: } } "." }
{ $examples { $code "?{ t f t }" } } ; { $examples { $code "?{ t f t }" } } ;
HELP: bit-array HELP: bit-array

View File

@ -15,7 +15,7 @@ $nl
<bit-vector> <bit-vector>
} }
"Literal syntax:" "Literal syntax:"
{ $subsections POSTPONE: ?V{ } { $subsections postpone: ?V{ }
"If you don't care about initial capacity, a more elegant way to create a new bit vector is to write:" "If you don't care about initial capacity, a more elegant way to create a new bit vector is to write:"
{ $code "?V{ } clone" } ; { $code "?V{ } clone" } ;
@ -35,5 +35,5 @@ HELP: >bit-vector
HELP: ?V{ HELP: ?V{
{ $syntax "?V{ elements... }" } { $syntax "?V{ elements... }" }
{ $values { "elements" "a list of booleans" } } { $values { "elements" "a list of booleans" } }
{ $description "Marks the beginning of a literal bit vector. Literal bit vectors are terminated by " { $link POSTPONE: } } "." } { $description "Marks the beginning of a literal bit vector. Literal bit vectors are terminated by " { $link postpone: } } "." }
{ $examples { $code "?V{ t f t }" } } ; { $examples { $code "?V{ t f t }" } } ;

View File

@ -14,11 +14,11 @@ MACRO: formatted ( spec -- quot )
} cond } cond
] map [ cleave ] curry ; ] map [ cleave ] curry ;
: pad-00 ( n -- str ) number>string 2 CHAR: 0 pad-head ; : pad-00 ( n -- str ) number>string 2 char: 0 pad-head ;
: pad-0000 ( n -- str ) number>string 4 CHAR: 0 pad-head ; : pad-0000 ( n -- str ) number>string 4 char: 0 pad-head ;
: pad-00000 ( n -- str ) number>string 5 CHAR: 0 pad-head ; : pad-00000 ( n -- str ) number>string 5 char: 0 pad-head ;
: write-00 ( n -- ) pad-00 write ; : write-00 ( n -- ) pad-00 write ;

View File

@ -28,16 +28,16 @@ ERROR: invalid-timestamp-format ;
: read-sp ( -- token ) " " read-token ; : read-sp ( -- token ) " " read-token ;
: signed-gmt-offset ( dt ch -- dt' ) : signed-gmt-offset ( dt ch -- dt' )
{ { CHAR: + [ 1 ] } { CHAR: - [ -1 ] } } case time* ; { { char: + [ 1 ] } { char: - [ -1 ] } } case time* ;
: read-rfc3339-gmt-offset ( ch -- dt ) : read-rfc3339-gmt-offset ( ch -- dt )
{ {
{ f [ instant ] } { f [ instant ] }
{ CHAR: Z [ instant ] } { char: Z [ instant ] }
[ [
[ [
read-00 hours read-00 hours
read1 { { CHAR: \: [ read-00 ] } { f [ 0 ] } } case minutes read1 { { char: \: [ read-00 ] } { f [ 0 ] } } case minutes
time+ time+
] dip signed-gmt-offset ] dip signed-gmt-offset
] ]
@ -58,7 +58,7 @@ ERROR: invalid-timestamp-format ;
read-ymd read-ymd
"Tt \t" expect "Tt \t" expect
read-hms read-hms
read1 { { CHAR: . [ read-rfc3339-seconds ] } [ ] } case read1 { { char: . [ read-rfc3339-seconds ] } [ ] } case
read-rfc3339-gmt-offset read-rfc3339-gmt-offset
<timestamp> ; <timestamp> ;
@ -66,7 +66,7 @@ ERROR: invalid-timestamp-format ;
[ (rfc3339>timestamp) ] with-string-reader ; [ (rfc3339>timestamp) ] with-string-reader ;
: parse-rfc822-military-offset ( string -- dt ) : parse-rfc822-military-offset ( string -- dt )
first CHAR: A - { first char: A - {
-1 -2 -3 -4 -5 -6 -7 -8 -9 f -10 -11 -12 -1 -2 -3 -4 -5 -6 -7 -8 -9 f -10 -11 -12
1 2 3 4 5 6 7 8 9 10 11 12 0 1 2 3 4 5 6 7 8 9 10 11 12 0
} nth hours ; } nth hours ;
@ -101,7 +101,7 @@ CONSTANT: rfc822-named-zones H{
: (rfc822>timestamp) ( -- timestamp ) : (rfc822>timestamp) ( -- timestamp )
"," read-token day-abbreviations3 member? check-timestamp drop "," read-token day-abbreviations3 member? check-timestamp drop
read1 CHAR: \s assert= read1 char: \s assert=
read-sp checked-number read-sp checked-number
read-sp month-abbreviations index 1 + check-timestamp read-sp month-abbreviations index 1 + check-timestamp
read-sp checked-number -rot swap read-sp checked-number -rot swap
@ -117,7 +117,7 @@ CONSTANT: rfc822-named-zones H{
: (cookie-string>timestamp-1) ( -- timestamp ) : (cookie-string>timestamp-1) ( -- timestamp )
"," read-token check-day-name "," read-token check-day-name
read1 CHAR: \s assert= read1 char: \s assert=
"-" read-token checked-number "-" read-token checked-number
"-" read-token month-abbreviations index 1 + check-timestamp "-" read-token month-abbreviations index 1 + check-timestamp
read-sp checked-number -rot swap read-sp checked-number -rot swap

View File

@ -1,4 +1,4 @@
USING: checksums checksums.adler-32 strings tools.test ; USING: checksums checksums.adler-32 strings tools.test ;
{ 300286872 } [ "Wikipedia" adler-32 checksum-bytes ] unit-test { 300286872 } [ "Wikipedia" adler-32 checksum-bytes ] unit-test
{ 2679885283 } [ 10000 CHAR: a <string> adler-32 checksum-bytes ] unit-test { 2679885283 } [ 10000 char: a <string> adler-32 checksum-bytes ] unit-test

View File

@ -1,4 +1,4 @@
USING: checksums checksums.bsd strings tools.test ; USING: checksums checksums.bsd strings tools.test ;
{ 15816 } [ "Wikipedia" bsd checksum-bytes ] unit-test { 15816 } [ "Wikipedia" bsd checksum-bytes ] unit-test
{ 47937 } [ 10000 CHAR: a <string> bsd checksum-bytes ] unit-test { 47937 } [ 10000 char: a <string> bsd checksum-bytes ] unit-test

View File

@ -36,5 +36,5 @@ M: crc16 checksum-bytes
M: crc16 checksum-lines M: crc16 checksum-lines
init-crc16 init-crc16
[ [ (crc16) ] each CHAR: \n (crc16) ] each [ [ (crc16) ] each char: \n (crc16) ] each
finish-crc16 ; inline finish-crc16 ; inline

View File

@ -65,7 +65,7 @@ IN: checksums.ripemd.tests
0x69 0x7b 0xdb 0xe1 0x6d 0x69 0x7b 0xdb 0xe1 0x6d
0x37 0xf9 0x7f 0x68 0xf0 0x37 0xf9 0x7f 0x68 0xf0
0x83 0x25 0xdc 0x15 0x28 0x83 0x25 0xdc 0x15 0x28
} } [ 1000000 CHAR: a <string> ripemd-160 checksum-bytes ] unit-test } } [ 1000000 char: a <string> ripemd-160 checksum-bytes ] unit-test

View File

@ -8,7 +8,7 @@ IN: checksums.sha.tests
{ "a9993e364706816aba3e25717850c26c9cd0d89d" } [ "abc" sha1 checksum-bytes bytes>hex-string ] unit-test { "a9993e364706816aba3e25717850c26c9cd0d89d" } [ "abc" sha1 checksum-bytes bytes>hex-string ] unit-test
{ "84983e441c3bd26ebaae4aa1f95129e5e54670f1" } [ "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq" sha1 checksum-bytes bytes>hex-string ] unit-test { "84983e441c3bd26ebaae4aa1f95129e5e54670f1" } [ "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq" sha1 checksum-bytes bytes>hex-string ] unit-test
! [ "34aa973cd4c4daa4f61eeb2bdbad27316534016f" ] [ 1000000 CHAR: a fill string>sha1str ] unit-test ! takes a long time... ! [ "34aa973cd4c4daa4f61eeb2bdbad27316534016f" ] [ 1000000 char: a fill string>sha1str ] unit-test ! takes a long time...
{ "dea356a2cddd90c7a7ecedc5ebb563934f460452" } [ "0123456701234567012345670123456701234567012345670123456701234567" { "dea356a2cddd90c7a7ecedc5ebb563934f460452" } [ "0123456701234567012345670123456701234567012345670123456701234567"
10 swap <array> concat sha1 checksum-bytes bytes>hex-string ] unit-test 10 swap <array> concat sha1 checksum-bytes bytes>hex-string ] unit-test

View File

@ -7,10 +7,10 @@ IN: circular.tests
{ 0 } [ { 0 1 2 3 4 } <circular> 0 swap virtual@ drop ] unit-test { 0 } [ { 0 1 2 3 4 } <circular> 0 swap virtual@ drop ] unit-test
{ 2 } [ { 0 1 2 3 4 } <circular> 2 swap virtual@ drop ] unit-test { 2 } [ { 0 1 2 3 4 } <circular> 2 swap virtual@ drop ] unit-test
{ CHAR: t } [ "test" <circular> 0 swap nth ] unit-test { char: t } [ "test" <circular> 0 swap nth ] unit-test
{ "test" } [ "test" <circular> >string ] unit-test { "test" } [ "test" <circular> >string ] unit-test
{ CHAR: e } [ "test" <circular> 5 swap nth-unsafe ] unit-test { char: e } [ "test" <circular> 5 swap nth-unsafe ] unit-test
{ [ 1 2 3 ] } [ { 1 2 3 } <circular> [ ] like ] unit-test { [ 1 2 3 ] } [ { 1 2 3 } <circular> [ ] like ] unit-test
{ [ 2 3 1 ] } [ { 1 2 3 } <circular> [ rotate-circular ] keep [ ] like ] unit-test { [ 2 3 1 ] } [ { 1 2 3 } <circular> [ rotate-circular ] keep [ ] like ] unit-test
@ -19,9 +19,9 @@ IN: circular.tests
{ [ 3 1 2 ] } [ { 1 2 3 } <circular> 1 over change-circular-start 1 over change-circular-start [ ] like ] unit-test { [ 3 1 2 ] } [ { 1 2 3 } <circular> 1 over change-circular-start 1 over change-circular-start [ ] like ] unit-test
{ [ 3 1 2 ] } [ { 1 2 3 } <circular> -100 over change-circular-start [ ] like ] unit-test { [ 3 1 2 ] } [ { 1 2 3 } <circular> -100 over change-circular-start [ ] like ] unit-test
{ "fob" } [ "foo" <circular> CHAR: b 2 pick set-nth >string ] unit-test { "fob" } [ "foo" <circular> char: b 2 pick set-nth >string ] unit-test
{ "boo" } [ "foo" <circular> CHAR: b 3 pick set-nth-unsafe >string ] unit-test { "boo" } [ "foo" <circular> char: b 3 pick set-nth-unsafe >string ] unit-test
{ "ornact" } [ "factor" <circular> 4 over change-circular-start CHAR: n 2 pick set-nth >string ] unit-test { "ornact" } [ "factor" <circular> 4 over change-circular-start char: n 2 pick set-nth >string ] unit-test
{ "bcd" } [ 3 <circular-string> "abcd" [ over circular-push ] each >string ] unit-test { "bcd" } [ 3 <circular-string> "abcd" [ over circular-push ] each >string ] unit-test
@ -29,7 +29,7 @@ IN: circular.tests
! This no longer fails ! This no longer fails
! [ "test" <circular> 5 swap nth ] must-fail ! [ "test" <circular> 5 swap nth ] must-fail
! [ "foo" <circular> CHAR: b 3 rot set-nth ] must-fail ! [ "foo" <circular> char: b 3 rot set-nth ] must-fail
{ { } } [ 3 <growing-circular> >array ] unit-test { { } } [ 3 <growing-circular> >array ] unit-test
{ { 1 2 } } [ { { 1 2 } } [

View File

@ -31,7 +31,7 @@ HELP: <struct>
HELP: STRUCT: HELP: STRUCT:
{ $syntax "STRUCT: class { slot type } { slot type } ... ;" } { $syntax "STRUCT: class { slot type } { slot type } ... ;" }
{ $values { "class" "a new " { $link struct } " class to define" } { "slots" "a list of slot specifiers" } } { $values { "class" "a new " { $link struct } " class to define" } { "slots" "a list of slot specifiers" } }
{ $description "Defines a new " { $link struct } " type. The syntax is nearly identical to " { $link POSTPONE: TUPLE: } "; however, there are some additional restrictions on struct types:" { $description "Defines a new " { $link struct } " type. The syntax is nearly identical to " { $link postpone: TUPLE: } "; however, there are some additional restrictions on struct types:"
{ $list { $list
{ "Struct classes cannot have a superclass defined." } { "Struct classes cannot have a superclass defined." }
{ "The slots of a struct must all have a type declared. The type must be a C type." } { "The slots of a struct must all have a type declared. The type must be a C type." }
@ -42,42 +42,42 @@ HELP: STRUCT:
HELP: S{ HELP: S{
{ $syntax "S{ class slots... }" } { $syntax "S{ class slots... }" }
{ $values { "class" "a " { $link struct } " class word" } { "slots" "slot values" } } { $values { "class" "a " { $link struct } " class word" } { "slots" "slot values" } }
{ $description "Marks the beginning of a literal struct. The syntax is identical to tuple literal syntax with " { $link POSTPONE: T{ } { $snippet " }" } "; either the assoc syntax (that is, " { $snippet "S{ class { slot value } { slot value } ... }" } ") or the simple syntax (" { $snippet "S{ class f value value ... }" } ") can be used." } ; { $description "Marks the beginning of a literal struct. The syntax is identical to tuple literal syntax with " { $link postpone: T{ } { $snippet " }" } "; either the assoc syntax (that is, " { $snippet "S{ class { slot value } { slot value } ... }" } ") or the simple syntax (" { $snippet "S{ class f value value ... }" } ") can be used." } ;
HELP: S@ HELP: S@
{ $syntax "S@ class alien" } { $syntax "S@ class alien" }
{ $values { "class" "a " { $link struct } " class word" } { "alien" "a literal alien" } } { $values { "class" "a " { $link struct } " class word" } { "alien" "a literal alien" } }
{ $description "Marks the beginning of a literal struct at a specific C address. The prettyprinter uses this syntax when the memory backing a struct object is invalid. This syntax should not generally be used in source code." } ; { $description "Marks the beginning of a literal struct at a specific C address. The prettyprinter uses this syntax when the memory backing a struct object is invalid. This syntax should not generally be used in source code." } ;
{ POSTPONE: S{ POSTPONE: S@ } related-words { postpone: S{ postpone: S@ } related-words
HELP: UNION-STRUCT: HELP: UNION-STRUCT:
{ $syntax "UNION-STRUCT: class { slot type } { slot type } ... ;" } { $syntax "UNION-STRUCT: class { slot type } { slot type } ... ;" }
{ $values { "class" "a new " { $link struct } " class to define" } { "slots" "a list of slot specifiers" } } { $values { "class" "a new " { $link struct } " class to define" } { "slots" "a list of slot specifiers" } }
{ $description "Defines a new " { $link struct } " type where all of the slots share the same storage. See " { $link POSTPONE: STRUCT: } " for details on the syntax." } ; { $description "Defines a new " { $link struct } " type where all of the slots share the same storage. See " { $link postpone: STRUCT: } " for details on the syntax." } ;
HELP: PACKED-STRUCT: HELP: PACKED-STRUCT:
{ $syntax "PACKED-STRUCT: class { slot type } { slot type } ... ;" } { $syntax "PACKED-STRUCT: class { slot type } { slot type } ... ;" }
{ $values { "class" "a new " { $link struct } " class to define" } { "slots" "a list of slot specifiers" } } { $values { "class" "a new " { $link struct } " class to define" } { "slots" "a list of slot specifiers" } }
{ $description "Defines a new " { $link struct } " type with no alignment padding between slots or at the end. In all other respects, behaves like " { $link POSTPONE: STRUCT: } "." } ; { $description "Defines a new " { $link struct } " type with no alignment padding between slots or at the end. In all other respects, behaves like " { $link postpone: STRUCT: } "." } ;
HELP: define-struct-class HELP: define-struct-class
{ $values { $values
{ "class" class } { "slots" "a sequence of " { $link struct-slot-spec } "s" } { "class" class } { "slots" "a sequence of " { $link struct-slot-spec } "s" }
} }
{ $description "Defines a new " { $link struct } " class. This is the runtime equivalent of the " { $link POSTPONE: STRUCT: } " syntax." } ; { $description "Defines a new " { $link struct } " class. This is the runtime equivalent of the " { $link postpone: STRUCT: } " syntax." } ;
HELP: define-packed-struct-class HELP: define-packed-struct-class
{ $values { $values
{ "class" class } { "slots" "a sequence of " { $link struct-slot-spec } "s" } { "class" class } { "slots" "a sequence of " { $link struct-slot-spec } "s" }
} }
{ $description "Defines a new " { $link struct } " class. This is the runtime equivalent of the " { $link POSTPONE: PACKED-STRUCT: } " syntax." } ; { $description "Defines a new " { $link struct } " class. This is the runtime equivalent of the " { $link postpone: PACKED-STRUCT: } " syntax." } ;
HELP: define-union-struct-class HELP: define-union-struct-class
{ $values { $values
{ "class" class } { "slots" "a sequence of " { $link struct-slot-spec } "s" } { "class" class } { "slots" "a sequence of " { $link struct-slot-spec } "s" }
} }
{ $description "Defines a new " { $link struct } " class where all of the slots share the same storage. This is the runtime equivalent of the " { $link POSTPONE: UNION-STRUCT: } " syntax." } ; { $description "Defines a new " { $link struct } " class where all of the slots share the same storage. This is the runtime equivalent of the " { $link postpone: UNION-STRUCT: } " syntax." } ;
HELP: malloc-struct HELP: malloc-struct
{ $values { $values
@ -111,7 +111,7 @@ HELP: read-struct
HELP: struct HELP: struct
{ $class-description "The parent class of all struct types." } ; { $class-description "The parent class of all struct types." } ;
{ struct POSTPONE: STRUCT: POSTPONE: UNION-STRUCT: } related-words { struct postpone: STRUCT: postpone: UNION-STRUCT: } related-words
HELP: struct-class HELP: struct-class
{ $class-description "The metaclass of all " { $link struct } " classes." } ; { $class-description "The metaclass of all " { $link struct } " classes." } ;
@ -145,10 +145,10 @@ ARTICLE: "classes.struct.examples" "Struct class examples"
} ; } ;
ARTICLE: "classes.struct.define" "Defining struct classes" ARTICLE: "classes.struct.define" "Defining struct classes"
"Struct classes are defined using a syntax similar to the " { $link POSTPONE: TUPLE: } " syntax for defining tuple classes:" "Struct classes are defined using a syntax similar to the " { $link postpone: TUPLE: } " syntax for defining tuple classes:"
{ $subsections POSTPONE: STRUCT: POSTPONE: PACKED-STRUCT: } { $subsections postpone: STRUCT: postpone: PACKED-STRUCT: }
"Union structs are also supported, which behave like structs but share the same memory for all the slots." "Union structs are also supported, which behave like structs but share the same memory for all the slots."
{ $subsections POSTPONE: UNION-STRUCT: } ; { $subsections postpone: UNION-STRUCT: } ;
ARTICLE: "classes.struct.create" "Creating instances of structs" ARTICLE: "classes.struct.create" "Creating instances of structs"
"Structs can be allocated with " { $link new } "- and " { $link boa } "-like constructor words. Additional words are provided for building structs from C memory and from existing buffers:" "Structs can be allocated with " { $link new } "- and " { $link boa } "-like constructor words. Additional words are provided for building structs from C memory and from existing buffers:"
@ -163,8 +163,8 @@ ARTICLE: "classes.struct.create" "Creating instances of structs"
(struct) (struct)
(malloc-struct) (malloc-struct)
} }
"Structs have literal syntax, similar to " { $link POSTPONE: T{ } " for tuples:" "Structs have literal syntax, similar to " { $link postpone: T{ } " for tuples:"
{ $subsections POSTPONE: S{ } ; { $subsections postpone: S{ } ;
ARTICLE: "classes.struct.c" "Passing structs to C functions" ARTICLE: "classes.struct.c" "Passing structs to C functions"
"Structs can be passed and returned by value, or by reference." "Structs can be passed and returned by value, or by reference."

View File

@ -132,7 +132,7 @@ STRUCT: struct-test-bar
[ make-mirror clear-assoc ] keep [ make-mirror clear-assoc ] keep
] unit-test ] unit-test
{ POSTPONE: STRUCT: } { postpone: STRUCT: }
[ struct-test-foo struct-definer-word ] unit-test [ struct-test-foo struct-definer-word ] unit-test
UNION-STRUCT: struct-test-float-and-bits UNION-STRUCT: struct-test-float-and-bits
@ -144,7 +144,7 @@ UNION-STRUCT: struct-test-float-and-bits
{ 123 } [ [ struct-test-foo malloc-struct &free y>> ] with-destructors ] unit-test { 123 } [ [ struct-test-foo malloc-struct &free y>> ] with-destructors ] unit-test
{ POSTPONE: UNION-STRUCT: } { postpone: UNION-STRUCT: }
[ struct-test-float-and-bits struct-definer-word ] unit-test [ struct-test-float-and-bits struct-definer-word ] unit-test
STRUCT: struct-test-string-ptr STRUCT: struct-test-string-ptr
@ -491,7 +491,7 @@ PACKED-STRUCT: packed-struct-test
{ 10 } [ "g" packed-struct-test offset-of ] unit-test { 10 } [ "g" packed-struct-test offset-of ] unit-test
{ 11 } [ "h" packed-struct-test offset-of ] unit-test { 11 } [ "h" packed-struct-test offset-of ] unit-test
{ POSTPONE: PACKED-STRUCT: } { postpone: PACKED-STRUCT: }
[ packed-struct-test struct-definer-word ] unit-test [ packed-struct-test struct-definer-word ] unit-test
STRUCT: struct-1 { a c:int } ; STRUCT: struct-1 { a c:int } ;

View File

@ -14,7 +14,7 @@ HELP: SUPER->
{ $description "A sugared form of the following:" } { $description "A sugared form of the following:" }
{ $code "\"selector\" send-super" } ; { $code "\"selector\" send-super" } ;
{ send super-send POSTPONE: -> POSTPONE: SUPER-> } related-words { send super-send postpone: -> postpone: SUPER-> } related-words
HELP: IMPORT: HELP: IMPORT:
{ $syntax "IMPORT: name" } { $syntax "IMPORT: name" }
@ -25,13 +25,13 @@ HELP: IMPORT:
ARTICLE: "objc-calling" "Calling Objective C code" ARTICLE: "objc-calling" "Calling Objective C code"
"Before an Objective C class can be used, it must be imported; by default, a small set of common classes are imported automatically, but additional classes can be imported as needed." "Before an Objective C class can be used, it must be imported; by default, a small set of common classes are imported automatically, but additional classes can be imported as needed."
{ $subsections POSTPONE: IMPORT: } { $subsections postpone: IMPORT: }
"Every imported Objective C class has as corresponding class word in the " { $vocab-link "cocoa.classes" } " vocabulary. Class words push the class object in the stack, allowing class methods to be invoked." "Every imported Objective C class has as corresponding class word in the " { $vocab-link "cocoa.classes" } " vocabulary. Class words push the class object in the stack, allowing class methods to be invoked."
$nl $nl
"Messages can be sent to classes and instances using a pair of parsing words:" "Messages can be sent to classes and instances using a pair of parsing words:"
{ $subsections { $subsections
POSTPONE: -> postpone: ->
POSTPONE: SUPER-> postpone: SUPER->
} }
"These parsing words are actually syntax sugar for a pair of ordinary words; they can be used instead of the parsing words if the selector name is dynamically computed:" "These parsing words are actually syntax sugar for a pair of ordinary words; they can be used instead of the parsing words if the selector name is dynamically computed:"
{ $subsections { $subsections

View File

@ -197,7 +197,7 @@ cell {
assoc-union alien>objc-types set-global assoc-union alien>objc-types set-global
: objc-struct-type ( i string -- ctype ) : objc-struct-type ( i string -- ctype )
[ CHAR: = ] 2keep index-from swap subseq [ char: = ] 2keep index-from swap subseq
objc>struct-types get at* [ drop void* ] unless ; objc>struct-types get at* [ drop void* ] unless ;
ERROR: no-objc-type name ; ERROR: no-objc-type name ;
@ -209,9 +209,9 @@ ERROR: no-objc-type name ;
: (parse-objc-type) ( i string -- ctype ) : (parse-objc-type) ( i string -- ctype )
[ [ 1 + ] dip ] [ nth ] 2bi { [ [ 1 + ] dip ] [ nth ] 2bi {
{ [ dup "rnNoORV" member? ] [ drop (parse-objc-type) ] } { [ dup "rnNoORV" member? ] [ drop (parse-objc-type) ] }
{ [ dup CHAR: ^ = ] [ 3drop void* ] } { [ dup char: ^ = ] [ 3drop void* ] }
{ [ dup CHAR: \{ = ] [ drop objc-struct-type ] } { [ dup char: \{ = ] [ drop objc-struct-type ] }
{ [ dup CHAR: \[ = ] [ 3drop void* ] } { [ dup char: \[ = ] [ 3drop void* ] }
[ 2nip decode-type ] [ 2nip decode-type ]
} cond ; } cond ;

View File

@ -3,21 +3,21 @@ IN: cocoa.subclassing
HELP: <CLASS: HELP: <CLASS:
{ $syntax "<CLASS: name < superclass protocols... imeth... ;CLASS>" } { $syntax "<CLASS: name < superclass protocols... imeth... ;CLASS>" }
{ $values { "name" "a new class name" } { "superclass" "a superclass name" } { "protocols" "zero or more protocol names" } { "imeth" "instance method definitions using " { $link POSTPONE: METHOD: } } } { $values { "name" "a new class name" } { "superclass" "a superclass name" } { "protocols" "zero or more protocol names" } { "imeth" "instance method definitions using " { $link postpone: METHOD: } } }
{ $description "Defines a new Objective C class. Instance methods are defined with the " { $link POSTPONE: METHOD: } " parsing word." { $description "Defines a new Objective C class. Instance methods are defined with the " { $link postpone: METHOD: } " parsing word."
$nl $nl
"This word is preferred to calling " { $link define-objc-class } ", because it creates a class word in the " { $vocab-link "cocoa.classes" } " vocabulary at parse time, allowing code to refer to the class word in the same source file where the class is defined." } ; "This word is preferred to calling " { $link define-objc-class } ", because it creates a class word in the " { $vocab-link "cocoa.classes" } " vocabulary at parse time, allowing code to refer to the class word in the same source file where the class is defined." } ;
{ define-objc-class POSTPONE: <CLASS: POSTPONE: METHOD: } related-words { define-objc-class postpone: <CLASS: postpone: METHOD: } related-words
HELP: METHOD: HELP: METHOD:
{ $syntax "METHOD: return foo: type1 arg1 bar: type2 arg2 baz: ... [ body ] ;" } { $syntax "METHOD: return foo: type1 arg1 bar: type2 arg2 baz: ... [ body ] ;" }
{ $values { "return" "a C type name" } { "type1" "a C type name" } { "arg1" "a local variable name" } { "body" "arbitrary code" } } { $values { "return" "a C type name" } { "type1" "a C type name" } { "arg1" "a local variable name" } { "body" "arbitrary code" } }
{ $description "Defines a method inside of a " { $link POSTPONE: <CLASS: } " form." } ; { $description "Defines a method inside of a " { $link postpone: <CLASS: } " form." } ;
ARTICLE: "objc-subclassing" "Subclassing Objective C classes" ARTICLE: "objc-subclassing" "Subclassing Objective C classes"
"Objective C classes can be subclassed, with new methods defined in Factor, using parsing words:" "Objective C classes can be subclassed, with new methods defined in Factor, using parsing words:"
{ $subsections POSTPONE: <CLASS: POSTPONE: METHOD: } { $subsections postpone: <CLASS: postpone: METHOD: }
"Objective C class definitions are saved in the image. If the image is saved and Factor is restarted with the saved image, custom class definitions are made available to the Objective C runtime when they are first accessed from within Factor." ; "Objective C class definitions are saved in the image. If the image is saved and Factor is restarted with the saved image, custom class definitions are made available to the Objective C runtime when they are first accessed from within Factor." ;
ABOUT: "objc-subclassing" ABOUT: "objc-subclassing"

View File

@ -4,21 +4,21 @@ USING: help.markup help.syntax strings colors ;
HELP: named-color HELP: named-color
{ $values { "name" string } { "color" color } } { $values { "name" string } { "color" color } }
{ $description "Outputs a named color from the color database." } { $description "Outputs a named color from the color database." }
{ $notes "In most cases, " { $link POSTPONE: COLOR: } " should be used instead." } { $notes "In most cases, " { $link postpone: color: } " should be used instead." }
{ $errors "Throws an error if the color is not listed in " { $snippet "rgb.txt" } ", " { $snippet "factor-colors.txt" } " or " { $snippet "solarized-colors.txt" } "." } ; { $errors "Throws an error if the color is not listed in " { $snippet "rgb.txt" } ", " { $snippet "factor-colors.txt" } " or " { $snippet "solarized-colors.txt" } "." } ;
HELP: named-colors HELP: named-colors
{ $values { "keys" "a sequence of strings" } } { $values { "keys" "a sequence of strings" } }
{ $description "Outputs a sequence of all colors in the " { $snippet "rgb.txt" } " database." } ; { $description "Outputs a sequence of all colors in the " { $snippet "rgb.txt" } " database." } ;
HELP: COLOR: HELP: color:
{ $syntax "COLOR: name" } { $syntax "color: name" }
{ $description "Parses as a " { $link color } " object with the given name." } { $description "Parses as a " { $link color } " object with the given name." }
{ $errors "Throws an error if the color is not listed in " { $snippet "rgb.txt" } "." } { $errors "Throws an error if the color is not listed in " { $snippet "rgb.txt" } "." }
{ $examples { $examples
{ $code { $code
"USING: colors.constants io.styles ;" "USING: colors.constants io.styles ;"
"\"Hello!\" { { foreground COLOR: cyan } } format nl" "\"Hello!\" { { foreground color: cyan } } format nl"
} }
} ; } ;
@ -27,7 +27,7 @@ ARTICLE: "colors.constants" "Standard color database"
{ $subsections { $subsections
named-color named-color
named-colors named-colors
POSTPONE: COLOR: postpone: color:
} ; } ;
ABOUT: "colors.constants" ABOUT: "colors.constants"

View File

@ -2,4 +2,4 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: colors colors.constants tools.test ; USING: colors colors.constants tools.test ;
{ t } [ COLOR: light-green rgba? ] unit-test { t } [ color: light-green rgba? ] unit-test

View File

@ -9,7 +9,7 @@ IN: colors.constants
: parse-color ( line -- name color ) : parse-color ( line -- name color )
first4 first4
[ [ string>number 255 /f ] tri@ 1.0 <rgba> ] dip [ [ string>number 255 /f ] tri@ 1.0 <rgba> ] dip
[ blank? ] trim-head H{ { CHAR: \s CHAR: - } } substitute swap ; [ blank? ] trim-head H{ { char: \s char: - } } substitute swap ;
: parse-colors ( lines -- assoc ) : parse-colors ( lines -- assoc )
[ "!" head? ] reject [ "!" head? ] reject
@ -31,4 +31,4 @@ ERROR: no-such-color name ;
: named-color ( name -- color ) : named-color ( name -- color )
dup colors at [ ] [ no-such-color ] ?if ; dup colors at [ ] [ no-such-color ] ?if ;
SYNTAX: COLOR: scan-token named-color suffix! ; SYNTAX: color: scan-token named-color suffix! ;

View File

@ -15,13 +15,13 @@ HELP: rgba>hex
{ $description "Converts a " { $link color } " into a hexadecimal string value." } { $description "Converts a " { $link color } " into a hexadecimal string value." }
; ;
HELP: HEXCOLOR: HELP: hexcolor:
{ $syntax "HEXCOLOR: value" } { $syntax "hexcolor: value" }
{ $description "Parses as a " { $link color } " object with the given hexadecimal value." } { $description "Parses as a " { $link color } " object with the given hexadecimal value." }
{ $examples { $examples
{ $code { $code
"USING: colors.hex io.styles ;" "USING: colors.hex io.styles ;"
"\"Hello!\" { { foreground HEXCOLOR: 336699 } } format nl" "\"Hello!\" { { foreground hexcolor: 336699 } } format nl"
} }
} ; } ;
@ -31,7 +31,7 @@ ARTICLE: "colors.hex" "HEX colors"
{ $subsections { $subsections
hex>rgba hex>rgba
rgba>hex rgba>hex
POSTPONE: HEXCOLOR: postpone: hexcolor:
} }
{ $see-also "colors" } ; { $see-also "colors" } ;

View File

@ -2,18 +2,18 @@
! See http://factorcode.org/license.txt for BSD license ! See http://factorcode.org/license.txt for BSD license
USING: colors colors.hex tools.test ; USING: colors colors.hex tools.test ;
{ HEXCOLOR: 000000 } [ 0.0 0.0 0.0 1.0 <rgba> ] unit-test { hexcolor: 000000 } [ 0.0 0.0 0.0 1.0 <rgba> ] unit-test
{ HEXCOLOR: FFFFFF } [ 1.0 1.0 1.0 1.0 <rgba> ] unit-test { hexcolor: FFFFFF } [ 1.0 1.0 1.0 1.0 <rgba> ] unit-test
{ HEXCOLOR: abcdef } [ "abcdef" hex>rgba ] unit-test { hexcolor: abcdef } [ "abcdef" hex>rgba ] unit-test
{ HEXCOLOR: abcdef } [ "ABCDEF" hex>rgba ] unit-test { hexcolor: abcdef } [ "ABCDEF" hex>rgba ] unit-test
{ "ABCDEF" } [ HEXCOLOR: abcdef rgba>hex ] unit-test { "ABCDEF" } [ hexcolor: abcdef rgba>hex ] unit-test
{ HEXCOLOR: 00000000 } [ 0.0 0.0 0.0 0.0 <rgba> ] unit-test { hexcolor: 00000000 } [ 0.0 0.0 0.0 0.0 <rgba> ] unit-test
{ HEXCOLOR: FF000000 } [ 1.0 0.0 0.0 0.0 <rgba> ] unit-test { hexcolor: FF000000 } [ 1.0 0.0 0.0 0.0 <rgba> ] unit-test
{ HEXCOLOR: FFFF0000 } [ 1.0 1.0 0.0 0.0 <rgba> ] unit-test { hexcolor: FFFF0000 } [ 1.0 1.0 0.0 0.0 <rgba> ] unit-test
{ HEXCOLOR: FFFFFF00 } [ 1.0 1.0 1.0 0.0 <rgba> ] unit-test { hexcolor: FFFFFF00 } [ 1.0 1.0 1.0 0.0 <rgba> ] unit-test
{ HEXCOLOR: FFFFFFFF } [ 1.0 1.0 1.0 1.0 <rgba> ] unit-test { hexcolor: FFFFFFFF } [ 1.0 1.0 1.0 1.0 <rgba> ] unit-test
{ HEXCOLOR: cafebabe } [ "cafebabe" hex>rgba ] unit-test { hexcolor: cafebabe } [ "cafebabe" hex>rgba ] unit-test
{ HEXCOLOR: 112233 } [ "123" hex>rgba ] unit-test { hexcolor: 112233 } [ "123" hex>rgba ] unit-test
{ HEXCOLOR: 11223344 } [ "1234" hex>rgba ] unit-test { hexcolor: 11223344 } [ "1234" hex>rgba ] unit-test

View File

@ -18,4 +18,4 @@ IN: colors.hex
[ red>> ] [ green>> ] [ blue>> ] tri [ red>> ] [ green>> ] [ blue>> ] tri
[ 255 * >integer ] tri@ "%02X%02X%02X" sprintf ; [ 255 * >integer ] tri@ "%02X%02X%02X" sprintf ;
SYNTAX: HEXCOLOR: scan-token hex>rgba suffix! ; SYNTAX: hexcolor: scan-token hex>rgba suffix! ;

View File

@ -1,13 +1,13 @@
USING: colors.constants colors.mix kernel tools.test ; USING: colors.constants colors.mix kernel tools.test ;
{ COLOR: blue } [ COLOR: blue COLOR: red 0.0 linear-gradient ] unit-test { color: blue } [ color: blue color: red 0.0 linear-gradient ] unit-test
{ COLOR: red } [ COLOR: blue COLOR: red 1.0 linear-gradient ] unit-test { color: red } [ color: blue color: red 1.0 linear-gradient ] unit-test
{ COLOR: blue } [ { COLOR: blue COLOR: red COLOR: green } 0.0 sample-linear-gradient ] unit-test { color: blue } [ { color: blue color: red color: green } 0.0 sample-linear-gradient ] unit-test
{ COLOR: red } [ { COLOR: blue COLOR: red COLOR: green } 0.5 sample-linear-gradient ] unit-test { color: red } [ { color: blue color: red color: green } 0.5 sample-linear-gradient ] unit-test
{ COLOR: green } [ { COLOR: blue COLOR: red COLOR: green } 1.0 sample-linear-gradient ] unit-test { color: green } [ { color: blue color: red color: green } 1.0 sample-linear-gradient ] unit-test
{ t } [ { t } [
{ COLOR: blue COLOR: red } 0.5 sample-linear-gradient { color: blue color: red } 0.5 sample-linear-gradient
COLOR: blue COLOR: red 0.5 linear-gradient = color: blue color: red 0.5 linear-gradient =
] unit-test ] unit-test

View File

@ -92,7 +92,7 @@ ARTICLE: "standard-cli-args" "Command line switches for general usage"
"The following command line switches can be passed to a bootstrapped Factor image:" "The following command line switches can be passed to a bootstrapped Factor image:"
{ $table { $table
{ { $snippet "-e=" { $emphasis "code" } } { "This specifies a code snippet to evaluate and then exit Factor." } } { { $snippet "-e=" { $emphasis "code" } } { "This specifies a code snippet to evaluate and then exit Factor." } }
{ { $snippet "-run=" { $emphasis "vocab" } } { { $snippet { $emphasis "vocab" } } " is the name of a vocabulary with a " { $link POSTPONE: MAIN: } " hook to run on startup, for example " { $vocab-link "listener" } " or " { $vocab-link "ui.tools" } "." } } { { $snippet "-run=" { $emphasis "vocab" } } { { $snippet { $emphasis "vocab" } } " is the name of a vocabulary with a " { $link postpone: MAIN: } " hook to run on startup, for example " { $vocab-link "listener" } " or " { $vocab-link "ui.tools" } "." } }
{ { $snippet "-no-user-init" } { "Inhibits the running of user initialization files on startup. See " { $link "rc-files" } "." } } { { $snippet "-no-user-init" } { "Inhibits the running of user initialization files on startup. See " { $link "rc-files" } "." } }
} ; } ;
@ -141,7 +141,7 @@ ARTICLE: "command-line" "Command line arguments"
{ $code "factor [VM args...] [script] [args...]" } { $code "factor [VM args...] [script] [args...]" }
"Zero or more VM arguments can be passed in, followed by an optional script file name. If the script file is specified, it will be run on startup using " { $link run-script } ". Any arguments after the script file are stored in the following variable, with no further processing by Factor itself:" "Zero or more VM arguments can be passed in, followed by an optional script file name. If the script file is specified, it will be run on startup using " { $link run-script } ". Any arguments after the script file are stored in the following variable, with no further processing by Factor itself:"
{ $subsections command-line } { $subsections command-line }
"Instead of running a script, it is also possible to run a vocabulary; this invokes the vocabulary's " { $link POSTPONE: MAIN: } " word:" "Instead of running a script, it is also possible to run a vocabulary; this invokes the vocabulary's " { $link postpone: MAIN: } " word:"
{ $code "factor [system switches...] -run=<vocab name>" } { $code "factor [system switches...] -run=<vocab name>" }
"If no script file or " { $snippet "-run=" } " switch is specified, Factor will start " { $link "listener" } " or " { $link "ui-tools" } ", depending on the operating system." "If no script file or " { $snippet "-run=" } " switch is specified, Factor will start " { $link "listener" } " or " { $link "ui-tools" } ", depending on the operating system."
$nl $nl
@ -165,7 +165,7 @@ $nl
HELP: run-script HELP: run-script
{ $values { "file" "a pathname string" } } { $values { "file" "a pathname string" } }
{ $description "Parses the Factor source code stored in a file and runs it. The initial vocabulary search path is used. If the source file contains a " { $link POSTPONE: MAIN: } " declaration, the main entry point of the file will be also be executed. Loading messages will be suppressed." } { $description "Parses the Factor source code stored in a file and runs it. The initial vocabulary search path is used. If the source file contains a " { $link postpone: MAIN: } " declaration, the main entry point of the file will be also be executed. Loading messages will be suppressed." }
{ $errors "Throws an error if loading the file fails, there input is malformed, or if a runtime error occurs while calling the parsed quotation or executing the main entry point." } ; { $errors "Throws an error if loading the file fails, there input is malformed, or if a runtime error occurs while calling the parsed quotation or executing the main entry point." } ;
ABOUT: "command-line" ABOUT: "command-line"

View File

@ -130,7 +130,7 @@ IN: compiler.cfg.builder.tests
{ {
byte-array byte-array
alien alien
POSTPONE: f postpone: f
} [| class | } [| class |
{ {
alien-signed-1 alien-signed-1

View File

@ -14,8 +14,8 @@ IN: compiler.cfg.linear-scan.debugger
allocate-registers drop ; allocate-registers drop ;
: picture ( uses -- str ) : picture ( uses -- str )
dup last 1 + CHAR: space <string> dup last 1 + char: space <string>
[ '[ CHAR: * swap _ set-nth ] each ] keep ; [ '[ char: * swap _ set-nth ] each ] keep ;
: interval-picture ( interval -- str ) : interval-picture ( interval -- str )
[ uses>> picture ] [ uses>> picture ]

View File

@ -44,7 +44,7 @@ $nl
} }
"The optimizing compiler also trades off compile time for performance of generated code, so loading certain vocabularies might take a while. Saving the image after loading vocabularies can save you a lot of time that you would spend waiting for the same code to load in every coding session; see " { $link "images" } " for information." "The optimizing compiler also trades off compile time for performance of generated code, so loading certain vocabularies might take a while. Saving the image after loading vocabularies can save you a lot of time that you would spend waiting for the same code to load in every coding session; see " { $link "images" } " for information."
$nl $nl
"Most code you write will run with the optimizing compiler. Sometimes, the non-optimizing compiler is used, for example for listener interactions, or for running the quotation passed to " { $link POSTPONE: call( } "." "Most code you write will run with the optimizing compiler. Sometimes, the non-optimizing compiler is used, for example for listener interactions, or for running the quotation passed to " { $link postpone: call( } "."
{ $subsections { $subsections
"compiler-errors" "compiler-errors"
"hints" "hints"

View File

@ -42,12 +42,12 @@ IN: compiler.tests.intrinsics
! Write barrier hits on the wrong value were causing segfaults ! Write barrier hits on the wrong value were causing segfaults
[ -3 ] [ -3 1 2 [ 2array [ 3 set-slot ] keep ] compile-call second ] unit-test [ -3 ] [ -3 1 2 [ 2array [ 3 set-slot ] keep ] compile-call second ] unit-test
[ CHAR: a ] [ 0 "abc" [ string-nth ] compile-call ] unit-test [ char: a ] [ 0 "abc" [ string-nth ] compile-call ] unit-test
[ CHAR: a ] [ 0 [ "abc" string-nth ] compile-call ] unit-test [ char: a ] [ 0 [ "abc" string-nth ] compile-call ] unit-test
[ CHAR: a ] [ [ 0 "abc" string-nth ] compile-call ] unit-test [ char: a ] [ [ 0 "abc" string-nth ] compile-call ] unit-test
[ CHAR: b ] [ 1 "abc" [ string-nth ] compile-call ] unit-test [ char: b ] [ 1 "abc" [ string-nth ] compile-call ] unit-test
[ CHAR: b ] [ 1 [ "abc" string-nth ] compile-call ] unit-test [ char: b ] [ 1 [ "abc" string-nth ] compile-call ] unit-test
[ CHAR: b ] [ [ 1 "abc" string-nth ] compile-call ] unit-test [ char: b ] [ [ 1 "abc" string-nth ] compile-call ] unit-test
[ 0x123456 ] [ 0 "\u123456bc" [ string-nth ] compile-call ] unit-test [ 0x123456 ] [ 0 "\u123456bc" [ string-nth ] compile-call ] unit-test
[ 0x123456 ] [ 0 [ "\u123456bc" string-nth ] compile-call ] unit-test [ 0x123456 ] [ 0 [ "\u123456bc" string-nth ] compile-call ] unit-test
@ -439,7 +439,7 @@ ERROR: bug-in-fixnum* x y a b ;
[ ALIEN: 1234 ] [ ALIEN: 1234 [ { alien } declare void* <ref> ] compile-call void* deref ] unit-test [ ALIEN: 1234 ] [ ALIEN: 1234 [ { alien } declare void* <ref> ] compile-call void* deref ] unit-test
[ ALIEN: 1234 ] [ ALIEN: 1234 [ { c-ptr } declare void* <ref> ] compile-call void* deref ] unit-test [ ALIEN: 1234 ] [ ALIEN: 1234 [ { c-ptr } declare void* <ref> ] compile-call void* deref ] unit-test
[ f ] [ f [ { POSTPONE: f } declare void* <ref> ] compile-call void* deref ] unit-test [ f ] [ f [ { postpone: f } declare void* <ref> ] compile-call void* deref ] unit-test
[ 252 ] [ B{ 1 2 3 -4 5 } 3 [ { byte-array fixnum } declare alien-unsigned-1 ] compile-call ] unit-test [ 252 ] [ B{ 1 2 3 -4 5 } 3 [ { byte-array fixnum } declare alien-unsigned-1 ] compile-call ] unit-test
[ -4 ] [ B{ 1 2 3 -4 5 } 3 [ { byte-array fixnum } declare alien-signed-1 ] compile-call ] unit-test [ -4 ] [ B{ 1 2 3 -4 5 } 3 [ { byte-array fixnum } declare alien-signed-1 ] compile-call ] unit-test

View File

@ -284,7 +284,7 @@ HINTS: recursive-inline-hang-3 array ;
! Infinite expansion ! Infinite expansion
TUPLE: cons car cdr ; TUPLE: cons car cdr ;
UNION: improper-list cons POSTPONE: f ; UNION: improper-list cons postpone: f ;
PREDICATE: list < improper-list PREDICATE: list < improper-list
[ cdr>> list instance? ] [ t ] if* ; [ cdr>> list instance? ] [ t ] if* ;

View File

@ -551,7 +551,7 @@ MIXIN: foo-mix
{ class { class
intersection{ intersection{
not{ not{
POSTPONE: f postpone: f
} }
not{ foo-mix } not{ foo-mix }
} }
@ -564,7 +564,7 @@ MIXIN: foo-mix
{ {
8815405 8815405
T{ value-info-state T{ value-info-state
{ class POSTPONE: f } { class postpone: f }
{ interval { interval
empty-interval empty-interval
} }

View File

@ -577,7 +577,7 @@ TUPLE: immutable-prop-test-tuple { x sequence read-only } ;
{ V{ number } } [ [ [ "Oops" throw ] [ 2 + ] if ] final-classes ] unit-test { V{ number } } [ [ [ "Oops" throw ] [ 2 + ] if ] final-classes ] unit-test
{ V{ number } } [ [ [ 2 + ] [ "Oops" throw ] if ] final-classes ] unit-test { V{ number } } [ [ [ 2 + ] [ "Oops" throw ] if ] final-classes ] unit-test
{ V{ POSTPONE: f } } [ { V{ postpone: f } } [
[ dup 1.0 <= [ drop f ] [ 0 number= ] if ] final-classes [ dup 1.0 <= [ drop f ] [ 0 number= ] if ] final-classes
] unit-test ] unit-test
@ -720,7 +720,7 @@ M: array iterate first t ; inline
[ { hashtable } declare hashtable instance? ] final-classes [ { hashtable } declare hashtable instance? ] final-classes
] unit-test ] unit-test
{ V{ POSTPONE: f } } [ { V{ postpone: f } } [
[ { vector } declare hashtable instance? ] final-classes [ { vector } declare hashtable instance? ] final-classes
] unit-test ] unit-test
@ -728,7 +728,7 @@ M: array iterate first t ; inline
[ { assoc } declare hashtable instance? ] final-classes [ { assoc } declare hashtable instance? ] final-classes
] unit-test ] unit-test
{ V{ POSTPONE: f } } [ { V{ postpone: f } } [
[ 3 string? ] final-classes [ 3 string? ] final-classes
] unit-test ] unit-test
@ -788,7 +788,7 @@ MIXIN: empty-mixin
] final-classes ] final-classes
] unit-test ] unit-test
{ V{ POSTPONE: f } } [ { V{ postpone: f } } [
[ { float } declare 0 eq? ] final-classes [ { float } declare 0 eq? ] final-classes
] unit-test ] unit-test
@ -872,7 +872,7 @@ MIXIN: empty-mixin
[ { fixnum } declare log2 0 >= ] final-classes [ { fixnum } declare log2 0 >= ] final-classes
] unit-test ] unit-test
{ V{ POSTPONE: f } } [ { V{ postpone: f } } [
[ { word object } declare equal? ] final-classes [ { word object } declare equal? ] final-classes
] unit-test ] unit-test
@ -1074,7 +1074,7 @@ M: tuple-with-read-only-slot clone
] unit-test ] unit-test
{ t } [ { t } [
[ { POSTPONE: f } declare <displaced-alien> ] final-classes [ { postpone: f } declare <displaced-alien> ] final-classes
first \ f alien class-or class= first \ f alien class-or class=
] unit-test ] unit-test

View File

@ -21,7 +21,7 @@ IN: core-text.tests
:: test-typographic-bounds ( string font -- ? ) :: test-typographic-bounds ( string font -- ? )
[ [
font test-font &CFRelease :> ctfont font test-font &CFRelease :> ctfont
string ctfont COLOR: white <CTLine> &CFRelease :> ctline string ctfont color: white <CTLine> &CFRelease :> ctline
ctfont ctline compute-line-metrics { ctfont ctline compute-line-metrics {
[ width>> float? ] [ width>> float? ]
[ ascent>> float? ] [ ascent>> float? ]

View File

@ -46,7 +46,7 @@ HELP: write-csv
{ $description "Writes a sequence of sequences of comma-separated-values to the output stream, escaping where necessary." } ; { $description "Writes a sequence of sequences of comma-separated-values to the output stream, escaping where necessary." } ;
HELP: with-delimiter HELP: with-delimiter
{ $values { "ch" "field delimiter (e.g. CHAR: \\t)" } { $values { "ch" "field delimiter (e.g. char: \\t)" }
{ "quot" quotation } } { "quot" quotation } }
{ $description "Sets the field delimiter for read-csv, read-row, write-csv, or write-row words." } ; { $description "Sets the field delimiter for read-csv, read-row, write-csv, or write-row words." } ;

View File

@ -61,7 +61,7 @@ IN: csv.tests
"allows setting of delimiting character" "allows setting of delimiting character"
[ { { "foo" "bah" "baz" } } ] [ { { "foo" "bah" "baz" } } ]
[ "foo\tbah\tbaz\n" CHAR: \t [ string>csv ] with-delimiter ] named-unit-test [ "foo\tbah\tbaz\n" char: \t [ string>csv ] with-delimiter ] named-unit-test
"Quoted field followed immediately by newline" "Quoted field followed immediately by newline"
[ { { "foo" "bar" } [ { { "foo" "bar" }

View File

@ -7,7 +7,7 @@ IN: csv
SYMBOL: delimiter SYMBOL: delimiter
CHAR: , delimiter set-global char: , delimiter set-global
<PRIVATE <PRIVATE
@ -20,9 +20,9 @@ DEFER: quoted-field,
2over stream-read1 swap over = 2over stream-read1 swap over =
[ nip ] [ [ nip ] [
{ {
{ CHAR: \" [ [ CHAR: \" , ] when quoted-field, ] } { char: \" [ [ char: \" , ] when quoted-field, ] }
{ CHAR: \n [ ] } ! Error: cr inside string? { char: \n [ ] } ! Error: cr inside string?
{ CHAR: \r [ ] } ! Error: lf inside string? { char: \r [ ] } ! Error: lf inside string?
[ [ , drop f maybe-escaped-quote ] when* ] [ [ , drop f maybe-escaped-quote ] when* ]
} case } case
] if ; inline recursive ] if ; inline recursive
@ -45,7 +45,7 @@ DEFER: quoted-field,
swap ?trim [ drop ] 2dip ; inline swap ?trim [ drop ] 2dip ; inline
: field ( delimiter stream field-seps quote-seps -- sep/f field ) : field ( delimiter stream field-seps quote-seps -- sep/f field )
pick stream-read-until dup CHAR: \" = [ pick stream-read-until dup char: \" = [
drop [ drop quoted-field ] [ continue-field ] if-empty drop [ drop quoted-field ] [ continue-field ] if-empty
] [ [ 3drop ] 2dip swap ?trim ] if ; ] [ [ 3drop ] 2dip swap ?trim ] if ;
@ -89,10 +89,10 @@ PRIVATE>
'[ dup "\n\"\r" member? [ drop t ] [ _ = ] if ] any? ; inline '[ dup "\n\"\r" member? [ drop t ] [ _ = ] if ] any? ; inline
: escape-quotes ( cell stream -- ) : escape-quotes ( cell stream -- )
CHAR: \" over stream-write1 swap [ char: \" over stream-write1 swap [
[ over stream-write1 ] [ over stream-write1 ]
[ dup CHAR: \" = [ over stream-write1 ] [ drop ] if ] bi [ dup char: \" = [ over stream-write1 ] [ drop ] if ] bi
] each CHAR: \" swap stream-write1 ; ] each char: \" swap stream-write1 ;
: escape-if-required ( cell delimiter stream -- ) : escape-if-required ( cell delimiter stream -- )
[ dupd needs-escaping? ] dip [ dupd needs-escaping? ] dip

View File

@ -117,7 +117,7 @@ M: postgresql-db-connection <prepared-statement> ( sql in out -- statement )
<simple-statement> dup prepare-statement ; <simple-statement> dup prepare-statement ;
: bind-name% ( -- ) : bind-name% ( -- )
CHAR: $ 0, char: $ 0,
sql-counter [ inc ] [ get 0# ] bi ; sql-counter [ inc ] [ get 0# ] bi ;
M: postgresql-db-connection bind% ( spec -- ) M: postgresql-db-connection bind% ( spec -- )

View File

@ -8,7 +8,7 @@ IN: db.tester
: postgresql-test-db-name ( -- string ) : postgresql-test-db-name ( -- string )
cpu name>> "-" "factor-test" 3append cpu name>> "-" "factor-test" 3append
H{ { CHAR: - CHAR: _ } { CHAR: . CHAR: _ } } substitute ; H{ { char: - char: _ } { char: . char: _ } } substitute ;
: postgresql-test-db ( -- postgresql-db ) : postgresql-test-db ( -- postgresql-db )
\ postgresql-db get-global clone postgresql-test-db-name >>database ; \ postgresql-db get-global clone postgresql-test-db-name >>database ;

View File

@ -305,7 +305,7 @@ TUPLE: exam id name score ;
: random-exam ( -- exam ) : random-exam ( -- exam )
f f
6 [ CHAR: a CHAR: z [a,b] random ] replicate >string 6 [ char: a char: z [a,b] random ] replicate >string
100 random 100 random
exam boa ; exam boa ;

View File

@ -7,6 +7,6 @@ ARTICLE: "definitions.icons" "Definition icons"
"Looking up the icon associated with a definition:" "Looking up the icon associated with a definition:"
{ $subsections definition-icon } { $subsections definition-icon }
"Defining new icons:" "Defining new icons:"
{ $subsections POSTPONE: ICON: } ; { $subsections postpone: ICON: } ;
ABOUT: "definitions.icons" ABOUT: "definitions.icons"

View File

@ -4,18 +4,18 @@ IN: delegate
HELP: define-protocol HELP: define-protocol
{ $values { "protocol" "a word for the new protocol" } { "wordlist" "a sequence of words" } } { $values { "protocol" "a word for the new protocol" } { "wordlist" "a sequence of words" } }
{ $description "Defines a symbol as a protocol." } { $description "Defines a symbol as a protocol." }
{ $notes "Usually, " { $link POSTPONE: PROTOCOL: } " should be used instead. This is only for runtime use." } ; { $notes "Usually, " { $link postpone: PROTOCOL: } " should be used instead. This is only for runtime use." } ;
HELP: PROTOCOL: HELP: PROTOCOL:
{ $syntax "PROTOCOL: protocol-name words... ;" } { $syntax "PROTOCOL: protocol-name words... ;" }
{ $description "Defines an explicit protocol, which can be used as a basis for delegation." } ; { $description "Defines an explicit protocol, which can be used as a basis for delegation." } ;
{ define-protocol POSTPONE: PROTOCOL: } related-words { define-protocol postpone: PROTOCOL: } related-words
HELP: define-consult HELP: define-consult
{ $values { "consultation" consultation } } { $values { "consultation" consultation } }
{ $description "Defines a class to consult, using the quotation, on the generic words contained in the group." } { $description "Defines a class to consult, using the quotation, on the generic words contained in the group." }
{ $notes "Usually, " { $link POSTPONE: CONSULT: } " should be used instead. This is only for runtime use." } ; { $notes "Usually, " { $link postpone: CONSULT: } " should be used instead. This is only for runtime use." } ;
HELP: CONSULT: HELP: CONSULT:
{ $syntax "CONSULT: group class { $syntax "CONSULT: group class
@ -33,9 +33,9 @@ HELP: SLOT-PROTOCOL:
{ $syntax "SLOT-PROTOCOL: protocol-name slots... ;" } { $syntax "SLOT-PROTOCOL: protocol-name slots... ;" }
{ $description "Defines a protocol consisting of reader and writer words for the listed slot names." } ; { $description "Defines a protocol consisting of reader and writer words for the listed slot names." } ;
{ define-protocol POSTPONE: PROTOCOL: } related-words { define-protocol postpone: PROTOCOL: } related-words
{ define-consult POSTPONE: BROADCAST: POSTPONE: CONSULT: } related-words { define-consult postpone: BROADCAST: postpone: CONSULT: } related-words
HELP: group-words HELP: group-words
{ $values { "group" "a group" } { "words" "an array of words" } } { $values { "group" "a group" } { "words" "an array of words" } }
@ -52,15 +52,15 @@ $nl
$nl $nl
"Defining new protocols:" "Defining new protocols:"
{ $subsections { $subsections
POSTPONE: PROTOCOL: postpone: PROTOCOL:
define-protocol define-protocol
} }
"Defining new protocols consisting of slot accessors:" "Defining new protocols consisting of slot accessors:"
{ $subsections POSTPONE: SLOT-PROTOCOL: } { $subsections postpone: SLOT-PROTOCOL: }
"Defining consultation:" "Defining consultation:"
{ $subsections { $subsections
POSTPONE: BROADCAST: postpone: BROADCAST:
POSTPONE: CONSULT: postpone: CONSULT:
define-consult define-consult
} }
"Every tuple class has an associated protocol consisting of all of its slot accessor methods. The " { $vocab-link "delegate.protocols" } " vocabulary defines formal protocols for the various informal protocols used in the Factor core, such as " { $link "sequence-protocol" } ", " { $link "assocs-protocol" } " or " { $link "stream-protocol" } ; "Every tuple class has an associated protocol consisting of all of its slot accessor methods. The " { $vocab-link "delegate.protocols" } " vocabulary defines formal protocols for the various informal protocols used in the Factor core, such as " { $link "sequence-protocol" } ", " { $link "assocs-protocol" } " or " { $link "stream-protocol" } ;

View File

@ -21,7 +21,7 @@ os unix? [
{ f } [ "factor-test-key-1" os-env ] unit-test { f } [ "factor-test-key-1" os-env ] unit-test
{ } [ { } [
32766 CHAR: a <string> "factor-test-key-long" set-os-env 32766 char: a <string> "factor-test-key-long" set-os-env
] unit-test ] unit-test
{ 32766 } [ "factor-test-key-long" os-env length ] unit-test { 32766 } [ "factor-test-key-long" os-env length ] unit-test
{ } [ "factor-test-key-long" unset-os-env ] unit-test { } [ "factor-test-key-long" unset-os-env ] unit-test

View File

@ -54,17 +54,17 @@ $nl
( -- seq ) (eval) ( -- seq ) (eval)
] with-interactive-vocabs" ] with-interactive-vocabs"
} }
"Note that the search path in the outer code (set by the " { $link POSTPONE: USING: } " form) has no relation to the search path used when parsing the string parameter (this is determined by " { $link with-interactive-vocabs } " and " { $link use-vocab } ")." ; "Note that the search path in the outer code (set by the " { $link postpone: USING: } " form) has no relation to the search path used when parsing the string parameter (this is determined by " { $link with-interactive-vocabs } " and " { $link use-vocab } ")." ;
ARTICLE: "eval" "Evaluating strings at run time" ARTICLE: "eval" "Evaluating strings at run time"
"The " { $vocab-link "eval" } " vocabulary implements support for evaluating strings of code dynamically." "The " { $vocab-link "eval" } " vocabulary implements support for evaluating strings of code dynamically."
$nl $nl
"The main entry point is a parsing word, which wraps a library word:" "The main entry point is a parsing word, which wraps a library word:"
{ $subsections { $subsections
POSTPONE: eval( postpone: eval(
eval eval
} }
"This pairing is analogous to that of " { $link POSTPONE: call( } " with " { $link call-effect } "." "This pairing is analogous to that of " { $link postpone: call( } " with " { $link call-effect } "."
$nl $nl
"Advanced features:" "Advanced features:"
{ $subsections "eval-vocabs" eval>string } { $subsections "eval-vocabs" eval>string }

View File

@ -63,11 +63,11 @@ DEFER: (parse-paragraph)
: delimiter-class ( delimiter -- class ) : delimiter-class ( delimiter -- class )
H{ H{
{ CHAR: * strong } { char: * strong }
{ CHAR: _ emphasis } { char: _ emphasis }
{ CHAR: ^ superscript } { char: ^ superscript }
{ CHAR: ~ subscript } { char: ~ subscript }
{ CHAR: % inline-code } { char: % inline-code }
} at ; } at ;
: or-simple-title ( ... url title/f quot: ( ... title -- ... title' ) -- ... url title' ) : or-simple-title ( ... url title/f quot: ( ... title -- ... title' ) -- ... url title' )
@ -82,9 +82,9 @@ DEFER: (parse-paragraph)
] dip [ (parse-paragraph) cons ] [ 1list ] if* ; ] dip [ (parse-paragraph) cons ] [ 1list ] if* ;
: parse-big-link ( before after -- link rest ) : parse-big-link ( before after -- link rest )
dup ?first CHAR: \[ = dup ?first char: \[ =
[ parse-link ] [ parse-link ]
[ [ CHAR: \[ suffix ] [ (parse-paragraph) ] bi* ] [ [ char: \[ suffix ] [ (parse-paragraph) ] bi* ]
if ; if ;
: escape ( before after -- before' after' ) : escape ( before after -- before' after' )
@ -94,8 +94,8 @@ DEFER: (parse-paragraph)
[ nil ] [ [ nil ] [
[ "*_^~%[\\" member? ] find-cut [ [ "*_^~%[\\" member? ] find-cut [
{ {
{ CHAR: \[ [ parse-big-link ] } { char: \[ [ parse-big-link ] }
{ CHAR: \\ [ escape ] } { char: \\ [ escape ] }
[ dup delimiter-class parse-delimiter ] [ dup delimiter-class parse-delimiter ]
} case cons } case cons
] [ drop "" like 1list ] if* ] [ drop "" like 1list ] if*
@ -124,10 +124,10 @@ DEFER: (parse-paragraph)
V{ } clone (take-until) ; V{ } clone (take-until) ;
: count= ( string -- n ) : count= ( string -- n )
dup <reversed> [ [ CHAR: = = not ] find drop 0 or ] bi@ min ; dup <reversed> [ [ char: = = not ] find drop 0 or ] bi@ min ;
: trim= ( string -- string' ) : trim= ( string -- string' )
[ CHAR: = = ] trim ; [ char: = = ] trim ;
: make-heading ( string class -- heading ) : make-heading ( string class -- heading )
[ trim= parse-paragraph ] dip boa ; inline [ trim= parse-paragraph ] dip boa ; inline
@ -149,14 +149,14 @@ DEFER: (parse-paragraph)
: coalesce ( rows -- rows' ) : coalesce ( rows -- rows' )
V{ } clone [ V{ } clone [
'[ '[
_ dup ?last ?last CHAR: \\ = _ dup ?last ?last char: \\ =
[ [ pop "|" rot 3append ] keep ] when [ [ pop "|" rot 3append ] keep ] when
push push
] each ] each
] keep ; ] keep ;
: parse-table ( state -- state' table ) : parse-table ( state -- state' table )
CHAR: | take-lines [ char: | take-lines [
"|" split "|" split
trim-row trim-row
coalesce coalesce
@ -175,13 +175,13 @@ DEFER: (parse-paragraph)
] dip boa ; inline ] dip boa ; inline
: parse-ul ( state -- state' ul ) : parse-ul ( state -- state' ul )
CHAR: - unordered-list parse-list ; char: - unordered-list parse-list ;
: parse-ol ( state -- state' ul ) : parse-ol ( state -- state' ul )
CHAR: # ordered-list parse-list ; char: # ordered-list parse-list ;
: parse-code ( state -- state' item ) : parse-code ( state -- state' item )
dup 1 look CHAR: \[ = dup 1 look char: \[ =
[ unclip-slice make-paragraph ] [ [ unclip-slice make-paragraph ] [
dup "{" take-until [ dup "{" take-until [
[ nip rest ] dip [ nip rest ] dip
@ -192,12 +192,12 @@ DEFER: (parse-paragraph)
: parse-item ( state -- state' item ) : parse-item ( state -- state' item )
dup 0 look { dup 0 look {
{ CHAR: = [ parse-heading ] } { char: = [ parse-heading ] }
{ CHAR: | [ parse-table ] } { char: | [ parse-table ] }
{ CHAR: _ [ parse-line ] } { char: _ [ parse-line ] }
{ CHAR: - [ parse-ul ] } { char: - [ parse-ul ] }
{ CHAR: # [ parse-ol ] } { char: # [ parse-ol ] }
{ CHAR: \[ [ parse-code ] } { char: \[ [ parse-code ] }
{ f [ rest-slice f ] } { f [ rest-slice f ] }
[ drop unclip-slice make-paragraph ] [ drop unclip-slice make-paragraph ]
} case ; } case ;
@ -212,7 +212,7 @@ CONSTANT: invalid-url "javascript:alert('Invalid URL in farkup');"
{ [ dup empty? ] [ drop invalid-url ] } { [ dup empty? ] [ drop invalid-url ] }
{ [ dup [ 127 > ] any? ] [ drop invalid-url ] } { [ dup [ 127 > ] any? ] [ drop invalid-url ] }
{ [ dup first "/\\" member? ] [ drop invalid-url ] } { [ dup first "/\\" member? ] [ drop invalid-url ] }
{ [ CHAR: \: over member? ] [ dup absolute-url? [ drop invalid-url ] unless ] } { [ char: \: over member? ] [ dup absolute-url? [ drop invalid-url ] unless ] }
[ relative-link-prefix get prepend "" like url-encode ] [ relative-link-prefix get prepend "" like url-encode ]
} cond ; } cond ;

View File

@ -11,10 +11,10 @@ CONSTANT: default-monospace-font-name "monospace"
CONSTANT: default-font-size 12 CONSTANT: default-font-size 12
SYMBOL: default-font-foreground-color SYMBOL: default-font-foreground-color
COLOR: black default-font-foreground-color set-global color: black default-font-foreground-color set-global
SYMBOL: default-font-background-color SYMBOL: default-font-background-color
COLOR: white default-font-background-color set-global color: white default-font-background-color set-global
TUPLE: font name size bold? italic? foreground background ; TUPLE: font name size bold? italic? foreground background ;

View File

@ -62,21 +62,21 @@ IN: formatting.tests
{ "1.00000e-1000" } [ -1000 10^ "%.5e" sprintf ] unit-test { "1.00000e-1000" } [ -1000 10^ "%.5e" sprintf ] unit-test
{ t } [ { t } [
1000 10^ "%.5f" sprintf 1000 10^ "%.5f" sprintf
"1" ".00000" 1000 CHAR: 0 <string> glue = "1" ".00000" 1000 char: 0 <string> glue =
] unit-test ] unit-test
{ t } [ { t } [
-1000 10^ "%.1004f" sprintf -1000 10^ "%.1004f" sprintf
"0." "10000" 999 CHAR: 0 <string> glue = "0." "10000" 999 char: 0 <string> glue =
] unit-test ] unit-test
{ "-1.00000e+1000" } [ 1000 10^ neg "%.5e" sprintf ] unit-test { "-1.00000e+1000" } [ 1000 10^ neg "%.5e" sprintf ] unit-test
{ "-1.00000e-1000" } [ -1000 10^ neg "%.5e" sprintf ] unit-test { "-1.00000e-1000" } [ -1000 10^ neg "%.5e" sprintf ] unit-test
{ t } [ { t } [
1000 10^ neg "%.5f" sprintf 1000 10^ neg "%.5f" sprintf
"-1" ".00000" 1000 CHAR: 0 <string> glue = "-1" ".00000" 1000 char: 0 <string> glue =
] unit-test ] unit-test
{ t } [ { t } [
-1000 10^ neg "%.1004f" sprintf -1000 10^ neg "%.1004f" sprintf
"-0." "10000" 999 CHAR: 0 <string> glue = "-0." "10000" 999 char: 0 <string> glue =
] unit-test ] unit-test
{ "9007199254740991.0" } [ 53 2^ 1 - "%.1f" sprintf ] unit-test { "9007199254740991.0" } [ 53 2^ 1 - "%.1f" sprintf ] unit-test
{ "9007199254740992.0" } [ 53 2^ "%.1f" sprintf ] unit-test { "9007199254740992.0" } [ 53 2^ "%.1f" sprintf ] unit-test
@ -121,7 +121,7 @@ IN: formatting.tests
{ "2008-09-10" } [ 2008 9 10 "%04d-%02d-%02d" sprintf ] unit-test { "2008-09-10" } [ 2008 9 10 "%04d-%02d-%02d" sprintf ] unit-test
{ "Hello, World!" } [ "Hello, World!" "%s" sprintf ] unit-test { "Hello, World!" } [ "Hello, World!" "%s" sprintf ] unit-test
{ "printf test" } [ "printf test" sprintf ] unit-test { "printf test" } [ "printf test" sprintf ] unit-test
{ "char a = 'a'" } [ CHAR: a "char %c = 'a'" sprintf ] unit-test { "char a = 'a'" } [ char: a "char %c = 'a'" sprintf ] unit-test
{ "00" } [ 0x0 "%02x" sprintf ] unit-test { "00" } [ 0x0 "%02x" sprintf ] unit-test
{ "ff" } [ 0xff "%02x" sprintf ] unit-test { "ff" } [ 0xff "%02x" sprintf ] unit-test
{ "0 message(s)" } [ 0 "message" "%d %s(s)" sprintf ] unit-test { "0 message(s)" } [ 0 "message" "%d %s(s)" sprintf ] unit-test

View File

@ -15,12 +15,12 @@ IN: formatting
[ ] [ compose ] reduce ; inline [ ] [ compose ] reduce ; inline
: fix-sign ( string -- string ) : fix-sign ( string -- string )
dup first CHAR: 0 = [ dup first char: 0 = [
dup [ [ CHAR: 0 = not ] [ digit? ] bi and ] find dup [ [ char: 0 = not ] [ digit? ] bi and ] find
[ [
1 - swap 2dup nth { 1 - swap 2dup nth {
{ CHAR: - [ remove-nth "-" prepend ] } { char: - [ remove-nth "-" prepend ] }
{ CHAR: + [ remove-nth "+" prepend ] } { char: + [ remove-nth "+" prepend ] }
[ drop nip ] [ drop nip ]
} case } case
] [ drop ] if ] [ drop ] if
@ -33,9 +33,9 @@ IN: formatting
[ [
[ abs ] dip [ abs ] dip
[ 10^ * round-to-even >integer number>string ] [ 10^ * round-to-even >integer number>string ]
[ 1 + CHAR: 0 pad-head ] [ 1 + char: 0 pad-head ]
[ cut* ] tri [ "." glue ] unless-empty [ cut* ] tri [ "." glue ] unless-empty
] curry keep neg? [ CHAR: - prefix ] when ; ] curry keep neg? [ char: - prefix ] when ;
: format-scientific-mantissa ( x log10x digits -- string rounded-up? ) : format-scientific-mantissa ( x log10x digits -- string rounded-up? )
[ swap - 10^ * round-to-even >integer number>string ] keep [ swap - 10^ * round-to-even >integer number>string ] keep
@ -45,15 +45,15 @@ IN: formatting
] keep ; ] keep ;
: format-scientific-exponent ( rounded-up? log10x -- string ) : format-scientific-exponent ( rounded-up? log10x -- string )
swap [ 1 + ] when number>string 2 CHAR: 0 pad-head swap [ 1 + ] when number>string 2 char: 0 pad-head
dup CHAR: - swap index "e" "e+" ? prepend ; dup char: - swap index "e" "e+" ? prepend ;
: format-scientific-simple ( x digits -- string ) : format-scientific-simple ( x digits -- string )
[ [
[ abs dup integer-log10 ] dip [ abs dup integer-log10 ] dip
[ format-scientific-mantissa ] [ format-scientific-mantissa ]
[ drop nip format-scientific-exponent ] 3bi append [ drop nip format-scientific-exponent ] 3bi append
] curry keep neg? [ CHAR: - prefix ] when ; ] curry keep neg? [ char: - prefix ] when ;
: format-float-fast ( x digits string -- string ) : format-float-fast ( x digits string -- string )
[ "" -1 ] 2dip "C" format-float ; [ "" -1 ] 2dip "C" format-float ;
@ -95,15 +95,15 @@ ERROR: unknown-printf-directive ;
EBNF: parse-printf [=[ EBNF: parse-printf [=[
zero = "0" => [[ CHAR: 0 ]] zero = "0" => [[ char: 0 ]]
char = "'" (.) => [[ second ]] char = "'" (.) => [[ second ]]
pad-char = (zero|char)? => [[ CHAR: \s or ]] pad-char = (zero|char)? => [[ char: \s or ]]
pad-align = ("-")? => [[ \ pad-tail \ pad-head ? ]] pad-align = ("-")? => [[ \ pad-tail \ pad-head ? ]]
pad-width = ([0-9])* => [[ >digits ]] pad-width = ([0-9])* => [[ >digits ]]
pad = pad-align pad-char pad-width => [[ <reversed> >quotation dup first 0 = [ drop [ ] ] when ]] pad = pad-align pad-char pad-width => [[ <reversed> >quotation dup first 0 = [ drop [ ] ] when ]]
sign_ = [+ ] => [[ '[ dup first CHAR: - = [ _ prefix ] unless ] ]] sign_ = [+ ] => [[ '[ dup first char: - = [ _ prefix ] unless ] ]]
sign = (sign_)? => [[ [ ] or ]] sign = (sign_)? => [[ [ ] or ]]
width_ = "." ([0-9])* => [[ second >digits '[ _ short head ] ]] width_ = "." ([0-9])* => [[ second >digits '[ _ short head ] ]]
@ -179,10 +179,10 @@ MACRO: sprintf ( format-string -- quot )
<PRIVATE <PRIVATE
: pad-00 ( n -- string ) : pad-00 ( n -- string )
number>string 2 CHAR: 0 pad-head ; inline number>string 2 char: 0 pad-head ; inline
: pad-000 ( n -- string ) : pad-000 ( n -- string )
number>string 3 CHAR: 0 pad-head ; inline number>string 3 char: 0 pad-head ; inline
: >time ( timestamp -- string ) : >time ( timestamp -- string )
[ hour>> ] [ minute>> ] [ second>> floor ] tri [ hour>> ] [ minute>> ] [ second>> floor ] tri

View File

@ -12,7 +12,7 @@ HELP: @
HELP: fry HELP: fry
{ $values { "quot" quotation } { "quot'" quotation } } { $values { "quot" quotation } { "quot'" quotation } }
{ $description "Outputs a quotation that when called, fries " { $snippet "quot" } " by taking values from the stack and substituting them in." } { $description "Outputs a quotation that when called, fries " { $snippet "quot" } " by taking values from the stack and substituting them in." }
{ $notes "This word is used to implement " { $link POSTPONE: '[ } "; the following two lines are equivalent:" { $notes "This word is used to implement " { $link postpone: '[ } "; the following two lines are equivalent:"
{ $code "[ X ] fry call" "'[ X ]" } { $code "[ X ] fry call" "'[ X ]" }
} }
{ $examples "See " { $link "fry.examples" } "." } ; { $examples "See " { $link "fry.examples" } "." } ;
@ -23,12 +23,12 @@ HELP: '[
{ $examples "See " { $link "fry.examples" } "." } ; { $examples "See " { $link "fry.examples" } "." } ;
HELP: >r/r>-in-fry-error HELP: >r/r>-in-fry-error
{ $error-description "Thrown by " { $link POSTPONE: '[ } " if the fried quotation contains calls to retain stack manipulation primitives." } ; { $error-description "Thrown by " { $link postpone: '[ } " if the fried quotation contains calls to retain stack manipulation primitives." } ;
ARTICLE: "fry.examples" "Examples of fried quotations" ARTICLE: "fry.examples" "Examples of fried quotations"
"The easiest way to understand fried quotations is to look at some examples." "The easiest way to understand fried quotations is to look at some examples."
$nl $nl
"If a quotation does not contain any fry specifiers, then " { $link POSTPONE: '[ } " behaves just like " { $link POSTPONE: [ } ":" "If a quotation does not contain any fry specifiers, then " { $link postpone: '[ } " behaves just like " { $link postpone: [ } ":"
{ $code "{ 10 20 30 } '[ . ] each" } { $code "{ 10 20 30 } '[ . ] each" }
"Occurrences of " { $link _ } " on the left map directly to " { $link curry } ". That is, the following three lines are equivalent:" "Occurrences of " { $link _ } " on the left map directly to " { $link curry } ". That is, the following three lines are equivalent:"
{ $code { $code
@ -80,7 +80,7 @@ ARTICLE: "fry" "Fried quotations"
"The " { $vocab-link "fry" } " vocabulary implements " { $emphasis "fried quotation" } ". Conceptually, fried quotations are quotations with “holes” (more formally, " { $emphasis "fry specifiers" } "), and the holes are filled in when the fried quotation is pushed on the stack." "The " { $vocab-link "fry" } " vocabulary implements " { $emphasis "fried quotation" } ". Conceptually, fried quotations are quotations with “holes” (more formally, " { $emphasis "fry specifiers" } "), and the holes are filled in when the fried quotation is pushed on the stack."
$nl $nl
"Fried quotations are started by a special parsing word:" "Fried quotations are started by a special parsing word:"
{ $subsections POSTPONE: '[ } { $subsections postpone: '[ }
"There are two types of fry specifiers; the first can hold a value, and the second “splices” a quotation, as if it were inserted without surrounding brackets:" "There are two types of fry specifiers; the first can hold a value, and the second “splices” a quotation, as if it were inserted without surrounding brackets:"
{ $subsections { $subsections
_ _

View File

@ -11,7 +11,7 @@ IN: ftp.client
3 head string>number ; 3 head string>number ;
: ftp-response-code ( string -- n/f ) : ftp-response-code ( string -- n/f )
dup fourth CHAR: - = [ drop f ] [ (ftp-response-code) ] if ; dup fourth char: - = [ drop f ] [ (ftp-response-code) ] if ;
: read-response-loop ( ftp-response -- ftp-response ) : read-response-loop ( ftp-response -- ftp-response )
readln readln
@ -22,7 +22,7 @@ IN: ftp.client
<ftp-response> readln <ftp-response> readln
[ (ftp-response-code) >>n ] [ (ftp-response-code) >>n ]
[ add-response-line ] [ add-response-line ]
[ fourth CHAR: - = ] tri [ fourth char: - = ] tri
[ read-response-loop ] when ; [ read-response-loop ] when ;
ERROR: ftp-error got expected ; ERROR: ftp-error got expected ;

View File

@ -6,26 +6,26 @@ IN: ftp.client.listing-parser
: ch>file-type ( ch -- type ) : ch>file-type ( ch -- type )
{ {
{ CHAR: b [ +block-device+ ] } { char: b [ +block-device+ ] }
{ CHAR: c [ +character-device+ ] } { char: c [ +character-device+ ] }
{ CHAR: d [ +directory+ ] } { char: d [ +directory+ ] }
{ CHAR: l [ +symbolic-link+ ] } { char: l [ +symbolic-link+ ] }
{ CHAR: s [ +socket+ ] } { char: s [ +socket+ ] }
{ CHAR: p [ +fifo+ ] } { char: p [ +fifo+ ] }
{ CHAR: - [ +regular-file+ ] } { char: - [ +regular-file+ ] }
[ drop +unknown+ ] [ drop +unknown+ ]
} case ; } case ;
: file-type>ch ( type -- string ) : file-type>ch ( type -- string )
{ {
{ +block-device+ [ CHAR: b ] } { +block-device+ [ char: b ] }
{ +character-device+ [ CHAR: c ] } { +character-device+ [ char: c ] }
{ +directory+ [ CHAR: d ] } { +directory+ [ char: d ] }
{ +symbolic-link+ [ CHAR: l ] } { +symbolic-link+ [ char: l ] }
{ +socket+ [ CHAR: s ] } { +socket+ [ char: s ] }
{ +fifo+ [ CHAR: p ] } { +fifo+ [ char: p ] }
{ +regular-file+ [ CHAR: - ] } { +regular-file+ [ char: - ] }
[ drop CHAR: - ] [ drop char: - ]
} case ; } case ;
: parse-permissions ( remote-file str -- remote-file ) : parse-permissions ( remote-file str -- remote-file )

View File

@ -111,7 +111,7 @@ TUPLE: couchdb-auth-provider
url>user ; url>user ;
: strip-hash ( hash1 -- hash2 ) : strip-hash ( hash1 -- hash2 )
[ drop first CHAR: _ = ] assoc-reject ; [ drop first char: _ = ] assoc-reject ;
: at-or-k ( key hash -- newkey ) : at-or-k ( key hash -- newkey )
dupd at [ nip ] when* ; dupd at [ nip ] when* ;

View File

@ -160,17 +160,17 @@ HELP: mouse-state
{ keyboard-state read-keyboard } related-words { keyboard-state read-keyboard } related-words
HELP: button-delta HELP: button-delta
{ $values { "old?" boolean } { "new?" boolean } { "delta" { $link pressed } ", " { $link released } ", or " { $link POSTPONE: f } } } { $values { "old?" boolean } { "new?" boolean } { "delta" { $link pressed } ", " { $link released } ", or " { $link postpone: f } } }
{ $description "Outputs a symbol representing the change in a key or button's state given a \"before\" and \"after\" sample of its state. Outputs " { $link pressed } " if " { $snippet "old?" } " is false and " { $snippet "new?" } " is true, " { $link released } " if " { $snippet "old?" } " is true and " { $snippet "new?" } " is false, or " { $link POSTPONE: f } " if the two inputs have the same boolean value." } ; { $description "Outputs a symbol representing the change in a key or button's state given a \"before\" and \"after\" sample of its state. Outputs " { $link pressed } " if " { $snippet "old?" } " is false and " { $snippet "new?" } " is true, " { $link released } " if " { $snippet "old?" } " is true and " { $snippet "new?" } " is false, or " { $link postpone: f } " if the two inputs have the same boolean value." } ;
HELP: buttons-delta HELP: buttons-delta
{ $values { "old-buttons" sequence } { "new-buttons" sequence } { "delta" "an array of " { $link pressed } ", " { $link released } ", or " { $link POSTPONE: f } } } { $values { "old-buttons" sequence } { "new-buttons" sequence } { "delta" "an array of " { $link pressed } ", " { $link released } ", or " { $link postpone: f } } }
{ $description "Outputs an array of symbols representing the change in a set of keys or buttons' states given \"before\" and \"after\" samples of their state. For each corresponding pair of values in the two input sequences, outputs " { $link pressed } " if " { $snippet "old-buttons" } " contains a false and " { $snippet "new-buttons" } " a true value, " { $link released } " if " { $snippet "old-buttons" } " contains true and " { $snippet "new-buttons" } " false, or " { $link POSTPONE: f } " if the two elements have the same boolean value." { $description "Outputs an array of symbols representing the change in a set of keys or buttons' states given \"before\" and \"after\" samples of their state. For each corresponding pair of values in the two input sequences, outputs " { $link pressed } " if " { $snippet "old-buttons" } " contains a false and " { $snippet "new-buttons" } " a true value, " { $link released } " if " { $snippet "old-buttons" } " contains true and " { $snippet "new-buttons" } " false, or " { $link postpone: f } " if the two elements have the same boolean value."
$nl $nl
"This word can be used with two samples of a " { $link keyboard-state } "'s " { $snippet "keys" } " slot or of a " { $link mouse-state } "'s or " { $link controller-state } "'s " { $snippet "buttons" } " slot to convert the button states into pressed/released values. Remember to " { $link clone } " state objects to record snapshots of their state." } ; "This word can be used with two samples of a " { $link keyboard-state } "'s " { $snippet "keys" } " slot or of a " { $link mouse-state } "'s or " { $link controller-state } "'s " { $snippet "buttons" } " slot to convert the button states into pressed/released values. Remember to " { $link clone } " state objects to record snapshots of their state." } ;
HELP: buttons-delta-as HELP: buttons-delta-as
{ $values { "old-buttons" sequence } { "new-buttons" sequence } { "exemplar" sequence } { "delta" "a sequence of " { $link pressed } ", " { $link released } ", or " { $link POSTPONE: f } } } { $values { "old-buttons" sequence } { "new-buttons" sequence } { "exemplar" sequence } { "delta" "a sequence of " { $link pressed } ", " { $link released } ", or " { $link postpone: f } } }
{ $description "Like " { $link buttons-delta } ", but returns a sequence matching the type of the " { $snippet "exemplar" } "." } ; { $description "Like " { $link buttons-delta } ", but returns a sequence matching the type of the " { $snippet "exemplar" } "." } ;
{ button-delta buttons-delta buttons-delta-as } related-words { button-delta buttons-delta buttons-delta-as } related-words

View File

@ -70,7 +70,7 @@ PREDICATE: fixed-size-array-type < c-array-type fixed-size>> >boolean ;
: qualified-type-name ( data-type -- name ) : qualified-type-name ( data-type -- name )
[ name>> ] keep { [ name>> ] keep {
[ name>> CHAR: . swap member? ] [ name>> char: . swap member? ]
[ none-type? ] [ none-type? ]
[ standard-type? ] [ standard-type? ]
} 1|| [ qualified-name ] unless ; } 1|| [ qualified-name ] unless ;

View File

@ -44,7 +44,7 @@ ARTICLE: "cookbook-colon-defs" "Shuffle word and definition cookbook"
{ $code ": sq ( x -- y ) dup * ;" } { $code ": sq ( x -- y ) dup * ;" }
"(You could have looked this up yourself by clicking on the " { $link sq } " word itself.)" "(You could have looked this up yourself by clicking on the " { $link sq } " word itself.)"
$nl $nl
"Note the key elements in a word definition: The colon " { $link POSTPONE: : } " denotes the start of a word definition. The name of the new word and a stack effect declaration must immediately follow. The word definition then continues on until the " { $link POSTPONE: ; } " token signifies the end of the definition. This type of word definition is called a " { $emphasis "compound definition." } "Note the key elements in a word definition: The colon " { $link postpone: : } " denotes the start of a word definition. The name of the new word and a stack effect declaration must immediately follow. The word definition then continues on until the " { $link postpone: ; } " token signifies the end of the definition. This type of word definition is called a " { $emphasis "compound definition." }
$nl $nl
"Factor is all about code reuse through short and logical colon definitions. Breaking up a problem into small pieces which are easy to test is called " { $emphasis "factoring." } "Factor is all about code reuse through short and logical colon definitions. Breaking up a problem into small pieces which are easy to test is called " { $emphasis "factoring." }
$nl $nl
@ -146,7 +146,7 @@ $nl
} }
"Typically a source file will refer to words in multiple vocabularies, and they can all be added to the search path in one go:" "Typically a source file will refer to words in multiple vocabularies, and they can all be added to the search path in one go:"
{ $code "USING: arrays kernel math ;" } { $code "USING: arrays kernel math ;" }
"New words go into the " { $vocab-link "scratchpad" } " vocabulary by default. You can change this with " { $link POSTPONE: IN: } ":" "New words go into the " { $vocab-link "scratchpad" } " vocabulary by default. You can change this with " { $link postpone: IN: } ":"
{ $code { $code
"IN: time-machine" "IN: time-machine"
": time-travel ( when what -- ) frob fizz flap ;" ": time-travel ( when what -- ) frob fizz flap ;"
@ -157,7 +157,7 @@ $nl
": accelerate ( -- ) accelerator on ;" ": accelerate ( -- ) accelerator on ;"
": particles ( what -- ) [ (particles) ] each ;" ": particles ( what -- ) [ (particles) ] each ;"
} }
"You would have to place the first definition after the two others for the parser to accept the file. If you have a set of mutually recursive words, you can use " { $link POSTPONE: DEFER: } "." "You would have to place the first definition after the two others for the parser to accept the file. If you have a set of mutually recursive words, you can use " { $link postpone: DEFER: } "."
{ $references { $references
{ } { }
"word-search" "word-search"
@ -173,7 +173,7 @@ ARTICLE: "cookbook-application" "Application cookbook"
"" ""
"MAIN: play-life" "MAIN: play-life"
} }
"See " { $link POSTPONE: MAIN: } " for details. The " { $link run } " word loads a vocabulary if necessary, and calls its main entry point; try the following, it's fun:" "See " { $link postpone: MAIN: } " for details. The " { $link run } " word loads a vocabulary if necessary, and calls its main entry point; try the following, it's fun:"
{ $code "\"tetris\" run" } { $code "\"tetris\" run" }
"Factor can deploy stand-alone executables; they do not have any external dependencies and consist entirely of compiled native machine code:" "Factor can deploy stand-alone executables; they do not have any external dependencies and consist entirely of compiled native machine code:"
{ $code "\"tetris\" deploy-tool" } { $code "\"tetris\" deploy-tool" }

View File

@ -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 "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." "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
@ -78,7 +78,7 @@ ARTICLE: "evaluator" "Stack machine model"
{ $link "quotations" } " are evaluated sequentially from beginning to end. When the end is reached, the quotation returns to its caller. As each object in the quotation is evaluated in turn, an action is taken based on its type:" { $link "quotations" } " are evaluated sequentially from beginning to end. When the end is reached, the quotation returns to its caller. As each object in the quotation is evaluated in turn, an action is taken based on its type:"
{ $list { $list
{ "a " { $link word } " - the word's definition quotation is called. See " { $link "words" } } { "a " { $link word } " - the word's definition quotation is called. See " { $link "words" } }
{ "a " { $link wrapper } " - the wrapped object is pushed on the data stack. Wrappers are used to push word objects directly on the stack when they would otherwise execute. See the " { $link POSTPONE: \ } " parsing word." } { "a " { $link wrapper } " - the wrapped object is pushed on the data stack. Wrappers are used to push word objects directly on the stack when they would otherwise execute. See the " { $link postpone: \ } " parsing word." }
{ "All other types of objects are pushed on the data stack." } { "All other types of objects are pushed on the data stack." }
} }
{ $subsections "tail-call-opt" } { $subsections "tail-call-opt" }

View File

@ -91,11 +91,11 @@ ARTICLE: "writing-help" "Writing documentation"
$nl $nl
"A pair of parsing words are used to define free-standing articles and to associate documentation with words:" "A pair of parsing words are used to define free-standing articles and to associate documentation with words:"
{ $subsections { $subsections
POSTPONE: ARTICLE: postpone: ARTICLE:
POSTPONE: HELP: postpone: HELP:
} }
"A parsing word defines the main help article for a vocabulary:" "A parsing word defines the main help article for a vocabulary:"
{ $subsections POSTPONE: ABOUT: } { $subsections postpone: ABOUT: }
"The " { $emphasis "content" } " in both cases is a " { $emphasis "markup element" } ", a recursive structure taking one of the following forms:" "The " { $emphasis "content" } " in both cases is a " { $emphasis "markup element" } ", a recursive structure taking one of the following forms:"
{ $list { $list
{ "a string," } { "a string," }
@ -311,7 +311,7 @@ HELP: $example
{ $values { "element" "a markup element of the form " { $snippet "{ inputs... output }" } } } { $values { "element" "a markup element of the form " { $snippet "{ inputs... output }" } } }
{ $description "Prints a clickable example with sample output. The markup element must be an array of strings. All but the last string are joined by newlines and taken as the input text, and the last string is the output. The example becomes clickable if the output stream supports it, and clicking it opens a listener window with the input text inserted at the input prompt." } { $description "Prints a clickable example with sample output. The markup element must be an array of strings. All but the last string are joined by newlines and taken as the input text, and the last string is the output. The example becomes clickable if the output stream supports it, and clicking it opens a listener window with the input text inserted at the input prompt." }
{ $examples { $examples
"The input text must contain a correct " { $link POSTPONE: USING: } " declaration, and output text should be a string of what the input prints when executed, not the final stack contents or anything like that. So the following is an incorrect example:" "The input text must contain a correct " { $link postpone: USING: } " declaration, and output text should be a string of what the input prints when executed, not the final stack contents or anything like that. So the following is an incorrect example:"
{ $markup-example { $unchecked-example "2 2 +" "4" } } { $markup-example { $unchecked-example "2 2 +" "4" } }
"However the following is right:" "However the following is right:"
{ $markup-example { $example "USING: math prettyprint ;" "2 2 + ." "4" } } { $markup-example { $example "USING: math prettyprint ;" "2 2 + ." "4" } }
@ -524,7 +524,7 @@ HELP: ABOUT:
HELP: vocab-help HELP: vocab-help
{ $values { "vocab-spec" "a vocabulary specifier" } { "help" "a help article" } } { $values { "vocab-spec" "a vocabulary specifier" } { "help" "a help article" } }
{ $description "Outputs the main help article for a vocabulary. The main help article can be set with " { $link POSTPONE: ABOUT: } "." } ; { $description "Outputs the main help article for a vocabulary. The main help article can be set with " { $link postpone: ABOUT: } "." } ;
HELP: orphan-articles HELP: orphan-articles
{ $values { "seq" "vocab names" } } { $values { "seq" "vocab names" } }

View File

@ -15,19 +15,19 @@ IN: help.html
: escape-char ( ch -- ) : escape-char ( ch -- )
dup ascii? [ dup ascii? [
dup H{ dup H{
{ CHAR: \" "__quo__" } { char: \" "__quo__" }
{ CHAR: * "__star__" } { char: * "__star__" }
{ CHAR: \: "__colon__" } { char: \: "__colon__" }
{ CHAR: < "__lt__" } { char: < "__lt__" }
{ CHAR: > "__gt__" } { char: > "__gt__" }
{ CHAR: ? "__que__" } { char: ? "__que__" }
{ CHAR: \\ "__back__" } { char: \\ "__back__" }
{ CHAR: | "__pipe__" } { char: | "__pipe__" }
{ CHAR: / "__slash__" } { char: / "__slash__" }
{ CHAR: , "__comma__" } { char: , "__comma__" }
{ CHAR: @ "__at__" } { char: @ "__at__" }
{ CHAR: # "__hash__" } { char: # "__hash__" }
{ CHAR: % "__percent__" } { char: % "__percent__" }
} at [ % ] [ , ] ?if } at [ % ] [ , ] ?if
] [ number>string "__" "__" surround % ] if ; ] [ number>string "__" "__" surround % ] if ;
@ -87,7 +87,7 @@ M: pathname url-of
XML] ; XML] ;
: bijective-base26 ( n -- name ) : bijective-base26 ( n -- name )
[ dup 0 > ] [ 1 - 26 /mod CHAR: a + ] "" produce-as nip reverse! ; [ dup 0 > ] [ 1 - 26 /mod char: a + ] "" produce-as nip reverse! ;
: css-class ( style classes -- name ) : css-class ( style classes -- name )
dup '[ drop _ assoc-size 1 + bijective-base26 ] cache ; dup '[ drop _ assoc-size 1 + bijective-base26 ] cache ;

View File

@ -17,7 +17,7 @@ IN: help.lint.spaces
dup utf8 file-lines [ 1 + 2array ] map-index dup utf8 file-lines [ 1 + 2array ] map-index
[ [
first [ first [
{ [ CHAR: space = ] [ CHAR: \" = ] } 1|| { [ char: space = ] [ char: \" = ] } 1||
] trim-head ] trim-head
" " swap subseq? " " swap subseq?
] filter ] filter

View File

@ -54,7 +54,7 @@ H{
{ font-style bold } { font-style bold }
{ wrap-margin $ wrap-margin-full } { wrap-margin $ wrap-margin-full }
{ foreground $ title-color } { foreground $ title-color }
{ page-color COLOR: FactorLightTan } { page-color color: FactorLightTan }
{ inset { 5 5 } } { inset { 5 5 } }
} title-style set-global } title-style set-global

View File

@ -19,7 +19,7 @@ TIP: "You can write graphical applications using the " { $link "ui" } "." ;
TIP: "Power tools: " { $links see edit help about apropos time infer. } ; TIP: "Power tools: " { $links see edit help about apropos time infer. } ;
TIP: "Tips of the day implement the " { $link "definition-protocol" } " and new tips of the day can be defined using the " { $link POSTPONE: TIP: } " parsing word." ; TIP: "Tips of the day implement the " { $link "definition-protocol" } " and new tips of the day can be defined using the " { $link postpone: TIP: } " parsing word." ;
TIP: "Try some simple demo applications:" { $code "\"demos\" run" } "Then look at the source code in " { $snippet "extra/" } "." ; TIP: "Try some simple demo applications:" { $code "\"demos\" run" } "Then look at the source code in " { $snippet "extra/" } "." ;
@ -42,7 +42,7 @@ ARTICLE: "all-tips-of-the-day" "All tips of the day"
ARTICLE: "tips-of-the-day" "Tips of the day" ARTICLE: "tips-of-the-day" "Tips of the day"
"The " { $vocab-link "help.tips" } " vocabulary provides a facility for displaying tips of the day in the " { $link "ui-listener" } ". Tips are defined with a parsing word:" "The " { $vocab-link "help.tips" } " vocabulary provides a facility for displaying tips of the day in the " { $link "ui-listener" } ". Tips are defined with a parsing word:"
{ $subsections POSTPONE: TIP: } { $subsections postpone: TIP: }
"All tips defined so far:" "All tips defined so far:"
{ $subsections "all-tips-of-the-day" } ; { $subsections "all-tips-of-the-day" } ;

View File

@ -34,7 +34,7 @@ $nl
"IN: palindrome" "IN: palindrome"
} }
$nl $nl
"Notice that the file ends with an " { $link POSTPONE: IN: } " form telling Factor that all definitions in this source file should go into the " { $snippet "palindrome" } " vocabulary using the " { $link POSTPONE: IN: } " word. We will be adding new definitions after the " { $link POSTPONE: IN: } " form." "Notice that the file ends with an " { $link postpone: IN: } " form telling Factor that all definitions in this source file should go into the " { $snippet "palindrome" } " vocabulary using the " { $link postpone: IN: } " word. We will be adding new definitions after the " { $link postpone: IN: } " form."
$nl $nl
"In order to be able to call the words defined in the " { $snippet "palindrome" } " vocabulary, you need to issue the following command in the listener:" "In order to be able to call the words defined in the " { $snippet "palindrome" } " vocabulary, you need to issue the following command in the listener:"
{ $code "USE: palindrome" } { $code "USE: palindrome" }
@ -42,7 +42,7 @@ $nl
"Now, we will be making some additions to the file. Since the file was loaded by the scaffold tool in the previous step, you need to tell Factor to reload it if it changes. Factor has a handy feature for this; pressing " { $command tool "common" refresh-all } " in the listener window will reload any changed source files. You can also force a single vocabulary to reload, in case the refresh feature does not pick up changes from disk:" "Now, we will be making some additions to the file. Since the file was loaded by the scaffold tool in the previous step, you need to tell Factor to reload it if it changes. Factor has a handy feature for this; pressing " { $command tool "common" refresh-all } " in the listener window will reload any changed source files. You can also force a single vocabulary to reload, in case the refresh feature does not pick up changes from disk:"
{ $code "\"palindrome\" reload" } { $code "\"palindrome\" reload" }
$nl $nl
"We will now write our first word using " { $link POSTPONE: : } ". This word will test if a string is a palindrome; it will take a string as input, and give back a boolean as output. We will call this word " { $snippet "palindrome?" } ", following a naming convention that words returning booleans have names ending with " { $snippet "?" } "." "We will now write our first word using " { $link postpone: : } ". This word will test if a string is a palindrome; it will take a string as input, and give back a boolean as output. We will call this word " { $snippet "palindrome?" } ", following a naming convention that words returning booleans have names ending with " { $snippet "?" } "."
$nl $nl
"Recall that a string is a palindrome if it is spelled the same forwards or backwards; that is, if the string is equal to its reverse. We can express this in Factor as follows:" "Recall that a string is a palindrome if it is spelled the same forwards or backwards; that is, if the string is equal to its reverse. We can express this in Factor as follows:"
{ $code ": palindrome? ( string -- ? ) dup reverse = ;" } { $code ": palindrome? ( string -- ? ) dup reverse = ;" }
@ -101,7 +101,7 @@ $nl
$nl $nl
"Now, open the file named " { $snippet "palindrome-tests.factor" } "; it is located in the same directory as " { $snippet "palindrome.factor" } ", and it was created by the scaffold tool." "Now, open the file named " { $snippet "palindrome-tests.factor" } "; it is located in the same directory as " { $snippet "palindrome.factor" } ", and it was created by the scaffold tool."
$nl $nl
"We will add some unit tests, which are similar to the interactive tests we did above. Unit tests are defined with the " { $link POSTPONE: unit-test } " word, which takes a sequence of expected outputs, and a piece of code. It runs the code, and asserts that it outputs the expected values." "We will add some unit tests, which are similar to the interactive tests we did above. Unit tests are defined with the " { $link postpone: unit-test } " word, which takes a sequence of expected outputs, and a piece of code. It runs the code, and asserts that it outputs the expected values."
$nl $nl
"Add the following two lines to " { $snippet "palindrome-tests.factor" } ":" "Add the following two lines to " { $snippet "palindrome-tests.factor" } ":"
{ $code { $code
@ -142,7 +142,7 @@ $nl
"We begin by writing a word which removes blanks and non-alphabetical characters from a string, and then converts the string to lower case. We call this word " { $snippet "normalize" } ". To figure out how to write this word, we begin with some interactive experimentation in the listener." "We begin by writing a word which removes blanks and non-alphabetical characters from a string, and then converts the string to lower case. We call this word " { $snippet "normalize" } ". To figure out how to write this word, we begin with some interactive experimentation in the listener."
$nl $nl
"Start by pushing a character on the stack; notice that characters are really just integers:" "Start by pushing a character on the stack; notice that characters are really just integers:"
{ $code "CHAR: a" } { $code "char: a" }
$nl $nl
"Now, use the " { $link Letter? } " word to test if it is an alphabetical character, upper or lower case:" "Now, use the " { $link Letter? } " word to test if it is an alphabetical character, upper or lower case:"
{ $unchecked-example "Letter? ." "t" } { $unchecked-example "Letter? ." "t" }
@ -151,7 +151,7 @@ $nl
"This gives the expected result." "This gives the expected result."
$nl $nl
"Now try with a non-alphabetical character:" "Now try with a non-alphabetical character:"
{ $code "CHAR: #" } { $code "char: #" }
{ $unchecked-example "Letter? ." "f" } { $unchecked-example "Letter? ." "f" }
$nl $nl
"What we want to do is given a string, remove all characters which do not match the " { $link Letter? } " predicate. Let's push a string on the stack:" "What we want to do is given a string, remove all characters which do not match the " { $link Letter? } " predicate. Let's push a string on the stack:"

View File

@ -21,7 +21,7 @@ HELP: words.
HELP: about HELP: about
{ $values { "vocab" "a vocabulary specifier" } } { $values { "vocab" "a vocabulary specifier" } }
{ $description { $description
"Displays the main help article for the vocabulary. The main help article is set with the " { $link POSTPONE: ABOUT: } " parsing word." "Displays the main help article for the vocabulary. The main help article is set with the " { $link postpone: ABOUT: } " parsing word."
} ; } ;
ARTICLE: "browsing-help" "Browsing documentation" ARTICLE: "browsing-help" "Browsing documentation"

View File

@ -11,7 +11,7 @@ $nl
"In some cases, specialization will not help at all, and can make generated code slower from the increase in code size. The compiler is capable of inferring enough static type information to generate efficient code in many cases without explicit help from the programmer. Specializers should be used as a last resort, after profiling shows that a critical loop makes a lot of repeated calls to generic words which dispatch on the same class." "In some cases, specialization will not help at all, and can make generated code slower from the increase in code size. The compiler is capable of inferring enough static type information to generate efficient code in many cases without explicit help from the programmer. Specializers should be used as a last resort, after profiling shows that a critical loop makes a lot of repeated calls to generic words which dispatch on the same class."
$nl $nl
"Type hints are declared with a parsing word:" "Type hints are declared with a parsing word:"
{ $subsections POSTPONE: HINTS: } { $subsections postpone: HINTS: }
"The specialized version of a word which will be compiled by the compiler can be inspected:" "The specialized version of a word which will be compiled by the compiler can be inspected:"
{ $subsections specialized-def } ; { $subsections specialized-def } ;

View File

@ -14,7 +14,7 @@ IN: html.streams.tests
] unit-test ] unit-test
{ "a" } [ { "a" } [
[ CHAR: a write1 ] make-html-string [ char: a write1 ] make-html-string
] unit-test ] unit-test
{ "&lt;" } [ { "&lt;" } [

View File

@ -36,7 +36,7 @@ TUPLE: html-sub-stream < html-writer style parent ;
: hex-color, ( color -- ) : hex-color, ( color -- )
[ red>> ] [ green>> ] [ blue>> ] tri [ red>> ] [ green>> ] [ blue>> ] tri
[ 255 * >integer >hex 2 CHAR: 0 pad-head % ] tri@ ; [ 255 * >integer >hex 2 char: 0 pad-head % ] tri@ ;
: fg-css, ( color -- ) : fg-css, ( color -- )
"color: #" % hex-color, "; " % ; "color: #" % hex-color, "; " % ;

View File

@ -36,7 +36,7 @@ HELP: reset-cache
{ $description "Resets the compiled template cache. Chloe automatically recompiles templates when their file changes on disk, however other when redefining Chloe tags or words which they call, the cache may have to be reset manually for the changes to take effect." } ; { $description "Resets the compiled template cache. Chloe automatically recompiles templates when their file changes on disk, however other when redefining Chloe tags or words which they call, the cache may have to be reset manually for the changes to take effect." } ;
HELP: tag-stack HELP: tag-stack
{ $var-description "During template compilation, holds the current nesting of XML element names. Can be used from " { $link POSTPONE: CHLOE: } " definitions to make a custom tag behave differently depending on how it is nested." } ; { $var-description "During template compilation, holds the current nesting of XML element names. Can be used from " { $link postpone: CHLOE: } " definitions to make a custom tag behave differently depending on how it is nested." } ;
HELP: [write] HELP: [write]
{ $values { "string" string } } { $values { "string" string } }
@ -194,8 +194,8 @@ $nl
ARTICLE: "html.templates.chloe.extend.tags" "Extending Chloe with custom tags" ARTICLE: "html.templates.chloe.extend.tags" "Extending Chloe with custom tags"
"Syntax for defining custom tags:" "Syntax for defining custom tags:"
{ $subsections POSTPONE: CHLOE: } { $subsections postpone: CHLOE: }
"A number of compiler words can be used from the " { $link POSTPONE: CHLOE: } " body to emit compiled template code." "A number of compiler words can be used from the " { $link postpone: CHLOE: } " body to emit compiled template code."
$nl $nl
"Extracting attributes from the XML tag:" "Extracting attributes from the XML tag:"
{ $subsections { $subsections
@ -226,7 +226,7 @@ ARTICLE: "html.templates.chloe.extend.tags.example" "Examples of custom Chloe ta
} }
"The " { $snippet "t:min" } " and " { $snippet "t:max" } " parameters are required, and " { $snippet "t:generator" } ", which can equal one of " { $snippet "default" } ", " { $snippet "system" } " or " { $snippet "secure" } ", is optional, with the default being " { $snippet "default" } "." "The " { $snippet "t:min" } " and " { $snippet "t:max" } " parameters are required, and " { $snippet "t:generator" } ", which can equal one of " { $snippet "default" } ", " { $snippet "system" } " or " { $snippet "secure" } ", is optional, with the default being " { $snippet "default" } "."
$nl $nl
"Here is the " { $link POSTPONE: USING: } " form that we need for the below code to work:" "Here is the " { $link postpone: USING: } " form that we need for the below code to work:"
{ $code { $code
"USING: combinators kernel math.parser math.ranges random" "USING: combinators kernel math.parser math.ranges random"
"html.templates.chloe.compiler html.templates.chloe.syntax ;" "html.templates.chloe.compiler html.templates.chloe.syntax ;"
@ -283,7 +283,7 @@ ARTICLE: "html.templates.chloe.extend.components.example" "An example of a custo
ARTICLE: "html.templates.chloe.extend.components" "Extending Chloe with custom components" ARTICLE: "html.templates.chloe.extend.components" "Extending Chloe with custom components"
"Custom HTML components implementing the " { $link render* } " word can be wired up with Chloe using the following syntax from " { $vocab-link "html.templates.chloe.components" } ":" "Custom HTML components implementing the " { $link render* } " word can be wired up with Chloe using the following syntax from " { $vocab-link "html.templates.chloe.components" } ":"
{ $subsections { $subsections
POSTPONE: COMPONENT: postpone: COMPONENT:
"html.templates.chloe.extend.components.example" "html.templates.chloe.extend.components.example"
} ; } ;

View File

@ -10,7 +10,7 @@ IN: html.templates.chloe.tests
: run-template ( quot -- string ) : run-template ( quot -- string )
with-string-writer [ "\r\n\t" member? ] reject with-string-writer [ "\r\n\t" member? ] reject
[ CHAR: \s = ] trim ; inline [ char: \s = ] trim ; inline
: test-template ( name -- template ) : test-template ( name -- template )
"vocab:html/templates/chloe/test/" "vocab:html/templates/chloe/test/"

View File

@ -16,7 +16,7 @@ TUPLE: template-lexer < lexer ;
M: template-lexer skip-word M: template-lexer skip-word
[ [
{ {
{ [ 2dup nth CHAR: \" = ] [ drop 1 + ] } { [ 2dup nth char: \" = ] [ drop 1 + ] }
{ [ 2dup swap tail-slice "%>" head? ] [ drop 2 + ] } { [ 2dup swap tail-slice "%>" head? ] [ drop 2 + ] }
[ f skip ] [ f skip ]
} cond } cond

View File

@ -97,7 +97,7 @@ PEG: parse-response-line ( string -- triple )
[ " \t" member? ] satisfy repeat1 ; [ " \t" member? ] satisfy repeat1 ;
: qdtext-parser ( -- parser ) : qdtext-parser ( -- parser )
{ [ CHAR: \" = ] [ control? ] } except-these ; { [ char: \" = ] [ control? ] } except-these ;
: quoted-char-parser ( -- parser ) : quoted-char-parser ( -- parser )
"\\" token hide any-char 2seq ; "\\" token hide any-char 2seq ;

View File

@ -7,6 +7,6 @@ HELP: filter-responder
ARTICLE: "http.server.filters" "HTTP responder filters" ARTICLE: "http.server.filters" "HTTP responder filters"
"The " { $vocab-link "http.server.filters" } " vocabulary implements the common pattern where one responder wraps another, doing some processing before calling the wrapped responder." "The " { $vocab-link "http.server.filters" } " vocabulary implements the common pattern where one responder wraps another, doing some processing before calling the wrapped responder."
{ $subsections filter-responder } { $subsections filter-responder }
"To use it, simply subclass " { $link filter-responder } ", and call " { $link POSTPONE: call-next-method } " from your " { $link call-responder* } " method to pass control to the wrapped responder." ; "To use it, simply subclass " { $link filter-responder } ", and call " { $link postpone: call-next-method } " from your " { $link call-responder* } " method to pass control to the wrapped responder." ;
ABOUT: "http.server.filters" ABOUT: "http.server.filters"

View File

@ -147,7 +147,7 @@ M: stdin dispose*
] with-destructors ; ] with-destructors ;
: wait-for-stdin ( stdin -- size ) : wait-for-stdin ( stdin -- size )
[ control>> CHAR: X over io:stream-write1 io:stream-flush ] [ control>> char: X over io:stream-write1 io:stream-flush ]
[ size>> ssize_t heap-size swap io:stream-read ssize_t deref ] [ size>> ssize_t heap-size swap io:stream-read ssize_t deref ]
bi ; bi ;

View File

@ -44,7 +44,7 @@ io.buffers kernel libc namespaces sequences strings tools.test ;
dup buffer-read-all >string swap dispose dup buffer-read-all >string swap dispose
] unit-test ] unit-test
{ CHAR: e } [ { char: e } [
"hello" string>buffer "hello" string>buffer
1 over buffer-consume [ buffer-pop ] keep dispose 1 over buffer-consume [ buffer-pop ] keep dispose
] unit-test ] unit-test
@ -58,11 +58,11 @@ io.buffers kernel libc namespaces sequences strings tools.test ;
"b" get dispose "b" get dispose
"hello world" string>buffer "b" set "hello world" string>buffer "b" set
{ "hello" CHAR: \s } [ " " "b" get buffer-read-until [ >string ] dip ] unit-test { "hello" char: \s } [ " " "b" get buffer-read-until [ >string ] dip ] unit-test
"b" get dispose "b" get dispose
"hello world" string>buffer "b" set "hello world" string>buffer "b" set
{ "hello worl" CHAR: d } [ "d" "b" get buffer-read-until [ >string ] dip ] unit-test { "hello worl" char: d } [ "d" "b" get buffer-read-until [ >string ] dip ] unit-test
"b" get dispose "b" get dispose
"hello world" string>buffer "b" set "hello world" string>buffer "b" set

View File

@ -8,14 +8,14 @@ IN: io.crlf
: read-crlf ( -- seq ) : read-crlf ( -- seq )
"\r" read-until "\r" read-until
[ CHAR: \r assert= read1 CHAR: \n assert= ] [ f like ] if* ; [ char: \r assert= read1 char: \n assert= ] [ f like ] if* ;
: read-?crlf ( -- seq ) : read-?crlf ( -- seq )
"\r\n" read-until "\r\n" read-until
[ CHAR: \r = [ read1 CHAR: \n assert= ] when ] [ f like ] if* ; [ char: \r = [ read1 char: \n assert= ] when ] [ f like ] if* ;
: crlf>lf ( str -- str' ) : crlf>lf ( str -- str' )
CHAR: \r swap remove ; char: \r swap remove ;
: lf>crlf ( str -- str' ) : lf>crlf ( str -- str' )
"\n" split "\r\n" join ; "\n" split "\r\n" join ;

View File

@ -3,12 +3,12 @@ io.encodings.8-bit.private tools.test strings arrays
io.encodings.8-bit.latin1 io.encodings.8-bit.windows-1252 ; io.encodings.8-bit.latin1 io.encodings.8-bit.windows-1252 ;
IN: io.encodings.8-bit.tests IN: io.encodings.8-bit.tests
{ B{ CHAR: f CHAR: o CHAR: o } } [ "foo" latin1 encode ] unit-test { B{ char: f char: o char: o } } [ "foo" latin1 encode ] unit-test
[ { 256 } >string latin1 encode ] must-fail [ { 256 } >string latin1 encode ] must-fail
{ B{ 255 } } [ { 255 } >string latin1 encode ] unit-test { B{ 255 } } [ { 255 } >string latin1 encode ] unit-test
{ "bar" } [ "bar" latin1 decode ] unit-test { "bar" } [ "bar" latin1 decode ] unit-test
{ { CHAR: b 233 CHAR: r } } [ B{ CHAR: b 233 CHAR: r } latin1 decode >array ] unit-test { { char: b 233 char: r } } [ B{ char: b 233 char: r } latin1 decode >array ] unit-test
{ { 0xfffd 0x20AC } } [ B{ 0x81 0x80 } windows-1252 decode >array ] unit-test { { 0xfffd 0x20AC } } [ B{ 0x81 0x80 } windows-1252 decode >array ] unit-test
{ t } [ \ latin1 8-bit-encoding? ] unit-test { t } [ \ latin1 8-bit-encoding? ] unit-test

View File

@ -47,4 +47,4 @@ IN: io.encodings.euc.tests
{ t } [ phrase-euc-kr 3 head* euc-kr decode phrase-unicode 2 head* = ] unit-test { t } [ phrase-euc-kr 3 head* euc-kr decode phrase-unicode 2 head* = ] unit-test
{ t } [ phrase-euc-kr 2 head* euc-kr decode phrase-unicode 2 head* CHAR: replacement-character suffix = ] unit-test { t } [ phrase-euc-kr 2 head* euc-kr decode phrase-unicode 2 head* char: replacement-character suffix = ] unit-test

View File

@ -9,15 +9,15 @@ IN: io.encodings.gb18030.tests
[ B{ 0xB7 0xB8 } >string gb18030 encode ] unit-test [ B{ 0xB7 0xB8 } >string gb18030 encode ] unit-test
{ { 0xB7 0xB8 } } { { 0xB7 0xB8 } }
[ B{ 0xA1 0xA4 0x81 0x30 0x86 0x30 } gb18030 decode >array ] unit-test [ B{ 0xA1 0xA4 0x81 0x30 0x86 0x30 } gb18030 decode >array ] unit-test
{ { 0xB7 CHAR: replacement-character } } { { 0xB7 char: replacement-character } }
[ B{ 0xA1 0xA4 0x81 0x30 0x86 } gb18030 decode >array ] unit-test [ B{ 0xA1 0xA4 0x81 0x30 0x86 } gb18030 decode >array ] unit-test
{ { 0xB7 CHAR: replacement-character } } { { 0xB7 char: replacement-character } }
[ B{ 0xA1 0xA4 0x81 0x30 } gb18030 decode >array ] unit-test [ B{ 0xA1 0xA4 0x81 0x30 } gb18030 decode >array ] unit-test
{ { 0xB7 CHAR: replacement-character } } { { 0xB7 char: replacement-character } }
[ B{ 0xA1 0xA4 0x81 } gb18030 decode >array ] unit-test [ B{ 0xA1 0xA4 0x81 } gb18030 decode >array ] unit-test
{ { 0xB7 } } { { 0xB7 } }
[ B{ 0xA1 0xA4 } gb18030 decode >array ] unit-test [ B{ 0xA1 0xA4 } gb18030 decode >array ] unit-test
{ { CHAR: replacement-character } } { { char: replacement-character } }
[ B{ 0xA1 } >string gb18030 decode >array ] unit-test [ B{ 0xA1 } >string gb18030 decode >array ] unit-test
{ { 0x44D7 0x464B } } { { 0x44D7 0x464B } }
[ B{ 0x82 0x33 0xA3 0x39 0x82 0x33 0xC9 0x31 } [ B{ 0x82 0x33 0xA3 0x39 0x82 0x33 0xC9 0x31 }

View File

@ -7,30 +7,30 @@ IN: io.encodings.iso2022
{ "hello" } [ "hello" >byte-array iso2022 decode ] unit-test { "hello" } [ "hello" >byte-array iso2022 decode ] unit-test
{ "hello" } [ "hello" iso2022 encode >string ] unit-test { "hello" } [ "hello" iso2022 encode >string ] unit-test
{ "hi" } [ B{ CHAR: h $ ESC CHAR: \( CHAR: B CHAR: i } iso2022 decode ] unit-test { "hi" } [ B{ char: h $ ESC char: \( char: B char: i } iso2022 decode ] unit-test
{ "hi" } [ B{ CHAR: h CHAR: i $ ESC CHAR: \( CHAR: B } iso2022 decode ] unit-test { "hi" } [ B{ char: h char: i $ ESC char: \( char: B } iso2022 decode ] unit-test
{ "hi\u00fffd" } [ B{ CHAR: h CHAR: i $ ESC CHAR: \( } iso2022 decode ] unit-test { "hi\u00fffd" } [ B{ char: h char: i $ ESC char: \( } iso2022 decode ] unit-test
{ "hi\u00fffd" } [ B{ CHAR: h CHAR: i $ ESC } iso2022 decode ] unit-test { "hi\u00fffd" } [ B{ char: h char: i $ ESC } iso2022 decode ] unit-test
{ B{ CHAR: h $ ESC CHAR: \( CHAR: J 0xD8 } } [ "h\u00ff98" iso2022 encode ] unit-test { B{ char: h $ ESC char: \( char: J 0xD8 } } [ "h\u00ff98" iso2022 encode ] unit-test
{ "h\u00ff98" } [ B{ CHAR: h $ ESC CHAR: \( CHAR: J 0xD8 } iso2022 decode ] unit-test { "h\u00ff98" } [ B{ char: h $ ESC char: \( char: J 0xD8 } iso2022 decode ] unit-test
{ "hi" } [ B{ CHAR: h $ ESC CHAR: \( CHAR: J CHAR: i } iso2022 decode ] unit-test { "hi" } [ B{ char: h $ ESC char: \( char: J char: i } iso2022 decode ] unit-test
{ "h" } [ B{ CHAR: h $ ESC CHAR: \( CHAR: J } iso2022 decode ] unit-test { "h" } [ B{ char: h $ ESC char: \( char: J } iso2022 decode ] unit-test
{ "h\u00fffd" } [ B{ CHAR: h $ ESC CHAR: \( CHAR: J 0x80 } iso2022 decode ] unit-test { "h\u00fffd" } [ B{ char: h $ ESC char: \( char: J 0x80 } iso2022 decode ] unit-test
{ B{ CHAR: h $ ESC CHAR: $ CHAR: B 0x3E 0x47 } } [ "h\u007126" iso2022 encode ] unit-test { B{ char: h $ ESC char: $ char: B 0x3E 0x47 } } [ "h\u007126" iso2022 encode ] unit-test
{ "h\u007126" } [ B{ CHAR: h $ ESC CHAR: $ CHAR: B 0x3E 0x47 } iso2022 decode ] unit-test { "h\u007126" } [ B{ char: h $ ESC char: $ char: B 0x3E 0x47 } iso2022 decode ] unit-test
{ "h\u00fffd" } [ B{ CHAR: h $ ESC CHAR: $ CHAR: B 0x3E } iso2022 decode ] unit-test { "h\u00fffd" } [ B{ char: h $ ESC char: $ char: B 0x3E } iso2022 decode ] unit-test
{ "h" } [ B{ CHAR: h $ ESC CHAR: $ CHAR: B } iso2022 decode ] unit-test { "h" } [ B{ char: h $ ESC char: $ char: B } iso2022 decode ] unit-test
{ "h\u00fffd" } [ B{ CHAR: h $ ESC CHAR: $ } iso2022 decode ] unit-test { "h\u00fffd" } [ B{ char: h $ ESC char: $ } iso2022 decode ] unit-test
{ "h\u00fffd" } [ B{ CHAR: h $ ESC } iso2022 decode ] unit-test { "h\u00fffd" } [ B{ char: h $ ESC } iso2022 decode ] unit-test
{ "h\u00fffd" } [ B{ CHAR: h $ ESC CHAR: $ CHAR: B 0x80 0x80 } iso2022 decode ] unit-test { "h\u00fffd" } [ B{ char: h $ ESC char: $ char: B 0x80 0x80 } iso2022 decode ] unit-test
{ B{ CHAR: h $ ESC CHAR: $ CHAR: \( CHAR: D 0x38 0x54 } } [ "h\u0058ce" iso2022 encode ] unit-test { B{ char: h $ ESC char: $ char: \( char: D 0x38 0x54 } } [ "h\u0058ce" iso2022 encode ] unit-test
{ "h\u0058ce" } [ B{ CHAR: h $ ESC CHAR: $ CHAR: \( CHAR: D 0x38 0x54 } iso2022 decode ] unit-test { "h\u0058ce" } [ B{ char: h $ ESC char: $ char: \( char: D 0x38 0x54 } iso2022 decode ] unit-test
{ "h\u00fffd" } [ B{ CHAR: h $ ESC CHAR: $ CHAR: \( CHAR: D 0x38 } iso2022 decode ] unit-test { "h\u00fffd" } [ B{ char: h $ ESC char: $ char: \( char: D 0x38 } iso2022 decode ] unit-test
{ "h" } [ B{ CHAR: h $ ESC CHAR: $ CHAR: \( CHAR: D } iso2022 decode ] unit-test { "h" } [ B{ char: h $ ESC char: $ char: \( char: D } iso2022 decode ] unit-test
{ "h\u00fffd" } [ B{ CHAR: h $ ESC CHAR: $ CHAR: \( } iso2022 decode ] unit-test { "h\u00fffd" } [ B{ char: h $ ESC char: $ char: \( } iso2022 decode ] unit-test
{ "h\u00fffd" } [ B{ CHAR: h $ ESC CHAR: $ CHAR: \( CHAR: D 0x70 0x70 } iso2022 decode ] unit-test { "h\u00fffd" } [ B{ char: h $ ESC char: $ char: \( char: D 0x70 0x70 } iso2022 decode ] unit-test
[ "\u{syriac-music}" iso2022 encode ] must-fail [ "\u{syriac-music}" iso2022 encode ] must-fail

View File

@ -33,10 +33,10 @@ M: iso2022 <decoder>
CONSTANT: ESC 0x16 CONSTANT: ESC 0x16
CONSTANT: switch-ascii B{ $ ESC CHAR: \( CHAR: B } CONSTANT: switch-ascii B{ $ ESC char: \( char: B }
CONSTANT: switch-jis201 B{ $ ESC CHAR: \( CHAR: J } CONSTANT: switch-jis201 B{ $ ESC char: \( char: J }
CONSTANT: switch-jis208 B{ $ ESC CHAR: $ CHAR: B } CONSTANT: switch-jis208 B{ $ ESC char: $ char: B }
CONSTANT: switch-jis212 B{ $ ESC CHAR: $ CHAR: \( CHAR: D } CONSTANT: switch-jis212 B{ $ ESC char: $ char: \( char: D }
: find-type ( char -- code type ) : find-type ( char -- code type )
{ {
@ -62,19 +62,19 @@ M:: iso2022-state encode-char ( char stream encoding -- )
: read-escape ( stream -- type/f ) : read-escape ( stream -- type/f )
dup stream-read1 { dup stream-read1 {
{ CHAR: \( [ { char: \( [
stream-read1 { stream-read1 {
{ CHAR: B [ ascii get-global ] } { char: B [ ascii get-global ] }
{ CHAR: J [ jis201 get-global ] } { char: J [ jis201 get-global ] }
[ drop f ] [ drop f ]
} case } case
] } ] }
{ CHAR: $ [ { char: $ [
dup stream-read1 { dup stream-read1 {
{ CHAR: @ [ drop jis208 get-global ] } ! want: JIS X 0208-1978 { char: @ [ drop jis208 get-global ] } ! want: JIS X 0208-1978
{ CHAR: B [ drop jis208 get-global ] } { char: B [ drop jis208 get-global ] }
{ CHAR: \( [ { char: \( [
stream-read1 CHAR: D = jis212 get-global f ? stream-read1 char: D = jis212 get-global f ?
] } ] }
[ 2drop f ] [ 2drop f ]
} case } case

View File

@ -3,15 +3,15 @@
USING: io.encodings.shift-jis tools.test io.encodings.string arrays strings ; USING: io.encodings.shift-jis tools.test io.encodings.string arrays strings ;
IN: io.encodings.shift-jis.tests IN: io.encodings.shift-jis.tests
{ { CHAR: replacement-character } } [ { 141 } shift-jis decode >array ] unit-test { { char: replacement-character } } [ { 141 } shift-jis decode >array ] unit-test
{ "" } [ "" shift-jis decode >string ] unit-test { "" } [ "" shift-jis decode >string ] unit-test
{ "" } [ "" shift-jis encode >string ] unit-test { "" } [ "" shift-jis encode >string ] unit-test
[ { CHAR: replacement-character } shift-jis encode ] must-fail [ { char: replacement-character } shift-jis encode ] must-fail
{ "ab¥ィ" } [ { CHAR: a CHAR: b 0x5C 0xA8 } shift-jis decode ] unit-test { "ab¥ィ" } [ { char: a char: b 0x5C 0xA8 } shift-jis decode ] unit-test
{ { CHAR: a CHAR: b 0x5C 0xA8 } } [ "ab¥ィ" shift-jis encode >array ] unit-test { { char: a char: b 0x5C 0xA8 } } [ "ab¥ィ" shift-jis encode >array ] unit-test
{ "ab\\ィ" } [ { CHAR: a CHAR: b 0x5C 0xA8 } windows-31j decode ] unit-test { "ab\\ィ" } [ { char: a char: b 0x5C 0xA8 } windows-31j decode ] unit-test
{ { CHAR: a CHAR: b 0x5C 0xA8 } } [ "ab\\ィ" windows-31j encode >array ] unit-test { { char: a char: b 0x5C 0xA8 } } [ "ab\\ィ" windows-31j encode >array ] unit-test
{ "\u000081\u0000c8" } [ CHAR: logical-and 1string windows-31j encode >string ] unit-test { "\u000081\u0000c8" } [ char: logical-and 1string windows-31j encode >string ] unit-test
{ "\u000081\u0000c8" } [ CHAR: logical-and 1string shift-jis encode >string ] unit-test { "\u000081\u0000c8" } [ char: logical-and 1string shift-jis encode >string ] unit-test
{ { CHAR: logical-and } } [ "\u000081\u0000c8" windows-31j decode >array ] unit-test { { char: logical-and } } [ "\u000081\u0000c8" windows-31j decode >array ] unit-test
{ { CHAR: logical-and } } [ "\u000081\u0000c8" shift-jis decode >array ] unit-test { { char: logical-and } } [ "\u000081\u0000c8" shift-jis decode >array ] unit-test

View File

@ -5,25 +5,25 @@ io.streams.byte-array sequences io.encodings io strings
io.encodings.string alien.c-types alien.strings accessors classes ; io.encodings.string alien.c-types alien.strings accessors classes ;
IN: io.encodings.utf32.tests IN: io.encodings.utf32.tests
{ { CHAR: x } } [ B{ 0 0 0 CHAR: x } utf32be decode >array ] unit-test { { char: x } } [ B{ 0 0 0 char: x } utf32be decode >array ] unit-test
{ { 0x1D11E } } [ B{ 0 1 0xD1 0x1E } utf32be decode >array ] unit-test { { 0x1D11E } } [ B{ 0 1 0xD1 0x1E } utf32be decode >array ] unit-test
{ { CHAR: replacement-character } } [ B{ 0 1 0xD1 } utf32be decode >array ] unit-test { { char: replacement-character } } [ B{ 0 1 0xD1 } utf32be decode >array ] unit-test
{ { CHAR: replacement-character } } [ B{ 0 1 } utf32be decode >array ] unit-test { { char: replacement-character } } [ B{ 0 1 } utf32be decode >array ] unit-test
{ { CHAR: replacement-character } } [ B{ 0 } utf32be decode >array ] unit-test { { char: replacement-character } } [ B{ 0 } utf32be decode >array ] unit-test
{ { } } [ { } utf32be decode >array ] unit-test { { } } [ { } utf32be decode >array ] unit-test
{ B{ 0 0 0 CHAR: x 0 1 0xD1 0x1E } } [ { CHAR: x 0x1d11e } >string utf32be encode ] unit-test { B{ 0 0 0 char: x 0 1 0xD1 0x1E } } [ { char: x 0x1d11e } >string utf32be encode ] unit-test
{ { CHAR: x } } [ B{ CHAR: x 0 0 0 } utf32le decode >array ] unit-test { { char: x } } [ B{ char: x 0 0 0 } utf32le decode >array ] unit-test
{ { 0x1d11e } } [ B{ 0x1e 0xd1 1 0 } utf32le decode >array ] unit-test { { 0x1d11e } } [ B{ 0x1e 0xd1 1 0 } utf32le decode >array ] unit-test
{ { CHAR: replacement-character } } [ B{ 0x1e 0xd1 1 } utf32le decode >array ] unit-test { { char: replacement-character } } [ B{ 0x1e 0xd1 1 } utf32le decode >array ] unit-test
{ { CHAR: replacement-character } } [ B{ 0x1e 0xd1 } utf32le decode >array ] unit-test { { char: replacement-character } } [ B{ 0x1e 0xd1 } utf32le decode >array ] unit-test
{ { CHAR: replacement-character } } [ B{ 0x1e } utf32le decode >array ] unit-test { { char: replacement-character } } [ B{ 0x1e } utf32le decode >array ] unit-test
{ { } } [ { } utf32le decode >array ] unit-test { { } } [ { } utf32le decode >array ] unit-test
{ B{ 120 0 0 0 0x1e 0xd1 1 0 } } [ { CHAR: x 0x1d11e } >string utf32le encode ] unit-test { B{ 120 0 0 0 0x1e 0xd1 1 0 } } [ { char: x 0x1d11e } >string utf32le encode ] unit-test
{ { CHAR: x } } [ B{ 0xff 0xfe 0 0 CHAR: x 0 0 0 } utf32 decode >array ] unit-test { { char: x } } [ B{ 0xff 0xfe 0 0 char: x 0 0 0 } utf32 decode >array ] unit-test
{ { CHAR: x } } [ B{ 0 0 0xfe 0xff 0 0 0 CHAR: x } utf32 decode >array ] unit-test { { char: x } } [ B{ 0 0 0xfe 0xff 0 0 0 char: x } utf32 decode >array ] unit-test
{ B{ 0xff 0xfe 0 0 120 0 0 0 0x1e 0xd1 1 0 } } [ { CHAR: x 0x1d11e } >string utf32 encode ] unit-test { B{ 0xff 0xfe 0 0 120 0 0 0 0x1e 0xd1 1 0 } } [ { char: x 0x1d11e } >string utf32 encode ] unit-test

View File

@ -13,20 +13,20 @@ TUPLE: utf7codec dialect buffer ;
: utf7 ( -- utf7codec ) : utf7 ( -- utf7codec )
{ {
{ { } { } } { { } { } }
{ { CHAR: + } { CHAR: - } } { { char: + } { char: - } }
} V{ } utf7codec boa ; } V{ } utf7codec boa ;
: utf7imap4 ( -- utf7codec ) : utf7imap4 ( -- utf7codec )
{ {
{ { CHAR: / } { CHAR: , } } { { char: / } { char: , } }
{ { CHAR: & } { CHAR: - } } { { char: & } { char: - } }
} V{ } utf7codec boa ; } V{ } utf7codec boa ;
: >raw-base64 ( bytes -- bytes' ) : >raw-base64 ( bytes -- bytes' )
>string utf16be encode >base64 [ CHAR: = = ] trim-tail ; >string utf16be encode >base64 [ char: = = ] trim-tail ;
: raw-base64> ( str -- str' ) : raw-base64> ( str -- str' )
dup length 4 / ceiling 4 * CHAR: = pad-tail base64> utf16be decode ; dup length 4 / ceiling 4 * char: = pad-tail base64> utf16be decode ;
: encode-chunk ( repl-pair surround-pair chunk ascii? -- bytes ) : encode-chunk ( repl-pair surround-pair chunk ascii? -- bytes )
[ swap [ first ] [ concat ] bi replace nip ] [ swap [ first ] [ concat ] bi replace nip ]

View File

@ -65,7 +65,7 @@ frequency pass-number ;
} cleave ; } cleave ;
: parse-mtab ( -- array ) : parse-mtab ( -- array )
CHAR: \s [ "/etc/mtab" utf8 file>csv ] with-delimiter char: \s [ "/etc/mtab" utf8 file>csv ] with-delimiter
[ mtab-csv>mtab-entry ] map ; [ mtab-csv>mtab-entry ] map ;
: mtab-entry>file-system-info ( mtab-entry -- file-system-info/f ) : mtab-entry>file-system-info ( mtab-entry -- file-system-info/f )

View File

@ -242,26 +242,26 @@ M: string set-file-group ( path string -- )
: ch>file-type ( ch -- type ) : ch>file-type ( ch -- type )
{ {
{ CHAR: b [ +block-device+ ] } { char: b [ +block-device+ ] }
{ CHAR: c [ +character-device+ ] } { char: c [ +character-device+ ] }
{ CHAR: d [ +directory+ ] } { char: d [ +directory+ ] }
{ CHAR: l [ +symbolic-link+ ] } { char: l [ +symbolic-link+ ] }
{ CHAR: s [ +socket+ ] } { char: s [ +socket+ ] }
{ CHAR: p [ +fifo+ ] } { char: p [ +fifo+ ] }
{ CHAR: - [ +regular-file+ ] } { char: - [ +regular-file+ ] }
[ drop +unknown+ ] [ drop +unknown+ ]
} case ; } case ;
: file-type>ch ( type -- ch ) : file-type>ch ( type -- ch )
{ {
{ +block-device+ [ CHAR: b ] } { +block-device+ [ char: b ] }
{ +character-device+ [ CHAR: c ] } { +character-device+ [ char: c ] }
{ +directory+ [ CHAR: d ] } { +directory+ [ char: d ] }
{ +symbolic-link+ [ CHAR: l ] } { +symbolic-link+ [ char: l ] }
{ +socket+ [ CHAR: s ] } { +socket+ [ char: s ] }
{ +fifo+ [ CHAR: p ] } { +fifo+ [ char: p ] }
{ +regular-file+ [ CHAR: - ] } { +regular-file+ [ char: - ] }
[ drop CHAR: - ] [ drop char: - ]
} case ; } case ;
<PRIVATE <PRIVATE

View File

@ -147,7 +147,7 @@ ERROR: not-absolute-path ;
unicode-prefix ?head drop unicode-prefix ?head drop
dup { dup {
[ length 2 >= ] [ length 2 >= ]
[ second CHAR: \: = ] [ second char: \: = ]
[ first Letter? ] [ first Letter? ]
} 1&& [ 2 head "\\" append ] [ not-absolute-path ] if ; } 1&& [ 2 head "\\" append ] [ not-absolute-path ] if ;

View File

@ -7,7 +7,7 @@ IN: io.files.unique.tests
{ 123 } [ { 123 } [
[ [
"core" ".test" [ "core" ".test" [
[ [ 123 CHAR: a <string> ] dip ascii set-file-contents ] [ [ 123 char: a <string> ] dip ascii set-file-contents ]
[ file-info size>> ] bi [ file-info size>> ] bi
] cleanup-unique-file ] cleanup-unique-file
] with-temp-directory ] with-temp-directory

View File

@ -320,7 +320,7 @@ M: windows root-directory? ( path -- ? )
{ [ dup empty? ] [ drop f ] } { [ dup empty? ] [ drop f ] }
{ [ dup [ path-separator? ] all? ] [ drop t ] } { [ dup [ path-separator? ] all? ] [ drop t ] }
{ [ dup trim-tail-separators { [ length 2 = ] { [ dup trim-tail-separators { [ length 2 = ]
[ second CHAR: \: = ] } 1&& ] [ drop t ] } [ second char: \: = ] } 1&& ] [ drop t ] }
{ [ dup unicode-prefix head? ] { [ dup unicode-prefix head? ]
[ trim-tail-separators length unicode-prefix length 2 + = ] } [ trim-tail-separators length unicode-prefix length 2 + = ] }
[ drop f ] [ drop f ]

View File

@ -57,17 +57,17 @@ TUPLE: CreateProcess-args
: fix-trailing-backslashes ( str -- str' ) : fix-trailing-backslashes ( str -- str' )
0 count-trailing-backslashes 0 count-trailing-backslashes
2 * CHAR: \\ <repetition> append ; 2 * char: \\ <repetition> append ;
! Find groups of \, groups of \ followed by ", or naked " ! Find groups of \, groups of \ followed by ", or naked "
: escape-double-quote ( str -- newstr ) : escape-double-quote ( str -- newstr )
[ [
{ [ drop CHAR: \\ = ] [ nip "\\\"" member? ] } 2&& { [ drop char: \\ = ] [ nip "\\\"" member? ] } 2&&
] monotonic-split [ ] monotonic-split [
dup last CHAR: \" = [ dup last char: \" = [
dup length 1 > [ dup length 1 > [
! String of backslashes + double-quote ! String of backslashes + double-quote
length 1 - 2 * CHAR: \\ <repetition> "\\\"" append length 1 - 2 * char: \\ <repetition> "\\\"" append
] [ ] [
! Single double-quote ! Single double-quote
drop "\\\"" drop "\\\""
@ -81,7 +81,7 @@ TUPLE: CreateProcess-args
! See http://msdn.microsoft.com/en-us/library/ms647232.aspx ! See http://msdn.microsoft.com/en-us/library/ms647232.aspx
: escape-argument ( str -- newstr ) : escape-argument ( str -- newstr )
escape-double-quote escape-double-quote
CHAR: \s over member? [ char: \s over member? [
fix-trailing-backslashes "\"" dup surround fix-trailing-backslashes "\"" dup surround
] when ; ] when ;

View File

@ -69,7 +69,7 @@ ARTICLE: "io.mmap.arrays" "Working with memory-mapped data"
{ $subsections <mapped-array> } { $subsections <mapped-array> }
"Additionally, files may be opened with two combinators which take a c-type as input:" "Additionally, files may be opened with two combinators which take a c-type as input:"
{ $subsections with-mapped-array with-mapped-array-reader } { $subsections with-mapped-array with-mapped-array-reader }
"The appropriate specialized array type must first be generated with " { $link POSTPONE: SPECIALIZED-ARRAY: } "." "The appropriate specialized array type must first be generated with " { $link postpone: SPECIALIZED-ARRAY: } "."
$nl $nl
"Data can also be read and written from the " { $link mapped-file } " by applying low-level alien words to the " { $slot "address" } " slot. This approach is not recommended, though, since in most cases the compiler will generate efficient code for specialized array usage. See " { $link "reading-writing-memory" } " for a description of low-level memory access primitives." ; "Data can also be read and written from the " { $link mapped-file } " by applying low-level alien words to the " { $slot "address" } " slot. This approach is not recommended, though, since in most cases the compiler will generate efficient code for specialized array usage. See " { $link "reading-writing-memory" } " for a description of low-level memory access primitives." ;

Some files were not shown because too many files have changed in this diff Show More