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

src/compiler/GF/Command/Commands.hs

@@ -1166,7 +1166,7 @@ allCommands = Map.fromList [
                                    map (map (unl . snd)) . tabularLinearizes pgf lang
        _ | isOpt "table"   opts -> unlines . concat . intersperse [[]] .
                     map (map (\(p,v) -> p+++":"+++unl v)) . tabularLinearizes pgf lang
-       _ | isOpt "bracket" opts -> showBracketedString . bracketedLinearize pgf lang
+       _ | isOpt "bracket" opts -> unwords . map showBracketedString . bracketedLinearize pgf lang
        _                        -> unl . linearize pgf lang
 
    -- replace each non-atomic constructor with mkC, where C is the val cat

src/runtime/haskell/PGF/Forest.hs

@@ -47,7 +47,7 @@ data Forest
 --------------------------------------------------------------------
 
 linearizeWithBrackets :: Maybe Int -> Forest -> BracketedString
-linearizeWithBrackets dp = head . snd . untokn Nothing . bracketedTokn dp
+linearizeWithBrackets dp = head . snd . untokn Nothing . (:[]) .bracketedTokn dp
 
 ---------------------------------------------------------------
 -- Internally we have to do everything with Tokn first because
@@ -67,8 +67,8 @@ bracketedTokn dp f@(Forest abs cnc forest root) =
 
     render forest arg@(PArg hypos fid) =
       case IntMap.lookup fid forest >>= Set.maxView of
-        Just (p,set) -> let (ct,fun,es,(_,lin)) = descend (if Set.null set then forest else IntMap.insert fid set forest) p
+        Just (p,set) -> let (ct,fid',fun,es,(_,lin)) = descend (if Set.null set then forest else IntMap.insert fid set forest) p
-                        in (ct,fun,es,(map getVar hypos,lin))
+                        in (ct,fid',fun,es,(map getVar hypos,lin))
         Nothing      -> error ("wrong forest id " ++ show fid)
       where
         descend forest (PApply funid args) = let (CncFun fun lins) = cncfuns cnc ! funid
@@ -78,9 +78,9 @@ bracketedTokn dp f@(Forest abs cnc forest root) =
                                                                        Just (DTyp _ cat _,_,_,_,_) -> cat
                                                  largs  = map (render forest) args
                                                  ltable = mkLinTable cnc isTrusted [] funid largs
-                                             in ((cat,fid),wildCId,either (const []) id $ getAbsTrees f arg Nothing dp,ltable)
+                                             in ((cat,fid),0,wildCId,either (const []) id $ getAbsTrees f arg Nothing dp,ltable)
         descend forest (PCoerce fid)       = render forest (PArg [] fid)
-        descend forest (PConst cat e ts)   = ((cat,fid),wildCId,[e],([],listArray (0,0) [map LeafKS ts]))
+        descend forest (PConst cat e ts)   = ((cat,fid),0,wildCId,[e],([],listArray (0,0) [map LeafKS ts]))
 
     getVar (fid,_)
       | fid == fidVar = wildCId

src/runtime/haskell/PGF/Linearize.hs

@@ -23,7 +23,9 @@ 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 Nothing . firstLin) . linTree pgf lang
+linearize pgf lang = concat . take 1 . map (unwords . concatMap flattenBracketedString . snd . untokn Nothing . firstLin cnc) . linTree pgf cnc
+  where
+    cnc = lookMap (error "no lang") lang (concretes pgf)
 
 -- | The same as 'linearizeAllLang' but does not return
 -- the language.
@@ -36,24 +38,29 @@ linearizeAllLang :: PGF -> Tree -> [(Language,String)]
 linearizeAllLang pgf t = [(lang,linearize pgf lang t) | lang <- Map.keys (concretes pgf)]
 
 -- | 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 Nothing . firstLin) . linTree pgf lang
+bracketedLinearize pgf lang = concat . map (snd . untokn Nothing . firstLin cnc) . linTree pgf cnc
   where
+    cnc = lookMap (error "no lang") lang (concretes pgf)
+
 --  head []       = error "cannot linearize"
     head []       = Leaf ""
             -- so that linearize = flattenBracketedString . bracketedLinearize
     head (bs:bss) = bs
 
-firstLin (_,arr)
+firstLin cnc arg@(ct@(cat,n_fid),fid,fun,es,(xs,lin)) =
-  | inRange (bounds arr) 0 = arr ! 0
+  case IntMap.lookup fid (linrefs cnc) of
-  | otherwise              = LeafKS []
+    Just (funid:_) -> snd (mkLinTable cnc (const True) [] funid [arg]) ! 0
+    _              -> [LeafKS []]
 
 -- | Creates a table from feature name to linearization. 
 -- The outher list encodes the variations
 tabularLinearizes :: PGF -> Language -> Expr -> [[(String,String)]]
-tabularLinearizes pgf lang e = map cnv (linTree pgf lang e)
+tabularLinearizes pgf lang e = map cnv (linTree pgf cnc e)
   where
-    cnv ((cat,_),lin) = zip (lbls cat) $ map (unwords . concatMap flattenBracketedString . snd . untokn Nothing) (elems lin)
+    cnc = lookMap (error "no lang") lang (concretes pgf)
+
+    cnv (ct@(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
@@ -63,11 +70,9 @@ tabularLinearizes pgf lang e = map cnv (linTree pgf lang e)
 -- Implementation
 --------------------------------------------------------------------
 
-linTree :: PGF -> Language -> Expr -> [(CncType, Array LIndex BracketedTokn)]
+linTree :: PGF -> Concr -> Expr -> [(CncType, FId, CId, [Expr], LinTable)]
-linTree pgf lang e = 
+linTree pgf cnc e = nub (map snd (lin Nothing 0 e [] [] e []))
-  nub [(ct,amapWithIndex (\label -> Bracket_ cat fid label fun es) lin) | (_,(ct@(cat,fid),fun,es,(xs,lin))) <- lin Nothing 0 e [] [] e []]
   where
-    cnc   = lookMap (error "no lang") lang (concretes pgf)
     lp    = lproductions cnc
 
     lin mb_cty n_fid e0 ys xs (EAbs _ x e) es = lin   mb_cty n_fid e0 ys (x:xs) e      es
@@ -78,18 +83,18 @@ linTree pgf lang e =
     lin mb_cty n_fid e0 ys xs (EMeta i)    es = def   mb_cty n_fid e0 ys    xs  ('?':show i)
     lin mb_cty n_fid e0 ys xs (EVar  i)    _  = def   mb_cty n_fid e0 ys    xs  (showCId ((xs++ys) !! i))
     lin mb_cty n_fid e0 ys xs (ELit l)     [] = case l of
-                                                   LStr s -> return (n_fid+1,((cidString,n_fid),wildCId,[e0],([],ss s)))
+                                                   LStr s -> return (n_fid+1,((cidString,n_fid),fidString,wildCId,[e0],([],ss s)))
-                                                   LInt n -> return (n_fid+1,((cidInt,   n_fid),wildCId,[e0],([],ss (show n))))
+                                                   LInt n -> return (n_fid+1,((cidInt,   n_fid),fidInt,   wildCId,[e0],([],ss (show n))))
-                                                   LFlt f -> return (n_fid+1,((cidFloat, n_fid),wildCId,[e0],([],ss (show f))))
+                                                   LFlt f -> return (n_fid+1,((cidFloat, n_fid),fidFloat, wildCId,[e0],([],ss (show f))))
 
     ss s = listArray (0,0) [[LeafKS s]]
 
-    apply :: Maybe CncType -> FId -> Expr -> [CId] -> [CId] -> CId -> [Expr] -> [(FId,(CncType, CId, [Expr], LinTable))]
+    apply :: Maybe CncType -> FId -> Expr -> [CId] -> [CId] -> CId -> [Expr] -> [(FId,(CncType, FId, CId, [Expr], LinTable))]
     apply mb_cty n_fid e0 ys xs f es =
       case Map.lookup f lp of
         Just prods -> do (funid,(cat,fid),ctys) <- getApps prods
                          (n_fid,args) <- descend n_fid (zip ctys es)
-                         return (n_fid+1,((cat,n_fid),f,[e0],mkLinTable cnc (const True) xs funid args))
+                         return (n_fid+1,((cat,n_fid),fid,f,[e0],mkLinTable cnc (const True) xs funid args))
         Nothing    -> def mb_cty n_fid e0 ys xs ("[" ++ showCId f ++ "]")  -- fun without lin
       where
         getApps prods =
@@ -112,10 +117,10 @@ linTree pgf lang e =
     def (Just (cat,fid)) n_fid e0 ys xs s =
       case IntMap.lookup fid (lindefs cnc) of
         Just funs           -> do funid <- funs
-                                  let args = [((wildCId, n_fid),wildCId,[e0],([],ss s))]
+                                  let args = [((wildCId, n_fid),fidString,wildCId,[e0],([],ss s))]
-                                  return (n_fid+2,((cat,n_fid+1),wildCId,[e0],mkLinTable cnc (const True) xs funid args))
+                                  return (n_fid+2,((cat,n_fid+1),fid,wildCId,[e0],mkLinTable cnc (const True) xs funid args))
         Nothing
-          | isPredefFId fid -> return (n_fid+2,((cat,n_fid+1),wildCId,[e0],(xs,listArray (0,0) [[LeafKS s]])))
+          | isPredefFId fid -> return (n_fid+2,((cat,n_fid+1),fid,wildCId,[e0],(xs,listArray (0,0) [[LeafKS s]])))
           | otherwise       -> do PCoerce fid <- maybe [] Set.toList (IntMap.lookup fid (pproductions cnc))
                                   def (Just (cat,fid)) n_fid e0 ys xs s
     def Nothing          n_fid e0 ys xs s = []

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 :: Maybe String -> [BracketedTokn] -> (Maybe String,[BracketedString])
-untokn nw bs = 
+untokn nw bss =
-  case untokn nw bs of
+  let (nw',bss') = mapAccumR untokn nw bss
-    (nw,Nothing ) -> (nw,[] )
+  in case sequence bss' of
-    (nw,Just bss) -> (nw,bss)
+       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
+        arg_lin                          = lin ! r
-        (ct@(cat,fid),fun,es,(xs,lin)) = args !! d
+        (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]

src/runtime/haskell/PGF/VisualizeTree.hs

@@ -137,11 +137,11 @@ graphvizDependencyTree format debug mlab ms pgf lang t = render $
 
     nil = -1
 
-    bs = bracketedLinearize pgf lang t
+    bss = bracketedLinearize pgf lang t
 
     root = (wildCId,nil,wildCId)
 
-    leaves = (root,0,root_lbl) : (groupAndIndexIt 1 . getLeaves root) bs
+    leaves = (root,0,root_lbl) : (groupAndIndexIt 1 . concatMap (getLeaves root)) bss
     deps   = let (_,(h,deps)) = getDeps 0 [] t []
              in (h,(dep_lbl,nil)):deps
 
@@ -213,8 +213,8 @@ graphvizParseTree :: PGF -> Language -> GraphvizOptions -> Tree -> String
 graphvizParseTree pgf lang opts = graphvizBracketedString opts . bracketedLinearize pgf lang
 
 
-graphvizBracketedString :: GraphvizOptions -> BracketedString -> String
+graphvizBracketedString :: GraphvizOptions -> [BracketedString] -> String
-graphvizBracketedString opts bs = render graphviz_code
+graphvizBracketedString opts bss = render graphviz_code
     where
       graphviz_code
           = text "graph {" $$
@@ -250,10 +250,10 @@ graphvizBracketedString opts bs = render graphviz_code
 
       nil = -1
       internal_nodes = [mkLevel internals |
-                        internals <- getInternals [(nil, bs)],
+                        internals <- getInternals (map ((,) nil) bss),
                         not (null internals)]
       leaf_nodes = mkLevel [(parent, id, word) |
-                            (id, (parent, word)) <- zip [100000..] (getLeaves nil bs)]
+                            (id, (parent, word)) <- zip [100000..] (concatMap (getLeaves nil) bss)]
 
       getInternals []    = []
       getInternals nodes
@@ -300,12 +300,12 @@ genPreAlignment pgf langs = lin2align . linsBracketed
  where
       linsBracketed t = [bracketedLinearize pgf lang t | lang <- langs]
 
-      lin2align :: [BracketedString] -> PreAlign
+      lin2align :: [[BracketedString]] -> PreAlign
-      lin2align bss =  PreAlign langSeqs langRels
+      lin2align bsss =  PreAlign langSeqs langRels
           where
            (langSeqs,langRels) = mkLayers leaves
            nil = -1
-           leaves = map (groupAndIndexIt 0 . getLeaves nil) bss
+           leaves = map (groupAndIndexIt 0 . concatMap (getLeaves nil)) bsss
 
            groupAndIndexIt id []          = []
            groupAndIndexIt id ((p,w):pws) = let (ws,pws1) = collect pws

src/server/PGFService.hs

@@ -601,9 +601,9 @@ linearizeTabular pgf tos tree =
         vs = concat (PGF.tabularLinearizes pgf to t)
 
 linearizeAndBind pgf mto tree =
-    [(to,s,bs) | to<-langs,
+    [(to,s,bss) | to<-langs,
-                 let bs = PGF.bracketedLinearize pgf to (transfer to tree)
+                 let bss = PGF.bracketedLinearize pgf to (transfer to tree)
-                     s = unwords . bind $ PGF.flattenBracketedString bs]
+                     s   = unwords . bind $ concatMap PGF.flattenBracketedString bss]
   where
     langs = if null mto then PGF.languages pgf else mto