Help lint fixes
parent
e96228b24c
commit
8b855b2445
|
@ -24,20 +24,20 @@ $nl
|
|||
{ find find-from find-last find-last find-last-from search } related-words
|
||||
|
||||
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." }
|
||||
{ $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
|
||||
|
||||
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 = } "." } ;
|
||||
|
||||
{ member? sorted-member? } related-words
|
||||
|
||||
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? } "." } ;
|
||||
|
||||
{ memq? sorted-memq? } related-words
|
||||
|
|
|
@ -60,11 +60,11 @@ HELP: set-bits
|
|||
{ $side-effects "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." }
|
||||
{ $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
|
||||
{ $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." }
|
||||
{ $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." } ;
|
||||
|
|
|
@ -69,8 +69,7 @@ M: bit-array resize
|
|||
|
||||
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 )
|
||||
n zero? [ 0 <bit-array> ] [
|
||||
|
@ -84,7 +83,7 @@ M: bit-array byte-length length 7 + -3 shift ;
|
|||
]
|
||||
] if ;
|
||||
|
||||
: bit-array>integer ( bit-array -- int )
|
||||
: bit-array>integer ( bit-array -- n )
|
||||
0 swap underlying>> [ length ] keep [
|
||||
uchar-nth swap 8 shift bitor
|
||||
] curry each ;
|
||||
|
|
|
@ -36,8 +36,8 @@ HELP: begin-compiling
|
|||
{ $description "Prepares to generate machine code for a word." } ;
|
||||
|
||||
HELP: with-generator
|
||||
{ $values { "node" "a dataflow node" } { "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." } ;
|
||||
{ $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 sequence of nodes." } ;
|
||||
|
||||
HELP: generate-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 } "." } ;
|
||||
|
||||
HELP: generate-nodes
|
||||
{ $values { "node" "a dataflow node" } }
|
||||
{ $values { "nodes" "a sequence of nodes" } }
|
||||
{ $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 } "." } ;
|
||||
|
||||
HELP: generate
|
||||
{ $values { "word" word } { "label" word } { "node" "a dataflow node" } }
|
||||
{ $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." } ;
|
||||
{ $values { "word" word } { "label" word } { "nodes" "a sequence of nodes" } }
|
||||
{ $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
|
||||
{ $values { "word" word } { "intrinsics" "a sequence of " { $snippet "{ quot assoc }" } " pairs" } }
|
||||
|
|
|
@ -2,7 +2,7 @@ USING: accessors arrays compiler.units generic hashtables
|
|||
stack-checker kernel kernel.private math prettyprint sequences
|
||||
sbufs strings tools.test vectors words sequences.private
|
||||
quotations classes classes.algebra classes.tuple.private
|
||||
continuations growable namespaces hints
|
||||
continuations growable namespaces hints alien.accessors
|
||||
compiler.tree.builder compiler.tree.optimizer ;
|
||||
IN: optimizer.tests
|
||||
|
||||
|
@ -356,3 +356,10 @@ TUPLE: some-tuple x ;
|
|||
[ ] curry some-tuple boa ;
|
||||
|
||||
[ 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
|
||||
|
|
|
@ -247,7 +247,7 @@ generic-comparison-ops [
|
|||
[ string>number 8 * 2^ 1- 0 swap [a,b] ]
|
||||
}
|
||||
} cond
|
||||
[ fixnum fits? fixnum bignum ? ] keep <class/interval-info>
|
||||
[ fixnum fits? fixnum integer ? ] keep <class/interval-info>
|
||||
[ 2nip ] curry +outputs+ set-word-prop
|
||||
] each
|
||||
|
||||
|
|
|
@ -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." } ;
|
||||
|
||||
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." } ;
|
||||
|
||||
{ CFRelease |CFRelease &CFRelease } related-words
|
||||
|
|
|
@ -110,7 +110,7 @@ M: help-error error.
|
|||
H{ } clone [
|
||||
[
|
||||
[ dup >link where dup ] 2dip
|
||||
[ first r> at r> push-at ] 2curry
|
||||
[ >r >r first r> at r> push-at ] 2curry
|
||||
[ 2drop ]
|
||||
if
|
||||
] 2curry each
|
||||
|
|
|
@ -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
|
||||
|
||||
ARTICLE: "inspector" "The inspector"
|
||||
|
@ -41,15 +41,8 @@ $nl
|
|||
{ $examples { $code "global describe" } } ;
|
||||
|
||||
HELP: describe*
|
||||
{ $values { "obj" object } { "flags" "an assoc" } }
|
||||
{ $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." }
|
||||
} }
|
||||
{ $values { "obj" object } { "mirror" mirror } { "keys" "a sequence of objects" } }
|
||||
{ $description "Print a tabular overview of the object." }
|
||||
{ $notes "This word is a factor of " { $link describe } " and " { $link inspect } "." } ;
|
||||
|
||||
HELP: inspector-stack
|
||||
|
|
|
@ -4,7 +4,7 @@ USING: alien.syntax cocoa cocoa.nibs cocoa.application
|
|||
cocoa.classes cocoa.dialogs cocoa.pasteboard cocoa.subclassing
|
||||
core-foundation help.topics kernel memory namespaces parser
|
||||
system ui ui.tools.browser ui.tools.listener ui.tools.workspace
|
||||
ui.cocoa eval ;
|
||||
ui.cocoa eval locals ;
|
||||
IN: ui.cocoa.tools
|
||||
|
||||
: finder-run-files ( alien -- )
|
||||
|
@ -52,10 +52,10 @@ CLASS: {
|
|||
NSApp FactorApplicationDelegate install-delegate ;
|
||||
|
||||
! Service support; evaluate Factor code from other apps
|
||||
: do-service ( pboard error quot -- )
|
||||
pick >r >r
|
||||
?pasteboard-string dup [ r> call ] [ r> 2drop f ] if
|
||||
dup [ r> set-pasteboard-string ] [ r> 2drop ] if ;
|
||||
:: do-service ( pboard error quot -- )
|
||||
pboard error ?pasteboard-string
|
||||
dup [ quot call ] when
|
||||
[ pboard set-pasteboard-string ] when* ;
|
||||
|
||||
CLASS: {
|
||||
{ +superclass+ "NSObject" }
|
||||
|
|
|
@ -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." } ;
|
||||
|
||||
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." } ;
|
||||
|
||||
HELP: <roll-button>
|
||||
|
|
|
@ -130,13 +130,13 @@ HELP: clear-gadget
|
|||
{ $side-effects "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." }
|
||||
{ $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" } ;
|
||||
|
||||
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." }
|
||||
{ $notes "This may result in " { $link graft* } " being called on the children, if the parent is visible on the screen." }
|
||||
{ $side-effects "parent" } ;
|
||||
|
|
|
@ -32,7 +32,7 @@ HELP: grid-child
|
|||
{ $errors "Throws an error if the indices are out of bounds." } ;
|
||||
|
||||
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." }
|
||||
{ $side-effects "grid" } ;
|
||||
|
||||
|
|
|
@ -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 } "." } ;
|
||||
|
||||
HELP: <incremental>
|
||||
{ $values { "pack" pack } { "incremental" "a new instance of " { $link incremental } } }
|
||||
{ $description "Creates a new incremental layout gadget delegating to " { $snippet "pack" } "." } ;
|
||||
{ $values { "incremental" "a new instance of " { $link incremental } } }
|
||||
{ $description "Creates a new incremental layout gadget." } ;
|
||||
|
||||
{ <incremental> add-incremental clear-incremental } related-words
|
||||
|
||||
|
|
|
@ -68,9 +68,6 @@ HELP: classes
|
|||
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." } ;
|
||||
|
||||
! HELP: implementors-map
|
||||
! { $var-description "Assoc mapping each class to a set of generic words defining methods on this class." } ;
|
||||
|
||||
HELP: 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." } ;
|
||||
|
@ -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 } }
|
||||
{ $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 ;
|
||||
|
||||
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." } ;
|
||||
|
|
|
@ -145,7 +145,7 @@ $nl
|
|||
} } ;
|
||||
|
||||
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." }
|
||||
{ $notes "This word is used in the implemention of " { $link hash-case-quot } " and " { $link standard-combination } "." } ;
|
||||
|
||||
|
|
|
@ -1,4 +1,4 @@
|
|||
USING: help.markup help.syntax math strings words ;
|
||||
USING: help.markup help.syntax math strings words kernel ;
|
||||
IN: effects
|
||||
|
||||
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." } ;
|
||||
|
||||
HELP: effect>string
|
||||
{ $values { "effect" effect } { "string" string } }
|
||||
{ $values { "obj" object } { "str" string } }
|
||||
{ $description "Turns a stack effect object into a string mnemonic." }
|
||||
{ $examples
|
||||
{ $example "USING: effects io ;" "1 2 <effect> effect>string print" "( object -- object object )" }
|
||||
|
|
|
@ -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." } ;
|
||||
|
||||
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." }
|
||||
$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: } "." }
|
||||
{ $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
|
||||
{ $values { "class" class } }
|
||||
{ $description "Remove all method definitions which specialize on the class." } ;
|
||||
|
|
|
@ -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." } ;
|
||||
|
||||
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." } ;
|
||||
|
||||
HELP: lexer-factory
|
||||
|
|
|
@ -122,7 +122,7 @@ $nl
|
|||
} } ;
|
||||
|
||||
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
|
||||
"Defines a generic word with the " { $link standard-combination } " using dispatch position 0, and having one method on " { $snippet "class" } "."
|
||||
$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." } ;
|
||||
|
||||
HELP: define-reader
|
||||
{ $values { "class" class } { "name" string } { "slot" integer } }
|
||||
{ $description "Defines a reader word to read a slot from instances of " { $snippet "class" } "." }
|
||||
{ $values { "class" class } { "slot-spec" slot-spec } }
|
||||
{ $description "Defines a reader word to read a slot specified by " { $snippet "slot-spec" } "." }
|
||||
$low-level-note ;
|
||||
|
||||
HELP: define-writer
|
||||
{ $values { "class" class } { "name" string } { "slot" integer } }
|
||||
{ $description "Defines a generic word " { $snippet "writer" } " to write a new value to a slot in instances of " { $snippet "class" } "." }
|
||||
{ $values { "class" class } { "slot-spec" slot-spec } }
|
||||
{ $description "Defines a generic word " { $snippet "writer" } " to write a new value to a slot specified by " { $snippet "slot-spec" } "." }
|
||||
$low-level-note ;
|
||||
|
||||
HELP: define-slot-methods
|
||||
{ $values { "class" class } { "name" string } { "slot" integer } }
|
||||
{ $description "Defines a reader, writer, setter and changer for a slot in instances of " { $snippet "class" } "." }
|
||||
{ $values { "class" class } { "slot-spec" slot-spec } }
|
||||
{ $description "Defines a reader, writer, setter and changer for a slot specified by " { $snippet "slot-spec" } "." }
|
||||
$low-level-note ;
|
||||
|
||||
HELP: define-accessors
|
||||
|
|
|
@ -135,7 +135,7 @@ TUPLE: merge
|
|||
|
||||
PRIVATE>
|
||||
|
||||
: sort ( seq quot -- seq' )
|
||||
: sort ( seq quot -- sortedseq )
|
||||
[ <merge> ] dip
|
||||
[ sort-pairs ] [ sort-loop ] [ drop accum>> underlying>> ] 2tri ;
|
||||
inline
|
||||
|
|
|
@ -302,7 +302,7 @@ HELP: bootstrap-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." } ;
|
||||
|
||||
HELP: parsing-word?
|
||||
HELP: parsing-word? ( obj -- ? )
|
||||
{ $values { "obj" object } { "?" "a boolean" } }
|
||||
{ $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." } ;
|
||||
|
|
|
@ -349,10 +349,10 @@ TUPLE: token-parser symbol ;
|
|||
|
||||
: parse-token ( input string -- result )
|
||||
#! Parse the string, returning a parse result
|
||||
dup >r ?head-slice [
|
||||
r> <parse-result> f f add-error
|
||||
[ ?head-slice ] keep swap [
|
||||
<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 ;
|
||||
|
||||
M: token-parser (compile) ( peg -- quot )
|
||||
|
@ -436,14 +436,14 @@ M: choice-parser (compile) ( peg -- quot )
|
|||
|
||||
TUPLE: repeat0-parser p1 ;
|
||||
|
||||
: (repeat) ( quot result -- result )
|
||||
: (repeat) ( quot: ( -- result ) result -- result )
|
||||
over call [
|
||||
[ remaining>> swap (>>remaining) ] 2keep
|
||||
ast>> swap [ ast>> push ] keep
|
||||
(repeat)
|
||||
] [
|
||||
nip
|
||||
] if* ; inline
|
||||
] if* ; inline recursive
|
||||
|
||||
M: repeat0-parser (compile) ( peg -- quot )
|
||||
p1>> compile-parser 1quotation '[
|
||||
|
|
Loading…
Reference in New Issue