"Committed_by_peb"

This commit is contained in:
peb
2005-08-11 13:11:46 +00:00
parent b119eefcdb
commit 7b6103ffe8
6 changed files with 277 additions and 120 deletions

View File

@@ -4,9 +4,9 @@
-- Stability : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/05/30 08:11:32 $
-- > CVS $Date: 2005/08/11 14:11:46 $
-- > CVS $Author: peb $
-- > CVS $Revision: 1.12 $
-- > CVS $Revision: 1.13 $
--
-- All conversions from GFC
-----------------------------------------------------------------------------
@@ -95,8 +95,8 @@ gfc2abstract :: (CanonGrammar, Ident) -> [Abstract SCat Fun]
gfc2abstract gr = [ Abs (decl2cat decl) (map decl2cat decls) (name2fun name) |
Rule (Abs decl decls name) _ <- gfc2simple gr ]
abstract2prolog :: [Abstract SCat Fun] -> String
abstract2prolog gr = skvatt_hdr ++ concatMap abs2pl gr
abstract2skvatt :: [Abstract SCat Fun] -> String
abstract2skvatt gr = skvatt_hdr ++ concatMap abs2pl gr
where abs2pl (Abs cat [] fun) = prtQuoted cat ++ " ---> " ++
"\"" ++ prt fun ++ "\".\n"
abs2pl (Abs cat cats fun) =
@@ -104,8 +104,8 @@ abstract2prolog gr = skvatt_hdr ++ concatMap abs2pl gr
"\"(" ++ prt fun ++ "\"" ++
prtBefore ", \" \", " (map prtQuoted cats) ++ ", \")\".\n"
cfg2prolog :: CGrammar -> String
cfg2prolog gr = skvatt_hdr ++ concatMap cfg2pl gr
cfg2skvatt :: CGrammar -> String
cfg2skvatt gr = skvatt_hdr ++ concatMap cfg2pl gr
where cfg2pl (CFRule cat syms _name) =
prtQuoted cat ++ " ---> " ++
if null syms then "\"\".\n" else

View File

@@ -0,0 +1,71 @@
----------------------------------------------------------------------
-- |
-- Maintainer : PL
-- Stability : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/08/11 14:11:46 $
-- > CVS $Author: peb $
-- > CVS $Revision: 1.1 $
--
-- Converting/Printing different grammar formalisms in Haskell-readable format
-----------------------------------------------------------------------------
module GF.Conversion.Haskell where
import GF.Formalism.GCFG
import GF.Formalism.SimpleGFC
import GF.Formalism.MCFG
import GF.Formalism.CFG
import GF.Formalism.Utilities
import GF.Conversion.Types
import GF.Data.Operations ((++++), (+++++))
import GF.Infra.Print
import Data.List (intersperse)
-- | SimpleGFC to Haskell
prtSGrammar :: SGrammar -> String
prtSGrammar rules = "-- Simple GFC grammar as a Haskell file" ++++
"-- Autogenerated from the Grammatical Framework" +++++
"import GF.Formalism.GCFG" ++++
"import GF.Formalism.SimpleGFC" ++++
"import GF.Formalism.Utilities" ++++
"import GF.Canon.AbsGFC (CIdent(..), Label(..))" ++++
"import GF.Infra.Ident (Ident(..))" +++++
"grammar :: SimpleGrammar Ident (NameProfile Ident) String" ++++
"grammar = \n\t[ " ++
concat (intersperse "\n\t, " (map show rules)) ++ "\n\t]\n\n"
-- | MCFG to Haskell
prtMGrammar :: MGrammar -> String
prtMGrammar rules = "-- Multiple context-free grammar as a Haskell file" ++++
"-- Autogenerated from the Grammatical Framework" +++++
"import GF.Formalism.GCFG" ++++
"import GF.Formalism.MCFG" ++++
"import GF.Formalism.Utilities" +++++
"grammar :: MCFGrammar String (NameProfile String) String String" ++++
"grammar = \n\t[ " ++
concat (intersperse "\n\t, " (map prtMRule rules)) ++ "\n\t]\n\n"
where prtMRule (Rule (Abs cat cats (Name fun profiles)) (Cnc lcat lcats lins))
= show (Rule (Abs (prt cat) (map prt cats) (Name (prt fun) (map cnvProfile profiles)))
(Cnc (map prt lcat) (map (map prt) lcats) (map cnvLin lins)))
cnvLin (Lin lbl syms) = Lin (prt lbl) (map (mapSymbol prtMArg id) syms)
prtMArg (cat, lbl, nr) = (prt cat, prt lbl, nr)
-- | CFG to Haskell
prtCGrammar :: CGrammar -> String
prtCGrammar rules = "-- Context-free grammar as a Haskell file" ++++
"-- autogenerated from the Grammatical Framework" +++++
"import GF.Formalism.CFG" ++++
"import GF.Formalism.Utilities" ++++
"\ngrammar :: CFGrammar String (NameProfile String) String" ++++
"grammar = \n\t[ " ++
concat (intersperse "\n\t, " (map prtCRule rules)) ++ "\n\t]\n\n"
where prtCRule (CFRule cat syms (Name fun profiles))
= show (CFRule (prt cat) (map (mapSymbol prt id) syms)
(Name (prt fun) (map cnvProfile profiles)))
cnvProfile (Unify args) = Unify args
cnvProfile (Constant forest) = Constant (fmap prt forest)

