prefix and variants restored in linearization

src-3.0/PGF.hs

@@ -55,8 +55,7 @@ module PGF(
           ) where
 
 import PGF.CId
-import PGF.Linearize hiding (linearize)
+import PGF.Linearize
-import qualified PGF.Linearize (linearize)
 import PGF.Generate
 import PGF.Macros
 import PGF.Data
@@ -177,7 +176,7 @@ readPGF f = do
   g <- parseGrammar s
   return $! toPGF g
 
-linearize pgf lang = PGF.Linearize.linearize pgf (mkCId lang)
+linearize pgf lang = concat . take 1 . PGF.Linearize.linearizes pgf (mkCId lang)
 
 parse pgf lang cat s = 
   case Map.lookup (mkCId lang) (concretes pgf) of

src-3.0/PGF/Linearize.hs

@@ -1,8 +1,9 @@
-module PGF.Linearize where
+module PGF.Linearize (linearizes,realize,realizes,linTree) where
 
 import PGF.CId
 import PGF.Data
 import PGF.Macros
+
 import qualified Data.Map as Map
 import Data.List
 
@@ -10,20 +11,35 @@ import Debug.Trace
 
 -- linearization and computation of concrete PGF Terms
 
-linearize :: PGF -> CId -> Tree -> String
+linearizes :: PGF -> CId -> Tree -> [String]
-linearize pgf lang = realize . linTree pgf lang
+linearizes pgf lang = realizes . linTree pgf lang
 
 realize :: Term -> String
-realize trm = case trm of
+realize = concat . take 1 . realizes
-  R ts     -> realize (ts !! 0)
+
-  S ss     -> unwords $ map realize ss
+realizes :: Term -> [String]
-  K t -> case t of
+realizes = map (unwords . untokn) . realizest
-    KS s -> s
+
-    KP s _ -> unwords s ---- prefix choice TODO
+realizest :: Term -> [[Tokn]]
-  W s t    -> s ++ realize t
+realizest trm = case trm of
-  FV ts    -> realize (ts !! 0)  ---- other variants TODO
+  R ts     -> realizest (ts !! 0)
-  TM s     -> s
+  S ss     -> map concat $ combinations $ map realizest ss
-  _ -> "ERROR " ++ show trm ---- debug
+  K t      -> [[t]]
+  W s t    -> [[KS (s ++ r)] | [KS r] <- realizest t]
+  FV ts    -> concatMap realizest ts
+  TM s     -> [[KS s]]
+  _ -> [[KS $ "REALIZE_ERROR " ++ show trm]] ---- debug
+
+untokn :: [Tokn] -> [String]
+untokn ts = case ts of
+  KP d _  : [] -> d
+  KP d vs : ws -> let ss@(s:_) = untokn ws in sel d vs s ++ ss
+  KS s    : ws -> s : untokn ws
+  []           -> []
+ where
+   sel d vs w = case [v | Alt v cs <- vs, any (\c -> isPrefixOf c w) cs] of
+     v:_ -> v
+     _   -> d
 
 linTree :: PGF -> CId -> Tree -> Term
 linTree pgf lang = lin

src-3.0/PGF/ShowLinearize.hs

@@ -43,11 +43,12 @@ prRecord = prr where
 -- uses the encoding of record types in PGF.paramlincat
 mkRecord :: Term -> Term -> Record
 mkRecord typ trm = case (typ,trm) of
-  (R rs,      R ts) -> RR [(str lab, mkRecord ty t) | (P lab ty, t) <- zip rs ts]
+  (_,         FV ts)  -> RFV $ map (mkRecord typ) ts
+  (R rs,      R ts)   -> RR [(str lab, mkRecord ty t) | (P lab ty, t) <- zip rs ts]
   (S [FV ps,ty],R ts) -> RT [(str par, mkRecord ty t) | (par,    t) <- zip ps ts]
   (_,W s (R ts))      -> mkRecord typ (R [K (KS (s ++ u)) | K (KS u) <- ts])
   (FV ps,       C i)  -> RCon $ str $ ps !! i
-  (S [],        _)    -> RS $ realize trm
+  (S [],        _)    -> RS $ str trm
   _                   -> RS $ show trm ---- printTree trm
  where
    str = realize