From 314abe733ba1e9e7de12c9c28b7d6ffc889d128b Mon Sep 17 00:00:00 2001 From: hallgren Date: Wed, 31 Aug 2011 13:55:49 +0000 Subject: [PATCH] GF.Compile.Coding: cleaner code Refine function codeTerm into codeTerm, codeLTerm and codeLTerms. --- src/compiler/GF/Compile/Coding.hs | 17 +++++++++++------ src/compiler/GFI.hs | 2 +- 2 files changed, 12 insertions(+), 7 deletions(-) diff --git a/src/compiler/GF/Compile/Coding.hs b/src/compiler/GF/Compile/Coding.hs index 01285eef1..e7c90b850 100644 --- a/src/compiler/GF/Compile/Coding.hs +++ b/src/compiler/GF/Compile/Coding.hs @@ -21,14 +21,19 @@ 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) + ResOper pty pt -> ResOper (codeLTerms co pty) (codeLTerms co pt) + ResOverload es tyts -> ResOverload es [(codeLTerm co ty,codeLTerm co t) | (ty,t) <- tyts] + CncCat pty pt mpr -> CncCat pty (codeLTerms co pt) (codeLTerms co mpr) + CncFun mty pt mpr -> CncFun mty (codeLTerms co pt) (codeLTerms co mpr) _ -> info -codeTerm :: (String -> String) -> L Term -> L Term -codeTerm co (L loc t) = L loc (codt t) +codeLTerms co = fmap (codeLTerm co) + +codeLTerm :: (String -> String) -> L Term -> L Term +codeLTerm = fmap . codeTerm + +codeTerm :: (String -> String) -> Term -> Term +codeTerm co = codt where codt t = case t of K s -> K (co s) diff --git a/src/compiler/GFI.hs b/src/compiler/GFI.hs index 6efd0f3e0..74edf95d7 100644 --- a/src/compiler/GFI.hs +++ b/src/compiler/GFI.hs @@ -176,7 +176,7 @@ execute1 opts gfenv0 s0 = case runP pExp (encodeUnicode utf8 s) of Left (_,msg) -> putStrLn msg - Right t -> case checkComputeTerm sgr (unLoc (codeTerm (decodeUnicode utf8 . BS.pack) (L (0,0) t))) of + Right t -> case checkComputeTerm sgr (codeTerm (decodeUnicode utf8 . BS.pack) t) of Ok x -> putStrLn $ showTerm sgr style q x Bad s -> putStrLn $ s continue gfenv