lexer: support tag`foo, tag``foo``, tag```foo```, etc.

core/kernel/kernel-docs.factor

@@ -37,7 +37,7 @@ HELP: swapd $complex-shuffle ;
 
 HELP: get-datastack
 $values{ { "array" array } }
-$description { "Outputs an array containing a copy of the data stack contents right before the call to this word, with the top of the stack at the end of the array." } ;
+$description{ "Outputs an array containing a copy of the data stack contents right before the call to this word, with the top of the stack at the end of the array." } ;
 
 HELP: set-datastack
 $values{ { "array" array } }

core/lexer/lexer.factor

@@ -52,10 +52,27 @@ ERROR: unexpected want got ;
 : forbid-tab ( c -- c )
     [ char: \t eq? [ "[space]" "[tab]" unexpected ] when ] keep ; inline
 
-: skip ( i seq ? -- n )
+: skip-whitespace ( i seq -- n )
-    over length [
+    [
-        [ swap forbid-tab char: \s eq? xor ] curry find-from drop
+        [ forbid-tab char: \s eq? not ] find-from drop
-    ] dip or ; inline
+    ] keep length or ; inline
+
+:: skip-meat ( i seq -- n )
+    i seq
+    [
+        [ forbid-tab "\s\"\`" member? ] find-from
+        dup char: \` = [
+            drop seq [ char: \` eq? not ] find-from drop
+        ] [
+            dup char: \" = [ drop 1 + ] [ drop ] if
+        ] if
+        ! Can't use case here because bootstrap breaks after the dots.
+        ! {
+        !    { char: \` [ seq [ char: \` eq? not ] find-from drop ] }
+        !    { char: \" [ 1 + ] }
+        !    [ drop ]
+        ! } case
+    ] keep length or ; inline
 
 : change-lexer-column ( ..a lexer quot: ( ..a col line -- ..b newcol ) -- ..b )
     [ check-lexer [ column>> ] [ line-text>> ] bi ] prepose
@@ -78,14 +95,14 @@ M: lexer skip-blank
     shebang? [
         [ nip length ] change-lexer-column
     ] [
-        [ t skip ] change-lexer-column
+        [ skip-whitespace ] change-lexer-column
     ] if ;
 
 GENERIC: skip-word ( lexer -- ) ;
 
 M: lexer skip-word
     [
-        2dup nth char: \" eq? [ drop 1 + ] [ f skip ] if
+        skip-meat
     ] change-lexer-column ;
 
 : still-parsing? ( lexer -- ? )
@@ -102,6 +119,13 @@ M: lexer skip-word
         [ line-text>> ]
     } cleave subseq ;
 
+: parse-spaceless-payload ( lexer -- str/f )
+    dup still-parsing? [
+        (parse-raw)
+    ] [
+        drop f
+    ] if ;
+
 : parse-raw ( lexer -- str/f )
     dup still-parsing? [
         dup skip-blank

core/multiline/multiline.factor

@@ -26,7 +26,14 @@ PRIVATE<
 
 PRIVATE>
 
-: parse-multiline-string ( end-text -- str )
+
+: parse-multiline-string-old ( end-text -- str )
     lexer get 1 (parse-multiline-string) ;
 
+: parse-multiline-string-new ( end-text -- str )
+    lexer get 0 (parse-multiline-string) ;
+
+: parse-multiline-string ( end-text -- str )
+    parse-multiline-string-old ;
+
 SYNTAX: /* "*/" parse-multiline-string drop ;

core/syntax/syntax.factor

@@ -87,19 +87,19 @@ IN: bootstrap.syntax
 
 
     "`" [
-        scan-token suffix!
+        lexer get parse-spaceless-payload suffix!
     ] define-core-syntax
 
     "``" [
-        "``" parse-multiline-string suffix!
+        "``" parse-multiline-string-new suffix!
     ] define-core-syntax
 
     "```" [
-        "```" parse-multiline-string suffix!
+        "```" parse-multiline-string-new suffix!
     ] define-core-syntax
 
     "````" [
-        "````" parse-multiline-string suffix!
+        "````" parse-multiline-string-new suffix!
     ] define-core-syntax
 
     ! Different from parse-multiline-string

libs/urls/urls.factor

@@ -2,8 +2,8 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays assocs combinators fry io.pathnames
 io.sockets io.sockets.secure kernel lexer linked-assocs make
-math.parser namespaces peg.ebnf present sequences splitting
+math.parser multiline namespaces peg.ebnf present sequences
-strings strings.parser urls.encoding vocabs.loader ;
+splitting strings strings.parser urls.encoding vocabs.loader ;
 IN: urls
 
 TUPLE: url protocol username password host port path query anchor ;
@@ -187,5 +187,9 @@ PRIVATE>
 
 ! Literal syntax
 SYNTAX: \ URL" lexer get skip-blank parse-string >url suffix! ;
+SYNTAX: \ url" "\"" parse-multiline-string-new >url suffix! ;
+
+SYNTAX: \ url` lexer get (parse-raw) >url suffix! ;
+SYNTAX: \ url`` "``" parse-multiline-string-new >url suffix! ;
 
 { "urls" "prettyprint" } "urls.prettyprint" require-when