blob: 665b5916d35e3f272335cbc70dff35e60ea4cf75 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
|
module GF.Compile.Coding where
import GF.Grammar.Grammar
import GF.Grammar.Macros
import GF.Text.UTF8
import GF.Text.CP1251
import GF.Infra.Modules
import GF.Infra.Option
import GF.Data.Operations
import Data.Char
encodeStringsInModule :: SourceModule -> SourceModule
encodeStringsInModule = codeSourceModule encodeUTF8
decodeStringsInModule :: SourceModule -> SourceModule
decodeStringsInModule mo = case mo of
(_,ModMod m) -> case flag optEncoding (flags m) of
UTF_8 -> codeSourceModule decodeUTF8 mo
CP_1251 -> codeSourceModule decodeCP1251 mo
_ -> mo
_ -> mo
codeSourceModule :: (String -> String) -> SourceModule -> SourceModule
codeSourceModule co (id,moi) = case moi of
ModMod mo -> (id, ModMod $ replaceJudgements mo (mapTree codj (jments mo)))
_ -> (id,moi)
where
codj (c,info) = case info of
ResOper pty pt -> ResOper (mapP codt pty) (mapP codt pt)
ResOverload es tyts -> ResOverload es [(codt ty,codt t) | (ty,t) <- tyts]
CncCat pty pt mpr -> CncCat pty (mapP codt pt) (mapP codt mpr)
CncFun mty pt mpr -> CncFun mty (mapP codt pt) (mapP codt mpr)
_ -> info
codt t = case t of
K s -> K (co s)
T ty cs -> T ty [(codp p,codt v) | (p,v) <- cs]
_ -> composSafeOp codt t
codp p = case p of --- really: composOpPatt
PR rs -> PR [(l,codp p) | (l,p) <- rs]
PString s -> PString (co s)
PChars s -> PChars (co s)
PT x p -> PT x (codp p)
PAs x p -> PAs x (codp p)
PNeg p -> PNeg (codp p)
PRep p -> PRep (codp p)
PSeq p q -> PSeq (codp p) (codp q)
PAlt p q -> PAlt (codp p) (codp q)
_ -> p
-- | Run an encoding function on all string literals within the given string.
codeStringLiterals :: (String -> String) -> String -> String
codeStringLiterals _ [] = []
codeStringLiterals co ('"':cs) = '"' : inStringLiteral cs
where inStringLiteral [] = error "codeStringLiterals: unterminated string literal"
inStringLiteral ('"':ds) = '"' : codeStringLiterals co ds
inStringLiteral ('\\':d:ds) = '\\' : co [d] ++ inStringLiteral ds
inStringLiteral (d:ds) = co [d] ++ inStringLiteral ds
codeStringLiterals co (c:cs) = c : codeStringLiterals co cs
|
