Help lint fixes

db4
Slava Pestov 2008-08-22 23:00:35 -05:00
parent e96228b24c
commit 8b855b2445
23 changed files with 60 additions and 64 deletions

View File

@ -24,20 +24,20 @@ $nl
{ find find-from find-last find-last find-last-from search } related-words { find find-from find-last find-last find-last-from search } related-words
HELP: sorted-index HELP: sorted-index
{ $values { "elt" object } { "seq" "a sorted sequence" } { "i" "an index, or " { $link f } } { "elt" "an element, or " { $link f } } } { $values { "obj" object } { "seq" "a sorted sequence" } { "i" "an index, or " { $link f } } }
{ $description "Outputs the index and value of the element closest to " { $snippet "elt" } " in the sequence. See " { $link search } " for details." } { $description "Outputs the index and value of the element closest to " { $snippet "elt" } " in the sequence. See " { $link search } " for details." }
{ $notes "If the sequence has at least one element, this word always outputs a valid index, because it finds the closest match, not necessarily an exact one. In this respect its behavior differs from " { $link index } "." } ; { $notes "If the sequence has at least one element, this word always outputs a valid index, because it finds the closest match, not necessarily an exact one. In this respect its behavior differs from " { $link index } "." } ;
{ index index-from last-index last-index-from sorted-index } related-words { index index-from last-index last-index-from sorted-index } related-words
HELP: sorted-member? HELP: sorted-member?
{ $values { "elt" object } { "seq" "a sorted sequence" } { "?" "a boolean" } } { $values { "obj" object } { "seq" "a sorted sequence" } { "?" "a boolean" } }
{ $description "Tests if the sorted sequence contains " { $snippet "elt" } ". Equality is tested with " { $link = } "." } ; { $description "Tests if the sorted sequence contains " { $snippet "elt" } ". Equality is tested with " { $link = } "." } ;
{ member? sorted-member? } related-words { member? sorted-member? } related-words
HELP: sorted-memq? HELP: sorted-memq?
{ $values { "elt" object } { "seq" "a sorted sequence" } { "?" "a boolean" } } { $values { "obj" object } { "seq" "a sorted sequence" } { "?" "a boolean" } }
{ $description "Tests if the sorted sequence contains " { $snippet "elt" } ". Equality is tested with " { $link eq? } "." } ; { $description "Tests if the sorted sequence contains " { $snippet "elt" } ". Equality is tested with " { $link eq? } "." } ;
{ memq? sorted-memq? } related-words { memq? sorted-memq? } related-words

View File

@ -60,11 +60,11 @@ HELP: set-bits
{ $side-effects "bit-array" } ; { $side-effects "bit-array" } ;
HELP: integer>bit-array HELP: integer>bit-array
{ $values { "integer" integer } { "bit-array" bit-array } } { $values { "n" integer } { "bit-array" bit-array } }
{ $description "Outputs a freshly-allocated bit array whose elements correspond to the bits in the binary representation of the given unsigned integer value." } { $description "Outputs a freshly-allocated bit array whose elements correspond to the bits in the binary representation of the given unsigned integer value." }
{ $notes "The bits of the integer are stored in the resulting bit array in order of ascending significance, least significant bit first. This word will fail if passed a negative integer. If you want the two's-complement binary representation of a negative number, use " { $link bitnot } " to get the complement of the number first. This word works with fixnums or bignums of any size; it is not limited by fixnum size or machine word size." } ; { $notes "The bits of the integer are stored in the resulting bit array in order of ascending significance, least significant bit first. This word will fail if passed a negative integer. If you want the two's-complement binary representation of a negative number, use " { $link bitnot } " to get the complement of the number first. This word works with fixnums or bignums of any size; it is not limited by fixnum size or machine word size." } ;
HELP: bit-array>integer HELP: bit-array>integer
{ $values { "bit-array" bit-array } { "integer" integer } } { $values { "bit-array" bit-array } { "n" integer } }
{ $description "Outputs the unsigned integer whose binary representation corresponds to the contents of the given bit array." } { $description "Outputs the unsigned integer whose binary representation corresponds to the contents of the given bit array." }
{ $notes "The bits of the integer are taken from the bit array in order of ascending significance, least significant bit first. This word is able to return fixnums or bignums of any size; it is not limited by fixnum size or machine word size." } ; { $notes "The bits of the integer are taken from the bit array in order of ascending significance, least significant bit first. This word is able to return fixnums or bignums of any size; it is not limited by fixnum size or machine word size." } ;

