diff options
| author | krasimir <krasimir@chalmers.se> | 2008-05-29 17:55:05 +0000 |
|---|---|---|
| committer | krasimir <krasimir@chalmers.se> | 2008-05-29 17:55:05 +0000 |
| commit | 88d3f61f41f7b6299e0d0f9e0047dd955cb67571 (patch) | |
| tree | 62fd337e92ac607469d47ade41ed19cd5209e59c /src-3.0/GF/GFCC/API.hs | |
| parent | 1bcc4aab8178434a890a3c723582b5fbd45a5a84 (diff) | |
change the library root namespace from GF.GFCC to PGF
Diffstat (limited to 'src-3.0/GF/GFCC/API.hs')
| -rw-r--r-- | src-3.0/GF/GFCC/API.hs | 184 |
1 files changed, 0 insertions, 184 deletions
diff --git a/src-3.0/GF/GFCC/API.hs b/src-3.0/GF/GFCC/API.hs deleted file mode 100644 index 0eb9d15da..000000000 --- a/src-3.0/GF/GFCC/API.hs +++ /dev/null @@ -1,184 +0,0 @@ ----------------------------------------------------------------------- --- | --- Module : GFCCAPI --- Maintainer : Aarne Ranta --- Stability : (stable) --- Portability : (portable) --- --- > CVS $Date: --- > CVS $Author: --- > CVS $Revision: --- --- Reduced Application Programmer's Interface to GF, meant for --- embedded GF systems. AR 19/9/2007 ------------------------------------------------------------------------------ - -module GF.GFCC.API where - -import GF.GFCC.Linearize -import GF.GFCC.Generate -import GF.GFCC.Macros -import GF.GFCC.DataGFCC -import GF.GFCC.CId -import GF.GFCC.Raw.ConvertGFCC -import GF.GFCC.Raw.ParGFCCRaw - -import GF.Data.ErrM - -import GF.GFCC.Parsing.FCFG - -import Data.Char -import qualified Data.Map as Map -import Control.Monad -import System.Random (newStdGen) -import System.Directory (doesFileExist) -import qualified Text.PrettyPrint as PP -import qualified Text.ParserCombinators.ReadP as RP - - --- This API is meant to be used when embedding GF grammars in Haskell --- programs. The embedded system is supposed to use the --- .gfcc grammar format, which is first produced by the gf program. - ---------------------------------------------------- --- Interface ---------------------------------------------------- - -data MultiGrammar = MultiGrammar {gfcc :: GFCC} -type Language = String -type Category = String -type Tree = Exp - -file2grammar :: FilePath -> IO MultiGrammar - -linearize :: MultiGrammar -> Language -> Tree -> String -parse :: MultiGrammar -> Language -> Category -> String -> [Tree] - -linearizeAll :: MultiGrammar -> Tree -> [String] -linearizeAllLang :: MultiGrammar -> Tree -> [(Language,String)] - -parseAll :: MultiGrammar -> Category -> String -> [[Tree]] -parseAllLang :: MultiGrammar -> Category -> String -> [(Language,[Tree])] - -generateAll :: MultiGrammar -> Category -> [Tree] -generateRandom :: MultiGrammar -> Category -> IO [Tree] -generateAllDepth :: MultiGrammar -> Category -> Maybe Int -> [Tree] - -readTree :: String -> Tree -showTree :: Tree -> String - -languages :: MultiGrammar -> [Language] -categories :: MultiGrammar -> [Category] - -startCat :: MultiGrammar -> Category - ---------------------------------------------------- --- Implementation ---------------------------------------------------- - -file2grammar f = do - gfcc <- file2gfcc f - return (MultiGrammar gfcc) - -file2gfcc f = do - s <- readFileIf f - g <- parseGrammar s - return $ toGFCC g - -linearize mgr lang = GF.GFCC.Linearize.linearize (gfcc mgr) (mkCId lang) - -parse mgr lang cat s = - case lookParser (gfcc mgr) (mkCId lang) of - Nothing -> error "no parser" - Just pinfo -> case parseFCF "bottomup" pinfo (mkCId cat) (words s) of - Ok x -> x - Bad s -> error s - -linearizeAll mgr = map snd . linearizeAllLang mgr -linearizeAllLang mgr t = - [(lang,linearThis mgr lang t) | lang <- languages mgr] - -parseAll mgr cat = map snd . parseAllLang mgr cat - -parseAllLang mgr cat s = - [(lang,ts) | lang <- languages mgr, let ts = parse mgr lang cat s, not (null ts)] - -generateRandom mgr cat = do - gen <- newStdGen - return $ genRandom gen (gfcc mgr) (mkCId cat) - -generateAll mgr cat = generate (gfcc mgr) (mkCId cat) Nothing -generateAllDepth mgr cat = generate (gfcc mgr) (mkCId cat) - -readTree s = case RP.readP_to_S (pExp 0) s of - [(x,"")] -> x - _ -> error "no parse" - -pExps :: RP.ReadP [Exp] -pExps = liftM2 (:) (pExp 1) pExps RP.<++ (RP.skipSpaces >> return []) - -pExp :: Int -> RP.ReadP Exp -pExp n = RP.skipSpaces >> (pParen RP.<++ pApp RP.<++ pNum RP.<++ pStr RP.<++ pMeta) - where - pParen = RP.between (RP.char '(') (RP.char ')') (pExp 0) - pApp = do xs <- RP.option [] (RP.between (RP.char '\\') (RP.string "->") (RP.sepBy1 pIdent (RP.char ','))) - f <- pIdent - ts <- (if n == 0 then pExps else return []) - return (DTr xs (AC f) ts) - pStr = RP.char '"' >> liftM (\s -> DTr [] (AS s) []) (RP.manyTill (pEsc RP.<++ RP.get) (RP.char '"')) - pEsc = RP.char '\\' >> RP.get - pNum = do x <- RP.munch1 isDigit - ((RP.char '.' >> RP.munch1 isDigit >>= \y -> return (DTr [] (AF (read (x++"."++y))) [])) - RP.<++ - (return (DTr [] (AI (read x)) []))) - pMeta = do RP.char '?' - x <- RP.munch1 isDigit - return (DTr [] (AM (read x)) []) - - pIdent = fmap mkCId (liftM2 (:) (RP.satisfy isIdentFirst) (RP.munch isIdentRest)) - isIdentFirst c = c == '_' || isLetter c - isIdentRest c = c == '_' || c == '\'' || isAlphaNum c - - -showTree = PP.render . ppExp False - -ppExp isNested (DTr [] at []) = ppAtom at -ppExp isNested (DTr xs at ts) = ppParens isNested (ppLambdas xs PP.<+> ppAtom at PP.<+> PP.hsep (map (ppExp True) ts)) - where - ppLambdas [] = PP.empty - ppLambdas xs = PP.char '\\' PP.<> - PP.hsep (PP.punctuate PP.comma (map (PP.text . prCId) xs)) PP.<+> - PP.text "->" - - ppParens True = PP.parens - ppParens False = id - -ppAtom (AC id) = PP.text (prCId id) -ppAtom (AS s) = PP.text (show s) -ppAtom (AI n) = PP.integer n -ppAtom (AF d) = PP.double d -ppAtom (AM n) = PP.char '?' PP.<> PP.integer n -ppAtom (AV id) = PP.text (prCId id) - -abstractName mgr = prCId (absname (gfcc mgr)) - -languages mgr = [prCId l | l <- cncnames (gfcc mgr)] - -categories mgr = [prCId c | c <- Map.keys (cats (abstract (gfcc mgr)))] - -startCat mgr = lookStartCat (gfcc mgr) - -emptyMultiGrammar = MultiGrammar emptyGFCC - ------------- for internal use only - -linearThis = GF.GFCC.API.linearize - -err f g ex = case ex of - Ok x -> g x - Bad s -> f s - -readFileIf f = do - b <- doesFileExist f - if b then readFile f - else putStrLn ("file " ++ f ++ " not found") >> return "" |