174
src/GF/Conversion/Prolog.hs Normal file
View File

@@ -0,0 +1,174 @@
----------------------------------------------------------------------
-- |
-- Maintainer : PL
-- Stability : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/08/11 14:11:46 $
-- > CVS $Author: peb $
-- > CVS $Revision: 1.1 $
--
-- Converting/Printing different grammar formalisms in Prolog-readable format
-----------------------------------------------------------------------------
module GF.Conversion.Prolog (prtSM_Multi,
prtSGrammar, prtSMulti, prtSHeader, prtSRule,
prtMGrammar, prtMMulti, prtMHeader, prtMRule,
prtCGrammar, prtCMulti, prtCHeader, prtCRule) where
import GF.Formalism.GCFG
import GF.Formalism.SimpleGFC
import GF.Formalism.MCFG
import GF.Formalism.CFG
import GF.Formalism.Utilities
import GF.Conversion.Types
import qualified GF.Conversion.GFC as Cnv
import GF.Data.Operations ((++++), (+++++))
import GF.Infra.Print
import qualified GF.Infra.Modules as Mod
import qualified GF.Infra.Option as Option
import GF.Data.Operations (okError)
import GF.Canon.AbsGFC (Flag(..))
import GF.Canon.GFC (CanonGrammar)
import GF.Infra.Ident (Ident(..))
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
-- code and ideas stolen from GF.CFGM.PrintCFGrammar
prtMulti prtHeader prtRule conversion startsuffix opts gr
= prtHeader ++++ unlines
[ "\n\n" ++ prtLine ++++
"%% Language module: " ++ prtQ langmod +++++
unlines (map (prtRule langmod) rules) |
lang <- maybe [] (Mod.allConcretes gr) (Mod.greatestAbstract gr),
let Mod.ModMod (Mod.Module{Mod.flags=fs}) = okError (Mod.lookupModule gr lang),
let cnvopts = Option.Opts $ map Option.gfcConversion $ getFlag fs "conversion",
let rules = conversion cnvopts (gr, lang),
let langmod = (let IC lg = lang in "gf_" ++ lg) ]
getFlag :: [Flag] -> String -> [String]
getFlag fs x = [v | Flg (IC k) (IC v) <- fs, k == x]
----------------------------------------------------------------------
-- | SimpleGFC to Prolog
--
-- assumes that the profiles in the Simple GFC names are trivial
prtSGrammar :: SGrammar -> String
prtSGrammar rules = prtSHeader +++++ unlines (map (prtSRule "") rules)
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)"
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)
prtSTerm (Arg n c p) = "arg(" ++ prtQ c ++ "," ++ prtSPath p ++ "," ++ prt n ++ ")"
-- 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 (Empty) = "empty"
prtSTerm (term :. lbl) = "(" ++ prtSTerm term ++ " :. " ++ prtQ lbl ++ ")"
prtSTerm (term :! sel) = "(" ++ prtSTerm term ++ " :/ " ++ prtSTerm sel ++ ")"
-- prtSTerm (Wildcard) = "wildcard"
-- prtSTerm (Var var) = "var(" ++ prtQ var ++ ")"
prtSPath (Path path) = "[" ++ prtSep "," (map (either prtQ prtSTerm) path) ++ "]"
----------------------------------------------------------------------
-- | MCFG to Prolog
prtMGrammar :: MGrammar -> String
prtMGrammar rules = prtMHeader +++++ unlines (map (prtMRule "") rules)
prtMHeader :: String
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,...])"
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) ++ "]"
pllins = "\n\t[ " ++ prtSep "\n\t, " (map prtMLin lins) ++ " ]"
prtMLin (Lin lbl lin) = prtQ lbl ++ " = [" ++ prtSep ", " (map prtMSymbol lin) ++ "]"
prtMSymbol (Cat (cat, lbl, nr)) = "cat(" ++ prtQ cat ++ "," ++ prtQ lbl ++ "," ++ show nr ++ ")"
prtMSymbol (Tok tok) = "tok(" ++ prtQ tok ++ ")"
----------------------------------------------------------------------
-- | CFG to Prolog
prtCGrammar :: CGrammar -> String
prtCGrammar rules = prtCHeader +++++ unlines (map (prtCRule "") rules)
prtCHeader :: String
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,...])"
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) ++ "]"
prtCSymbol (Cat cat) = "cat(" ++ prtQ cat ++ ")"
prtCSymbol (Tok tok) = "tok(" ++ prtQ tok ++ ")"
----------------------------------------------------------------------
-- profiles, quoted strings and more
prtProfile (Unify args) = show 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) ++ "]"
prtQ x = "'" ++ concatMap esc (prt x) ++ "'"
where esc '\'' = "\\'"
esc '\n' = "\\n"
esc '\t' = "\\t"
esc c = [c]
prtLine = replicate 70 '%'

