forked from GitHub/gf-core
61 lines
2.2 KiB
Haskell
61 lines
2.2 KiB
Haskell
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) = (c, 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
|