View File

@ -69,8 +69,7 @@ M: bit-array resize
M: bit-array byte-length length 7 + -3 shift ; M: bit-array byte-length length 7 + -3 shift ;
: ?{ ( parsed -- parsed ) : ?{ \ } [ >bit-array ] parse-literal ; parsing
\ } [ >bit-array ] parse-literal ; parsing
:: integer>bit-array ( n -- bit-array ) :: integer>bit-array ( n -- bit-array )
n zero? [ 0 <bit-array> ] [ n zero? [ 0 <bit-array> ] [
@ -84,7 +83,7 @@ M: bit-array byte-length length 7 + -3 shift ;
] ]
] if ; ] if ;
: bit-array>integer ( bit-array -- int ) : bit-array>integer ( bit-array -- n )
0 swap underlying>> [ length ] keep [ 0 swap underlying>> [ length ] keep [
uchar-nth swap 8 shift bitor uchar-nth swap 8 shift bitor
] curry each ; ] curry each ;

View File

@ -36,8 +36,8 @@ HELP: begin-compiling
{ $description "Prepares to generate machine code for a word." } ; { $description "Prepares to generate machine code for a word." } ;
HELP: with-generator HELP: with-generator
{ $values { "node" "a dataflow node" } { "word" word } { "label" word } { "quot" "a quotation with stack effect " { $snippet "( node -- )" } } } { $values { "nodes" "a sequence of nodes" } { "word" word } { "label" word } { "quot" "a quotation with stack effect " { $snippet "( node -- )" } } }
{ $description "Generates machine code for " { $snippet "label" } " by applying the quotation to the dataflow node." } ; { $description "Generates machine code for " { $snippet "label" } " by applying the quotation to the sequence of nodes." } ;
HELP: generate-node HELP: generate-node
{ $values { "node" "a dataflow node" } { "next" "a dataflow node" } } { $values { "node" "a dataflow node" } { "next" "a dataflow node" } }
@ -45,13 +45,13 @@ HELP: generate-node
{ $notes "This word can only be called from inside the quotation passed to " { $link with-generator } "." } ; { $notes "This word can only be called from inside the quotation passed to " { $link with-generator } "." } ;
HELP: generate-nodes HELP: generate-nodes
{ $values { "node" "a dataflow node" } } { $values { "nodes" "a sequence of nodes" } }
{ $description "Recursively generate machine code for a dataflow graph." } { $description "Recursively generate machine code for a dataflow graph." }
{ $notes "This word can only be called from inside the quotation passed to " { $link with-generator } "." } ; { $notes "This word can only be called from inside the quotation passed to " { $link with-generator } "." } ;
HELP: generate HELP: generate
{ $values { "word" word } { "label" word } { "node" "a dataflow node" } } { $values { "word" word } { "label" word } { "nodes" "a sequence of nodes" } }
{ $description "Generates machine code for " { $snippet "label" } " from " { $snippet "node" } ". The value of " { $snippet "word" } " is retained for debugging purposes; it is the word which will appear in a call stack trace if this compiled code block throws an error when run." } ; { $description "Generates machine code for " { $snippet "label" } " from " { $snippet "nodes" } ". The value of " { $snippet "word" } " is retained for debugging purposes; it is the word which will appear in a call stack trace if this compiled code block throws an error when run." } ;
HELP: define-intrinsics HELP: define-intrinsics
{ $values { "word" word } { "intrinsics" "a sequence of " { $snippet "{ quot assoc }" } " pairs" } } { $values { "word" word } { "intrinsics" "a sequence of " { $snippet "{ quot assoc }" } " pairs" } }

