summaryrefslogtreecommitdiff
path: root/src/compiler/GF/Compile/Coding.hs
diff options
context:
space:
mode:
authorkrasimir <krasimir@chalmers.se>2009-12-13 18:50:29 +0000
committerkrasimir <krasimir@chalmers.se>2009-12-13 18:50:29 +0000
commitf85232947e74ee7ef8c7b0ad2338212e7e68f1be (patch)
tree667b886a5e3a4b026a63d4e3597f32497d824761 /src/compiler/GF/Compile/Coding.hs
parentd88a865faff59c98fc91556ff8700b10ee5f2df8 (diff)
reorganize the directories under src, and rescue the JavaScript interpreter from deprecated
Diffstat (limited to 'src/compiler/GF/Compile/Coding.hs')
-rw-r--r--src/compiler/GF/Compile/Coding.hs55
1 files changed, 55 insertions, 0 deletions
diff --git a/src/compiler/GF/Compile/Coding.hs b/src/compiler/GF/Compile/Coding.hs
new file mode 100644
index 000000000..49538bd35
--- /dev/null
+++ b/src/compiler/GF/Compile/Coding.hs
@@ -0,0 +1,55 @@
+module GF.Compile.Coding where
+
+import GF.Grammar.Grammar
+import GF.Grammar.Macros
+import GF.Text.Coding
+import GF.Infra.Modules
+import GF.Infra.Option
+import GF.Data.Operations
+
+import Data.Char
+
+encodeStringsInModule :: SourceModule -> SourceModule
+encodeStringsInModule = codeSourceModule (encodeUnicode UTF_8)
+
+decodeStringsInModule :: SourceModule -> SourceModule
+decodeStringsInModule mo = codeSourceModule (decodeUnicode (flag optEncoding (flagsModule mo))) mo
+
+codeSourceModule :: (String -> String) -> SourceModule -> SourceModule
+codeSourceModule co (id,mo) = (id,replaceJudgements mo (mapTree codj (jments mo)))
+ where
+ codj (c,info) = case info of
+ ResOper pty pt -> ResOper (fmap (codeTerm co) pty) (fmap (codeTerm co) pt)
+ ResOverload es tyts -> ResOverload es [(codeTerm co ty,codeTerm co t) | (ty,t) <- tyts]
+ CncCat pty pt mpr -> CncCat pty (fmap (codeTerm co) pt) (fmap (codeTerm co) mpr)
+ CncFun mty pt mpr -> CncFun mty (fmap (codeTerm co) pt) (fmap (codeTerm co) mpr)
+ _ -> info
+
+codeTerm :: (String -> String) -> Term -> Term
+codeTerm co t = case t of
+ K s -> K (co s)
+ T ty cs -> T ty [(codp p,codeTerm co v) | (p,v) <- cs]
+ EPatt p -> EPatt (codp p)
+ _ -> composSafeOp (codeTerm co) t
+ where
+ 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