escape-strings: Add a way to find the shortest lua-string escape.

Also add a way to escape a string as either 'foo "foo" or [[foo]] depending on which delimiters will do the job.

Add a couple helper words to assocs.extras

diff --git a/basis/escape-strings/authors.txt b/basis/escape-strings/authors.txt
new file mode 100644 (file)
index 0000000..dbe8e57
--- /dev/null
+++ b/basis/escape-strings/authors.txt
@@ -0,0 +1,2 @@
+John Benediktsson
+Doug Coleman

diff --git a/basis/escape-strings/escape-strings-tests.factor b/basis/escape-strings/escape-strings-tests.factor
new file mode 100644 (file)
index 0000000..93a388f
--- /dev/null
+++ b/basis/escape-strings/escape-strings-tests.factor
@@ -0,0 +1,25 @@
+! Copyright (C) 2017 John Benediktsson, Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: tools.test escape-strings ;
+IN: escape-strings.tests
+
+{ "[[asdf]]" } [ "asdf" escape-string ] unit-test
+{ "[[[[]]" } [ "[[" escape-string ] unit-test
+{ "[=[]]]=]" } [ "]]" escape-string ] unit-test
+
+{ "[===[]]]==][=[=]=]]===]" } [ "]]]==][=[=]=]" escape-string ] unit-test
+{ "[==[[=[=]=]]==]" } [ "[=[=]=]" escape-string ] unit-test
+{ "[[[a[]]" } [ "[a[" escape-string ] unit-test
+
+{ "[=[ab]]=]" } [ "ab]" escape-string ] unit-test
+
+{ "[==[[=[abcd]]=]]==]" } [ { "abcd]" } escape-strings ] unit-test
+{ "[==[[=[abcd]]]=]]==]" } [ { "abcd]]" } escape-strings ] unit-test
+
+{ "[==[]]ab]=]==]" } [ "]]ab]=" escape-string ] unit-test
+{ "[=[]]ab]==]=]" } [ "]]ab]==" escape-string ] unit-test
+{ "[=[]]ab]===]=]" } [ "]]ab]===" escape-string ] unit-test
+
+{ "[[]ab]=]]" } [ "]ab]=" escape-string ] unit-test
+{ "[[]ab]==]]" } [ "]ab]==" escape-string ] unit-test
+{ "[[]ab]===]]" } [ "]ab]===" escape-string ] unit-test

diff --git a/basis/escape-strings/escape-strings.factor b/basis/escape-strings/escape-strings.factor
new file mode 100644 (file)
index 0000000..423b405
--- /dev/null
+++ b/basis/escape-strings/escape-strings.factor
@@ -0,0 +1,36 @@
+! Copyright (C) 2017 John Benediktsson, Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: assocs assocs.extras combinators kernel math math.order
+math.statistics sequences sequences.extras sets ;
+IN: escape-strings
+
+: find-escapes ( str -- set )
+    [ HS{ } clone 0 0 ] dip
+    [
+        {
+            { CHAR: ] [ 1 + dup 2 = [ drop over adjoin 0 1 ] when ] }
+            { CHAR: = [ dup 1 = [ [ 1 + ] dip ] when ] }
+            [ 3drop 0 0 ]
+        } case
+    ] each 0 > [ over adjoin ] [ drop ] if ;
+
+: lowest-missing ( set -- min )
+    members dup [ = not ] find-index
+    [ nip ] [ drop length ] if ;
+
+: escape-string* ( str n -- str' )
+    CHAR: = <repetition>
+    [ "[" dup surround ] [ "]" dup surround ] bi surround ;
+
+: escape-string ( str -- str' )
+    dup find-escapes lowest-missing escape-string* ;
+
+: escape-strings ( strs -- str )
+    [ escape-string ] map concat escape-string ;
+
+: escape-simplest ( str -- str' )
+    dup { CHAR: ' CHAR: " CHAR: \r CHAR: \n CHAR: \s } counts {
+        { [ dup { CHAR: ' CHAR: \r CHAR: \n CHAR: \s } values-of sum 0 = ] [ drop "'" prepend ] }
+        { [ dup CHAR: " of not ] [ drop "\"" "\"" surround ] }
+        [ drop escape-string ]
+    } cond ;
\ No newline at end of file

diff --git a/extra/assocs/extras/extras.factor b/extra/assocs/extras/extras.factor
index 27da0347e9af32b057a95b0c96333cf9c4b960a2..a426ae456843bcdd1596ed1ac1c0e73a574fc62c 100644 (file)
--- a/extra/assocs/extras/extras.factor
+++ b/extra/assocs/extras/extras.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2012 John Benediktsson, Doug Coleman
 ! See http://factorcode.org/license.txt for BSD license
 USING: arrays assocs assocs.private fry generalizations kernel
-math sequences ;
+math math.statistics sequences sequences.extras ;
 IN: assocs.extras
 
 : deep-at ( assoc seq -- value/f )
@@ -163,3 +163,12 @@ PRIVATE>
 
 : flatten-values ( assoc -- assoc' )
     dup any-multi-value? [ expand-values-set-at flatten-values ] when ;
+
+: intersect-keys ( assoc seq -- elts )
+    [ of ] with map-zip sift-values ; inline
+
+: values-of ( assoc seq -- elts )
+    [ of ] with map sift ; inline
+
+: counts ( seq elts -- counts )
+    [ histogram ] dip intersect-keys ;
\ No newline at end of file