mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-18 09:19:32 -06:00
158 lines
5.2 KiB
Haskell
158 lines
5.2 KiB
Haskell
----------------------------------------------------------------------
|
|
-- |
|
|
-- Maintainer : PL
|
|
-- Stability : (stable)
|
|
-- Portability : (portable)
|
|
--
|
|
-- > CVS $Date: 2005/09/01 09:53:18 $
|
|
-- > CVS $Author: peb $
|
|
-- > CVS $Revision: 1.14 $
|
|
--
|
|
-- All conversions from GFC
|
|
-----------------------------------------------------------------------------
|
|
|
|
module GF.Conversion.GFC
|
|
(module GF.Conversion.GFC,
|
|
SGrammar, EGrammar, MGrammar, CGrammar) where
|
|
|
|
import GF.Infra.Option
|
|
import GF.Canon.GFC (CanonGrammar)
|
|
import GF.Infra.Ident (Ident, identC)
|
|
import qualified GF.Infra.Modules as M
|
|
|
|
import GF.Formalism.GCFG (Rule(..), Abstract(..))
|
|
import GF.Formalism.SimpleGFC (decl2cat)
|
|
import GF.Formalism.CFG (CFRule(..))
|
|
import GF.Formalism.Utilities (symbol, name2fun)
|
|
import GF.Conversion.Types
|
|
|
|
import qualified GF.Conversion.GFCtoSimple as G2S
|
|
import qualified GF.Conversion.SimpleToFinite as S2Fin
|
|
import qualified GF.Conversion.RemoveSingletons as RemSing
|
|
import qualified GF.Conversion.RemoveErasing as RemEra
|
|
import qualified GF.Conversion.RemoveEpsilon as RemEps
|
|
import qualified GF.Conversion.SimpleToMCFG as S2M
|
|
import qualified GF.Conversion.MCFGtoCFG as M2C
|
|
|
|
import GF.Infra.Print
|
|
|
|
import GF.System.Tracing
|
|
|
|
----------------------------------------------------------------------
|
|
-- * GFC -> MCFG & CFG, using options to decide which conversion is used
|
|
|
|
convertGFC :: Options -> (CanonGrammar, Ident)
|
|
-> (SGrammar, (EGrammar, (MGrammar, CGrammar)))
|
|
convertGFC opts = \g -> let s = g2s g
|
|
e = s2e s
|
|
m = e2m e
|
|
in trace2 "Options" (show opts) (s, (e, (m, e2c e)))
|
|
where e2c = M2C.convertGrammar
|
|
e2m = case getOptVal opts firstCat of
|
|
Just cat -> flip erasing [identC cat]
|
|
Nothing -> flip erasing []
|
|
s2e = case getOptVal opts gfcConversion of
|
|
Just "strict" -> strict
|
|
Just "finite-strict" -> strict
|
|
Just "epsilon" -> epsilon . nondet
|
|
_ -> nondet
|
|
g2s = case getOptVal opts gfcConversion of
|
|
Just "finite" -> finite . simple
|
|
Just "finite2" -> finite . finite . simple
|
|
Just "finite3" -> finite . finite . finite . simple
|
|
Just "singletons" -> single . simple
|
|
Just "finite-singletons" -> single . finite . simple
|
|
Just "finite-strict" -> finite . simple
|
|
_ -> simple
|
|
|
|
simple = G2S.convertGrammar
|
|
strict = S2M.convertGrammarStrict
|
|
nondet = S2M.convertGrammarNondet
|
|
epsilon = RemEps.convertGrammar
|
|
finite = S2Fin.convertGrammar
|
|
single = RemSing.convertGrammar
|
|
erasing = RemEra.convertGrammar
|
|
|
|
gfc2simple :: Options -> (CanonGrammar, Ident) -> SGrammar
|
|
gfc2simple opts = fst . convertGFC opts
|
|
|
|
gfc2mcfg :: Options -> (CanonGrammar, Ident) -> MGrammar
|
|
gfc2mcfg opts g = mcfg
|
|
where
|
|
(mcfg, _) = snd (snd (convertGFC opts g))
|
|
|
|
gfc2cfg :: Options -> (CanonGrammar, Ident) -> CGrammar
|
|
gfc2cfg opts g = cfg
|
|
where
|
|
(_, cfg) = snd (snd (convertGFC opts g))
|
|
|
|
|
|
----------------------------------------------------------------------
|
|
-- * single step conversions
|
|
|
|
{-
|
|
gfc2simple :: (CanonGrammar, Ident) -> SGrammar
|
|
gfc2simple = G2S.convertGrammar
|
|
|
|
simple2finite :: SGrammar -> SGrammar
|
|
simple2finite = S2Fin.convertGrammar
|
|
|
|
removeSingletons :: SGrammar -> SGrammar
|
|
removeSingletons = RemSing.convertGrammar
|
|
|
|
simple2mcfg_nondet :: SGrammar -> EGrammar
|
|
simple2mcfg_nondet =
|
|
|
|
simple2mcfg_strict :: SGrammar -> EGrammar
|
|
simple2mcfg_strict = S2M.convertGrammarStrict
|
|
|
|
mcfg2cfg :: EGrammar -> CGrammar
|
|
mcfg2cfg = M2C.convertGrammar
|
|
|
|
removeErasing :: EGrammar -> [SCat] -> MGrammar
|
|
removeErasing = RemEra.convertGrammar
|
|
|
|
removeEpsilon :: EGrammar -> EGrammar
|
|
removeEpsilon = RemEps.convertGrammar
|
|
-}
|
|
|
|
----------------------------------------------------------------------
|
|
-- * converting to some obscure formats
|
|
|
|
gfc2abstract :: (CanonGrammar, Ident) -> [Abstract SCat Fun]
|
|
gfc2abstract gr = [ Abs (decl2cat decl) (map decl2cat decls) (name2fun name) |
|
|
Rule (Abs decl decls name) _ <- G2S.convertGrammar 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) =
|
|
prtQuoted cat ++ " ---> " ++
|
|
"\"(" ++ prt fun ++ "\"" ++
|
|
prtBefore ", \" \", " (map prtQuoted cats) ++ ", \")\".\n"
|
|
|
|
cfg2skvatt :: CGrammar -> String
|
|
cfg2skvatt gr = skvatt_hdr ++ concatMap cfg2pl gr
|
|
where cfg2pl (CFRule cat syms _name) =
|
|
prtQuoted cat ++ " ---> " ++
|
|
if null syms then "\"\".\n" else
|
|
prtSep ", " (map (symbol prtQuoted prTok) syms) ++ ".\n"
|
|
prTok tok = "\"" ++ tok ++ " \""
|
|
|
|
skvatt_hdr = ":- use_module(library(skvatt)).\n" ++
|
|
":- use_module(library(utils), [repeat/1]).\n" ++
|
|
"corpus(File, StartCat, Depth, Size) :- \n" ++
|
|
" set_flag(gendepth, Depth),\n" ++
|
|
" tell(File), repeat(Size),\n" ++
|
|
" generate_words(StartCat, String), format('~s~n~n', [String]),\n" ++
|
|
" write(user_error, '.'),\n" ++
|
|
" fail ; told.\n\n"
|
|
|
|
prtQuoted :: Print a => a -> String
|
|
prtQuoted a = "'" ++ prt a ++ "'"
|
|
|
|
|
|
|
|
|