@@ -0,0 +1,146 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+module Temp
3+ ( toByte
4+ , intToAscii
5+ )
6+ where
7+
8+
9+import qualified Data.ByteString.Short as S
10+import qualified Data.Map as Map
11+import qualified Data.Set as Set
12+import qualified Data.Text as Text
13+import qualified Data.Text.Encoding as Text
14+import Data.Word (Word8)
15+
16+
17+
18+-- RESERVED NAMES
19+
20+
21+jsReservedWords :: Set.Set Text.Text
22+jsReservedWords =
23+ Set.fromList
24+ [ "do", "if", "in"
25+ , "NaN", "int", "for", "new", "try", "var", "let"
26+ , "null", "true", "eval", "byte", "char", "goto", "long", "case", "else", "this", "void", "with", "enum"
27+ , "false", "final", "float", "short", "break", "catch", "throw", "while", "class", "const", "super", "yield"
28+ , "double", "native", "throws", "delete", "return", "switch", "typeof", "export", "import", "public", "static"
29+ , "boolean", "default", "finally", "extends", "package", "private"
30+ , "Infinity", "abstract", "volatile", "function", "continue", "debugger", "function"
31+ , "undefined", "arguments", "transient", "interface", "protected"
32+ , "instanceof", "implements"
33+ , "synchronized"
34+ ]
35+
36+
37+
38+-- INT TO ASCII
39+
40+
41+intToAscii :: Int -> S.ShortByteString
42+intToAscii n =
43+ if n < 53 then -- skip $ as a standalone name
44+ S.pack [toByte n]
45+
46+ else
47+ intToAsciiHelp (numStartBytes * numInnerBytes) allBadFields (n - 53)
48+
49+
50+intToAsciiHelp :: Int -> [BadFields] -> Int -> S.ShortByteString
51+intToAsciiHelp blockSize badFields n =
52+ case badFields of
53+ [] ->
54+ if n < blockSize then
55+ unsafeIntToAscii n
56+ else
57+ intToAsciiHelp (blockSize * numInnerBytes) [] (n - blockSize)
58+
59+ BadFields renamings : biggerBadFields ->
60+ let availableSize = blockSize - Map.size renamings in
61+ if n < availableSize then
62+ let name = unsafeIntToAscii n in
63+ Map.findWithDefault name name renamings
64+ else
65+ intToAsciiHelp (blockSize * numInnerBytes) biggerBadFields (n - availableSize)
66+
67+
68+
69+-- UNSAFE INT TO ASCII
70+
71+
72+unsafeIntToAscii :: Int -> S.ShortByteString
73+unsafeIntToAscii n =
74+ let
75+ (quotient, remainder) =
76+ quotRem n numStartBytes
77+ in
78+ S.pack $ toByte remainder : unsafeIntToAsciiHelp quotient
79+
80+
81+unsafeIntToAsciiHelp :: Int -> [Word8]
82+unsafeIntToAsciiHelp n =
83+ if n == 0 then
84+ []
85+ else
86+ let (quotient, remainder) = quotRem n numInnerBytes in
87+ toByte remainder : unsafeIntToAsciiHelp quotient
88+
89+
90+
91+-- ASCII BYTES
92+
93+
94+numStartBytes :: Int
95+numStartBytes =
96+ 54
97+
98+
99+numInnerBytes :: Int
100+numInnerBytes =
101+ 64
102+
103+
104+toByte :: Int -> Word8
105+toByte n
106+ | n < 26 = fromIntegral (97 + n ) {- lower -}
107+ | n < 52 = fromIntegral (65 + n - 26) {- upper -}
108+ | n == 52 = 0x5F {- _ -}
109+ | n == 53 = 0x24 {- $ -}
110+ | n < 64 = fromIntegral (48 + n - 54) {- digit -}
111+ | True = error $ "cannot convert int " ++ show n ++ " to ASCII"
112+
113+
114+
115+-- BAD FIELDS
116+
117+
118+newtype BadFields =
119+ BadFields { _renamings :: Renamings }
120+
121+
122+type Renamings =
123+ Map.Map S.ShortByteString S.ShortByteString
124+
125+
126+allBadFields :: [BadFields]
127+allBadFields =
128+ let
129+ add keyword dict =
130+ Map.alter (Just . addRenaming keyword) (Text.length keyword) dict
131+ in
132+ Map.elems $ Set.foldr add Map.empty jsReservedWords
133+
134+
135+addRenaming :: Text.Text -> Maybe BadFields -> BadFields
136+addRenaming keyword maybeBadFields =
137+ let
138+ maxName =
139+ numStartBytes * numInnerBytes ^ (Text.length keyword - 1) - 1
140+ in
141+ case maybeBadFields of
142+ Nothing ->
143+ BadFields $ Map.singleton (S.toShort (Text.encodeUtf8 keyword)) (unsafeIntToAscii maxName)
144+
145+ Just (BadFields renamings) ->
146+ BadFields $ Map.insert (S.toShort (Text.encodeUtf8 keyword)) (unsafeIntToAscii (maxName - Map.size renamings)) renamings