mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-05-12 12:42:50 -06:00
changed names of resource-1.3; added a note on homepage on release
This commit is contained in:
105
src/PGF/ShowLinearize.hs
Normal file
105
src/PGF/ShowLinearize.hs
Normal file
@@ -0,0 +1,105 @@
|
||||
module PGF.ShowLinearize (
|
||||
collectWords,
|
||||
tableLinearize,
|
||||
recordLinearize,
|
||||
termLinearize,
|
||||
tabularLinearize,
|
||||
allLinearize
|
||||
) where
|
||||
|
||||
import PGF.CId
|
||||
import PGF.Data
|
||||
import PGF.Macros
|
||||
import PGF.Linearize
|
||||
|
||||
import GF.Data.Operations
|
||||
import Data.List
|
||||
import qualified Data.Map as Map
|
||||
|
||||
-- printing linearizations in different ways with source parameters
|
||||
|
||||
-- internal representation, only used internally in this module
|
||||
data Record =
|
||||
RR [(String,Record)]
|
||||
| RT [(String,Record)]
|
||||
| RFV [Record]
|
||||
| RS String
|
||||
| RCon String
|
||||
|
||||
prRecord :: Record -> String
|
||||
prRecord = prr where
|
||||
prr t = case t of
|
||||
RR fs -> concat $
|
||||
"{" :
|
||||
(intersperse ";" (map (\ (l,v) -> unwords [l,"=", prr v]) fs)) ++ ["}"]
|
||||
RT fs -> concat $
|
||||
"table {" :
|
||||
(intersperse ";" (map (\ (l,v) -> unwords [l,"=>",prr v]) fs)) ++ ["}"]
|
||||
RFV ts -> concat $
|
||||
"variants {" : (intersperse ";" (map prr ts)) ++ ["}"]
|
||||
RS s -> prQuotedString s
|
||||
RCon s -> s
|
||||
|
||||
-- uses the encoding of record types in PGF.paramlincat
|
||||
mkRecord :: Term -> Term -> Record
|
||||
mkRecord typ trm = case (typ,trm) of
|
||||
(_, FV ts) -> RFV $ map (mkRecord typ) ts
|
||||
(R rs, R ts) -> RR [(str lab, mkRecord ty t) | (P lab ty, t) <- zip rs ts]
|
||||
(S [FV ps,ty],R ts) -> RT [(str par, mkRecord ty t) | (par, t) <- zip ps ts]
|
||||
(_,W s (R ts)) -> mkRecord typ (R [K (KS (s ++ u)) | K (KS u) <- ts])
|
||||
(FV ps, C i) -> RCon $ str $ ps !! i
|
||||
(S [], _) -> RS $ str trm
|
||||
_ -> RS $ show trm ---- printTree trm
|
||||
where
|
||||
str = realize
|
||||
|
||||
-- show all branches, without labels and params
|
||||
allLinearize :: (String -> String) -> PGF -> CId -> Tree -> String
|
||||
allLinearize unlex pgf lang = concat . map (unlex . pr) . tabularLinearize pgf lang where
|
||||
pr (p,vs) = unlines vs
|
||||
|
||||
-- show all branches, with labels and params
|
||||
tableLinearize :: (String -> String) -> PGF -> CId -> Tree -> String
|
||||
tableLinearize unlex pgf lang = unlines . map pr . tabularLinearize pgf lang where
|
||||
pr (p,vs) = p +++ ":" +++ unwords (intersperse "|" (map unlex vs))
|
||||
|
||||
-- create a table from labels+params to variants
|
||||
tabularLinearize :: PGF -> CId -> Tree -> [(String,[String])]
|
||||
tabularLinearize pgf lang = branches . recLinearize pgf lang where
|
||||
branches r = case r of
|
||||
RR fs -> [( b,s) | (lab,t) <- fs, (b,s) <- branches t]
|
||||
RT fs -> [(lab +++ b,s) | (lab,t) <- fs, (b,s) <- branches t]
|
||||
RFV rs -> [([], ss) | (_,ss) <- concatMap branches rs]
|
||||
RS s -> [([], [s])]
|
||||
RCon _ -> []
|
||||
|
||||
-- show record in GF-source-like syntax
|
||||
recordLinearize :: PGF -> CId -> Tree -> String
|
||||
recordLinearize pgf lang = prRecord . recLinearize pgf lang
|
||||
|
||||
-- create a GF-like record, forming the basis of all functions above
|
||||
recLinearize :: PGF -> CId -> Tree -> Record
|
||||
recLinearize pgf lang tree = mkRecord typ $ linTree pgf lang tree where
|
||||
typ = case tree of
|
||||
Fun f _ -> lookParamLincat pgf lang $ valCat $ lookType pgf f
|
||||
|
||||
-- show PGF term
|
||||
termLinearize :: PGF -> CId -> Tree -> String
|
||||
termLinearize pgf lang = show . linTree pgf lang
|
||||
|
||||
|
||||
-- for Morphology: word, lemma, tags
|
||||
collectWords :: PGF -> CId -> [(String, [(String,String)])]
|
||||
collectWords pgf lang =
|
||||
concatMap collOne
|
||||
[(f,c,0) | (f,(DTyp [] c _,_)) <- Map.toList $ funs $ abstract pgf]
|
||||
where
|
||||
collOne (f,c,i) =
|
||||
fromRec f [prCId c] (recLinearize pgf lang (Fun f (replicate i (Meta 888))))
|
||||
fromRec f v r = case r of
|
||||
RR rs -> concat [fromRec f v t | (_,t) <- rs]
|
||||
RT rs -> concat [fromRec f (p:v) t | (p,t) <- rs]
|
||||
RFV rs -> concatMap (fromRec f v) rs
|
||||
RS s -> [(s,[(prCId f,unwords (reverse v))])]
|
||||
RCon c -> [] ---- inherent
|
||||
|
||||
Reference in New Issue
Block a user