GF/src is now for 2.9, and the new sources are in src-3.0 - keep it this way until the release of GF 3

2026-05-09 11:12:51 -06:00 · 2008-05-21 09:26:44 +00:00
parent 915a1de717
commit 055c0d0d5a
536 changed files with 0 additions and 0 deletions
--- a/src-3.0/GF/CFGM/PrintCFGrammar.hs
+++ b/src-3.0/GF/CFGM/PrintCFGrammar.hs
@@ -0,0 +1,113 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : PrintCFGrammar
+-- Maintainer  : BB
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/05/17 14:04:38 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.20 $
+--
+-- Handles printing a CFGrammar in CFGM format.
+-----------------------------------------------------------------------------
+
+module GF.CFGM.PrintCFGrammar (prCanonAsCFGM) where
+
+import GF.Canon.AbsGFC
+import qualified GF.CFGM.PrintCFG as PrintCFG
+import GF.Infra.Ident
+import GF.Canon.GFC
+import GF.Infra.Modules
+
+import qualified GF.Conversion.GFC as Cnv
+import GF.Infra.Print (prt)
+import GF.Formalism.CFG (CFRule(..))
+import qualified GF.Formalism.Utilities as GU
+import qualified GF.Conversion.Types as GT
+import qualified GF.CFGM.AbsCFG as AbsCFG
+import GF.Formalism.Utilities (Symbol(..))
+
+import GF.Data.ErrM
+import GF.Data.Utilities (compareBy)
+import qualified GF.Infra.Option as Option
+
+import Data.List (intersperse, sortBy)
+import Data.Maybe (listToMaybe, maybeToList, maybe)
+
+import GF.Infra.Print
+import GF.System.Tracing
+
+-- | FIXME: should add an Options argument,
+-- to be able to decide which CFG conversion one wants to use
+prCanonAsCFGM :: Option.Options -> CanonGrammar -> String
+prCanonAsCFGM opts gr = unlines $ map (prLangAsCFGM gr) xs 
+    where 
+    cncs = maybe [] (allConcretes gr) (greatestAbstract gr)
+    cncms = map (\i -> (i,fromOk (lookupModule gr i))) cncs
+    fromOk (Ok x) = x
+    fromOk (Bad y) = error y
+    xs = tracePrt "CFGM languages" (prtBefore "\n") 
+	 [ (i, getFlag fs "startcat", getFlag fs "conversion") | 
+	   (i, ModMod (Module{flags=fs})) <- cncms ]
+
+-- | FIXME: need to look in abstract module too
+getFlag :: [Flag] -> String -> Maybe String
+getFlag fs x = listToMaybe [v | Flg (IC k) (IC v) <- fs, k == x]
+
+-- FIXME: (1) Should use 'ShellState.stateCFG'
+-- instead of 'Cnv.gfc2cfg' (which recalculates the grammar every time)
+--
+-- FIXME: (2) Should use the state options, when calculating the CFG
+-- (this is solved automatically if one solves (1) above)
+prLangAsCFGM :: CanonGrammar -> (Ident, Maybe String, Maybe String) -> String
+prLangAsCFGM gr (i, start, cnv) = prCFGrammarAsCFGM (Cnv.gfc2cfg opts (gr, i)) i start
+-- prLangAsCFGM gr i start = prCFGrammarAsCFGM (Cnv.cfg (Cnv.pInfo opts gr i)) i start
+     where opts = Option.Opts $ maybeToList $ fmap Option.gfcConversion cnv
+
+prCFGrammarAsCFGM :: GT.CGrammar -> Ident -> Maybe String -> String
+prCFGrammarAsCFGM gr i start = PrintCFG.printTree $ cfGrammarToCFGM gr i start
+
+cfGrammarToCFGM :: GT.CGrammar -> Ident -> Maybe String -> AbsCFG.Grammar
+cfGrammarToCFGM gr i start = 
+    AbsCFG.Grammar (identToCFGMIdent i) flags $ sortCFGMRules $ map ruleToCFGMRule gr
+    where flags = maybe [] (\c -> [AbsCFG.StartCat $ strToCFGMCat (c++"{}.s")]) start
+          sortCFGMRules = sortBy (compareBy ruleKey)
+          ruleKey (AbsCFG.Rule f ps cat rhs) = (cat,f)
+
+ruleToCFGMRule :: GT.CRule -> AbsCFG.Rule
+ruleToCFGMRule (CFRule c rhs (GU.Name fun profile)) 
+    = AbsCFG.Rule fun' p' c' rhs'
+    where 
+    fun' = identToFun fun
+    p' = profileToCFGMProfile profile
+    c' = catToCFGMCat c
+    rhs' = map symbolToGFCMSymbol rhs
+
+profileToCFGMProfile :: [GU.Profile (GU.SyntaxForest GT.Fun)] -> AbsCFG.Profiles
+profileToCFGMProfile = AbsCFG.Profiles . map cnvProfile
+    where cnvProfile (GU.Unify ns)   = AbsCFG.UnifyProfile $ map fromIntegral ns
+	  -- FIXME: is it always FNode?
+	  cnvProfile (GU.Constant (GU.FNode c _)) = AbsCFG.ConstProfile $ identToCFGMIdent c
+						  
+
+identToCFGMIdent :: Ident -> AbsCFG.Ident
+identToCFGMIdent = AbsCFG.Ident . prt
+
+identToFun :: Ident -> AbsCFG.Fun
+identToFun IW = AbsCFG.Coerce
+identToFun i = AbsCFG.Cons (identToCFGMIdent i)
+
+strToCFGMCat :: String -> AbsCFG.Category
+strToCFGMCat = AbsCFG.Category . AbsCFG.SingleQuoteString . quoteSingle
+
+catToCFGMCat :: GT.CCat -> AbsCFG.Category
+catToCFGMCat = strToCFGMCat . prt
+
+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 ++ "'"
+    where escapeSingle = concatMap (\c -> if c == '\'' then "\\'" else [c])