diff options
Diffstat (limited to 'src/GF/Compile')
| -rw-r--r-- | src/GF/Compile/CheckGrammar.hs | 6 | ||||
| -rw-r--r-- | src/GF/Compile/Compile.hs | 14 | ||||
| -rw-r--r-- | src/GF/Compile/GetGrammar.hs | 17 | ||||
| -rw-r--r-- | src/GF/Compile/Rename.hs | 1 |
4 files changed, 30 insertions, 8 deletions
diff --git a/src/GF/Compile/CheckGrammar.hs b/src/GF/Compile/CheckGrammar.hs index 3a1b480ff..f7df7102d 100644 --- a/src/GF/Compile/CheckGrammar.hs +++ b/src/GF/Compile/CheckGrammar.hs @@ -269,6 +269,8 @@ inferLType gr trm = case trm of prtFail "cannot infer type of constant" trm ] + QC m ident | m==cPredef -> termWith trm $ checkErr (typPredefined ident) + QC m ident -> checks [ termWith trm $ checkErr (lookupResType gr m ident) , @@ -426,7 +428,7 @@ inferLType gr trm = case trm of _ -> False inferPatt p = case p of - PP q c ps -> checkErr $ lookupResType gr q c >>= valTypeCnc + PP q c ps | q /= cPredef -> checkErr $ lookupResType gr q c >>= valTypeCnc _ -> infer (patt2term p) >>= return . snd checkLType :: SourceGrammar -> Term -> Type -> Check (Term, Type) @@ -560,7 +562,7 @@ checkLType env trm typ0 = do pattContext :: LTEnv -> Type -> Patt -> Check Context pattContext env typ p = case p of PV x -> return [(x,typ)] - PP q c ps -> do + PP q c ps | q /= cPredef -> do t <- checkErr $ lookupResType cnc q c (cont,v) <- checkErr $ typeFormCnc t checkCond ("wrong number of arguments for constructor in" +++ prt p) diff --git a/src/GF/Compile/Compile.hs b/src/GF/Compile/Compile.hs index e6936809c..145ada8a9 100644 --- a/src/GF/Compile/Compile.hs +++ b/src/GF/Compile/Compile.hs @@ -56,18 +56,22 @@ batchCompileOld f = compileOld defOpts f compileModule :: Options -> ShellState -> FilePath -> IOE (GFC.CanonGrammar, (SourceGrammar,[(FilePath,ModTime)])) -compileModule opts st0 file | oElem showOld opts || fileSuffix file == "cf" = do +compileModule opts st0 file | oElem showOld opts || + elem suff ["cf","ebnf"] = do let putp = putPointE opts let path = [] ---- - grammar1 <- if fileSuffix file == "cf" - then putp ("- parsing cf" +++ file) $ getCFGrammar opts file - else putp ("- parsing old gf" +++ file) $ getOldGrammar opts file + grammar1 <- if suff == "cf" + then putp ("- parsing" +++ suff +++ file) $ getCFGrammar opts file + else if suff == "ebnf" + then putp ("- parsing" +++ suff +++ file) $ getEBNFGrammar opts file + else putp ("- parsing old gf" +++ file) $ getOldGrammar opts file let mods = modules grammar1 let env = compileEnvShSt st0 [] (_,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 (k',sm) <- makeSourceModule opts env sm0 cm <- putp " generating code... " $ generateModuleCode opts path sm @@ -87,7 +91,7 @@ compileModule opts1 st0 file = do let st = st0 --- if useFileOpt then emptyShellState else st0 let rfs = readFiles st let file' = if useFileOpt then justFileName file else file -- to find file itself - files <- getAllFiles ps rfs file' + files <- getAllFiles opts ps rfs file' ioeIO $ putStrLn $ "files to read:" +++ show files ---- let names = map justModuleName files ioeIO $ putStrLn $ "modules to include:" +++ show names ---- diff --git a/src/GF/Compile/GetGrammar.hs b/src/GF/Compile/GetGrammar.hs index 58ce8d62b..a9cae513a 100644 --- a/src/GF/Compile/GetGrammar.hs +++ b/src/GF/Compile/GetGrammar.hs @@ -18,6 +18,7 @@ import qualified LexGF as L import PPrCF import CFtoGrammar +import EBNF import ReadFiles ---- @@ -86,9 +87,23 @@ oldLexer = map change . L.tokens where getCFGrammar :: Options -> FilePath -> IOE SourceGrammar getCFGrammar opts file = do - let mo = takeWhile (/='-') file + let mo = takeWhile (/='.') file s <- ioeIO $ readFileIf file cf <- ioeErr $ pCF mo s defs <- return $ cf2grammar cf let g = A.OldGr A.NoIncl defs +--- let ma = justModuleName file +--- let mc = 'C':ma --- +--- let opts' = addOptions (options [useAbsName ma, useCncName mc]) opts + ioeErr $ transOldGrammar opts file g + +getEBNFGrammar :: Options -> FilePath -> IOE SourceGrammar +getEBNFGrammar opts file = do + let mo = takeWhile (/='.') file + s <- ioeIO $ readFileIf file + defs <- ioeErr $ pEBNFasGrammar s + let g = A.OldGr A.NoIncl defs +--- let ma = justModuleName file +--- let mc = 'C':ma --- +--- let opts' = addOptions (options [useAbsName ma, useCncName mc]) opts ioeErr $ transOldGrammar opts file g diff --git a/src/GF/Compile/Rename.hs b/src/GF/Compile/Rename.hs index 30c2b2c71..6c3f964df 100644 --- a/src/GF/Compile/Rename.hs +++ b/src/GF/Compile/Rename.hs @@ -62,6 +62,7 @@ renameIdentTerm env@(act,imps) t = m <- lookupErr m' qualifs f <- lookupTree prt c m return $ f c + QC m' c | m' == cPredef {- && isInPredefined c -} -> return t QC m' c -> do m <- lookupErr m' qualifs f <- lookupTree prt c m |
