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

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
basis/alien/c-types/c-types-docs.factor
View File

@ -65,7 +65,7 @@ HELP: longlong
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." } ;
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*
{ $description "This C type represents a generic pointer to C memory. See " { $link pointer } " for information on pointer C types." } ;
HELP: c-string
@ -84,7 +84,7 @@ HELP: pointer
$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."
$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 ": foo ( bar -- int* )
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 ( ) ;"
"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
"USING: alien.syntax math prettyprint ;"
"QUALIFIED-WITH: alien.c-types c"
@ -165,10 +165,10 @@ ARTICLE: "c-types-specs" "C type specifiers"
$nl
"Defining new C types:"
{ $subsections
POSTPONE: STRUCT:
POSTPONE: UNION-STRUCT:
POSTPONE: CALLBACK:
POSTPONE: TYPEDEF:
postpone: STRUCT:
postpone: UNION-STRUCT:
postpone: CALLBACK:
postpone: TYPEDEF:
}
"Getting the c-type of a class:"
{ $subsections lookup-c-type }

2
basis/alien/c-types/c-types.factor
View File

@ -503,7 +503,7 @@ M: double-2-rep rep-component-type drop double ;
GENERIC: pointer-string ( pointer -- string/f )
M: object pointer-string drop f ;
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 )

6
basis/alien/data/data-docs.factor
View File

