summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authoraarne <unknown>2004-08-12 09:02:00 +0000
committeraarne <unknown>2004-08-12 09:02:00 +0000
commit096c861fb4cb7feba5db4752da029c639527b3b3 (patch)
tree60d27402a4b551856bfb5f0d8856db8d06c22e42 /src
parent4bc5b35bcb4a834c7d22f6503bf5d64e7092cd2b (diff)
fixes for Janna
Diffstat (limited to 'src')
-rw-r--r--src/GF/Compile/Compile.hs13
-rw-r--r--src/GF/Compile/GetGrammar.hs3
-rw-r--r--src/GF/Compile/ShellState.hs5
-rw-r--r--src/GF/Shell/Commands.hs11
4 files changed, 12 insertions, 20 deletions
diff --git a/src/GF/Compile/Compile.hs b/src/GF/Compile/Compile.hs
index 5dd4d3345..b0f9bb581 100644
--- a/src/GF/Compile/Compile.hs
+++ b/src/GF/Compile/Compile.hs
@@ -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
diff --git a/src/GF/Compile/GetGrammar.hs b/src/GF/Compile/GetGrammar.hs
index 7907a817b..e2c581dd4 100644
--- a/src/GF/Compile/GetGrammar.hs
+++ b/src/GF/Compile/GetGrammar.hs
@@ -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
diff --git a/src/GF/Compile/ShellState.hs b/src/GF/Compile/ShellState.hs
index 18b237745..e1e64e85c 100644
--- a/src/GF/Compile/ShellState.hs
+++ b/src/GF/Compile/ShellState.hs
@@ -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
diff --git a/src/GF/Shell/Commands.hs b/src/GF/Shell/Commands.hs
index 9bf1f8ff2..5a16c4b59 100644
--- a/src/GF/Shell/Commands.hs
+++ b/src/GF/Shell/Commands.hs
@@ -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 == "--"