diff --git a/src/compiler/GF/Compile/GeneratePMCFG.hs b/src/compiler/GF/Compile/GeneratePMCFG.hs index d34518cf6..9b8fb8765 100644 --- a/src/compiler/GF/Compile/GeneratePMCFG.hs +++ b/src/compiler/GF/Compile/GeneratePMCFG.hs @@ -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 = diff --git a/src/runtime/haskell/PGF/Forest.hs b/src/runtime/haskell/PGF/Forest.hs index 5cb4ccf51..9c47583ad 100644 --- a/src/runtime/haskell/PGF/Forest.hs +++ b/src/runtime/haskell/PGF/Forest.hs @@ -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 diff --git a/src/runtime/haskell/PGF/Linearize.hs b/src/runtime/haskell/PGF/Linearize.hs index d24e98d38..cf4c78193 100644 --- a/src/runtime/haskell/PGF/Linearize.hs +++ b/src/runtime/haskell/PGF/Linearize.hs @@ -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 diff --git a/src/runtime/haskell/PGF/Macros.hs b/src/runtime/haskell/PGF/Macros.hs index 31f7655b3..bfce7dd49 100644 --- a/src/runtime/haskell/PGF/Macros.hs +++ b/src/runtime/haskell/PGF/Macros.hs @@ -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