refactored FCFG parsing to fit in GFCC shell

This commit is contained in:
aarne
2007-09-20 09:10:37 +00:00
parent ef389db569
commit 3707eb4576
18 changed files with 197 additions and 161 deletions

View File

@@ -1,8 +1,8 @@
module GF.Canon.GFCC.FCFGParsing where module GF.Canon.GFCC.FCFGParsing (parserLang) where
import GF.Canon.GFCC.DataGFCC import GF.Canon.GFCC.DataGFCC
import GF.Canon.GFCC.AbsGFCC import GF.Canon.GFCC.AbsGFCC
import GF.Conversion.SimpleToFCFG (convertGrammar) import GF.Conversion.SimpleToFCFG (convertGrammarCId,FCat(..))
--import GF.System.Tracing --import GF.System.Tracing
--import GF.Infra.Print --import GF.Infra.Print
@@ -20,8 +20,9 @@ import GF.Conversion.SimpleToFCFG (convertGrammar)
import GF.Data.SortedList import GF.Data.SortedList
import GF.Data.Assoc import GF.Data.Assoc
import GF.Formalism.Utilities --(forest2trees) import GF.Formalism.Utilities --(forest2trees)
import qualified GF.Data.Operations as Op
--import GF.Conversion.Types import GF.Conversion.FTypes
import GF.Formalism.FCFG import GF.Formalism.FCFG
--import qualified GF.Formalism.GCFG as G --import qualified GF.Formalism.GCFG as G
@@ -32,16 +33,15 @@ import GF.Formalism.FCFG
import qualified GF.Parsing.FCFG as PF import qualified GF.Parsing.FCFG as PF
--import qualified GF.Parsing.CFG as PC --import qualified GF.Parsing.CFG as PC
import GF.Canon.GFCC.ErrM import GF.Canon.GFCC.ErrM
import GF.Infra.PrintClass
--convertGrammarCId :: Grammar -> [(CId,FGrammar)]
--convertGrammar :: Grammar -> [(Ident,FGrammar)] parserLang :: GFCC -> CId -> CFCat -> [CFTok] -> Err [Exp]
parserLang mgr lang = parse info where
fcfgs = convertGrammarCId mgr
info = buildPInfo $ maybe (error "no parser") id $ lookup lang fcfgs
--import qualified GF.Parsing.GFC as New
--checkErr $ New.parse algorithm strategy (pInfo sg) (absId sg) cat toks
-- algorithm "f"
-- strategy "bottomup"
type Token = String ----
type CFTok = String ---- type CFTok = String ----
type CFCat = CId ---- type CFCat = CId ----
type Fun = CId ---- type Fun = CId ----
@@ -54,6 +54,16 @@ wordsCFTok = return ----
type FCFPInfo = PF.FCFPInfo FCat FName Token type FCFPInfo = PF.FCFPInfo FCat FName Token
buildPInfo :: FGrammar -> FCFPInfo
buildPInfo fcfg = PF.buildFCFPInfo grammarLexer fcfg where
grammarLexer s =
case reads s of
[(n,"")] -> (fcatInt, SInt (n::Integer))
_ -> case reads s of
[(f,"")] -> (fcatFloat, SFloat (f::Double))
_ -> (fcatString,SString s)
-- main parsing function -- main parsing function
parse :: parse ::
@@ -65,7 +75,7 @@ parse ::
[CFTok] -> -- ^ input tokens [CFTok] -> -- ^ input tokens
Err [Exp] -- ^ resulting GF terms Err [Exp] -- ^ resulting GF terms
parse pinfo startCat inString = parse pinfo startCat inString = e2e $
do let inTokens = inputMany (map wordsCFTok inString) do let inTokens = inputMany (map wordsCFTok inString)
forests <- selectParser pinfo startCat inTokens forests <- selectParser pinfo startCat inTokens
@@ -107,7 +117,7 @@ cnv_forests2 (FFloat x) = FFloat x
-- parse trees to GFCC terms -- parse trees to GFCC terms
tree2term :: SyntaxTree Fun -> Exp tree2term :: SyntaxTree Fun -> Exp
tree2term (TNode f ts) = Tr (AC (CId f)) (map tree2term ts) tree2term (TNode f ts) = Tr (AC f) (map tree2term ts)
{- ---- {- ----
tree2term (TString s) = Macros.string2term s tree2term (TString s) = Macros.string2term s
tree2term (TInt n) = Macros.int2term n tree2term (TInt n) = Macros.int2term n
@@ -122,7 +132,7 @@ tree2term (TMeta) = Macros.mkMeta 0
-- simplest implementation -- simplest implementation
applyProfileToForest :: SyntaxForest Name -> [SyntaxForest Fun] applyProfileToForest :: SyntaxForest Name -> [SyntaxForest Fun]
applyProfileToForest (FNode name@(Name fun profile) children) applyProfileToForest (FNode name@(Name fun profile) children)
| isCoercion name = concat chForests | isCoercionF name = concat chForests
| otherwise = [ FNode fun chForests | not (null chForests) ] | otherwise = [ FNode fun chForests | not (null chForests) ]
where chForests = concat [ applyProfileM unifyManyForests profile forests | where chForests = concat [ applyProfileM unifyManyForests profile forests |
forests0 <- children, forests0 <- children,
@@ -132,40 +142,10 @@ applyProfileToForest (FInt n) = [FInt n]
applyProfileToForest (FFloat f) = [FFloat f] applyProfileToForest (FFloat f) = [FFloat f]
applyProfileToForest (FMeta) = [FMeta] applyProfileToForest (FMeta) = [FMeta]
--------------------- From parsing types ------------------------------
-- * fast nonerasing MCFG
type FIndex = Int
type FPath = [FIndex]
type FName = NameProfile CId
type FGrammar = FCFGrammar FCat FName Token
type FRule = FCFRule FCat FName Token
data FCat = FCat {-# UNPACK #-} !Int CId [FPath] [(FPath,FIndex)]
initialFCat :: CId -> FCat
initialFCat cat = FCat 0 cat [] []
fcatString = FCat (-1) (CId "String") [[0]] []
fcatInt = FCat (-2) (CId "Int") [[0]] []
fcatFloat = FCat (-3) (CId "Float") [[0]] []
fcat2cid :: FCat -> CId
fcat2cid (FCat _ c _ _) = c
instance Eq FCat where
(FCat id1 _ _ _) == (FCat id2 _ _ _) = id1 == id2
instance Ord FCat where
compare (FCat id1 _ _ _) (FCat id2 _ _ _) = compare id1 id2
--- ---
isCoercion :: Name -> Bool e2e :: Op.Err a -> Err a
isCoercion (Name fun [Unify [0]]) = False -- isWildIdent fun e2e e = case e of
isCoercion _ = False Op.Ok v -> Ok v
Op.Bad s -> Bad s
type Name = NameProfile Fun

View File

@@ -21,6 +21,7 @@ import GF.Canon.GFCC.AbsGFCC
import GF.Canon.GFCC.ParGFCC import GF.Canon.GFCC.ParGFCC
import GF.Canon.GFCC.PrintGFCC import GF.Canon.GFCC.PrintGFCC
import GF.Canon.GFCC.ErrM import GF.Canon.GFCC.ErrM
import GF.Canon.GFCC.FCFGParsing
--import GF.Data.Operations --import GF.Data.Operations
--import GF.Infra.UseIO --import GF.Infra.UseIO
import qualified Data.Map as Map import qualified Data.Map as Map
@@ -70,7 +71,9 @@ file2grammar f =
linearize mgr lang = GF.Canon.GFCC.DataGFCC.linearize mgr (CId lang) linearize mgr lang = GF.Canon.GFCC.DataGFCC.linearize mgr (CId lang)
parse mgr lang cat s = [] parse mgr lang cat s =
err error id $ parserLang mgr (CId lang) (CId cat) (words s)
{- {-
map tree2exp . map tree2exp .
errVal [] . errVal [] .

View File

@@ -0,0 +1,64 @@
module GF.Conversion.FTypes where
import qualified GF.Infra.Ident as Ident (Ident(..), wildIdent, isWildIdent)
import qualified GF.Canon.GFCC.AbsGFCC as AbsGFCC (CId(..))
import GF.Formalism.FCFG
import GF.Formalism.Utilities
import GF.Infra.PrintClass
import GF.Data.Assoc
import Control.Monad (foldM)
import Data.Array
----------------------------------------------------------------------
-- * basic (leaf) types
-- ** input tokens
---- type Token = String ---- inlined in FGrammar and FRule
----------------------------------------------------------------------
-- * fast nonerasing MCFG
type FIndex = Int
type FPath = [FIndex]
type FName = NameProfile AbsGFCC.CId
type FGrammar = FCFGrammar FCat FName String
type FRule = FCFRule FCat FName String
data FCat = FCat {-# UNPACK #-} !Int AbsGFCC.CId [FPath] [(FPath,FIndex)]
initialFCat :: AbsGFCC.CId -> FCat
initialFCat cat = FCat 0 cat [] []
fcatString = FCat (-1) (AbsGFCC.CId "String") [[0]] []
fcatInt = FCat (-2) (AbsGFCC.CId "Int") [[0]] []
fcatFloat = FCat (-3) (AbsGFCC.CId "Float") [[0]] []
fcat2cid :: FCat -> AbsGFCC.CId
fcat2cid (FCat _ c _ _) = c
instance Eq FCat where
(FCat id1 _ _ _) == (FCat id2 _ _ _) = id1 == id2
instance Ord FCat where
compare (FCat id1 _ _ _) (FCat id2 _ _ _) = compare id1 id2
instance Print AbsGFCC.CId where
prt (AbsGFCC.CId s) = s
isCoercionF :: FName -> Bool
isCoercionF (Name fun [Unify [0]]) = fun == AbsGFCC.CId "_"
isCoercionF _ = False
----------------------------------------------------------------------
-- * pretty-printing
instance Print FCat where
prt (FCat _ (AbsGFCC.CId cat) rcs tcs) = cat ++ "{" ++
prtSep ";" ([prt path | path <- rcs] ++
[prt path ++ "=" ++ prt term | (path,term) <- tcs])
++ "}"

View File

@@ -25,6 +25,7 @@ import GF.Formalism.SimpleGFC (decl2cat)
import GF.Formalism.CFG (CFRule(..)) import GF.Formalism.CFG (CFRule(..))
import GF.Formalism.Utilities (symbol, name2fun) import GF.Formalism.Utilities (symbol, name2fun)
import GF.Conversion.Types import GF.Conversion.Types
import GF.Conversion.FTypes
import qualified GF.Conversion.GFCtoSimple as G2S import qualified GF.Conversion.GFCtoSimple as G2S
import qualified GF.Conversion.SimpleToFinite as S2Fin import qualified GF.Conversion.SimpleToFinite as S2Fin

View File

@@ -13,17 +13,17 @@
module GF.Conversion.SimpleToFCFG module GF.Conversion.SimpleToFCFG
(convertGrammar) where (convertGrammar,convertGrammarCId,FCat(..)) where
import GF.System.Tracing import GF.System.Tracing
import GF.Infra.Print import GF.Infra.PrintClass
import GF.Infra.Ident import GF.Infra.Ident
import Control.Monad import Control.Monad
import GF.Formalism.Utilities import GF.Formalism.Utilities
import GF.Formalism.FCFG import GF.Formalism.FCFG
import GF.Conversion.Types import GF.Conversion.FTypes
import GF.Canon.GFCC.AbsGFCC import GF.Canon.GFCC.AbsGFCC
import GF.Canon.GFCC.DataGFCC import GF.Canon.GFCC.DataGFCC
@@ -40,17 +40,27 @@ import Data.Maybe
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- main conversion function -- main conversion function
convertGrammar :: Grammar -> [(Ident,FGrammar)] type FToken = String
convertGrammar g@(Grm hdr (Abs abs_defs) cncs) = [(i2i cncname,convert abs_defs conc) | cncname <- cncnames gfcc, conc <- Map.lookup cncname (concretes gfcc)]
convertGrammar :: Grammar -> [(Ident,FCFGrammar FCat FName FToken)]
convertGrammar g = [(IC c, f) | (CId c,f) <- convertGrammarCId (mkGFCC g)]
-- this is more native for GFCC
convertGrammarCId :: GFCC -> [(CId,FCFGrammar FCat FName FToken)]
convertGrammarCId gfcc = [(cncname,convert abs_defs conc) |
cncname <- cncnames gfcc, conc <- Map.lookup cncname (concretes gfcc)]
where where
gfcc = mkGFCC g
i2i (CId i) = IC i abs_defs = Map.assocs (funs (abstract gfcc))
convert :: [AbsDef] -> TermMap -> FGrammar convert :: [(CId,Type)] -> TermMap -> FGrammar
convert abs_defs cnc_defs = getFRules (loop frulesEnv) convert abs_defs cnc_defs = getFRules (loop frulesEnv)
where where
srules = [(XRule id args res (map findLinType args) (findLinType res) term) | Fun id (Typ args res) exp <- abs_defs, term <- Map.lookup id cnc_defs] srules = [
(XRule id args res (map findLinType args) (findLinType res) term) |
(id, Typ args res) <- abs_defs,
term <- Map.lookup id cnc_defs]
findLinType (CId id) = fromJust (Map.lookup (CId ("__"++id)) cnc_defs) findLinType (CId id) = fromJust (Map.lookup (CId ("__"++id)) cnc_defs)
@@ -119,7 +129,7 @@ translateLin idxArgs lbl' ((lbl,syms) : lins)
type CnvMonad a = BacktrackM Env a type CnvMonad a = BacktrackM Env a
type Env = (FCat, [(FCat,[FPath])], Term, [Term]) type Env = (FCat, [(FCat,[FPath])], Term, [Term])
type LinRec = [(FPath, [Symbol (FPath, FIndex, Int) Token])] type LinRec = [(FPath, [Symbol (FPath, FIndex, Int) FToken])]
type TermMap = Map.Map CId Term type TermMap = Map.Map CId Term

View File

@@ -14,6 +14,8 @@
module GF.Conversion.Types where module GF.Conversion.Types where
---import GF.Conversion.FTypes
import qualified GF.Infra.Ident as Ident (Ident(..), wildIdent, isWildIdent) import qualified GF.Infra.Ident as Ident (Ident(..), wildIdent, isWildIdent)
import qualified GF.Canon.AbsGFC as AbsGFC (CIdent(..), Label(..)) import qualified GF.Canon.AbsGFC as AbsGFC (CIdent(..), Label(..))
import qualified GF.Canon.GFCC.AbsGFCC as AbsGFCC (CId(..)) import qualified GF.Canon.GFCC.AbsGFCC as AbsGFCC (CId(..))
@@ -110,31 +112,8 @@ mcat2scat = ecat2scat . mcat2ecat
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- * fast nonerasing MCFG -- * fast nonerasing MCFG
type FIndex = Int ---- moved to FTypes by AR 20/9/2007
type FPath = [FIndex]
type FName = NameProfile AbsGFCC.CId
type FGrammar = FCFGrammar FCat FName Token
type FRule = FCFRule FCat FName Token
data FCat = FCat {-# UNPACK #-} !Int AbsGFCC.CId [FPath] [(FPath,FIndex)]
initialFCat :: AbsGFCC.CId -> FCat
initialFCat cat = FCat 0 cat [] []
fcatString = FCat (-1) (AbsGFCC.CId "String") [[0]] []
fcatInt = FCat (-2) (AbsGFCC.CId "Int") [[0]] []
fcatFloat = FCat (-3) (AbsGFCC.CId "Float") [[0]] []
fcat2cid :: FCat -> AbsGFCC.CId
fcat2cid (FCat _ c _ _) = c
instance Eq FCat where
(FCat id1 _ _ _) == (FCat id2 _ _ _) = id1 == id2
instance Ord FCat where
compare (FCat id1 _ _ _) (FCat id2 _ _ _) = compare id1 id2
instance Print AbsGFCC.CId where
prt (AbsGFCC.CId s) = s
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- * CFG -- * CFG
@@ -163,9 +142,5 @@ instance Print MCat where
instance Print CCat where instance Print CCat where
prt (CCat cat label) = prt cat ++ prt label prt (CCat cat label) = prt cat ++ prt label
instance Print FCat where ---- instance Print FCat where ---- FCat
prt (FCat _ (AbsGFCC.CId cat) rcs tcs) = cat ++ "{" ++
prtSep ";" ([prt path | path <- rcs] ++
[prt path ++ "=" ++ prt term | (path,term) <- tcs])
++ "}"

View File

@@ -11,7 +11,7 @@ module GF.FCFG.ToFCFG (printFGrammar) where
import GF.Formalism.FCFG import GF.Formalism.FCFG
import GF.Formalism.SimpleGFC import GF.Formalism.SimpleGFC
import GF.Conversion.Types import GF.Conversion.FTypes
import GF.Infra.Ident import GF.Infra.Ident
import qualified GF.FCFG.AbsFCFG as F import qualified GF.FCFG.AbsFCFG as F
@@ -28,22 +28,23 @@ import GF.Formalism.GCFG
import GF.Infra.Print import GF.Infra.Print
type FToken = String
-- this is the main function used -- this is the main function used
printFGrammar :: FCFGrammar FCat FName Token -> String printFGrammar :: FCFGrammar FCat FName FToken -> String
printFGrammar = undefined {- printTree . fgrammar printFGrammar = undefined {- printTree . fgrammar
fgrammar :: FCFGrammar FCat Name Token -> F.FGrammar fgrammar :: FCFGrammar FCat Name FToken -> F.FGrammar
fgrammar = F.FGr . map frule fgrammar = F.FGr . map frule
frule :: FCFRule FCat Name Token -> F.FRule frule :: FCFRule FCat Name FToken -> F.FRule
frule (FRule ab rhs) = frule (FRule ab rhs) =
F.FR (abstract ab) [[fsymbol sym | (_,sym) <- assocs syms] | (_,syms) <- assocs rhs] F.FR (abstract ab) [[fsymbol sym | (_,sym) <- assocs syms] | (_,syms) <- assocs rhs]
abstract :: Abstract FCat Name -> F.Abstract abstract :: Abstract FCat Name -> F.Abstract
abstract (Abs cat cats n) = F.Abs (fcat cat) (map fcat cats) (name n) abstract (Abs cat cats n) = F.Abs (fcat cat) (map fcat cats) (name n)
fsymbol :: FSymbol FCat Token -> F.FSymbol fsymbol :: FSymbol FCat FToken -> F.FSymbol
fsymbol fs = case fs of fsymbol fs = case fs of
FSymCat fc i j -> F.FSymCat (fcat fc) (toInteger i) (toInteger j) FSymCat fc i j -> F.FSymCat (fcat fc) (toInteger i) (toInteger j)
FSymTok s -> F.FSymTok s FSymTok s -> F.FSymTok s
@@ -56,7 +57,7 @@ fcat (FCat i id ps pts) =
name :: Name -> F.Name name :: Name -> F.Name
name (Name id profs) = F.Nm (ident id) (map profile profs) name (Name id profs) = F.Nm (ident id) (map profile profs)
pathel :: Either C.Label (Term SCat Token) -> F.PathEl pathel :: Either C.Label (Term SCat FToken) -> F.PathEl
pathel lt = case lt of pathel lt = case lt of
Left lab -> F.PLabel $ label lab Left lab -> F.PLabel $ label lab
Right trm -> F.PTerm $ term trm Right trm -> F.PTerm $ term trm
@@ -76,7 +77,7 @@ forest f = case f of
FInt i -> F.FInt i FInt i -> F.FInt i
FFloat d -> F.FFloat d FFloat d -> F.FFloat d
term :: Term SCat Token -> F.Term term :: Term SCat FToken -> F.Term
term tr = case tr of term tr = case tr of
Arg i id p -> F.Arg (toInteger i) (ident id) (path p) Arg i id p -> F.Arg (toInteger i) (ident id) (path p)
Rec rs -> F.Rec [F.Ass (label l) (term t) | (l,t) <- rs] Rec rs -> F.Rec [F.Ass (label l) (term t) | (l,t) <- rs]

View File

@@ -14,9 +14,9 @@ import Data.List (groupBy)
import Data.Array import Data.Array
import GF.Formalism.Utilities import GF.Formalism.Utilities
import GF.Formalism.GCFG --import GF.Formalism.GCFG
import GF.Infra.Print import GF.Infra.PrintClass
------------------------------------------------------------ ------------------------------------------------------------

View File

@@ -16,7 +16,7 @@ module GF.Formalism.GCFG where
import GF.Formalism.Utilities (SyntaxChart) import GF.Formalism.Utilities (SyntaxChart)
import GF.Data.Assoc (assocMap, accumAssoc) import GF.Data.Assoc (assocMap, accumAssoc)
import GF.Data.SortedList (nubsort, groupPairs) import GF.Data.SortedList (nubsort, groupPairs)
import GF.Infra.Print import GF.Infra.PrintClass
---------------------------------------------------------------------- ----------------------------------------------------------------------

View File

@@ -19,7 +19,7 @@ import Data.List (groupBy)
import GF.Formalism.Utilities import GF.Formalism.Utilities
import GF.Formalism.GCFG import GF.Formalism.GCFG
import GF.Infra.Print import GF.Infra.PrintClass
------------------------------------------------------------ ------------------------------------------------------------

View File

@@ -22,7 +22,7 @@ import GF.Data.SortedList
import GF.Data.Assoc import GF.Data.Assoc
import GF.Data.Utilities (sameLength, foldMerge, splitBy) import GF.Data.Utilities (sameLength, foldMerge, splitBy)
import GF.Infra.Print import GF.Infra.PrintClass
------------------------------------------------------------ ------------------------------------------------------------
-- * symbols -- * symbols

View File

@@ -12,16 +12,14 @@
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module GF.Infra.Print module GF.Infra.Print
(Print(..), (module GF.Infra.PrintClass
prtBefore, prtAfter, prtSep,
prtBeforeAfter, prtPairList,
prIO
) where ) where
-- haskell modules: -- haskell modules:
import Data.List (intersperse)
import Data.Char (toUpper) import Data.Char (toUpper)
-- gf modules: -- gf modules:
import GF.Infra.PrintClass
import GF.Data.Operations (Err(..)) import GF.Data.Operations (Err(..))
import GF.Infra.Ident (Ident(..)) import GF.Infra.Ident (Ident(..))
import GF.Canon.AbsGFC import GF.Canon.AbsGFC
@@ -31,59 +29,6 @@ import qualified GF.Canon.PrintGFC as P
------------------------------------------------------------ ------------------------------------------------------------
prtBefore :: Print a => String -> [a] -> String
prtBefore before = prtBeforeAfter before ""
prtAfter :: Print a => String -> [a] -> String
prtAfter after = prtBeforeAfter "" after
prtSep :: Print a => String -> [a] -> String
prtSep sep = concat . intersperse sep . map prt
prtBeforeAfter :: Print a => String -> String -> [a] -> String
prtBeforeAfter before after as = concat [ before ++ prt a ++ after | a <- as ]
prtPairList :: (Print a, Print b) => String -> String -> [(a,b)] -> String
prtPairList comma sep xys = prtSep sep [ prt x ++ comma ++ prt y | (x,y) <- xys ]
prIO :: Print a => a -> IO ()
prIO = putStr . prt
class Print a where
prt :: a -> String
prtList :: [a] -> String
prtList as = "[" ++ prtSep "," as ++ "]"
instance Print a => Print [a] where
prt = prtList
instance (Print a, Print b) => Print (a, b) where
prt (a, b) = "(" ++ prt a ++ "," ++ prt b ++ ")"
instance (Print a, Print b, Print c) => Print (a, b, c) where
prt (a, b, c) = "(" ++ prt a ++ "," ++ prt b ++ "," ++ prt c ++ ")"
instance (Print a, Print b, Print c, Print d) => Print (a, b, c, d) where
prt (a, b, c, d) = "(" ++ prt a ++ "," ++ prt b ++ "," ++ prt c ++ "," ++ prt d ++ ")"
instance Print Char where
prt = return
prtList = id
instance Print Int where
prt = show
instance Print Integer where
prt = show
instance Print a => Print (Maybe a) where
prt (Just a) = prt a
prt Nothing = "Nothing"
instance Print a => Print (Err a) where
prt (Ok a) = prt a
prt (Bad str) = str
---------------------------------------------------------------------- ----------------------------------------------------------------------
instance Print Ident where instance Print Ident where

View File

@@ -0,0 +1,56 @@
module GF.Infra.PrintClass where
import Data.List (intersperse)
import GF.Data.Operations (Err(..))
class Print a where
prt :: a -> String
prtList :: [a] -> String
prtList as = "[" ++ prtSep "," as ++ "]"
prtSep :: Print a => String -> [a] -> String
prtSep sep = concat . intersperse sep . map prt
prtBefore :: Print a => String -> [a] -> String
prtBefore before = prtBeforeAfter before ""
prtAfter :: Print a => String -> [a] -> String
prtAfter after = prtBeforeAfter "" after
prtBeforeAfter :: Print a => String -> String -> [a] -> String
prtBeforeAfter before after as = concat [ before ++ prt a ++ after | a <- as ]
prtPairList :: (Print a, Print b) => String -> String -> [(a,b)] -> String
prtPairList comma sep xys = prtSep sep [ prt x ++ comma ++ prt y | (x,y) <- xys ]
prIO :: Print a => a -> IO ()
prIO = putStr . prt
instance Print a => Print [a] where
prt = prtList
instance (Print a, Print b) => Print (a, b) where
prt (a, b) = "(" ++ prt a ++ "," ++ prt b ++ ")"
instance (Print a, Print b, Print c) => Print (a, b, c) where
prt (a, b, c) = "(" ++ prt a ++ "," ++ prt b ++ "," ++ prt c ++ ")"
instance (Print a, Print b, Print c, Print d) => Print (a, b, c, d) where
prt (a, b, c, d) = "(" ++ prt a ++ "," ++ prt b ++ "," ++ prt c ++ "," ++ prt d ++ ")"
instance Print Char where
prt = return
prtList = id
instance Print Int where
prt = show
instance Print Integer where
prt = show
instance Print a => Print (Maybe a) where
prt (Just a) = prt a
prt Nothing = "Nothing"
instance Print a => Print (Err a) where
prt (Ok a) = prt a
prt (Bad str) = str

View File

@@ -18,7 +18,7 @@ import GF.Formalism.MCFG
import GF.Parsing.FCFG.PInfo import GF.Parsing.FCFG.PInfo
import qualified GF.Parsing.FCFG.Active as Active import qualified GF.Parsing.FCFG.Active as Active
import GF.Infra.Print import GF.Infra.PrintClass
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- parsing -- parsing

View File

@@ -20,7 +20,7 @@ import GF.Formalism.MCFG(Lin(..))
import GF.Formalism.Utilities import GF.Formalism.Utilities
import GF.Infra.Ident import GF.Infra.Ident
import GF.Infra.Print import GF.Infra.PrintClass
import GF.Parsing.FCFG.Range import GF.Parsing.FCFG.Range
import GF.Parsing.FCFG.PInfo import GF.Parsing.FCFG.PInfo

View File

@@ -10,7 +10,7 @@
module GF.Parsing.FCFG.PInfo where module GF.Parsing.FCFG.PInfo where
import GF.System.Tracing import GF.System.Tracing
import GF.Infra.Print import GF.Infra.PrintClass
import GF.Formalism.Utilities import GF.Formalism.Utilities
import GF.Formalism.GCFG import GF.Formalism.GCFG

View File

@@ -14,7 +14,7 @@ module GF.Parsing.FCFG.Range
-- GF modules -- GF modules
import GF.Formalism.Utilities import GF.Formalism.Utilities
import GF.Infra.Print import GF.Infra.PrintClass
------------------------------------------------------------ ------------------------------------------------------------
-- ranges as single pairs -- ranges as single pairs

View File

@@ -32,6 +32,7 @@ import GF.Data.SortedList
import GF.Data.Assoc import GF.Data.Assoc
import GF.Formalism.Utilities import GF.Formalism.Utilities
import GF.Conversion.Types import GF.Conversion.Types
import GF.Conversion.FTypes
import qualified GF.Formalism.GCFG as G import qualified GF.Formalism.GCFG as G
import qualified GF.Formalism.SimpleGFC as S import qualified GF.Formalism.SimpleGFC as S