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

modern: fix ![[ ]]

locals-and-roots
Doug Coleman 2016-06-20 16:40:49 -07:00
parent 64ae7ff7f8
commit 9b79fc6788
4 changed files with 17 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
collections/stream/extras/extras.factor
View File

@ -15,4 +15,3 @@ in: stream.extras
: write1-flush ( str -- ) output-stream get stream-write1-flush ; inline : write1-flush ( str -- ) output-stream get stream-write1-flush ; inline
: write-flush ( str -- ) output-stream get stream-write-flush ; inline : write-flush ( str -- ) output-stream get stream-write-flush ; inline
: print-flush ( str -- ) output-stream get stream-print-flush ; inline : print-flush ( str -- ) output-stream get stream-print-flush ; inline

12
core/modern/modern.factor
View File

@ -33,7 +33,7 @@ TUPLE: matched-literal < tag-literal delimiter payload closing-tag ;
TUPLE: delimited-literal < tag-literal delimiter payload ; TUPLE: delimited-literal < tag-literal delimiter payload ;
TUPLE: decorator-literal < literal delimiter payload ; TUPLE: decorator-literal < literal delimiter payload ;
TUPLE: dquote-literal < delimited-literal ; TUPLE: dquote-literal < matched-literal ;
TUPLE: single-matched-literal < matched-literal ; TUPLE: single-matched-literal < matched-literal ;
TUPLE: double-matched-literal < matched-literal ; TUPLE: double-matched-literal < matched-literal ;
TUPLE: less-than-literal < single-matched-literal ; TUPLE: less-than-literal < single-matched-literal ;
@ -210,12 +210,11 @@ ERROR: closing-delimiter-required opening-delimiter ;
payload postprocess-lexed opening-delimiter "\"" = [ split-double-dash ] unless >>payload payload postprocess-lexed opening-delimiter "\"" = [ split-double-dash ] unless >>payload
tag closing [ dup tag-literal? [ lexed-underlying ] when ] bi@ ?span-slices >>underlying tag closing [ dup tag-literal? [ lexed-underlying ] when ] bi@ ?span-slices >>underlying
opening-delimiter >string >>delimiter opening-delimiter >string >>delimiter
dup single-matched-literal? [
closing dup [ tag>> ] when >>closing-tag closing dup tag-literal? [ tag>> ] when >string >>closing-tag
] when
! PRIVATE< PRIVATE> ! PRIVATE< PRIVATE>
dup less-than-literal? [ dup less-than-literal? [
closing dup [ tag>> ] when >>closing-tag
closing f = [ opening-delimiter closing-delimiter-required ] when closing f = [ opening-delimiter closing-delimiter-required ] when
] when ] when
tag opening-delimiter payload closing 4array >>seq ; inline tag opening-delimiter payload closing 4array >>seq ; inline
@ -394,7 +393,8 @@ ERROR: closing-tag-required lexer tag ;
: take-comment ( lexer slice -- comment ) : take-comment ( lexer slice -- comment )
over ?lexer-nth char: \[ = [ over ?lexer-nth char: \[ = [
[ [ 1 + ] change-n ] dip over ?lexer-nth read-double-matched-bracket [ [ 1 + ] change-n ] [ 1 modify-to ] bi*
over ?lexer-nth read-double-matched-bracket
] [ ] [
[ lex-til-eol drop 2nip dup ] dip 1 cut-slice* line-comment-literal make-delimited-literal [ lex-til-eol drop 2nip dup ] dip 1 cut-slice* line-comment-literal make-delimited-literal
] if ; ] if ;

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

@ -63,3 +63,12 @@ in: modern.out.tests
{ 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 { t } [ [=[ [[omg]]]=] rewrite-same-string ] unit-test
{ t } [ "lol[[]]" rewrite-same-string ] unit-test
{ t } [ "![[]]" rewrite-same-string ] unit-test
{ t } [ "lol[[abc]]" rewrite-same-string ] unit-test
{ t } [ "![[abc]]" rewrite-same-string ] unit-test
{ t } [ "lol[==[]==]" rewrite-same-string ] unit-test
{ t } [ "![==[]==]" rewrite-same-string ] unit-test
{ t } [ "lol[==[abc]==]" rewrite-same-string ] unit-test
{ t } [ "![==[abc]==]" rewrite-same-string ] unit-test

1
core/modern/slices/slices.factor
View File

@ -196,4 +196,3 @@ ERROR: subseq-expected-but-got-eof n string expected ;
dup length 1 = [ dup length 1 = [
-1 modify-to [ 1 - ] 2dip -1 modify-to [ 1 - ] 2dip
] unless ; ] unless ;