summaryrefslogtreecommitdiff
path: root/src/GF/Compile
diff options
context:
space:
mode:
Diffstat (limited to 'src/GF/Compile')
-rw-r--r--src/GF/Compile/BackOpt.hs9
-rw-r--r--src/GF/Compile/Coding.hs3
-rw-r--r--src/GF/Compile/GrammarToGFCC.hs10
-rw-r--r--src/GF/Compile/Optimize.hs8
-rw-r--r--src/GF/Compile/OptimizeGF.hs9
-rw-r--r--src/GF/Compile/RemoveLiT.hs12
-rw-r--r--src/GF/Compile/Rename.hs5
7 files changed, 28 insertions, 28 deletions
diff --git a/src/GF/Compile/BackOpt.hs b/src/GF/Compile/BackOpt.hs
index 8667023c0..aeb3bcb8d 100644
--- a/src/GF/Compile/BackOpt.hs
+++ b/src/GF/Compile/BackOpt.hs
@@ -38,10 +38,11 @@ shareModule opt (i,m) = case m of
(i,M.ModMod (M.replaceJudgements mo (mapTree (shareInfo opt) (M.jments mo))))
_ -> (i,m)
-shareInfo opt (c, CncCat ty (Yes t) m) = (c,CncCat ty (Yes (shareOptim opt c t)) m)
-shareInfo opt (c, CncFun kxs (Yes t) m) = (c,CncFun kxs (Yes (shareOptim opt c t)) m)
-shareInfo opt (c, ResOper ty (Yes t)) = (c,ResOper ty (Yes (shareOptim opt c t)))
-shareInfo _ i = i
+shareInfo :: OptSpec -> (Ident, Info) -> Info
+shareInfo opt (c, CncCat ty (Yes t) m) = CncCat ty (Yes (shareOptim opt c t)) m
+shareInfo opt (c, CncFun kxs (Yes t) m) = CncFun kxs (Yes (shareOptim opt c t)) m
+shareInfo opt (c, ResOper ty (Yes t)) = ResOper ty (Yes (shareOptim opt c t))
+shareInfo _ (_,i) = i
-- the function putting together optimizations
shareOptim :: OptSpec -> Ident -> Term -> Term
diff --git a/src/GF/Compile/Coding.hs b/src/GF/Compile/Coding.hs
index 89e458956..665b5916d 100644
--- a/src/GF/Compile/Coding.hs
+++ b/src/GF/Compile/Coding.hs
@@ -26,13 +26,12 @@ codeSourceModule co (id,moi) = case moi of
ModMod mo -> (id, ModMod $ replaceJudgements mo (mapTree codj (jments mo)))
_ -> (id,moi)
where
- codj (c,info) = (c, case info of
+ codj (c,info) = case info of
ResOper pty pt -> ResOper (mapP codt pty) (mapP codt pt)
ResOverload es tyts -> ResOverload es [(codt ty,codt t) | (ty,t) <- tyts]
CncCat pty pt mpr -> CncCat pty (mapP codt pt) (mapP codt mpr)
CncFun mty pt mpr -> CncFun mty (mapP codt pt) (mapP codt mpr)
_ -> info
- )
codt t = case t of
K s -> K (co s)
T ty cs -> T ty [(codp p,codt v) | (p,v) <- cs]
diff --git a/src/GF/Compile/GrammarToGFCC.hs b/src/GF/Compile/GrammarToGFCC.hs
index 13f6eb9d2..bb99d9d6c 100644
--- a/src/GF/Compile/GrammarToGFCC.hs
+++ b/src/GF/Compile/GrammarToGFCC.hs
@@ -283,9 +283,9 @@ canon2canon abs cg0 =
j2j cg (f,j) =
let debug = traceD ("+ " ++ prt f) in
case j of
- CncFun x (Yes tr) z -> (f,CncFun x (Yes (debug (t2t tr))) z)
- CncCat (Yes ty) (Yes x) y -> (f,CncCat (Yes (ty2ty ty)) (Yes (t2t x)) y)
- _ -> (f,j)
+ CncFun x (Yes tr) z -> CncFun x (Yes (debug (t2t tr))) z
+ CncCat (Yes ty) (Yes x) y -> CncCat (Yes (ty2ty ty)) (Yes (t2t x)) y
+ _ -> j
where
cg1 = cg
t2t = term2term f cg1 pv
@@ -295,8 +295,8 @@ canon2canon abs cg0 =
-- flatten record arguments of param constructors
p2p (f,j) = case j of
ResParam (Yes (ps,v)) ->
- (f,ResParam (Yes ([(c,concatMap unRec cont) | (c,cont) <- ps],Nothing)))
- _ -> (f,j)
+ ResParam (Yes ([(c,concatMap unRec cont) | (c,cont) <- ps],Nothing))
+ _ -> j
unRec (x,ty) = case ty of
RecType fs -> [ity | (_,typ) <- fs, ity <- unRec (identW,typ)]
_ -> [(x,ty)]
diff --git a/src/GF/Compile/Optimize.hs b/src/GF/Compile/Optimize.hs
index 05a3826bf..da18e6e3e 100644
--- a/src/GF/Compile/Optimize.hs
+++ b/src/GF/Compile/Optimize.hs
@@ -107,7 +107,7 @@ evalResInfo oopts gr (c,info) = case info of
evalCncInfo ::
- Options -> SourceGrammar -> Ident -> Ident -> (Ident,Info) -> Err (Ident,Info)
+ Options -> SourceGrammar -> Ident -> Ident -> (Ident,Info) -> Err Info
evalCncInfo opts gr cnc abs (c,info) = do
seq (prtIf (verbAtLeast opts Verbose) c) $ return ()
@@ -126,7 +126,7 @@ evalCncInfo opts gr cnc abs (c,info) = do
ppr' <- liftM yes $ evalPrintname gr c ppr (yes $ K $ prt c)
- return (c, CncCat ptyp pde' ppr')
+ return (CncCat ptyp pde' ppr')
CncFun (mt@(Just (_,ty@(cont,val)))) pde ppr -> --trace (prt c) $
eIn ("linearization in type" +++ prt (mkProd (cont,val,[])) ++++ "of function") $ do
@@ -136,9 +136,9 @@ evalCncInfo opts gr cnc abs (c,info) = do
_ -> return pde
ppr' <- liftM yes $ evalPrintname gr c ppr pde'
- return $ (c, CncFun mt pde' ppr') -- only cat in type actually needed
+ return $ CncFun mt pde' ppr' -- only cat in type actually needed
- _ -> return (c,info)
+ _ -> return info
where
pEval = partEval opts gr
eIn cat = errIn ("Error optimizing" +++ cat +++ prt c +++ ":")
diff --git a/src/GF/Compile/OptimizeGF.hs b/src/GF/Compile/OptimizeGF.hs
index 41b828aa3..785d73994 100644
--- a/src/GF/Compile/OptimizeGF.hs
+++ b/src/GF/Compile/OptimizeGF.hs
@@ -51,10 +51,11 @@ processModule opt (i,m) = case m of
(i,M.ModMod (M.replaceJudgements mo (mapTree (shareInfo opt) (M.jments mo))))
_ -> (i,m)
-shareInfo opt (c, CncCat ty (Yes t) m) = (c,CncCat ty (Yes (opt c t)) m)
-shareInfo opt (c, CncFun kxs (Yes t) m) = (c,CncFun kxs (Yes (opt c t)) m)
-shareInfo opt (c, ResOper ty (Yes t)) = (c,ResOper ty (Yes (opt c t)))
-shareInfo _ i = i
+shareInfo :: (Ident -> Term -> Term) -> (Ident,Info) -> Info
+shareInfo opt (c, CncCat ty (Yes t) m) = CncCat ty (Yes (opt c t)) m
+shareInfo opt (c, CncFun kxs (Yes t) m) = CncFun kxs (Yes (opt c t)) m
+shareInfo opt (c, ResOper ty (Yes t)) = ResOper ty (Yes (opt c t))
+shareInfo _ (_,i) = i
-- the function putting together optimizations
optim :: Ident -> Term -> Term
diff --git a/src/GF/Compile/RemoveLiT.hs b/src/GF/Compile/RemoveLiT.hs
index d06b80400..a641737eb 100644
--- a/src/GF/Compile/RemoveLiT.hs
+++ b/src/GF/Compile/RemoveLiT.hs
@@ -40,12 +40,12 @@ remlModule gr mi@(name,mod) = case mod of
return $ (name,mod2)
_ -> return mi
-remlResInfo :: SourceGrammar -> (Ident,Info) -> Err (Ident,Info)
-remlResInfo gr mi@(i,info) = case info of
- ResOper pty ptr -> liftM ((,) i) $ liftM2 ResOper (ren pty) (ren ptr)
- CncCat pty ptr ppr -> liftM ((,) i) $ liftM3 CncCat (ren pty) (ren ptr) (ren ppr)
- CncFun mt ptr ppr -> liftM ((,) i) $ liftM2 (CncFun mt) (ren ptr) (ren ppr)
- _ -> return mi
+remlResInfo :: SourceGrammar -> (Ident,Info) -> Err Info
+remlResInfo gr (i,info) = case info of
+ ResOper pty ptr -> liftM2 ResOper (ren pty) (ren ptr)
+ CncCat pty ptr ppr -> liftM3 CncCat (ren pty) (ren ptr) (ren ppr)
+ CncFun mt ptr ppr -> liftM2 (CncFun mt) (ren ptr) (ren ppr)
+ _ -> return info
where
ren = remlPerh gr
diff --git a/src/GF/Compile/Rename.hs b/src/GF/Compile/Rename.hs
index 7b4d09277..bfa342702 100644
--- a/src/GF/Compile/Rename.hs
+++ b/src/GF/Compile/Rename.hs
@@ -115,15 +115,14 @@ renameIdentPatt env p = do
t' <- renameIdentTerm env t
term2patt t'
-info2status :: Maybe Ident -> (Ident,Info) -> (Ident,StatusInfo)
-info2status mq (c,i) = (c, case i of
+info2status :: Maybe Ident -> (Ident,Info) -> StatusInfo
+info2status mq (c,i) = case i of
AbsFun _ (Yes EData) -> maybe Con QC mq
ResValue _ -> maybe Con QC mq
ResParam _ -> maybe Con QC mq
AnyInd True m -> maybe Con (const (QC m)) mq
AnyInd False m -> maybe Cn (const (Q m)) mq
_ -> maybe Cn Q mq
- )
tree2status :: OpenSpec Ident -> BinTree Ident Info -> BinTree Ident StatusInfo
tree2status o = case o of
generated by cgit v1.2.3 (git 2.39.1) at 2026-05-20 07:50:03 +0000