-IN: strings.parser.tests
USING: strings.parser tools.test ;
+IN: strings.parser.tests
[ "Hello\n\rworld" ] [ "Hello\\n\\rworld" unescape-string ] unit-test
+
+[ "Hello\n\rworld" ] [ "Hello\n\rworld" ] unit-test
+[ "Hello\n\rworld" ] [ """Hello\n\rworld""" ] unit-test
+[ "Hello\n\rworld\n" ] [ "Hello\n\rworld
+" ] unit-test
+[ "Hello\n\rworld" "hi" ] [ "Hello\n\rworld" "hi" ] unit-test
+[ "Hello\n\rworld" "hi" ] [ """Hello\n\rworld""" """hi""" ] unit-test
+[ "Hello\n\rworld\n" "hi" ] [ """Hello\n\rworld
+""" """hi""" ] unit-test
+[ "Hello\n\rworld\"" "hi" ] [ """Hello\n\rworld\"""" """hi""" ] unit-test
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov, Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel assocs namespaces make splitting sequences
-strings math.parser lexer accessors ;
+USING: accessors assocs kernel lexer make math math.parser
+namespaces parser sequences splitting strings arrays ;
IN: strings.parser
ERROR: bad-escape ;
unclip-slice escape swap
] if ;
+: (unescape-string) ( str -- )
+ CHAR: \\ over index dup [
+ cut-slice [ % ] dip rest-slice
+ next-escape [ , ] dip
+ (unescape-string)
+ ] [
+ drop %
+ ] if ;
+
+: unescape-string ( str -- str' )
+ [ (unescape-string) ] "" make ;
+
: (parse-string) ( str -- m )
dup [ "\"\\" member? ] find dup [
[ cut-slice [ % ] dip rest-slice ] dip
[ swap tail-slice (parse-string) ] "" make swap
] change-lexer-column ;
-: (unescape-string) ( str -- )
- CHAR: \\ over index dup [
- cut-slice [ % ] dip rest-slice
- next-escape [ , ] dip
- (unescape-string)
+<PRIVATE
+
+: lexer-advance ( i -- before )
+ [
+ [
+ lexer get
+ [ column>> ] [ line-text>> ] bi
+ ] dip swap subseq
] [
- drop %
+ lexer get (>>column)
+ ] bi ;
+
+: find-next-token ( ch -- i elt )
+ CHAR: \ 2array
+ [ lexer get [ column>> ] [ line-text>> ] bi ] dip
+ [ member? ] curry find-from ;
+
+: rest-of-line ( -- seq )
+ lexer get [ line-text>> ] [ column>> ] bi tail-slice ;
+
+: parse-escape ( i -- )
+ lexer-advance % CHAR: \ ,
+ lexer get
+ [ [ 2 + ] change-column drop ]
+ [ [ column>> 1 - ] [ line-text>> ] bi nth , ] bi ;
+
+: next-string-line ( obj -- )
+ drop rest-of-line %
+ lexer get next-line "\n" % ;
+
+: rest-begins? ( string -- ? )
+ [
+ lexer get [ line-text>> ] [ column>> ] bi tail-slice
+ ] dip head? ;
+
+DEFER: (parse-long-string)
+
+: parse-rest-of-line ( string i token -- )
+ CHAR: \ = [
+ parse-escape (parse-long-string)
+ ] [
+ lexer-advance %
+ dup rest-begins? [
+ [ lexer get ] dip length [ + ] curry change-column drop
+ ] [
+ rest-of-line %
+ lexer get next-line "\n" % (parse-long-string)
+ ] if
] if ;
-: unescape-string ( str -- str' )
- [ (unescape-string) ] "" make ;
+: parse-til-separator ( string -- )
+ dup first find-next-token [
+ parse-rest-of-line
+ ] [
+ next-string-line (parse-long-string)
+ ] if* ;
+
+: (parse-long-string) ( string -- )
+ lexer get still-parsing? [
+ parse-til-separator
+ ] [
+ unexpected-eof
+ ] if ;
+
+PRIVATE>
+
+: parse-long-string ( string -- string' )
+ [ (parse-long-string) ] "" make unescape-string ;
+
+: parse-multiline-string ( -- string )
+ rest-of-line "\"\"" head? [
+ lexer get [ 2 + ] change-column drop
+ "\"\"\"" parse-long-string
+ ] [
+ "\"" parse-long-string
+ ] if ;