From 2069b47183993fbe9ab9b6984d0e3cb2c7fb6a75 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Thu, 23 Jun 2016 21:12:51 -0700
Subject: [PATCH] modern: add support for backticks. tag`payload tag``payload``
 tag```payload```

---
 core/modern/lexer/lexer.factor   | 15 +++++++++++++++
 core/modern/modern.factor        | 29 ++++++++++++++++++++---------
 core/modern/out/out-tests.factor |  7 +++++++
 core/modern/slices/slices.factor | 10 ++++++++++
 4 files changed, 52 insertions(+), 9 deletions(-)

diff --git a/core/modern/lexer/lexer.factor b/core/modern/lexer/lexer.factor
index 803ef6d06f..b835d4a098 100644
--- a/core/modern/lexer/lexer.factor
+++ b/core/modern/lexer/lexer.factor
@@ -170,3 +170,18 @@ ERROR: subseq-expected-but-got-eof n string expected ;
 
 : skip-blanks ( lexer -- lexer )
     dup >lexer< skip-blank-from drop >>n ; inline
+
+ERROR: char-expected-but-got-eof n string expected ;
+
+:: slice-til-not-char ( n string slice char --  n' string found )
+    n string [ char = not ] find-from drop :> n'
+    n' [ n string char char-expected-but-got-eof ] unless
+    n'
+    string
+    slice from>> n' string ?<slice> ;
+
+:: lex-til-not-char ( lexer slice char -- n'/f string' found )
+    lexer >lexer< slice char slice-til-not-char :> ( n' string' found )
+    lexer
+        n' >>n drop
+    n' string' found ;
diff --git a/core/modern/modern.factor b/core/modern/modern.factor
index 938102e656..7cb566c28e 100644
--- a/core/modern/modern.factor
+++ b/core/modern/modern.factor
@@ -5,8 +5,8 @@ combinators.short-circuit constructors continuations fry
 generalizations io.encodings.utf8 io.files kernel locals macros
 make math math.order modern.lexer modern.paths modern.slices
 namespaces quotations sequences sequences.extras
-shuffle splitting splitting.extras splitting.monotonic strings
-unicode vocabs.loader ;
+sequences.private shuffle splitting splitting.extras
+splitting.monotonic strings unicode vocabs.loader ;
 IN: modern
 
 COMPILE<
@@ -42,8 +42,8 @@ TUPLE: uppercase-colon-literal < single-matched-literal ;
 TUPLE: lowercase-colon-literal < delimited-literal ;
 ! TUPLE: standalone-colon-literal < delimited-literal ; ! :foo
 TUPLE: backtick-literal < delimited-literal ;
-TUPLE: backslash-literal < delimited-literal ;
-TUPLE: semicolon-literal < delimited-literal ;
+TUPLE: matched-backtick-literal < double-matched-literal ;
+TUPLE: backslash-literal < single-matched-literal ;
 TUPLE: line-comment-literal < delimited-literal ;
 TUPLE: terminator-literal < tag-literal ;
 TUPLE: whitespace-literal < tag-literal ;
@@ -419,13 +419,24 @@ ERROR: closing-tag-required lexer tag ;
     dup { [ "!" sequence= ] [ "#!" sequence= ] } 1||
     [ take-comment ] [ >>partial [ 1 + ] change-n lex-factor ] if ;
 
+: count-head ( seq quot -- n )
+    (trim-head) [ length ] dip - ; inline
 
-: read-backtick ( lexer opening -- obj )
-    [
-        lex-til-whitespace drop 2nip
-        dup
-    ] dip 1 cut-slice* backtick-literal make-delimited-literal ;
+: count-tail ( seq quot -- n )
+    (trim-tail) [ length ] dip - ; inline
 
+:: read-backtick ( lexer slice -- obj )
+    lexer slice char: \` lex-til-not-char 2nip :> tag-opening
+    tag-opening [ char: \` = ] count-tail :> count
+    tag-opening count cut-slice* :> ( tag opening )
+    count 1 > [
+        lexer opening lex-til-string :> ( n' string' payload closing )
+        payload closing tag opening matched-backtick-literal make-matched-literal
+        [ >string ] change-payload
+    ] [
+        lexer lex-til-whitespace drop 2nip
+        dup slice 1 cut-slice* backtick-literal make-delimited-literal
+    ] if ;
 
 ERROR: backslash-expects-whitespace slice ;
 : read-backslash ( lexer slice -- obj )
diff --git a/core/modern/out/out-tests.factor b/core/modern/out/out-tests.factor
index 209469ad84..15bde4702e 100644
--- a/core/modern/out/out-tests.factor
+++ b/core/modern/out/out-tests.factor
@@ -83,3 +83,10 @@ IN: modern.out.tests
 { t } [ "abc>[ ]" rewrite-same-string ] unit-test
 { t } [ "CC>n" rewrite-same-string ] unit-test
 { t } [ "CC>CC" rewrite-same-string ] unit-test
+
+{ t } [ "`omg" rewrite-same-string ] unit-test
+{ t } [ "``omg``" rewrite-same-string ] unit-test
+{ t } [ "```omg```" rewrite-same-string ] unit-test
+{ t } [ "lol`omg" rewrite-same-string ] unit-test
+{ t } [ "lol``omg``" rewrite-same-string ] unit-test
+{ t } [ "lol```omg```" rewrite-same-string ] unit-test
\ No newline at end of file
diff --git a/core/modern/slices/slices.factor b/core/modern/slices/slices.factor
index 3fa8749ec7..bd329449b2 100644
--- a/core/modern/slices/slices.factor
+++ b/core/modern/slices/slices.factor
@@ -182,6 +182,16 @@ ERROR: subseq-expected-but-got-eof n string expected ;
     n n' string ?<slice>
     n' dup search length + string ?<slice> ;
 
+ERROR: char-expected-but-got-eof n string expected ;
+
+:: slice-til-not-char ( n string slice char --  n' string found )
+    n string [ char = not ] find-from drop :> n'
+    n' [ n string char char-expected-but-got-eof ] unless
+    B
+    n'
+    string
+    slice from>> n' string ?<slice> ;
+
 : modify-from ( slice n -- slice' )
     '[ from>> _ + ] [ to>> ] [ seq>> ] tri <slice> ;