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

"Committed_by_peb"

Browse Source
This commit is contained in:
peb
2005-09-14 08:51:18 +00:00
parent 95463f6dba
commit 16f2bf8cd6
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) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date: 2005/09/01 09:53:19 $ -- > CVS $Date: 2005/09/14 09:51:18 $
-- > CVS $Author: peb $ -- > CVS $Author: peb $
-- > CVS $Revision: 1.3 $ -- > CVS $Revision: 1.4 $
-- --
-- Converting/Printing different grammar formalisms in Prolog-readable format -- 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 -- | printing multiple languages at the same time
prtSMulti, prtMMulti, prtCMulti :: Option.Options -> CanonGrammar -> String prtSMulti, prtMMulti, prtCMulti :: Option.Options -> CanonGrammar -> String
prtSMulti = prtMulti prtSHeader prtSRule Cnv.gfc2simple prtSMulti = prtMulti prtSHeader prtSRule Cnv.gfc2simple "gfc_"
prtMMulti = prtMulti prtMHeader prtMRule Cnv.gfc2mcfg prtMMulti = prtMulti prtMHeader prtMRule Cnv.gfc2mcfg "mcfg_"
prtCMulti = prtMulti prtCHeader prtCRule Cnv.gfc2cfg prtCMulti = prtMulti prtCHeader prtCRule Cnv.gfc2cfg "cfg_"
-- code and ideas stolen from GF.CFGM.PrintCFGrammar -- code and ideas stolen from GF.CFGM.PrintCFGrammar
prtMulti prtHeader prtRule conversion opts gr prtMulti prtHeader prtRule conversion prefix opts gr
= prtHeader ++++ unlines = prtHeader ++++ unlines
[ "\n\n" ++ prtLine ++++ [ "\n\n" ++ prtLine ++++
"%% Language module: " ++ prtQ langmod +++++ "%% 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 Mod.ModMod (Mod.Module{Mod.flags=fs}) = okError (Mod.lookupModule gr lang),
let cnvopts = Option.Opts $ map Option.gfcConversion $ getFlag fs "conversion", let cnvopts = Option.Opts $ map Option.gfcConversion $ getFlag fs "conversion",
let rules = conversion cnvopts (gr, lang), 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 :: [Flag] -> String -> [String]
getFlag fs x = [v | Flg (IC k) (IC v) <- fs, k == x] 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" ++++ "%% Simple GFC grammar in Prolog-readable format" ++++
"%% Autogenerated from the Grammatical Framework" +++++ "%% Autogenerated from the Grammatical Framework" +++++
"%% The following predicate is defined:" ++++ "%% The following predicate is defined:" ++++
"%% \t gfcrule(Fun, Cat, c(Cat,...), LinTerm)" "%% \t rule(Fun, Cat, c(Cat,...), LinTerm)"
prtSRule :: String -> SRule -> String prtSRule :: String -> SRule -> String
prtSRule lang (Rule (Abs cat cats (Name fun _prof)) (Cnc _ _ mterm)) prtSRule lang (Rule (Abs cat cats (Name fun _prof)) (Cnc _ _ mterm))
= (if null lang then "" else prtQ lang ++ " : ") ++ = (if null lang then "" else prtQ lang ++ " : ") ++
prtFunctor "gfcrule" [plfun, plcat, plcats, plcnc] ++ "." prtFunctor "rule" [plfun, plcat, plcats, plcnc] ++ "."
where plfun = prtQ fun where plfun = prtQ fun
plcat = prtSCat cat plcat = prtSCat cat
plcats = prtFunctor "c" (map prtSCat cats) plcats = prtFunctor "c" (map prtSCat cats)
plcnc = "\n\t" ++ prtSTerm (maybe Empty id mterm) 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 :^ []) = prtQ c
prtSTerm (c :^ ts) = prtOper "^" (prtQ c) (prtPList (map prtSTerm ts)) 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 (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 (Tbl tbl) = prtFunctor "tbl" [prtPList [ prtOper "=" (prtSTerm p) (prtSTerm t) | (p, t) <- tbl ]]
prtSTerm (Variants ts) = prtFunctor "variants" [prtPList (map prtSTerm ts)] prtSTerm (Variants ts) = prtFunctor "variants" [prtPList (map prtSTerm ts)]
prtSTerm (t1 :++ t2) = prtOper "+" (prtSTerm t1) (prtSTerm t2) 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 (Empty) = "empty"
prtSTerm (term :. lbl) = prtOper "*" (prtSTerm term) (prtQ lbl) prtSTerm (term :. lbl) = prtOper "*" (prtSTerm term) (prtQ lbl)
prtSTerm (term :! sel) = prtOper "/" (prtSTerm term) (prtSTerm sel) prtSTerm (term :! sel) = prtOper "/" (prtSTerm term) (prtSTerm sel)
@@ -116,12 +116,12 @@ prtMHeader = prtLine ++++
"%% Multiple context-free grammar in Prolog-readable format" ++++ "%% Multiple context-free grammar in Prolog-readable format" ++++
"%% Autogenerated from the Grammatical Framework" +++++ "%% Autogenerated from the Grammatical Framework" +++++
"%% The following predicate is defined:" ++++ "%% 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 :: String -> MRule -> String
prtMRule lang (Rule (Abs cat cats name) (Cnc _lcat _lcats lins)) prtMRule lang (Rule (Abs cat cats name) (Cnc _lcat _lcats lins))
= (if null lang then "" else prtQ lang ++ " : ") ++ = (if null lang then "" else prtQ lang ++ " : ") ++
prtFunctor "mcfgrule" [plname, plcat, plcats, pllins] ++ "." prtFunctor "rule" [plname, plcat, plcats, pllins] ++ "."
where plname = prtName name where plname = prtName name
plcat = prtQ cat plcat = prtQ cat
plcats = prtFunctor "c" (map prtQ cats) 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)) 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] prtMSymbol (Tok tok) = prtFunctor "tok" [prtQ tok]
---------------------------------------------------------------------- ----------------------------------------------------------------------
@@ -142,7 +142,7 @@ prtCHeader = prtLine ++++
"%% Context-free grammar in Prolog-readable format" ++++ "%% Context-free grammar in Prolog-readable format" ++++
"%% Autogenerated from the Grammatical Framework" +++++ "%% Autogenerated from the Grammatical Framework" +++++
"%% The following predicate is defined:" ++++ "%% The following predicate is defined:" ++++
"%% \t cfgrule(Fun(Profile,...), Cat, [Symbol,...])" "%% \t rule(Profile, Cat, [Symbol,...])"
prtCRule :: String -> CRule -> String prtCRule :: String -> CRule -> String
prtCRule lang (CFRule cat syms name) 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 ++ "]" prtPList xs = "[" ++ prtSep ", " xs ++ "]"
prtOper f x y = "(" ++ x ++ " " ++ f ++ " " ++ y ++ ")" 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 | and (zipWith (==) profiles (map (Unify . return) [0..])) = prtQ fun
| otherwise = prtFunctor (prtQ fun) (map prtProfile profiles) | otherwise = prtFunctor (prtQ fun) (map prtProfile profiles)