forked from GitHub/gf-core
fixes for Janna
This commit is contained in:
@@ -73,9 +73,6 @@ compileModule opts st0 file |
|
||||
let mods = modules grammar1
|
||||
let env = compileEnvShSt st0 []
|
||||
foldM (comp putp path) env mods
|
||||
---- (_,sgr,cgr) <- foldM (comp putp path) env mods
|
||||
---- return $ (reverseModules cgr, -- to preserve dependency order
|
||||
---- (reverseModules sgr,[]))
|
||||
where
|
||||
suff = fileSuffix file
|
||||
comp putp path env sm0 = do
|
||||
@@ -110,16 +107,6 @@ compileModule opts1 st0 file = do
|
||||
maybe (return ()) putStrLnE mm
|
||||
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
|
||||
t <- ioeIO getNowTime
|
||||
let m = justModuleName file
|
||||
|
||||
@@ -42,7 +42,8 @@ getOldGrammar :: Options -> FilePath -> IOE SourceGrammar
|
||||
getOldGrammar opts file = do
|
||||
defs <- parseOldGrammarFiles file
|
||||
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 file = do
|
||||
|
||||
@@ -122,7 +122,8 @@ updateShellState opts sh ((_,sgr,gr),rts) = do
|
||||
a' = ifNull Nothing (return . head) $ allAbstracts cgr0
|
||||
abstr0 <- case abstract sh of
|
||||
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 a'
|
||||
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
|
||||
|
||||
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
|
||||
needed (i,_) = case abstr of
|
||||
Just a -> elem i $ needs a
|
||||
|
||||
@@ -144,13 +144,15 @@ execCommand env c s = case c of
|
||||
CCEnvOpenTerm file -> do
|
||||
c <- readFileIf file
|
||||
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)
|
||||
|
||||
CCEnvOpenString file -> do
|
||||
c <- readFileIf file
|
||||
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)
|
||||
|
||||
CCEnvOn name -> return (languageOn (language name) env,s)
|
||||
@@ -177,9 +179,10 @@ execCommand env c s = case c of
|
||||
cgr = canCEnv 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 =
|
||||
(map ((initFilePath f ++) . filter (/=' ') . drop 2) fs, unlines ss) where
|
||||
(unwords (intersperse ";;" fs), unlines ss) where
|
||||
(fs,ss) = span isImport (lines s)
|
||||
isImport l = take 2 l == "--"
|
||||
|
||||
|
||||
Reference in New Issue
Block a user