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

"Committed_by_peb"

Browse Source
This commit is contained in:
peb
2005-09-14 08:51:18 +00:00
parent a97d355583
commit 8921c613bb
1 changed files with 17 additions and 16 deletions
Download Patch File Download Diff File Expand all files Collapse all files

33
src/GF/Conversion/Prolog.hs
View File

@@ -4,9 +4,9 @@
-- Stability : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/09/01 09:53:19 $
-- > CVS $Date: 2005/09/14 09:51:18 $
-- > CVS $Author: peb $
-- > CVS $Revision: 1.3 $
-- > CVS $Revision: 1.4 $
--
-- Converting/Printing different grammar formalisms in Prolog-readable format
-----------------------------------------------------------------------------
@@ -40,13 +40,13 @@ import Data.Char (isLower, isAlphaNum)
-- | printing multiple languages at the same time
prtSMulti, prtMMulti, prtCMulti :: Option.Options -> CanonGrammar -> String
prtSMulti = prtMulti prtSHeader prtSRule Cnv.gfc2simple
prtMMulti = prtMulti prtMHeader prtMRule Cnv.gfc2mcfg
prtCMulti = prtMulti prtCHeader prtCRule Cnv.gfc2cfg
prtSMulti = prtMulti prtSHeader prtSRule Cnv.gfc2simple "gfc_"
prtMMulti = prtMulti prtMHeader prtMRule Cnv.gfc2mcfg "mcfg_"
prtCMulti = prtMulti prtCHeader prtCRule Cnv.gfc2cfg "cfg_"
-- code and ideas stolen from GF.CFGM.PrintCFGrammar
prtMulti prtHeader prtRule conversion opts gr
prtMulti prtHeader prtRule conversion prefix opts gr
= prtHeader ++++ unlines
[ "\n\n" ++ prtLine ++++
"%% Language module: " ++ prtQ langmod +++++
@@ -55,7 +55,7 @@ prtMulti prtHeader prtRule conversion opts 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) ]
let langmod = (let IC lg = lang in prefix ++ lg) ]
getFlag :: [Flag] -> String -> [String]
getFlag fs x = [v | Flg (IC k) (IC v) <- fs, k == x]
@@ -72,25 +72,25 @@ prtSHeader = prtLine ++++
"%% Simple GFC grammar in Prolog-readable format" ++++
"%% Autogenerated from the Grammatical Framework" +++++
"%% The following predicate is defined:" ++++
"%% \t gfcrule(Fun, Cat, c(Cat,...), LinTerm)"
"%% \t rule(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 ++ " : ") ++
prtFunctor "gfcrule" [plfun, plcat, plcats, plcnc] ++ "."
prtFunctor "rule" [plfun, plcat, plcats, plcnc] ++ "."
where plfun = prtQ fun
plcat = prtSCat cat
plcats = prtFunctor "c" (map prtSCat cats)
plcnc = "\n\t" ++ prtSTerm (maybe Empty id mterm)
prtSTerm (Arg n c p) = prtFunctor "arg" [prtQ c, prtSPath p, prt (n+1)]
prtSTerm (Arg n c p) = prtFunctor "arg" [prtQ c, prt (n+1), prtSPath p]
-- prtSTerm (c :^ []) = prtQ c
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 (Token t) = prtFunctor "tok" [prtQ t]
prtSTerm (Empty) = "empty"
prtSTerm (term :. lbl) = prtOper "*" (prtSTerm term) (prtQ lbl)
prtSTerm (term :! sel) = prtOper "/" (prtSTerm term) (prtSTerm sel)
@@ -116,12 +116,12 @@ prtMHeader = prtLine ++++
"%% Multiple context-free grammar in Prolog-readable format" ++++
"%% Autogenerated from the Grammatical Framework" +++++
"%% The following predicate is defined:" ++++
"%% \t mcfgrule(Fun(Profile,...), Cat, c(Cat,...), [Lbl=Symbols,...])"
"%% \t rule(Profile, Cat, c(Cat,...), [Lbl=Symbols,...])"
prtMRule :: String -> MRule -> String
prtMRule lang (Rule (Abs cat cats name) (Cnc _lcat _lcats lins))
= (if null lang then "" else prtQ lang ++ " : ") ++
prtFunctor "mcfgrule" [plname, plcat, plcats, pllins] ++ "."
prtFunctor "rule" [plname, plcat, plcats, pllins] ++ "."
where plname = prtName name
plcat = prtQ cat
plcats = prtFunctor "c" (map prtQ cats)
@@ -129,7 +129,7 @@ prtMRule lang (Rule (Abs cat cats name) (Cnc _lcat _lcats lins))
prtMLin (Lin lbl lin) = prtOper "=" (prtQ lbl) (prtPList (map prtMSymbol lin))
prtMSymbol (Cat (cat, lbl, nr)) = prtFunctor "cat" [prtQ cat, prtQ lbl, show (nr+1)]
prtMSymbol (Cat (cat, lbl, nr)) = prtFunctor "arg" [prtQ cat, show (nr+1), prtQ lbl]
prtMSymbol (Tok tok) = prtFunctor "tok" [prtQ tok]
----------------------------------------------------------------------
@@ -142,7 +142,7 @@ prtCHeader = prtLine ++++
"%% Context-free grammar in Prolog-readable format" ++++
"%% Autogenerated from the Grammatical Framework" +++++
"%% The following predicate is defined:" ++++
"%% \t cfgrule(Fun(Profile,...), Cat, [Symbol,...])"
"%% \t rule(Profile, Cat, [Symbol,...])"
prtCRule :: String -> CRule -> String
prtCRule lang (CFRule cat syms name)
@@ -162,7 +162,8 @@ prtFunctor f xs = f ++ if null xs then "" else "(" ++ prtSep ", " xs ++ ")"
prtPList xs = "[" ++ prtSep ", " xs ++ "]"
prtOper f x y = "(" ++ x ++ " " ++ f ++ " " ++ y ++ ")"
prtName (Name fun profiles)
prtName name@(Name fun profiles)
| name == coercionName = "1"
| and (zipWith (==) profiles (map (Unify . return) [0..])) = prtQ fun
| otherwise = prtFunctor (prtQ fun) (map prtProfile profiles)