mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-05-23 09:52:55 -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
|
lin mk
|
||||||
| oElem showRecord opts = liftM prt . linearizeNoMark g c
|
| 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
|
| otherwise = return . untok . linTree2string mk g c
|
||||||
g = grammar gr
|
g = grammar gr
|
||||||
c = cncId gr
|
c = cncId gr
|
||||||
@@ -288,9 +290,10 @@ optTransfer opts g = case getOptVal opts transferFun of
|
|||||||
optTokenizer :: Options -> GFGrammar -> String -> String
|
optTokenizer :: Options -> GFGrammar -> String -> String
|
||||||
optTokenizer opts gr = show . customOrDefault opts useTokenizer customTokenizer gr
|
optTokenizer opts gr = show . customOrDefault opts useTokenizer customTokenizer gr
|
||||||
|
|
||||||
-- performs UTF8 if the language name is not *U.gf ; should be by gr option ---
|
-- performs UTF8 if the language does not have flag coding=utf8; replaces name*U
|
||||||
optEncodeUTF8 :: Language -> GFGrammar -> String -> String
|
|
||||||
optEncodeUTF8 lang gr = case reverse (prLanguage lang) of
|
optEncodeUTF8 :: GFGrammar -> String -> String
|
||||||
'U':_ -> id
|
optEncodeUTF8 gr = case getOptVal (stateOptions gr) uniCoding of
|
||||||
|
Just "utf8" -> id
|
||||||
_ -> encodeUTF8
|
_ -> encodeUTF8
|
||||||
|
|
||||||
|
|||||||
@@ -191,6 +191,7 @@ typeDisplay = aOpt "types"
|
|||||||
noDepTypes = aOpt "nodeptypes"
|
noDepTypes = aOpt "nodeptypes"
|
||||||
extractGr = aOpt "extract"
|
extractGr = aOpt "extract"
|
||||||
pathList = aOpt "path"
|
pathList = aOpt "path"
|
||||||
|
uniCoding = aOpt "coding"
|
||||||
|
|
||||||
markLin = aOpt "mark"
|
markLin = aOpt "mark"
|
||||||
markOptXML = oArg "xml"
|
markOptXML = oArg "xml"
|
||||||
|
|||||||
@@ -426,7 +426,7 @@ displaySStateJavaX env state = unlines $ tagXML "gfedit" $ concat [
|
|||||||
opts = addOptions (optsSState state) -- state opts override
|
opts = addOptions (optsSState state) -- state opts override
|
||||||
(addOption (markLin mark) (globalOptions env))
|
(addOption (markLin mark) (globalOptions env))
|
||||||
lin (n,gr) = (n, map uni $ linearizeState noWrap opts gr zipper) where
|
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
|
exp = prprTree $ loc2tree zipper
|
||||||
zipper = stateSState state
|
zipper = stateSState state
|
||||||
linAll = map lin lgrs
|
linAll = map lin lgrs
|
||||||
|
|||||||
@@ -17,10 +17,11 @@ render :: [String] -> String
|
|||||||
render = rend 0 where
|
render = rend 0 where
|
||||||
rend i ss = case ss of
|
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
|
"{0" :ts -> cons "{" $ rend (i+1) ts
|
||||||
t :"}0" :ts -> cons t $ space "}" $ rend (i-1) ts
|
t :"}0" :ts -> cons t $ space "}" $ rend (i-1) ts
|
||||||
t : "." :ts -> cons t $ cons "." $ rend i ts
|
t : "." :ts -> cons t $ cons "." $ rend i ts
|
||||||
|
"\\" :ts -> cons "\\" $ rend i ts
|
||||||
|
|
||||||
"[" :ts -> 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
|
-- this is just unwords; use an unlexer from Text to postprocess
|
||||||
unlex :: [Str] -> String
|
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
|
-- finally, a top-level function to get a string from an expression
|
||||||
linTree2string :: Marker -> CanonGrammar -> Ident -> A.Tree -> String
|
linTree2string :: Marker -> CanonGrammar -> Ident -> A.Tree -> String
|
||||||
@@ -132,6 +132,25 @@ allLinsOfTree gr a e = err (singleton . str) id $ do
|
|||||||
ts <- rec2strTables r'
|
ts <- rec2strTables r'
|
||||||
return $ concat $ sTables2strs $ strTables2sTables ts
|
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
|
-- the value is a list of strs
|
||||||
allLinStrings :: CanonGrammar -> Tree -> [Str]
|
allLinStrings :: CanonGrammar -> Tree -> [Str]
|
||||||
@@ -145,9 +164,6 @@ allLinsAsStrs gr ft = do
|
|||||||
lpts <- allLinearizations gr ft
|
lpts <- allLinearizations gr ft
|
||||||
return $ concat $ mapM (mapPairsM (mapPairsM strsFromTerm)) lpts
|
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
|
-- to a list of strings
|
||||||
linearizeToStrings :: CanonGrammar -> ([Int] ->Term -> Term) -> Tree -> Err [String]
|
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