lexer: add "each-token" and "map-tokens", which are equivalent to "parse-token _ each/map" but incremental. update a smattering of parsing words (such as USING:, SYMBOLS:, etc.) to use each-token/map-tokens

basis/delegate/delegate.factor

@@ -157,6 +157,6 @@ M: protocol definer drop \ PROTOCOL: \ ; ;
 M: protocol group-words protocol-words ;
 
 SYNTAX: SLOT-PROTOCOL:
-    CREATE-WORD ";" parse-tokens
+    CREATE-WORD ";"
-    [ [ reader-word ] [ writer-word ] bi 2array ] map concat
+    [ [ reader-word ] [ writer-word ] bi 2array ]
-    define-protocol ;
+    map-tokens concat define-protocol ;

basis/locals/parser/parser.factor

@@ -21,6 +21,9 @@ SYMBOL: in-lambda?
 : make-locals ( seq -- words assoc )
     [ [ make-local ] map ] H{ } make-assoc ;
 
+: parse-local-defs ( -- words assoc )
+    [ "|" [ make-local ] map-tokens ] H{ } make-assoc ;
+
 : make-local-word ( name def -- word )
     [ <local-word> [ dup name>> set ] [ ] [ ] tri ] dip
     "local-word-def" set-word-prop ;
@@ -42,12 +45,12 @@ SYMBOL: locals
     [ \ ] parse-until >quotation ] ((parse-lambda)) ;
 
 : parse-lambda ( -- lambda )
-    "|" parse-tokens make-locals
+    parse-local-defs
     (parse-lambda) <lambda>
     ?rewrite-closures ;
 
 : parse-multi-def ( locals -- multi-def )
-    ")" parse-tokens swap [ [ make-local ] map ] bind <multi-def> ;
+    [ ")" [ make-local ] map-tokens ] bind <multi-def> ;
 
 : parse-def ( name/paren locals -- def )
     over "(" = [ nip parse-multi-def ] [ [ make-local ] bind <def> ] if ;

basis/match/match.factor

@@ -17,7 +17,7 @@ SYMBOL: _
     [ define-match-var ] each ;
 
 SYNTAX: MATCH-VARS: ! vars ...
-    ";" parse-tokens define-match-vars ;
+    ";" [ define-match-var ] each-token ;
 
 : match-var? ( symbol -- bool )
     dup word? [ "match-var" word-prop ] [ drop f ] if ;

basis/specialized-arrays/specialized-arrays.factor

@@ -168,7 +168,7 @@ M: c-type-word c-direct-array-constructor
 M: pointer c-direct-array-constructor drop void* c-direct-array-constructor ;
 
 SYNTAX: SPECIALIZED-ARRAYS:
-    ";" parse-tokens [ parse-c-type define-array-vocab use-vocab ] each ;
+    ";" [ parse-c-type define-array-vocab use-vocab ] each-token ;
 
 SYNTAX: SPECIALIZED-ARRAY:
     scan-c-type define-array-vocab use-vocab ;

basis/specialized-vectors/specialized-vectors.factor

@@ -56,11 +56,11 @@ PRIVATE>
     generate-vocab ;
 
 SYNTAX: SPECIALIZED-VECTORS:
-    ";" parse-tokens [
+    ";" [
         parse-c-type
         [ define-array-vocab use-vocab ]
         [ define-vector-vocab use-vocab ] bi
-    ] each ;
+    ] each-token ;
 
 SYNTAX: SPECIALIZED-VECTOR:
     scan-c-type

core/lexer/lexer.factor

@@ -82,15 +82,17 @@ PREDICATE: unexpected-eof < unexpected
     [ unexpected-eof ]
     if* ;
 
-: (parse-tokens) ( accum end -- accum )
+: (each-token) ( end quot -- pred quot )
-    scan 2dup = [
+    [ [ [ scan dup ] ] dip [ = not ] curry [ [ f ] if* ] curry compose ] dip ; inline
-        2drop
+
-    ] [
+: each-token ( end quot -- )
-        [ pick push (parse-tokens) ] [ unexpected-eof ] if*
+    (each-token) while drop ; inline
-    ] if ;
+
+: map-tokens ( end quot -- seq )
+    (each-token) produce nip ; inline
 
 : parse-tokens ( end -- seq )
-    100 <vector> swap (parse-tokens) >array ;
+    [ ] map-tokens ;
 
 TUPLE: lexer-error line column line-text error ;
 

core/syntax/syntax.factor

@@ -51,7 +51,7 @@ IN: bootstrap.syntax
 
     "UNUSE:" [ scan unuse-vocab ] define-core-syntax
 
-    "USING:" [ ";" parse-tokens [ use-vocab ] each ] define-core-syntax
+    "USING:" [ ";" [ use-vocab ] each-token ] define-core-syntax
 
     "QUALIFIED:" [ scan dup add-qualified ] define-core-syntax
 
@@ -124,13 +124,11 @@ IN: bootstrap.syntax
     ] define-core-syntax
 
     "SYMBOLS:" [
-        ";" parse-tokens
+        ";" [ create-in dup reset-generic define-symbol ] each-token
-        [ create-in dup reset-generic define-symbol ] each
     ] define-core-syntax
 
     "SINGLETONS:" [
-        ";" parse-tokens
+        ";" [ create-class-in define-singleton-class ] each-token
-        [ create-class-in define-singleton-class ] each
     ] define-core-syntax
 
     "DEFER:" [

extra/poker/poker.factor

@@ -263,4 +263,4 @@ ERROR: bad-suit-symbol ch ;
     string>value value>hand-name ;
 
 SYNTAX: HAND{
-    "}" parse-tokens [ card> ] { } map-as suffix! ;
+    "}" [ card> ] map-tokens suffix! ;

extra/slots/syntax/syntax.factor

@@ -5,6 +5,5 @@ sequences slots  ;
 IN: slots.syntax
 
 SYNTAX: slots{
-    "}" parse-tokens
+    "}" [ reader-word 1quotation ] map-tokens
-    [ reader-word 1quotation ] map
     '[ [ _ cleave ] output>array ] append! ;

extra/vars/vars.factor

@@ -28,4 +28,4 @@ SYNTAX: VAR: ! var
     [ define-var ] each ;
 
 SYNTAX: VARS: ! vars ...
-    ";" parse-tokens define-vars ;
+    ";" [ define-var ] each-token ;