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

Updated to simple CFGM grammar, use CFGM pretty printer when printing cfgm grammars.

Browse Source
This commit is contained in:
bringert
2004-09-29 15:53:46 +00:00
parent df2c63c559
commit 7492cfd236
8 changed files with 273 additions and 557 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -2,11 +2,17 @@
module PrintCFGrammar (prCanonAsCFGM) where
import AbsGFC
import qualified PrintCFG
import Ident
import GFC
import Modules
import qualified ConvertGrammar as Cnv
import qualified PrintParser as Prt
import qualified CFGrammar
import qualified GrammarTypes as GT
import qualified AbsCFG
import qualified Parser
import qualified PrintParser
import ErrM
import List (intersperse)
@@ -28,11 +34,55 @@ getFlag :: [Flag] -> String -> Maybe String
getFlag fs x = listToMaybe [v | Flg (IC k) (IC v) <- fs, k == x]
prLangAsCFGM :: CanonGrammar -> Ident -> Maybe String -> String
prLangAsCFGM gr i@(IC lang) start = (header . startcat . rules . footer) ""
prLangAsCFGM gr i start = prCFGrammarAsCFGM (Cnv.cfg (Cnv.pInfo gr i)) i start
{-
prCFGrammarAsCFGM :: GT.CFGrammar -> Ident -> Maybe String -> String
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 $ Cnv.cfg $ Cnv.pInfo gr i
rules = showString $ concat $ map (\l -> init l++";\n") rules0
rules0 = map Prt.prt gr
rules = showString $ concat $ map (\l -> init l++";\n") rules0
footer = showString "end grammar\n"
-}
prCFGrammarAsCFGM :: GT.CFGrammar -> Ident -> Maybe String -> String
prCFGrammarAsCFGM gr i start = PrintCFG.printTree $ cfGrammarToCFGM gr i start
cfGrammarToCFGM :: GT.CFGrammar -> 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 (CFGrammar.Rule c rhs (GT.CFName (GT.MCFName fun cat args) lbl profile))
= 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)
p' = profileToCFGMProfile profile
c' = catToCFGMCat c
rhs' = map symbolToGFCMSymbol rhs
profileToCFGMProfile :: GT.CFProfile -> AbsCFG.Profile
profileToCFGMProfile = AbsCFG.Profile . map (AbsCFG.Ints . map fromIntegral)
identToCFGMIdent :: Ident -> AbsCFG.Ident
identToCFGMIdent = AbsCFG.Ident . Prt.prt
strToCFGMCat :: String -> AbsCFG.Category
strToCFGMCat = AbsCFG.Category . AbsCFG.SingleQuoteString . quoteSingle
catToCFGMCat :: GT.CFCat -> AbsCFG.Category
catToCFGMCat = strToCFGMCat . Prt.prt
strToCFGMName :: String -> AbsCFG.Name
strToCFGMName = AbsCFG.Name . AbsCFG.SingleQuoteString . quoteSingle
symbolToGFCMSymbol :: Parser.Symbol GT.CFCat GT.Token -> AbsCFG.Symbol
symbolToGFCMSymbol (Parser.Cat c) = AbsCFG.CatS (catToCFGMCat c)
symbolToGFCMSymbol (Parser.Tok t) = AbsCFG.TermS (Prt.prt t)
quoteSingle :: String -> String
quoteSingle s = "'" ++ escapeSingle s ++ "'"
where escapeSingle = concatMap (\c -> if c == '\'' then "\\'" else [c])