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

modern: fix up the returned objects.

locals-and-roots
Doug Coleman 2016-06-19 13:40:54 -07:00
parent dda8add101
commit c09fa97634
2 changed files with 18 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
core/modern/modern-tests.factor
View File

@ -22,18 +22,21 @@ in: modern.tests
{ 2 } [ "{=={abc}==} {=={cba}==}" string>literals length ] unit-test { 2 } [ "{=={abc}==} {=={cba}==}" string>literals length ] unit-test
{ 2 } [ "(==(abc)==) (==(cba)==)" string>literals length ] unit-test { 2 } [ "(==(abc)==) (==(cba)==)" string>literals length ] unit-test
{ 1 } [ "hex`abc" string>literals length ] unit-test : literal-test ( string -- n string string string )
{ 2 } [ "hex`abc hex`cba" string>literals length ] unit-test string>literals [ length ] [ first [ tag>> ] [ delimiter>> ] [ payload>> ] tri ] bi ;
{ 2 } [ "hex\"abc\" hex\"cba\"" string>literals length ] unit-test
{ 2 } [ "hex[[abc]] hex[[cba]]" string>literals length ] unit-test { 1 "hex" "`" "abc" } [ "hex`abc" literal-test ] unit-test
{ 2 } [ "hex{{abc}} hex{{cba}}" string>literals length ] unit-test { 2 "hex" "`" "abc" } [ "hex`abc hex`cba" literal-test ] unit-test
{ 2 } [ "hex((abc)) hex((cba))" string>literals length ] unit-test { 2 "hex" "\"" "abc" } [ "hex\"abc\" hex\"cba\"" literal-test ] unit-test
{ 2 } [ "hex[=[abc]=] hex[=[cba]=]" string>literals length ] unit-test { 2 "hex" "[[" "abc" } [ "hex[[abc]] hex[[cba]]" literal-test ] unit-test
{ 2 } [ "hex{={abc}=} hex{={cba}=}" string>literals length ] unit-test { 2 "hex" "{{" "abc" } [ "hex{{abc}} hex{{cba}}" literal-test ] unit-test
{ 2 } [ "hex(=(abc)=) hex(=(cba)=)" string>literals length ] unit-test { 2 "hex" "((" "abc" } [ "hex((abc)) hex((cba))" literal-test ] unit-test
{ 2 } [ "hex[==[abc]==] hex[==[cba]==]" string>literals length ] unit-test { 2 "hex" "[=[" "abc" } [ "hex[=[abc]=] hex[=[cba]=]" literal-test ] unit-test
{ 2 } [ "hex{=={abc}==} hex{=={cba}==}" string>literals length ] unit-test { 2 "hex" "{={" "abc" } [ "hex{={abc}=} hex{={cba}=}" literal-test ] unit-test
{ 2 } [ "hex(==(abc)==) hex(==(cba)==)" string>literals length ] unit-test { 2 "hex" "(=(" "abc" } [ "hex(=(abc)=) hex(=(cba)=)" literal-test ] unit-test
{ 2 "hex" "[==[" "abc" } [ "hex[==[abc]==] hex[==[cba]==]" literal-test ] unit-test
{ 2 "hex" "{=={" "abc" } [ "hex{=={abc}==} hex{=={cba}==}" literal-test ] unit-test
{ 2 "hex" "(==(" "abc" } [ "hex(==(abc)==) hex(==(cba)==)" literal-test ] unit-test
{ 1 } [ "[ ]" string>literals length ] unit-test { 1 } [ "[ ]" string>literals length ] unit-test

6
core/modern/modern.factor
View File

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