forked from GitHub/gf-core
"Committed_by_peb"
This commit is contained in:
peb
@@ -1,6 +1,8 @@
|
||||
|
||||
abstract FragmentAbstract = {
|
||||
|
||||
flags startcat=NP;
|
||||
|
||||
cat S; NP; VP; D; N; V;
|
||||
|
||||
fun
|
||||
|
||||
@@ -4,16 +4,15 @@
|
||||
-- Stability : (stable)
|
||||
-- Portability : (portable)
|
||||
--
|
||||
-- > CVS $Date: 2005/08/11 14:11:46 $
|
||||
-- > CVS $Date: 2005/08/18 13:18:10 $
|
||||
-- > CVS $Author: peb $
|
||||
-- > CVS $Revision: 1.1 $
|
||||
-- > CVS $Revision: 1.2 $
|
||||
--
|
||||
-- Converting/Printing different grammar formalisms in Prolog-readable format
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
|
||||
module GF.Conversion.Prolog (prtSM_Multi,
|
||||
prtSGrammar, prtSMulti, prtSHeader, prtSRule,
|
||||
module GF.Conversion.Prolog (prtSGrammar, prtSMulti, prtSHeader, prtSRule,
|
||||
prtMGrammar, prtMMulti, prtMHeader, prtMRule,
|
||||
prtCGrammar, prtCMulti, prtCHeader, prtCRule) where
|
||||
|
||||
@@ -39,16 +38,14 @@ import Data.Maybe (maybeToList, listToMaybe)
|
||||
----------------------------------------------------------------------
|
||||
-- | printing multiple languages at the same time
|
||||
|
||||
prtSM_Multi, prtSMulti, prtMMulti, prtCMulti :: Option.Options -> CanonGrammar -> String
|
||||
prtSMulti = prtMulti prtSHeader prtSRule (const Cnv.gfc2simple) ""
|
||||
prtMMulti = prtMulti prtMHeader prtMRule Cnv.gfc2mcfg "{}[.s]"
|
||||
prtCMulti = prtMulti prtCHeader prtCRule Cnv.gfc2cfg "{}.s"
|
||||
|
||||
prtSM_Multi opts gr = prtSMulti opts gr +++++ prtMMulti opts gr
|
||||
prtSMulti, prtMMulti, prtCMulti :: Option.Options -> CanonGrammar -> String
|
||||
prtSMulti = prtMulti prtSHeader prtSRule (const Cnv.gfc2simple)
|
||||
prtMMulti = prtMulti prtMHeader prtMRule Cnv.gfc2mcfg
|
||||
prtCMulti = prtMulti prtCHeader prtCRule Cnv.gfc2cfg
|
||||
|
||||
-- code and ideas stolen from GF.CFGM.PrintCFGrammar
|
||||
|
||||
prtMulti prtHeader prtRule conversion startsuffix opts gr
|
||||
prtMulti prtHeader prtRule conversion opts gr
|
||||
= prtHeader ++++ unlines
|
||||
[ "\n\n" ++ prtLine ++++
|
||||
"%% Language module: " ++ prtQ langmod +++++
|
||||
@@ -73,35 +70,33 @@ prtSHeader :: String
|
||||
prtSHeader = prtLine ++++
|
||||
"%% Simple GFC grammar in Prolog-readable format" ++++
|
||||
"%% Autogenerated from the Grammatical Framework" +++++
|
||||
"%% Operators used in LinTerms:" ++++
|
||||
":- op(200, xfx, [':.', ':/', ':++', ':^'])." +++++
|
||||
"%% The following predicate is defined:" ++++
|
||||
"%% \t gfcrule(Fun, Cat, [Cat,...], LinTerm)"
|
||||
"%% \t gfcrule(Fun, Cat, c(Cat,...), LinTerm)"
|
||||
|
||||
prtSRule :: String -> SRule -> String
|
||||
prtSRule lang (Rule (Abs cat cats (Name fun _prof)) (Cnc _ _ mterm))
|
||||
= (if null lang then "" else prtQ lang ++ " : ") ++
|
||||
"gfcrule(" ++ plname ++ ", " ++ plcat ++ ", " ++ plcats ++ ", " ++ plcnc ++ ")."
|
||||
where plcat = prtQ cat
|
||||
plcats = "[" ++ prtSep ", " (map prtQ cats) ++ "]"
|
||||
plname = prtQ fun
|
||||
plcnc = "\n\t" ++ prtSTerm (maybe (Variants []) id mterm)
|
||||
prtFunctor "gfcrule" [plfun, plcat, plcats, plcnc] ++ "."
|
||||
where plfun = prtQ fun
|
||||
plcat = prtQ cat
|
||||
plcats = prtFunctor "c" (map prtQ cats)
|
||||
plcnc = "\n\t" ++ prtSTerm (maybe (Variants []) id mterm)
|
||||
|
||||
prtSTerm (Arg n c p) = "arg(" ++ prtQ c ++ "," ++ prtSPath p ++ "," ++ prt n ++ ")"
|
||||
prtSTerm (Arg n c p) = prtFunctor "arg" [prtQ c, prtSPath p, prt (n+1)]
|
||||
-- prtSTerm (c :^ []) = prtQ c
|
||||
prtSTerm (c :^ ts) = "(" ++ prtQ c ++ " :^ [" ++ prtSep ", " (map prtSTerm ts) ++ "])"
|
||||
prtSTerm (Rec rec) = "rec([" ++ prtSep ", " [ prtQ l ++ "=" ++ prtSTerm t | (l, t) <- rec ] ++ "])"
|
||||
prtSTerm (Tbl tbl) = "tbl([" ++ prtSep ", " [ prtSTerm p ++ "=" ++ prtSTerm t | (p, t) <- tbl ] ++ "])"
|
||||
prtSTerm (Variants ts) = "variants([" ++ prtSep ", " (map prtSTerm ts) ++ "])"
|
||||
prtSTerm (t1 :++ t2) = "(" ++ prtSTerm t1 ++ " :++ " ++ prtSTerm t2 ++ ")"
|
||||
prtSTerm (Token t) = "token(" ++ prtQ t ++ ")"
|
||||
prtSTerm (c :^ ts) = prtOper "^" (prtQ c) (prtPList (map prtSTerm ts))
|
||||
prtSTerm (Rec rec) = prtFunctor "rec" [prtPList [ prtOper "=" (prtQ l) (prtSTerm t) | (l, t) <- rec ]]
|
||||
prtSTerm (Tbl tbl) = prtFunctor "tbl" [prtPList [ prtOper "=" (prtSTerm p) (prtSTerm t) | (p, t) <- tbl ]]
|
||||
prtSTerm (Variants ts) = prtFunctor "variants" [prtPList (map prtSTerm ts)]
|
||||
prtSTerm (t1 :++ t2) = prtOper "+" (prtSTerm t1) (prtSTerm t2)
|
||||
prtSTerm (Token t) = prtFunctor "token" [prtQ t]
|
||||
prtSTerm (Empty) = "empty"
|
||||
prtSTerm (term :. lbl) = "(" ++ prtSTerm term ++ " :. " ++ prtQ lbl ++ ")"
|
||||
prtSTerm (term :! sel) = "(" ++ prtSTerm term ++ " :/ " ++ prtSTerm sel ++ ")"
|
||||
prtSTerm (term :. lbl) = prtOper "*" (prtSTerm term) (prtQ lbl)
|
||||
prtSTerm (term :! sel) = prtOper "/" (prtSTerm term) (prtSTerm sel)
|
||||
-- prtSTerm (Wildcard) = "wildcard"
|
||||
-- prtSTerm (Var var) = "var(" ++ prtQ var ++ ")"
|
||||
-- prtSTerm (Var var) = prtFunctor "var" [prtQ var]
|
||||
|
||||
prtSPath (Path path) = "[" ++ prtSep "," (map (either prtQ prtSTerm) path) ++ "]"
|
||||
prtSPath (Path path) = prtPList (map (either prtQ prtSTerm) path)
|
||||
|
||||
----------------------------------------------------------------------
|
||||
-- | MCFG to Prolog
|
||||
@@ -113,21 +108,22 @@ prtMHeader = prtLine ++++
|
||||
"%% Multiple context-free grammar in Prolog-readable format" ++++
|
||||
"%% Autogenerated from the Grammatical Framework" +++++
|
||||
"%% The following predicate is defined:" ++++
|
||||
"%% \t mcfgrule(Fun/ProfileList, Cat, [Cat,...], [Lbl=Symbols,...])"
|
||||
"%% \t mcfgrule(Fun, p(Profile,...), Cat, c(Cat,...), [Lbl=Symbols,...])"
|
||||
|
||||
prtMRule :: String -> MRule -> String
|
||||
prtMRule lang (Rule (Abs cat cats (Name fun profiles)) (Cnc _lcat _lcats lins))
|
||||
= (if null lang then "" else prtQ lang ++ " : ") ++
|
||||
"mcfgrule(" ++ plname ++ ", " ++ plcat ++ ", " ++ plcats ++ ", " ++ pllins ++ ")."
|
||||
where plcat = prtQ cat
|
||||
plcats = "[" ++ prtSep ", " (map prtQ cats) ++ "]"
|
||||
plname = prtQ fun ++ "/[" ++ prtSep "," (map prtProfile profiles) ++ "]"
|
||||
prtFunctor "mcfgrule" [plfun, plprof, plcat, plcats, pllins] ++ "."
|
||||
where plfun = prtQ fun
|
||||
plprof = prtFunctor "p" (map prtProfile profiles)
|
||||
plcat = prtQ cat
|
||||
plcats = prtFunctor "c" (map prtQ cats)
|
||||
pllins = "\n\t[ " ++ prtSep "\n\t, " (map prtMLin lins) ++ " ]"
|
||||
|
||||
prtMLin (Lin lbl lin) = prtQ lbl ++ " = [" ++ prtSep ", " (map prtMSymbol lin) ++ "]"
|
||||
prtMLin (Lin lbl lin) = prtOper "=" (prtQ lbl) (prtPList (map prtMSymbol lin))
|
||||
|
||||
prtMSymbol (Cat (cat, lbl, nr)) = "cat(" ++ prtQ cat ++ "," ++ prtQ lbl ++ "," ++ show nr ++ ")"
|
||||
prtMSymbol (Tok tok) = "tok(" ++ prtQ tok ++ ")"
|
||||
prtMSymbol (Cat (cat, lbl, nr)) = prtFunctor "cat" [prtQ cat, prtQ lbl, show (nr+1)]
|
||||
prtMSymbol (Tok tok) = prtFunctor "tok" [prtQ tok]
|
||||
|
||||
----------------------------------------------------------------------
|
||||
-- | CFG to Prolog
|
||||
@@ -139,29 +135,35 @@ prtCHeader = prtLine ++++
|
||||
"%% Context-free grammar in Prolog-readable format" ++++
|
||||
"%% Autogenerated from the Grammatical Framework" +++++
|
||||
"%% The following predicate is defined:" ++++
|
||||
"%% \t cfgrule(Fun/ProfileList, Cat, [Symbol,...])"
|
||||
"%% \t cfgrule(Fun, p(Profile,...), Cat, [Symbol,...])"
|
||||
|
||||
prtCRule :: String -> CRule -> String
|
||||
prtCRule lang (CFRule cat syms (Name fun profiles))
|
||||
= (if null lang then "" else prtQ lang ++ " : ") ++
|
||||
"cfgrule(" ++ plname ++ ", " ++ plcat ++ ", " ++ plsyms ++ ")."
|
||||
where plcat = prtQ cat
|
||||
plsyms = "[" ++ prtSep ", " (map prtCSymbol syms) ++ "]"
|
||||
plname = prtQ fun ++ "/[" ++ prtSep "," (map prtProfile profiles) ++ "]"
|
||||
prtFunctor "cfgrule" [plfun, plprof, plcat, plsyms] ++ "."
|
||||
where plfun = prtQ fun
|
||||
plprof = prtFunctor "p" (map prtProfile profiles)
|
||||
plcat = prtQ cat
|
||||
plsyms = prtPList (map prtCSymbol syms)
|
||||
|
||||
prtCSymbol (Cat cat) = "cat(" ++ prtQ cat ++ ")"
|
||||
prtCSymbol (Tok tok) = "tok(" ++ prtQ tok ++ ")"
|
||||
prtCSymbol (Cat cat) = prtFunctor "cat" [prtQ cat]
|
||||
prtCSymbol (Tok tok) = prtFunctor "tok" [prtQ tok]
|
||||
|
||||
----------------------------------------------------------------------
|
||||
-- profiles, quoted strings and more
|
||||
|
||||
prtProfile (Unify args) = show args
|
||||
prtFunctor f xs = f ++ if null xs then "" else "(" ++ prtSep ", " xs ++ ")"
|
||||
prtPList xs = "[" ++ prtSep ", " xs ++ "]"
|
||||
prtOper f x y = "(" ++ x ++ " " ++ f ++ " " ++ y ++ ")"
|
||||
|
||||
prtProfile (Unify [arg]) = show (succ arg)
|
||||
prtProfile (Unify args) = show (map succ args)
|
||||
prtProfile (Constant forest) = prtForest forest
|
||||
|
||||
prtForest (FMeta) = "_META_"
|
||||
prtForest (FNode fun fss) = prtQ fun ++ "^" ++ prtFss fss
|
||||
where prtFss fss = "[" ++ prtSep "," (map prtFs fss) ++ "]"
|
||||
prtFs fs = "[" ++ prtSep "," (map prtForest fs) ++ "]"
|
||||
prtForest (FMeta) = "fmeta"
|
||||
prtForest (FNode fun fss) = prtFunctor "fnode" [prtQ fun, prtFss fss]
|
||||
where prtFss fss = prtPList (map prtFs fss)
|
||||
prtFs fs = prtPList (map prtForest fs)
|
||||
|
||||
prtQ x = "'" ++ concatMap esc (prt x) ++ "'"
|
||||
where esc '\'' = "\\'"
|
||||
|
||||
@@ -5,9 +5,9 @@
|
||||
-- Stability : (stable)
|
||||
-- Portability : (portable)
|
||||
--
|
||||
-- > CVS $Date: 2005/08/11 14:11:46 $
|
||||
-- > CVS $Date: 2005/08/18 13:18:10 $
|
||||
-- > CVS $Author: peb $
|
||||
-- > CVS $Revision: 1.67 $
|
||||
-- > CVS $Revision: 1.68 $
|
||||
--
|
||||
-- A database for customizable GF shell commands.
|
||||
--
|
||||
@@ -295,7 +295,6 @@ customMultiGrammarPrinter =
|
||||
,(strCI "gfc-prolog", CnvProlog.prtSMulti)
|
||||
,(strCI "mcfg-prolog", CnvProlog.prtMMulti)
|
||||
,(strCI "cfg-prolog", CnvProlog.prtCMulti)
|
||||
,(strCI "prolog", CnvProlog.prtSM_Multi)
|
||||
]
|
||||
|
||||
|
||||
|
||||
Reference in New Issue
Block a user