summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/compiler/GF/Compile/Coding.hs17
-rw-r--r--src/compiler/GFI.hs2
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