forked from GitHub/gf-core
GF/src is now for 2.9, and the new sources are in src-3.0 - keep it this way until the release of GF 3
This commit is contained in:
157
src-3.0/GF/Conversion/GFC.hs
Normal file
157
src-3.0/GF/Conversion/GFC.hs
Normal file
@@ -0,0 +1,157 @@
|
||||
----------------------------------------------------------------------
|
||||
-- |
|
||||
-- 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 ++ "'"
|
||||
|
||||
|
||||
|
||||
|
||||
Reference in New Issue
Block a user