mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-09 04:59:31 -06:00
method for flattening grammars
This commit is contained in:
aarne
110
lib/resource-1.0/minimal/trees.tmp
Normal file
110
lib/resource-1.0/minimal/trees.tmp
Normal file
@@ -0,0 +1,110 @@
|
||||
PredVP this_NP (AdvVP (ComplV2 break_V2 that_NP) (PositAdvAdj big_A))
|
||||
PredVP this_NP (AdvVP (ComplV2 break_V2 this_NP) (PositAdvAdj big_A))
|
||||
PredVP this_NP (AdvVP (ComplV3 add_V3 this_NP that_NP) (PositAdvAdj big_A))
|
||||
PredVP this_NP (AdvVP (ComplV3 add_V3 this_NP this_NP) (PositAdvAdj big_A))
|
||||
PredVP this_NP (AdvVP (PassV2 break_V2) (PositAdvAdj big_A))
|
||||
PredVP this_NP (AdvVP (ReflV2 break_V2) (PositAdvAdj big_A))
|
||||
PredVP this_NP (AdvVP (UseV sleep_V) (PositAdvAdj big_A))
|
||||
PredVP this_NP (ComplV2 (UseVQ wonder_VQ) that_NP)
|
||||
PredVP this_NP (ComplV2 (UseVQ wonder_VQ) this_NP)
|
||||
PredVP this_NP (ComplV2A paint_V2A that_NP (ComparA big_A that_NP))
|
||||
PredVP this_NP (ComplV2A paint_V2A that_NP (ComparA big_A this_NP))
|
||||
PredVP this_NP (ComplV2A paint_V2A that_NP (PositA big_A))
|
||||
PredVP this_NP (ComplV2A paint_V2A this_NP (ComparA big_A that_NP))
|
||||
PredVP this_NP (ComplV2A paint_V2A this_NP (ComparA big_A this_NP))
|
||||
PredVP this_NP (ComplV2A paint_V2A this_NP (PositA big_A))
|
||||
PredVP this_NP (ComplVA become_VA (ComparA big_A that_NP))
|
||||
PredVP this_NP (ComplVA become_VA (ComparA big_A this_NP))
|
||||
PredVP this_NP (ComplVA become_VA (PositA big_A))
|
||||
PredVP this_NP (PassV2 (UseVQ wonder_VQ))
|
||||
PredVP this_NP (ReflV2 (UseVQ wonder_VQ))
|
||||
PredVP this_NP (UseComp (CompNP that_NP))
|
||||
PredVP this_NP (UseComp (CompNP this_NP))
|
||||
PredVP this_NP (ProgrVP (ComplV2 break_V2 that_NP))
|
||||
PredVP this_NP (ProgrVP (ComplV2 break_V2 this_NP))
|
||||
PredVP this_NP (ProgrVP (ComplV3 add_V3 this_NP that_NP))
|
||||
PredVP this_NP (ProgrVP (ComplV3 add_V3 this_NP this_NP))
|
||||
PredVP this_NP (ProgrVP (PassV2 break_V2))
|
||||
PredVP this_NP (ProgrVP (ReflV2 break_V2))
|
||||
PredVP this_NP (ProgrVP (UseV sleep_V))
|
||||
GenericCl (AdvVP (ComplV2 break_V2 that_NP) (PositAdvAdj big_A))
|
||||
GenericCl (AdvVP (ComplV2 break_V2 this_NP) (PositAdvAdj big_A))
|
||||
GenericCl (AdvVP (ComplV3 add_V3 this_NP that_NP) (PositAdvAdj big_A))
|
||||
GenericCl (AdvVP (ComplV3 add_V3 this_NP this_NP) (PositAdvAdj big_A))
|
||||
GenericCl (AdvVP (PassV2 break_V2) (PositAdvAdj big_A))
|
||||
GenericCl (AdvVP (ReflV2 break_V2) (PositAdvAdj big_A))
|
||||
GenericCl (AdvVP (UseV sleep_V) (PositAdvAdj big_A))
|
||||
GenericCl (ComplV2 (UseVQ wonder_VQ) that_NP)
|
||||
GenericCl (ComplV2 (UseVQ wonder_VQ) this_NP)
|
||||
GenericCl (ComplV2A paint_V2A that_NP (ComparA big_A that_NP))
|
||||
GenericCl (ComplV2A paint_V2A that_NP (ComparA big_A this_NP))
|
||||
GenericCl (ComplV2A paint_V2A that_NP (PositA big_A))
|
||||
GenericCl (ComplV2A paint_V2A this_NP (ComparA big_A that_NP))
|
||||
GenericCl (ComplV2A paint_V2A this_NP (ComparA big_A this_NP))
|
||||
GenericCl (ComplV2A paint_V2A this_NP (PositA big_A))
|
||||
GenericCl (ComplVA become_VA (ComparA big_A that_NP))
|
||||
GenericCl (ComplVA become_VA (ComparA big_A this_NP))
|
||||
GenericCl (ComplVA become_VA (PositA big_A))
|
||||
GenericCl (PassV2 (UseVQ wonder_VQ))
|
||||
GenericCl (ReflV2 (UseVQ wonder_VQ))
|
||||
GenericCl (UseComp (CompNP that_NP))
|
||||
GenericCl (UseComp (CompNP this_NP))
|
||||
GenericCl (ProgrVP (ComplV2 break_V2 that_NP))
|
||||
GenericCl (ProgrVP (ComplV2 break_V2 this_NP))
|
||||
GenericCl (ProgrVP (ComplV3 add_V3 this_NP that_NP))
|
||||
GenericCl (ProgrVP (ComplV3 add_V3 this_NP this_NP))
|
||||
GenericCl (ProgrVP (PassV2 break_V2))
|
||||
GenericCl (ProgrVP (ReflV2 break_V2))
|
||||
GenericCl (ProgrVP (UseV sleep_V))
|
||||
ImpersCl (AdvVP (ComplV2 break_V2 that_NP) (PositAdvAdj big_A))
|
||||
ImpersCl (AdvVP (ComplV2 break_V2 this_NP) (PositAdvAdj big_A))
|
||||
ImpersCl (AdvVP (ComplV3 add_V3 this_NP that_NP) (PositAdvAdj big_A))
|
||||
ImpersCl (AdvVP (ComplV3 add_V3 this_NP this_NP) (PositAdvAdj big_A))
|
||||
ImpersCl (AdvVP (PassV2 break_V2) (PositAdvAdj big_A))
|
||||
ImpersCl (AdvVP (ReflV2 break_V2) (PositAdvAdj big_A))
|
||||
ImpersCl (AdvVP (UseV sleep_V) (PositAdvAdj big_A))
|
||||
ImpersCl (ComplV2 (UseVQ wonder_VQ) that_NP)
|
||||
ImpersCl (ComplV2 (UseVQ wonder_VQ) this_NP)
|
||||
ImpersCl (ComplV2A paint_V2A that_NP (ComparA big_A that_NP))
|
||||
ImpersCl (ComplV2A paint_V2A that_NP (ComparA big_A this_NP))
|
||||
ImpersCl (ComplV2A paint_V2A that_NP (PositA big_A))
|
||||
ImpersCl (ComplV2A paint_V2A this_NP (ComparA big_A that_NP))
|
||||
ImpersCl (ComplV2A paint_V2A this_NP (ComparA big_A this_NP))
|
||||
ImpersCl (ComplV2A paint_V2A this_NP (PositA big_A))
|
||||
ImpersCl (ComplVA become_VA (ComparA big_A that_NP))
|
||||
ImpersCl (ComplVA become_VA (ComparA big_A this_NP))
|
||||
ImpersCl (ComplVA become_VA (PositA big_A))
|
||||
ImpersCl (PassV2 (UseVQ wonder_VQ))
|
||||
ImpersCl (ReflV2 (UseVQ wonder_VQ))
|
||||
ImpersCl (UseComp (CompNP that_NP))
|
||||
ImpersCl (UseComp (CompNP this_NP))
|
||||
ImpersCl (ProgrVP (ComplV2 break_V2 that_NP))
|
||||
ImpersCl (ProgrVP (ComplV2 break_V2 this_NP))
|
||||
ImpersCl (ProgrVP (ComplV3 add_V3 this_NP that_NP))
|
||||
ImpersCl (ProgrVP (ComplV3 add_V3 this_NP this_NP))
|
||||
ImpersCl (ProgrVP (PassV2 break_V2))
|
||||
ImpersCl (ProgrVP (ReflV2 break_V2))
|
||||
ImpersCl (ProgrVP (UseV sleep_V))
|
||||
PredVP this_NP (ComplV2 break_V2 that_NP)
|
||||
PredVP this_NP (ComplV2 break_V2 this_NP)
|
||||
PredVP this_NP (ComplV3 add_V3 this_NP that_NP)
|
||||
PredVP this_NP (ComplV3 add_V3 this_NP this_NP)
|
||||
PredVP this_NP (PassV2 break_V2)
|
||||
PredVP this_NP (ReflV2 break_V2)
|
||||
PredVP this_NP (UseV sleep_V)
|
||||
GenericCl (ComplV2 break_V2 that_NP)
|
||||
GenericCl (ComplV2 break_V2 this_NP)
|
||||
GenericCl (ComplV3 add_V3 this_NP that_NP)
|
||||
GenericCl (ComplV3 add_V3 this_NP this_NP)
|
||||
GenericCl (PassV2 break_V2)
|
||||
GenericCl (ReflV2 break_V2)
|
||||
GenericCl (UseV sleep_V)
|
||||
ImpersCl (ComplV2 break_V2 that_NP)
|
||||
ImpersCl (ComplV2 break_V2 this_NP)
|
||||
ImpersCl (ComplV3 add_V3 this_NP that_NP)
|
||||
ImpersCl (ComplV3 add_V3 this_NP this_NP)
|
||||
ImpersCl (PassV2 break_V2)
|
||||
ImpersCl (ReflV2 break_V2)
|
||||
ImpersCl (UseV sleep_V)
|
||||
ExistNP that_NP
|
||||
ExistNP this_NP
|
||||
92
src/GF/Compile/Flatten.hs
Normal file
92
src/GF/Compile/Flatten.hs
Normal file
@@ -0,0 +1,92 @@
|
||||
module Flatten where
|
||||
|
||||
import Data.List
|
||||
-- import GF.Data.Operations
|
||||
|
||||
-- (AR 15/3/2006)
|
||||
--
|
||||
-- A method for flattening grammars: create many flat rules instead of
|
||||
-- a few deep ones. This is generally better for parsins.
|
||||
-- The rules are obtained as follows:
|
||||
-- 1. write a config file tellinq which constants are variables: format 'c : C'
|
||||
-- 2. generate a list of trees with their types: format 't : T'
|
||||
-- 3. for each such tree, form a fun rule 'fun fui : X -> Y -> T' and a lin
|
||||
-- rule 'lin fui x y = t' where x:X,y:Y is the list of variables in t, as
|
||||
-- found in the config file.
|
||||
-- 4. You can go on and produce def or transfer rules similar to the lin rules
|
||||
-- except for the keyword.
|
||||
--
|
||||
-- So far this module is used outside gf. You can e.g. generate a list of
|
||||
-- trees by 'gt', write it in a file, and then in ghci call
|
||||
-- flattenGrammar <Config> <Trees> <OutFile>
|
||||
|
||||
type Ident = String ---
|
||||
type Term = String ---
|
||||
type Rule = String ---
|
||||
|
||||
type Config = [(Ident,Ident)]
|
||||
|
||||
flattenGrammar :: FilePath -> FilePath -> FilePath -> IO ()
|
||||
flattenGrammar conff tf out = do
|
||||
conf <- readFile conff >>= return . lines
|
||||
ts <- readFile tf >>= return . lines
|
||||
writeFile out $ mkFlatten conf ts
|
||||
|
||||
mkFlatten :: [String] -> [String] -> String
|
||||
mkFlatten conff = unlines . concatMap getOne . zip [1..] where
|
||||
getOne (k,t) = let (x,y) = mkRules conf ("fu" ++ show k) t in [x,y]
|
||||
conf = getConfig conff
|
||||
|
||||
mkRules :: Config -> Ident -> Term -> (Rule,Rule)
|
||||
mkRules conf f t = (fun f ty, lin f (takeWhile (/=':') t)) where
|
||||
args = mkArgs conf ts
|
||||
ty = concat [a ++ " -> " | a <- map snd args] ++ val
|
||||
(ts,val) = let tt = lexTerm t in (init tt,last tt)
|
||||
--- f = mkIdent t
|
||||
fun c a = unwords [" fun", c, ":",a,";"]
|
||||
lin c a = unwords $ [" lin", c] ++ map fst args ++ ["=",a,";"]
|
||||
|
||||
mkArgs :: Config -> [Ident] -> [(Ident,Ident)]
|
||||
mkArgs conf ids = [(x,ty) | x <- ids, Just ty <- [lookup x conf]]
|
||||
|
||||
mkIdent :: Term -> Ident
|
||||
mkIdent = map mkChar where
|
||||
mkChar c = case c of
|
||||
'(' -> '6'
|
||||
')' -> '9'
|
||||
' ' -> '_'
|
||||
_ -> c
|
||||
|
||||
-- to get just the identifiers
|
||||
lexTerm :: String -> [String]
|
||||
lexTerm ss = case lex ss of
|
||||
[([c],ws)] | isSpec c -> lexTerm ws
|
||||
[(w@(_:_),ws)] -> w : lexTerm ws
|
||||
_ -> []
|
||||
where
|
||||
isSpec = flip elem "();:"
|
||||
|
||||
|
||||
getConfig :: [String] -> Config
|
||||
getConfig = map getOne . filter (not . null) where
|
||||
getOne line = case lexTerm line of
|
||||
v:c:_ -> (v,c)
|
||||
|
||||
ex = putStrLn fs where
|
||||
fs =
|
||||
mkFlatten
|
||||
["man_N : N",
|
||||
"sleep_V : V"
|
||||
]
|
||||
["PredVP (DefSg man_N) (UseV sleep_V) : Cl",
|
||||
"PredVP (DefPl man_N) (UseV sleep_V) : Cl"
|
||||
]
|
||||
|
||||
{-
|
||||
-- result of ex
|
||||
|
||||
fun fu1 : N -> V -> Cl ;
|
||||
lin fu1 man_N sleep_V = PredVP (DefSg man_N) (UseV sleep_V) ;
|
||||
fun fu2 : N -> V -> Cl ;
|
||||
lin fu2 man_N sleep_V = PredVP (DefPl man_N) (UseV sleep_V) ;
|
||||
-}
|
||||
Reference in New Issue
Block a user