msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

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

Browse Source
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
Download Patch File Download Diff File Expand all files Collapse all files

2
src/compiler/GF/Compile/GeneratePMCFG.hs
View File

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

2
src/runtime/haskell/PGF/Forest.hs
View File

@@ -47,7 +47,7 @@ data Forest
--------------------------------------------------------------------
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

6
src/runtime/haskell/PGF/Linearize.hs
View File

@@ -23,7 +23,7 @@ import qualified Data.Set as Set
-- | Linearizes given expression as string in the language
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 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
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
-- head [] = error "cannot linearize"
head [] = Leaf ""
@@ -53,7 +53,7 @@ firstLin (_,arr)
tabularLinearizes :: PGF -> Language -> Expr -> [[(String,String)]]
tabularLinearizes pgf lang e = map cnv (linTree pgf lang e)
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
Just (CncCat _ _ lbls) -> elems lbls

15
src/runtime/haskell/PGF/Macros.hs
View File

@@ -177,19 +177,24 @@ lengthBracketedString :: BracketedString -> Int
lengthBracketedString (Leaf _) = 1
lengthBracketedString (Bracket _ _ _ _ _ bss) = sum (map lengthBracketedString bss)
untokn :: String -> BracketedTokn -> (String,[BracketedString])
untokn nw (LeafKS ts) = (head ts,map Leaf ts)
untokn :: Maybe String -> BracketedTokn -> (Maybe String,[BracketedString])
untokn nw (LeafKS ts) = (has_tok nw (head ts),map Leaf ts)
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
sel d vs nw =
case [v | Alt v cs <- vs, any (\c -> isPrefixOf c nw) cs] of
sel d vs Nothing = d
sel d vs (Just w) =
case [v | Alt v cs <- vs, any (\c -> isPrefixOf c w) cs] of
v:_ -> v
_ -> d
untokn nw (Bracket_ cat fid index fun es bss) =
let (nw',bss') = mapAccumR untokn nw 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
mkLinTable :: Concr -> (CncType -> Bool) -> [CId] -> FunId -> [(CncType,CId,[Expr],LinTable)] -> LinTable