GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-04-22 19:22:50 -06:00
Code Issues Packages Projects Releases Wiki Activity

use parser combinators to parse the shell commands. simplified CommandLine type

Browse Source
This commit is contained in:
kr.angelov
2008-06-05 07:33:42 +00:00
parent 4606271031
commit 0625cbb869
15 changed files with 164 additions and 1478 deletions
Download Patch File Download Diff File Expand all files Collapse all files

62
src-3.0/PGF.hs
View File

@@ -52,6 +52,7 @@ import qualified PGF.Linearize (linearize)
import PGF.Generate
import PGF.Macros
import PGF.Data
import PGF.ExprSyntax
import PGF.Raw.Convert
import PGF.Raw.Parse
import PGF.Raw.Print (printTree)
@@ -61,14 +62,8 @@ import GF.Text.UTF8
import GF.Data.ErrM
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
---------------------------------------------------
-- Interface
@@ -148,12 +143,6 @@ generateRandom :: PGF -> Category -> IO [Exp]
-- to limit the search space.
generateAllDepth :: PGF -> Category -> Maybe Int -> [Exp]
-- | parses 'String' as an expression
readExp :: String -> Maybe Exp
-- | renders expression as 'String'
showExp :: Exp -> String
-- | List of all languages available in the given grammar.
languages :: PGF -> [Language]
@@ -215,55 +204,6 @@ generateRandom pgf cat = do
generateAll pgf cat = generate pgf (mkCId cat) Nothing
generateAllDepth pgf cat = generate pgf (mkCId cat)
readExp s = case RP.readP_to_S (pExp False) s of
[(x,"")] -> Just x
_ -> Nothing
pExps :: RP.ReadP [Exp]
pExps = liftM2 (:) (pExp True) pExps RP.<++ (RP.skipSpaces >> return [])
pExp :: Bool -> RP.ReadP Exp
pExp isNested = RP.skipSpaces >> (pParen RP.<++ pAbs RP.<++ pApp RP.<++ pNum RP.<++ pStr RP.<++ pMeta)
where
pParen = RP.between (RP.char '(') (RP.char ')') (pExp False)
pAbs = do xs <- RP.between (RP.char '\\') (RP.skipSpaces >> RP.string "->") (RP.sepBy1 (RP.skipSpaces >> pIdent) (RP.skipSpaces >> RP.char ','))
t <- pExp False
return (EAbs xs t)
pApp = do f <- pIdent
ts <- (if isNested then return [] else pExps)
return (EApp f ts)
pStr = RP.char '"' >> liftM EStr (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 (EFloat (read (x++"."++y))))
RP.<++
(return (EInt (read x))))
pMeta = do RP.char '?'
x <- RP.munch1 isDigit
return (EMeta (read x))
pIdent = fmap mkCId (liftM2 (:) (RP.satisfy isIdentFirst) (RP.munch isIdentRest))
isIdentFirst c = c == '_' || isLetter c
isIdentRest c = c == '_' || c == '\'' || isAlphaNum c
showExp = PP.render . ppExp False
ppExp isNested (EAbs xs t) = ppParens isNested (PP.char '\\' PP.<>
PP.hsep (PP.punctuate PP.comma (map (PP.text . prCId) xs)) PP.<+>
PP.text "->" PP.<+>
ppExp False t)
ppExp isNested (EApp f []) = PP.text (prCId f)
ppExp isNested (EApp f ts) = ppParens isNested (PP.text (prCId f) PP.<+> PP.hsep (map (ppExp True) ts))
ppExp isNested (EStr s) = PP.text (show s)
ppExp isNested (EInt n) = PP.integer n
ppExp isNested (EFloat d) = PP.double d
ppExp isNested (EMeta n) = PP.char '?' PP.<> PP.integer n
ppExp isNested (EVar id) = PP.text (prCId id)
ppParens True = PP.parens
ppParens False = id
abstractName pgf = prCId (absname pgf)
languages pgf = [prCId l | l <- cncnames pgf]