lexer: add "each-token" and "map-tokens", which are equivalent to "parse-token _...

diff --git a/basis/delegate/delegate.factor b/basis/delegate/delegate.factor
index 662a2840a1d1990946a2b45d03a6aed5bff30686..dc3024b55faddeae3cd9c53e5f7df3f12aadfc3b 100644 (file)
--- a/basis/delegate/delegate.factor
+++ b/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
-    [ [ reader-word ] [ writer-word ] bi 2array ] map concat
-    define-protocol ;
\ No newline at end of file
+    CREATE-WORD ";"
+    [ [ reader-word ] [ writer-word ] bi 2array ]
+    map-tokens concat define-protocol ;

diff --git a/basis/locals/parser/parser.factor b/basis/locals/parser/parser.factor
index c0184ee0efed1be229a01e3eee80d41f813b478b..e742b4768a11fd21fdfa4aad315d9ddac06ff2f2 100644 (file)
--- a/basis/locals/parser/parser.factor
+++ b/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 ;

diff --git a/basis/match/match.factor b/basis/match/match.factor
index b6369249b39502e5d99389cb82abef4d33e6669e..9baadfe1f265a1113c620aefe5cb7adcae1cfc0f 100644 (file)
--- a/basis/match/match.factor
+++ b/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 ;

diff --git a/basis/specialized-arrays/specialized-arrays.factor b/basis/specialized-arrays/specialized-arrays.factor
index b052becfedae766d309aa3213e4b8a1b4fa9a6c7..11b050d5fcbb32d4147fc0b826dfda19cccad023 100644 (file)
--- a/basis/specialized-arrays/specialized-arrays.factor
+++ b/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 ;

diff --git a/basis/specialized-vectors/specialized-vectors.factor b/basis/specialized-vectors/specialized-vectors.factor
index 0c0569ea9d964a4a4f748723b26d494afa5fd262..3352c226d8b67c0a471e279823fcd5f8bfb81885 100644 (file)
--- a/basis/specialized-vectors/specialized-vectors.factor
+++ b/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

diff --git a/core/lexer/lexer.factor b/core/lexer/lexer.factor
index b3bd3cacdb7f49fe13762d53a6245b4880a35c9d..7ad454c67ce6866386c19e05d9a2c1836485999d 100644 (file)
--- a/core/lexer/lexer.factor
+++ b/core/lexer/lexer.factor
@@ -82,15 +82,17 @@ PREDICATE: unexpected-eof < unexpected
     [ unexpected-eof ]
     if* ;
 
-: (parse-tokens) ( accum end -- accum )
-    scan 2dup = [
-        2drop
-    ] [
-        [ pick push (parse-tokens) ] [ unexpected-eof ] if*
-    ] if ;
+: (each-token) ( end quot -- pred quot )
+    [ [ [ scan dup ] ] dip [ = not ] curry [ [ f ] if* ] curry compose ] dip ; inline
+
+: each-token ( end quot -- )
+    (each-token) while drop ; inline
+
+: 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 ;
 

diff --git a/core/syntax/syntax.factor b/core/syntax/syntax.factor
index 0b5b32e289174a7336a8d64382c104f76af644e4..6c35a3c5c6a47c26d3a84903722123957dfbde8b 100644 (file)
--- a/core/syntax/syntax.factor
+++ b/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
+        ";" [ create-in dup reset-generic define-symbol ] each-token
     ] define-core-syntax
 
     "SINGLETONS:" [
-        ";" parse-tokens
-        [ create-class-in define-singleton-class ] each
+        ";" [ create-class-in define-singleton-class ] each-token
     ] define-core-syntax
 
     "DEFER:" [

diff --git a/extra/poker/poker.factor b/extra/poker/poker.factor
index b33b8e5710e3fb1a79d1913277cc821225e0f825..75af1b604a0468529b265163b998c239919a365a 100644 (file)
--- a/extra/poker/poker.factor
+++ b/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! ;

diff --git a/extra/slots/syntax/syntax.factor b/extra/slots/syntax/syntax.factor
index 2cce91c569d16145d7dbe98c14df5d39d0175c3d..95207a0de94fb713594c1a751e0c58cc2aa527e7 100755 (executable)
--- a/extra/slots/syntax/syntax.factor
+++ b/extra/slots/syntax/syntax.factor
@@ -5,6 +5,5 @@ sequences slots  ;
 IN: slots.syntax
 
 SYNTAX: slots{
-    "}" parse-tokens
-    [ reader-word 1quotation ] map
-    '[ [ _ cleave ] output>array ] append! ;
\ No newline at end of file
+    "}" [ reader-word 1quotation ] map-tokens
+    '[ [ _ cleave ] output>array ] append! ;

diff --git a/extra/vars/vars.factor b/extra/vars/vars.factor
index 21c9b303f304946512cc5c85b8f6e342631667b1..990b0307d00601f34c85cf73dba774af8436041a 100644 (file)
--- a/extra/vars/vars.factor
+++ b/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 ;