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

"Committed_by_peb"

Browse Source
This commit is contained in:
peb
2005-04-14 17:38:36 +00:00
parent b63b29a247
commit 95c6e8a58f
11 changed files with 302 additions and 97 deletions
Download Patch File Download Diff File Expand all files Collapse all files

58
src/GF/CFGM/PrintCFGrammar.hs
View File

@@ -5,9 +5,9 @@
-- Stability : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/04/11 13:53:38 $
-- > CVS $Date: 2005/04/14 18:38:36 $
-- > CVS $Author: peb $
-- > CVS $Revision: 1.13 $
-- > CVS $Revision: 1.14 $
--
-- Handles printing a CFGrammar in CFGM format.
-----------------------------------------------------------------------------
@@ -19,12 +19,20 @@ import qualified PrintCFG
import Ident
import GFC
import Modules
import qualified GF.OldParsing.ConvertGrammar as Cnv
import qualified GF.Printing.PrintParser as Prt
import qualified GF.OldParsing.CFGrammar as CFGrammar
import qualified GF.OldParsing.GrammarTypes as GT
-- import qualified GF.OldParsing.ConvertGrammar as Cnv
-- import qualified GF.Printing.PrintParser as Prt
-- import qualified GF.OldParsing.CFGrammar as CFGrammar
-- import qualified GF.OldParsing.GrammarTypes as GT
-- import qualified AbsCFG
-- import qualified GF.OldParsing.Utilities as Parser
import qualified GF.Conversion.GFC as Cnv
import GF.Infra.Print (prt)
import GF.Formalism.CFG (CFRule(..))
import qualified GF.Conversion.Types as GT
import qualified AbsCFG
import qualified GF.OldParsing.Utilities as Parser
import GF.Formalism.Utilities (Symbol(..))
import ErrM
import qualified Option
@@ -48,8 +56,9 @@ getFlag fs x = listToMaybe [v | Flg (IC k) (IC v) <- fs, k == x]
-- | OBS! Should use 'ShellState.statePInfo' or 'ShellState.pInfos'
-- instead of 'Cnv.pInfo' (which recalculates the grammar every time)
prLangAsCFGM :: CanonGrammar -> Ident -> Maybe String -> String
prLangAsCFGM gr i start = prCFGrammarAsCFGM (Cnv.cfg (Cnv.pInfo opts gr i)) i start
where opts = Option.Opts [Option.gfcConversion "nondet"]
prLangAsCFGM gr i start = prCFGrammarAsCFGM (Cnv.gfc2cfg (gr, i)) i start
-- prLangAsCFGM gr i start = prCFGrammarAsCFGM (Cnv.cfg (Cnv.pInfo opts gr i)) i start
-- where opts = Option.Opts [Option.gfcConversion "nondet"]
{-
prCFGrammarAsCFGM :: GT.CFGrammar -> Ident -> Maybe String -> String
@@ -57,21 +66,21 @@ prCFGrammarAsCFGM gr i@(IC lang) start = (header . startcat . rules . footer) ""
where
header = showString "grammar " . showString lang . showString "\n"
startcat = maybe id (\s -> showString "startcat " . showString (s++"{}.s") . showString ";\n") start
rules0 = map Prt.prt gr
rules0 = map prt gr
rules = showString $ concat $ map (\l -> init l++";\n") rules0
footer = showString "end grammar\n"
-}
prCFGrammarAsCFGM :: GT.CFGrammar -> Ident -> Maybe String -> String
prCFGrammarAsCFGM :: GT.CGrammar -> Ident -> Maybe String -> String
prCFGrammarAsCFGM gr i start = PrintCFG.printTree $ cfGrammarToCFGM gr i start
cfGrammarToCFGM :: GT.CFGrammar -> Ident -> Maybe String -> AbsCFG.Grammar
cfGrammarToCFGM :: GT.CGrammar -> Ident -> Maybe String -> AbsCFG.Grammar
cfGrammarToCFGM gr i start = AbsCFG.Grammar (identToCFGMIdent i) flags (map ruleToCFGMRule gr)
where flags = maybe [] (\c -> [AbsCFG.StartCat $ strToCFGMCat (c++"{}.s")]) start
ruleToCFGMRule :: GT.CFRule -> AbsCFG.Rule
ruleToCFGMRule :: GT.CRule -> AbsCFG.Rule
-- new version, without the MCFName constructor:
ruleToCFGMRule (CFGrammar.Rule c rhs (GT.CFName fun profile))
ruleToCFGMRule (CFRule c rhs (GT.Name fun profile))
= AbsCFG.Rule fun' p' c' rhs'
where
fun' = identToFun fun
@@ -84,17 +93,20 @@ ruleToCFGMRule (CFGrammar.Rule c rhs (GT.CFName (GT.MCFName fun cat args) lbl pr
= AbsCFG.Rule fun' n' p' c' rhs'
where
fun' = identToCFGMIdent fun
n' = strToCFGMName (Prt.prt cat ++ concat [ "/" ++ Prt.prt arg | arg <- args ] ++ Prt.prt lbl)
n' = strToCFGMName (prt cat ++ concat [ "/" ++ prt arg | arg <- args ] ++ prt lbl)
p' = profileToCFGMProfile profile
c' = catToCFGMCat c
rhs' = map symbolToGFCMSymbol rhs
-}
profileToCFGMProfile :: GT.CFProfile -> AbsCFG.Profile
profileToCFGMProfile = AbsCFG.Profile . map (AbsCFG.Ints . map fromIntegral)
profileToCFGMProfile :: [GT.Profile a] -> AbsCFG.Profile
profileToCFGMProfile = AbsCFG.Profile . map cnvProfile
where cnvProfile (GT.Unify ns) = AbsCFG.Ints $ map fromIntegral ns
cnvProfile (GT.Constant a) = AbsCFG.Ints []
-- this should be replaced with a new constructor in 'AbsCFG'
identToCFGMIdent :: Ident -> AbsCFG.Ident
identToCFGMIdent = AbsCFG.Ident . Prt.prt
identToCFGMIdent = AbsCFG.Ident . prt
identToFun :: Ident -> AbsCFG.Fun
identToFun IW = AbsCFG.Coerce
@@ -103,12 +115,12 @@ identToFun i = AbsCFG.Cons (identToCFGMIdent i)
strToCFGMCat :: String -> AbsCFG.Category
strToCFGMCat = AbsCFG.Category . AbsCFG.SingleQuoteString . quoteSingle
catToCFGMCat :: GT.CFCat -> AbsCFG.Category
catToCFGMCat = strToCFGMCat . Prt.prt
catToCFGMCat :: GT.CCat -> AbsCFG.Category
catToCFGMCat = strToCFGMCat . prt
symbolToGFCMSymbol :: Parser.Symbol GT.CFCat GT.Tokn -> AbsCFG.Symbol
symbolToGFCMSymbol (Parser.Cat c) = AbsCFG.CatS (catToCFGMCat c)
symbolToGFCMSymbol (Parser.Tok t) = AbsCFG.TermS (Prt.prt t)
symbolToGFCMSymbol :: Symbol GT.CCat GT.Token -> AbsCFG.Symbol
symbolToGFCMSymbol (Cat c) = AbsCFG.CatS (catToCFGMCat c)
symbolToGFCMSymbol (Tok t) = AbsCFG.TermS (prt t)
quoteSingle :: String -> String
quoteSingle s = "'" ++ escapeSingle s ++ "'"