strings.parser: use sbuf accumulator instead of make.

core/strings/parser/parser.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2008, 2009 Slava Pestov, Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays assocs combinators kernel lexer make
+USING: accessors arrays assocs combinators kernel lexer
-math math.parser namespaces sequences splitting strings ;
+math math.parser namespaces sbufs sequences splitting strings ;
 IN: strings.parser
 
 ERROR: bad-escape char ;
@@ -45,46 +45,51 @@ name>char-hook [
         [ drop unclip-slice escape swap ]
     } case ;
 
-: (unescape-string) ( str -- )
+<PRIVATE
-    CHAR: \\ over index dup [
+
-        cut-slice [ % ] dip rest-slice
+: (unescape-string) ( accum str i/f -- accum )
-        next-escape [ , ] dip
+    [
-        (unescape-string)
+        cut-slice [ over push-all ] dip
+        rest-slice next-escape [ over push ] dip
+        CHAR: \\ over index (unescape-string)
     ] [
-        drop %
+        over push-all
-    ] if ;
+    ] if* ; inline recursive
+
+PRIVATE>
 
 : unescape-string ( str -- str' )
-    [ (unescape-string) ] "" make ;
+    CHAR: \\ over index [
+        [ [ length <sbuf> ] keep ] dip (unescape-string)
+    ] when* "" like ;
 
-: (parse-string) ( str -- m )
+<PRIVATE
-    dup [ "\"\\" member? ] find dup [
+
-        [ cut-slice [ % ] dip rest-slice ] dip
+: (parse-string) ( accum str -- accum m )
+    dup [ "\"\\" member? ] find [
+        [ cut-slice [ over push-all ] dip rest-slice ] dip
         CHAR: " = [
             from>>
         ] [
-            next-escape [ , ] dip (parse-string)
+            next-escape [ over push ] dip (parse-string)
         ] if
     ] [
         "Unterminated string" throw
-    ] if ;
+    ] if* ; inline recursive
+
+PRIVATE>
 
 : parse-string ( -- str )
     lexer get [
-        [ swap tail-slice (parse-string) ] "" make swap
+        [ SBUF" " clone ] 2dip swap tail-slice
+        (parse-string) [ "" like ] dip
     ] change-lexer-column ;
 
 <PRIVATE
 
-: lexer-subseq ( i -- before )
+: lexer-subseq ( i lexer -- before )
-    [
+    [ [ column>> ] [ line-text>> ] bi swapd subseq ]
-        [
+    [ column<< ] 2bi ;
-            lexer get
-            [ column>> ] [ line-text>> ] bi
-        ] dip swap subseq
-    ] [
-        lexer get column<<
-    ] bi ;
 
 : rest-of-line ( lexer -- seq )
     [ line-text>> ] [ column>> ] bi tail-slice ;
@@ -104,74 +109,78 @@ ERROR: escaped-char-expected ;
         escaped-char-expected
     ] if ;
 
-: lexer-head? ( string -- ? )
+: lexer-head? ( lexer string -- ? )
-    [ lexer get rest-of-line ] dip head? ;
+    [ rest-of-line ] dip head? ;
 
-: advance-lexer ( n -- )
+: advance-lexer ( lexer n -- )
-    [ lexer get ] dip [ + ] curry change-column drop ; inline
+    [ + ] curry change-column drop ; inline
 
-: find-next-token ( ch -- i elt )
+: find-next-token ( lexer ch -- i elt )
-    CHAR: \ 2array
+    [ [ column>> ] [ line-text>> ] bi ] dip
-    [ lexer get [ column>> ] [ line-text>> ] bi ] dip
+    CHAR: \ 2array [ member? ] curry find-from ;
-    [ member? ] curry find-from ;
 
-: next-line% ( lexer -- )
+: next-line% ( accum lexer -- )
-    [ rest-of-line % ]
+    [ rest-of-line swap push-all ]
-    [ next-line "\n" % ] bi ;
+    [ next-line CHAR: \n swap push ] 2bi ; inline
 
-: take-double-quotes ( -- string )
+: take-double-quotes ( lexer -- string )
-    lexer get dup current-char CHAR: " = [
+    dup current-char CHAR: " = [
-        [ ] [ column>> ] [ line-text>> ] tri
+        dup [ column>> ] [ line-text>> ] bi
         [ CHAR: " = not ] find-from drop [
-            swap column>> - CHAR: " <repetition>
+            over column>> - CHAR: " <repetition>
         ] [
-            rest-of-line
+            dup rest-of-line
         ] if*
-    ] [
+        [ length advance-lexer ] keep
-        drop f
+    ] [ drop f ] if ;
-    ] if dup length advance-lexer ;
 
-: end-string-parse ( delimiter -- )
+: end-string-parse ( accum lexer delimiter -- )
     length 3 = [
-        take-double-quotes 3 tail %
+        take-double-quotes 3 tail-slice swap push-all
     ] [
-        lexer get advance-char
+        advance-char drop
-    ] if ;
+    ] if ; inline
 
 DEFER: (parse-multiline-string)
 
-: parse-found-token ( string i token -- )
+: parse-found-token ( accum lexer string i token -- )
-    [ lexer-subseq % ] dip
+    [ [ 2over ] dip swap lexer-subseq swap push-all ] dip
     CHAR: \ = [
-        lexer get [ next-char , ] [ next-char , ] bi (parse-multiline-string)
+        2over next-char swap push
+        2over next-char swap push
+        (parse-multiline-string)
     ] [
-        dup lexer-head? [
+        2dup lexer-head? [
             end-string-parse
         ] [
-            lexer get next-char , (parse-multiline-string)
+            2over next-char swap push
+            (parse-multiline-string)
         ] if
-    ] if ;
+    ] if ; inline recursive
 
 ERROR: trailing-characters string ;
 
-: (parse-multiline-string) ( string -- )
+: (parse-multiline-string) ( accum lexer string -- )
-    lexer get still-parsing? [
+    over still-parsing? [
-        dup first find-next-token [
+        2dup first find-next-token [
             parse-found-token
         ] [
-            drop lexer get next-line%
+            drop 2over next-line%
             (parse-multiline-string)
         ] if*
     ] [
         throw-unexpected-eof
-    ] if ;
+    ] if ; inline recursive
 
 PRIVATE>
 
 : parse-multiline-string ( -- string )
-    lexer get rest-of-line "\"\"" head? [
+    SBUF" " clone [
-        lexer get [ 2 + ] change-column drop
+        lexer get
+        dup rest-of-line "\"\"" head? [
+            [ 2 + ] change-column
             "\"\"\""
         ] [
             "\""
-    ] if [ (parse-multiline-string) ] "" make unescape-string ;
+        ] if (parse-multiline-string)
+    ] keep unescape-string ;