@ -182,7 +182,7 @@ $nl
{ $subsections "alien.enums" }
"A utility for defining " { $link "destructors" } " for deallocating memory:"
{ $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
{ $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." } ;
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
"Using C string types triggers automatic conversions:"
{ $list
@ -211,7 +211,7 @@ $nl
"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." }
{ "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
"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."

2
basis/alien/destructors/destructors-docs.factor
View File

@ -25,6 +25,6 @@ HELP: DESTRUCTOR:
ARTICLE: "alien.destructors" "Alien destructors"
"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"

8
basis/alien/endian/endian-docs.factor
View File

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

4
basis/alien/enums/enums-docs.factor
View File

@ -7,7 +7,7 @@ HELP: define-enum
{ $values
{ "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
{ $values
@ -23,6 +23,6 @@ HELP: number>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"

2
basis/alien/libraries/finder/finder-docs.factor
View File

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

2
basis/alien/libraries/finder/linux/linux.factor
View File

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

6
basis/alien/libraries/libraries-docs.factor
View File

@ -6,10 +6,10 @@ IN: alien.libraries
HELP: add-library
{ $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."
$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
"For details about parse-time evaluation, see " { $link "syntax-immediate" } "." }
{ $examples "Here is a typical usage of " { $link add-library } ":"
@ -24,7 +24,7 @@ $nl
" [ drop ]"
"} cond >>"
}
"Note the parse time evaluation with " { $link POSTPONE: << } "." } ;
"Note the parse time evaluation with " { $link postpone: << } "." } ;
HELP: deploy-library
{ $values { "name" string } }

2
basis/alien/parser/parser.factor
View File

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

30
basis/alien/syntax/syntax-docs.factor
View File

@ -15,20 +15,20 @@ HELP: ALIEN:
ARTICLE: "syntax-aliens" "Alien object literal syntax"
{ $subsections
POSTPONE: ALIEN:
POSTPONE: DLL"
postpone: ALIEN:
postpone: DLL"
} ;
HELP: LIBRARY:
{ $syntax "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." } ;
HELP: FUNCTION:
{ $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, ..." } } }
{ $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
"The new word must be compiled before being executed." }
{ $examples
@ -45,18 +45,18 @@ $nl
"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."
{ $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:
{ $syntax "FUNCTION-ALIAS: factor-name
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, ..." } } }
{ $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
"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." } ;
{ POSTPONE: FUNCTION: POSTPONE: FUNCTION-ALIAS: } related-words
{ postpone: FUNCTION: postpone: FUNCTION-ALIAS: } related-words
HELP: TYPEDEF:
{ $syntax "TYPEDEF: old new" }
@ -84,7 +84,7 @@ HELP: ENUM:
HELP: C-TYPE:
{ $syntax "C-TYPE: 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:"
{ $code "C-TYPE: forward
STRUCT: backward { x forward* } ;
@ -94,7 +94,7 @@ STRUCT: forward { x backward* } ;" } }
HELP: CALLBACK:
{ $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, ..." } } }
{ $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
{ $code
"CALLBACK: bool FakeCallback ( int message, void* payload )"
@ -111,25 +111,25 @@ HELP: CALLBACK:
HELP: &:
{ $syntax "&: symbol" }
{ $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
{ $values { "old" "a C type" } { "new" "a C type" } }
{ $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:
{ $syntax "C-GLOBAL: type 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"
"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
"Defining enums:"
{ $subsection POSTPONE: ENUM: }
{ $subsection postpone: ENUM: }
"Defining enums at run-time:"
{ $subsection define-enum }
"Conversions between enums and integers:"

14
basis/ascii/ascii-tests.factor
View File

@ -1,18 +1,18 @@
USING: ascii kernel math sequences strings tools.test ;
{ t } [ 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: 0 digit? ] unit-test
{ f } [ CHAR: x digit? ] unit-test
{ t } [ 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: 0 digit? ] unit-test
{ f } [ char: x digit? ] unit-test
{ 4 } [
0 "There are Four Upper Case characters"
[ LETTER? [ 1 + ] when ] each
] 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
{ "i'm good thx bai" } [ "I'm Good THX bai" >lower ] unit-test

8
basis/ascii/ascii.factor
View File

@ -6,10 +6,10 @@ IN: ascii
: ascii? ( ch -- ? ) 0 127 between? ; inline
: blank? ( ch -- ? ) " \t\n\r" member? ; 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
: printable? ( ch -- ? ) CHAR: \s CHAR: ~ 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
: printable? ( ch -- ? ) char: \s char: ~ between? ; inline
: control? ( ch -- ? ) { [ 0 0x1F between? ] [ 0x7F = ] } 1|| ; inline
: quotable? ( ch -- ? ) { [ printable? ] [ "\"\\" member? not ] } 1&& ; inline
: Letter? ( ch -- ? ) { [ letter? ] [ LETTER? ] } 1|| ; inline

10
basis/base64/base64.factor
View File

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

4
basis/bit-arrays/bit-arrays-docs.factor
View File

@ -29,14 +29,14 @@ $nl
bit-array>integer
}
"Bit array literal syntax:"
{ $subsections POSTPONE: ?{ } ;
{ $subsections postpone: ?{ } ;
ABOUT: "bit-arrays"
HELP: ?{
{ $syntax "?{ elements... }" }
{ $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 }" } } ;
HELP: bit-array

4
basis/bit-vectors/bit-vectors-docs.factor
View File

@ -15,7 +15,7 @@ $nl
<bit-vector>
}
"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:"
{ $code "?V{ } clone" } ;
@ -35,5 +35,5 @@ HELP: >bit-vector
HELP: ?V{
{ $syntax "?V{ elements... }" }
{ $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 }" } } ;

6
basis/calendar/format/format.factor
View File

@ -14,11 +14,11 @@ MACRO: formatted ( spec -- quot )
} cond
] 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 ;

14
basis/calendar/parser/parser.factor
View File

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

2
basis/checksums/adler-32/adler-32-tests.factor
View File

@ -1,4 +1,4 @@
USING: checksums checksums.adler-32 strings tools.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

2
basis/checksums/bsd/bsd-tests.factor
View File

@ -1,4 +1,4 @@
USING: checksums checksums.bsd strings tools.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

2
basis/checksums/crc16/crc16.factor
View File

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

2
basis/checksums/ripemd/ripemd-tests.factor
View File

@ -65,7 +65,7 @@ IN: checksums.ripemd.tests
0x69 0x7b 0xdb 0xe1 0x6d
0x37 0xf9 0x7f 0x68 0xf0
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

2
basis/checksums/sha/sha-tests.factor
View File

@ -8,7 +8,7 @@ IN: checksums.sha.tests
{ "a9993e364706816aba3e25717850c26c9cd0d89d" } [ "abc" 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"
10 swap <array> concat sha1 checksum-bytes bytes>hex-string ] unit-test

12
basis/circular/circular-tests.factor
View File

@ -7,10 +7,10 @@ IN: circular.tests
{ 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
{ CHAR: t } [ "test" <circular> 0 swap nth ] unit-test
{ char: t } [ "test" <circular> 0 swap nth ] 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
{ [ 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> -100 over change-circular-start [ ] like ] 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
{ "ornact" } [ "factor" <circular> 4 over change-circular-start CHAR: n 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
{ "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
@ -29,7 +29,7 @@ IN: circular.tests
! This no longer fails
! [ "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
{ { 1 2 } } [

28
basis/classes/struct/struct-docs.factor
View File

@ -31,7 +31,7 @@ HELP: <struct>
HELP: STRUCT:
{ $syntax "STRUCT: class { slot type } { slot type } ... ;" }
{ $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
{ "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." }
@ -42,42 +42,42 @@ HELP: STRUCT:
HELP: S{
{ $syntax "S{ class slots... }" }
{ $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@
{ $syntax "S@ class 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." } ;
{ POSTPONE: S{ POSTPONE: S@ } related-words
{ postpone: S{ postpone: S@ } related-words
HELP: UNION-STRUCT:
{ $syntax "UNION-STRUCT: class { slot type } { slot type } ... ;" }
{ $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:
{ $syntax "PACKED-STRUCT: class { slot type } { slot type } ... ;" }
{ $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
{ $values
{ "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
{ $values
{ "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
{ $values
{ "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
{ $values
@ -111,7 +111,7 @@ HELP: read-struct
HELP: struct
{ $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
{ $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"
"Struct classes are defined using a syntax similar to the " { $link POSTPONE: TUPLE: } " syntax for defining tuple classes:"
{ $subsections POSTPONE: STRUCT: POSTPONE: PACKED-STRUCT: }
"Struct classes are defined using a syntax similar to the " { $link postpone: TUPLE: } " syntax for defining tuple classes:"
{ $subsections postpone: STRUCT: postpone: PACKED-STRUCT: }
"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"
"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)
(malloc-struct)
}
"Structs have literal syntax, similar to " { $link POSTPONE: T{ } " for tuples:"
{ $subsections POSTPONE: S{ } ;
"Structs have literal syntax, similar to " { $link postpone: T{ } " for tuples:"
{ $subsections postpone: S{ } ;
ARTICLE: "classes.struct.c" "Passing structs to C functions"
"Structs can be passed and returned by value, or by reference."

6
basis/classes/struct/struct-tests.factor
View File

@ -132,7 +132,7 @@ STRUCT: struct-test-bar
[ make-mirror clear-assoc ] keep
] unit-test
{ POSTPONE: STRUCT: }
{ postpone: STRUCT: }
[ struct-test-foo struct-definer-word ] unit-test
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
{ POSTPONE: UNION-STRUCT: }
{ postpone: UNION-STRUCT: }
[ struct-test-float-and-bits struct-definer-word ] unit-test
STRUCT: struct-test-string-ptr
@ -491,7 +491,7 @@ PACKED-STRUCT: packed-struct-test
{ 10 } [ "g" 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
STRUCT: struct-1 { a c:int } ;

8
basis/cocoa/cocoa-docs.factor
View File

@ -14,7 +14,7 @@ HELP: SUPER->
{ $description "A sugared form of the following:" }
{ $code "\"selector\" send-super" } ;
{ send super-send POSTPONE: -> POSTPONE: SUPER-> } related-words
{ send super-send postpone: -> postpone: SUPER-> } related-words
HELP: IMPORT:
{ $syntax "IMPORT: name" }
@ -25,13 +25,13 @@ HELP: IMPORT:
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."
{ $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."
$nl
"Messages can be sent to classes and instances using a pair of parsing words:"
{ $subsections
POSTPONE: ->
POSTPONE: SUPER->
postpone: ->
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:"
{ $subsections

8
basis/cocoa/messages/messages.factor
View File

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

10
basis/cocoa/subclassing/subclassing-docs.factor
View File

@ -3,21 +3,21 @@ IN: cocoa.subclassing
HELP: <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: } } }
{ $description "Defines a new Objective C class. Instance methods are defined with the " { $link POSTPONE: METHOD: } " parsing word."
{ $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."
$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." } ;
{ define-objc-class POSTPONE: <CLASS: POSTPONE: METHOD: } related-words
{ define-objc-class postpone: <CLASS: postpone: METHOD: } related-words
HELP: METHOD:
{ $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" } }
{ $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"
"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." ;
ABOUT: "objc-subclassing"

10
basis/colors/constants/constants-docs.factor
View File

@ -4,21 +4,21 @@ USING: help.markup help.syntax strings colors ;
HELP: named-color
{ $values { "name" string } { "color" color } }
{ $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" } "." } ;
HELP: named-colors
{ $values { "keys" "a sequence of strings" } }
{ $description "Outputs a sequence of all colors in the " { $snippet "rgb.txt" } " database." } ;
HELP: COLOR:
{ $syntax "COLOR: name" }
HELP: color:
{ $syntax "color: 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" } "." }
{ $examples
{ $code
"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
named-color
named-colors
POSTPONE: COLOR:
postpone: color:
} ;
ABOUT: "colors.constants"

2
basis/colors/constants/constants-tests.factor
View File

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

4
basis/colors/constants/constants.factor
View File

@ -9,7 +9,7 @@ IN: colors.constants
: parse-color ( line -- name color )
first4
[ [ 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 )
[ "!" head? ] reject
@ -31,4 +31,4 @@ ERROR: no-such-color name ;
: named-color ( name -- color )
dup colors at [ ] [ no-such-color ] ?if ;
SYNTAX: COLOR: scan-token named-color suffix! ;
SYNTAX: color: scan-token named-color suffix! ;

8
basis/colors/hex/hex-docs.factor
View File

@ -15,13 +15,13 @@ HELP: rgba>hex
{ $description "Converts a " { $link color } " into a hexadecimal string value." }
;
HELP: HEXCOLOR:
{ $syntax "HEXCOLOR: value" }
HELP: hexcolor:
{ $syntax "hexcolor: value" }
{ $description "Parses as a " { $link color } " object with the given hexadecimal value." }
{ $examples
{ $code
"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
hex>rgba
rgba>hex
POSTPONE: HEXCOLOR:
postpone: hexcolor:
}
{ $see-also "colors" } ;

26
basis/colors/hex/hex-tests.factor
View File

@ -2,18 +2,18 @@
! See http://factorcode.org/license.txt for BSD license
USING: colors colors.hex tools.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: abcdef } [ "abcdef" hex>rgba ] unit-test
{ HEXCOLOR: abcdef } [ "ABCDEF" hex>rgba ] unit-test
{ "ABCDEF" } [ HEXCOLOR: abcdef rgba>hex ] 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: abcdef } [ "abcdef" hex>rgba ] unit-test
{ hexcolor: abcdef } [ "ABCDEF" hex>rgba ] unit-test
{ "ABCDEF" } [ hexcolor: abcdef rgba>hex ] 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: 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: FFFFFFFF } [ 1.0 1.0 1.0 1.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: 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: FFFFFFFF } [ 1.0 1.0 1.0 1.0 <rgba> ] unit-test
{ HEXCOLOR: cafebabe } [ "cafebabe" hex>rgba ] unit-test
{ HEXCOLOR: 112233 } [ "123" hex>rgba ] unit-test
{ HEXCOLOR: 11223344 } [ "1234" hex>rgba ] unit-test
{ hexcolor: cafebabe } [ "cafebabe" hex>rgba ] unit-test
{ hexcolor: 112233 } [ "123" hex>rgba ] unit-test
{ hexcolor: 11223344 } [ "1234" hex>rgba ] unit-test

2
basis/colors/hex/hex.factor
View File

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

14
basis/colors/mix/mix-tests.factor
View File

@ -1,13 +1,13 @@
USING: colors.constants colors.mix kernel tools.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: blue } [ color: blue color: red 0.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: 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: 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: green } [ { color: blue color: red color: green } 1.0 sample-linear-gradient ] unit-test
{ t } [
{ COLOR: blue COLOR: red } 0.5 sample-linear-gradient
COLOR: blue COLOR: red 0.5 linear-gradient =
{ color: blue color: red } 0.5 sample-linear-gradient
color: blue color: red 0.5 linear-gradient =
] unit-test

6
basis/command-line/command-line-docs.factor
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:"
{ $table
{ { $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" } "." } }
} ;
@ -141,7 +141,7 @@ ARTICLE: "command-line" "Command line arguments"
{ $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:"
{ $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>" }
"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
@ -165,7 +165,7 @@ $nl
HELP: run-script
{ $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." } ;
ABOUT: "command-line"

2
basis/compiler/cfg/builder/builder-tests.factor
View File

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

4
basis/compiler/cfg/linear-scan/debugger/debugger.factor
View File

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

2
basis/compiler/compiler-docs.factor
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."
$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
"compiler-errors"
"hints"

14
basis/compiler/tests/intrinsics.factor
View File

@ -42,12 +42,12 @@ IN: compiler.tests.intrinsics
! Write barrier hits on the wrong value were causing segfaults
[ -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: 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: 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
[ 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 [ { 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
[ -4 ] [ B{ 1 2 3 -4 5 } 3 [ { byte-array fixnum } declare alien-signed-1 ] compile-call ] unit-test

2
basis/compiler/tests/optimizer.factor
View File

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

4
basis/compiler/tree/cleanup/cleanup-tests.factor
View File

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

12
basis/compiler/tree/propagation/propagation-tests.factor
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 } } [ [ [ 2 + ] [ "Oops" throw ] if ] final-classes ] unit-test
{ V{ POSTPONE: f } } [
{ V{ postpone: f } } [
[ dup 1.0 <= [ drop f ] [ 0 number= ] if ] final-classes
] unit-test
@ -720,7 +720,7 @@ M: array iterate first t ; inline
[ { hashtable } declare hashtable instance? ] final-classes
] unit-test
{ V{ POSTPONE: f } } [
{ V{ postpone: f } } [
[ { vector } declare hashtable instance? ] final-classes
] unit-test
@ -728,7 +728,7 @@ M: array iterate first t ; inline
[ { assoc } declare hashtable instance? ] final-classes
] unit-test
{ V{ POSTPONE: f } } [
{ V{ postpone: f } } [
[ 3 string? ] final-classes
] unit-test
@ -788,7 +788,7 @@ MIXIN: empty-mixin
] final-classes
] unit-test
{ V{ POSTPONE: f } } [
{ V{ postpone: f } } [
[ { float } declare 0 eq? ] final-classes
] unit-test
@ -872,7 +872,7 @@ MIXIN: empty-mixin
[ { fixnum } declare log2 0 >= ] final-classes
] unit-test
{ V{ POSTPONE: f } } [
{ V{ postpone: f } } [
[ { word object } declare equal? ] final-classes
] unit-test
@ -1074,7 +1074,7 @@ M: tuple-with-read-only-slot clone
] unit-test
{ t } [
[ { POSTPONE: f } declare <displaced-alien> ] final-classes
[ { postpone: f } declare <displaced-alien> ] final-classes
first \ f alien class-or class=
] unit-test

2
basis/core-text/core-text-tests.factor
View File

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

2
basis/csv/csv-docs.factor
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." } ;
HELP: with-delimiter
{ $values { "ch" "field delimiter (e.g. CHAR: \\t)" }
{ $values { "ch" "field delimiter (e.g. char: \\t)" }
{ "quot" quotation } }
{ $description "Sets the field delimiter for read-csv, read-row, write-csv, or write-row words." } ;

2
basis/csv/csv-tests.factor
View File

@ -61,7 +61,7 @@ IN: csv.tests
"allows setting of delimiting character"
[ { { "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"
[ { { "foo" "bar" }

16
basis/csv/csv.factor
View File

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

2
basis/db/postgresql/postgresql.factor
View File

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

2
basis/db/tester/tester.factor
View File

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

2
basis/db/tuples/tuples-tests.factor
View File

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

2
basis/definitions/icons/icons-docs.factor
View File

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

18
basis/delegate/delegate-docs.factor
View File

@ -4,18 +4,18 @@ IN: delegate
HELP: define-protocol
{ $values { "protocol" "a word for the new protocol" } { "wordlist" "a sequence of words" } }
{ $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:
{ $syntax "PROTOCOL: protocol-name words... ;" }
{ $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
{ $values { "consultation" consultation } }
{ $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:
{ $syntax "CONSULT: group class
@ -33,9 +33,9 @@ HELP: SLOT-PROTOCOL:
{ $syntax "SLOT-PROTOCOL: protocol-name slots... ;" }
{ $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
{ $values { "group" "a group" } { "words" "an array of words" } }
@ -52,15 +52,15 @@ $nl
$nl
"Defining new protocols:"
{ $subsections
POSTPONE: PROTOCOL:
postpone: PROTOCOL:
define-protocol
}
"Defining new protocols consisting of slot accessors:"
{ $subsections POSTPONE: SLOT-PROTOCOL: }
{ $subsections postpone: SLOT-PROTOCOL: }
"Defining consultation:"
{ $subsections
POSTPONE: BROADCAST:
POSTPONE: CONSULT:
postpone: BROADCAST:
postpone: 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" } ;

2
basis/environment/environment-tests.factor
View File

@ -21,7 +21,7 @@ os unix? [
{ 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
{ 32766 } [ "factor-test-key-long" os-env length ] unit-test
{ } [ "factor-test-key-long" unset-os-env ] unit-test

6
basis/eval/eval-docs.factor
View File

@ -54,17 +54,17 @@ $nl
( -- seq ) (eval)
] 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"
"The " { $vocab-link "eval" } " vocabulary implements support for evaluating strings of code dynamically."
$nl
"The main entry point is a parsing word, which wraps a library word:"
{ $subsections
POSTPONE: eval(
postpone: 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
"Advanced features:"
{ $subsections "eval-vocabs" eval>string }

46
basis/farkup/farkup.factor
View File

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

4
basis/fonts/fonts.factor
View File

@ -11,10 +11,10 @@ CONSTANT: default-monospace-font-name "monospace"
CONSTANT: default-font-size 12
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
COLOR: white default-font-background-color set-global
color: white default-font-background-color set-global
TUPLE: font name size bold? italic? foreground background ;

10
basis/formatting/formatting-tests.factor
View File

@ -62,21 +62,21 @@ IN: formatting.tests
{ "1.00000e-1000" } [ -1000 10^ "%.5e" sprintf ] unit-test
{ t } [
1000 10^ "%.5f" sprintf
"1" ".00000" 1000 CHAR: 0 <string> glue =
"1" ".00000" 1000 char: 0 <string> glue =
] unit-test
{ t } [
-1000 10^ "%.1004f" sprintf
"0." "10000" 999 CHAR: 0 <string> glue =
"0." "10000" 999 char: 0 <string> glue =
] unit-test
{ "-1.00000e+1000" } [ 1000 10^ neg "%.5e" sprintf ] unit-test
{ "-1.00000e-1000" } [ -1000 10^ neg "%.5e" sprintf ] unit-test
{ t } [
1000 10^ neg "%.5f" sprintf
"-1" ".00000" 1000 CHAR: 0 <string> glue =
"-1" ".00000" 1000 char: 0 <string> glue =
] unit-test
{ t } [
-1000 10^ neg "%.1004f" sprintf
"-0." "10000" 999 CHAR: 0 <string> glue =
"-0." "10000" 999 char: 0 <string> glue =
] unit-test
{ "9007199254740991.0" } [ 53 2^ 1 - "%.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
{ "Hello, World!" } [ "Hello, World!" "%s" 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
{ "ff" } [ 0xff "%02x" sprintf ] unit-test
{ "0 message(s)" } [ 0 "message" "%d %s(s)" sprintf ] unit-test

28
basis/formatting/formatting.factor
View File

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

8
basis/fry/fry-docs.factor
View File

@ -12,7 +12,7 @@ HELP: @
HELP: fry
{ $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." }
{ $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 ]" }
}
{ $examples "See " { $link "fry.examples" } "." } ;
@ -23,12 +23,12 @@ HELP: '[
{ $examples "See " { $link "fry.examples" } "." } ;
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"
"The easiest way to understand fried quotations is to look at some examples."
$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" }
"Occurrences of " { $link _ } " on the left map directly to " { $link curry } ". That is, the following three lines are equivalent:"
{ $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."
$nl
"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:"
{ $subsections
_

4
basis/ftp/client/client.factor
View File

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

30
basis/ftp/client/listing-parser/listing-parser.factor
View File

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

2
basis/furnace/auth/providers/couchdb/couchdb.factor
View File

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

10
basis/game/input/input-docs.factor
View File

@ -160,17 +160,17 @@ HELP: mouse-state
{ keyboard-state read-keyboard } related-words
HELP: button-delta
{ $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." } ;
{ $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." } ;
HELP: buttons-delta
{ $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."
{ $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."
$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." } ;
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" } "." } ;
{ button-delta buttons-delta buttons-delta-as } related-words

2
basis/gobject-introspection/types/types.factor
View File

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

8
basis/help/cookbook/cookbook.factor
View File

@ -44,7 +44,7 @@ ARTICLE: "cookbook-colon-defs" "Shuffle word and definition cookbook"
{ $code ": sq ( x -- y ) dup * ;" }
"(You could have looked this up yourself by clicking on the " { $link sq } " word itself.)"
$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
"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
@ -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:"
{ $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
"IN: time-machine"
": time-travel ( when what -- ) frob fizz flap ;"
@ -157,7 +157,7 @@ $nl
": accelerate ( -- ) accelerator on ;"
": 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
{ }
"word-search"
@ -173,7 +173,7 @@ ARTICLE: "cookbook-application" "Application cookbook"
""
"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" }
"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" }

4
basis/help/handbook/handbook.factor
View File

@ -45,7 +45,7 @@ $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."
{ $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" }
"These conventions are not hard and fast, but are usually a good first step in understanding a word's behavior:"
{ $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:"
{ $list
{ "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." }
}
{ $subsections "tail-call-opt" }

10
basis/help/help-docs.factor
View File

@ -91,11 +91,11 @@ ARTICLE: "writing-help" "Writing documentation"
$nl
"A pair of parsing words are used to define free-standing articles and to associate documentation with words:"
{ $subsections
POSTPONE: ARTICLE:
POSTPONE: HELP:
postpone: ARTICLE:
postpone: HELP:
}
"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:"
{ $list
{ "a string," }
@ -311,7 +311,7 @@ HELP: $example
{ $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." }
{ $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" } }
"However the following is right:"
{ $markup-example { $example "USING: math prettyprint ;" "2 2 + ." "4" } }
@ -524,7 +524,7 @@ HELP: ABOUT:
HELP: vocab-help
{ $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
{ $values { "seq" "vocab names" } }

28
basis/help/html/html.factor
View File

@ -15,19 +15,19 @@ IN: help.html
: escape-char ( ch -- )
dup ascii? [
dup H{
{ CHAR: \" "__quo__" }
{ CHAR: * "__star__" }
{ CHAR: \: "__colon__" }
{ CHAR: < "__lt__" }
{ CHAR: > "__gt__" }
{ CHAR: ? "__que__" }
{ CHAR: \\ "__back__" }
{ CHAR: | "__pipe__" }
{ CHAR: / "__slash__" }
{ CHAR: , "__comma__" }
{ CHAR: @ "__at__" }
{ CHAR: # "__hash__" }
{ CHAR: % "__percent__" }
{ char: \" "__quo__" }
{ char: * "__star__" }
{ char: \: "__colon__" }
{ char: < "__lt__" }
{ char: > "__gt__" }
{ char: ? "__que__" }
{ char: \\ "__back__" }
{ char: | "__pipe__" }
{ char: / "__slash__" }
{ char: , "__comma__" }
{ char: @ "__at__" }
{ char: # "__hash__" }
{ char: % "__percent__" }
} at [ % ] [ , ] ?if
] [ number>string "__" "__" surround % ] if ;
@ -87,7 +87,7 @@ M: pathname url-of
XML] ;
: 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 )
dup '[ drop _ assoc-size 1 + bijective-base26 ] cache ;

2
basis/help/lint/spaces/spaces.factor
View File

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

2
basis/help/stylesheet/stylesheet.factor
View File

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

4
basis/help/tips/tips-docs.factor
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: "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/" } "." ;
@ -42,7 +42,7 @@ ARTICLE: "all-tips-of-the-day" "All 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:"
{ $subsections POSTPONE: TIP: }
{ $subsections postpone: TIP: }
"All tips defined so far:"
{ $subsections "all-tips-of-the-day" } ;

10
basis/help/tutorial/tutorial.factor
View File

@ -34,7 +34,7 @@ $nl
"IN: palindrome"
}
$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
"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" }
@ -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:"
{ $code "\"palindrome\" reload" }
$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
"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 = ;" }
@ -101,7 +101,7 @@ $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."
$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
"Add the following two lines to " { $snippet "palindrome-tests.factor" } ":"
{ $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."
$nl
"Start by pushing a character on the stack; notice that characters are really just integers:"
{ $code "CHAR: a" }
{ $code "char: a" }
$nl
"Now, use the " { $link Letter? } " word to test if it is an alphabetical character, upper or lower case:"
{ $unchecked-example "Letter? ." "t" }
@ -151,7 +151,7 @@ $nl
"This gives the expected result."
$nl
"Now try with a non-alphabetical character:"
{ $code "CHAR: #" }
{ $code "char: #" }
{ $unchecked-example "Letter? ." "f" }
$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:"

2
basis/help/vocabs/vocabs-docs.factor
View File

@ -21,7 +21,7 @@ HELP: words.
HELP: about
{ $values { "vocab" "a vocabulary specifier" } }
{ $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"

2
basis/hints/hints-docs.factor
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."
$nl
"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:"
{ $subsections specialized-def } ;

2
basis/html/streams/streams-tests.factor
View File

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

2
basis/html/streams/streams.factor
View File

@ -36,7 +36,7 @@ TUPLE: html-sub-stream < html-writer style parent ;
: hex-color, ( color -- )
[ 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 -- )
"color: #" % hex-color, "; " % ;

10
basis/html/templates/chloe/chloe-docs.factor
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." } ;
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]
{ $values { "string" string } }
@ -194,8 +194,8 @@ $nl
ARTICLE: "html.templates.chloe.extend.tags" "Extending Chloe with custom tags"
"Syntax for defining custom tags:"
{ $subsections POSTPONE: CHLOE: }
"A number of compiler words can be used from the " { $link POSTPONE: CHLOE: } " body to emit compiled template code."
{ $subsections postpone: CHLOE: }
"A number of compiler words can be used from the " { $link postpone: CHLOE: } " body to emit compiled template code."
$nl
"Extracting attributes from the XML tag:"
{ $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" } "."
$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
"USING: combinators kernel math.parser math.ranges random"
"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"
"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
POSTPONE: COMPONENT:
postpone: COMPONENT:
"html.templates.chloe.extend.components.example"
} ;

2
basis/html/templates/chloe/chloe-tests.factor
View File

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

2
basis/html/templates/fhtml/fhtml.factor
View File

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

2
basis/http/parsers/parsers.factor
View File

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

2
basis/http/server/filters/filters-docs.factor
View File

@ -7,6 +7,6 @@ HELP: filter-responder
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."
{ $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"

2
basis/io/backend/unix/unix.factor
View File

@ -147,7 +147,7 @@ M: stdin dispose*
] with-destructors ;
: 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 ]
bi ;

6
basis/io/buffers/buffers-tests.factor
View File

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

6
basis/io/crlf/crlf.factor
View File

@ -8,14 +8,14 @@ IN: io.crlf
: read-crlf ( -- seq )
"\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 )
"\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' )
CHAR: \r swap remove ;
char: \r swap remove ;
: lf>crlf ( str -- str' )
"\n" split "\r\n" join ;

4
basis/io/encodings/8-bit/8-bit-tests.factor
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 ;
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
{ B{ 255 } } [ { 255 } >string latin1 encode ] 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
{ t } [ \ latin1 8-bit-encoding? ] unit-test

2
basis/io/encodings/euc/euc-tests.factor
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 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

8
basis/io/encodings/gb18030/gb18030-tests.factor
View File

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

44
basis/io/encodings/iso2022/iso2022-tests.factor
View File

@ -7,30 +7,30 @@ IN: io.encodings.iso2022
{ "hello" } [ "hello" >byte-array iso2022 decode ] 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 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 } 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\u00fffd" } [ B{ char: h char: i $ ESC char: \( } 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
{ "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
{ "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
{ 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
{ "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\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
{ "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" } [ 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 } 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: 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\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\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 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
{ "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" } [ 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: \( CHAR: D 0x70 0x70 } iso2022 decode ] 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\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\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
[ "\u{syriac-music}" iso2022 encode ] must-fail

24
basis/io/encodings/iso2022/iso2022.factor
View File

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

20
basis/io/encodings/shift-jis/shift-jis-tests.factor
View File

@ -3,15 +3,15 @@
USING: io.encodings.shift-jis tools.test io.encodings.string arrays strings ;
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 encode >string ] unit-test
[ { CHAR: replacement-character } shift-jis encode ] must-fail
{ "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
{ "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
{ "\u000081\u0000c8" } [ CHAR: logical-and 1string windows-31j 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" shift-jis decode >array ] unit-test
[ { char: replacement-character } shift-jis encode ] must-fail
{ "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
{ "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
{ "\u000081\u0000c8" } [ char: logical-and 1string windows-31j 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" shift-jis decode >array ] unit-test

26
basis/io/encodings/utf32/utf32-tests.factor
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 ;
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
{ { 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 } 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 } 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
{ { 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 } 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 } 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{ 0 0 0xfe 0xff 0 0 0 CHAR: x } 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
{ 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

10
basis/io/encodings/utf7/utf7.factor
View File

@ -13,20 +13,20 @@ TUPLE: utf7codec dialect buffer ;
: utf7 ( -- utf7codec )
{
{ { } { } }
{ { CHAR: + } { CHAR: - } }
{ { char: + } { char: - } }
} V{ } utf7codec boa ;
: utf7imap4 ( -- utf7codec )
{
{ { CHAR: / } { CHAR: , } }
{ { CHAR: & } { CHAR: - } }
{ { char: / } { char: , } }
{ { char: & } { char: - } }
} V{ } utf7codec boa ;
: >raw-base64 ( bytes -- bytes' )
>string utf16be encode >base64 [ CHAR: = = ] trim-tail ;
>string utf16be encode >base64 [ char: = = ] trim-tail ;
: 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 )
[ swap [ first ] [ concat ] bi replace nip ]

2
basis/io/files/info/unix/linux/linux.factor
View File

@ -65,7 +65,7 @@ frequency pass-number ;
} cleave ;
: 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-entry>file-system-info ( mtab-entry -- file-system-info/f )

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

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

2
basis/io/files/info/windows/windows.factor
View File

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

2
basis/io/files/unique/unique-tests.factor
View File

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

2
basis/io/files/windows/windows.factor
View File

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

10
basis/io/launcher/windows/windows.factor
View File

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

2
basis/io/mmap/mmap-docs.factor
View File

@ -69,7 +69,7 @@ ARTICLE: "io.mmap.arrays" "Working with memory-mapped data"
{ $subsections <mapped-array> }
"Additionally, files may be opened with two combinators which take a c-type as input:"
{ $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
"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