Refactor the lexer/parser to expose friendlier words for scanning tok…

…ens. The preferred top-level words now throw an exception on EOF.

CREATE -> scan-new
CREATE-CLASS -> scan-new-class
CREATE-WORD -> scan-new-word
CREATE-GENERIC -> scan-new-generic
scan -> (scan-token)
scan-token now throws on eof
(scan-word) returns word/number/f
scan-word now throws on eof
scan-word-name expects a non-number
Fixes factor#183.
Fixes factor#209.

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) ;
 
 <PRIVATE
 GENERIC: return-type-name ( type -- name )
@@ -88,21 +88,21 @@ M: pointer return-type-name to>> 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

basis/alien/syntax/syntax.factor

@@ -13,7 +13,7 @@ SYNTAX: ALIEN: 16 scan-base <alien> suffix! ;
 
 SYNTAX: BAD-ALIEN <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 <pointer> suffix! ;

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 ;
+    2bi ;

basis/classes/struct/struct.factor

@@ -354,7 +354,7 @@ PRIVATE>
 
 <PRIVATE
 : parse-struct-slot ( -- slot )
-    scan scan-c-type \ } parse-until <struct-slot-spec> ;
+    (scan-token) scan-c-type \ } parse-until <struct-slot-spec> ;
 
 : parse-struct-slots ( slots -- slots' more? )
     scan-token {
@@ -364,7 +364,7 @@ PRIVATE>
     } case ;
 
 : parse-struct-definition ( -- class slots )
-    CREATE-CLASS 8 <vector> [ parse-struct-slots ] [ ] while >array
+    scan-new-class 8 <vector> [ parse-struct-slots ] [ ] while >array
     dup [ name>> ] map check-duplicate-slots ;
 PRIVATE>
 
@@ -387,14 +387,14 @@ SYNTAX: S@
 
 <PRIVATE
 : scan-c-type` ( -- c-type/param )
-    scan dup "{" = [ drop \ } parse-until >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
     [ <struct-slot-spec> suffix! ] 3curry append! ;
 
 : parse-struct-slots` ( accum -- accum more? )
-    scan {
+    (scan-token) {
         { ";" [ f ] }
         { "{" [ parse-struct-slot` t ] }
         [ invalid-struct-slot ]

basis/cocoa/cocoa.factor

@@ -14,24 +14,24 @@ 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
 
 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
 

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! ;

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! ;

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 ;

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 ;

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 ;
+SYNTAX: RENAMING: scan-token scan-object scan-object scan-object define-renaming ;

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 ] [ '[ _ [ _ <CFString> ] initialize-alien ] ] 2bi
     (( -- alien )) define-declared ;

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 ;
 
 >>
 

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 ;

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 ;
 

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>
 

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

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"
 

basis/io/encodings/8-bit/8-bit.factor

@@ -54,4 +54,4 @@ M: 8-bit-encoding <decoder>
 
 PRIVATE>
 
-SYNTAX: 8-BIT: scan scan scan load-encoding ;
+SYNTAX: 8-BIT: scan-token scan-token scan-token load-encoding ;

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 ;

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! ;

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

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 ;
 

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>
 >>

basis/math/vectors/simd/simd.factor

@@ -309,7 +309,7 @@ c:<c-type>
 ;FUNCTOR
 
 SYNTAX: SIMD-128:
-    scan define-simd-128 ;
+    scan-token define-simd-128 ;
 
 PRIVATE>
 

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 ;
 

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 ]

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 ;

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! ;