auto-insert default lincat; eliminate deps bug; less verbosity in import; take away word order variants in Scand

lib/resource/scandinavian/SyntaxScand.gf

@@ -903,6 +903,8 @@ oper
         idag = sats.s6 ;
         exts = sats.s7
       in case osf.o of {
+      Main => jag  ++ har ++ inte ++ sagt ++ dig  ++ idag ++ exts ;
+{-
       Main => variants {
                jag  ++ har ++ inte ++ sagt ++ dig  ++ idag ++ exts ;
         onlyIf (orB sats.e3 (notB b)) 
@@ -916,6 +918,7 @@ oper
         onlyIf sats.e7 
                (exts ++ har ++ jag  ++ inte ++ sagt ++ dig  ++ idag)
         } ;
+-}
       Inv => 
         har ++ jag  ++ inte ++ sagt ++ dig ++ idag ++ exts ;
       Sub => 

src/GF/API/IOGrammar.hs

@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/02/18 19:21:06 $ 
+-- > CVS $Date: 2005/03/08 18:08:58 $ 
--- > CVS $Author: peb $
+-- > CVS $Author: aarne $
--- > CVS $Revision: 1.14 $
+-- > CVS $Revision: 1.15 $
 --
 -- for reading grammars and terms from strings and files
 -----------------------------------------------------------------------------
@@ -55,7 +55,7 @@ shellStateFromFiles opts st file = case fileSuffix file of
      cenv <- compileOne opts (compileEnvShSt st []) file
      ioeErr $ updateShellState opts Nothing st cenv
   s | elem s ["cf","ebnf"] -> do
-     let osb = addOptions (options [beVerbose]) opts
+     let osb = addOptions (options []) opts
      grts <- compileModule osb st file
      ioeErr $ updateShellState opts Nothing st grts
   _ -> do
@@ -63,8 +63,8 @@ shellStateFromFiles opts st file = case fileSuffix file of
      let opts' = if b then (addOption showOld opts) else opts
 
      let osb = if oElem showOld opts' 
-                 then addOptions (options [beVerbose]) opts' -- for old no emit
+                 then addOptions (options []) opts' -- for old no emit
-                 else addOptions (options [beVerbose, emitCode]) opts'
+                 else addOptions (options [emitCode]) opts'
      grts <- compileModule osb st file
      let top = identC $ justModuleName file
      ioeErr $ updateShellState opts' (Just top) st grts

src/GF/Compile/CheckGrammar.hs

@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/02/18 19:21:08 $ 
+-- > CVS $Date: 2005/03/08 18:08:58 $ 
--- > CVS $Author: peb $
+-- > CVS $Author: aarne $
--- > CVS $Revision: 1.20 $
+-- > CVS $Revision: 1.21 $
 --
 -- AR 4\/12\/1999 -- 1\/4\/2000 -- 8\/9\/2001 -- 15\/5\/2002 -- 27\/11\/2002 -- 18\/6\/2003
 --
@@ -63,8 +63,8 @@ checkModule ms (name,mod) = checkIn ("checking module" +++ prt name) $ case mod
 
       MTConcrete a -> do
         ModMod abs <- checkErr $ lookupModule gr a
-        checkCompleteGrammar abs mo
+        js1 <- checkCompleteGrammar abs mo
-        mapMTree (checkCncInfo gr name (a,abs)) js
+        mapMTree (checkCncInfo gr name (a,abs)) js1
 
       MTInterface -> mapMTree (checkResInfo gr) js
 
@@ -118,17 +118,26 @@ checkAbsInfo st m (c,info) = do
      _ -> composOp (compAbsTyp g) t
 
 
-checkCompleteGrammar :: SourceAbs -> SourceCnc -> Check ()
+checkCompleteGrammar :: SourceAbs -> SourceCnc -> Check (BinTree (Ident,Info))
-checkCompleteGrammar abs cnc = mapM_ checkWarn $
+checkCompleteGrammar abs cnc = do
-  checkComplete [f | (f, AbsFun (Yes _) _) <- abs'] cnc'
+  let js = jments cnc
-   where
+  let fs = tree2list $ jments abs
-     abs' = tree2list $ jments abs
+  foldM checkOne js fs
-     cnc' = mapTree fst $ jments cnc
+ where
-     checkComplete sought given = foldr ckOne [] sought
+   checkOne js i@(c,info) = case info of
-       where
+     AbsFun (Yes _) _ -> case lookupTree prt c js of
-         ckOne f = if isInBinTree f given 
+       Ok _ -> return js
-                      then id
+       _ -> do
-                      else (("Warning: no linearization of" +++ prt f):)
+         checkWarn $ "Warning: no linearization of" +++ prt c
+         return js
+     AbsCat (Yes _) _ -> case lookupTree prt c js of
+       Ok _ -> return js
+       _ -> do
+         checkWarn $ 
+           "Warning: no linearization type for" +++ prt c ++ 
+           ", inserting default {s : Str}" 
+         return $ updateTree (c,CncCat (Yes defLinType) nope nope) js
+     _ -> return js
 
 -- | General Principle: only Yes-values are checked. 
 -- A May-value has always been checked in its origin module.

src/GF/Compile/Compile.hs

@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/03/02 14:22:53 $
+-- > CVS $Date: 2005/03/08 18:08:58 $
--- > CVS $Author: peb $
+-- > CVS $Author: aarne $
--- > CVS $Revision: 1.34 $
+-- > CVS $Revision: 1.35 $
 --
 -- The top-level compilation chain from source file to gfc\/gfr.
 -----------------------------------------------------------------------------
@@ -57,14 +57,14 @@ gfGrammarPathVar = "GF_LIB_PATH"
 -- | in batch mode: write code in a file
 batchCompile f = liftM fst $ compileModule defOpts emptyShellState f
   where
-    defOpts = options [beVerbose, emitCode] 
+    defOpts = options [emitCode] 
 batchCompileOpt f = liftM fst $ compileModule defOpts emptyShellState f
   where
-    defOpts = options [beVerbose, emitCode, optimizeCanon] 
+    defOpts = options [emitCode, optimizeCanon] 
 
 batchCompileOld f = compileOld defOpts f
   where
-    defOpts = options [beVerbose, emitCode] 
+    defOpts = options [emitCode] 
 
 -- | compile with one module as starting point
 -- command-line options override options (marked by --#) in the file
@@ -76,7 +76,8 @@ compileModule :: Options -> ShellState -> FilePath -> IOE TimedCompileEnv
 compileModule opts st0 file | 
      oElem showOld opts || 
      elem suff ["cf","ebnf"] = do
-  let putp = putPointE opts
+  let putp  = putPointE opts
+  let putpp = putPointEsil opts
   let path = [] ----
   grammar1 <- if suff == "cf"
               then putp ("- parsing" +++ suff +++ file) $ getCFGrammar opts file
@@ -85,12 +86,12 @@ compileModule opts st0 file |
               else putp ("- parsing old gf" +++ file) $ getOldGrammar opts file
   let mods = modules grammar1
   let env = compileEnvShSt st0 []
-  foldM (comp putp path) env mods
+  foldM (comp putpp path) env mods
  where
    suff = fileSuffix file
-   comp putp path env sm0 = do
+   comp putpp path env sm0 = do
      (k',sm)  <- makeSourceModule opts (fst env) sm0
-     cm  <- putp "  generating code... " $ generateModuleCode opts path sm
+     cm  <- putpp "  generating code... " $ generateModuleCode opts path sm
      ft <- getReadTimes file ---
      extendCompileEnvInt env (k',sm,cm) ft
 
@@ -106,9 +107,8 @@ compileModule opts1 st0 file = do
               then (map (prefixPathName fpath) ps0)
               else ps0
   ps <- ioeIO $ extendPathEnv gfGrammarPathVar ps1
-  let ioeIOIf = if oElem beSilent opts then (const (return ())) else ioeIO
+  let ioeIOIf = if oElem beVerbose opts then ioeIO else (const (return ()))
   ioeIOIf $ putStrLn $ "module search path:" +++ show ps ----
-  let putp = putPointE opts
   let st = st0 --- if useFileOpt then emptyShellState else st0
   let rfs = readFiles st
   let file' = if useFileOpt then justFileName file else file -- to find file itself
@@ -166,6 +166,12 @@ compileOne :: Options -> TimedCompileEnv -> FullPath -> IOE TimedCompileEnv
 compileOne opts env@((_,srcgr,_),_) file = do
 
   let putp = putPointE opts
+  let putpp = putPointEsil opts
+  let putpOpt v m act
+       | oElem beVerbose opts =  putp v act
+       | oElem beSilent opts  =  putpp v act
+       | otherwise = ioeIO (putStrFlush m) >> act
+
   let gf   = fileSuffix file
   let path = justInitPath file
   let name = fileBody file
@@ -187,7 +193,7 @@ compileOne opts env@((_,srcgr,_),_) file = do
 
     -- for compiled resource, parse and organize, then update environment
     "gfr" -> do
-       sm0 <- putp ("| parsing" +++ file) $ getSourceModule file
+       sm0 <- putp ("| reading" +++ file) $ getSourceModule file
        sm <- {- putp "creating indirections" $ -} ioeErr $ extendModule mos sm0
 ---- experiment with not optimizing gfr 
 ----      sm:_  <- putp "  optimizing " $ ioeErr $ evalModule mos sm1
@@ -198,9 +204,9 @@ compileOne opts env@((_,srcgr,_),_) file = do
 
     -- for gf source, do full compilation
     _ -> do
-       sm0 <- putp ("- parsing" +++ file) $ getSourceModule file
+       sm0 <- putpOpt ("- parsing" +++ file) ("- compiling" +++ file ++ "... ") $ getSourceModule file
        (k',sm)  <- makeSourceModule opts (fst env) sm0
-       cm  <- putp "  generating code... " $ generateModuleCode opts path sm
+       cm  <- putpp "  generating code... " $ generateModuleCode opts path sm
        ft <- getReadTimes file
 
        sm':_ <- case snd sm of
@@ -235,13 +241,14 @@ compileSourceModule :: Options -> CompileEnv ->
                        SourceModule -> IOE (Int,SourceModule)
 compileSourceModule opts env@(k,gr,can) mo@(i,mi) = do
 
-  let putp = putPointE opts
+  let putp  = putPointE opts
-      mos  = modules gr
+      putpp = putPointEsil opts
+      mos   = modules gr
 
   if (oElem showOld opts && oElem emitCode opts) 
     then do
       let (file,out) = (gfFile (prt i), prGrammar (MGrammar [mo]))
-      ioeIO $ writeFile file out >> putStr ("  wrote file" +++ file)
+      putp ("  wrote file" +++ file) $ ioeIO $ writeFile file out
     else return ()
 
   mo1   <- ioeErr $ rebuildModule mos mo
@@ -252,17 +259,17 @@ compileSourceModule opts env@(k,gr,can) mo@(i,mi) = do
     (_,ModMod n) | not (isCompleteModule n) -> do
       return (k,mo1b)   -- refresh would fail, since not renamed
     _ -> do
-      mo2:_ <- putp "  renaming " $ ioeErr $ renameModule mos mo1b
+      mo2:_ <- putpp "  renaming " $ ioeErr $ renameModule mos mo1b
 
-      (mo3:_,warnings) <- putp "  type checking" $ ioeErr $ showCheckModule mos mo2
+      (mo3:_,warnings) <- putpp "  type checking" $ ioeErr $ showCheckModule mos mo2
-      putStrE warnings
+      if null warnings then return () else putp warnings $ return ()
 
       (k',mo3r:_) <- ioeErr $ refreshModule (k,mos) mo3
 
       mo4 <- 
 ----        case snd mo1b of
 ----          ModMod n | isModCnc n -> 
-        putp "  optimizing " $ ioeErr $ optimizeModule opts mos mo3r
+        putpp "  optimizing " $ ioeErr $ optimizeModule opts mos mo3r
 ----        _ -> return [mo3r]
       return (k',mo4)
  where
@@ -291,17 +298,19 @@ generateModuleCode opts path minfo@(name,info) = do
       let rminfo = if isCompilable info then minfo 
                    else (name,emptyModInfo) 
       let (file,out) = (gfrFile pname, prGrammar (MGrammar [rminfo]))
-      ioeIO $ writeFile file out >> putStr ("  wrote file" +++ file)
+      putp ("  wrote file" +++ file) $ ioeIO $ writeFile file out
     _ -> return ()
   (file,out) <- do
       code <- return $ MkGFC.prCanonModInfo minfo'
       return (gfcFile pname, code)
   if emit && nomulti ---- && isCompilable info 
-     then ioeIO (writeFile file out) >> ioeIOIf (putStr ("  wrote file" +++ file))
+     then putp  ("  wrote file" +++ file) $ ioeIO $ writeFile file out
-     else ioeIOIf $ putStrFlush $ "no need to save module" +++ prt name
+     else putpp ("no need to save module" +++ prt name) $ return ()
   return minfo'
  where 
-   ioeIOIf = if oElem beSilent opts then (const (return ())) else ioeIO
+   putp  = putPointE opts
+   putpp = putPointEsil opts
+
    emitsGFR m = isModRes m ---- && isCompilable info
      ---- isModRes m || (isModCnc m && mstatus m == MSIncomplete)
    isCompilable mi = case mi of
@@ -326,4 +335,3 @@ writeNewGF m@(i,_) = do
   ioeIO $ writeFile file $ prGrammar (MGrammar [m])
   ioeIO $ putStrLn $ "wrote file" +++ file
   return file
-

src/GF/Compile/ModDeps.hs

@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/02/18 19:21:09 $ 
+-- > CVS $Date: 2005/03/08 18:08:58 $ 
--- > CVS $Author: peb $
+-- > CVS $Author: aarne $
--- > CVS $Revision: 1.11 $
+-- > CVS $Revision: 1.12 $
 --
 -- Check correctness of module dependencies. Incomplete.
 --
@@ -74,7 +74,7 @@ moduleDeps ms = mapM deps ms where
     ModMod m -> case mtype m of
       MTConcrete a -> do
         aty <- lookupModuleType gr a
-        testErr (aty == MTAbstract) "the for-module is not an abstract syntax" 
+        testErr (aty == MTAbstract) "the of-module is not an abstract syntax" 
         chDep (IdentM c (MTConcrete a)) 
               (extends m) (MTConcrete a) (opens m) MTResource
       t -> chDep (IdentM c t) (extends m) t (opens m) t

src/GF/Compile/Rebuild.hs

@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/02/18 19:21:09 $ 
+-- > CVS $Date: 2005/03/08 18:08:58 $ 
--- > CVS $Author: peb $
+-- > CVS $Author: aarne $
--- > CVS $Revision: 1.9 $
+-- > CVS $Revision: 1.10 $
 --
 -- Rebuild a source module from incomplete and its with-instance.
 -----------------------------------------------------------------------------
@@ -30,8 +30,9 @@ import Operations
 rebuildModule :: [SourceModule] -> SourceModule -> Err SourceModule
 rebuildModule ms mo@(i,mi) = do
   let gr = MGrammar ms
-  deps <- moduleDeps ms
+----  deps <- moduleDeps ms
-  is   <- openInterfaces deps i
+----  is   <- openInterfaces deps i
+  let is = [] ---- the method above is buggy: try "i -src" for two grs. AR 8/3/2005
   mi'  <- case mi of
 
     -- add the information given in interface into an instance module

src/GF/Infra/ReadFiles.hs

@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/02/18 19:21:15 $ 
+-- > CVS $Date: 2005/03/08 18:08:58 $ 
--- > CVS $Author: peb $
+-- > CVS $Author: aarne $
--- > CVS $Revision: 1.19 $
+-- > CVS $Revision: 1.20 $
 --
 -- Decide what files to read as function of dependencies and time stamps.
 --
@@ -45,9 +45,9 @@ getAllFiles opts ps env file = do
   -- read module headers from all files recursively
   ds0  <- getImports ps file
   let ds = [((snd m,map fst ms),p) | ((m,ms),p) <- ds0]
-  if oElem beSilent opts 
+  if oElem beVerbose opts 
-    then return ()
+    then ioeIO $ putStrLn $ "all modules:" +++ show (map (fst . fst) ds)
-    else ioeIO $ putStrLn $ "all modules:" +++ show (map (fst . fst) ds)
+    else return ()
     -- get a topological sorting of files: returns file names --- deletes paths
   ds1 <- ioeErr $ either 
            return 

src/GF/Infra/UseIO.hs

@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/02/24 11:46:36 $ 
+-- > CVS $Date: 2005/03/08 18:08:58 $ 
--- > CVS $Author: peb $
+-- > CVS $Author: aarne $
--- > CVS $Revision: 1.9 $
+-- > CVS $Revision: 1.10 $
 --
 -- (Description of the module)
 -----------------------------------------------------------------------------
@@ -227,9 +227,17 @@ putStrLnE = ioeIO . putStrLnFlush
 putStrE :: String -> IOE ()
 putStrE = ioeIO . putStrFlush 
 
+-- this is more verbose
 putPointE :: Options -> String -> IOE a -> IOE a
-putPointE opts msg act = do
+putPointE = putPointEgen (oElem beSilent)
-  let ve x = if oElem beSilent opts then return () else x
+
+-- this is less verbose
+putPointEsil :: Options -> String -> IOE a -> IOE a
+putPointEsil = putPointEgen (not . oElem beVerbose)
+
+putPointEgen :: (Options -> Bool) -> Options -> String -> IOE a -> IOE a
+putPointEgen cond opts msg act = do
+  let ve x = if cond opts then return () else x
   ve $ ioeIO $ putStrFlush msg
   a <- act
 ---  ve $ ioeIO $ putShow' id a --- replace by a statistics command