steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

XML interpolation efficiency/cleanup

db4
Daniel Ehrenberg 2009-01-28 16:17:20 -06:00
parent d5160ce791
commit 940a085325
2 changed files with 32 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
basis/xml/interpolate/interpolate-tests.factor
View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: tools.test xml.interpolate multiline kernel assocs USING: tools.test xml.interpolate multiline kernel assocs
sequences accessors xml.writer xml.interpolate.private sequences accessors xml.writer xml.interpolate.private
locals splitting urls xml.data ; locals splitting urls xml.data classes ;
IN: xml.interpolate.tests IN: xml.interpolate.tests
[ "a" "c" { "a" "c" f } ] [ [ "a" "c" { "a" "c" f } ] [
@ -54,6 +54,15 @@ IN: xml.interpolate.tests
[ "<x>3</x>" ] [ 3 [XML <x><-></x> XML] xml-chunk>string ] unit-test [ "<x>3</x>" ] [ 3 [XML <x><-></x> XML] xml-chunk>string ] unit-test
[ "<x></x>" ] [ f [XML <x><-></x> XML] xml-chunk>string ] unit-test [ "<x></x>" ] [ f [XML <x><-></x> XML] xml-chunk>string ] unit-test
\ parse-def must-infer \ <XML must-infer
[ "" interpolate-chunk ] must-infer [ { } "" interpolate-xml ] must-infer
[ [XML <foo><-></foo> <bar val=<->/> XML] ] must-infer [ [XML <foo><-></foo> <bar val=<->/> XML] ] must-infer
[ xml-chunk ] [ [ [XML <foo/> XML] ] first class ] unit-test
[ xml ] [ [ <XML <foo/> XML> ] first class ] unit-test
[ xml-chunk ] [ [ [XML <foo val=<->/> XML] ] third class ] unit-test
[ xml ] [ [ <XML <foo val=<->/> XML> ] third class ] unit-test
[ 1 ] [ [ [XML <foo/> XML] ] length ] unit-test
[ 1 ] [ [ <XML <foo/> XML> ] length ] unit-test
[ "" ] [ [XML XML] concat ] unit-test

38
basis/xml/interpolate/interpolate.factor
View File

@ -64,14 +64,18 @@ M: interpolated interpolate-item
: number<-> ( doc -- dup ) : number<-> ( doc -- dup )
0 over [ 0 over [
dup var>> [ over >>var [ 1+ ] dip ] unless drop dup var>> [
over >>var [ 1+ ] dip
] unless drop
] each-interpolated drop ; ] each-interpolated drop ;
MACRO: interpolate-xml ( string -- doc ) GENERIC: interpolate-xml ( table xml -- xml )
string>doc number<-> '[ _ interpolate-xml-doc ] ;
MACRO: interpolate-chunk ( string -- chunk ) M: xml interpolate-xml
string>chunk number<-> '[ _ interpolate-sequence ] ; interpolate-xml-doc ;
M: xml-chunk interpolate-xml
interpolate-sequence <xml-chunk> ;
: >search-hash ( seq -- hash ) : >search-hash ( seq -- hash )
[ dup search ] H{ } map>assoc ; [ dup search ] H{ } map>assoc ;
@ -82,26 +86,24 @@ MACRO: interpolate-chunk ( string -- chunk )
: nenum ( ... n -- assoc ) : nenum ( ... n -- assoc )
narray <enum> ; inline narray <enum> ; inline
: collect ( accum seq -- accum ) : collect ( accum variables -- accum ? )
{ {
{ [ dup [ ] all? ] [ >search-hash parsed ] } ! locals { [ dup empty? ] [ drop f ] } ! Just a literal
{ [ dup [ not ] all? ] [ ! fry { [ dup [ ] all? ] [ >search-hash parsed t ] } ! locals
length parsed \ nenum parsed { [ dup [ not ] all? ] [ length parsed \ nenum parsed t ] } ! fry
] }
[ drop "XML interpolation contains both fry and locals" throw ] ! mixed [ drop "XML interpolation contains both fry and locals" throw ] ! mixed
} cond ; } cond ;
: parse-def ( accum delimiter word -- accum ) : parse-def ( accum delimiter quot -- accum )
[ [ parse-multiline-string 1 short head* ] dip call
parse-multiline-string but-last [ extract-variables collect ] keep swap
[ string>chunk extract-variables collect ] keep [ number<-> parsed ] dip
parsed [ \ interpolate-xml parsed ] when ; inline
] dip parsed ;
PRIVATE> PRIVATE>
: <XML : <XML
"XML>" \ interpolate-xml parse-def ; parsing "XML>" [ string>doc ] parse-def ; parsing
: [XML : [XML
"XML]" \ interpolate-chunk parse-def ; parsing "XML]" [ string>chunk ] parse-def ; parsing