From 8bc8929c59d2bd6f28d5dab9c7a9ca8a1c23609e Mon Sep 17 00:00:00 2001
From: krasimir <krasimir@chalmers.se>
Date: Tue, 16 Jun 2009 11:56:08 +0000
Subject: completely phrase based parser and support for pre {} in PMCFG

---
 src/GF/Compile/GFCCtoJS.hs      |  2 +-
 src/GF/Compile/GenerateFCFG.hs  |  5 ++++-
 src/GF/Compile/GeneratePMCFG.hs | 21 +++++++++++++++------
 3 files changed, 20 insertions(+), 8 deletions(-)

(limited to 'src/GF/Compile')

diff --git a/src/GF/Compile/GFCCtoJS.hs b/src/GF/Compile/GFCCtoJS.hs
index 8ca321eaa..6a82d02d9 100644
--- a/src/GF/Compile/GFCCtoJS.hs
+++ b/src/GF/Compile/GFCCtoJS.hs
@@ -129,7 +129,7 @@ lins2js p ls = JS.EArray [JS.EArray [sym2js s | s <- Array.elems (sequences p Ar
 sym2js :: FSymbol -> JS.Expr
 sym2js (FSymCat n l) = new "ArgProj" [JS.EInt n, JS.EInt l]
 sym2js (FSymLit n l) = new "ArgProj" [JS.EInt n, JS.EInt l]
-sym2js (FSymTok (KS t)) = new "Terminal" [JS.EStr t]
+sym2js (FSymKS [t])  = new "Terminal" [JS.EStr t]
 
 new :: String -> [JS.Expr] -> JS.Expr
 new f xs = JS.ENew (JS.Ident f) xs
diff --git a/src/GF/Compile/GenerateFCFG.hs b/src/GF/Compile/GenerateFCFG.hs
index 7597e71dd..096572659 100644
--- a/src/GF/Compile/GenerateFCFG.hs
+++ b/src/GF/Compile/GenerateFCFG.hs
@@ -158,7 +158,10 @@ translateLin idxArgs ((lbl,syms) : lins) grammarEnv lbl'
   | lbl' == lbl = addFSeq grammarEnv (lbl,map instSym syms)
   | otherwise   = translateLin idxArgs lins grammarEnv lbl'
   where
-    instSym = either (\(lbl, nr, xnr) -> instCat lbl nr xnr 0 idxArgs) FSymTok
+    instSym = either (\(lbl, nr, xnr) -> instCat lbl nr xnr 0 idxArgs) 
+                     (\t -> case t of
+                              KS s -> FSymKS [s]
+                              KP strs vars -> FSymKP strs vars)
     instCat lbl nr xnr nr' ((idx,xargs):idxArgs)
       | nr == idx = let (fcat, PFCat _ rcs _) = xargs !! xnr
                     in FSymCat (nr'+xnr) (index lbl rcs 0)
diff --git a/src/GF/Compile/GeneratePMCFG.hs b/src/GF/Compile/GeneratePMCFG.hs
index 667b403b5..ab79f9b30 100644
--- a/src/GF/Compile/GeneratePMCFG.hs
+++ b/src/GF/Compile/GeneratePMCFG.hs
@@ -213,10 +213,22 @@ addSequences' env (Return  v)       = let (env1,v1) = addSequences env v
 addSequences :: GrammarEnv -> Value [FSymbol] -> (GrammarEnv, Value SeqId)
 addSequences env (Rec vs)  = let (env1,vs1) = List.mapAccumL addSequences' env vs
                              in (env1,Rec vs1)
-addSequences env (Str lin) = let (env1,seqid) = addFSeq env lin
+addSequences env (Str lin) = let (env1,seqid) = addFSeq env (optimizeLin lin)
                              in (env1,Str seqid)
 addSequences env (Con i)   = (env,Con i)
 
+
+optimizeLin [] = []
+optimizeLin lin@(FSymKS _ : _) = 
+  let (ts,lin') = getRest lin
+  in FSymKS ts : optimizeLin lin'
+  where
+    getRest (FSymKS ts : lin) = let (ts1,lin') = getRest lin
+                                in (ts++ts1,lin')
+    getRest              lin  = ([],lin)
+optimizeLin (sym : lin) = sym : optimizeLin lin
+
+
 convertTerm :: TermMap -> FPath -> Term -> Term -> CnvMonad (Value [FSymbol])
 convertTerm cnc_defs sel ctype (V nr)     = convertArg ctype nr (reverse sel)
 convertTerm cnc_defs sel ctype (C nr)     = convertCon ctype nr (reverse sel)
@@ -227,11 +239,8 @@ convertTerm cnc_defs sel ctype (FV vars)  = do term <- variants vars
                                                convertTerm cnc_defs sel ctype term
 convertTerm cnc_defs sel ctype (S ts)     = do vs <- mapM (convertTerm cnc_defs sel ctype) ts
                                                return (Str (concat [s | Str s <- vs]))
---convertTerm cnc_defs sel ctype (K t)      = return (Str [FSymTok t])
-convertTerm cnc_defs sel ctype (K (KS t)) = return (Str [FSymTok (KS t)])
-convertTerm cnc_defs sel ctype (K (KP strs vars)) =
-  do toks <- variants (strs:[strs' | Alt strs' _ <- vars])
-     return (Str (map (FSymTok . KS) toks))
+convertTerm cnc_defs sel ctype (K (KS t)) = return (Str [FSymKS [t]])
+convertTerm cnc_defs sel ctype (K (KP s v))=return (Str [FSymKP s v])
 convertTerm cnc_defs sel ctype (F id)     = case Map.lookup id cnc_defs of
                                               Just term -> convertTerm cnc_defs sel ctype term
                                               Nothing   -> error ("unknown id " ++ prCId id)
-- 
cgit v1.2.3