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)))
where
codj (c,info) = case info of
ResOper pty pt -> ResOper (fmap codt pty) (fmap codt pt)
ResOverload es tyts -> ResOverload es [(codt ty,codt t) | (ty,t) <- tyts]
CncCat pty pt mpr -> CncCat pty (fmap codt pt) (fmap codt mpr)
CncFun mty pt mpr -> CncFun mty (fmap codt pt) (fmap codt mpr)
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
codt t = case t of
codeTerm :: (String -> String) -> Term -> Term
codeTerm co t = case t of
K s -> K (co s)
T ty cs -> T ty [(codp p,codt v) | (p,v) <- cs]
_ -> composSafeOp codt t
T ty cs -> T ty [(codp p,codeTerm co v) | (p,v) <- cs]
_ -> 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)

View File

@@ -16,6 +16,7 @@ import GF.Infra.Option
import GF.System.Readline
import GF.Text.Coding
import GF.Compile.Coding
import PGF
import PGF.Data
@@ -106,10 +107,10 @@ loop opts gfenv0 = do
pOpts style q ("-qual" :ws) = pOpts style Qualified 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
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)
Bad s -> putStrLn $ enc s
loopNewCPU gfenv