1
0
forked from GitHub/gf-core

Added Read and Show instances for CId. Also added readCId :: String -> Maybe CId, and use that for readLanguage.

This commit is contained in:
bjorn
2008-10-20 11:59:31 +00:00
parent 0c442d9ac9
commit 335a8d6977
5 changed files with 39 additions and 18 deletions

View File

@@ -1,5 +1,6 @@
module GF.Command.Parse(readCommandLine, pCommand) where module GF.Command.Parse(readCommandLine, pCommand) where
import PGF.CId
import PGF.Expr import PGF.Expr
import PGF.Data(Tree) import PGF.Data(Tree)
import GF.Command.Abstract import GF.Command.Abstract

View File

@@ -77,7 +77,7 @@ import qualified PGF.Parsing.FCFG.Incremental as Incremental
import GF.Text.UTF8 import GF.Text.UTF8
import GF.Data.ErrM import GF.Data.ErrM
import GF.Data.Utilities import GF.Data.Utilities (replace)
import Data.Char import Data.Char
import qualified Data.Map as Map import qualified Data.Map as Map
@@ -98,7 +98,7 @@ import Control.Monad
-- > concrete LangEng of Lang = ... -- > concrete LangEng of Lang = ...
type Language = CId type Language = CId
readLanguage :: String -> Language readLanguage :: String -> Maybe Language
showLanguage :: Language -> String showLanguage :: Language -> String
@@ -207,7 +207,7 @@ complete :: PGF -> Language -> Type -> String
-- Implementation -- Implementation
--------------------------------------------------- ---------------------------------------------------
readLanguage = mkCId readLanguage = readCId
showLanguage = prCId showLanguage = prCId

View File

@@ -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 -- | An abstract data type that represents
-- function identifier in PGF. -- 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
wildCId = CId (BS.singleton '_') wildCId = CId (BS.singleton '_')
@@ -13,6 +20,26 @@ wildCId = CId (BS.singleton '_')
mkCId :: String -> CId mkCId :: String -> CId
mkCId s = CId (BS.pack s) 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' -- | Renders the identifier as 'String'
prCId :: CId -> String prCId :: CId -> String
prCId (CId x) = BS.unpack x 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

View File

@@ -10,7 +10,7 @@ module PGF.Expr(Tree(..), Literal(..),
Value(..), Env, eval, apply, Value(..), Env, eval, apply,
-- helpers -- helpers
pIdent,pStr,pFactor pStr,pFactor
) where ) where
import PGF.CId import PGF.CId
@@ -145,13 +145,6 @@ pStr = RP.char '"' >> (RP.manyTill (pEsc RP.<++ RP.get) (RP.char '"'))
where where
pEsc = RP.char '\\' >> RP.get 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 -- Printing

View File

@@ -49,18 +49,18 @@ pType = do
RP.<++ RP.<++
(RP.between (RP.char '(') (RP.char ')') $ do (RP.between (RP.char '(') (RP.char ')') $ do
var <- RP.option wildCId $ do var <- RP.option wildCId $ do
v <- pIdent v <- pCId
RP.skipSpaces RP.skipSpaces
RP.string ":" RP.string ":"
return (mkCId v) return v
ty <- pType ty <- pType
return (Hyp var ty)) return (Hyp var ty))
pAtom = do pAtom = do
cat <- pIdent cat <- pCId
RP.skipSpaces RP.skipSpaces
args <- RP.sepBy pFactor RP.skipSpaces args <- RP.sepBy pFactor RP.skipSpaces
return (mkCId cat, args) return (cat, args)
ppType :: Int -> Type -> PP.Doc ppType :: Int -> Type -> PP.Doc
ppType d (DTyp ctxt cat args) ppType d (DTyp ctxt cat args)