View File

@@ -4,9 +4,9 @@
-- Stability : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/05/13 12:40:19 $
-- > CVS $Date: 2005/08/11 14:11:46 $
-- > CVS $Author: peb $
-- > CVS $Revision: 1.9 $
-- > CVS $Revision: 1.10 $
--
-- All possible instantiations of different grammar formats used in conversion from GFC
-----------------------------------------------------------------------------
@@ -27,7 +27,6 @@ import GF.Infra.Print
import GF.Data.Assoc
import Control.Monad (foldM)
import Data.List (intersperse)
----------------------------------------------------------------------
-- * basic (leaf) types
@@ -133,98 +132,3 @@ instance Print CCat where
prt (CCat cat label) = prt cat ++ prt label
----------------------------------------------------------------------
-- * other printing facilities
-- ** printing grammars as Haskell files
prtHsSGrammar :: SGrammar -> String
prtHsSGrammar rules = "-- Simple GFC grammar as a Haskell file\n" ++
"-- autogenerated from the Grammatical Framework\n\n" ++
"import GF.Formalism.GCFG\n" ++
"import GF.Formalism.SimpleGFC\n" ++
"import GF.Formalism.Utilities\n" ++
"--import GF.Conversion.Types\n" ++
"import GF.Canon.AbsGFC (CIdent(..), Label(..))\n" ++
"import GF.Infra.Ident (Ident(..))\n" ++
"\ngrammar :: SimpleGrammar Ident (NameProfile Ident) String\n" ++
-- "\ngrammar :: SGrammar\n" ++
"grammar = \n\t[ " ++
concat (intersperse "\n\t, " (map show rules)) ++
"\n\t]\n\n"
prtHsMGrammar :: MGrammar -> String
prtHsMGrammar rules = "-- Multiple context-free grammar as a Haskell file\n" ++
"-- autogenerated from the Grammatical Framework\n\n" ++
"import GF.Formalism.GCFG\n" ++
"import GF.Formalism.MCFG\n" ++
"import GF.Formalism.Utilities\n" ++
"\ngrammar :: MCFGrammar String (NameProfile String) String String\n" ++
"grammar = \n\t[ " ++
concat (intersperse "\n\t, " (map prtHsMRule rules)) ++
"\n\t]\n\n"
where prtHsMRule (Rule (Abs cat cats (Name fun profiles)) (Cnc lcat lcats lins)) =
show (Rule (Abs (prt cat) (map prt cats) (Name (prt fun) (map cnvHsProfile profiles)))
(Cnc (map prt lcat) (map (map prt) lcats) (map cnvHsLin lins)))
cnvHsLin (Lin lbl syms) = Lin (prt lbl) (map (mapSymbol prtMArg id) syms)
prtMArg (cat, lbl, nr) = (prt cat, prt lbl, nr)
prtHsCGrammar :: CGrammar -> String
prtHsCGrammar rules = "-- Context-free grammar as a Haskell file\n" ++
"-- autogenerated from the Grammatical Framework\n\n" ++
"import GF.Formalism.CFG\n" ++
"import GF.Formalism.Utilities\n" ++
"\ngrammar :: CFGrammar String (NameProfile String) String\n" ++
"grammar = \n\t[ " ++
concat (intersperse "\n\t, " (map prtHsCRule rules)) ++
"\n\t]\n\n"
where prtHsCRule (CFRule cat syms (Name fun profiles)) =
show (CFRule (prt cat) (map (mapSymbol prt id) syms)
(Name (prt fun) (map cnvHsProfile profiles)))
cnvHsProfile (Unify args) = Unify args
cnvHsProfile (Constant forest) = Constant (fmap prt forest)
-- ** printing grammars as Prolog files
prtPlMGrammar :: MGrammar -> String
prtPlMGrammar rules = ":- op(1100, xfx, ':=').\n" ++
":- op(1000, xfx, '--->').\n" ++
":- op(200, xfx, '@').\n\n" ++
"%% Fun/ProfileList : Cat ---> [Cat,...] := [Lbl=SymbolList,...]\n" ++
concatMap prtPlMRule rules
where prtPlMRule (Rule (Abs cat cats (Name fun profiles)) (Cnc _lcat _lcats lins)) =
prtPlQuoted fun ++ "/" ++
"[" ++ prtSep "," (map prtPlProfile profiles) ++ "] : " ++
prtPlQuoted cat ++ " ---> " ++
"[" ++ prtSep ", " (map prtPlQuoted cats) ++ "] := \n" ++
"\t[ " ++ prtSep "\n\t, " (map prtLin lins) ++ "\n\t].\n"
prtLin (Lin lbl lin) = prtPlQuoted lbl ++ " = " ++
"[" ++ prtSep ", " (map prtSymbol lin) ++ "]"
prtSymbol (Cat (cat, lbl, nr)) = prtPlQuoted cat ++ "@" ++ show nr ++ "-" ++ prtPlQuoted lbl
prtSymbol (Tok tok) = "[" ++ prtPlQuoted tok ++ "]"
prtPlCGrammar :: CGrammar -> String
prtPlCGrammar rules = ":- op(1000, xfx, '--->').\n\n" ++
"%% Fun/ProfileList : Cat ---> [Symbol,...]\n" ++
concatMap prtPlCRule rules
where prtPlCRule (CFRule cat syms (Name fun profiles)) =
prtPlQuoted fun ++ "/" ++
"[" ++ prtSep "," (map prtPlProfile profiles) ++ "] : " ++
prtPlQuoted cat ++ " ---> " ++
"[" ++ prtSep ", " (map prtSymbol syms) ++ "].\n"
prtSymbol (Cat cat) = prtPlQuoted cat
prtSymbol (Tok tok) = "[" ++ prtPlQuoted tok ++ "]"
prtPlProfile (Unify args) = show args
prtPlProfile (Constant forest) = prtPlForest forest
prtPlForest (FMeta) = "_META_"
prtPlForest (FNode fun fss) = prtPlQuoted fun ++ "^" ++ prtFss fss
where prtFss fss = "[" ++ prtSep "," (map prtFs fss) ++ "]"
prtFs fs = "[" ++ prtSep "," (map prtPlForest fs) ++ "]"
prtPlQuoted str = "'" ++ prt str ++ "'"