View File

@ -2,7 +2,7 @@ USING: accessors arrays compiler.units generic hashtables
stack-checker kernel kernel.private math prettyprint sequences stack-checker kernel kernel.private math prettyprint sequences
sbufs strings tools.test vectors words sequences.private sbufs strings tools.test vectors words sequences.private
quotations classes classes.algebra classes.tuple.private quotations classes classes.algebra classes.tuple.private
continuations growable namespaces hints continuations growable namespaces hints alien.accessors
compiler.tree.builder compiler.tree.optimizer ; compiler.tree.builder compiler.tree.optimizer ;
IN: optimizer.tests IN: optimizer.tests
@ -356,3 +356,10 @@ TUPLE: some-tuple x ;
[ ] curry some-tuple boa ; [ ] curry some-tuple boa ;
[ T{ some-tuple f [ 3 ] } ] [ 3 allot-regression ] unit-test [ T{ some-tuple f [ 3 ] } ] [ 3 allot-regression ] unit-test
[ 1 ] [ B{ 0 0 0 0 } [ 0 alien-signed-4 1+ ] compile-call ] unit-test
[ 1 ] [ B{ 0 0 0 0 } [ 0 alien-unsigned-4 1+ ] compile-call ] unit-test
[ 1 ] [ B{ 0 0 0 0 0 0 0 0 } [ 0 alien-signed-8 1+ ] compile-call ] unit-test
[ 1 ] [ B{ 0 0 0 0 0 0 0 0 } [ 0 alien-unsigned-8 1+ ] compile-call ] unit-test
[ 1 ] [ B{ 0 0 0 0 0 0 0 0 } [ 0 alien-signed-cell 1+ ] compile-call ] unit-test
[ 1 ] [ B{ 0 0 0 0 0 0 0 0 } [ 0 alien-unsigned-cell 1+ ] compile-call ] unit-test

View File

@ -247,7 +247,7 @@ generic-comparison-ops [
[ string>number 8 * 2^ 1- 0 swap [a,b] ] [ string>number 8 * 2^ 1- 0 swap [a,b] ]
} }
} cond } cond
[ fixnum fits? fixnum bignum ? ] keep <class/interval-info> [ fixnum fits? fixnum integer ? ] keep <class/interval-info>
[ 2nip ] curry +outputs+ set-word-prop [ 2nip ] curry +outputs+ set-word-prop
] each ] each

View File

@ -42,7 +42,7 @@ HELP: &CFRelease
{ $description "Marks the given Core Foundation object for unconditional release via " { $link CFRelease } " at the end of the enclosing " { $link with-destructors } " scope." } ; { $description "Marks the given Core Foundation object for unconditional release via " { $link CFRelease } " at the end of the enclosing " { $link with-destructors } " scope." } ;
HELP: |CFRelease HELP: |CFRelease
{ $values { "interface" "Pointer to a Core Foundation object" } } { $values { "alien" "Pointer to a Core Foundation object" } }
{ $description "Marks the given Core Foundation object for release via " { $link CFRelease } " in the event of an error at the end of the enclosing " { $link with-destructors } " scope." } ; { $description "Marks the given Core Foundation object for release via " { $link CFRelease } " in the event of an error at the end of the enclosing " { $link with-destructors } " scope." } ;
{ CFRelease |CFRelease &CFRelease } related-words { CFRelease |CFRelease &CFRelease } related-words

View File

