diff --git a/basis/alien/parser/parser.factor b/basis/alien/parser/parser.factor index a9cf10b9f9..d4824507d2 100755 --- a/basis/alien/parser/parser.factor +++ b/basis/alien/parser/parser.factor @@ -18,7 +18,7 @@ ERROR: bad-array-type ; : parse-array-type ( name -- c-type ) "[" split unclip - [ [ "]" ?tail [ bad-array-type ] unless parse-word/number ] map ] + [ [ "]" ?tail [ bad-array-type ] unless parse-datum ] map ] [ (parse-c-type) ] bi* prefix ; @@ -70,7 +70,7 @@ ERROR: *-in-c-type-name name ; } cleave ; : CREATE-C-TYPE ( -- word ) - (scan-token) (CREATE-C-TYPE) ; + scan-token (CREATE-C-TYPE) ; > return-type-name CHAR: * suffix ; [ [ 2array suffix! ] [ enum>number 1 + ] bi ] 2bi ; : parse-enum-name ( -- name ) - (scan-token) (CREATE-C-TYPE) dup save-location ; + scan-token (CREATE-C-TYPE) dup save-location ; : parse-enum-base-type ( -- base-type token ) - (scan-token) dup "<" = - [ drop scan-object (scan-token) ] + scan-token dup "<" = + [ drop scan-object scan-token ] [ [ int ] dip ] if ; : parse-enum-member ( members name value -- members value' ) over "{" = - [ 2drop (scan-token) create-class-in scan-object next-enum-member "}" expect ] + [ 2drop scan-token create-class-in scan-object next-enum-member "}" expect ] [ [ create-class-in ] dip next-enum-member ] if ; : parse-enum-members ( members counter token -- members ) dup ";" = not - [ swap parse-enum-member (scan-token) parse-enum-members ] [ 2drop ] if ; + [ swap parse-enum-member scan-token parse-enum-members ] [ 2drop ] if ; PRIVATE> @@ -112,14 +112,14 @@ PRIVATE> [ V{ } clone 0 ] dip parse-enum-members ; : scan-function-name ( -- return function ) - scan-c-type (scan-token) parse-pointers ; + scan-c-type scan-token parse-pointers ; :: (scan-c-args) ( end-marker types names -- ) - (scan-token) :> type-str + scan-token :> type-str type-str end-marker = [ type-str { "(" ")" } member? [ type-str parse-c-type :> type - (scan-token) "," ?tail drop :> name + scan-token "," ?tail drop :> name type name parse-pointers :> ( type' name' ) type' types push name' names push ] unless diff --git a/basis/bootstrap/image/syntax/syntax.factor b/basis/bootstrap/image/syntax/syntax.factor index e8dff61430..c8f91e224f 100644 --- a/basis/bootstrap/image/syntax/syntax.factor +++ b/basis/bootstrap/image/syntax/syntax.factor @@ -8,7 +8,7 @@ SYMBOL: special-objects SYNTAX: RESET H{ } clone special-objects set-global ; SYNTAX: SPECIAL-OBJECT: - scan-new-word scan-word + scan-new-word scan-number [ swap special-objects get set-at ] [ drop define-symbol ] 2bi ; diff --git a/basis/classes/struct/struct.factor b/basis/classes/struct/struct.factor index 0f22ba6cc5..adb9f330d4 100644 --- a/basis/classes/struct/struct.factor +++ b/basis/classes/struct/struct.factor @@ -354,7 +354,7 @@ PRIVATE> ; + scan-token scan-c-type \ } parse-until ; : parse-struct-slots ( slots -- slots' more? ) scan-token { @@ -387,14 +387,14 @@ SYNTAX: S@ array ] [ search ] if ; + scan-token dup "{" = [ drop \ } parse-until >array ] [ search ] if ; : parse-struct-slot` ( accum -- accum ) scan-string-param scan-c-type` \ } parse-until [ suffix! ] 3curry append! ; : parse-struct-slots` ( accum -- accum more? ) - (scan-token) { + scan-token { { ";" [ f ] } { "{" [ parse-struct-slot` t ] } [ invalid-struct-slot ] diff --git a/basis/compiler/cfg/registers/registers.factor b/basis/compiler/cfg/registers/registers.factor index 9c7896be7e..d061409932 100644 --- a/basis/compiler/cfg/registers/registers.factor +++ b/basis/compiler/cfg/registers/registers.factor @@ -42,5 +42,5 @@ C: ds-loc TUPLE: rs-loc < loc ; C: rs-loc -SYNTAX: D scan-word suffix! ; -SYNTAX: R scan-word suffix! ; +SYNTAX: D scan-number suffix! ; +SYNTAX: R scan-number suffix! ; diff --git a/basis/cpu/x86/assembler/syntax/syntax.factor b/basis/cpu/x86/assembler/syntax/syntax.factor index 185d892ce7..6649345bea 100644 --- a/basis/cpu/x86/assembler/syntax/syntax.factor +++ b/basis/cpu/x86/assembler/syntax/syntax.factor @@ -23,7 +23,7 @@ registers [ H{ } clone ] initialize [ [ 0 ] dip (define-registers) ] keep registers get set-at ; SYNTAX: REGISTERS: - scan-word [ ";" parse-tokens ] dip define-registers ; + scan-number [ ";" parse-tokens ] dip define-registers ; SYNTAX: HI-REGISTERS: - scan-word [ ";" parse-tokens 4 ] dip (define-registers) drop ; + scan-number [ ";" parse-tokens 4 ] dip (define-registers) drop ; diff --git a/basis/functors/backend/backend.factor b/basis/functors/backend/backend.factor index 0bdbb03ab1..1528053f5f 100644 --- a/basis/functors/backend/backend.factor +++ b/basis/functors/backend/backend.factor @@ -23,7 +23,7 @@ SYNTAX: FUNCTOR-SYNTAX: scan-token >string-param ; : scan-c-type-param ( -- c-type/param ) - (scan-token) dup "{" = [ drop \ } parse-until >array ] [ >string-param ] if ; + scan-token dup "{" = [ drop \ } parse-until >array ] [ >string-param ] if ; : define* ( word def -- ) over set-word define ; diff --git a/basis/functors/functors.factor b/basis/functors/functors.factor index 64a3870926..8e1364b495 100644 --- a/basis/functors/functors.factor +++ b/basis/functors/functors.factor @@ -52,7 +52,7 @@ M: object (fake-quotations>) , ; FUNCTOR-SYNTAX: TUPLE: scan-param suffix! - (scan-token) { + scan-token { { ";" [ tuple suffix! f suffix! ] } { "<" [ scan-param suffix! [ parse-tuple-slots ] { } make suffix! ] } [ @@ -122,7 +122,7 @@ FUNCTOR-SYNTAX: inline [ word make-inline ] append! ; FUNCTOR-SYNTAX: call-next-method T{ fake-call-next-method } suffix! ; : (INTERPOLATE) ( accum quot -- accum ) - [ (scan-token) interpolate-locals ] dip + [ scan-token interpolate-locals ] dip '[ _ with-string-writer @ ] suffix! ; PRIVATE> diff --git a/basis/openssl/libssl/libssl.factor b/basis/openssl/libssl/libssl.factor index 1f4fe9b869..ef46a0e851 100644 --- a/basis/openssl/libssl/libssl.factor +++ b/basis/openssl/libssl/libssl.factor @@ -281,7 +281,7 @@ H{ } clone verify-messages set-global SYNTAX: X509_V_: scan-token "X509_V_" prepend create-in - scan-word + scan-number [ 1quotation (( -- value )) define-inline ] [ verify-messages get set-at ] 2bi ; diff --git a/basis/windows/com/syntax/syntax.factor b/basis/windows/com/syntax/syntax.factor index 83c9b38790..06e43b39f5 100755 --- a/basis/windows/com/syntax/syntax.factor +++ b/basis/windows/com/syntax/syntax.factor @@ -43,8 +43,8 @@ ERROR: no-com-interface interface ; ; :: (parse-com-functions) ( functions -- ) - (scan-token) dup ";" = [ drop ] [ - parse-c-type (scan-token) parse-pointers + scan-token dup ";" = [ drop ] [ + parse-c-type scan-token parse-pointers (parse-com-function) functions push functions (parse-com-functions) ] if ; diff --git a/core/classes/tuple/parser/parser.factor b/core/classes/tuple/parser/parser.factor index 3059f2683f..1bc1067724 100644 --- a/core/classes/tuple/parser/parser.factor +++ b/core/classes/tuple/parser/parser.factor @@ -31,7 +31,7 @@ ERROR: duplicate-slot-names names ; ERROR: invalid-slot-name name ; : parse-long-slot-name ( -- spec ) - [ (scan-token) , \ } parse-until % ] { } make ; + [ scan-token , \ } parse-until % ] { } make ; : parse-slot-name-delim ( end-delim string/f -- ? ) ! Check for mistakes of this form: @@ -72,7 +72,7 @@ ERROR: bad-slot-name class slot ; 2dup swap slot-named* nip [ 2nip ] [ nip bad-slot-name ] if ; : parse-slot-value ( class slots -- ) - (scan-token) check-slot-name scan-object 2array , scan-token { + scan-token check-slot-name scan-object 2array , scan-token { { "}" [ ] } [ bad-literal-tuple ] } case ; diff --git a/core/effects/parser/parser.factor b/core/effects/parser/parser.factor index bbc49c97b1..ae41689491 100644 --- a/core/effects/parser/parser.factor +++ b/core/effects/parser/parser.factor @@ -34,7 +34,7 @@ SYMBOL: effect-var PRIVATE> : parse-effect-token ( first? var end -- var more? ) - (scan-token) { + scan-token { { [ end-token? ] [ drop nip f ] } { [ effect-opener? ] [ bad-effect ] } { [ effect-closer? ] [ stack-effect-omits-dashes ] } diff --git a/core/parser/parser-docs.factor b/core/parser/parser-docs.factor index 2766f5aac9..f042cd419f 100644 --- a/core/parser/parser-docs.factor +++ b/core/parser/parser-docs.factor @@ -9,13 +9,16 @@ ARTICLE: "reading-ahead" "Reading ahead" "Parsing words can consume input:" { $subsections scan-token + scan-word-name scan-word + scan-datum + scan-number scan-object } "Lower-level words:" { $subsections (scan-token) - (scan-word) + (scan-datum) } "For example, the " { $link POSTPONE: HEX: } " word uses this feature to read hexadecimal literals:" { $see POSTPONE: HEX: } @@ -136,6 +139,12 @@ HELP: scan-new { $errors "Throws an error if the end of the line is reached." } $parsing-note ; +HELP: scan-new-word +{ $values { "word" word } } +{ $description "Reads the next token from the line currently being parsed, and creates a word with that name in the current vocabulary and resets the generic word properties of that word." } +{ $errors "Throws an error if the end of the line is reached." } +$parsing-note ; + HELP: no-word-error { $error-description "Thrown if the parser encounters a token which does not name a word in the current vocabulary search path. If any words with this name exist in vocabularies not part of the search path, a number of restarts will offer to add those vocabularies to the search path and use the chosen word." } { $notes "Apart from a missing " { $link POSTPONE: USE: } ", this error can also indicate an ordering issue. In Factor, words must be defined before they can be called. Mutual recursion can be implemented via " { $link POSTPONE: DEFER: } "." } ; @@ -150,20 +159,48 @@ HELP: parse-word { $errors "Throws an error if the token does not name a word, and does not parse as a number." } { $notes "This word is used to implement " { $link scan-word } "." } ; -HELP: parse-word/number +HELP: parse-datum { $values { "string" string } { "word/number" "a word or number" } } { $description "If " { $snippet "string" } " is a valid number literal, it is converted to a number, otherwise the current vocabulary search path is searched for a word named by the string." } { $errors "Throws an error if the token does not name a word, and does not parse as a number." } -{ $notes "This word is used to implement " { $link (scan-word) } "." } ; +{ $notes "This word is used to implement " { $link (scan-datum) } "." } ; HELP: scan-word -{ $values { "word/number" "a word or a number" } } -{ $description "Reads the next token from parser input. If the token is a valid number literal, it is converted to a number, otherwise the vocabulary search path is searched for a word named by the token. Outputs " { $link f } " if the end of the input has been reached." } -{ $errors "Throws an error if the token does not name a word, and does not parse as a number." } +{ $values { "word" "a word" } } +{ $description "Reads the next token from parser input. If the token is a valid number literal, it is converted to a number, otherwise the vocabulary search path is searched for a word named by the token." } +{ $errors "Throws an error if the token does not name a word or end of file is reached." } $parsing-note ; { scan-word parse-word } related-words +HELP: scan-word-name +{ $values + { "string" string } +} +{ $description "Reads the next token from parser input and makes sure it does not parse as a number." } +{ $errors "Throws an error if the scanned token is a number." } +$parsing-note ; + +HELP: (scan-datum) +{ $values + { "word/number/f" "a word, a number, or " { $link f } } +} +{ $description "Reads the next token from parser input. If the token is found in the vocabulary search path, returns the word named by the token. If the token is a number instead, it is converted to a number. Otherwise returns " { $link f } "." } ; + +HELP: scan-datum +{ $values + { "word/number" "a word or a number" } +} +{ $description "Reads the next token from parser input. If the token is found in the vocabulary search path, returns the word named be the token. If the token is not found in the vocabulary search path, it is converted to a number. If this conversion fails, an error is thrown." } +{ $errors "Throws an error if the token is not a number or end of file is reached." } +$parsing-note ; + +HELP: scan-number +{ $values { "number" "a number" } } +{ $description "Reads the next token from parser input. If the token is a number literal, it is converted to a number." } +{ $errors "Throws an error if the token is not a number or end of file is reached." } +$parsing-note ; + HELP: parse-step { $values { "accum" vector } { "end" word } { "?" "a boolean" } } { $description "Parses a token. If the token is a number or an ordinary word, it is added to the accumulator. If it is a parsing word, calls the parsing word with the accumulator on the stack. Outputs " { $link f } " if " { $snippet "end" } " is encountered, " { $link t } " otherwise." } diff --git a/core/parser/parser.factor b/core/parser/parser.factor index 65b90338b0..3191f64007 100644 --- a/core/parser/parser.factor +++ b/core/parser/parser.factor @@ -47,16 +47,27 @@ SYMBOL: auto-use? : parse-word ( string -- word ) dup search [ ] [ no-word ] ?if ; -: parse-word/number ( string -- word/number ) +ERROR: number-expected ; + +: parse-number ( string -- number ) + string>number [ number-expected ] unless* ; + +: parse-datum ( string -- word/number ) dup search [ ] [ dup string>number [ ] [ no-word ] ?if ] ?if ; -: (scan-word) ( -- word/number/f ) - (scan-token) dup [ parse-word/number ] when ; +: (scan-datum) ( -- word/number/f ) + (scan-token) dup [ parse-datum ] when ; -: scan-word ( -- word/number ) - (scan-word) [ \ word unexpected-eof ] unless* ; +: scan-datum ( -- word/number ) + (scan-datum) [ \ word unexpected-eof ] unless* ; + +: scan-word ( -- word ) + (scan-token) parse-word ; + +: scan-number ( -- number ) + (scan-token) parse-number ; : scan-word-name ( -- string ) scan-token @@ -82,13 +93,13 @@ ERROR: staging-violation word ; (execute-parsing) ; : scan-object ( -- object ) - scan-word + scan-datum dup parsing-word? [ V{ } clone swap execute-parsing first ] when ; : parse-step ( accum end -- accum ? ) - (scan-word) { + (scan-datum) { { [ 2dup eq? ] [ 2drop f ] } { [ dup not ] [ drop unexpected-eof t ] } { [ dup delimiter? ] [ unexpected t ] } diff --git a/core/syntax/syntax.factor b/core/syntax/syntax.factor index a3b398be54..ceef21bc76 100644 --- a/core/syntax/syntax.factor +++ b/core/syntax/syntax.factor @@ -154,7 +154,7 @@ IN: bootstrap.syntax ] define-core-syntax "GENERIC#" [ - [ scan-word ] (GENERIC:) + [ scan-number ] (GENERIC:) ] define-core-syntax "MATH:" [