msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

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

Browse Source
This commit is contained in:
aarne
2005-03-08 17:08:58 +00:00
parent 9de7d07889
commit 7aedefa5fb
8 changed files with 98 additions and 69 deletions
Download Patch File Download Diff File Expand all files Collapse all files

3
lib/resource/scandinavian/SyntaxScand.gf
View File

@@ -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 =>

12
src/GF/API/IOGrammar.hs
View File

@@ -5,9 +5,9 @@
-- Stability : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/02/18 19:21:06 $
-- > CVS $Author: peb $
-- > CVS $Revision: 1.14 $
-- > CVS $Date: 2005/03/08 18:08:58 $
-- > CVS $Author: aarne $
-- > 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
else addOptions (options [beVerbose, emitCode]) opts'
then addOptions (options []) opts' -- for old no emit
else addOptions (options [emitCode]) opts'
grts <- compileModule osb st file
let top = identC $ justModuleName file
ioeErr $ updateShellState opts' (Just top) st grts

41
src/GF/Compile/CheckGrammar.hs
View File

@@ -5,9 +5,9 @@
-- Stability : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/02/18 19:21:08 $
-- > CVS $Author: peb $
-- > CVS $Revision: 1.20 $
-- > CVS $Date: 2005/03/08 18:08:58 $
-- > CVS $Author: aarne $
-- > 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
mapMTree (checkCncInfo gr name (a,abs)) js
js1 <- checkCompleteGrammar abs mo
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 abs cnc = mapM_ checkWarn $
checkComplete [f | (f, AbsFun (Yes _) _) <- abs'] cnc'
where
abs' = tree2list $ jments abs
cnc' = mapTree fst $ jments cnc
checkComplete sought given = foldr ckOne [] sought
where
ckOne f = if isInBinTree f given
then id
else (("Warning: no linearization of" +++ prt f):)
checkCompleteGrammar :: SourceAbs -> SourceCnc -> Check (BinTree (Ident,Info))
checkCompleteGrammar abs cnc = do
let js = jments cnc
let fs = tree2list $ jments abs
foldM checkOne js fs
where
checkOne js i@(c,info) = case info of
AbsFun (Yes _) _ -> case lookupTree prt c js of
Ok _ -> return js
_ -> do
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.

62
src/GF/Compile/Compile.hs
View File

@@ -5,9 +5,9 @@
-- Stability : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/03/02 14:22:53 $
-- > CVS $Author: peb $
-- > CVS $Revision: 1.34 $
-- > CVS $Date: 2005/03/08 18:08:58 $
-- > CVS $Author: aarne $
-- > 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
mos = modules gr
let putp = putPointE opts
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
putStrE warnings
(mo3:_,warnings) <- putpp " type checking" $ ioeErr $ showCheckModule mos mo2
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))
else ioeIOIf $ putStrFlush $ "no need to save module" +++ prt name
then putp (" wrote file" +++ file) $ ioeIO $ writeFile file out
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

8
src/GF/Compile/ModDeps.hs
View File

@@ -5,9 +5,9 @@
-- Stability : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/02/18 19:21:09 $
-- > CVS $Author: peb $
-- > CVS $Revision: 1.11 $
-- > CVS $Date: 2005/03/08 18:08:58 $
-- > CVS $Author: aarne $
-- > 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

11
src/GF/Compile/Rebuild.hs
View File

@@ -5,9 +5,9 @@
-- Stability : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/02/18 19:21:09 $
-- > CVS $Author: peb $
-- > CVS $Revision: 1.9 $
-- > CVS $Date: 2005/03/08 18:08:58 $
-- > CVS $Author: aarne $
-- > 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
is <- openInterfaces deps i
---- deps <- moduleDeps ms
---- 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

12
src/GF/Infra/ReadFiles.hs
View File

@@ -5,9 +5,9 @@
-- Stability : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/02/18 19:21:15 $
-- > CVS $Author: peb $
-- > CVS $Revision: 1.19 $
-- > CVS $Date: 2005/03/08 18:08:58 $
-- > CVS $Author: aarne $
-- > 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
then return ()
else ioeIO $ putStrLn $ "all modules:" +++ show (map (fst . fst) ds)
if oElem beVerbose opts
then 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

18
src/GF/Infra/UseIO.hs
View File

@@ -5,9 +5,9 @@
-- Stability : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/02/24 11:46:36 $
-- > CVS $Author: peb $
-- > CVS $Revision: 1.9 $
-- > CVS $Date: 2005/03/08 18:08:58 $
-- > CVS $Author: aarne $
-- > 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
let ve x = if oElem beSilent opts then return () else x
putPointE = putPointEgen (oElem beSilent)
-- 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