summaryrefslogtreecommitdiff
path: root/src-3.0/GF/GFCC/API.hs
diff options
context:
space:
mode:
authorkrasimir <krasimir@chalmers.se>2008-05-29 17:55:05 +0000
committerkrasimir <krasimir@chalmers.se>2008-05-29 17:55:05 +0000
commit88d3f61f41f7b6299e0d0f9e0047dd955cb67571 (patch)
tree62fd337e92ac607469d47ade41ed19cd5209e59c /src-3.0/GF/GFCC/API.hs
parent1bcc4aab8178434a890a3c723582b5fbd45a5a84 (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.hs184
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 ""