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

3 files changed, 14 insertions, 9 deletions

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