@ -110,7 +110,7 @@ M: help-error error.
H{ } clone [ H{ } clone [
[ [
[ dup >link where dup ] 2dip [ dup >link where dup ] 2dip
[ first r> at r> push-at ] 2curry [ >r >r first r> at r> push-at ] 2curry
[ 2drop ] [ 2drop ]
if if
] 2curry each ] 2curry each

View File

@ -1,4 +1,4 @@
USING: help.markup help.syntax kernel classes io io.styles ; USING: help.markup help.syntax kernel classes io io.styles mirrors ;
IN: inspector IN: inspector
ARTICLE: "inspector" "The inspector" ARTICLE: "inspector" "The inspector"
@ -41,15 +41,8 @@ $nl
{ $examples { $code "global describe" } } ; { $examples { $code "global describe" } } ;
HELP: describe* HELP: describe*
{ $values { "obj" object } { "flags" "an assoc" } } { $values { "obj" object } { "mirror" mirror } { "keys" "a sequence of objects" } }
{ $description "Print a tabular overview of the object." { $description "Print a tabular overview of the object." }
$nl
"The assoc can contain any of the following keys:"
{ $list
{ { $link +number-rows+ } " - if set to a true value, every row of output will begin with a row number." }
{ { $link +editable+ } " - if set to a true value, keys and values will be editable in place, if the output stream supports it." }
{ { $link +sequence+ } " - if set to a true value, keys will not be printed, only values." }
} }
{ $notes "This word is a factor of " { $link describe } " and " { $link inspect } "." } ; { $notes "This word is a factor of " { $link describe } " and " { $link inspect } "." } ;
HELP: inspector-stack HELP: inspector-stack

View File

@ -4,7 +4,7 @@ USING: alien.syntax cocoa cocoa.nibs cocoa.application
cocoa.classes cocoa.dialogs cocoa.pasteboard cocoa.subclassing cocoa.classes cocoa.dialogs cocoa.pasteboard cocoa.subclassing
core-foundation help.topics kernel memory namespaces parser core-foundation help.topics kernel memory namespaces parser
system ui ui.tools.browser ui.tools.listener ui.tools.workspace system ui ui.tools.browser ui.tools.listener ui.tools.workspace
ui.cocoa eval ; ui.cocoa eval locals ;
IN: ui.cocoa.tools IN: ui.cocoa.tools
: finder-run-files ( alien -- ) : finder-run-files ( alien -- )
@ -52,10 +52,10 @@ CLASS: {
NSApp FactorApplicationDelegate install-delegate ; NSApp FactorApplicationDelegate install-delegate ;
! Service support; evaluate Factor code from other apps ! Service support; evaluate Factor code from other apps
: do-service ( pboard error quot -- ) :: do-service ( pboard error quot -- )
pick >r >r pboard error ?pasteboard-string
?pasteboard-string dup [ r> call ] [ r> 2drop f ] if dup [ quot call ] when
dup [ r> set-pasteboard-string ] [ r> 2drop ] if ; [ pboard set-pasteboard-string ] when* ;
CLASS: { CLASS: {
{ +superclass+ "NSObject" } { +superclass+ "NSObject" }

View File

@ -10,7 +10,7 @@ $nl
"A button can be selected, which is distinct from being pressed. This state is held in the " { $link button-selected? } " slot, and is used by the " { $link <toggle-buttons> } " word to construct a row of buttons for choosing among several alternatives." } ; "A button can be selected, which is distinct from being pressed. This state is held in the " { $link button-selected? } " slot, and is used by the " { $link <toggle-buttons> } " word to construct a row of buttons for choosing among several alternatives." } ;
HELP: <button> HELP: <button>
{ $values { "gadget" gadget } { "quot" "a quotation with stack effect " { $snippet "( button -- )" } } { "button" "a new " { $link button } } } { $values { "label" gadget } { "quot" "a quotation with stack effect " { $snippet "( button -- )" } } { "button" "a new " { $link button } } }
{ $description "Creates a new " { $link button } " which calls the quotation when clicked. The given gadget becomes the button's only child." } ; { $description "Creates a new " { $link button } " which calls the quotation when clicked. The given gadget becomes the button's only child." } ;
HELP: <roll-button> HELP: <roll-button>

View File

@ -130,13 +130,13 @@ HELP: clear-gadget
{ $side-effects "gadget" } ; { $side-effects "gadget" } ;
HELP: add-gadget HELP: add-gadget
{ $values { "gadget" gadget } { "parent" gadget } } { $values { "parent" gadget } { "child" gadget } }
{ $description "Adds a child gadget to a parent. If the gadget is contained in another gadget, " { $link unparent } " is called on the gadget first. The parent will be relayout." } { $description "Adds a child gadget to a parent. If the gadget is contained in another gadget, " { $link unparent } " is called on the gadget first. The parent will be relayout." }
{ $notes "Adding a gadget to a parent may result in " { $link graft* } " being called on the children, if the parent is visible on the screen." } { $notes "Adding a gadget to a parent may result in " { $link graft* } " being called on the children, if the parent is visible on the screen." }
{ $side-effects "parent" } ; { $side-effects "parent" } ;
HELP: add-gadgets HELP: add-gadgets
{ $values { "seq" "a sequence of gadgets" } { "parent" gadget } } { $values { "parent" gadget } { "children" "a sequence of gadgets" } }
{ $description "Adds a sequence of gadgets to a parent. The parent will be relayout." } { $description "Adds a sequence of gadgets to a parent. The parent will be relayout." }
{ $notes "This may result in " { $link graft* } " being called on the children, if the parent is visible on the screen." } { $notes "This may result in " { $link graft* } " being called on the children, if the parent is visible on the screen." }
{ $side-effects "parent" } ; { $side-effects "parent" } ;

View File

@ -32,7 +32,7 @@ HELP: grid-child
{ $errors "Throws an error if the indices are out of bounds." } ; { $errors "Throws an error if the indices are out of bounds." } ;
HELP: grid-add HELP: grid-add
{ $values { "gadget" gadget } { "grid" grid } { "i" "non-negative integer" } { "j" "non-negative integer" } } { $values { "grid" grid } { "child" gadget } { "i" "non-negative integer" } { "j" "non-negative integer" } }
{ $description "Adds a child gadget at the specified location." } { $description "Adds a child gadget at the specified location." }
{ $side-effects "grid" } ; { $side-effects "grid" } ;

View File

@ -11,8 +11,8 @@ $nl
"Not every " { $link pack } " can use incremental layout, since incremental layout does not support non-default values for " { $link pack-align } ", " { $link pack-fill } ", and " { $link pack-gap } "." } ; "Not every " { $link pack } " can use incremental layout, since incremental layout does not support non-default values for " { $link pack-align } ", " { $link pack-fill } ", and " { $link pack-gap } "." } ;
HELP: <incremental> HELP: <incremental>
{ $values { "pack" pack } { "incremental" "a new instance of " { $link incremental } } } { $values { "incremental" "a new instance of " { $link incremental } } }
{ $description "Creates a new incremental layout gadget delegating to " { $snippet "pack" } "." } ; { $description "Creates a new incremental layout gadget." } ;
{ <incremental> add-incremental clear-incremental } related-words { <incremental> add-incremental clear-incremental } related-words

View File

@ -68,9 +68,6 @@ HELP: classes
HELP: update-map HELP: update-map
{ $var-description "Assoc mapping each class to a set of classes defined in terms of this class. The " { $link define-class } " word uses this information to update generic words when classes are redefined." } ; { $var-description "Assoc mapping each class to a set of classes defined in terms of this class. The " { $link define-class } " word uses this information to update generic words when classes are redefined." } ;
! HELP: implementors-map
! { $var-description "Assoc mapping each class to a set of generic words defining methods on this class." } ;
HELP: predicate-word HELP: predicate-word
{ $values { "word" "a word" } { "predicate" "a predicate word" } } { $values { "word" "a word" } { "predicate" "a predicate word" } }
{ $description "Suffixes the word's name with \"?\" and creates a word with that name in the same vocabulary as the word itself." } ; { $description "Suffixes the word's name with \"?\" and creates a word with that name in the same vocabulary as the word itself." } ;
@ -96,3 +93,7 @@ HELP: define-class
{ $values { "word" word } { "superclass" class } { "members" "a sequence of class words" } { "participants" "a sequence of class words" } { "metaclass" class } } { $values { "word" word } { "superclass" class } { "members" "a sequence of class words" } { "participants" "a sequence of class words" } { "metaclass" class } }
{ $description "Sets a property indicating this word is a class word, thus making it an instance of " { $link class } ", and registers it with " { $link update-map } "." } { $description "Sets a property indicating this word is a class word, thus making it an instance of " { $link class } ", and registers it with " { $link update-map } "." }
$low-level-note ; $low-level-note ;
HELP: implementors
{ $values { "class/classes" "a class or a sequence of classes" } { "seq" "a sequence of generic words" } }
{ $description "Finds all generic words in the dictionary implementing methods for the given set of classes." } ;

View File

@ -145,7 +145,7 @@ $nl
} } ; } } ;
HELP: distribute-buckets HELP: distribute-buckets
{ $values { "assoc" "an alist" } { "initial" object } { "quot" "a quotation with stack effect " { $snippet "( obj -- assoc )" } } { "buckets" "a new array" } } { $values { "alist" "an alist" } { "initial" object } { "quot" "a quotation with stack effect " { $snippet "( obj -- assoc )" } } { "buckets" "a new array" } }
{ $description "Sorts the entries of " { $snippet "assoc" } " into buckets, using the quotation to yield a set of keys for each entry. The hashcode of each key is computed, and the entry is placed in all corresponding buckets. Each bucket is initially cloned from " { $snippet "initial" } "; this should either be an empty vector or a one-element vector containing a pair." } { $description "Sorts the entries of " { $snippet "assoc" } " into buckets, using the quotation to yield a set of keys for each entry. The hashcode of each key is computed, and the entry is placed in all corresponding buckets. Each bucket is initially cloned from " { $snippet "initial" } "; this should either be an empty vector or a one-element vector containing a pair." }
{ $notes "This word is used in the implemention of " { $link hash-case-quot } " and " { $link standard-combination } "." } ; { $notes "This word is used in the implemention of " { $link hash-case-quot } " and " { $link standard-combination } "." } ;

