1
0
forked from GitHub/gf-core

fix in the GF compiler and runtime which let us to define pre construct detecting whether this is the last token.

This commit is contained in:
kr.angelov
2013-09-03 07:51:25 +00:00
parent d626a194de
commit df26b134fc
4 changed files with 15 additions and 10 deletions

View File

@@ -379,7 +379,7 @@ convertTerm opts sel ctype (Alts s alts)
strings (C u v) = strings u ++ strings v strings (C u v) = strings u ++ strings v
strings (Strs ss) = concatMap strings ss strings (Strs ss) = concatMap strings ss
strings (EPatt p) = getPatts p strings (EPatt p) = getPatts p
strings Empty = [] -- ?? strings Empty = [""]
strings t = bug $ "strings "++show t strings t = bug $ "strings "++show t
getPatts p = getPatts p =

View File

@@ -47,7 +47,7 @@ data Forest
-------------------------------------------------------------------- --------------------------------------------------------------------
linearizeWithBrackets :: Maybe Int -> Forest -> BracketedString linearizeWithBrackets :: Maybe Int -> Forest -> BracketedString
linearizeWithBrackets dp = head . snd . untokn "" . bracketedTokn dp linearizeWithBrackets dp = head . snd . untokn Nothing . bracketedTokn dp
--------------------------------------------------------------- ---------------------------------------------------------------
-- Internally we have to do everything with Tokn first because -- Internally we have to do everything with Tokn first because

View File

@@ -23,7 +23,7 @@ import qualified Data.Set as Set
-- | Linearizes given expression as string in the language -- | Linearizes given expression as string in the language
linearize :: PGF -> Language -> Tree -> String linearize :: PGF -> Language -> Tree -> String
linearize pgf lang = concat . take 1 . map (unwords . concatMap flattenBracketedString . snd . untokn "" . firstLin) . linTree pgf lang linearize pgf lang = concat . take 1 . map (unwords . concatMap flattenBracketedString . snd . untokn Nothing . firstLin) . linTree pgf lang
-- | The same as 'linearizeAllLang' but does not return -- | The same as 'linearizeAllLang' but does not return
-- the language. -- the language.
@@ -37,7 +37,7 @@ linearizeAllLang pgf t = [(lang,linearize pgf lang t) | lang <- Map.keys (concre
-- | Linearizes given expression as a bracketed string in the language -- | Linearizes given expression as a bracketed string in the language
bracketedLinearize :: PGF -> Language -> Tree -> BracketedString bracketedLinearize :: PGF -> Language -> Tree -> BracketedString
bracketedLinearize pgf lang = head . concat . map (snd . untokn "" . firstLin) . linTree pgf lang bracketedLinearize pgf lang = head . concat . map (snd . untokn Nothing . firstLin) . linTree pgf lang
where where
-- head [] = error "cannot linearize" -- head [] = error "cannot linearize"
head [] = Leaf "" head [] = Leaf ""
@@ -53,7 +53,7 @@ firstLin (_,arr)
tabularLinearizes :: PGF -> Language -> Expr -> [[(String,String)]] tabularLinearizes :: PGF -> Language -> Expr -> [[(String,String)]]
tabularLinearizes pgf lang e = map cnv (linTree pgf lang e) tabularLinearizes pgf lang e = map cnv (linTree pgf lang e)
where where
cnv ((cat,_),lin) = zip (lbls cat) $ map (unwords . concatMap flattenBracketedString . snd . untokn "") (elems lin) cnv ((cat,_),lin) = zip (lbls cat) $ map (unwords . concatMap flattenBracketedString . snd . untokn Nothing) (elems lin)
lbls cat = case Map.lookup cat (cnccats (lookConcr pgf lang)) of lbls cat = case Map.lookup cat (cnccats (lookConcr pgf lang)) of
Just (CncCat _ _ lbls) -> elems lbls Just (CncCat _ _ lbls) -> elems lbls

View File

@@ -177,19 +177,24 @@ lengthBracketedString :: BracketedString -> Int
lengthBracketedString (Leaf _) = 1 lengthBracketedString (Leaf _) = 1
lengthBracketedString (Bracket _ _ _ _ _ bss) = sum (map lengthBracketedString bss) lengthBracketedString (Bracket _ _ _ _ _ bss) = sum (map lengthBracketedString bss)
untokn :: String -> BracketedTokn -> (String,[BracketedString]) untokn :: Maybe String -> BracketedTokn -> (Maybe String,[BracketedString])
untokn nw (LeafKS ts) = (head ts,map Leaf ts) untokn nw (LeafKS ts) = (has_tok nw (head ts),map Leaf ts)
untokn nw (LeafKP d vs) = let ts = sel d vs nw untokn nw (LeafKP d vs) = let ts = sel d vs nw
in (head ts,map Leaf ts) in (has_tok nw (head ts),map Leaf ts)
where where
sel d vs nw = sel d vs Nothing = d
case [v | Alt v cs <- vs, any (\c -> isPrefixOf c nw) cs] of sel d vs (Just w) =
case [v | Alt v cs <- vs, any (\c -> isPrefixOf c w) cs] of
v:_ -> v v:_ -> v
_ -> d _ -> d
untokn nw (Bracket_ cat fid index fun es bss) = untokn nw (Bracket_ cat fid index fun es bss) =
let (nw',bss') = mapAccumR untokn nw bss let (nw',bss') = mapAccumR untokn nw bss
in (nw',[Bracket cat fid index fun es (concat bss')]) in (nw',[Bracket cat fid index fun es (concat bss')])
has_tok nw t
| null t = nw
| otherwise = Just t
type CncType = (CId, FId) -- concrete type is the abstract type (the category) + the forest id type CncType = (CId, FId) -- concrete type is the abstract type (the category) + the forest id
mkLinTable :: Concr -> (CncType -> Bool) -> [CId] -> FunId -> [(CncType,CId,[Expr],LinTable)] -> LinTable mkLinTable :: Concr -> (CncType -> Bool) -> [CId] -> FunId -> [(CncType,CId,[Expr],LinTable)] -> LinTable