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

modern: make string payloads >string after the fact. too early and they lose the position information.

locals-and-roots
Doug Coleman 2016-06-20 16:23:59 -07:00
parent f0f762de1e
commit 64ae7ff7f8
2 changed files with 8 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
core/modern/modern.factor
View File

@ -254,12 +254,14 @@ MACRO:: read-double-matched ( open-ch -- quot: ( lexer tag ch -- seq ) )
opening matching-delimiter-string :> needle
lexer needle lex-til-string :> ( n'' string'' payload closing )
payload >string closing tag but-last-slice opening double-matched-literal make-matched-literal
payload closing tag but-last-slice opening double-matched-literal make-matched-literal
[ >string ] change-payload
] }
{ open-ch [
tag 1 cut-slice* swap tag! 1 modify-to :> opening
lexer [ 1 + ] change-n closestr2 lex-til-string :> ( n' string' payload closing )
payload >string closing tag opening double-matched-literal make-matched-literal
payload closing tag opening double-matched-literal make-matched-literal
[ >string ] change-payload
] }
[ [ tag openstr2 lexer ] dip long-opening-mismatch ]
} case
@ -337,7 +339,8 @@ MACRO:: read-matched ( ch -- quot: ( lexer tag -- slice' ) )
n' [ n string string-expected-got-eof ] unless
n n' 1 - string <slice>
n' 1 - n' string <slice>
tag 1 cut-slice* dquote-literal make-matched-literal ;
tag 1 cut-slice* dquote-literal make-matched-literal
[ >string ] change-payload ;

3
core/modern/out/out-tests.factor
View File

@ -61,4 +61,5 @@ in: modern.out.tests
{ t } [ "<{ ptx-2op-instruction ptx-float-ftz }" rewrite-same-string ] unit-test
{ t } [ "foo<{ ptx-2op-instruction ptx-float-ftz }" rewrite-same-string ] unit-test
{ t } [ [[ [ dup 0 > [ number>string ] [ drop "No more" ] if ] ]] [ ] rewrite-same-string ] unit-test
{ t } [ [=[ [ dup 0 > [ number>string ] [ drop "No more" ] if ]]=] rewrite-same-string ] unit-test
{ t } [ [=[ [[omg]]]=] rewrite-same-string ] unit-test