GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-04-09 13:09:33 -06:00
Code Issues Packages Projects Releases Wiki Activity

Added semantic interpretation tag printing to the *bnf grammar printers.

Browse Source
This commit is contained in:
bjorn
2008-09-26 12:57:20 +00:00
parent 2f3b7d1c55
commit b0dde31f00
4 changed files with 36 additions and 11 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
src/GF/Compile/Export.hs
View File

@@ -38,8 +38,8 @@ exportPGF opts fmt pgf =
FmtProlog -> multi "pl" grammar2prolog
FmtProlog_Abs -> multi "pl" grammar2prolog_abs
FmtBNF -> single "bnf" bnfPrinter
FmtEBNF -> single "ebnf" ebnfPrinter
FmtNoLR -> single "ebnf" nonLeftRecursivePrinter
FmtEBNF -> single "ebnf" (ebnfPrinter sisr)
FmtNoLR -> single "ebnf" (nonLeftRecursivePrinter sisr)
FmtRegular -> single "ebnf" regularPrinter
FmtFCFG -> single "fcfg" fcfgPrinter
FmtSRGS_XML -> single "grxml" (srgsXmlPrinter sisr)

12
src/GF/Speech/CFG.hs
View File

@@ -285,6 +285,18 @@ prProductions prods =
maxLHSWidth = maximum $ 0:(map (length . fst) prods)
rpad n s = s ++ replicate (n - length s) ' '
prCFTerm :: CFTerm -> String
prCFTerm = pr 0
where
pr p (CFObj f args) = paren p (prCId f ++ " (" ++ concat (intersperse "," (map (pr 0) args)) ++ ")")
pr p (CFAbs i t) = paren p ("\\x" ++ show i ++ ". " ++ pr 0 t)
pr p (CFApp t1 t2) = paren p (pr 1 t1 ++ "(" ++ pr 0 t2 ++ ")")
pr _ (CFRes i) = "$" ++ show i
pr _ (CFVar i) = "x" ++ show i
pr _ (CFMeta c) = "?" ++ prCId c
paren 0 x = x
paren 1 x = "(" ++ x ++ ")"
--
-- * CFRule Utilities
--

1
src/GF/Speech/RegExp.hs
View File

@@ -133,6 +133,7 @@ symbolsRE (RESymbol x) = [x]
prRE :: (a -> String) -> RE a -> String
prRE = prRE' 0
prRE' :: Int -> (a -> String) -> RE a -> String
prRE' _ _ (REUnion []) = "<NULL>"
prRE' n f (REUnion xs) = p n 1 (concat (intersperse " | " (map (prRE' 1 f) xs)))
prRE' n f (REConcat xs) = p n 2 (unwords (map (prRE' 2 f) xs))

30
src/GF/Speech/SRG.hs
View File

@@ -68,14 +68,14 @@ type SRGSymbol = Symbol SRGNT Token
type SRGNT = (Cat, Int)
ebnfPrinter :: PGF -> CId -> String
ebnfPrinter pgf cnc = prSRG $ makeSRG id pgf cnc
ebnfPrinter :: Maybe SISRFormat -> PGF -> CId -> String
ebnfPrinter sisr pgf cnc = prSRG sisr $ makeSRG id pgf cnc
nonLeftRecursivePrinter :: PGF -> CId -> String
nonLeftRecursivePrinter pgf cnc = prSRG $ makeSRG removeLeftRecursion pgf cnc
nonLeftRecursivePrinter :: Maybe SISRFormat -> PGF -> CId -> String
nonLeftRecursivePrinter sisr pgf cnc = prSRG sisr $ makeSRG removeLeftRecursion pgf cnc
regularPrinter :: PGF -> CId -> String
regularPrinter pgf cnc = prSRG $ makeSRG makeRegular pgf cnc
regularPrinter pgf cnc = prSRG Nothing $ makeSRG makeRegular pgf cnc
makeSRG :: (CFG -> CFG) -> PGF -> CId -> SRG
makeSRG = mkSRG cfgToSRG
@@ -182,12 +182,24 @@ ungroupTokens = joinRE . mapRE (symbol (RESymbol . NonTerminal) (REConcat . map
-- * Utilities for building and printing SRGs
--
prSRG :: SRG -> String
prSRG srg = prProductions $ map prRule $ ext ++ int
prSRG :: Maybe SISRFormat -> SRG -> String
prSRG sisr srg = prProductions $ map prRule $ ext ++ int
where
(ext,int) = partition (isExternalCat srg . srgLHSCat) (srgRules srg)
prRule (SRGRule c alts) = (c,unwords (intersperse "|" (map prAlt alts)))
prAlt (SRGAlt _ _ rhs) = prRE prSym rhs
prRule (SRGRule c alts) = (c,unwords (intersperse "|" (concatMap prAlt alts)))
prAlt (SRGAlt _ t rhs) =
-- FIXME: hack: we high-jack the --sisr flag to add
-- a simple lambda calculus format for semantic interpretation
-- Maybe the --sisr flag should be renamed.
case sisr of
Just _ ->
-- copy tags to each part of a top-level union,
-- to get simpler output
case rhs of
REUnion xs -> map prOneAlt xs
_ -> [prOneAlt rhs]
where prOneAlt a = prRE prSym a ++ " { " ++ prCFTerm t ++ " }"
Nothing -> [prRE prSym rhs]
prSym = symbol fst (\t -> "\""++ t ++"\"")
lookupFM_ :: (Ord key, Show key) => Map key elt -> key -> elt