check grammar should process the definitions in dependency order. This also ensures that the list of parameters for some parameter type is complete

src/GF/Compile/CheckGrammar.hs

@@ -46,15 +46,17 @@ import Text.PrettyPrint
 checkModule :: [SourceModule] -> SourceModule -> Check SourceModule
 checkModule ms m@(name,mo) = checkIn (text "checking module" <+> ppIdent name) $ do
   checkRestrictedInheritance ms m
-  checkErr $ topoSortJments m
+  m <- case mtype mo of
-  js <- case mtype mo of
+         MTConcrete a -> do let gr = MGrammar (m:ms)
-          MTConcrete a -> do abs <- checkErr $ lookupModule gr a
+                            abs <- checkErr $ lookupModule gr a
                             checkCompleteGrammar gr (a,abs) m
-          _            -> return (jments mo)
+         _            -> return m
-  js <- checkMap (checkInfo gr m) js
+  infos <- checkErr $ topoSortJments m
-  return (name, replaceJudgements mo js)
+  foldM updateCheckInfo m infos
   where
-    gr  = MGrammar $ (name,mo):ms
+    updateCheckInfo (name,mo) (i,info) = do
+      info <- checkInfo ms (name,mo) i info
+      return (name,updateModule mo i info)
 
 -- check if restricted inheritance modules are still coherent
 -- i.e. that the defs of remaining names don't depend on omitted names
@@ -77,7 +79,7 @@ checkRestrictedInheritance mos (name,mo) = do
                          nest 2 (vcat [ppIdent f <+> text "on" <+> fsep (map ppIdent is) | (f,is) <- cs]))
    allDeps = concatMap (allDependencies (const True) . jments . snd) mos
 
-checkCompleteGrammar :: SourceGrammar -> SourceModule -> SourceModule -> Check (BinTree Ident Info)
+checkCompleteGrammar :: SourceGrammar -> SourceModule -> SourceModule -> Check SourceModule
 checkCompleteGrammar gr (am,abs) (cm,cnc) = do
   let jsa = jments abs
   let jsc = jments cnc
@@ -88,7 +90,7 @@ checkCompleteGrammar gr (am,abs) (cm,cnc) = do
   -- check that all abstract constants are in concrete; build default lin and lincats
   jsc <- foldM checkAbs jsc (tree2list jsa)
   
-  return jsc
+  return (cm,replaceJudgements cnc jsc)
   where
    checkAbs js i@(c,info) =
      case info of
@@ -150,8 +152,8 @@ checkCompleteGrammar gr (am,abs) (cm,cnc) = do
 
 -- | General Principle: only Just-values are checked. 
 -- A May-value has always been checked in its origin module.
-checkInfo :: SourceGrammar -> SourceModule -> Ident -> Info -> Check Info
+checkInfo :: [SourceModule] -> SourceModule -> Ident -> Info -> Check Info
-checkInfo gr (m,mo) c info = do
+checkInfo ms (m,mo) c info = do
   checkReservedId c
   case info of
     AbsCat (Just cont) _ -> mkCheck "category" $ 
@@ -207,13 +209,18 @@ checkInfo gr (m,mo) c info = do
       return (ResOverload os [(y,x) | (x,y) <- tysts'])
 
     ResParam (Just pcs) _ -> chIn "parameter type" $ do
-      ts <- checkErr $ lookupParamValues gr m c
+      ts <- checkErr $ liftM concat $ mapM mkPar pcs
       return (ResParam (Just pcs) (Just ts))
 
     _ ->  return info
  where
+   gr = MGrammar ((m,mo) : ms)
    chIn cat = checkIn (text "Happened in" <+> text cat <+> ppIdent c <+> ppPosition mo c <> colon)
 
+   mkPar (f,co) = do
+     vs <- liftM combinations $ mapM (\(_,_,ty) -> allParamValues gr ty) co
+     return $ map (mkApp (QC m f)) vs
+
    checkUniq xss = case xss of
      x:y:xs 
       | x == y    -> checkError $ text "ambiguous for type" <+>

src/GF/Grammar/Lookup.hs

@@ -140,28 +140,12 @@ allOrigInfos gr m = errVal [] $ do
   where
     look = lookupOrigInfo gr m
 
-lookupParams :: SourceGrammar -> Ident -> Ident -> Err ([Param],Maybe [Term])
-lookupParams gr = look True where 
-  look isTop m c = do
-    mo <- lookupModule gr m
-    info <- lookupIdentInfo mo c
-    case info of
-      ResParam (Just psm) m -> return (psm,m)
-      AnyInd _ n            -> look False n c
-      _                     -> Bad $ render (ppIdent c <+> text "has no parameters defined in resource" <+> ppIdent m)
-  lookExt m c =
-    checks [look False n c | n <- allExtensions gr m]
-
 lookupParamValues :: SourceGrammar -> Ident -> Ident -> Err [Term]
 lookupParamValues gr m c = do
-  (ps,mpv) <- lookupParams gr m c
+  (_,info) <- lookupOrigInfo gr m c
-  case mpv of
+  case info of
-    Just ts -> return ts
+    ResParam _ (Just pvs) -> return pvs
-    _ -> liftM concat $ mapM mkPar ps
+    _                     -> Bad $ render (ppIdent c <+> text "has no parameter values defined in resource" <+> ppIdent m)
- where
-   mkPar (f,co) = do
-     vs <- liftM combinations $ mapM (\(_,_,ty) -> allParamValues gr ty) co
-     return $ map (mkApp (QC m f)) vs
 
 allParamValues :: SourceGrammar -> Type -> Err [Term]
 allParamValues cnc ptyp = case ptyp of