msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

system command pipes (sp)

Browse Source
This commit is contained in:
aarne
2008-06-18 16:26:12 +00:00
parent 8201f59aeb
commit 0442d67e8c
4 changed files with 39 additions and 7 deletions
Download Patch File Download Diff File Expand all files Collapse all files

12
src-3.0/PGF/ExprSyntax.hs
View File

@@ -2,7 +2,7 @@ module PGF.ExprSyntax(readExp, showExp,
pExp,ppExp,
-- helpers
pIdent
pIdent,pStr
) where
import PGF.CId
@@ -28,7 +28,8 @@ 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)
pExp isNested = RP.skipSpaces >> (pParen RP.<++ pAbs RP.<++ pApp RP.<++ pNum RP.<++
liftM EStr 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 >> pCId) (RP.skipSpaces >> RP.char ','))
@@ -40,14 +41,15 @@ pExp isNested = RP.skipSpaces >> (pParen RP.<++ pAbs RP.<++ pApp RP.<++ pNum RP.
pMeta = do RP.char '?'
x <- RP.munch1 isDigit
return (EMeta (read x))
pStr = RP.char '"' >> liftM EStr (RP.manyTill (pEsc RP.<++ RP.get) (RP.char '"'))
where
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))))
pStr = RP.char '"' >> (RP.manyTill (pEsc RP.<++ RP.get) (RP.char '"'))
where
pEsc = RP.char '\\' >> RP.get
pCId = fmap mkCId pIdent
pIdent = liftM2 (:) (RP.satisfy isIdentFirst) (RP.munch isIdentRest)