mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-12 22:39:31 -06:00
80 lines
2.2 KiB
Haskell
80 lines
2.2 KiB
Haskell
----------------------------------------------------------------------
|
|
-- |
|
|
-- Module : GetGFC
|
|
-- Maintainer : AR
|
|
-- Stability : (stable)
|
|
-- Portability : (portable)
|
|
--
|
|
-- > CVS $Date: 2005/05/30 18:39:43 $
|
|
-- > CVS $Author: aarne $
|
|
-- > CVS $Revision: 1.9 $
|
|
--
|
|
-- (Description of the module)
|
|
-----------------------------------------------------------------------------
|
|
|
|
module GF.Canon.GetGFC (getCanonModule, getCanonGrammar) where
|
|
|
|
import GF.Data.Operations
|
|
import GF.Canon.ParGFC
|
|
import GF.Canon.GFC
|
|
import GF.Canon.MkGFC
|
|
import GF.Infra.Modules
|
|
import GF.Compile.GetGrammar (err2err) ---
|
|
import GF.Infra.UseIO
|
|
|
|
import System.IO
|
|
import System.Directory
|
|
import Control.Monad
|
|
|
|
getCanonModule :: FilePath -> IOE CanonModule
|
|
getCanonModule file = do
|
|
gr <- getCanonGrammar file
|
|
case modules gr of
|
|
[m] -> return m
|
|
_ -> ioeErr $ Bad "expected exactly one module in a file"
|
|
|
|
getCanonGrammar :: FilePath -> IOE CanonGrammar
|
|
-- getCanonGrammar = getCanonGrammarByLine
|
|
getCanonGrammar file = do
|
|
s <- ioeIO $ readFileIf file
|
|
c <- ioeErr $ pCanon $ myLexer s
|
|
return $ canon2grammar c
|
|
|
|
{-
|
|
-- the following surprisingly does not save memory so it is
|
|
-- not in use
|
|
|
|
getCanonGrammarByLine :: FilePath -> IOE CanonGrammar
|
|
getCanonGrammarByLine file = do
|
|
b <- ioeIO $ doesFileExist file
|
|
if not b
|
|
then ioeErr $ Bad $ "file" +++ file +++ "does not exist"
|
|
else do
|
|
ioeIO $ putStrLn ""
|
|
hand <- ioeIO $ openFile file ReadMode ---- err
|
|
size <- ioeIO $ hFileSize hand
|
|
gr <- addNextLine (size,0) 1 hand emptyMGrammar
|
|
ioeIO $ hClose hand
|
|
return $ MGrammar $ reverse $ modules gr
|
|
|
|
where
|
|
addNextLine (size,act) d hand gr = do
|
|
eof <- ioeIO $ hIsEOF hand
|
|
if eof
|
|
then return gr
|
|
else do
|
|
s <- ioeIO $ hGetLine hand
|
|
let act' = act + toInteger (length s)
|
|
-- if isHash act act' then (ioeIO $ putChar '#') else return ()
|
|
updGrammar act' d gr $ pLine $ myLexer s
|
|
where
|
|
updGrammar a d gr (Ok t) = case buildCanonGrammar d gr t of
|
|
(gr',d') -> addNextLine (size,a) d' hand gr'
|
|
updGrammar _ _ gr (Bad s) = do
|
|
ioeIO $ putStrLn s
|
|
return emptyMGrammar
|
|
|
|
isHash a b = a `div` step < b `div` step
|
|
step = size `div` 50
|
|
-}
|