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

change the PGF.Data.Exp type

Browse Source
This commit is contained in:
krasimir
2008-05-30 09:10:28 +00:00
parent 1077fa1f30
commit 1172539a95
11 changed files with 118 additions and 145 deletions
Download Patch File Download Diff File Expand all files Collapse all files

57
src-3.0/PGF.hs
View File

@@ -109,30 +109,32 @@ generateRandom mgr cat = do
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
readTree s = case RP.readP_to_S (pExp False) s of
[(x,"")] -> x
_ -> error "no parse"
pExps :: RP.ReadP [Exp]
pExps = liftM2 (:) (pExp 1) pExps RP.<++ (RP.skipSpaces >> return [])
pExps = liftM2 (:) (pExp True) pExps RP.<++ (RP.skipSpaces >> return [])
pExp :: Int -> RP.ReadP Exp
pExp n = RP.skipSpaces >> (pParen RP.<++ pApp RP.<++ pNum RP.<++ pStr RP.<++ pMeta)
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 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 '"'))
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 (DTr [] (AF (read (x++"."++y))) []))
((RP.char '.' >> RP.munch1 isDigit >>= \y -> return (EFloat (read (x++"."++y))))
RP.<++
(return (DTr [] (AI (read x)) [])))
(return (EInt (read x))))
pMeta = do RP.char '?'
x <- RP.munch1 isDigit
return (DTr [] (AM (read x)) [])
return (EMeta (read x))
pIdent = fmap mkCId (liftM2 (:) (RP.satisfy isIdentFirst) (RP.munch isIdentRest))
isIdentFirst c = c == '_' || isLetter c
@@ -141,23 +143,20 @@ pExp n = RP.skipSpaces >> (pParen RP.<++ pApp RP.<++ pNum RP.<++ pStr RP.<++ pMe
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 "->"
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
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)
ppParens True = PP.parens
ppParens False = id
abstractName mgr = prCId (absname (gfcc mgr))