]> gitweb.factorcode.org Git - factor.git/commitdiff
urls.encoding: speed up decode on unicode.
authorJohn Benediktsson <mrjbq7@gmail.com>
Fri, 5 Mar 2021 02:18:41 +0000 (18:18 -0800)
committerJohn Benediktsson <mrjbq7@gmail.com>
Fri, 5 Mar 2021 02:18:41 +0000 (18:18 -0800)
basis/urls/encoding/encoding.factor

index 0d9cb5dfb3aabfc6ee26069826da11fcddda2775..5101e8fac87031b8371b02101c3d78890e7329fc 100644 (file)
@@ -1,9 +1,9 @@
 ! Copyright (C) 2008, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays ascii assocs byte-arrays combinators
-combinators.short-circuit fry io.encodings.string
+combinators.short-circuit io.encodings io.encodings.string
 io.encodings.utf8 kernel linked-assocs make math math.parser
-present sequences splitting strings ;
+namespaces present sequences sequences.private splitting strings ;
 IN: urls.encoding
 
 : url-quotable? ( ch -- ? )
@@ -38,7 +38,7 @@ IN: urls.encoding
 : hex% ( n -- )
     CHAR: % , >hex >upper 2 CHAR: 0 pad-head % ;
 
-: push-utf8 ( ch -- )
+: hex-utf8% ( ch -- )
     1string utf8 encode [ hex% ] each ;
 
 : (url-encode) ( str quot: ( ch -- ? ) -- encoded )
@@ -47,7 +47,7 @@ IN: urls.encoding
             '[ dup @ [ , ] [ hex% ] if ] each
         ] [
             [ present ] dip
-            '[ dup @ [ , ] [ push-utf8 ] if ] each
+            '[ dup @ [ , ] [ hex-utf8% ] if ] each
         ] if
     ] "" make ; inline
 
@@ -61,6 +61,9 @@ PRIVATE>
 
 <PRIVATE
 
+: utf8% ( ch -- )
+    building get utf8 encode-char ;
+
 : url-decode-hex ( index str -- )
     2dup length 2 - >= [
         2drop
@@ -72,12 +75,12 @@ PRIVATE>
     2dup length >= [
         2drop
     ] [
-        2dup nth dup CHAR: % = [
+        2dup nth-unsafe dup CHAR: % = [
             drop 2dup url-decode-hex [ 3 + ] dip
         ] [
-            1string utf8 encode % [ 1 + ] dip
+            utf8% [ 1 + ] dip
         ] if url-decode-iter
-    ] if ;
+    ] if ; inline recursive
 
 PRIVATE>
 
@@ -130,7 +133,7 @@ PRIVATE>
 
 : encode-uri-component ( str -- str' )
     [
-        [ dup escape-uri-component-char? [ push-utf8 ] [ , ] if ] each
+        [ dup escape-uri-component-char? [ hex-utf8% ] [ , ] if ] each
     ] "" make ;
 
 : escape-uri-char? ( ch -- ? )
@@ -143,7 +146,7 @@ PRIVATE>
 
 : encode-uri ( str -- str' )
     [
-        [ dup escape-uri-char? [ push-utf8 ] [ , ] if ] each
+        [ dup escape-uri-char? [ hex-utf8% ] [ , ] if ] each
     ] "" make ;
 
 <PRIVATE
@@ -163,10 +166,10 @@ PRIVATE>
         2dup length >= [
             2drop
         ] [
-            2dup nth dup CHAR: % = [
+            2dup nth-unsafe dup CHAR: % = [
                 drop 2dup _ decode-uri-hex [ 3 + ] dip
             ] [
-                1string utf8 encode % [ 1 + ] dip
+                utf8% [ 1 + ] dip
             ] if _ decode-uri-iter
         ] if
     ] call ; inline recursive