From 25f486858fcd3bad89fda6317abe750be5d29855 Mon Sep 17 00:00:00 2001
From: aarne <aarne@cs.chalmers.se>
Date: Sun, 22 Jun 2008 09:01:32 +0000
Subject: prefix and variants restored in linearization

---
 src-3.0/PGF/Linearize.hs | 42 +++++++++++++++++++++++++++++-------------
 1 file changed, 29 insertions(+), 13 deletions(-)

(limited to 'src-3.0/PGF/Linearize.hs')

diff --git a/src-3.0/PGF/Linearize.hs b/src-3.0/PGF/Linearize.hs
index c3341698f..5bc40438f 100644
--- a/src-3.0/PGF/Linearize.hs
+++ b/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
-linearize pgf lang = realize . linTree pgf lang
+linearizes :: PGF -> CId -> Tree -> [String]
+linearizes pgf lang = realizes . linTree pgf lang
 
 realize :: Term -> String
-realize trm = case trm of
-  R ts     -> realize (ts !! 0)
-  S ss     -> unwords $ map realize ss
-  K t -> case t of
-    KS s -> s
-    KP s _ -> unwords s ---- prefix choice TODO
-  W s t    -> s ++ realize t
-  FV ts    -> realize (ts !! 0)  ---- other variants TODO
-  TM s     -> s
-  _ -> "ERROR " ++ show trm ---- debug
+realize = concat . take 1 . realizes
+
+realizes :: Term -> [String]
+realizes = map (unwords . untokn) . realizest
+
+realizest :: Term -> [[Tokn]]
+realizest trm = case trm of
+  R ts     -> realizest (ts !! 0)
+  S ss     -> map concat $ combinations $ map realizest ss
+  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
-- 
cgit v1.2.3