1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
|
module GF.Devel.Compile.Compile (batchCompile) where
-- the main compiler passes
import GF.Devel.Compile.GetGrammar
import GF.Devel.Compile.Extend
import GF.Devel.Compile.Rename
import GF.Devel.Compile.CheckGrammar
import GF.Devel.Compile.Refresh
import GF.Devel.Compile.Optimize
import GF.Devel.Compile.Factorize
import GF.Devel.Grammar.Grammar
import GF.Devel.Grammar.Construct
import GF.Infra.Ident
import GF.Devel.Grammar.PrGF
----import GF.Devel.Grammar.Lookup
import GF.Devel.ReadFiles
import GF.Infra.Option ----
import GF.Data.Operations
import GF.Devel.UseIO
import GF.Devel.Arch
import Control.Monad
import System.Directory
batchCompile :: Options -> [FilePath] -> IO GF
batchCompile opts files = do
let defOpts = addOptions opts (options [emitCode])
egr <- appIOE $ foldM (compileModule defOpts) emptyCompileEnv files
case egr of
Ok (_,gr) -> return gr
Bad s -> error s
-- to output an intermediate stage
intermOut :: Options -> Option -> String -> IOE ()
intermOut opts opt s = if oElem opt opts then
ioeIO (putStrLn ("\n\n--#" +++ prOpt opt) >> putStrLn s)
else return ()
prMod :: SourceModule -> String
prMod = prModule
-- | environment variable for grammar search path
gfGrammarPathVar = "GF_GRAMMAR_PATH"
-- | the environment
type CompileEnv = (Int,GF)
-- | compile with one module as starting point
-- command-line options override options (marked by --#) in the file
-- 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.
compileModule :: Options -> CompileEnv -> FilePath -> IOE CompileEnv
compileModule opts1 env file = do
opts0 <- ioeIO $ getOptionsFromFile file
let useFileOpt = maybe False (const True) $ getOptVal opts0 pathList
let useLineOpt = maybe False (const True) $ getOptVal opts1 pathList
let opts = addOptions opts1 opts0
let fpath = justInitPath file
ps0 <- ioeIO $ pathListOpts opts fpath
let ps1 = if (useFileOpt && not useLineOpt)
then (ps0 ++ map (prefixPathName fpath) ps0)
else ps0
ps <- ioeIO $ extendPathEnv gfLibraryPath gfGrammarPathVar ps1
let ioeIOIf = if oElem beVerbose opts then ioeIO else (const (return ()))
ioeIOIf $ putStrLn $ "module search path:" +++ show ps ----
let sgr = snd env
let rfs = [] ---- files already in memory and their read times
let file' = if useFileOpt then justFileName file else file -- find file itself
files <- getAllFiles opts ps rfs file'
ioeIOIf $ putStrLn $ "files to read:" +++ show files ----
let names = map justModuleName files
ioeIOIf $ putStrLn $ "modules to include:" +++ show names ----
let sgr2 = sgr ----MGrammar [m | m@(i,_) <- modules sgr,
---- notElem (prt i) $ map fileBody names]
let env0 = (0,sgr2)
(e,mm) <- foldIOE (compileOne opts) env0 files
maybe (return ()) putStrLnE mm
return e
compileOne :: Options -> CompileEnv -> FullPath -> IOE CompileEnv
compileOne opts env@(_,srcgr) file = do
let putp s = putPointE opts ("\n" ++ s)
let putpp = putPointEsil opts
let putpOpt v m act
| oElem beVerbose opts = putp v act
| oElem beSilent opts = putpp v act
| otherwise = ioeIO (putStrFlush ("\n" ++ m)) >> act
let gf = fileSuffix file
let path = justInitPath file
let name = fileBody file
let mos = gfmodules srcgr
case gf of
-- for compiled gf, read the file and update environment
-- also undo common subexp optimization, to enable normal computations
"gfo" -> do
sm0 <- putp ("+ reading" +++ file) $ getSourceModule opts file
let sm1 = unsubexpModule sm0
sm <- {- putp "creating indirections" $ -} ioeErr $ extendModule srcgr sm1
extendCompileEnv env sm
-- for gf source, do full compilation and generate code
_ -> do
let modu = unsuffixFile file
b1 <- ioeIO $ doesFileExist file
if not b1
then compileOne opts env $ gfoFile $ modu
else do
sm0 <-
putpOpt ("- parsing" +++ file) ("- compiling" +++ file ++ "... ") $
getSourceModule opts file
(k',sm) <- compileSourceModule opts env sm0
let sm1 = sm ----
---- if isConcr sm then shareModule sm else sm -- cannot expand Str
if oElem (iOpt "doemit") opts
then putpp " generating code... " $ generateModuleCode opts path sm1
else return ()
---- -- sm is optimized before generation, but not in the env
---- let cm2 = unsubexpModule cm
extendCompileEnvInt env (k',sm) ---- sm1
where
isConcr (_,mi) = case mi of
---- ModMod m -> isModCnc m && mstatus m /= MSIncomplete
_ -> False
compileSourceModule :: Options -> CompileEnv ->
SourceModule -> IOE (Int,SourceModule)
compileSourceModule opts env@(k,gr) mo@(i,mi) = do
intermOut opts (iOpt "show_gf") (prMod mo)
let putp = putPointE opts
putpp = putPointEsil opts
stopIf n comp m =
if any (\k -> oElem (iOpt (show k)) opts) [1..n] then return m else comp m
stopIfV v n comp m =
if any (\k -> oElem (iOpt (show k)) opts) [1..n] then return (m,v) else comp m
moe <- stopIf 1 (putpp " extending" . ioeErr . extendModule gr) mo
intermOut opts (iOpt "show_extend") (prMod moe)
mor <- stopIf 2 (putpp " renaming" . ioeErr . renameModule gr) moe
intermOut opts (iOpt "show_rename") (prMod mor)
(moc,warnings) <-
stopIfV [] 3 (putpp " type checking" . ioeErr . showCheckModule gr) mor
if null warnings then return () else putp warnings $ return ()
intermOut opts (iOpt "show_typecheck") (prMod moc)
(mox,k') <- stopIfV k 4 (putpp " refreshing " . ioeErr . refreshModule k) moc
intermOut opts (iOpt "show_refresh") (prMod mox)
moo <- stopIf 5 (putpp " optimizing " . ioeErr . optimizeModule opts gr) mox
intermOut opts (iOpt "show_optimize") (prMod moo)
mof <- stopIf 6 (putpp " factorizing " . ioeErr . optimizeModule opts gr) moo
intermOut opts (iOpt "show_factorize") (prMod mof)
return (k',moo) ----
generateModuleCode :: Options -> InitPath -> SourceModule -> IOE ()
generateModuleCode opts path minfo@(name,info) = do
let pname = prefixPathName path (prt name)
let minfo0 = minfo
let minfo1 = subexpModule minfo0
let minfo2 = minfo1
let (file,out) = (gfoFile pname, prGF (gfModules [minfo2]))
putp (" wrote file" +++ file) $ ioeIO $ writeFile file $ out
return () ----- minfo2
where
putp = putPointE opts
putpp = putPointEsil opts
-- auxiliaries
pathListOpts :: Options -> FileName -> IO [InitPath]
pathListOpts opts file = return $ maybe [file] pFilePaths $ getOptVal opts pathList
----reverseModules (MGrammar ms) = MGrammar $ reverse ms
emptyCompileEnv :: CompileEnv
emptyCompileEnv = (0,emptyGF)
extendCompileEnvInt (_,gf) (k,(s,m)) = return (k, addModule s m gf)
extendCompileEnv e@(k,_) sm = extendCompileEnvInt e (k,sm)
|
