----------------------------------------------------------------------
-- |
-- 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 '%'