basis: use lint.vocabs tool to trim using lists

[factor.git] / basis / interpolate / interpolate.factor

diff --git a/basis/interpolate/interpolate.factor b/basis/interpolate/interpolate.factor
index 27f0756f1f2eb6a124881ab68e9d2b90c826ad97..cd300a585c73791bc08121fa464a880f61418cfe 100644 (file)
--- a/basis/interpolate/interpolate.factor
+++ b/basis/interpolate/interpolate.factor
@@ -1,21 +1,90 @@
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: io kernel macros make multiline namespaces parser
-peg.ebnf present sequences strings ;
+USING: accessors fry generalizations io io.streams.string kernel
+make math math.order math.parser multiline namespaces present
+sequences splitting strings vocabs.parser ;
 IN: interpolate
 
-MACRO: interpolate ( string -- )
-[EBNF
-var = "${" [^}]+ "}" => [[ second >string [ get present write ] curry ]]
-text = [^$]+ => [[ >string [ write ] curry ]]
-interpolate = (var|text)* => [[ [ ] join ]]
-EBNF] ;
-
-EBNF: interpolate-locals
-var = "${" [^}]+ "}" => [[ [ second >string search , [ present write ] % ] [ ] make ]]
-text = [^$]+ => [[ [ >string , [ write ] % ] [ ] make ]]
-interpolate = (var|text)* => [[ [ ] join ]]
-;EBNF
-
-: I[ "]I" parse-multiline-string
-    interpolate-locals parsed \ call parsed ; parsing
+<PRIVATE
+
+TUPLE: named-var name ;
+
+TUPLE: stack-var n ;
+
+TUPLE: anon-var ;
+
+: (parse-interpolate) ( str -- )
+    [
+        "${" split1-slice [
+            [ >string , ] unless-empty
+        ] [
+            [
+                "}" split1-slice
+                [
+                    >string dup string>number
+                    [ 1 + stack-var boa ]
+                    [ [ anon-var new ] [ named-var boa ] if-empty ] ?if ,
+                ]
+                [ (parse-interpolate) ] bi*
+            ] when*
+        ] bi*
+    ] unless-empty ;
+
+: deanonymize ( seq -- seq' )
+    0 over <reversed> [
+        dup anon-var? [
+            drop 1 + dup stack-var boa
+        ] when
+    ] map! 2drop ;
+
+: parse-interpolate ( str -- seq )
+    [ (parse-interpolate) ] { } make deanonymize ;
+
+: max-stack-var ( seq -- n/f )
+    f [
+        dup stack-var? [ n>> [ or ] keep max ] [ drop ] if
+    ] reduce ;
+
+:: (interpolate-quot) ( str quot -- quot' )
+    str parse-interpolate :> args
+    args max-stack-var    :> vars
+
+    args [
+        dup named-var? [
+            name>> quot call '[ _ @ present write ]
+        ] [
+            dup stack-var? [
+                n>> '[ _ npick present write ]
+            ] [
+                '[ _ write ]
+            ] if
+        ] if
+    ] map concat
+
+    vars [
+        '[ _ ndrop ] append
+    ] when* ; inline
+
+PRIVATE>
+
+: interpolate-quot ( str -- quot )
+    [ [ get ] ] (interpolate-quot) ;
+
+MACRO: interpolate ( str -- quot )
+    interpolate-quot ;
+
+: interpolate>string ( str -- newstr )
+    [ interpolate ] with-string-writer ; inline
+
+: interpolate-locals-quot ( str -- quot )
+    [ dup search [ [ ] ] [ [ get ] ] ?if ] (interpolate-quot) ;
+
+MACRO: interpolate-locals ( str -- quot )
+    interpolate-locals-quot ;
+
+: interpolate-locals>string ( str -- newstr )
+    [ interpolate-locals ] with-string-writer ; inline
+
+SYNTAX: [I
+    "I]" parse-multiline-string
+    interpolate-locals-quot append! ;