View File

@ -1,4 +1,4 @@
USING: help.markup help.syntax math strings words ; USING: help.markup help.syntax math strings words kernel ;
IN: effects IN: effects
ARTICLE: "effect-declaration" "Stack effect declaration" ARTICLE: "effect-declaration" "Stack effect declaration"
@ -61,7 +61,7 @@ HELP: effect<=
{ $description "Tests if " { $snippet "eff1" } " is substitutable for " { $snippet "eff2" } ". What this means is that both stack effects change the stack height by the same amount, the first takes a smaller or equal number of inputs as the second, and either both or neither one terminate execution by throwing an error." } ; { $description "Tests if " { $snippet "eff1" } " is substitutable for " { $snippet "eff2" } ". What this means is that both stack effects change the stack height by the same amount, the first takes a smaller or equal number of inputs as the second, and either both or neither one terminate execution by throwing an error." } ;
HELP: effect>string HELP: effect>string
{ $values { "effect" effect } { "string" string } } { $values { "obj" object } { "str" string } }
{ $description "Turns a stack effect object into a string mnemonic." } { $description "Turns a stack effect object into a string mnemonic." }
{ $examples { $examples
{ $example "USING: effects io ;" "1 2 <effect> effect>string print" "( object -- object object )" } { $example "USING: effects io ;" "1 2 <effect> effect>string print" "( object -- object object )" }

View File

@ -145,7 +145,7 @@ HELP: check-method
{ $error-description "Thrown if " { $link POSTPONE: M: } " or " { $link create-method } " is given an invalid class or generic word." } ; { $error-description "Thrown if " { $link POSTPONE: M: } " or " { $link create-method } " is given an invalid class or generic word." } ;
HELP: with-methods HELP: with-methods
{ $values { "generic" generic } { "quot" "a quotation with stack effect " { $snippet "( methods -- )" } } } { $values { "class" class } { "generic" generic } { "quot" "a quotation with stack effect " { $snippet "( methods -- )" } } }
{ $description "Applies a quotation to the generic word's methods hashtable, and regenerates the generic word's definition when the quotation returns." } { $description "Applies a quotation to the generic word's methods hashtable, and regenerates the generic word's definition when the quotation returns." }
$low-level-note ; $low-level-note ;
@ -154,10 +154,6 @@ HELP: create-method
{ $description "Creates a method or returns an existing one. This is the runtime equivalent of " { $link POSTPONE: M: } "." } { $description "Creates a method or returns an existing one. This is the runtime equivalent of " { $link POSTPONE: M: } "." }
{ $notes "To define a method, pass the output value to " { $link define } "." } ; { $notes "To define a method, pass the output value to " { $link define } "." } ;
HELP: implementors
{ $values { "class" class } { "seq" "a sequence of generic words" } }
{ $description "Finds all generic words in the dictionary implementing methods for this class." } ;
HELP: forget-methods HELP: forget-methods
{ $values { "class" class } } { $values { "class" class } }
{ $description "Remove all method definitions which specialize on the class." } ; { $description "Remove all method definitions which specialize on the class." } ;

View File

@ -86,7 +86,7 @@ HELP: unexpected-eof
{ $description "Throws an " { $link unexpected } " error indicating the parser was looking for an occurrence of " { $snippet "word" } " but encountered end of file." } ; { $description "Throws an " { $link unexpected } " error indicating the parser was looking for an occurrence of " { $snippet "word" } " but encountered end of file." } ;
HELP: with-lexer HELP: with-lexer
{ $values { "lexer" lexer } { "quot" quotation } } { $values { "lexer" lexer } { "quot" quotation } { "newquot" quotation } }
{ $description "Calls the quotation with the " { $link lexer } " variable set to the given lexer. The quotation can make use of words such as " { $link scan } ". Any errors thrown by the quotation are wrapped in " { $link lexer-error } " instances." } ; { $description "Calls the quotation with the " { $link lexer } " variable set to the given lexer. The quotation can make use of words such as " { $link scan } ". Any errors thrown by the quotation are wrapped in " { $link lexer-error } " instances." } ;
HELP: lexer-factory HELP: lexer-factory

View File

@ -122,7 +122,7 @@ $nl
} } ; } } ;
HELP: define-typecheck HELP: define-typecheck
{ $values { "class" class } { "generic" "a generic word" } { "quot" quotation } } { $values { "class" class } { "generic" "a generic word" } { "quot" quotation } { "props" "an assoc of word properties" } }
{ $description { $description
"Defines a generic word with the " { $link standard-combination } " using dispatch position 0, and having one method on " { $snippet "class" } "." "Defines a generic word with the " { $link standard-combination } " using dispatch position 0, and having one method on " { $snippet "class" } "."
$nl $nl
@ -136,18 +136,18 @@ HELP: define-typecheck
{ $notes "This word is used internally to wrap unsafe low-level code in a type-checking stub." } ; { $notes "This word is used internally to wrap unsafe low-level code in a type-checking stub." } ;
HELP: define-reader HELP: define-reader
{ $values { "class" class } { "name" string } { "slot" integer } } { $values { "class" class } { "slot-spec" slot-spec } }
{ $description "Defines a reader word to read a slot from instances of " { $snippet "class" } "." } { $description "Defines a reader word to read a slot specified by " { $snippet "slot-spec" } "." }
$low-level-note ; $low-level-note ;
HELP: define-writer HELP: define-writer
{ $values { "class" class } { "name" string } { "slot" integer } } { $values { "class" class } { "slot-spec" slot-spec } }
{ $description "Defines a generic word " { $snippet "writer" } " to write a new value to a slot in instances of " { $snippet "class" } "." } { $description "Defines a generic word " { $snippet "writer" } " to write a new value to a slot specified by " { $snippet "slot-spec" } "." }
$low-level-note ; $low-level-note ;
HELP: define-slot-methods HELP: define-slot-methods
{ $values { "class" class } { "name" string } { "slot" integer } } { $values { "class" class } { "slot-spec" slot-spec } }
{ $description "Defines a reader, writer, setter and changer for a slot in instances of " { $snippet "class" } "." } { $description "Defines a reader, writer, setter and changer for a slot specified by " { $snippet "slot-spec" } "." }
$low-level-note ; $low-level-note ;
HELP: define-accessors HELP: define-accessors

View File

@ -135,7 +135,7 @@ TUPLE: merge
PRIVATE> PRIVATE>
: sort ( seq quot -- seq' ) : sort ( seq quot -- sortedseq )
[ <merge> ] dip [ <merge> ] dip
[ sort-pairs ] [ sort-loop ] [ drop accum>> underlying>> ] 2tri ; [ sort-pairs ] [ sort-loop ] [ drop accum>> underlying>> ] 2tri ;
inline inline

View File

@ -302,7 +302,7 @@ HELP: bootstrap-word
{ $values { "word" word } { "target" word } } { $values { "word" word } { "target" word } }
{ $description "Looks up a word with the same name and vocabulary as the given word, performing a transformation to handle parsing words in the target dictionary. Used during bootstrap to transfer host words to the target dictionary." } ; { $description "Looks up a word with the same name and vocabulary as the given word, performing a transformation to handle parsing words in the target dictionary. Used during bootstrap to transfer host words to the target dictionary." } ;
HELP: parsing-word? HELP: parsing-word? ( obj -- ? )
{ $values { "obj" object } { "?" "a boolean" } } { $values { "obj" object } { "?" "a boolean" } }
{ $description "Tests if an object is a parsing word declared by " { $link POSTPONE: parsing } "." } { $description "Tests if an object is a parsing word declared by " { $link POSTPONE: parsing } "." }
{ $notes "Outputs " { $link f } " if the object is not a word." } ; { $notes "Outputs " { $link f } " if the object is not a word." } ;

View File

@ -349,10 +349,10 @@ TUPLE: token-parser symbol ;
: parse-token ( input string -- result ) : parse-token ( input string -- result )
#! Parse the string, returning a parse result #! Parse the string, returning a parse result
dup >r ?head-slice [ [ ?head-slice ] keep swap [
r> <parse-result> f f add-error <parse-result> f f add-error
] [ ] [
drop pos get "token '" r> append "'" append 1vector add-error f >r drop pos get "token '" r> append "'" append 1vector add-error f
] if ; ] if ;
M: token-parser (compile) ( peg -- quot ) M: token-parser (compile) ( peg -- quot )
@ -436,14 +436,14 @@ M: choice-parser (compile) ( peg -- quot )
TUPLE: repeat0-parser p1 ; TUPLE: repeat0-parser p1 ;
: (repeat) ( quot result -- result ) : (repeat) ( quot: ( -- result ) result -- result )
over call [ over call [
[ remaining>> swap (>>remaining) ] 2keep [ remaining>> swap (>>remaining) ] 2keep
ast>> swap [ ast>> push ] keep ast>> swap [ ast>> push ] keep
(repeat) (repeat)
] [ ] [
nip nip
] if* ; inline ] if* ; inline recursive
M: repeat0-parser (compile) ( peg -- quot ) M: repeat0-parser (compile) ( peg -- quot )
p1>> compile-parser 1quotation '[ p1>> compile-parser 1quotation '[