diff options
Diffstat (limited to 'src/GF/Conversion/Prolog.hs')
| -rw-r--r-- | src/GF/Conversion/Prolog.hs | 205 |
1 files changed, 0 insertions, 205 deletions
diff --git a/src/GF/Conversion/Prolog.hs b/src/GF/Conversion/Prolog.hs deleted file mode 100644 index b930cb476..000000000 --- a/src/GF/Conversion/Prolog.hs +++ /dev/null @@ -1,205 +0,0 @@ ----------------------------------------------------------------------- --- | --- Maintainer : PL --- Stability : (stable) --- Portability : (portable) --- --- > CVS $Date: 2005/09/14 09:51:18 $ --- > CVS $Author: peb $ --- > CVS $Revision: 1.4 $ --- --- Converting/Printing different grammar formalisms in Prolog-readable format ------------------------------------------------------------------------------ - - -module GF.Conversion.Prolog (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) -import Data.Char (isLower, isAlphaNum) - -import GF.System.Tracing - ----------------------------------------------------------------------- --- | printing multiple languages at the same time - -prtSMulti, prtMMulti, prtCMulti :: Option.Options -> CanonGrammar -> String -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 prefix 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 prefix ++ 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" +++++ - "%% The following predicate is defined:" ++++ - "%% \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 "rule" [plfun, plcat, plcats, plcnc] ++ "." - where plfun = prtQ fun - plcat = prtSDecl cat - plcats = prtFunctor "c" (map prtSDecl cats) - plcnc = "\n\t" ++ prtSTerm (maybe Empty id mterm) - -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 "tok" [prtQ t] -prtSTerm (Empty) = "empty" -prtSTerm (term :. lbl) = prtOper "*" (prtSTerm term) (prtQ lbl) -prtSTerm (term :! sel) = prtOper "/" (prtSTerm term) (prtSTerm sel) --- prtSTerm (Wildcard) = "wildcard" --- prtSTerm (Var var) = prtFunctor "var" [prtQ var] - -prtSPath (Path path) = prtPList (map (either prtQ prtSTerm) path) - -prtSDecl (Decl var typ) | var == anyVar = prtSAbsType typ - | otherwise = "_" ++ prtVar var ++ ":" ++ prtSAbsType typ - - -prtSAbsType ([] ::--> typ) = prtSFOType typ -prtSAbsType (args ::--> typ) = prtOper ":->" (prtPList (map prtSFOType args)) (prtSFOType typ) - -prtSFOType (cat ::@ args) = prtFunctor (prtQ cat) (map prtSTTerm args) - -prtSTTerm (con :@ args) = prtFunctor (prtQ con) (map prtSTTerm args) -prtSTTerm (TVar var) = "_" ++ prtVar var - ----------------------------------------------------------------------- --- | 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 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 "rule" [plname, plcat, plcats, pllins] ++ "." - where plname = prtName name - plcat = prtQ cat - plcats = prtFunctor "c" (map prtQ cats) - pllins = "\n\t[ " ++ prtSep "\n\t, " (map prtMLin lins) ++ " ]" - -prtMLin (Lin lbl lin) = prtOper "=" (prtQ lbl) (prtPList (map prtMSymbol lin)) - -prtMSymbol (Cat (cat, lbl, nr)) = prtFunctor "arg" [prtQ cat, show (nr+1), prtQ lbl] -prtMSymbol (Tok tok) = prtFunctor "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 rule(Profile, Cat, [Symbol,...])" - -prtCRule :: String -> CRule -> String -prtCRule lang (CFRule cat syms name) - = (if null lang then "" else prtQ lang ++ " : ") ++ - prtFunctor "cfgrule" [plname, plcat, plsyms] ++ "." - where plname = prtName name - plcat = prtQ cat - plsyms = prtPList (map prtCSymbol syms) - -prtCSymbol (Cat cat) = prtFunctor "cat" [prtQ cat] -prtCSymbol (Tok tok) = prtFunctor "tok" [prtQ tok] - ----------------------------------------------------------------------- --- profiles, quoted strings and more - -prtFunctor f xs = f ++ if null xs then "" else "(" ++ prtSep ", " xs ++ ")" -prtPList xs = "[" ++ prtSep ", " xs ++ "]" -prtOper f x y = "(" ++ x ++ " " ++ f ++ " " ++ y ++ ")" - -prtName name@(Name fun profiles) - | name == coercionName = "1" - | and (zipWith (==) profiles (map (Unify . return) [0..])) = prtQ fun - | otherwise = prtFunctor (prtQ fun) (map prtProfile profiles) - -prtProfile (Unify []) = " ? " -prtProfile (Unify args) = foldr1 (prtOper "=") (map (show . succ) args) -prtProfile (Constant forest) = prtForest forest - -prtForest (FMeta) = " ? " -prtForest (FNode fun [fs]) = prtFunctor (prtQ fun) (map prtForest fs) -prtForest (FNode fun fss) = prtPList [ prtFunctor (prtQ fun) (map prtForest fs) | - fs <- fss ] - -prtQ atom = prtQStr (prt atom) - -prtQStr atom@(x:xs) - | isLower x && all isAlphaNumUnder xs = atom - where isAlphaNumUnder '_' = True - isAlphaNumUnder x = isAlphaNum x -prtQStr atom = "'" ++ concatMap esc (prt atom) ++ "'" - where esc '\'' = "\\'" - esc '\n' = "\\n" - esc '\t' = "\\t" - esc c = [c] - -prtVar var = reprime (prt var) - where reprime "" = "" - reprime ('\'' : cs) = "_0" ++ reprime cs - reprime (c:cs) = c : reprime cs - -prtLine = replicate 70 '%' - - |