xml.tokenize: minor speedups.

db4
John Benediktsson 2012-08-24 15:16:04 -07:00
parent 625da03282
commit 1455a5fb17
1 changed files with 7 additions and 8 deletions

View File

@ -77,17 +77,17 @@ HINTS: next* { spot } ;
#! advance spot to after the substring. #! advance spot to after the substring.
10 <sbuf> [ 10 <sbuf> [
'[ _ keep over [ drop ] [ _ push ] if ] skip-until '[ _ keep over [ drop ] [ _ push ] if ] skip-until
] keep >string ; inline ] keep "" like ; inline
: take-to ( seq -- string ) : take-to ( seq -- string )
'[ _ member? ] take-until ; '[ _ member? ] take-until ; inline
: pass-blank ( -- ) : pass-blank ( -- )
#! Advance code past any whitespace, including newlines #! Advance code past any whitespace, including newlines
[ blank? not ] skip-until ; [ blank? not ] skip-until ;
: next-matching ( pos ch str -- pos' ) : next-matching ( pos ch str -- pos' )
[ over ] dip nth eq? [ 1 + ] [ drop 0 ] if ; [ over ] dip nth eq? [ 1 + ] [ drop 0 ] if ; inline
: string-matcher ( str -- quot: ( pos char -- pos ? ) ) : string-matcher ( str -- quot: ( pos char -- pos ? ) )
dup length 1 - '[ _ next-matching dup _ > ] ; inline dup length 1 - '[ _ next-matching dup _ > ] ; inline
@ -142,14 +142,14 @@ HINTS: next* { spot } ;
} cond ; inline recursive } cond ; inline recursive
: parse-char ( quot: ( ch -- ? ) -- seq ) : parse-char ( quot: ( ch -- ? ) -- seq )
1024 <sbuf> [ spot get (parse-char) ] keep >string ; inline 512 <sbuf> [ spot get (parse-char) ] keep "" like ; inline
: assure-no-]]> ( pos char -- pos' ) : assure-no-]]> ( pos char -- pos' )
"]]>" next-matching dup 2 > [ text-w/]]> ] when ; "]]>" next-matching dup 2 > [ text-w/]]> ] when ; inline
:: parse-text ( -- string ) :: parse-text ( -- string )
0 :> pos!
depth get zero? :> no-text depth get zero? :> no-text
0 :> pos!
[| char | [| char |
pos char assure-no-]]> pos! pos char assure-no-]]> pos!
no-text [ no-text [
@ -164,7 +164,7 @@ HINTS: next* { spot } ;
pass-blank ">" expect ; pass-blank ">" expect ;
: normalize-quote ( str -- str ) : normalize-quote ( str -- str )
[ dup "\t\r\n" member? [ drop CHAR: \s ] when ] map ; [ dup "\t\r\n" member? [ drop CHAR: \s ] when ] map! ;
: (parse-quote) ( <-disallowed? ch -- string ) : (parse-quote) ( <-disallowed? ch -- string )
swap '[ swap '[
@ -179,4 +179,3 @@ HINTS: next* { spot } ;
: parse-quote ( -- seq ) : parse-quote ( -- seq )
f parse-quote* ; f parse-quote* ;