mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-24 03:52:50 -06:00
fixes for Janna
This commit is contained in:
@@ -73,9 +73,6 @@ compileModule opts st0 file |
|
|||||||
let mods = modules grammar1
|
let mods = modules grammar1
|
||||||
let env = compileEnvShSt st0 []
|
let env = compileEnvShSt st0 []
|
||||||
foldM (comp putp path) env mods
|
foldM (comp putp path) env mods
|
||||||
---- (_,sgr,cgr) <- foldM (comp putp path) env mods
|
|
||||||
---- return $ (reverseModules cgr, -- to preserve dependency order
|
|
||||||
---- (reverseModules sgr,[]))
|
|
||||||
where
|
where
|
||||||
suff = fileSuffix file
|
suff = fileSuffix file
|
||||||
comp putp path env sm0 = do
|
comp putp path env sm0 = do
|
||||||
@@ -110,16 +107,6 @@ compileModule opts1 st0 file = do
|
|||||||
maybe (return ()) putStrLnE mm
|
maybe (return ()) putStrLnE mm
|
||||||
return e
|
return e
|
||||||
|
|
||||||
{- ----
|
|
||||||
(_,sgr,cgr) <- foldM (compileOne opts) env0 files
|
|
||||||
t <- ioeIO getNowTime
|
|
||||||
return $ (reverseModules cgr, -- to preserve dependency order
|
|
||||||
(reverseModules sgr, --- keepResModules opts sgr, --- keep all so far
|
|
||||||
[(justModuleName f,t) | f <- files] -- pass on the time of reading
|
|
||||||
++ [(resModName (justModuleName f),t) -- also #file if file.(gf|gfr)
|
|
||||||
| f <- files, not (isGFC f)]))
|
|
||||||
-}
|
|
||||||
|
|
||||||
getReadTimes file = do
|
getReadTimes file = do
|
||||||
t <- ioeIO getNowTime
|
t <- ioeIO getNowTime
|
||||||
let m = justModuleName file
|
let m = justModuleName file
|
||||||
|
|||||||
@@ -42,7 +42,8 @@ getOldGrammar :: Options -> FilePath -> IOE SourceGrammar
|
|||||||
getOldGrammar opts file = do
|
getOldGrammar opts file = do
|
||||||
defs <- parseOldGrammarFiles file
|
defs <- parseOldGrammarFiles file
|
||||||
let g = A.OldGr A.NoIncl defs
|
let g = A.OldGr A.NoIncl defs
|
||||||
ioeErr $ transOldGrammar opts file g
|
let name = justFileName file
|
||||||
|
ioeErr $ transOldGrammar opts name g
|
||||||
|
|
||||||
parseOldGrammarFiles :: FilePath -> IOE [A.TopDef]
|
parseOldGrammarFiles :: FilePath -> IOE [A.TopDef]
|
||||||
parseOldGrammarFiles file = do
|
parseOldGrammarFiles file = do
|
||||||
|
|||||||
@@ -122,7 +122,8 @@ updateShellState opts sh ((_,sgr,gr),rts) = do
|
|||||||
a' = ifNull Nothing (return . head) $ allAbstracts cgr0
|
a' = ifNull Nothing (return . head) $ allAbstracts cgr0
|
||||||
abstr0 <- case abstract sh of
|
abstr0 <- case abstract sh of
|
||||||
Just a -> do
|
Just a -> do
|
||||||
--- test that abstract is compatible
|
-- test that abstract is compatible
|
||||||
|
testErr (maybe True (a==) a') ("expected abstract" +++ P.prt a)
|
||||||
return $ Just a
|
return $ Just a
|
||||||
_ -> return a'
|
_ -> return a'
|
||||||
let cgr = filterAbstracts abstr0 cgr0
|
let cgr = filterAbstracts abstr0 cgr0
|
||||||
@@ -173,7 +174,7 @@ abstractName sh = maybe "(none)" P.prt (abstract sh)
|
|||||||
-- throw away those abstracts that are not needed --- could be more aggressive
|
-- throw away those abstracts that are not needed --- could be more aggressive
|
||||||
|
|
||||||
filterAbstracts :: Maybe Ident -> CanonGrammar -> CanonGrammar
|
filterAbstracts :: Maybe Ident -> CanonGrammar -> CanonGrammar
|
||||||
filterAbstracts abstr cgr = M.MGrammar [m | m <- ms, needed m] where
|
filterAbstracts abstr cgr = M.MGrammar (nubBy (\x y -> fst x == fst y) [m | m <- ms, needed m]) where
|
||||||
ms = M.modules cgr
|
ms = M.modules cgr
|
||||||
needed (i,_) = case abstr of
|
needed (i,_) = case abstr of
|
||||||
Just a -> elem i $ needs a
|
Just a -> elem i $ needs a
|
||||||
|
|||||||
@@ -144,13 +144,15 @@ execCommand env c s = case c of
|
|||||||
CCEnvOpenTerm file -> do
|
CCEnvOpenTerm file -> do
|
||||||
c <- readFileIf file
|
c <- readFileIf file
|
||||||
let (fs,t) = envAndTerm file c
|
let (fs,t) = envAndTerm file c
|
||||||
env' <- useIOE env $ foldM (shellStateFromFiles noOptions) env fs
|
(env',_) <- execCommand env (CCEnvGFShell fs) s
|
||||||
|
---- env' <- useIOE env $ foldM (shellStateFromFiles noOptions) env fs
|
||||||
return (env', execECommand env' (CNewTree t) s)
|
return (env', execECommand env' (CNewTree t) s)
|
||||||
|
|
||||||
CCEnvOpenString file -> do
|
CCEnvOpenString file -> do
|
||||||
c <- readFileIf file
|
c <- readFileIf file
|
||||||
let (fs,t) = envAndTerm file c
|
let (fs,t) = envAndTerm file c
|
||||||
env' <- useIOE env $ foldM (shellStateFromFiles noOptions) env fs
|
(env',_) <- execCommand env (CCEnvGFShell fs) s
|
||||||
|
---- env' <- useIOE env $ foldM (shellStateFromFiles noOptions) env fs
|
||||||
return (env', execECommand env' (CRefineParse t) s)
|
return (env', execECommand env' (CRefineParse t) s)
|
||||||
|
|
||||||
CCEnvOn name -> return (languageOn (language name) env,s)
|
CCEnvOn name -> return (languageOn (language name) env,s)
|
||||||
@@ -177,9 +179,10 @@ execCommand env c s = case c of
|
|||||||
cgr = canCEnv env
|
cgr = canCEnv env
|
||||||
opts = globalOptions env
|
opts = globalOptions env
|
||||||
|
|
||||||
-- format for documents: import lines of form "-- file", then term
|
-- format for documents:
|
||||||
|
-- GF commands of form "-- command", then term or text
|
||||||
envAndTerm f s =
|
envAndTerm f s =
|
||||||
(map ((initFilePath f ++) . filter (/=' ') . drop 2) fs, unlines ss) where
|
(unwords (intersperse ";;" fs), unlines ss) where
|
||||||
(fs,ss) = span isImport (lines s)
|
(fs,ss) = span isImport (lines s)
|
||||||
isImport l = take 2 l == "--"
|
isImport l = take 2 l == "--"
|
||||||
|
|
||||||
|
|||||||
Reference in New Issue
Block a user