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

fixed a file reading bug ; improved pi

Browse Source
This commit is contained in:
aarne
2006-06-03 13:03:17 +00:00
parent 97dada16f6
commit 4a3d280df5
3 changed files with 39 additions and 27 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -74,7 +74,7 @@ batchCompileOld f = compileOld defOpts f
-- As for path: if it is read from file, the file path is prepended to each name. -- As for path: if it is read from file, the file path is prepended to each name.
-- If from command line, it is used as it is. -- If from command line, it is used as it is.
compileModule :: Options -> ShellState -> FilePath -> IOE TimedCompileEnv compileModule :: Options -> ShellState -> FilePath -> IOE TimedCompileEnv
---- IOE (GFC.CanonGrammar, (SourceGrammar,[(FilePath,ModTime)])) ---- IOE (GFC.CanonGrammar, (SourceGrammar,[(String,(FilePath,ModTime))]))
compileModule opts st0 file | compileModule opts st0 file |
oElem showOld opts || oElem showOld opts ||
@@ -113,7 +113,7 @@ compileModule opts1 st0 file = do
let ioeIOIf = if oElem beVerbose opts then ioeIO else (const (return ())) let ioeIOIf = if oElem beVerbose opts then ioeIO else (const (return ()))
ioeIOIf $ putStrLn $ "module search path:" +++ show ps ---- ioeIOIf $ putStrLn $ "module search path:" +++ show ps ----
let st = st0 --- if useFileOpt then emptyShellState else st0 let st = st0 --- if useFileOpt then emptyShellState else st0
let rfs = readFiles st let rfs = [(m,t) | (m,(_,t)) <- readFiles st]
let file' = if useFileOpt then justFileName file else file -- to find file itself let file' = if useFileOpt then justFileName file else file -- to find file itself
files <- getAllFiles opts ps rfs file' files <- getAllFiles opts ps rfs file'
ioeIOIf $ putStrLn $ "files to read:" +++ show files ---- ioeIOIf $ putStrLn $ "files to read:" +++ show files ----
@@ -127,7 +127,7 @@ compileModule opts1 st0 file = do
getReadTimes file = do getReadTimes file = do
t <- ioeIO getNowTime t <- ioeIO getNowTime
let m = justModuleName file let m = justModuleName file
return $ (m,t) : [(resModName m,t) | not (isGFC file)] return $ (m,(file,t)) : [(resModName m,(file,t)) | not (isGFC file)]
compileEnvShSt :: ShellState -> [ModName] -> TimedCompileEnv compileEnvShSt :: ShellState -> [ModName] -> TimedCompileEnv
compileEnvShSt st fs = ((0,sgr,cgr),fts) where compileEnvShSt st fs = ((0,sgr,cgr),fts) where
@@ -163,7 +163,7 @@ extendCompileEnv e@((k,_,_),_) (sm,cm) = extendCompileEnvInt e (k,sm,cm)
extendCompileEnvCanon ((k,s,c),fts) cgr ft = extendCompileEnvCanon ((k,s,c),fts) cgr ft =
return ((k,s, MGrammar (modules cgr ++ modules c)),ft++fts) return ((k,s, MGrammar (modules cgr ++ modules c)),ft++fts)
type TimedCompileEnv = (CompileEnv,[(FilePath,ModTime)]) type TimedCompileEnv = (CompileEnv,[(String,(FilePath,ModTime))])
compileOne :: Options -> TimedCompileEnv -> FullPath -> IOE TimedCompileEnv compileOne :: Options -> TimedCompileEnv -> FullPath -> IOE TimedCompileEnv
compileOne opts env@((_,srcgr,cancgr0),_) file = do compileOne opts env@((_,srcgr,cancgr0),_) file = do
@@ -207,7 +207,16 @@ compileOne opts env@((_,srcgr,cancgr0),_) file = do
extendCompileEnv env (sm,cm) ft extendCompileEnv env (sm,cm) ft
-- for gf source, do full compilation -- for gf source, do full compilation
_ -> do _ -> do
--- hack fix to a bug in ReadFiles with reused concrete
b <- ioeIO $ doesFileExist file
if not b
then compileOne opts env $ gfcFile (init (init file))
else do
sm0 <- putpOpt ("- parsing" +++ file) ("- compiling" +++ file ++ "... ") $ sm0 <- putpOpt ("- parsing" +++ file) ("- compiling" +++ file ++ "... ") $
getSourceModule opts file getSourceModule opts file
(k',sm) <- makeSourceModule opts (fst env) sm0 (k',sm) <- makeSourceModule opts (fst env) sm0

20
src/GF/Compile/ShellState.hs
View File

