a major refactoring in the C and the Haskell runtimes. Note incompatible change in the PGF format!!!

The following are the outcomes:

   - Predef.nonExist is fully supported by both the Haskell and the C runtimes

   - Predef.BIND is now an internal compiler defined token. For now
     it behaves just as usual for the Haskell runtime, i.e. it generates &+.
     However, the special treatment will let us to handle it properly in 
     the C runtime.

   - This required a major change in the PGF format since both 
     nonExist and BIND may appear inside 'pre' and this was not supported
     before.

1 files changed, 16 insertions, 32 deletions

diff --git a/src/compiler/GF/Compile/GeneratePMCFG.hs b/src/compiler/GF/Compile/GeneratePMCFG.hs
index 0afa2bd49..9642110bc 100644
--- a/src/compiler/GF/Compile/GeneratePMCFG.hs
+++ b/src/compiler/GF/Compile/GeneratePMCFG.hs
@@ -14,7 +14,7 @@ module GF.Compile.GeneratePMCFG
     ) where
 
 import PGF.CId
-import PGF.Data(Alternative(..),CncCat(..),Symbol(..),fidVar)
+import PGF.Data(CncCat(..),Symbol(..),fidVar)
 
 import GF.Infra.Option
 import GF.Grammar hiding (Env, mkRecord, mkTable)
@@ -376,30 +376,24 @@ convertTerm opts sel ctype (FV vars)    = do term <- variants vars
 convertTerm opts sel ctype (C t1 t2)    = do v1 <- convertTerm opts sel ctype t1
                                              v2 <- convertTerm opts sel ctype t2
                                              return (CStr (concat [s | CStr s <- [v1,v2]]))
-convertTerm opts sel ctype (K t)        = return (CStr [SymKS [t]])
+convertTerm opts sel ctype (K t)        = return (CStr [SymKS t])
 convertTerm opts sel ctype Empty        = return (CStr [])
-convertTerm opts sel ctype (Alts s alts)
-                                        = return (CStr [SymKP (strings s) [Alt (strings u) (strings v) | (u,v) <- alts]])
-           where
-             strings (K s)     = [s]
-             strings (C u v)   = strings u ++ strings v
-             strings (Strs ss) = concatMap strings ss
-             strings (EPatt p) = getPatts p
-             strings Empty     = [""]
-             strings t = bug $ "strings "++show t
-
-             getPatts p =
-               case p of
-                 PAlt a b  -> getPatts a ++ getPatts b
-                 PString s -> [s]
-                 PSeq a b  -> [s ++ t | s <- getPatts a, t <- getPatts b]
-                 _ -> ppbug $ hang (text "not valid pattern in pre expression:")
-                                   4
-                                   (ppPatt Unqualified 0 p)
+convertTerm opts sel ctype (Alts s alts)= do CStr s <- convertTerm opts CNil ctype s
+                                             alts <- forM alts $ \(u,Strs ps) -> do 
+                                                            CStr u <- convertTerm opts CNil ctype u
+                                                            ps     <- mapM (convertTerm opts CNil ctype) ps
+                                                            return (u,map unSym ps)
+                                             return (CStr [SymKP s alts])
+  where
+    unSym (CStr [])        = ""
+    unSym (CStr [SymKS t]) = t
+    unSym _                = ppbug $ hang (text "invalid prefix in pre expression:") 4 (ppU 0 (Alts s alts))
 
 convertTerm opts sel ctype (Q (m,f))
   | m == cPredef &&
     f == cNonExist                      = return (CStr [SymNE])
+  | m == cPredef &&
+    f == cBIND                          = return (CStr [SymBIND])
 
 convertTerm opts sel@(CProj l _) ctype (ExtR t1 t2@(R rs2))
                     | l `elem` map fst rs2 = convertTerm opts sel ctype t2
@@ -492,7 +486,7 @@ addSequencesV seqs (CRec vs)  = let !(seqs1,vs1) = mapAccumL' (\seqs (lbl,b) ->
 addSequencesV seqs (CTbl pt vs)=let !(seqs1,vs1) = mapAccumL' (\seqs (trm,b) -> let !(seqs',b') = addSequencesB seqs b
                                                                                 in (seqs',(trm,b'))) seqs vs
                                 in (seqs1,CTbl pt vs1)
-addSequencesV seqs (CStr lin) = let !(seqs1,seqid) = addSequence seqs (optimizeLin lin)
+addSequencesV seqs (CStr lin) = let !(seqs1,seqid) = addSequence seqs lin
                                 in (seqs1,CStr seqid)
 addSequencesV seqs (CPar i)   = (seqs,CPar i)
 
@@ -502,16 +496,6 @@ mapAccumL' f s (x:xs) = (s'',y:ys)
                         where !(s', y ) = f s x
                               !(s'',ys) = mapAccumL' f s' xs
 
-optimizeLin [] = []
-optimizeLin lin@(SymKS _ : _) = 
-  let (ts,lin') = getRest lin
-  in SymKS ts : optimizeLin lin'
-  where
-    getRest (SymKS ts : lin) = let (ts1,lin') = getRest lin
-                               in (ts++ts1,lin')
-    getRest             lin  = ([],lin)
-optimizeLin (sym : lin) = sym : optimizeLin lin
-
 addSequence :: SeqSet -> [Symbol] -> (SeqSet,SeqId)
 addSequence seqs lst =
   case Map.lookup seq seqs of
@@ -629,4 +613,4 @@ mkSetArray map = array (0,Map.size map-1) [(v,k) | (k,v) <- Map.toList map]
 bug msg = ppbug (text msg)
 ppbug = error . render . hang (text "Internal error in GeneratePMCFG:") 4
 
-ppU = ppTerm Unqualified
\ No newline at end of file
+ppU = ppTerm Unqualified