Lin to tables.

Lin to tables.
New unicode flag.
This commit is contained in:
aarne
2003-11-10 14:57:51 +00:00
parent c84ce99de2
commit 7a44450b34
6 changed files with 32 additions and 11 deletions

View File

@@ -178,6 +178,8 @@ optLinearizeTree opts0 gr t = case getOptVal opts transferFun of
lin mk
| oElem showRecord opts = liftM prt . linearizeNoMark g c
| oElem tableLin opts = liftM (unlines . map untok . prLinTable) .
allLinTables g c
| otherwise = return . untok . linTree2string mk g c
g = grammar gr
c = cncId gr
@@ -288,9 +290,10 @@ optTransfer opts g = case getOptVal opts transferFun of
optTokenizer :: Options -> GFGrammar -> String -> String
optTokenizer opts gr = show . customOrDefault opts useTokenizer customTokenizer gr
-- performs UTF8 if the language name is not *U.gf ; should be by gr option ---
optEncodeUTF8 :: Language -> GFGrammar -> String -> String
optEncodeUTF8 lang gr = case reverse (prLanguage lang) of
'U':_ -> id
-- performs UTF8 if the language does not have flag coding=utf8; replaces name*U
optEncodeUTF8 :: GFGrammar -> String -> String
optEncodeUTF8 gr = case getOptVal (stateOptions gr) uniCoding of
Just "utf8" -> id
_ -> encodeUTF8

View File

@@ -191,6 +191,7 @@ typeDisplay = aOpt "types"
noDepTypes = aOpt "nodeptypes"
extractGr = aOpt "extract"
pathList = aOpt "path"
uniCoding = aOpt "coding"
markLin = aOpt "mark"
markOptXML = oArg "xml"

View File

@@ -426,7 +426,7 @@ displaySStateJavaX env state = unlines $ tagXML "gfedit" $ concat [
opts = addOptions (optsSState state) -- state opts override
(addOption (markLin mark) (globalOptions env))
lin (n,gr) = (n, map uni $ linearizeState noWrap opts gr zipper) where
uni = optEncodeUTF8 n gr . mkUnicode
uni = optEncodeUTF8 gr . mkUnicode
exp = prprTree $ loc2tree zipper
zipper = stateSState state
linAll = map lin lgrs

View File

@@ -17,10 +17,11 @@ render :: [String] -> String
render = rend 0 where
rend i ss = case ss of
--H these three are hand-written
--H these four are hand-written
"{0" :ts -> cons "{" $ rend (i+1) ts
t :"}0" :ts -> cons t $ space "}" $ rend (i-1) ts
t : "." :ts -> cons t $ cons "." $ rend i ts
"\\" :ts -> cons "\\" $ rend i ts
"[" :ts -> cons "[" $ rend i ts
"(" :ts -> cons "(" $ rend i ts

View File

@@ -111,7 +111,7 @@ strs2strings = map unlex
-- this is just unwords; use an unlexer from Text to postprocess
unlex :: [Str] -> String
unlex = performBinds . concat . map sstr . take 1 ----
unlex = concat . map sstr . take 1 ----
-- finally, a top-level function to get a string from an expression
linTree2string :: Marker -> CanonGrammar -> Ident -> A.Tree -> String
@@ -132,6 +132,25 @@ allLinsOfTree gr a e = err (singleton . str) id $ do
ts <- rec2strTables r'
return $ concat $ sTables2strs $ strTables2sTables ts
-- the value is a list of structures arranged as records of tables of terms
allLinsAsRec :: CanonGrammar -> Ident -> A.Tree -> Err [[(Label,[([Patt],Term)])]]
allLinsAsRec gr c t = linearizeNoMark gr c t >>= allLinValues
-- the value is a list of structures arranged as records of tables of strings
-- only taking into account string fields
allLinTables :: CanonGrammar ->Ident ->A.Tree -> Err [[(Label,[([Patt],[String])])]]
allLinTables gr c t = do
r' <- allLinsAsRec gr c t
mapM (mapM getS) r'
where
getS (lab,pss) = liftM (curry id lab) $ mapM gets pss
gets (ps,t) = liftM (curry id ps . concat . map str2strings) $ strsFromTerm t
prLinTable :: [[(Label,[([Patt],[String])])]] -> [String]
prLinTable = concatMap prOne . concat where
prOne (lab,pss) = prt lab : map pr pss ----
pr (ps,ss) = unwords (map prt_ ps) +++ ":" +++ unwords ss
{-
-- the value is a list of strs
allLinStrings :: CanonGrammar -> Tree -> [Str]
@@ -145,9 +164,6 @@ allLinsAsStrs gr ft = do
lpts <- allLinearizations gr ft
return $ concat $ mapM (mapPairsM (mapPairsM strsFromTerm)) lpts
-- the value is a list of terms of type Str, not forgetting their arguments
allLinearizations :: CanonGrammar -> Tree -> Err [[(Label,[([Patt],Term)])]]
allLinearizations gr ft = linearizeTree gr ft >>= allLinValues
-- to a list of strings
linearizeToStrings :: CanonGrammar -> ([Int] ->Term -> Term) -> Tree -> Err [String]

View File

@@ -1 +1 @@
module Today where today = "Mon Nov 10 11:51:43 CET 2003"
module Today where today = "Mon Nov 10 16:45:46 CET 2003"