mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-17 00:39:32 -06:00
Lin to tables.
Lin to tables. New unicode flag.
This commit is contained in:
@@ -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
|
||||
|
||||
|
||||
@@ -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"
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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]
|
||||
|
||||
@@ -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"
|
||||
|
||||
Reference in New Issue
Block a user