linref is now used by the linearizer. The visible change is that the 'l' command in the shell now can linearize discontinuous phrases

1 files changed, 11 insertions, 10 deletions

diff --git a/src/runtime/haskell/PGF/Macros.hs b/src/runtime/haskell/PGF/Macros.hs
index ffec9279f..ce0f8866e 100644
--- a/src/runtime/haskell/PGF/Macros.hs
+++ b/src/runtime/haskell/PGF/Macros.hs
@@ -179,11 +179,12 @@ lengthBracketedString :: BracketedString -> Int
 lengthBracketedString (Leaf _)              = 1
 lengthBracketedString (Bracket _ _ _ _ _ bss) = sum (map lengthBracketedString bss)
 
-untokn :: Maybe String -> BracketedTokn -> (Maybe String,[BracketedString])
-untokn nw bs = 
-  case untokn nw bs of
-    (nw,Nothing ) -> (nw,[] )
-    (nw,Just bss) -> (nw,bss)
+untokn :: Maybe String -> [BracketedTokn] -> (Maybe String,[BracketedString])
+untokn nw bss =
+  let (nw',bss') = mapAccumR untokn nw bss
+  in case sequence bss' of
+       Just bss -> (nw,concat bss)
+       Nothing  -> (nw,[])
   where
     untokn nw (Bracket_ cat fid index fun es bss) =
       let (nw',bss') = mapAccumR untokn nw bss
@@ -207,12 +208,12 @@ untokn nw bs =
 
 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,FId,CId,[Expr],LinTable)] -> LinTable
 mkLinTable cnc filter xs funid args = (xs,listArray (bounds lins) [computeSeq filter (elems (sequences cnc ! seqid)) args | seqid <- elems lins])
   where
     (CncFun _ lins) = cncfuns cnc ! funid
 
-computeSeq :: (CncType -> Bool) -> [Symbol] -> [(CncType,CId,[Expr],LinTable)] -> [BracketedTokn]
+computeSeq :: (CncType -> Bool) -> [Symbol] -> [(CncType,FId,CId,[Expr],LinTable)] -> [BracketedTokn]
 computeSeq filter seq args = concatMap compute seq
   where
     compute (SymCat d r)      = getArg d r
@@ -228,12 +229,12 @@ computeSeq filter seq args = concatMap compute seq
         filter ct   = [Bracket_ cat fid r fun es arg_lin]
       | otherwise   = arg_lin
       where
-        arg_lin                    = lin ! r
-        (ct@(cat,fid),fun,es,(xs,lin)) = args !! d
+        arg_lin                          = lin ! r
+        (ct@(cat,fid),_,fun,es,(xs,lin)) = args !! d
 
     getVar d r = [LeafKS (showCId (xs !! r))]
       where
-        (ct,fun,es,(xs,lin)) = args !! d
+        (ct,_,fun,es,(xs,lin)) = args !! d
 
 flattenBracketedString :: BracketedString -> [String]
 flattenBracketedString (Leaf w)              = [w]