diff --git a/basis/alien/syntax/syntax.factor b/basis/alien/syntax/syntax.factor index cbf93f735a..6676906941 100755 --- a/basis/alien/syntax/syntax.factor +++ b/basis/alien/syntax/syntax.factor @@ -6,7 +6,7 @@ strings.parser vocabs words ; << "alien.arrays" require >> ! needed for bootstrap IN: alien.syntax -SYNTAX: DLL" lexer get skip-blank parse-string dlopen suffix! ; +SYNTAX: DLL" lexer get skip-blank parse-short-string dlopen suffix! ; SYNTAX: ALIEN: 16 scan-base suffix! ; diff --git a/basis/urls/urls.factor b/basis/urls/urls.factor index f149f499d9..45d87fc9c1 100644 --- a/basis/urls/urls.factor +++ b/basis/urls/urls.factor @@ -196,7 +196,7 @@ PRIVATE> clone dup protocol>> '[ _ protocol-port or ] change-port ; ! Literal syntax -SYNTAX: URL" lexer get skip-blank parse-string >url suffix! ; +SYNTAX: URL" lexer get skip-blank parse-short-string >url suffix! ; { "urls" "prettyprint" } "urls.prettyprint" require-when { "urls" "io.sockets.secure" } "urls.secure" require-when diff --git a/core/strings/parser/parser-docs.factor b/core/strings/parser/parser-docs.factor index e1c53cd87a..8f912a0287 100644 --- a/core/strings/parser/parser-docs.factor +++ b/core/strings/parser/parser-docs.factor @@ -9,8 +9,14 @@ HELP: escape { $description "Converts from a single-character escape code and the corresponding character." } { $examples { $example "USING: kernel prettyprint strings.parser ;" "CHAR: n escape CHAR: \\n = ." "t" } } ; -HELP: parse-string +HELP: parse-short-string { $values { "str" "a new " { $link string } } } { $description "Parses the line until a quote (\"), interpreting escape codes along the way." } { $errors "Throws an error if the string contains an invalid escape sequence." } $parsing-note ; + +HELP: parse-full-string +{ $values { "str" "a new " { $link string } } } +{ $description "Parses one or more lines until a quote (\"), interpreting escape codes along the way." } +{ $errors "Throws an error if the string contains an invalid escape sequence." } +$parsing-note ; diff --git a/core/strings/parser/parser-tests.factor b/core/strings/parser/parser-tests.factor index 237f91fcbb..dfc5c0efca 100644 --- a/core/strings/parser/parser-tests.factor +++ b/core/strings/parser/parser-tests.factor @@ -13,18 +13,9 @@ IN: strings.parser.tests " "hi" ] unit-test { "Hello\n\rworld\"" "hi" } [ "Hello\n\rworld\"" "hi" ] unit-test -[ - "\"\"\"Hello\n\rworld\\\n\"\"\"" eval( -- obj ) -] [ - error>> escaped-char-expected? -] must-fail-with - -{ - "\"abc\"" -} [ - "\"\\\"abc\\\"\"" eval( -- string ) -] unit-test +{ "foobarbaz" } [ "\"foo\\\nbar\\\r\nbaz\"" eval( -- obj ) ] unit-test +{ "\"abc\"" } [ "\"\\\"abc\\\"\"" eval( -- string ) ] unit-test { "\"\\" } [ "\"\\" ] unit-test diff --git a/core/strings/parser/parser.factor b/core/strings/parser/parser.factor index 97ee6836f0..6f7e0f1bec 100644 --- a/core/strings/parser/parser.factor +++ b/core/strings/parser/parser.factor @@ -70,14 +70,14 @@ PRIVATE> > ] [ - next-escape [ suffix! ] dip (parse-string) + next-escape [ suffix! ] dip (parse-short-string) ] if ] [ "Unterminated string" throw @@ -85,9 +85,9 @@ PRIVATE> PRIVATE> -: parse-string ( -- str ) +: parse-short-string ( -- str ) SBUF" " clone lexer get [ - swap tail-slice (parse-string) [ "" like ] dip + swap tail-slice (parse-short-string) [ "" like ] dip ] change-lexer-column ; { lexer } declare [ 1 + ] change-column drop ; -ERROR: escaped-char-expected ; - -: next-char ( lexer -- ch ) +: next-char ( lexer -- ch/f ) { lexer } declare dup still-parsing-line? [ [ current-char ] [ advance-char ] bi ] [ - escaped-char-expected + drop f ] if ; -: lexer-head? ( lexer string -- ? ) - { lexer string } declare - [ rest-of-line ] dip head? ; - -: advance-lexer ( lexer n -- ) - { lexer fixnum } declare - [ + ] curry change-column drop ; - -: find-next-token ( lexer ch -- i elt ) - { lexer fixnum } declare - [ [ column>> ] [ line-text>> ] bi ] dip - CHAR: \ 2array [ member? ] curry find-from ; - : next-line% ( accum lexer -- ) { sbuf lexer } declare - [ rest-of-line swap push-all ] - [ next-line CHAR: \n swap push ] 2bi ; + [ rest-of-line swap push-all ] [ next-line ] bi ; -: take-double-quotes ( lexer -- string ) +: find-next-token ( lexer -- i elt ) { lexer } declare - dup current-char CHAR: " = [ - dup [ column>> ] [ line-text>> ] bi - [ CHAR: " = not ] find-from drop [ - over column>> - CHAR: " - ] [ - dup rest-of-line - ] if* - [ length advance-lexer ] keep - ] [ drop f ] if ; + [ column>> ] [ line-text>> ] bi + [ "\"\\" member? ] find-from ; -: end-string-parse ( accum lexer delimiter -- ) - { sbuf lexer string } declare - length 3 = [ - take-double-quotes 3 tail-slice swap push-all +DEFER: (parse-full-string) + +: parse-found-token ( accum lexer i elt -- ) + { sbuf lexer fixnum fixnum } declare + [ over lexer-subseq pick push-all ] dip + CHAR: \ = [ + dup dup [ next-char ] bi@ + [ [ pick push ] bi@ ] + [ drop 2dup next-line% ] if* + (parse-full-string) ] [ advance-char drop ] if ; -DEFER: (parse-multiline-string-until) - -: parse-found-token ( accum lexer string i token -- ) - { sbuf lexer string fixnum fixnum } declare - [ [ 2over ] dip swap lexer-subseq swap push-all ] dip - CHAR: \ = [ - 2over next-char swap push - 2over next-char swap push - (parse-multiline-string-until) - ] [ - 2dup lexer-head? [ - end-string-parse - ] [ - 2over next-char swap push - (parse-multiline-string-until) - ] if - ] if ; - -: (parse-multiline-string-until) ( accum lexer string -- ) - { sbuf lexer fixnum } declare - over still-parsing? [ - 2dup first find-next-token [ +: (parse-full-string) ( accum lexer -- ) + { sbuf lexer } declare + dup still-parsing? [ + dup find-next-token [ parse-found-token ] [ - drop 2over next-line% - (parse-multiline-string-until) + drop 2dup next-line% + CHAR: \n pick push + (parse-full-string) ] if* ] [ throw-unexpected-eof @@ -190,7 +156,7 @@ DEFER: (parse-multiline-string-until) PRIVATE> -: parse-multiline-string-until ( arg -- string ) - [ SBUF" " clone ] dip [ - [ lexer get ] dip (parse-multiline-string-until) - ] curry keep unescape-string ; +: parse-full-string ( -- str ) + SBUF" " clone [ + lexer get (parse-full-string) + ] keep unescape-string ; diff --git a/core/syntax/syntax.factor b/core/syntax/syntax.factor index 55f8561a47..306cf7c758 100644 --- a/core/syntax/syntax.factor +++ b/core/syntax/syntax.factor @@ -92,14 +92,14 @@ IN: bootstrap.syntax } cond suffix! ] define-core-syntax - "\"" [ "\"" parse-multiline-string-until suffix! ] define-core-syntax + "\"" [ parse-full-string suffix! ] define-core-syntax "SBUF\"" [ - lexer get skip-blank parse-string >sbuf suffix! + lexer get skip-blank parse-full-string >sbuf suffix! ] define-core-syntax "P\"" [ - lexer get skip-blank parse-string suffix! + lexer get skip-blank parse-short-string suffix! ] define-core-syntax "[" [ parse-quotation suffix! ] define-core-syntax