@@ -35,6 +35,7 @@ import GF.Probabilistic.Probabilistic
import GF.Compile.NoParse import GF.Compile.NoParse
import GF.Infra.Option import GF.Infra.Option
import GF.Infra.Ident import GF.Infra.Ident
import GF.Infra.UseIO (justModuleName)
import GF.System.Arch (ModTime) import GF.System.Arch (ModTime)
import qualified Transfer.InterpreterAPI as T import qualified Transfer.InterpreterAPI as T
@@ -69,7 +70,7 @@ data ShellState = ShSt {
treebanks :: [(Ident,Treebank)], -- ^ treebanks treebanks :: [(Ident,Treebank)], -- ^ treebanks
probss :: [(Ident,Probs)], -- ^ probability distributions probss :: [(Ident,Probs)], -- ^ probability distributions
gloptions :: Options, -- ^ global options gloptions :: Options, -- ^ global options
readFiles :: [(FilePath,ModTime)],-- ^ files read readFiles :: [(String,(FilePath,ModTime))],-- ^ files read
absCats :: [(G.Cat,(G.Context, absCats :: [(G.Cat,(G.Context,
[(G.Fun,G.Type)], [(G.Fun,G.Type)],
[((G.Fun,Int),G.Type)]))], -- ^ cats, (their contexts, [((G.Fun,Int),G.Type)]))], -- ^ cats, (their contexts,
@@ -197,8 +198,8 @@ grammar2shellState opts (gr,sgr) =
-- | update a shell state from a canonical grammar -- | update a shell state from a canonical grammar
updateShellState :: Options -> NoParse -> Maybe Ident -> ShellState -> updateShellState :: Options -> NoParse -> Maybe Ident -> ShellState ->
((Int,G.SourceGrammar,CanonGrammar),[(FilePath,ModTime)]) -> ((Int,G.SourceGrammar,CanonGrammar),[(String,(FilePath,ModTime))]) ->
---- (CanonGrammar,(G.SourceGrammar,[(FilePath,ModTime)])) -> ---- (CanonGrammar,(G.SourceGrammar,[(String,(FilePath,ModTime))])) ->
Err ShellState Err ShellState
updateShellState opts ign mcnc sh ((_,sgr,gr),rts) = do updateShellState opts ign mcnc sh ((_,sgr,gr),rts) = do
let cgr0 = M.updateMGrammar (canModules sh) gr let cgr0 = M.updateMGrammar (canModules sh) gr
@@ -271,7 +272,7 @@ updateShellState opts ign mcnc sh ((_,sgr,gr),rts) = do
treebanks = treebanks sh, treebanks = treebanks sh,
probss = zip concrs probss, probss = zip concrs probss,
gloptions = gloptions sh, --- opts, -- this would be command-line options gloptions = gloptions sh, --- opts, -- this would be command-line options
readFiles = [ft | ft@(f,_) <- readFiles sh, notInrts f] ++ rts, readFiles = [ft | ft@(_,(f,_)) <- readFiles sh, notInrts f] ++ rts,
absCats = csi, absCats = csi,
statistics = [StDepTypes deps,StBoundVars binds], statistics = [StDepTypes deps,StBoundVars binds],
transfers = transfers sh transfers = transfers sh
@@ -455,6 +456,9 @@ allActiveStateGrammarsWithNames st =
allActiveGrammars = map snd . allActiveStateGrammarsWithNames allActiveGrammars = map snd . allActiveStateGrammarsWithNames
pathOfModule :: ShellState -> Ident -> FilePath
pathOfModule sh m = maybe "module not found" fst $ lookup (P.prt m) $ readFiles sh
-- command-line option -lang=foo overrides the actual grammar in state -- command-line option -lang=foo overrides the actual grammar in state
grammarOfOptState :: Options -> ShellState -> StateGrammar grammarOfOptState :: Options -> ShellState -> StateGrammar
grammarOfOptState opts st = grammarOfOptState opts st =
@@ -531,14 +535,6 @@ changeOptions :: (Options -> Options) -> ShellStateOper
--- __________ this is OBSOLETE --- __________ this is OBSOLETE
changeOptions f sh = sh {gloptions = f (gloptions sh)} changeOptions f sh = sh {gloptions = f (gloptions sh)}
changeModTimes :: [(FilePath,ModTime)] -> ShellStateOper
--- __________ this is OBSOLETE
changeModTimes mfs
(ShSt a c cs can src cfs old_pinfos mcfgs fcfgs cfgs pinfos ms tbs pbs os ff ts ss trs) =
ShSt a c cs can src cfs old_pinfos mcfgs fcfgs cfgs pinfos ms tbs pbs os ff' ts ss trs
where
ff' = mfs ++ [mf | mf@(f,_) <- ff, notElem f (map fst mfs)]
addGlobalOptions :: Options -> ShellStateOper addGlobalOptions :: Options -> ShellStateOper
addGlobalOptions = changeOptions . addOptions addGlobalOptions = changeOptions . addOptions

29
src/GF/UseGrammar/Information.hs
View File

@@ -42,7 +42,11 @@ import GF.Infra.UseIO
showInformation :: Options -> ShellState -> Ident -> IOE () showInformation :: Options -> ShellState -> Ident -> IOE ()
showInformation opts st c = do showInformation opts st c = do
is <- ioeErr $ getInformation opts st c is <- ioeErr $ getInformation opts st c
mapM_ (putStrLnE . prInformation opts c) is if null is
then putStrLnE "Identifier not in scope"
else mapM_ (putStrLnE . prInformationM c) is
where
prInformationM c (i,m) = prInformation opts c i ++ "file:" +++ m ++ "\n"
-- | the data type of different kinds of information -- | the data type of different kinds of information
data Information = data Information =
@@ -71,7 +75,8 @@ prInformation opts c i = unlines $ prt c : case i of
] ]
ICatAbs m co _ -> [ ICatAbs m co _ -> [
"category in abstract module" +++ prt m, "category in abstract module" +++ prt m,
"context" +++ prContext co if null co then "not a dependent type"
else "dependent type with context" +++ prContext co
] ]
ICatCnc m ty cfs tr -> [ ICatCnc m ty cfs tr -> [
"category in concrete module" +++ prt m, "category in concrete module" +++ prt m,
@@ -102,37 +107,39 @@ prInformation opts c i = unlines $ prt c : case i of
] ]
-- | also finds out if an identifier is defined in many places -- | also finds out if an identifier is defined in many places
getInformation :: Options -> ShellState -> Ident -> Err [Information] getInformation :: Options -> ShellState -> Ident -> Err [(Information,FilePath)]
getInformation opts st c = allChecks $ [ getInformation opts st c = allChecks $ [
do do
m <- lookupModule src c m <- lookupModule src c
case m of case m of
ModMod mo -> return $ IModule mo ModMod mo -> returnm c $ IModule mo
_ -> prtBad "not a source module" c _ -> prtBad "not a source module" c
] ++ map lookInSrc ss ++ map lookInCan cs ] ++ map lookInSrc ss ++ map lookInCan cs
where where
lookInSrc (i,m) = do lookInSrc (i,m) = do
j <- lookupInfo m c j <- lookupInfo m c
case j of case j of
AbsCat (Yes co) _ -> return $ ICatAbs i co [] --- AbsCat (Yes co) _ -> returnm i $ ICatAbs i co [] ---
AbsFun (Yes ty) _ -> return $ IFunAbs i ty Nothing --- AbsFun (Yes ty) _ -> returnm i $ IFunAbs i ty Nothing ---
CncCat (Yes ty) _ _ -> do CncCat (Yes ty) _ _ -> do
---- let cat = ident2CFCat i c ---- let cat = ident2CFCat i c
---- rs <- concat [rs | (c,rs) <- cf, ] ---- rs <- concat [rs | (c,rs) <- cf, ]
return $ ICatCnc i ty [] ty --- returnm i $ ICatCnc i ty [] ty ---
CncFun _ (Yes tr) _ -> do CncFun _ (Yes tr) _ -> do
rs <- return [] rs <- return []
return $ IFunCnc i tr rs tr --- returnm i $ IFunCnc i tr rs tr ---
ResOper (Yes ty) (Yes tr) -> return $ IOper i ty tr ResOper (Yes ty) (Yes tr) -> returnm i $ IOper i ty tr
ResParam (Yes ps) -> do ResParam (Yes ps) -> do
ts <- allParamValues src (QC i c) ts <- allParamValues src (QC i c)
return $ IParam i ps ts returnm i $ IParam i ps ts
ResValue (Yes ty) -> return $ IValue i ty --- ResValue (Yes ty) -> returnm i $ IValue i ty ---
_ -> prtBad "nothing available for" i _ -> prtBad "nothing available for" i
lookInCan (i,m) = do lookInCan (i,m) = do
Bad "nothing available yet in canonical" Bad "nothing available yet in canonical"
returnm m i = return (i, pathOfModule st m)
src = srcModules st src = srcModules st
can = canModules st can = canModules st
ss = [(i,m) | (i,ModMod m) <- modules src] ss = [(i,m) | (i,ModMod m) <- modules src]