summaryrefslogtreecommitdiff
path: root/src/compiler/GF/Compile
diff options
context:
space:
mode:
Diffstat (limited to 'src/compiler/GF/Compile')
-rw-r--r--src/compiler/GF/Compile/CheckGrammar.hs24
-rw-r--r--src/compiler/GF/Compile/Coding.hs2
-rw-r--r--src/compiler/GF/Compile/GeneratePMCFG.hs42
-rw-r--r--src/compiler/GF/Compile/GrammarToPGF.hs48
-rw-r--r--src/compiler/GF/Compile/Optimize.hs34
-rw-r--r--src/compiler/GF/Compile/Refresh.hs13
-rw-r--r--src/compiler/GF/Compile/Rename.hs2
-rw-r--r--src/compiler/GF/Compile/Tags.hs5
-rw-r--r--src/compiler/GF/Compile/Update.hs6
9 files changed, 126 insertions, 50 deletions
diff --git a/src/compiler/GF/Compile/CheckGrammar.hs b/src/compiler/GF/Compile/CheckGrammar.hs
index 6d8e9750e..736046179 100644
--- a/src/compiler/GF/Compile/CheckGrammar.hs
+++ b/src/compiler/GF/Compile/CheckGrammar.hs
@@ -106,8 +106,8 @@ checkCompleteGrammar opts gr (am,abs) (cm,cnc) = checkIn (ppLocation (msrc cnc)
return info
_ -> return info
case info of
- CncCat (Just (L loc (RecType []))) _ _ _ -> return (foldr (\_ -> Abs Explicit identW) (R []) cxt)
- _ -> Bad "no def lin"
+ CncCat (Just (L loc (RecType []))) _ _ _ _ -> return (foldr (\_ -> Abs Explicit identW) (R []) cxt)
+ _ -> Bad "no def lin"
case lookupIdent c js of
Ok (AnyInd _ _) -> return js
@@ -129,13 +129,13 @@ checkCompleteGrammar opts gr (am,abs) (cm,cnc) = checkIn (ppLocation (msrc cnc)
checkWarn (text "no linearization of" <+> ppIdent c)
AbsCat (Just _) -> case lookupIdent c js of
Ok (AnyInd _ _) -> return js
- Ok (CncCat (Just _) _ _ _) -> return js
- Ok (CncCat Nothing mt mp mpmcfg) -> do
+ Ok (CncCat (Just _) _ _ _ _) -> return js
+ Ok (CncCat Nothing md mr mp mpmcfg) -> do
checkWarn (text "no linearization type for" <+> ppIdent c <> text ", inserting default {s : Str}")
- return $ updateTree (c,CncCat (Just (L NoLoc defLinType)) mt mp mpmcfg) js
+ return $ updateTree (c,CncCat (Just (L NoLoc defLinType)) md mr mp mpmcfg) js
_ -> do
checkWarn (text "no linearization type for" <+> ppIdent c <> text ", inserting default {s : Str}")
- return $ updateTree (c,CncCat (Just (L NoLoc defLinType)) Nothing Nothing Nothing) js
+ return $ updateTree (c,CncCat (Just (L NoLoc defLinType)) Nothing Nothing Nothing Nothing) js
_ -> return js
checkCnc js i@(c,info) =
@@ -147,7 +147,7 @@ checkCompleteGrammar opts gr (am,abs) (cm,cnc) = checkIn (ppLocation (msrc cnc)
return $ updateTree (c,CncFun (Just linty) d mn mf) js
_ -> do checkWarn (text "function" <+> ppIdent c <+> text "is not in abstract")
return js
- CncCat _ _ _ _ -> case lookupOrigInfo gr (am,c) of
+ CncCat _ _ _ _ _ -> case lookupOrigInfo gr (am,c) of
Ok _ -> return $ updateTree i js
_ -> do checkWarn (text "category" <+> ppIdent c <+> text "is not in abstract")
return js
@@ -175,7 +175,7 @@ checkInfo opts sgr (m,mo) c info = do
Nothing -> return ()
return (AbsFun (Just (L loc typ)) ma md moper)
- CncCat mty mdef mpr mpmcfg -> do
+ CncCat mty mdef mref mpr mpmcfg -> do
mty <- case mty of
Just (L loc typ) -> chIn loc "linearization type of" $
(if False --flag optNewComp opts
@@ -192,13 +192,19 @@ checkInfo opts sgr (m,mo) c info = do
(def,_) <- checkLType gr [] def (mkFunType [typeStr] typ)
return (Just (L loc def))
_ -> return Nothing
+ mref <- case (mty,mref) of
+ (Just (L _ typ),Just (L loc ref)) ->
+ chIn loc "reference linearization of" $ do
+ (ref,_) <- checkLType gr [] ref (mkFunType [typ] typeStr)
+ return (Just (L loc ref))
+ _ -> return Nothing
mpr <- case mpr of
(Just (L loc t)) ->
chIn loc "print name of" $ do
(t,_) <- checkLType gr [] t typeStr
return (Just (L loc t))
_ -> return Nothing
- return (CncCat mty mdef mpr mpmcfg)
+ return (CncCat mty mdef mref mpr mpmcfg)
CncFun mty mt mpr mpmcfg -> do
mt <- case (mty,mt) of
diff --git a/src/compiler/GF/Compile/Coding.hs b/src/compiler/GF/Compile/Coding.hs
index 5dc463d0e..9d7022229 100644
--- a/src/compiler/GF/Compile/Coding.hs
+++ b/src/compiler/GF/Compile/Coding.hs
@@ -22,7 +22,7 @@ codeSourceModule co (id,mo) = (id,mo{jments = mapTree codj (jments mo)})
codj (c,info) = case info of
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 mty mt mpr mpmcfg -> CncCat mty (codeLTerms co mt) (codeLTerms co mpr) mpmcfg
+ CncCat mcat mdef mref mpr mpmcfg -> CncCat mcat (codeLTerms co mdef) (codeLTerms co mref) (codeLTerms co mpr) mpmcfg
CncFun mty mt mpr mpmcfg -> CncFun mty (codeLTerms co mt) (codeLTerms co mpr) mpmcfg
_ -> info
diff --git a/src/compiler/GF/Compile/GeneratePMCFG.hs b/src/compiler/GF/Compile/GeneratePMCFG.hs
index 9642110bc..bf4bebdec 100644
--- a/src/compiler/GF/Compile/GeneratePMCFG.hs
+++ b/src/compiler/GF/Compile/GeneratePMCFG.hs
@@ -100,27 +100,47 @@ addPMCFG opts gr cenv opath am cm seqs id (GF.Grammar.CncFun mty@(Just (cat,cont
newArgs = map getFIds newArgs'
in addFunction env0 newCat fun newArgs
-addPMCFG opts gr cenv opath am cm seqs id (GF.Grammar.CncCat mty@(Just (L _ lincat)) mdef@(Just (L loc term)) mprn Nothing) = do
- let pres = protoFCat gr (am,id) lincat
- parg = protoFCat gr (identW,cVar) typeStr
+addPMCFG opts gr cenv opath am cm seqs id (GF.Grammar.CncCat mty@(Just (L _ lincat))
+ mdef@(Just (L loc1 def))
+ mref@(Just (L loc2 ref))
+ mprn
+ Nothing) = do
+ let pcat = protoFCat gr (am,id) lincat
+ pvar = protoFCat gr (identW,cVar) typeStr
pmcfgEnv0 = emptyPMCFGEnv
- lincont = [(Explicit, varStr, typeStr)]
- b <- convert opts gr cenv (floc opath loc id) term (lincont,lincat) [parg]
+
+ let lincont = [(Explicit, varStr, typeStr)]
+ b <- convert opts gr cenv (floc opath loc1 id) def (lincont,lincat) [pvar]
let (seqs1,b1) = addSequencesB seqs b
- pmcfgEnv1 = foldBM addRule
+ pmcfgEnv1 = foldBM addLindef
pmcfgEnv0
(goB b1 CNil [])
- (pres,[parg])
- pmcfg = getPMCFG pmcfgEnv1
- when (verbAtLeast opts Verbose) $ liftIO $ hPutStr stderr ("\n+ "++showIdent id++" "++show (catFactor pres))
- seqs1 `seq` pmcfg `seq` return (seqs1,GF.Grammar.CncCat mty mdef mprn (Just pmcfg))
+ (pcat,[pvar])
+
+ let lincont = [(Explicit, varStr, lincat)]
+ b <- convert opts gr cenv (floc opath loc2 id) ref (lincont,typeStr) [pcat]
+ let (seqs2,b2) = addSequencesB seqs1 b
+ pmcfgEnv2 = foldBM addLinref
+ pmcfgEnv1
+ (goB b2 CNil [])
+ (pvar,[pcat])
+
+ let pmcfg = getPMCFG pmcfgEnv2
+
+ when (verbAtLeast opts Verbose) $ liftIO $ hPutStr stderr ("\n+ "++showIdent id++" "++show (catFactor pcat))
+ seqs2 `seq` pmcfg `seq` return (seqs2,GF.Grammar.CncCat mty mdef mref mprn (Just pmcfg))
where
- addRule lins (newCat', newArgs') env0 =
+ addLindef lins (newCat', newArgs') env0 =
let [newCat] = getFIds newCat'
!fun = mkArray lins
in addFunction env0 newCat fun [[fidVar]]
+ addLinref lins (newCat', [newArg']) env0 =
+ let newArg = getFIds newArg'
+ !fun = mkArray lins
+ in addFunction env0 fidVar fun [newArg]
+
addPMCFG opts gr cenv opath am cm seqs id info = return (seqs, info)
floc opath loc id = maybe (L loc id) (\path->L (External path loc) id) opath
diff --git a/src/compiler/GF/Compile/GrammarToPGF.hs b/src/compiler/GF/Compile/GrammarToPGF.hs
index aa5c3d163..b8a4f36fa 100644
--- a/src/compiler/GF/Compile/GrammarToPGF.hs
+++ b/src/compiler/GF/Compile/GrammarToPGF.hs
@@ -6,7 +6,7 @@ import GF.Compile.GeneratePMCFG
import GF.Compile.GenerateBC
import PGF.CId
-import PGF.Data(fidInt,fidFloat,fidString)
+import PGF.Data(fidInt,fidFloat,fidString,fidVar)
import PGF.Optimize(updateProductionIndices)
import qualified PGF.Macros as CM
import qualified PGF.Data as C
@@ -67,7 +67,7 @@ mkCanon2pgf opts gr am = do
(ex_seqs,cdefs) <- addMissingPMCFGs
Map.empty
- ([((cPredefAbs,c), CncCat (Just (L NoLoc GM.defLinType)) Nothing Nothing Nothing) | c <- [cInt,cFloat,cString]] ++
+ ([((cPredefAbs,c), CncCat (Just (L NoLoc GM.defLinType)) Nothing Nothing Nothing Nothing) | c <- [cInt,cFloat,cString]] ++
Look.allOrigInfos gr cm)
let flags = Map.fromList [(mkCId f,if f == "beam_size" then C.LFlt (read x) else C.LStr x) | (f,x) <- optionsPGF cflags]
@@ -78,7 +78,7 @@ mkCanon2pgf opts gr am = do
ex_seqs_arr = mkMapArray ex_seqs :: Array SeqId Sequence
!(!fid_cnt1,!cnccats) = genCncCats gr am cm cdefs
- !(!fid_cnt2,!productions,!lindefs,!cncfuns)
+ !(!fid_cnt2,!productions,!lindefs,!linrefs,!cncfuns)
= genCncFuns gr am cm ex_seqs_arr seqs cdefs fid_cnt1 cnccats
printnames = genPrintNames cdefs
@@ -86,6 +86,7 @@ mkCanon2pgf opts gr am = do
printnames
cncfuns
lindefs
+ linrefs
seqs
productions
IntMap.empty
@@ -178,7 +179,7 @@ genCncCats gr am cm cdefs =
in (index, Map.fromList cats)
where
mkCncCats index [] = (index,[])
- mkCncCats index (((m,id),CncCat (Just (L _ lincat)) _ _ _):cdefs)
+ mkCncCats index (((m,id),CncCat (Just (L _ lincat)) _ _ _ _):cdefs)
| id == cInt =
let cc = pgfCncCat gr lincat fidInt
(index',cats) = mkCncCats index cdefs
@@ -208,22 +209,24 @@ genCncFuns :: SourceGrammar
-> (FId,
IntMap.IntMap (Set.Set D.Production),
IntMap.IntMap [FunId],
+ IntMap.IntMap [FunId],
Array FunId D.CncFun)
genCncFuns gr am cm ex_seqs seqs cdefs fid_cnt cnccats =
- let (fid_cnt1,funs_cnt1,funs1,lindefs) = mkCncCats cdefs fid_cnt 0 [] IntMap.empty
- (fid_cnt2,funs_cnt2,funs2,prods) = mkCncFuns cdefs fid_cnt1 funs_cnt1 funs1 lindefs Map.empty IntMap.empty
- in (fid_cnt2,prods,lindefs,array (0,funs_cnt2-1) funs2)
+ let (fid_cnt1,funs_cnt1,funs1,lindefs,linrefs) = mkCncCats cdefs fid_cnt 0 [] IntMap.empty IntMap.empty
+ (fid_cnt2,funs_cnt2,funs2,prods) = mkCncFuns cdefs fid_cnt1 funs_cnt1 funs1 lindefs Map.empty IntMap.empty
+ in (fid_cnt2,prods,lindefs,linrefs,array (0,funs_cnt2-1) funs2)
where
- mkCncCats [] fid_cnt funs_cnt funs lindefs =
- (fid_cnt,funs_cnt,funs,lindefs)
- mkCncCats (((m,id),CncCat _ _ _ (Just (PMCFG prods0 funs0))):cdefs) fid_cnt funs_cnt funs lindefs =
+ mkCncCats [] fid_cnt funs_cnt funs lindefs linrefs =
+ (fid_cnt,funs_cnt,funs,lindefs,linrefs)
+ mkCncCats (((m,id),CncCat _ _ _ _ (Just (PMCFG prods0 funs0))):cdefs) fid_cnt funs_cnt funs lindefs linrefs =
let !funs_cnt' = let (s_funid, e_funid) = bounds funs0
in funs_cnt+(e_funid-s_funid+1)
lindefs' = foldl' (toLinDef (am,id) funs_cnt) lindefs prods0
+ linrefs' = foldl' (toLinRef (am,id) funs_cnt) linrefs prods0
funs' = foldl' (toCncFun funs_cnt (m,mkLinDefId id)) funs (assocs funs0)
- in mkCncCats cdefs fid_cnt funs_cnt' funs' lindefs'
- mkCncCats (_ :cdefs) fid_cnt funs_cnt funs lindefs =
- mkCncCats cdefs fid_cnt funs_cnt funs lindefs
+ in mkCncCats cdefs fid_cnt funs_cnt' funs' lindefs' linrefs'
+ mkCncCats (_ :cdefs) fid_cnt funs_cnt funs lindefs linrefs =
+ mkCncCats cdefs fid_cnt funs_cnt funs lindefs linrefs
mkCncFuns [] fid_cnt funs_cnt funs lindefs crc prods =
(fid_cnt,funs_cnt,funs,prods)
@@ -264,11 +267,20 @@ genCncFuns gr am cm ex_seqs seqs cdefs fid_cnt cnccats =
mkLinDefId id = prefixIdent "lindef " id
- toLinDef res offs lindefs (Production fid0 funid0 _) =
- IntMap.insertWith (++) fid [offs+funid0] lindefs
+ toLinDef res offs lindefs (Production fid0 funid0 args) =
+ if args == [[fidVar]]
+ then IntMap.insertWith (++) fid [offs+funid0] lindefs
+ else lindefs
where
fid = mkFId res fid0
+ toLinRef res offs linrefs (Production fid0 funid0 [fargs]) =
+ if fid0 == fidVar
+ then foldr (\fid -> IntMap.insertWith (++) fid [offs+funid0]) linrefs fids
+ else linrefs
+ where
+ fids = map (mkFId res) fargs
+
mkFId (_,cat) fid0 =
case Map.lookup (i2i cat) cnccats of
Just (C.CncCat s e _) -> s+fid0
@@ -299,9 +311,9 @@ genCncFuns gr am cm ex_seqs seqs cdefs fid_cnt cnccats =
genPrintNames cdefs =
Map.fromAscList [(i2i id, name) | ((m,id),info) <- cdefs, name <- prn info]
where
- prn (CncFun _ _ (Just (L _ tr)) _) = [flatten tr]
- prn (CncCat _ _ (Just (L _ tr)) _) = [flatten tr]
- prn _ = []
+ prn (CncFun _ _ (Just (L _ tr)) _) = [flatten tr]
+ prn (CncCat _ _ _ (Just (L _ tr)) _) = [flatten tr]
+ prn _ = []
flatten (K s) = s
flatten (Alts x _) = flatten x
diff --git a/src/compiler/GF/Compile/Optimize.hs b/src/compiler/GF/Compile/Optimize.hs
index 9ee50251b..37fe21cc0 100644
--- a/src/compiler/GF/Compile/Optimize.hs
+++ b/src/compiler/GF/Compile/Optimize.hs
@@ -60,7 +60,7 @@ evalInfo opts sgr m c info = do
errIn ("optimizing " ++ showIdent c) $ case info of
- CncCat ptyp pde ppr mpmcfg -> do
+ CncCat ptyp pde pre ppr mpmcfg -> do
pde' <- case (ptyp,pde) of
(Just (L _ typ), Just (L loc de)) -> do
de <- partEval opts gr ([(Explicit, varStr, typeStr)], typ) de
@@ -71,9 +71,19 @@ evalInfo opts sgr m c info = do
return (Just (L loc (factor param c 0 de)))
_ -> return pde -- indirection
+ pre' <- case (ptyp,pre) of
+ (Just (L _ typ), Just (L loc re)) -> do
+ re <- partEval opts gr ([(Explicit, varStr, typ)], typeStr) re
+ return (Just (L loc (factor param c 0 re)))
+ (Just (L loc typ), Nothing) -> do
+ re <- mkLinReference gr typ
+ re <- partEval opts gr ([(Explicit, varStr, typ)], typeStr) re
+ return (Just (L loc (factor param c 0 re)))
+ _ -> return pre -- indirection
+
ppr' <- evalPrintname gr ppr
- return (CncCat ptyp pde' ppr' mpmcfg)
+ return (CncCat ptyp pde' pre' ppr' mpmcfg)
CncFun (mt@(Just (_,cont,val))) pde ppr mpmcfg -> --trace (prt c) $
eIn (text "linearization in type" <+> ppTerm Unqualified 0 (mkProd cont val []) $$ text "of function") $ do
@@ -166,6 +176,26 @@ mkLinDefault gr typ = liftM (Abs Explicit varStr) $ mkDefField typ
_ | Just _ <- isTypeInts typ -> return $ EInt 0 -- exists in all as first val
_ -> Bad (render (text "linearization type field cannot be" <+> ppTerm Unqualified 0 typ))
+mkLinReference :: SourceGrammar -> Type -> Err Term
+mkLinReference gr typ =
+ liftM (Abs Explicit varStr) $
+ case mkDefField typ (Vr varStr) of
+ Bad "no string" -> return Empty
+ x -> x
+ where
+ mkDefField ty trm =
+ case ty of
+ Table pty ty -> do ps <- allParamValues gr pty
+ case ps of
+ [] -> Bad "no string"
+ (p:ps) -> mkDefField ty (S trm p)
+ Sort s | s == cStr -> return trm
+ QC p -> Bad "no string"
+ RecType rs -> do
+ msum (map (\(l,ty) -> mkDefField ty (P trm l)) (sortRec rs))
+ _ | Just _ <- isTypeInts typ -> Bad "no string"
+ _ -> Bad (render (text "linearization type field cannot be" <+> ppTerm Unqualified 0 typ))
+
evalPrintname :: SourceGrammar -> Maybe (L Term) -> Err (Maybe (L Term))
evalPrintname gr mpr =
case mpr of
diff --git a/src/compiler/GF/Compile/Refresh.hs b/src/compiler/GF/Compile/Refresh.hs
index 837534afa..999d8b083 100644
--- a/src/compiler/GF/Compile/Refresh.hs
+++ b/src/compiler/GF/Compile/Refresh.hs
@@ -124,9 +124,16 @@ refreshModule (k,sgr) mi@(i,mo)
(k',tyts') <- liftM (\ (t,(_,i)) -> (i,t)) $
appSTM (mapPairsM (\(L loc t) -> liftM (L loc) (refresh t)) tyts) (initIdStateN k)
return $ (k', (c, ResOverload os tyts'):cs)
- CncCat mt (Just (L loc trm)) mn mpmcfg-> do ---- refresh mt, pn
- (k',trm') <- refreshTermKN k trm
- return $ (k', (c, CncCat mt (Just (L loc trm')) mn mpmcfg):cs)
+ CncCat mt md mr mn mpmcfg-> do
+ (k,md) <- case md of
+ Just (L loc trm) -> do (k,trm) <- refreshTermKN k trm
+ return (k,Just (L loc trm))
+ Nothing -> return (k,Nothing)
+ (k,mr) <- case mr of
+ Just (L loc trm) -> do (k,trm) <- refreshTermKN k trm
+ return (k,Just (L loc trm))
+ Nothing -> return (k,Nothing)
+ return (k, (c, CncCat mt md mr mn mpmcfg):cs)
CncFun mt (Just (L loc trm)) mn mpmcfg -> do ---- refresh pn
(k',trm') <- refreshTermKN k trm
return $ (k', (c, CncFun mt (Just (L loc trm')) mn mpmcfg):cs)
diff --git a/src/compiler/GF/Compile/Rename.hs b/src/compiler/GF/Compile/Rename.hs
index e81582bc9..5c8b7bf20 100644
--- a/src/compiler/GF/Compile/Rename.hs
+++ b/src/compiler/GF/Compile/Rename.hs
@@ -153,7 +153,7 @@ renameInfo status (m,mi) i info =
ResValue t -> do
t <- renLoc (renameTerm status []) t
return (ResValue t)
- CncCat mty mtr mpr mpmcfg -> liftM4 CncCat (renTerm mty) (renTerm mtr) (renTerm mpr) (return mpmcfg)
+ CncCat mcat mdef mref mpr mpmcfg -> liftM5 CncCat (renTerm mcat) (renTerm mdef) (renTerm mref) (renTerm mpr) (return mpmcfg)
CncFun mty mtr mpr mpmcfg -> liftM3 (CncFun mty) (renTerm mtr) (renTerm mpr) (return mpmcfg)
_ -> return info
where
diff --git a/src/compiler/GF/Compile/Tags.hs b/src/compiler/GF/Compile/Tags.hs
index bf4a6e04d..ccb47a219 100644
--- a/src/compiler/GF/Compile/Tags.hs
+++ b/src/compiler/GF/Compile/Tags.hs
@@ -36,8 +36,9 @@ getLocalTags x (m,mi) =
maybe (loc "oper-def") mb_def
getLocations (ResOverload _ defs) = list (\(x,y) -> ltype "overload-type" x ++
loc "overload-def" y) defs
- getLocations (CncCat mty mdef mprn _) = maybe (loc "lincat") mty ++
- maybe (loc "lindef") mdef ++
+ getLocations (CncCat mty md mr mprn _) = maybe (loc "lincat") mty ++
+ maybe (loc "lindef") md ++
+ maybe (loc "linref") mr ++
maybe (loc "printname") mprn
getLocations (CncFun _ mlin mprn _) = maybe (loc "lin") mlin ++
maybe (loc "printname") mprn
diff --git a/src/compiler/GF/Compile/Update.hs b/src/compiler/GF/Compile/Update.hs
index 252563a72..54adcac2c 100644
--- a/src/compiler/GF/Compile/Update.hs
+++ b/src/compiler/GF/Compile/Update.hs
@@ -178,7 +178,7 @@ globalizeLoc fpath i =
ResValue t -> ResValue (gl t)
ResOper mt m -> ResOper (fmap gl mt) (fmap gl m)
ResOverload ms os -> ResOverload ms (map (\(x,y) -> (gl x,gl y)) os)
- CncCat mc mf mp mpmcfg-> CncCat (fmap gl mc) (fmap gl mf) (fmap gl mp) mpmcfg
+ CncCat mc md mr mp mpmcfg-> CncCat (fmap gl mc) (fmap gl md) (fmap gl mr) (fmap gl mp) mpmcfg
CncFun m mt md mpmcfg-> CncFun m (fmap gl mt) (fmap gl md) mpmcfg
AnyInd b m -> AnyInd b m
where
@@ -205,8 +205,8 @@ unifyAnyInfo m i j = case (i,j) of
(ResOper mt1 m1, ResOper mt2 m2) ->
liftM2 ResOper (unifMaybeL mt1 mt2) (unifMaybeL m1 m2)
- (CncCat mc1 mf1 mp1 mpmcfg1, CncCat mc2 mf2 mp2 mpmcfg2) ->
- liftM4 CncCat (unifMaybeL mc1 mc2) (unifMaybeL mf1 mf2) (unifMaybeL mp1 mp2) (unifMaybe mpmcfg1 mpmcfg2)
+ (CncCat mc1 md1 mr1 mp1 mpmcfg1, CncCat mc2 md2 mr2 mp2 mpmcfg2) ->
+ liftM5 CncCat (unifMaybeL mc1 mc2) (unifMaybeL md1 md2) (unifMaybeL mr1 mr2) (unifMaybeL mp1 mp2) (unifMaybe mpmcfg1 mpmcfg2)
(CncFun m mt1 md1 mpmcfg1, CncFun _ mt2 md2 mpmcfg2) ->
liftM3 (CncFun m) (unifMaybeL mt1 mt2) (unifMaybeL md1 md2) (unifMaybe mpmcfg1 mpmcfg2)
generated by cgit v1.2.3 (git 2.39.1) at 2026-05-20 07:29:18 +0000