summaryrefslogtreecommitdiff
path: root/src/PGF
diff options
context:
space:
mode:
Diffstat (limited to 'src/PGF')
-rw-r--r--src/PGF/CId.hs33
-rw-r--r--src/PGF/Expr.hs9
-rw-r--r--src/PGF/Type.hs8
3 files changed, 35 insertions, 15 deletions
diff --git a/src/PGF/CId.hs b/src/PGF/CId.hs
index 161529308..99325975e 100644
--- a/src/PGF/CId.hs
+++ b/src/PGF/CId.hs
@@ -1,10 +1,17 @@
-module PGF.CId (CId(..), wildCId, mkCId, prCId) where
+module PGF.CId (CId(..),
+ mkCId, readCId, prCId,
+ wildCId,
+ pCId, pIdent) where
+
+import Control.Monad
+import qualified Data.ByteString.Char8 as BS
+import Data.Char
+import qualified Text.ParserCombinators.ReadP as RP
-import Data.ByteString.Char8 as BS
-- | An abstract data type that represents
-- function identifier in PGF.
-newtype CId = CId BS.ByteString deriving (Eq,Ord,Show)
+newtype CId = CId BS.ByteString deriving (Eq,Ord)
wildCId :: CId
wildCId = CId (BS.singleton '_')
@@ -13,6 +20,26 @@ wildCId = CId (BS.singleton '_')
mkCId :: String -> CId
mkCId s = CId (BS.pack s)
+readCId :: String -> Maybe CId
+readCId s = case [x | (x,cs) <- RP.readP_to_S pCId s, all isSpace cs] of
+ [x] -> Just x
+ _ -> Nothing
+
-- | Renders the identifier as 'String'
prCId :: CId -> String
prCId (CId x) = BS.unpack x
+
+instance Show CId where
+ showsPrec _ = showString . prCId
+
+instance Read CId where
+ readsPrec _ = RP.readP_to_S pCId
+
+pCId :: RP.ReadP CId
+pCId = fmap mkCId pIdent
+
+pIdent :: RP.ReadP String
+pIdent = liftM2 (:) (RP.satisfy isIdentFirst) (RP.munch isIdentRest)
+ where
+ isIdentFirst c = c == '_' || isLetter c
+ isIdentRest c = c == '_' || c == '\'' || isAlphaNum c \ No newline at end of file
diff --git a/src/PGF/Expr.hs b/src/PGF/Expr.hs
index 0dde19310..3b8ec01bc 100644
--- a/src/PGF/Expr.hs
+++ b/src/PGF/Expr.hs
@@ -10,7 +10,7 @@ module PGF.Expr(Tree(..), Literal(..),
Value(..), Env, eval, apply,
-- helpers
- pIdent,pStr,pFactor
+ pStr,pFactor
) where
import PGF.CId
@@ -145,13 +145,6 @@ 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)
- where
- isIdentFirst c = c == '_' || isLetter c
- isIdentRest c = c == '_' || c == '\'' || isAlphaNum c
-
-----------------------------------------------------
-- Printing
diff --git a/src/PGF/Type.hs b/src/PGF/Type.hs
index 9ec5b3022..fec8c0ff2 100644
--- a/src/PGF/Type.hs
+++ b/src/PGF/Type.hs
@@ -49,18 +49,18 @@ pType = do
RP.<++
(RP.between (RP.char '(') (RP.char ')') $ do
var <- RP.option wildCId $ do
- v <- pIdent
+ v <- pCId
RP.skipSpaces
RP.string ":"
- return (mkCId v)
+ return v
ty <- pType
return (Hyp var ty))
pAtom = do
- cat <- pIdent
+ cat <- pCId
RP.skipSpaces
args <- RP.sepBy pFactor RP.skipSpaces
- return (mkCId cat, args)
+ return (cat, args)
ppType :: Int -> Type -> PP.Doc
ppType d (DTyp ctxt cat args)