diff --git a/basis/alien/parser/parser.factor b/basis/alien/parser/parser.factor index 09fedc5e3c..a9cf10b9f9 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 ] map ] + [ [ "]" ?tail [ bad-array-type ] unless parse-word/number ] map ] [ (parse-c-type) ] bi* prefix ; @@ -70,7 +70,7 @@ ERROR: *-in-c-type-name name ; } cleave ; : CREATE-C-TYPE ( -- word ) - scan (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 (CREATE-C-TYPE) dup save-location ; + (scan-token) (CREATE-C-TYPE) dup save-location ; : parse-enum-base-type ( -- base-type token ) - scan dup "<" = - [ drop scan-object scan ] + (scan-token) dup "<" = + [ drop scan-object (scan-token) ] [ [ int ] dip ] if ; : parse-enum-member ( members name value -- members value' ) over "{" = - [ 2drop scan 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 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 parse-pointers ; + scan-c-type (scan-token) parse-pointers ; :: (scan-c-args) ( end-marker types names -- ) - scan :> type-str + (scan-token) :> type-str type-str end-marker = [ type-str { "(" ")" } member? [ type-str parse-c-type :> type - scan "," ?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/alien/syntax/syntax.factor b/basis/alien/syntax/syntax.factor index fe5a6dcadc..3630933899 100755 --- a/basis/alien/syntax/syntax.factor +++ b/basis/alien/syntax/syntax.factor @@ -13,7 +13,7 @@ SYNTAX: ALIEN: 16 scan-base suffix! ; SYNTAX: BAD-ALIEN suffix! ; -SYNTAX: LIBRARY: scan current-library set ; +SYNTAX: LIBRARY: scan-token current-library set ; SYNTAX: FUNCTION: (FUNCTION:) make-function define-inline ; @@ -35,9 +35,9 @@ SYNTAX: C-TYPE: void CREATE-C-TYPE typedef ; SYNTAX: &: - scan current-library get '[ _ _ address-of ] append! ; + scan-token current-library get '[ _ _ address-of ] append! ; -SYNTAX: C-GLOBAL: scan-c-type CREATE-WORD define-global ; +SYNTAX: C-GLOBAL: scan-c-type scan-new-word define-global ; SYNTAX: pointer: scan-c-type suffix! ; diff --git a/basis/bootstrap/image/syntax/syntax.factor b/basis/bootstrap/image/syntax/syntax.factor index 7025cd61e1..e8dff61430 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: - CREATE-WORD scan-word + scan-new-word scan-word [ swap special-objects get set-at ] [ drop define-symbol ] - 2bi ; \ No newline at end of file + 2bi ; diff --git a/basis/classes/struct/struct.factor b/basis/classes/struct/struct.factor index 1770444d8d..0f22ba6cc5 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 { @@ -364,7 +364,7 @@ PRIVATE> } case ; : parse-struct-definition ( -- class slots ) - CREATE-CLASS 8 [ parse-struct-slots ] [ ] while >array + scan-new-class 8 [ parse-struct-slots ] [ ] while >array dup [ name>> ] map check-duplicate-slots ; PRIVATE> @@ -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 { + (scan-token) { { ";" [ f ] } { "{" [ parse-struct-slot` t ] } [ invalid-struct-slot ] diff --git a/basis/cocoa/cocoa.factor b/basis/cocoa/cocoa.factor index 53f22addcb..558c4f5f26 100644 --- a/basis/cocoa/cocoa.factor +++ b/basis/cocoa/cocoa.factor @@ -14,14 +14,14 @@ SYMBOL: sent-messages : remember-send ( selector -- ) sent-messages (remember-send) ; -SYNTAX: -> scan dup remember-send suffix! \ send suffix! ; +SYNTAX: -> scan-token dup remember-send suffix! \ send suffix! ; SYMBOL: super-sent-messages : remember-super-send ( selector -- ) super-sent-messages (remember-send) ; -SYNTAX: SUPER-> scan dup remember-super-send suffix! \ super-send suffix! ; +SYNTAX: SUPER-> scan-token dup remember-super-send suffix! \ super-send suffix! ; SYMBOL: frameworks @@ -29,9 +29,9 @@ frameworks [ V{ } clone ] initialize [ frameworks get [ load-framework ] each ] "cocoa" add-startup-hook -SYNTAX: FRAMEWORK: scan [ load-framework ] [ frameworks get push ] bi ; +SYNTAX: FRAMEWORK: scan-token [ load-framework ] [ frameworks get push ] bi ; -SYNTAX: IMPORT: scan [ ] import-objc-class ; +SYNTAX: IMPORT: scan-token [ ] import-objc-class ; "Importing Cocoa classes..." print diff --git a/basis/colors/constants/constants.factor b/basis/colors/constants/constants.factor index c17d1069b2..6f1b3cb951 100644 --- a/basis/colors/constants/constants.factor +++ b/basis/colors/constants/constants.factor @@ -30,4 +30,4 @@ ERROR: no-such-color name ; : named-color ( name -- color ) dup colors at [ ] [ no-such-color ] ?if ; -SYNTAX: COLOR: scan named-color suffix! ; +SYNTAX: COLOR: scan-token named-color suffix! ; diff --git a/basis/colors/hex/hex.factor b/basis/colors/hex/hex.factor index a4b1aef7e5..c9f13b7236 100644 --- a/basis/colors/hex/hex.factor +++ b/basis/colors/hex/hex.factor @@ -13,4 +13,4 @@ IN: colors.hex [ red>> ] [ green>> ] [ blue>> ] tri [ 255 * >integer ] tri@ "%02X%02X%02X" sprintf ; -SYNTAX: HEXCOLOR: scan hex>rgba suffix! ; +SYNTAX: HEXCOLOR: scan-token hex>rgba suffix! ; diff --git a/basis/compiler/cfg/dataflow-analysis/dataflow-analysis.factor b/basis/compiler/cfg/dataflow-analysis/dataflow-analysis.factor index 553b843833..b5e9535d97 100644 --- a/basis/compiler/cfg/dataflow-analysis/dataflow-analysis.factor +++ b/basis/compiler/cfg/dataflow-analysis/dataflow-analysis.factor @@ -133,7 +133,7 @@ INSTANCE: name-analysis backward-analysis PRIVATE> SYNTAX: FORWARD-ANALYSIS: - scan [ define-analysis ] [ define-forward-analysis ] bi ; + scan-token [ define-analysis ] [ define-forward-analysis ] bi ; SYNTAX: BACKWARD-ANALYSIS: - scan [ define-analysis ] [ define-backward-analysis ] bi ; + scan-token [ define-analysis ] [ define-backward-analysis ] bi ; diff --git a/basis/compiler/cfg/instructions/syntax/syntax.factor b/basis/compiler/cfg/instructions/syntax/syntax.factor index 16a3ff4158..46517671b9 100644 --- a/basis/compiler/cfg/instructions/syntax/syntax.factor +++ b/basis/compiler/cfg/instructions/syntax/syntax.factor @@ -86,13 +86,13 @@ TUPLE: insn-slot-spec type name rep ; } 3cleave ; SYNTAX: INSN: - CREATE-CLASS insn-word ";" parse-tokens define-insn ; + scan-new-class insn-word ";" parse-tokens define-insn ; SYNTAX: VREG-INSN: - CREATE-CLASS vreg-insn-word ";" parse-tokens define-insn ; + scan-new-class vreg-insn-word ";" parse-tokens define-insn ; SYNTAX: FLUSHABLE-INSN: - CREATE-CLASS flushable-insn-word ";" parse-tokens define-insn ; + scan-new-class flushable-insn-word ";" parse-tokens define-insn ; SYNTAX: FOLDABLE-INSN: - CREATE-CLASS foldable-insn-word ";" parse-tokens define-insn ; + scan-new-class foldable-insn-word ";" parse-tokens define-insn ; diff --git a/basis/compiler/cfg/renaming/functor/functor.factor b/basis/compiler/cfg/renaming/functor/functor.factor index 1b7f6d5f0c..0e1cf5311d 100644 --- a/basis/compiler/cfg/renaming/functor/functor.factor +++ b/basis/compiler/cfg/renaming/functor/functor.factor @@ -74,4 +74,4 @@ insn-classes get [ insn-temp-slots empty? not ] filter [ ;FUNCTOR -SYNTAX: RENAMING: scan scan-object scan-object scan-object define-renaming ; \ No newline at end of file +SYNTAX: RENAMING: scan-token scan-object scan-object scan-object define-renaming ; diff --git a/basis/core-foundation/strings/strings.factor b/basis/core-foundation/strings/strings.factor index 11d28024f8..25cd16485b 100644 --- a/basis/core-foundation/strings/strings.factor +++ b/basis/core-foundation/strings/strings.factor @@ -97,6 +97,6 @@ FUNCTION: CFStringRef CFCopyTypeIDDescription ( CFTypeID type_id ) ; CFGetTypeID [ CFCopyTypeIDDescription &CFRelease CF>string ] with-destructors ; SYNTAX: CFSTRING: - CREATE scan-object + scan-new-word scan-object [ drop ] [ '[ _ [ _ ] initialize-alien ] ] 2bi (( -- alien )) define-declared ; diff --git a/basis/definitions/icons/icons.factor b/basis/definitions/icons/icons.factor index 90b8d3363c..1e5a0037be 100644 --- a/basis/definitions/icons/icons.factor +++ b/basis/definitions/icons/icons.factor @@ -24,7 +24,7 @@ icons [ H{ } clone ] initialize define ] 2bi ; -SYNTAX: ICON: scan-word scan define-icon ; +SYNTAX: ICON: scan-word scan-token define-icon ; >> diff --git a/basis/delegate/delegate.factor b/basis/delegate/delegate.factor index f37a562444..7958f51bc3 100644 --- a/basis/delegate/delegate.factor +++ b/basis/delegate/delegate.factor @@ -166,7 +166,7 @@ PRIVATE> ] 2bi ; SYNTAX: PROTOCOL: - CREATE-WORD parse-definition define-protocol ; + scan-new-word parse-definition define-protocol ; PREDICATE: protocol < word protocol-words ; ! Subclass of symbol? @@ -181,6 +181,6 @@ M: protocol definer drop \ PROTOCOL: \ ; ; M: protocol group-words protocol-words ; SYNTAX: SLOT-PROTOCOL: - CREATE-WORD ";" + scan-new-word ";" [ [ reader-word ] [ writer-word ] bi 2array ] map-tokens concat define-protocol ; diff --git a/basis/functors/backend/backend.factor b/basis/functors/backend/backend.factor index 9ade1d50f8..0bdbb03ab1 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 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 1895c6e0f4..64a3870926 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 { + (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 interpolate-locals ] dip + [ (scan-token) interpolate-locals ] dip '[ _ with-string-writer @ ] suffix! ; PRIVATE> @@ -175,7 +175,7 @@ DEFER: ;FUNCTOR delimiter pop-functor-words ; : (FUNCTOR:) ( -- word def effect ) - CREATE-WORD [ parse-functor-body ] parse-locals-definition ; + scan-new-word [ parse-functor-body ] parse-locals-definition ; PRIVATE> diff --git a/basis/gobject-introspection/gobject-introspection.factor b/basis/gobject-introspection/gobject-introspection.factor index 4973545333..09cd62f2d3 100755 --- a/basis/gobject-introspection/gobject-introspection.factor +++ b/basis/gobject-introspection/gobject-introspection.factor @@ -54,7 +54,7 @@ M: gir-not-found summary PRIVATE> -SYNTAX: GIR: scan define-gir-vocab ; +SYNTAX: GIR: scan-token define-gir-vocab ; SYNTAX: IMPLEMENT-STRUCTS: ";" parse-tokens diff --git a/basis/html/templates/chloe/syntax/syntax.factor b/basis/html/templates/chloe/syntax/syntax.factor index f7da0fe277..264559e2d8 100644 --- a/basis/html/templates/chloe/syntax/syntax.factor +++ b/basis/html/templates/chloe/syntax/syntax.factor @@ -14,7 +14,7 @@ tags [ H{ } clone ] initialize : define-chloe-tag ( name quot -- ) swap tags get set-at ; SYNTAX: CHLOE: - scan parse-definition define-chloe-tag ; + scan-token parse-definition define-chloe-tag ; CONSTANT: chloe-ns "http://factorcode.org/chloe/1.0" diff --git a/basis/io/encodings/8-bit/8-bit.factor b/basis/io/encodings/8-bit/8-bit.factor index db269c319d..17cb527073 100644 --- a/basis/io/encodings/8-bit/8-bit.factor +++ b/basis/io/encodings/8-bit/8-bit.factor @@ -54,4 +54,4 @@ M: 8-bit-encoding PRIVATE> -SYNTAX: 8-BIT: scan scan scan load-encoding ; +SYNTAX: 8-BIT: scan-token scan-token scan-token load-encoding ; diff --git a/basis/io/encodings/euc/euc.factor b/basis/io/encodings/euc/euc.factor index bf882fcfd0..a61046a5c7 100644 --- a/basis/io/encodings/euc/euc.factor +++ b/basis/io/encodings/euc/euc.factor @@ -65,4 +65,4 @@ PRIVATE> SYNTAX: EUC: ! EUC: euc-kr "vocab:io/encodings/korean/cp949.txt" - CREATE-CLASS scan-object define-euc ; + scan-new-class scan-object define-euc ; diff --git a/basis/locals/locals.factor b/basis/locals/locals.factor index 5fd12e2fb3..c7b05e0120 100644 --- a/basis/locals/locals.factor +++ b/basis/locals/locals.factor @@ -6,7 +6,7 @@ locals.errors ; IN: locals SYNTAX: :> - scan locals get [ :>-outside-lambda-error ] unless* + scan-token locals get [ :>-outside-lambda-error ] unless* parse-def suffix! ; SYNTAX: [| parse-lambda append! ; diff --git a/basis/locals/parser/parser.factor b/basis/locals/parser/parser.factor index 5248d50ced..09f75a0fa0 100644 --- a/basis/locals/parser/parser.factor +++ b/basis/locals/parser/parser.factor @@ -76,12 +76,12 @@ M: lambda-parser parse-quotation ( -- quotation ) [ drop nip ] 3tri ; inline : (::) ( -- word def effect ) - CREATE-WORD + scan-new-word [ parse-definition ] parse-locals-definition ; : (M::) ( -- word def ) - CREATE-METHOD + scan-new-method [ [ parse-definition ] parse-locals-definition drop diff --git a/basis/logging/logging.factor b/basis/logging/logging.factor index 7542c269bd..0521951574 100644 --- a/basis/logging/logging.factor +++ b/basis/logging/logging.factor @@ -138,7 +138,7 @@ PRIVATE> SYNTAX: LOG: #! Syntax: name level - CREATE-WORD dup scan-word + scan-new-word dup scan-word '[ 1array stack>message _ _ log-message ] (( message -- )) define-declared ; diff --git a/basis/math/vectors/simd/cords/cords.factor b/basis/math/vectors/simd/cords/cords.factor index cc3aa023e7..37f1d6db51 100644 --- a/basis/math/vectors/simd/cords/cords.factor +++ b/basis/math/vectors/simd/cords/cords.factor @@ -79,7 +79,7 @@ SYNTAX: A{ \ } [ >A ] parse-literal ; [ create-in (define-simd-128-cord) ] 2bi ; SYNTAX: SIMD-128-CORD: - scan-word scan define-simd-128-cord ; + scan-word scan-token define-simd-128-cord ; PRIVATE> >> diff --git a/basis/math/vectors/simd/simd.factor b/basis/math/vectors/simd/simd.factor index 1c2f61c7c6..dcd200ee08 100644 --- a/basis/math/vectors/simd/simd.factor +++ b/basis/math/vectors/simd/simd.factor @@ -309,7 +309,7 @@ c: ;FUNCTOR SYNTAX: SIMD-128: - scan define-simd-128 ; + scan-token define-simd-128 ; PRIVATE> diff --git a/basis/multiline/multiline.factor b/basis/multiline/multiline.factor index 1b62513abf..51efecc9cd 100644 --- a/basis/multiline/multiline.factor +++ b/basis/multiline/multiline.factor @@ -32,7 +32,7 @@ ERROR: text-found-before-eol string ; ] "" make but-last ; SYNTAX: STRING: - CREATE-WORD + scan-new-word parse-here 1quotation (( -- string )) define-inline ; diff --git a/basis/openssl/libssl/libssl.factor b/basis/openssl/libssl/libssl.factor index 148f12e017..1f4fe9b869 100644 --- a/basis/openssl/libssl/libssl.factor +++ b/basis/openssl/libssl/libssl.factor @@ -280,7 +280,7 @@ H{ } clone verify-messages set-global : verify-message ( n -- word ) verify-messages get-global at ; SYNTAX: X509_V_: - scan "X509_V_" prepend create-in + scan-token "X509_V_" prepend create-in scan-word [ 1quotation (( -- value )) define-inline ] [ verify-messages get set-at ] diff --git a/basis/peg/ebnf/ebnf.factor b/basis/peg/ebnf/ebnf.factor index eac9c21fd6..d808b9aaa0 100644 --- a/basis/peg/ebnf/ebnf.factor +++ b/basis/peg/ebnf/ebnf.factor @@ -49,7 +49,7 @@ M: no-tokenizer summary drop "Tokenizer not found" ; SYNTAX: TOKENIZER: - scan dup search [ nip ] [ no-tokenizer ] if* + scan-word-name dup search [ nip ] [ no-tokenizer ] if* execute( -- tokenizer ) \ tokenizer set-global ; TUPLE: ebnf-non-terminal symbol ; @@ -570,7 +570,7 @@ SYNTAX: [EBNF suffix! \ call suffix! reset-tokenizer ; SYNTAX: EBNF: - reset-tokenizer CREATE-WORD dup ";EBNF" parse-multiline-string + reset-tokenizer scan-new-word dup ";EBNF" parse-multiline-string ebnf>quot swapd (( input -- ast )) define-declared "ebnf-parser" set-word-prop reset-tokenizer ; diff --git a/basis/roman/roman.factor b/basis/roman/roman.factor index 588166829a..be7c70431d 100644 --- a/basis/roman/roman.factor +++ b/basis/roman/roman.factor @@ -69,4 +69,4 @@ ROMAN-OP: * ( x y -- z ) ROMAN-OP: /i ( x y -- z ) ROMAN-OP: /mod ( x y -- z w ) -SYNTAX: ROMAN: scan roman> suffix! ; +SYNTAX: ROMAN: scan-token roman> suffix! ; diff --git a/basis/tools/test/test.factor b/basis/tools/test/test.factor index b789fa8537..79399123af 100644 --- a/basis/tools/test/test.factor +++ b/basis/tools/test/test.factor @@ -104,7 +104,7 @@ MACRO: ( word -- ) << SYNTAX: TEST: - scan + scan-token [ create-in ] [ "(" ")" surround search '[ _ parse-test ] ] bi define-syntax ; diff --git a/basis/tr/tr.factor b/basis/tr/tr.factor index 690103edf5..c7a21c3cb2 100644 --- a/basis/tr/tr.factor +++ b/basis/tr/tr.factor @@ -41,7 +41,7 @@ M: bad-tr summary PRIVATE> SYNTAX: TR: - scan parse-definition + scan-token parse-definition unclip-last [ unclip-last ] dip compute-tr [ check-tr ] [ [ create-tr ] dip define-tr ] diff --git a/basis/ui/pixel-formats/pixel-formats.factor b/basis/ui/pixel-formats/pixel-formats.factor index c0a645629b..e0cd9ede62 100644 --- a/basis/ui/pixel-formats/pixel-formats.factor +++ b/basis/ui/pixel-formats/pixel-formats.factor @@ -87,7 +87,7 @@ M: pixel-format-attribute >PFA ;FUNCTOR SYNTAX: PIXEL-FORMAT-ATTRIBUTE-TABLE: - scan scan-object scan-object define-pixel-format-attribute-table ; + scan-token scan-object scan-object define-pixel-format-attribute-table ; PRIVATE> diff --git a/basis/ui/ui.factor b/basis/ui/ui.factor index 9837938c0a..7a7868149d 100644 --- a/basis/ui/ui.factor +++ b/basis/ui/ui.factor @@ -226,7 +226,7 @@ HOOK: system-alert ui-backend ( caption text -- ) ] [ 2drop current-vocab main<< ] 3bi ; SYNTAX: MAIN-WINDOW: - CREATE + scan-new-word world-attributes parse-main-window-attributes parse-definition define-main-window ; diff --git a/basis/unicode/categories/syntax/syntax.factor b/basis/unicode/categories/syntax/syntax.factor index 849f361fcd..4c763bd2bc 100644 --- a/basis/unicode/categories/syntax/syntax.factor +++ b/basis/unicode/categories/syntax/syntax.factor @@ -23,7 +23,7 @@ SYMBOLS: Cn Lu Ll Lt Lm Lo Mn Mc Me Nd Nl No Pc Pd Ps Pe Pi Pf Po Sm Sc Sk So Zs [category] [ not ] compose integer-predicate-class ; : parse-category ( -- word tokens quot ) - CREATE-CLASS \ ; parse-until { | } split1 + scan-new-class \ ; parse-until { | } split1 [ [ name>> categories-map at ] map ] [ [ [ ] like ] [ [ drop f ] ] if* ] bi* ; diff --git a/basis/values/values.factor b/basis/values/values.factor index 8154c7db59..0189742ad4 100644 --- a/basis/values/values.factor +++ b/basis/values/values.factor @@ -31,7 +31,7 @@ PREDICATE: value-word < word } 1&& ; SYNTAX: VALUE: - CREATE-WORD + scan-new-word dup t "no-def-strip" set-word-prop T{ value-holder } clone [ obj>> ] curry (( -- value )) define-declared ; diff --git a/basis/windows/com/syntax/syntax.factor b/basis/windows/com/syntax/syntax.factor index 27105992ec..83c9b38790 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 dup ";" = [ drop ] [ - parse-c-type scan parse-pointers + (scan-token) dup ";" = [ drop ] [ + parse-c-type (scan-token) parse-pointers (parse-com-function) functions push functions (parse-com-functions) ] if ; @@ -86,13 +86,13 @@ SYNTAX: COM-INTERFACE: CREATE-C-TYPE void* over typedef scan-object find-com-interface-definition - scan string>guid + scan-token string>guid parse-com-functions dup save-com-interface-definition define-words-for-com-interface ; -SYNTAX: GUID: scan string>guid suffix! ; +SYNTAX: GUID: scan-token string>guid suffix! ; USE: vocabs.loader diff --git a/basis/xml/syntax/syntax.factor b/basis/xml/syntax/syntax.factor index 6455d7ba0b..0b880e259c 100644 --- a/basis/xml/syntax/syntax.factor +++ b/basis/xml/syntax/syntax.factor @@ -28,16 +28,16 @@ M: no-tag summary PRIVATE> SYNTAX: TAGS: - CREATE-WORD complete-effect + scan-new-word complete-effect [ drop H{ } clone "xtable" set-word-prop ] [ define-tags ] 2bi ; SYNTAX: TAG: - scan scan-word parse-definition define-tag ; + scan-token scan-word parse-definition define-tag ; SYNTAX: XML-NS: - CREATE-WORD scan '[ f swap _ ] (( string -- name )) define-memoized ; + scan-new-word scan-token '[ f swap _ ] (( string -- name )) define-memoized ; : parse-effect-token ( first? var end -- var more? ) - scan { + (scan-token) { { [ end-token? ] [ drop nip f ] } { [ effect-opener? ] [ bad-effect ] } { [ effect-closer? ] [ stack-effect-omits-dashes ] } @@ -58,6 +58,6 @@ PRIVATE> [ ")" parse-effect ] dip 2array append! ; : (:) ( -- word def effect ) - CREATE-WORD + scan-new-word complete-effect parse-definition swap ; diff --git a/core/generic/parser/parser.factor b/core/generic/parser/parser.factor index 11fb2b5b42..652fafc2e3 100644 --- a/core/generic/parser/parser.factor +++ b/core/generic/parser/parser.factor @@ -5,10 +5,10 @@ IN: generic.parser ERROR: not-in-a-method-error ; -: CREATE-GENERIC ( -- word ) CREATE dup reset-word ; +: scan-new-generic ( -- word ) scan-new dup reset-word ; : (GENERIC:) ( quot -- ) - [ CREATE-GENERIC ] dip call complete-effect define-generic ; inline + [ scan-new-generic ] dip call complete-effect define-generic ; inline : create-method-in ( class generic -- method ) create-method dup set-word dup save-location ; @@ -16,7 +16,7 @@ ERROR: not-in-a-method-error ; : define-inline-method ( class generic quot -- ) [ create-method-in ] dip [ define ] [ drop make-inline ] 2bi ; -: CREATE-METHOD ( -- method ) +: scan-new-method ( -- method ) scan-word bootstrap-word scan-word create-method-in ; SYMBOL: current-method @@ -25,5 +25,5 @@ SYMBOL: current-method over current-method set call current-method off ; inline : (M:) ( -- method def ) - CREATE-METHOD [ parse-definition ] with-method-definition ; + scan-new-method [ parse-definition ] with-method-definition ; diff --git a/core/lexer/lexer-docs.factor b/core/lexer/lexer-docs.factor index 0fbf3b3563..c5ce3a39ad 100644 --- a/core/lexer/lexer-docs.factor +++ b/core/lexer/lexer-docs.factor @@ -57,14 +57,14 @@ HELP: parse-token { $values { "lexer" lexer } { "str/f" { $maybe string } } } { $description "Reads the next token from the lexer. Tokens are delimited by whitespace, with the exception that " { $snippet "\"" } " is treated like a single token even when not followed by whitespace." } ; -HELP: scan +HELP: (scan-token) { $values { "str/f" { $maybe string } } } { $description "Reads the next token from the lexer. Tokens are delimited by whitespace, with the exception that " { $snippet "\"" } " is treated like a single token even when not followed by whitespace. This word outputs " { $link f } " on end of input. To throw an error on end of input, use " { $link scan-token } " instead." } $parsing-note ; HELP: scan-token { $values { "str" string } } -{ $description "Reads the next token from the lexer. Tokens are delimited by whitespace, with the exception that " { $snippet "\"" } " is treated like a single token even when not followed by whitespace. This word throws " { $link unexpected-eof } " on end of input. To output " { $link f } " on end of input, use " { $link scan } " instead." } +{ $description "Reads the next token from the lexer. Tokens are delimited by whitespace, with the exception that " { $snippet "\"" } " is treated like a single token even when not followed by whitespace. This word throws " { $link unexpected-eof } " on end of input. To output " { $link f } " on end of input, use " { $link (scan-token) } " instead." } $parsing-note ; HELP: still-parsing? @@ -102,7 +102,7 @@ HELP: unexpected-eof HELP: with-lexer { $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-token } ". Any errors thrown by the quotation are wrapped in " { $link lexer-error } " instances." } ; HELP: lexer-factory { $var-description "A variable holding a quotation with stack effect " { $snippet "( lines -- lexer )" } ". This quotation is called by the parser to create " { $link lexer } " instances. This variable can be rebound to a quotation which outputs a custom tuple delegating to " { $link lexer } " to customize syntax." } ; diff --git a/core/lexer/lexer.factor b/core/lexer/lexer.factor index 8f373640d3..8caaf78403 100644 --- a/core/lexer/lexer.factor +++ b/core/lexer/lexer.factor @@ -84,13 +84,13 @@ M: lexer skip-word ( lexer -- ) [ (parse-token) ] [ dup next-line parse-token ] if ] [ drop f ] if ; -: scan ( -- str/f ) lexer get parse-token ; +: (scan-token) ( -- str/f ) lexer get parse-token ; PREDICATE: unexpected-eof < unexpected got>> not ; : unexpected-eof ( word -- * ) f unexpected ; -: scan-token ( -- str ) scan [ "token" unexpected-eof ] unless* ; +: scan-token ( -- str ) (scan-token) [ "token" unexpected-eof ] unless* ; : expect ( token -- ) scan-token 2dup = [ 2drop ] [ unexpected ] if ; diff --git a/core/parser/parser-docs.factor b/core/parser/parser-docs.factor index 716dcf4914..2766f5aac9 100644 --- a/core/parser/parser-docs.factor +++ b/core/parser/parser-docs.factor @@ -9,12 +9,13 @@ ARTICLE: "reading-ahead" "Reading ahead" "Parsing words can consume input:" { $subsections scan-token + scan-word scan-object } "Lower-level words:" { $subsections - scan - scan-word + (scan-token) + (scan-word) } "For example, the " { $link POSTPONE: HEX: } " word uses this feature to read hexadecimal literals:" { $see POSTPONE: HEX: } @@ -39,14 +40,14 @@ $nl ARTICLE: "defining-words" "Defining words" "Defining words add definitions to the dictionary without modifying the parse tree. The simplest example is the " { $link POSTPONE: SYMBOL: } " word." { $see POSTPONE: SYMBOL: } -"The key factor in the definition of " { $link POSTPONE: SYMBOL: } " is " { $link CREATE } ", which reads a token from the input and creates a word with that name. This word is then passed to " { $link define-symbol } "." +"The key factor in the definition of " { $link POSTPONE: SYMBOL: } " is " { $link scan-new } ", which reads a token from the input and creates a word with that name. This word is then passed to " { $link define-symbol } "." { $subsections - CREATE - CREATE-WORD + scan-new + scan-new-word } "Colon definitions are defined in a more elaborate way:" { $subsections POSTPONE: : } -"The " { $link POSTPONE: : } " word first calls " { $link CREATE } ", and then reads input until reaching " { $link POSTPONE: ; } " using a utility word:" +"The " { $link POSTPONE: : } " word first calls " { $link scan-new } ", and then reads input until reaching " { $link POSTPONE: ; } " using a utility word:" { $subsections parse-definition } "The " { $link POSTPONE: ; } " word is just a delimiter; an unpaired occurrence throws a parse error:" { $see POSTPONE: ; } @@ -129,7 +130,7 @@ HELP: create-in { $description "Creates a word in the current vocabulary. Until re-defined, the word throws an error when invoked." } $parsing-note ; -HELP: CREATE +HELP: scan-new { $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." } { $errors "Throws an error if the end of the line is reached." } @@ -144,13 +145,19 @@ HELP: no-word { $description "Throws a " { $link no-word-error } "." } ; HELP: parse-word -{ $values { "string" string } { "word/number" "a word or number" } } +{ $values { "string" string } { "word" "a 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 } "." } ; +HELP: parse-word/number +{ $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) } "." } ; + HELP: scan-word -{ $values { "word/number/f" "a word, number or " { $link f } } } +{ $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." } $parsing-note ; diff --git a/core/parser/parser-tests.factor b/core/parser/parser-tests.factor index 842e5c607f..e96d7600d5 100644 --- a/core/parser/parser-tests.factor +++ b/core/parser/parser-tests.factor @@ -624,3 +624,13 @@ EXCLUDE: qualified.tests.bar => x ; [ ] [ "vocabs.loader.test.l" unuse-vocab ] unit-test [ f ] [ "vocabs.loader.test.l" manifest get search-vocab-names>> key? ] unit-test ] with-file-vocabs + +! Test cases for #183 +[ "SINGLETON: 33" "class identifier test" parse-stream ] +[ error>> lexer-error? ] must-fail-with + +[ ": 44 ( -- ) ;" "word identifier test" parse-stream ] +[ error>> lexer-error? ] must-fail-with + +[ "GENERIC: 33 ( -- )" "generic identifier test" parse-stream ] +[ error>> lexer-error? ] must-fail-with diff --git a/core/parser/parser.factor b/core/parser/parser.factor index 4f2d9b5634..65b90338b0 100644 --- a/core/parser/parser.factor +++ b/core/parser/parser.factor @@ -20,10 +20,6 @@ M: parsing-word stack-effect drop (( parsed -- parsed )) ; : create-in ( str -- word ) current-vocab create dup set-word dup save-location ; -: CREATE ( -- word ) scan create-in ; - -: CREATE-WORD ( -- word ) CREATE dup reset-generic ; - SYMBOL: auto-use? : no-word-restarted ( restart-value -- word ) @@ -48,13 +44,31 @@ SYMBOL: auto-use? [ drop throw-restarts no-word-restarted ] if ; -: parse-word ( string -- word/number ) +: parse-word ( string -- word ) + dup search [ ] [ no-word ] ?if ; + +: parse-word/number ( string -- word/number ) dup search [ ] [ dup string>number [ ] [ no-word ] ?if ] ?if ; -: scan-word ( -- word/number/f ) - scan dup [ parse-word ] when ; +: (scan-word) ( -- word/number/f ) + (scan-token) dup [ parse-word/number ] when ; + +: scan-word ( -- word/number ) + (scan-word) [ \ word unexpected-eof ] unless* ; + +: scan-word-name ( -- string ) + scan-token + dup string>number [ + "Word names cannot be numbers" throw + ] when ; + +: scan-new ( -- word ) + scan-word-name create-in ; + +: scan-new-word ( -- word ) + scan-new dup reset-generic ; ERROR: staging-violation word ; @@ -68,14 +82,13 @@ ERROR: staging-violation word ; (execute-parsing) ; : scan-object ( -- object ) - scan-word { - { [ dup not ] [ unexpected-eof ] } - { [ dup parsing-word? ] [ V{ } clone swap execute-parsing first ] } - [ ] - } cond ; + scan-word + dup parsing-word? [ + V{ } clone swap execute-parsing first + ] when ; : parse-step ( accum end -- accum ? ) - scan-word { + (scan-word) { { [ 2dup eq? ] [ 2drop f ] } { [ dup not ] [ drop unexpected-eof t ] } { [ dup delimiter? ] [ unexpected t ] } @@ -110,7 +123,7 @@ M: f parse-quotation \ ] parse-until >quotation ; ERROR: bad-number ; : scan-base ( base -- n ) - scan swap base> [ bad-number ] unless* ; + scan-token swap base> [ bad-number ] unless* ; : parse-base ( parsed base -- parsed ) scan-base suffix! ; diff --git a/core/syntax/syntax.factor b/core/syntax/syntax.factor index 864c67d172..a3b398be54 100644 --- a/core/syntax/syntax.factor +++ b/core/syntax/syntax.factor @@ -117,11 +117,11 @@ IN: bootstrap.syntax "deprecated" [ word make-deprecated ] define-core-syntax "SYNTAX:" [ - CREATE-WORD parse-definition define-syntax + scan-new-word parse-definition define-syntax ] define-core-syntax "SYMBOL:" [ - CREATE-WORD define-symbol + scan-new-word define-symbol ] define-core-syntax "SYMBOLS:" [ @@ -138,11 +138,11 @@ IN: bootstrap.syntax ] define-core-syntax "ALIAS:" [ - CREATE-WORD scan-word define-alias + scan-new-word scan-word define-alias ] define-core-syntax "CONSTANT:" [ - CREATE-WORD scan-object define-constant + scan-new-word scan-object define-constant ] define-core-syntax ":" [ @@ -170,15 +170,15 @@ IN: bootstrap.syntax ] define-core-syntax "UNION:" [ - CREATE-CLASS parse-definition define-union-class + scan-new-class parse-definition define-union-class ] define-core-syntax "INTERSECTION:" [ - CREATE-CLASS parse-definition define-intersection-class + scan-new-class parse-definition define-intersection-class ] define-core-syntax "MIXIN:" [ - CREATE-CLASS define-mixin-class + scan-new-class define-mixin-class ] define-core-syntax "INSTANCE:" [ @@ -189,14 +189,14 @@ IN: bootstrap.syntax ] define-core-syntax "PREDICATE:" [ - CREATE-CLASS + scan-new-class "<" expect scan-word parse-definition define-predicate-class ] define-core-syntax "SINGLETON:" [ - CREATE-CLASS define-singleton-class + scan-new-class define-singleton-class ] define-core-syntax "TUPLE:" [ @@ -212,7 +212,7 @@ IN: bootstrap.syntax ] define-core-syntax "C:" [ - CREATE-WORD scan-word define-boa-word + scan-new-word scan-word define-boa-word ] define-core-syntax "ERROR:" [ diff --git a/extra/calendar/holidays/holidays.factor b/extra/calendar/holidays/holidays.factor index 7a87a1df45..cfae6028bb 100644 --- a/extra/calendar/holidays/holidays.factor +++ b/extra/calendar/holidays/holidays.factor @@ -8,7 +8,7 @@ SINGLETONS: all world commonwealth-of-nations ; << SYNTAX: HOLIDAY: - CREATE-WORD + scan-new-word dup "holiday" word-prop [ dup H{ } clone "holiday" set-word-prop ] unless diff --git a/extra/cpu/8080/emulator/emulator.factor b/extra/cpu/8080/emulator/emulator.factor index 015d98157f..914f7a17a9 100644 --- a/extra/cpu/8080/emulator/emulator.factor +++ b/extra/cpu/8080/emulator/emulator.factor @@ -1397,10 +1397,10 @@ SYNTAX: INSTRUCTION: ";" parse-tokens parse-instructions ; SYNTAX: cycles #! Set the number of cycles for the last instruction that was defined. - scan string>number last-opcode global at instruction-cycles set-nth ; + scan-token string>number last-opcode global at instruction-cycles set-nth ; SYNTAX: opcode ( -- ) #! Set the opcode number for the last instruction that was defined. - last-instruction global at 1quotation scan 16 base> + last-instruction global at 1quotation scan-token 16 base> dup last-opcode global set-at set-instruction ; diff --git a/extra/cpu/arm/assembler/assembler.factor b/extra/cpu/arm/assembler/assembler.factor index 38e385020f..1ef5692b65 100644 --- a/extra/cpu/arm/assembler/assembler.factor +++ b/extra/cpu/arm/assembler/assembler.factor @@ -12,7 +12,7 @@ SYMBOL: registers V{ } registers set-global SYNTAX: REGISTER: - CREATE-WORD + scan-new-word [ define-symbol ] [ registers get length "register" set-word-prop ] [ registers get push ] diff --git a/extra/cuda/syntax/syntax.factor b/extra/cuda/syntax/syntax.factor index 09b7786cf9..e3173995e2 100644 --- a/extra/cuda/syntax/syntax.factor +++ b/extra/cuda/syntax/syntax.factor @@ -5,14 +5,14 @@ fry kernel lexer namespaces parser ; IN: cuda.syntax SYNTAX: CUDA-LIBRARY: - scan scan-word scan + scan-token scan-word scan-token '[ _ _ add-cuda-library ] [ current-cuda-library set-global ] bi ; SYNTAX: CUDA-FUNCTION: - scan [ create-in current-cuda-library get ] keep + scan-token [ create-in current-cuda-library get ] keep ";" scan-c-args drop define-cuda-function ; SYNTAX: CUDA-GLOBAL: - scan [ create-in current-cuda-library get ] keep + scan-token [ create-in current-cuda-library get ] keep define-cuda-global ; diff --git a/extra/decimals/decimals.factor b/extra/decimals/decimals.factor index d5c62fee5e..3cd51abc98 100644 --- a/extra/decimals/decimals.factor +++ b/extra/decimals/decimals.factor @@ -18,7 +18,7 @@ TUPLE: decimal { mantissa read-only } { exponent read-only } ; [ [ CHAR: 0 = ] trim-tail [ "" ] when-empty ] bi* [ append string>number ] [ nip length neg ] 2bi ; -: parse-decimal ( -- decimal ) scan string>decimal ; +: parse-decimal ( -- decimal ) scan-token string>decimal ; SYNTAX: D: parse-decimal suffix! ; diff --git a/extra/game/worlds/worlds.factor b/extra/game/worlds/worlds.factor index 8ce720f983..d48aa94f65 100644 --- a/extra/game/worlds/worlds.factor +++ b/extra/game/worlds/worlds.factor @@ -82,7 +82,7 @@ M: game-world apply-world-attributes [ name>> "-attributes" append create-in ] dip define-constant ; SYNTAX: GAME: - CREATE + scan-new-word game-attributes parse-main-window-attributes 2dup define-attributes-word parse-definition diff --git a/extra/gpu/render/render.factor b/extra/gpu/render/render.factor index ed75f218de..72880a39f4 100755 --- a/extra/gpu/render/render.factor +++ b/extra/gpu/render/render.factor @@ -507,7 +507,7 @@ DEFER: [bind-uniform-tuple] ] 3bi ; : parse-uniform-tuple-definition ( -- class superclass uniforms ) - CREATE-CLASS scan { + scan-new-class scan-token { { ";" [ uniform-tuple f ] } { "<" [ scan-word parse-definition [ first3 uniform boa ] map ] } { "{" [ diff --git a/extra/gpu/shaders/shaders.factor b/extra/gpu/shaders/shaders.factor index b032004d40..8302547b39 100755 --- a/extra/gpu/shaders/shaders.factor +++ b/extra/gpu/shaders/shaders.factor @@ -356,7 +356,7 @@ PRIVATE> [ "vertex-format-attributes" set-word-prop ] 2bi ; SYNTAX: VERTEX-FORMAT: - CREATE-CLASS parse-definition + scan-new-class parse-definition [ first4 vertex-attribute boa ] map define-vertex-format ; @@ -365,7 +365,7 @@ SYNTAX: VERTEX-FORMAT: define-struct-class ; SYNTAX: VERTEX-STRUCT: - CREATE-CLASS scan-word define-vertex-struct ; + scan-new-class scan-word define-vertex-struct ; TUPLE: vertex-array-object < gpu-object { program-instance program-instance read-only } @@ -589,7 +589,7 @@ TYPED: ( program: program -- instance: program-instance ) PRIVATE> SYNTAX: GLSL-SHADER: - CREATE dup + scan-new dup dup old-instances [ scan-word f @@ -601,7 +601,7 @@ SYNTAX: GLSL-SHADER: define-constant ; SYNTAX: GLSL-SHADER-FILE: - CREATE dup + scan-new dup dup old-instances [ scan-word execute( -- kind ) scan-object in-word's-path @@ -613,7 +613,7 @@ SYNTAX: GLSL-SHADER-FILE: define-constant ; SYNTAX: GLSL-PROGRAM: - CREATE dup + scan-new dup dup old-instances [ f lexer get line>> diff --git a/extra/irc/messages/base/base.factor b/extra/irc/messages/base/base.factor index f0f9ca02ce..7a9f849dea 100644 --- a/extra/irc/messages/base/base.factor +++ b/extra/irc/messages/base/base.factor @@ -110,7 +110,7 @@ PRIVATE> #! IRC: type "COMMAND" slot1 ...; #! IRC: type "COMMAND" slot1 ... : trailing-slot; SYNTAX: IRC: ( name string parameters -- ) - CREATE-CLASS + scan-new-class [ scan-object register-irc-message-type ] keep ";" parse-tokens [ define-irc-class ] [ define-irc-parameter-slots ] 2bi ; diff --git a/extra/money/money.factor b/extra/money/money.factor index 6cafeff289..a3ac4ebb13 100644 --- a/extra/money/money.factor +++ b/extra/money/money.factor @@ -30,4 +30,4 @@ ERROR: not-an-integer x ; ] keep length 10^ / + swap [ neg ] when ; -SYNTAX: DECIMAL: scan parse-decimal suffix! ; +SYNTAX: DECIMAL: scan-token parse-decimal suffix! ; diff --git a/extra/multi-methods/multi-methods.factor b/extra/multi-methods/multi-methods.factor index ebe60e00f6..d46c30a17c 100644 --- a/extra/multi-methods/multi-methods.factor +++ b/extra/multi-methods/multi-methods.factor @@ -224,7 +224,7 @@ M: no-method error. ] if ; ! Syntax -SYNTAX: GENERIC: CREATE-WORD complete-effect define-generic ; +SYNTAX: GENERIC: scan-new-word complete-effect define-generic ; : parse-method ( -- quot classes generic ) parse-definition [ 2 tail ] [ second ] [ first ] tri ; @@ -232,10 +232,10 @@ SYNTAX: GENERIC: CREATE-WORD complete-effect define-generic ; : create-method-in ( specializer generic -- method ) create-method dup save-location f set-word ; -: CREATE-METHOD ( -- method ) +: scan-new-method ( -- method ) scan-word scan-object swap create-method-in ; -: (METHOD:) ( -- method def ) CREATE-METHOD parse-definition ; +: (METHOD:) ( -- method def ) scan-new-method parse-definition ; SYNTAX: METHOD: (METHOD:) define ; diff --git a/extra/opencl/syntax/syntax.factor b/extra/opencl/syntax/syntax.factor index e9dbabd7fc..bd9589d956 100644 --- a/extra/opencl/syntax/syntax.factor +++ b/extra/opencl/syntax/syntax.factor @@ -5,4 +5,4 @@ sequences ; IN: opencl.syntax SYNTAX: SINGLETONS-UNION: - CREATE-CLASS ";" parse-tokens [ create-class-in [ define-singleton-class ] keep ] map define-union-class ; + scan-new-class ";" parse-tokens [ create-class-in [ define-singleton-class ] keep ] map define-union-class ; diff --git a/extra/pair-methods/pair-methods.factor b/extra/pair-methods/pair-methods.factor index 131f9f5465..28a1182cf2 100644 --- a/extra/pair-methods/pair-methods.factor +++ b/extra/pair-methods/pair-methods.factor @@ -37,7 +37,7 @@ ERROR: no-pair-method a b generic ; [ drop make-pair-generic ] 2tri ; : (PAIR-GENERIC:) ( -- ) - CREATE-GENERIC complete-effect define-pair-generic ; + scan-new-generic complete-effect define-pair-generic ; SYNTAX: PAIR-GENERIC: (PAIR-GENERIC:) ; diff --git a/extra/roles/roles.factor b/extra/roles/roles.factor index d54b4339a7..3a58be9830 100644 --- a/extra/roles/roles.factor +++ b/extra/roles/roles.factor @@ -12,7 +12,7 @@ PREDICATE: role < mixin-class "role-slots" word-prop >boolean ; : parse-role-definition ( -- class superroles slots ) - CREATE-CLASS scan { + scan-new-class scan-token { { ";" [ { } { } ] } { "<" [ scan-word 1array [ parse-tuple-slots ] { } make ] } { "<{" [ \ } parse-until >array [ parse-tuple-slots ] { } make ] } diff --git a/extra/smalltalk/selectors/selectors.factor b/extra/smalltalk/selectors/selectors.factor index 6094986345..8485430018 100644 --- a/extra/smalltalk/selectors/selectors.factor +++ b/extra/smalltalk/selectors/selectors.factor @@ -25,4 +25,4 @@ SYMBOLS: unary binary keyword ; [ selector>effect ] bi define-simple-generic ; -SYNTAX: SELECTOR: scan selector>generic drop ; \ No newline at end of file +SYNTAX: SELECTOR: scan-token selector>generic drop ; diff --git a/extra/units/reduction/reduction.factor b/extra/units/reduction/reduction.factor index 52279771f9..6f67f163fa 100644 --- a/extra/units/reduction/reduction.factor +++ b/extra/units/reduction/reduction.factor @@ -55,4 +55,4 @@ ERROR: bad-storage-string string reason ; : n>money ( n -- string ) 3 10 { "" "K" "M" "B" "T" } reduce-magnitude ; -SYNTAX: STORAGE: scan storage>n suffix! ; +SYNTAX: STORAGE: scan-token storage>n suffix! ; diff --git a/extra/variables/variables.factor b/extra/variables/variables.factor index e4632d04ea..1ce77f66a6 100644 --- a/extra/variables/variables.factor +++ b/extra/variables/variables.factor @@ -35,7 +35,7 @@ SYNTAX: set: dup [ [variable-getter] ] [ [variable-setter] ] bi (define-variable) ; SYNTAX: VAR: - CREATE-WORD define-variable ; + scan-new-word define-variable ; M: variable definer drop \ VAR: f ; M: variable definition drop f ; @@ -59,7 +59,7 @@ PREDICATE: typed-variable < variable } 2cleave (define-variable) ; SYNTAX: TYPED-VAR: - CREATE-WORD scan-object define-typed-variable ; + scan-new-word scan-object define-typed-variable ; M: typed-variable definer drop \ TYPED-VAR: f ; M: typed-variable definition "variable-type" word-prop 1quotation ; @@ -78,7 +78,7 @@ PREDICATE: global-variable < variable global-box new [ [global-getter] ] [ [global-setter] ] bi (define-variable) ; SYNTAX: GLOBAL: - CREATE-WORD define-global ; + scan-new-word define-global ; M: global-variable definer drop \ GLOBAL: f ; @@ -92,7 +92,7 @@ INTERSECTION: typed-global-variable [ [ [global-setter] ] dip [typed-setter] ] 2bi (define-variable) ; SYNTAX: TYPED-GLOBAL: - CREATE-WORD scan-object define-typed-global ; + scan-new-word scan-object define-typed-global ; M: typed-global-variable definer drop \ TYPED-GLOBAL: f ; diff --git a/extra/variants/variants.factor b/extra/variants/variants.factor index df948b1863..55ee0390e0 100644 --- a/extra/variants/variants.factor +++ b/extra/variants/variants.factor @@ -38,17 +38,17 @@ M: variant-class initial-value* ":" ?tail [ parse-variant-tuple-member ] [ create-class-in ] if ; : parse-variant-members ( -- members ) - [ scan dup ";" = not ] + [ scan-token dup ";" = not ] [ parse-variant-member ] produce nip ; SYNTAX: VARIANT: - CREATE-CLASS + scan-new-class parse-variant-members define-variant-class-members ; SYNTAX: VARIANT-MEMBER: scan-word - scan parse-variant-member + scan-token parse-variant-member define-variant-class-member ; MACRO: unboa ( class -- ) diff --git a/extra/vocabs/git/git.factor b/extra/vocabs/git/git.factor index eb945b57c7..6411623b8e 100644 --- a/extra/vocabs/git/git.factor +++ b/extra/vocabs/git/git.factor @@ -25,4 +25,4 @@ ERROR: git-revision-not-found path ; [ [ input-stream get swap parse-stream call( -- ) ] with-git-object-stream ] [ git-revision-not-found ] if* ; -SYNTAX: USE-REV: scan scan use-vocab-rev ; +SYNTAX: USE-REV: scan-token scan-token use-vocab-rev ; diff --git a/unmaintained/peg-lexer/peg-lexer.factor b/unmaintained/peg-lexer/peg-lexer.factor index dcde55c91a..56dda70bdd 100644 --- a/unmaintained/peg-lexer/peg-lexer.factor +++ b/unmaintained/peg-lexer/peg-lexer.factor @@ -52,7 +52,7 @@ M: lex-hash at* define-syntax word make-inline ; SYNTAX: ON-BNF: - CREATE-WORD reset-tokenizer ";ON-BNF" parse-multiline-string parse-ebnf + scan-new-word reset-tokenizer ";ON-BNF" parse-multiline-string parse-ebnf main swap at create-bnf ; ! Tokenizer like standard factor lexer diff --git a/unmaintained/ui/gadgets/layout/layout.factor b/unmaintained/ui/gadgets/layout/layout.factor index c287b9a059..fb498103b5 100644 --- a/unmaintained/ui/gadgets/layout/layout.factor +++ b/unmaintained/ui/gadgets/layout/layout.factor @@ -54,7 +54,7 @@ M: model -> dup , ; : ( quot -- book ) f make-layout f make-book ; inline ERROR: not-in-template word ; -SYNTAX: $ CREATE-WORD dup +SYNTAX: $ scan-new-word dup [ [ dup templates get at [ nip , ] [ not-in-template ] if* ] curry (( -- )) define-declared "$" expect ] [ [ [ swap templates get set-at ] keep , ] curry ] bi append! ;