Rewrite interpolate without using PEGs for mad lulz

basis/interpolate/interpolate-tests.factor

@@ -1,4 +1,22 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: tools.test interpolate ;
+USING: interpolate io.streams.string namespaces tools.test locals ;
 IN: interpolate.tests
+
+[ "Hello, Jane." ] [
+    "Jane" "name" set
+    [ "Hello, ${name}." interpolate ] with-string-writer
+] unit-test
+
+[ "Sup Dawg, we heard you liked rims, so we put rims on your rims so you can roll while you roll." ] [
+    "Dawg" "name" set
+    "rims" "noun" set
+    "roll" "verb" set
+    [ "Sup ${name}, we heard you liked ${noun}, so we put ${noun} on your ${noun} so you can ${verb} while you ${verb}." interpolate ] with-string-writer
+] unit-test
+
+[ "Oops, I accidentally the whole economy..." ] [
+    [let | noun [ "economy" ] |
+        [ I[ Oops, I accidentally the whole ${noun}...]I ] with-string-writer
+    ]
+] unit-test

basis/interpolate/interpolate.factor

@@ -1,21 +1,40 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: io kernel macros make multiline namespaces parser
-peg.ebnf present sequences strings ;
+present sequences strings splitting fry accessors ;
 IN: interpolate
 
-MACRO: interpolate ( string -- )
+TUPLE: interpolate-var name ;
-[EBNF
-var = "${" [^}]+ "}" => [[ second >string [ get present write ] curry ]]
-text = [^$]+ => [[ >string [ write ] curry ]]
-interpolate = (var|text)* => [[ [ ] join ]]
-EBNF] ;
 
-EBNF: interpolate-locals
+: (parse-interpolate) ( string -- )
-var = "${" [^}]+ "}" => [[ [ second >string search , [ present write ] % ] [ ] make ]]
+    [
-text = [^$]+ => [[ [ >string , [ write ] % ] [ ] make ]]
+        "${" split1-slice [ >string , ] [
-interpolate = (var|text)* => [[ [ ] join ]]
+            [
-;EBNF
+                "}" split1-slice
+                [ >string interpolate-var boa , ]
+                [ (parse-interpolate) ] bi*
+            ] when*
+        ] bi*
+    ] unless-empty ;
+
+: parse-interpolate ( string -- seq )
+    [ (parse-interpolate) ] { } make ;
+
+MACRO: interpolate ( string -- )
+    parse-interpolate [
+        dup interpolate-var?
+        [ name>> '[ _ get present write ] ]
+        [ '[ _ write ] ]
+        if
+    ] map [ ] join ;
+
+: interpolate-locals ( string -- quot )
+    parse-interpolate [
+        dup interpolate-var?
+        [ name>> search '[ _ present write ] ]
+        [ '[ _ write ] ]
+        if
+    ] map [ ] join ;
 
 : I[ "]I" parse-multiline-string
     interpolate-locals parsed \ call parsed ; parsing