fix the unicode encoding problem with the cc command

This commit is contained in:
krasimir
2009-08-18 07:08:44 +00:00
parent cd511bbc25
commit 44e0e0e3cd
2 changed files with 13 additions and 9 deletions

View File

@@ -19,15 +19,18 @@ codeSourceModule :: (String -> String) -> SourceModule -> SourceModule
codeSourceModule co (id,mo) = (id,replaceJudgements mo (mapTree codj (jments mo))) codeSourceModule co (id,mo) = (id,replaceJudgements mo (mapTree codj (jments mo)))
where where
codj (c,info) = case info of codj (c,info) = case info of
ResOper pty pt -> ResOper (fmap codt pty) (fmap codt pt) ResOper pty pt -> ResOper (fmap (codeTerm co) pty) (fmap (codeTerm co) pt)
ResOverload es tyts -> ResOverload es [(codt ty,codt t) | (ty,t) <- tyts] ResOverload es tyts -> ResOverload es [(codeTerm co ty,codeTerm co t) | (ty,t) <- tyts]
CncCat pty pt mpr -> CncCat pty (fmap codt pt) (fmap codt mpr) CncCat pty pt mpr -> CncCat pty (fmap (codeTerm co) pt) (fmap (codeTerm co) mpr)
CncFun mty pt mpr -> CncFun mty (fmap codt pt) (fmap codt mpr) CncFun mty pt mpr -> CncFun mty (fmap (codeTerm co) pt) (fmap (codeTerm co) mpr)
_ -> info _ -> info
codt t = case t of
codeTerm :: (String -> String) -> Term -> Term
codeTerm co t = case t of
K s -> K (co s) K s -> K (co s)
T ty cs -> T ty [(codp p,codt v) | (p,v) <- cs] T ty cs -> T ty [(codp p,codeTerm co v) | (p,v) <- cs]
_ -> composSafeOp codt t _ -> composSafeOp (codeTerm co) t
where
codp p = case p of --- really: composOpPatt codp p = case p of --- really: composOpPatt
PR rs -> PR [(l,codp p) | (l,p) <- rs] PR rs -> PR [(l,codp p) | (l,p) <- rs]
PString s -> PString (co s) PString s -> PString (co s)

View File

@@ -16,6 +16,7 @@ import GF.Infra.Option
import GF.System.Readline import GF.System.Readline
import GF.Text.Coding import GF.Text.Coding
import GF.Compile.Coding
import PGF import PGF
import PGF.Data import PGF.Data
@@ -106,10 +107,10 @@ loop opts gfenv0 = do
pOpts style q ("-qual" :ws) = pOpts style Qualified ws pOpts style q ("-qual" :ws) = pOpts style Qualified ws
pOpts style q ws = (style,q,unwords ws) pOpts style q ws = (style,q,unwords ws)
(style,q,s) = pOpts TermPrintDefault Qualified ws (style,q,s) = pOpts TermPrintDefault Qualified (tail (words s0))
case runP pExp (BS.pack s) of case runP pExp (BS.pack s) of
Left (_,msg) -> putStrLn msg Left (_,msg) -> putStrLn msg
Right t -> case checkTerm sgr t >>= computeTerm sgr of Right t -> case checkTerm sgr (codeTerm (decode gfenv) t) >>= computeTerm sgr of
Ok x -> putStrLn $ enc (showTerm style q x) Ok x -> putStrLn $ enc (showTerm style q x)
Bad s -> putStrLn $ enc s Bad s -> putStrLn $ enc s
loopNewCPU gfenv loopNewCPU gfenv