Add a scan-token word which is like scan, except throws an error on EOF; document scan-object word; mention that scan-token/scan-object are preferred over scan/scan-word

basis/alien/parser/parser.factor

@@ -32,7 +32,7 @@ SYMBOL: current-library
     (parse-c-type) dup valid-c-type? [ no-c-type ] unless ;
 
 : scan-c-type ( -- c-type )
-    scan {
+    scan-token {
         { [ dup "{" = ] [ drop \ } parse-until >array ] }
         { [ dup "pointer:" = ] [ drop scan-c-type <pointer> ] }
         [ parse-c-type ]

basis/alien/syntax/syntax.factor

@@ -19,7 +19,7 @@ SYNTAX: FUNCTION:
     (FUNCTION:) make-function define-declared ;
 
 SYNTAX: FUNCTION-ALIAS:
-    scan create-function
+    scan-token create-function
     (FUNCTION:) (make-function) define-declared ;
 
 SYNTAX: CALLBACK:

basis/classes/struct/struct.factor

@@ -334,10 +334,9 @@ PRIVATE>
     scan scan-c-type \ } parse-until <struct-slot-spec> ;
 
 : parse-struct-slots ( slots -- slots' more? )
-    scan {
+    scan-token {
         { ";" [ f ] }
         { "{" [ parse-struct-slot suffix! t ] }
-        { f [ unexpected-eof ] }
         [ invalid-struct-slot ]
     } case ;
 

basis/functors/backend/backend.factor

@@ -20,7 +20,7 @@ SYNTAX: FUNCTOR-SYNTAX:
     dup search dup lexical? [ nip ] [ drop ] if ;
 
 : scan-string-param ( -- name/param )
-    scan >string-param ;
+    scan-token >string-param ;
 
 : scan-c-type-param ( -- c-type/param )
     scan dup "{" = [ drop \ } parse-until >array ] [ >string-param ] if ;

basis/locals/parser/parser.factor

@@ -55,8 +55,7 @@ M: lambda-parser parse-quotation ( -- quotation )
     H{ } clone (parse-lambda) ;
 
 : parse-binding ( end -- pair/f )
-    scan {
+    scan-token {
-        { [ dup not ] [ unexpected-eof ] }
         { [ 2dup = ] [ 2drop f ] }
         [ nip scan-object 2array ]
     } cond ;

core/classes/tuple/parser/parser.factor

@@ -34,21 +34,19 @@ ERROR: invalid-slot-name name ;
     [ scan , \ } parse-until % ] { } make ;
 
 : parse-slot-name-delim ( end-delim string/f -- ? )
-    #! This isn't meant to enforce any kind of policy, just
+    ! Check for mistakes of this form:
-    #! to check for mistakes of this form:
+    !
-    #!
+    ! TUPLE: blahblah foo bing
-    #! TUPLE: blahblah foo bing
+    !
-    #!
+    ! : ...
-    #! : ...
     {
-        { [ dup not ] [ unexpected-eof ] }
         { [ dup { ":" "(" "<" "\"" "!" } member? ] [ invalid-slot-name ] }
         { [ 2dup = ] [ drop f ] }
         [ dup "{" = [ drop parse-long-slot-name ] when , t ]
     } cond nip ;
 
 : parse-tuple-slots-delim ( end-delim -- )
-    dup scan parse-slot-name-delim [ parse-tuple-slots-delim ] [ drop ] if ;
+    dup scan-token parse-slot-name-delim [ parse-tuple-slots-delim ] [ drop ] if ;
 
 : parse-slot-name ( string/f -- ? )
     ";" swap parse-slot-name-delim ;
@@ -74,16 +72,14 @@ ERROR: bad-slot-name class slot ;
     2dup swap slot-named* nip [ 2nip ] [ nip bad-slot-name ] if ;
 
 : parse-slot-value ( class slots -- )
-    scan check-slot-name scan-object 2array , scan {
+    scan check-slot-name scan-object 2array , scan-token {
-        { f [ \ } unexpected-eof ] }
         { "}" [ ] }
         [ bad-literal-tuple ]
     } case ;
 
 : (parse-slot-values) ( class slots -- )
     2dup parse-slot-value
-    scan {
+    scan-token {
-        { f [ 2drop \ } unexpected-eof ] }
         { "{" [ (parse-slot-values) ] }
         { "}" [ 2drop ] }
         [ 2nip bad-literal-tuple ]
@@ -109,8 +105,7 @@ M: tuple-class boa>object
     assoc-union! seq>> boa>object ;
 
 : parse-tuple-literal-slots ( class slots -- tuple )
-    scan {
+    scan-token {
-        { f [ unexpected-eof ] }
         { "f" [ drop \ } parse-until boa>object ] }
         { "{" [ 2dup parse-slot-values assoc>object ] }
         { "}" [ drop new ] }

core/effects/parser/parser.factor

@@ -26,9 +26,8 @@ SYMBOL: effect-var
 
 : parse-effect-value ( token -- value )
     ":" ?tail [
-        scan {
+        scan-token {
             { [ dup "(" = ] [ drop ")" parse-effect ] }
-            { [ dup f = ] [ ")" unexpected-eof ] }
             [ parse-word dup class? [ bad-effect ] unless ]
         } cond 2array
     ] when ;

core/lexer/authors.txt

@@ -1 +1,2 @@
 Slava Pestov
+Joe Groff

core/lexer/lexer-docs.factor

@@ -59,7 +59,12 @@ HELP: parse-token
 
 HELP: scan
 { $values { "str/f" { $maybe string } } }
-{ $description "Reads the next token from the lexer. See " { $link parse-token } " for details." }
+{ $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." }
 $parsing-note ;
 
 HELP: still-parsing?

core/lexer/lexer.factor

@@ -1,4 +1,4 @@
-! Copyright (C) 2008, 2009 Slava Pestov.
+! Copyright (C) 2008, 2010 Slava Pestov, Joe Groff.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel sequences accessors namespaces math words strings
 io vectors arrays math.parser combinators continuations
@@ -18,12 +18,12 @@ TUPLE: lexer-parsing-word word line line-text column ;
 
 : push-parsing-word ( word -- )
     lexer-parsing-word new
-        swap >>word
+    swap >>word
-        lexer get [
+    lexer get [
-            [ line>>      >>line      ]
+        [ line>>      >>line      ]
-            [ line-text>> >>line-text ]
+        [ line-text>> >>line-text ]
-            [ column>>    >>column    ] tri
+        [ column>>    >>column    ] tri
-        ] [ parsing-words>> push ] bi ;
+    ] [ parsing-words>> push ] bi ;
 
 : pop-parsing-word ( -- )
     lexer get parsing-words>> pop drop ;
@@ -77,7 +77,7 @@ M: lexer skip-word ( lexer -- )
         [ line-text>> ]
     } cleave subseq ;
 
-:  parse-token ( lexer -- str/f )
+: parse-token ( lexer -- str/f )
     dup still-parsing? [
         dup skip-blank
         dup still-parsing-line?
@@ -90,18 +90,14 @@ PREDICATE: unexpected-eof < unexpected got>> not ;
 
 : unexpected-eof ( word -- * ) f unexpected ;
 
+: scan-token ( -- str ) scan [ "token" unexpected-eof ] unless* ;
+
 : expect ( token -- )
-    scan
+    scan-token 2dup = [ 2drop ] [ unexpected ] if ;
-    [ 2dup = [ 2drop ] [ unexpected ] if ]
-    [ unexpected-eof ]
-    if* ;
 
 : each-token ( ... end quot: ( ... token -- ... ) -- ... )
-    [ scan ] 2dip {
+    [ scan-token ] 2dip 2over =
-        { [ 2over = ] [ 3drop ] }
+    [ 3drop ] [ [ nip call ] [ each-token ] 2bi ] if ; inline recursive
-        { [ pick not ] [ drop unexpected-eof ] }
-        [ [ nip call ] [ each-token ] 2bi ]
-    } cond ; inline recursive
 
 : map-tokens ( ... end quot: ( ... token -- ... elt ) -- ... seq )
     collector [ each-token ] dip { } like ; inline
@@ -117,14 +113,14 @@ M: lexer-error error-line [ error>> error-line ] [ line>> ] bi or ;
 
 : <lexer-error> ( msg -- error )
     \ lexer-error new
-        lexer get [
+    lexer get [
-            [ line>> >>line ]
+        [ line>> >>line ]
-            [ column>> >>column ] bi
+        [ column>> >>column ] bi
-        ] [ 
+    ] [
-            [ line-text>> >>line-text ]
+        [ line-text>> >>line-text ]
-            [ parsing-words>> clone >>parsing-words ] bi
+        [ parsing-words>> clone >>parsing-words ] bi
-        ] bi
+    ] bi
-        swap >>error ;
+    swap >>error ;
 
 : simple-lexer-dump ( error -- )
     [ line>> number>string ": " append ]
@@ -148,7 +144,9 @@ M: lexer-error error-line [ error>> error-line ] [ line>> ] bi or ;
     [ (parsing-word-lexer-dump) ] if ;
 
 : lexer-dump ( error -- )
-    dup parsing-words>> [ simple-lexer-dump ] [ last parsing-word-lexer-dump ] if-empty ;
+    dup parsing-words>>
+    [ simple-lexer-dump ]
+    [ last parsing-word-lexer-dump ] if-empty ;
 
 : with-lexer ( lexer quot -- newquot )
     [ lexer set ] dip [ <lexer-error> rethrow ] recover ; inline

core/parser/parser-docs.factor

@@ -7,6 +7,11 @@ IN: parser
 
 ARTICLE: "reading-ahead" "Reading ahead"
 "Parsing words can consume input:"
+{ $subsections
+    scan-token
+    scan-object
+}
+"Lower-level words:"
 { $subsections
     scan
     scan-word
@@ -249,3 +254,8 @@ HELP: staging-violation
 HELP: auto-use?
 { $var-description "If set to a true value, the behavior of the parser when encountering an unknown word name is changed. If only one loaded vocabulary has a word with this name, instead of throwing an error, the parser adds the vocabulary to the search path and prints a parse note. Off by default." }
 { $notes "This feature is intended to help during development. To generate a " { $link POSTPONE: USING: } " form automatically, enable " { $link auto-use? } ", load the source file, and copy and paste the " { $link POSTPONE: USING: } " form printed by the parser back into the file, then disable " { $link auto-use? } ". See " { $link "word-search-errors" } "." } ;
+
+HELP: scan-object
+{ $values { "object" object } }
+{ $description "Parses a literal representation of an object." }
+$parsing-note ;

core/syntax/syntax.factor

@@ -41,32 +41,32 @@ IN: bootstrap.syntax
 
     "#!" [ POSTPONE: ! ] define-core-syntax
 
-    "IN:" [ scan set-current-vocab ] define-core-syntax
+    "IN:" [ scan-token set-current-vocab ] define-core-syntax
 
     "<PRIVATE" [ begin-private ] define-core-syntax
 
     "PRIVATE>" [ end-private ] define-core-syntax
 
-    "USE:" [ scan use-vocab ] define-core-syntax
+    "USE:" [ scan-token use-vocab ] define-core-syntax
 
-    "UNUSE:" [ scan unuse-vocab ] define-core-syntax
+    "UNUSE:" [ scan-token unuse-vocab ] define-core-syntax
 
     "USING:" [ ";" [ use-vocab ] each-token ] define-core-syntax
 
-    "QUALIFIED:" [ scan dup add-qualified ] define-core-syntax
+    "QUALIFIED:" [ scan-token dup add-qualified ] define-core-syntax
 
-    "QUALIFIED-WITH:" [ scan scan add-qualified ] define-core-syntax
+    "QUALIFIED-WITH:" [ scan-token scan-token add-qualified ] define-core-syntax
 
     "FROM:" [
-        scan "=>" expect ";" parse-tokens add-words-from
+        scan-token "=>" expect ";" parse-tokens add-words-from
     ] define-core-syntax
 
     "EXCLUDE:" [
-        scan "=>" expect ";" parse-tokens add-words-excluding
+        scan-token "=>" expect ";" parse-tokens add-words-excluding
     ] define-core-syntax
 
     "RENAME:" [
-        scan scan "=>" expect scan add-renamed-word
+        scan-token scan-token "=>" expect scan-token add-renamed-word
     ] define-core-syntax
 
     "HEX:" [ 16 parse-base ] define-core-syntax
@@ -79,7 +79,7 @@ IN: bootstrap.syntax
     "t" "syntax" lookup define-singleton-class
 
     "CHAR:" [
-        scan {
+        scan-token {
             { [ dup length 1 = ] [ first ] }
             { [ "\\" ?head ] [ next-escape >string "" assert= ] }
             [ name>char-hook get call( name -- char ) ]
@@ -133,7 +133,7 @@ IN: bootstrap.syntax
     ] define-core-syntax
 
     "DEFER:" [
-        scan current-vocab create
+        scan-token current-vocab create
         [ fake-definition ] [ set-word ] [ undefined-def define ] tri
     ] define-core-syntax
     
@@ -190,7 +190,7 @@ IN: bootstrap.syntax
 
     "PREDICATE:" [
         CREATE-CLASS
-        scan "<" assert=
+        "<" expect
         scan-word
         parse-definition define-predicate-class
     ] define-core-syntax
@@ -208,7 +208,7 @@ IN: bootstrap.syntax
     ] define-core-syntax
 
     "SLOT:" [
-        scan define-protocol-slot
+        scan-token define-protocol-slot
     ] define-core-syntax
 
     "C:" [