diff options
| -rw-r--r-- | src/GF/Command/Commands.hs | 10 | ||||
| -rw-r--r-- | src/PGF/Linearize.hs | 37 | ||||
| -rw-r--r-- | src/PGF/ShowLinearize.hs | 7 |
3 files changed, 48 insertions, 6 deletions
diff --git a/src/GF/Command/Commands.hs b/src/GF/Command/Commands.hs index 35a86ad96..a78fa0fac 100644 --- a/src/GF/Command/Commands.hs +++ b/src/GF/Command/Commands.hs @@ -273,6 +273,7 @@ allCommands cod env@(pgf, mos) = Map.fromList [ exec = \opts -> return . fromStrings . map (optLin opts), options = [ ("all","show all forms and variants"), + ("bracket","show tree structure with brackets and paths to nodes"), ("multi","linearize to all languages (default)"), ("record","show source-code-like record"), ("table","show all forms labelled by parameters"), @@ -555,10 +556,11 @@ allCommands cod env@(pgf, mos) = Map.fromList [ _ -> unlines [linear opts lang t | lang <- optLangs opts] linear opts lang = let unl = unlex opts lang in case opts of - _ | isOpt "all" opts -> allLinearize unl pgf lang - _ | isOpt "table" opts -> tableLinearize unl pgf lang - _ | isOpt "term" opts -> termLinearize pgf lang - _ | isOpt "record" opts -> recordLinearize pgf lang + _ | isOpt "all" opts -> allLinearize unl pgf lang + _ | isOpt "table" opts -> tableLinearize unl pgf lang + _ | isOpt "term" opts -> termLinearize pgf lang + _ | isOpt "record" opts -> recordLinearize pgf lang + _ | isOpt "bracket" opts -> markLinearize pgf lang _ -> unl . linearize pgf lang treebank opts t = unlines $ diff --git a/src/PGF/Linearize.hs b/src/PGF/Linearize.hs index 469654f07..3b0c42597 100644 --- a/src/PGF/Linearize.hs +++ b/src/PGF/Linearize.hs @@ -1,4 +1,5 @@ -module PGF.Linearize (linearizes,realize,realizes,linTree) where +module PGF.Linearize + (linearizes,realize,realizes,linTree, linTreeMark,linearizesMark) where import PGF.CId import PGF.Data @@ -118,3 +119,37 @@ compute pgf lang args = comp where TM s -> TM s _ -> error ("ERROR in grammar compiler: field from " ++ show t) t +--------- +-- markup with tree positions + +linearizesMark :: PGF -> CId -> Tree -> [String] +linearizesMark pgf lang = realizes . linTreeMark pgf lang + +linTreeMark :: PGF -> CId -> Tree -> Term +linTreeMark pgf lang = lin [] + where + lin p (Abs xs e ) = case lin p e of + R ts -> R $ ts ++ (Data.List.map (kks . prCId) xs) + TM s -> R $ (TM s) : (Data.List.map (kks . prCId) xs) + lin p (Fun fun es) = let argVariants = + mapM (\ (i,e) -> liftVariants $ lin (sub p i) e) (zip [0..] es) + in variants [mark p $ compute pgf lang args $ look fun | args <- argVariants] + lin p (Lit (LStr s)) = mark p $ R [kks (show s)] -- quoted + lin p (Lit (LInt i)) = mark p $ R [kks (show i)] + lin p (Lit (LFlt d)) = mark p $ R [kks (show d)] + lin p (Var x) = mark p $ TM (prCId x) + lin p (Meta i) = mark p $ TM (show i) + + look = lookLin pgf lang + + mark p t = case t of + R ts -> R $ map (mark p) ts + FV ts -> R $ map (mark p) ts + S ts -> S $ bracket p ts + K s -> S $ bracket p [t] + W s (R ts) -> R [mark p $ kks (s ++ u) | K (KS u) <- ts] + _ -> t + -- otherwise in normal form + + bracket p ts = [kks ("["++show p)] ++ ts ++ [kks "]"] + sub p i = p ++ [i] diff --git a/src/PGF/ShowLinearize.hs b/src/PGF/ShowLinearize.hs index 87538201c..26fddd6c2 100644 --- a/src/PGF/ShowLinearize.hs +++ b/src/PGF/ShowLinearize.hs @@ -4,7 +4,8 @@ module PGF.ShowLinearize ( recordLinearize, termLinearize, tabularLinearize, - allLinearize + allLinearize, + markLinearize ) where import PGF.CId @@ -89,6 +90,10 @@ recLinearize pgf lang tree = mkRecord typ $ linTree pgf lang tree where termLinearize :: PGF -> CId -> Tree -> String termLinearize pgf lang = show . linTree pgf lang +-- show bracketed markup with references to tree structure +markLinearize :: PGF -> CId -> Tree -> String +markLinearize pgf lang t = concat $ take 1 $ linearizesMark pgf lang t + -- for Morphology: word, lemma, tags collectWords :: PGF -> CId -> [(String, [(String,String)])] |