use the cached parameter count

src/compiler/api/GF/Compile/GeneratePMCFG.hs

@@ -92,8 +92,8 @@ pmcfgForm g t ctxt ty = do
       where
         boundsOf sgr ms i =
           case Map.lookup (i+1) ms of
-            Just (Narrowing _ pty) -> case allParamValues sgr pty of
+            Just (Narrowing _ pty) -> case countParamValues sgr pty of
-                                        Ok ps   -> length ps
+                                        Ok c    -> c
                                         Bad msg -> error msg
             _                      -> error (show (ppLVar i <+> "is not a free variable"))
 
@@ -123,7 +123,7 @@ mkLinDefault gr typ = liftM (Abs Explicit varStr) $ mkDefField typ
                         let T _ cs = mkWildCases t'
                         return $ T (TWild p) cs
        Sort s | s == cStr -> return (Vr varStr)
-       QC p       -> case lookupParamValues gr p of
+       QC p       -> case allParamValues gr ty of
                        Ok []    -> checkError ("no parameter values given to type" <+> ppQIdent Qualified p)
                        Ok (v:_) -> return v
                        Bad msg  -> fail msg
@@ -176,8 +176,8 @@ type2metaTerm gr d ms s r rs (Table p q) params
                      delta  = r'-r
                  in (ms',s',r+delta*count,T (TTyped p) [(PV pv,t)],params')
   where
-    count = case allParamValues gr p of
+    count = case countParamValues gr p of
-              Ok ts   -> length ts
+              Ok c    -> c
               Bad msg -> error msg
 type2metaTerm gr d ms c r rs ty@(QC q) params =
   let i = Map.size ms + 1
@@ -218,7 +218,7 @@ breakDown g ms c r rs v (Table p q) fn0 fn = do
       v0 = VS v v2 []
       (c1,c2) = split c
       Gl gr _ = g
-  cnt <- fmap length $ allParamValues gr p
+  cnt <- countParamValues gr p
   (ms,r',fn0,fn) <- mfix $ \(~(_,r',_,_)) ->
        breakDown g (Map.insert i (Narrowing c1 p) ms) c2 r ((r'-r,(v2,p)):rs) (select v0 v v2) q fn0 fn
   return (ms,r+(r'-r)*cnt,fn0,fn)
@@ -476,8 +476,8 @@ setMeta i st = GenM $ \_ k svs ms ->
   k () svs (Map.insert i st ms)
 
 getCnt ty = GenM $ \(Gl gr _) k svs ms r ->
-  case allParamValues gr ty of
+  case countParamValues gr ty of
-    Ok ts   -> k (length ts) svs ms r
+    Ok c    -> k c svs ms r
     Bad msg -> checkError (pp msg)
 
 getIdxCnt q = GenM $ \(Gl gr _) k svs ms r ->

src/compiler/api/GF/Grammar/Lookup.hs

@@ -23,8 +23,8 @@ module GF.Grammar.Lookup (
            lookupResType,
            lookupOverload,
            lookupOverloadTypes,
-           lookupParamValues,
            allParamValues,
+           countParamValues,
            lookupAbsDef,
            lookupLincat,
            lookupFunType,
@@ -180,32 +180,50 @@ allOrigInfos gr m = fromErr [] $ do
     ModInfo{jments=jments} -> return [((m,c),i) | (c,_) <- Map.toList jments, Ok (m,i) <- [lookupOrigInfo gr (m,c)]]
     _                      -> return []
 
-lookupParamValues :: ErrorMonad m => Grammar -> QIdent -> m [Term]
-lookupParamValues gr c = do
-  (_,info) <- lookupOrigInfo gr c
-  case info of
-    ResParam _ (Just (pvs,_)) -> return pvs
-    _                         -> raise $ render (ppQIdent Qualified c <+> "has no parameter values defined")
-
 allParamValues :: ErrorMonad m => Grammar -> Type -> m [Term]
-allParamValues cnc ptyp =
+allParamValues gr ptyp =
   case ptyp of
     _ | Just n <- isTypeInts ptyp -> return [EInt i | i <- [0..n]]
-    QC c -> lookupParamValues cnc c
+    QC c -> do (_,info) <- lookupOrigInfo gr c
-    Q  c -> lookupResDef cnc c >>= allParamValues cnc
+               case info of
+                 ResParam _ (Just (pvs,_)) -> return pvs
+                 _                         -> raise $ render (ppQIdent Qualified c <+> "has no parameter values defined")
+    Q  c -> lookupResDef gr c >>= allParamValues gr
     RecType r -> do
        let (ls,lls,tys) = unzip3 $ sortByLbl r
-       tss <- mapM (allParamValues cnc) tys
+       tss <- mapM (allParamValues gr) tys
        return [R (zipAssign ls ts) | ts <- sequence tss]
     Table pt vt -> do
-       pvs <- allParamValues cnc pt
+       pvs <- allParamValues gr pt
-       vvs <- allParamValues cnc vt
+       vvs <- allParamValues gr vt
        return [V pt ts | ts <- sequence (replicate (length pvs) vvs)]
     _ -> raise (render ("cannot find parameter values for" <+> ptyp))
   where
     -- to normalize records and record types
     sortByLbl = sortBy (\(l1,_,_) (l2,_,_) -> compare l1 l2)
 
+countParamValues :: ErrorMonad m => Grammar -> Type -> m Int
+countParamValues gr ptyp =
+  case ptyp of
+    _ | Just n <- isTypeInts ptyp -> return (fromIntegral n)
+    QC c -> do (_,info) <- lookupOrigInfo gr c
+               case info of
+                 ResParam _ (Just (_,cnt)) -> return cnt
+                 _                         -> raise $ render (ppQIdent Qualified c <+> "has no parameter values defined")
+    Q  c -> lookupResDef gr c >>= countParamValues gr
+    RecType r -> do
+       let (ls,lls,tys) = unzip3 $ sortByLbl r
+       cs <- mapM (countParamValues gr) tys
+       return (product cs)
+    Table pt vt -> do
+       pc <- countParamValues gr pt
+       vc <- countParamValues gr vt
+       return (vc ^ pc)
+    _ -> raise (render ("cannot find parameter values for" <+> ptyp))
+  where
+    -- to normalize records and record types
+    sortByLbl = sortBy (\(l1,_,_) (l2,_,_) -> compare l1 l2)
+
 lookupAbsDef :: ErrorMonad m => Grammar -> ModuleName -> Ident -> m (Maybe Int,Maybe [Equation])
 lookupAbsDef gr m c = errIn (render ("looking up absdef of" <+> c)) $ do
   info <- lookupQIdentInfo gr (m,c)