PGF is now real synchronous PMCFG

7 files changed, 51 insertions, 285 deletions

diff --git a/src/compiler/GF/Compile/Export.hs b/src/compiler/GF/Compile/Export.hs
index 29f35e32a..463a48aa6 100644
--- a/src/compiler/GF/Compile/Export.hs
+++ b/src/compiler/GF/Compile/Export.hs
@@ -2,10 +2,10 @@ module GF.Compile.Export where
 
 import PGF.CId
 import PGF.Data (PGF(..))
+import PGF.Printer
 import GF.Compile.PGFtoHaskell
 import GF.Compile.PGFtoProlog
 import GF.Compile.PGFtoJS
-import GF.Compile.PGFPretty
 import GF.Infra.Option
 import GF.Speech.CFG
 import GF.Speech.PGFToCFG
@@ -20,6 +20,7 @@ import GF.Speech.PrRegExp
 
 import Data.Maybe
 import System.FilePath
+import Text.PrettyPrint
 
 -- top-level access to code generation
 
@@ -29,8 +30,7 @@ exportPGF :: Options
           -> [(FilePath,String)] -- ^ List of recommended file names and contents.
 exportPGF opts fmt pgf = 
     case fmt of
-      FmtPGFPretty    -> multi "txt" prPGFPretty
-      FmtPMCFGPretty  -> single "pmcfg" prPMCFGPretty
+      FmtPGFPretty    -> multi "txt" (render . ppPGF)
       FmtJavaScript   -> multi "js"  pgf2js
       FmtHaskell      -> multi "hs"  (grammar2haskell opts name)
       FmtProlog       -> multi "pl"  grammar2prolog 
diff --git a/src/compiler/GF/Compile/GeneratePMCFG.hs b/src/compiler/GF/Compile/GeneratePMCFG.hs
index e6e3fdc79..27426203f 100644
--- a/src/compiler/GF/Compile/GeneratePMCFG.hs
+++ b/src/compiler/GF/Compile/GeneratePMCFG.hs
@@ -35,24 +35,20 @@ import Control.Exception
 -- main conversion function
 
 
-convertConcrete :: Options -> Abstr -> CId -> Concr -> IO ParserInfo
-convertConcrete opts abs lang cnc = do
+--convertConcrete :: Options -> Abstr -> CId -> Concr -> IO Concr
+convertConcrete opts lang flags printnames abs_defs cnc_defs lincats params lin_defs = do
   let env0 = emptyGrammarEnv cnc_defs cat_defs params
   when (flag optProf opts) $ do
     profileGrammar lang cnc_defs env0 pfrules
   let env1 = expandHOAS abs_defs cnc_defs cat_defs lin_defs env0
       env2 = List.foldl' (convertRule cnc_defs) env1 pfrules
-  return $ getParserInfo env2
+  return $ getParserInfo flags printnames env2
   where
-    abs_defs = Map.assocs (funs abs)
-    cnc_defs = Map.union (opers cnc) (lins cnc) -- "union big+small most efficient"
-    cat_defs = Map.insert cidVar (S []) (lincats cnc)
-    params   = paramlincats cnc
-    lin_defs = lindefs cnc
+    cat_defs = Map.insert cidVar (S []) lincats
 
     pfrules = [
       (PFRule id args (0,res) (map findLinType args) (findLinType (0,res)) term) | 
-        (id, (ty,_,_)) <- abs_defs, let (args,res) = typeSkeleton ty, 
+        (id, (ty,_,_)) <- Map.toList abs_defs, let (args,res) = typeSkeleton ty, 
         term <- maybeToList (Map.lookup id cnc_defs)]
         
     findLinType (_,id) = fromMaybe (error $ "No lincat for " ++ show id) (Map.lookup id cat_defs)
@@ -364,7 +360,7 @@ expandHOAS abs_defs cnc_defs lincats lindefs env =
   foldl add_varFun (foldl (\env ncat -> add_hoFun (add_hoCat env ncat) ncat) env hoTypes) (Map.keys lincats)
   where
     hoTypes :: [(Int,CId)]
-    hoTypes = sortNub [(n,c) | (_,(ty,_,_)) <- abs_defs
+    hoTypes = sortNub [(n,c) | (_,(ty,_,_)) <- Map.toList abs_defs
                              , (n,c) <- fst (typeSkeleton ty), n > 0]
   
     -- add a range of PMCFG categories for each GF high-order category
@@ -438,16 +434,18 @@ addFCoercion env@(GrammarEnv last_id catSet seqSet funSet crcSet prodSet) sub_fc
                 Nothing   -> let !fcat = last_id+1
                              in (GrammarEnv fcat catSet seqSet funSet (Map.insert sub_fcats fcat crcSet) prodSet,fcat)
 
-getParserInfo :: GrammarEnv -> ParserInfo
-getParserInfo (GrammarEnv last_id catSet seqSet funSet crcSet prodSet) =
-  ParserInfo { functions   = mkArray funSet
-             , sequences   = mkArray seqSet
-             , productions = IntMap.union prodSet coercions
-             , pproductions = IntMap.empty
-             , lproductions = Map.empty
-             , startCats   = maybe Map.empty (Map.map (\(start,end,_,lbls) -> (start,end,lbls))) (IntMap.lookup 0 catSet)
-             , totalCats   = last_id+1
-             }
+getParserInfo :: Map.Map CId String -> Map.Map CId String -> GrammarEnv -> Concr
+getParserInfo flags printnames (GrammarEnv last_id catSet seqSet funSet crcSet prodSet) =
+  Concr { cflags = flags
+        , printnames = printnames
+        , functions   = mkArray funSet
+        , sequences   = mkArray seqSet
+        , productions = IntMap.union prodSet coercions
+        , pproductions = IntMap.empty
+        , lproductions = Map.empty
+        , startCats   = maybe Map.empty (Map.map (\(start,end,_,lbls) -> (start,end,lbls))) (IntMap.lookup 0 catSet)
+        , totalCats   = last_id+1
+        }
   where
     mkArray map = array (0,Map.size map-1) [(v,k) | (k,v) <- Map.toList map]
     
diff --git a/src/compiler/GF/Compile/GrammarToPGF.hs b/src/compiler/GF/Compile/GrammarToPGF.hs
index 31c768045..d272404e3 100644
--- a/src/compiler/GF/Compile/GrammarToPGF.hs
+++ b/src/compiler/GF/Compile/GrammarToPGF.hs
@@ -1,11 +1,12 @@
 {-# LANGUAGE PatternGuards #-}
-module GF.Compile.GrammarToPGF (mkCanon2gfcc,addParsers) where
+module GF.Compile.GrammarToPGF (mkCanon2pgf) where
 
 import GF.Compile.Export
 import GF.Compile.GeneratePMCFG
 
 import PGF.CId
 import PGF.Macros(updateProductionIndices)
+import PGF.Check(checkLin)
 import qualified PGF.Macros as CM
 import qualified PGF.Data as C
 import qualified PGF.Data as D
@@ -36,28 +37,22 @@ traceD s t = t
 
 
 -- the main function: generate PGF from GF.
-mkCanon2gfcc :: Options -> String -> SourceGrammar -> (String,D.PGF)
-mkCanon2gfcc opts cnc gr = 
-  (showIdent abs, (canon2gfcc opts pars . reorder abs . canon2canon opts abs) gr)
+mkCanon2pgf :: Options -> String -> SourceGrammar -> IO D.PGF
+mkCanon2pgf opts cnc gr = (canon2pgf opts pars . reorder abs . canon2canon opts abs) gr
   where
     abs = err (const c) id $ M.abstractOfConcrete gr c where c = identC (BS.pack cnc)
     pars = mkParamLincat gr
 
--- Adds parsers for all concretes
-addParsers :: Options -> D.PGF -> IO D.PGF
-addParsers opts pgf = do cncs <- sequence [conv lang cnc | (lang,cnc) <- Map.toList (D.concretes pgf)]
-                         return $ updateProductionIndices $ pgf { D.concretes = Map.fromList cncs }
-  where
-    conv lang cnc = do pinfo <- convertConcrete opts (D.abstract pgf) lang cnc
-                       return (lang,cnc { D.parser = Just pinfo })
-
 -- Generate PGF from GFCM.
 -- this assumes a grammar translated by canon2canon
 
-canon2gfcc :: Options -> (Ident -> Ident -> C.Term) -> SourceGrammar -> D.PGF
-canon2gfcc opts pars cgr@(M.MGrammar ((a,abm):cms)) = 
-  (if dump opts DumpCanon then trace (render (vcat (map (ppModule Qualified) (M.modules cgr)))) else id) $
-     D.PGF an cns gflags abs cncs 
+canon2pgf :: Options -> (Ident -> Ident -> C.Term) -> SourceGrammar -> IO D.PGF
+canon2pgf opts pars cgr@(M.MGrammar ((a,abm):cms)) = do
+  if dump opts DumpCanon
+    then putStrLn (render (vcat (map (ppModule Qualified) (M.modules cgr))))
+    else return ()
+  cncs <- sequence [mkConcr lang (i2i lang) mo | (lang,mo) <- cms]
+  return (D.PGF an cns gflags abs (Map.fromList cncs))
  where
   -- abstract
   an  = (i2i a)
@@ -82,13 +77,15 @@ canon2gfcc opts pars cgr@(M.MGrammar ((a,abm):cms)) =
   catfuns = Map.fromList 
     [(cat,[f | (f, (C.DTyp _ c _,_,_)) <- lfuns, c==cat]) | (cat,_) <- lcats]
 
-  cncs  = Map.fromList [mkConcr lang (i2i lang) mo | (lang,mo) <- cms]
-  mkConcr lang0 lang mo = 
-      (lang,D.Concr flags lins opers lincats lindefs printnames params fcfg)
+  mkConcr lang0 lang mo = do
+    lins' <- case mapM (checkLin (funs,lins,lincats) lang) (Map.toList lins) of
+               Ok x    -> return x
+               Bad msg -> fail msg
+    cnc <- convertConcrete opts lang flags printnames funs (Map.fromList (map fst lins')) lincats params lindefs
+    return (lang, cnc)
     where
       js = tree2list (M.jments mo)
       flags   = Map.fromList [(mkCId f,x) | (f,x) <- optionsPGF (M.flags mo)]
-      opers   = Map.fromAscList [] -- opers will be created as optimization
       utf     = id -- trace (show lang0 +++ show flags) $ 
                 -- if moduleFlag optEncoding (moduleOptions (M.flags mo)) == UTF_8
                 --  then id else id 
diff --git a/src/compiler/GF/Compile/OptimizePGF.hs b/src/compiler/GF/Compile/OptimizePGF.hs
deleted file mode 100644
index 4ef8ce5cf..000000000
--- a/src/compiler/GF/Compile/OptimizePGF.hs
+++ /dev/null
@@ -1,118 +0,0 @@
-module GF.Compile.OptimizePGF where
-
-import PGF.CId
-import PGF.Data
-import PGF.Macros
-
-import GF.Data.Operations
-
-import Data.List
-import qualified Data.Map as Map
-
-
--- back-end optimization: 
--- suffix analysis followed by common subexpression elimination
-
-optPGF :: PGF -> PGF
-optPGF = cseOptimize . suffixOptimize
-
-suffixOptimize :: PGF -> PGF
-suffixOptimize = mapConcretes opt
- where 
-  opt cnc = cnc {
-    lins = Map.map optTerm (lins cnc),
-    lindefs = Map.map optTerm (lindefs cnc)
-  }
-
-cseOptimize :: PGF -> PGF
-cseOptimize = mapConcretes subex
-
--- analyse word form lists into prefix + suffixes
--- suffix sets can later be shared by subex elim
-
-optTerm :: Term -> Term  
-optTerm tr = case tr of
-    R ts@(_:_:_) | all isK ts -> mkSuff $ optToks [s | K (KS s) <- ts]
-    R ts  -> R $ map optTerm ts
-    P t v -> P (optTerm t) v
-    _ -> tr
- where
-  optToks ss = prf : suffs where
-    prf = pref (head ss) (tail ss)
-    suffs = map (drop (length prf)) ss
-    pref cand ss = case ss of
-      s1:ss2 -> if isPrefixOf cand s1 then pref cand ss2 else pref (init cand) ss
-      _ -> cand
-  isK t = case t of
-    K (KS _) -> True
-    _ -> False
-  mkSuff ("":ws) = R (map (K . KS) ws)
-  mkSuff (p:ws) = W p (R (map (K . KS) ws))
-
-
--- common subexpression elimination
-
----subex :: [(CId,Term)] -> [(CId,Term)]
-subex :: Concr -> Concr
-subex cnc = err error id $ do
-  (tree,_) <- appSTM (getSubtermsMod cnc) (Map.empty,0)
-  return $ addSubexpConsts tree cnc
-
-type TermList = Map.Map Term (Int,Int) -- number of occs, id
-type TermM a = STM (TermList,Int) a
-
-addSubexpConsts :: TermList -> Concr -> Concr
-addSubexpConsts tree cnc = cnc {
-  opers = Map.fromList [(f,recomp f trm) | (f,trm) <- ops],
-  lins  = rec lins,
-  lindefs = rec lindefs
-  }
- where
-   ops = [(fid id, trm) | (trm,(_,id)) <- Map.assocs tree]
-   mkOne (f,trm) = (f, recomp f trm)
-   recomp f t = case Map.lookup t tree of
-     Just (_,id) | fid id /= f -> F $ fid id -- not to replace oper itself
-     _ -> case t of
-       R ts   -> R $ map (recomp f) ts
-       S ts   -> S $ map (recomp f) ts
-       W s t  -> W s (recomp f t)
-       P t p  -> P (recomp f t) (recomp f p)
-       _ -> t
-   fid n = mkCId $ "_" ++ show n
-   rec field = Map.fromAscList [(f,recomp f trm) | (f,trm) <- Map.assocs (field cnc)]
-
-
-getSubtermsMod :: Concr -> TermM TermList
-getSubtermsMod cnc = do
-  mapM getSubterms (Map.assocs (lins cnc))
-  mapM getSubterms (Map.assocs (lindefs cnc))
-  (tree0,_) <- readSTM
-  return $ Map.filter (\ (nu,_) -> nu > 1) tree0
- where
-   getSubterms (f,trm) = collectSubterms trm >> return ()
-
-collectSubterms :: Term -> TermM ()
-collectSubterms t = case t of
-  R ts -> do
-    mapM collectSubterms ts
-    add t
-  S ts -> do
-    mapM collectSubterms ts
-    add t
-  W s u -> do
-    collectSubterms u
-    add t
-  P p u -> do
-    collectSubterms p
-    collectSubterms u
-    add t
-  _ -> return ()
- where
-   add t = do
-     (ts,i) <- readSTM
-     let 
-       ((count,id),next) = case Map.lookup t ts of
-         Just (nu,id) -> ((nu+1,id), i)
-         _ ->            ((1,   i ), i+1)
-     writeSTM (Map.insert t (count,id) ts, next)
-
diff --git a/src/compiler/GF/Compile/PGFPretty.hs b/src/compiler/GF/Compile/PGFPretty.hs
deleted file mode 100644
index 706081999..000000000
--- a/src/compiler/GF/Compile/PGFPretty.hs
+++ /dev/null
@@ -1,94 +0,0 @@
--- | Print a part of a PGF grammar on the human-readable format used in 
--- the paper "PGF: A Portable Run-Time Format for Type-Theoretical Grammars".
-module GF.Compile.PGFPretty (prPGFPretty, prPMCFGPretty) where
-
-import PGF.CId
-import PGF.Data
-import PGF.Macros
-import PGF.PMCFG
-
-import GF.Data.Operations
-
-import Data.Map (Map)
-import qualified Data.Map as Map
-import Text.PrettyPrint.HughesPJ
-
-
-prPGFPretty :: PGF -> String
-prPGFPretty pgf = render $ prAbs (abstract pgf) $$ prAll (prCnc (abstract pgf)) (concretes pgf)
-
-prPMCFGPretty :: PGF -> CId -> String
-prPMCFGPretty pgf lang = render $
-  case lookParser pgf lang of
-    Nothing    -> empty
-    Just pinfo -> text "language" <+> ppCId lang $$ ppPMCFG pinfo
-                                                   
-
-prAbs :: Abstr -> Doc
-prAbs a = prAll prCat (cats a) $$ prAll prFun (funs a)
-
-prCat :: CId -> [Hypo] -> Doc
-prCat c h | isLiteralCat c = empty
-          | otherwise = text "cat" <+> ppCId c
-
-prFun :: CId -> (Type,Int,[Equation]) -> Doc
-prFun f (t,_,_) = text "fun" <+> ppCId f <+> text ":" <+> prType t
-
-prType :: Type -> Doc
-prType t = parens (hsep (punctuate (text ",") (map ppCId cs))) <+> text "->" <+> ppCId c
-  where (cs,c) = catSkeleton t
-
-
--- FIXME: show concrete name
--- FIXME: inline opers first
-prCnc :: Abstr -> CId -> Concr -> Doc
-prCnc abstr name c = prAll prLinCat (lincats c) $$ prAll prLin (lins (expand c))
-  where
-    prLinCat :: CId -> Term -> Doc
-    prLinCat c t | isLiteralCat c = empty
-                 | otherwise = text "lincat" <+> ppCId c <+> text "=" <+> pr 0 t
-        where
-          pr p (R ts) = prec p 1 (hsep (punctuate (text " *") (map (pr 1) ts)))
-          pr _ (S []) = text "Str"
-          pr _ (C n) = text "Int_" <> text (show (n+1))
-
-    prLin :: CId -> Term -> Doc
-    prLin f t = text "lin" <+> ppCId f <+> text "=" <+> pr 0 t
-        where
-          pr :: Int -> Term -> Doc
-          pr p (R ts) = text "<" <+> hsep (punctuate (text ",") (map (pr 0) ts)) <+> text ">"
-          pr p (P t1 t2) = prec p 3 (pr 3 t1 <> text "!" <> pr 3 t2)
-          pr p (S ts) = prec p 2 (hsep (punctuate (text " ++") (map (pr 2) ts)))
-          pr p (K (KS t)) = doubleQuotes (text t)
-          pr p (K _) = empty
-          pr p (V i) = text ("argv_" ++ show (i+1))
-          pr p (C i) = text (show (i+1))
-          pr p (FV ts) = prec p 1 (hsep (punctuate (text " |") (map (pr 1) ts)))
-          pr _ t = error $ "PGFPretty.prLin " ++ show t
-
-linCat :: Concr -> CId -> Term
-linCat cnc c = Map.findWithDefault (error $ "lincat: " ++ showCId c) c (lincats cnc)
-
-prec :: Int -> Int -> Doc -> Doc
-prec p m | p >= m = parens
-         | otherwise = id
-
-expand :: Concr -> Concr
-expand cnc = cnc { lins = Map.map (f "") (lins cnc) }
-  where 
-    -- FIXME: handle KP
-    f :: String -> Term -> Term
-    f w (R ts) = R (map (f w) ts)
-    f w (P t1 t2) = P (f w t1) (f w t2)
-    f w (S []) = S (if null w then [] else [K (KS w)])
-    f w (S (t:ts)) = S (f w t : map (f "") ts)
-    f w (FV ts) = FV (map (f w) ts)
-    f w (W s t) = f (w++s) t
-    f w (K (KS t)) = K (KS (w++t))
-    f w (F o) = f w (Map.findWithDefault (error $ "Bad oper: " ++ showCId o) o (opers cnc))
-    f w t = t
-
--- Utilities
-
-prAll :: (a -> b -> Doc) -> Map a b -> Doc
-prAll p m = vcat [ p k v | (k,v) <- Map.toList m]
\ No newline at end of file
diff --git a/src/compiler/GF/Compile/PGFtoJS.hs b/src/compiler/GF/Compile/PGFtoJS.hs
index 67d18809a..1f6d083a2 100644
--- a/src/compiler/GF/Compile/PGFtoJS.hs
+++ b/src/compiler/GF/Compile/PGFtoJS.hs
@@ -29,7 +29,7 @@ pgf2js pgf =
    start = showCId $ M.lookStartCat pgf
    grammar = new "GFGrammar" [js_abstract, js_concrete]
    js_abstract = abstract2js start as
-   js_concrete = JS.EObj $ map (concrete2js n) cs
+   js_concrete = JS.EObj $ map concrete2js cs
 
 abstract2js :: String -> Abstr -> JS.Expr
 abstract2js start ds = new "GFAbstract" [JS.EStr start, JS.EObj $ map absdef2js (Map.assocs (funs ds))]
@@ -39,18 +39,21 @@ absdef2js (f,(typ,_,_)) =
   let (args,cat) = M.catSkeleton typ in 
     JS.Prop (JS.IdentPropName (JS.Ident (showCId f))) (new "Type" [JS.EArray [JS.EStr (showCId x) | x <- args], JS.EStr (showCId cat)])
 
-concrete2js :: String -> (CId,Concr) -> JS.Property
-concrete2js n (c, cnc) =
-    JS.Prop l (new "GFConcrete" ([flags,(JS.EObj $ ((map (cncdef2js n (showCId c)) ds) ++ litslins))] ++
-                                 maybe [] parser2js (parser cnc)))
+concrete2js :: (CId,Concr) -> JS.Property
+concrete2js (c,cnc) =
+  JS.Prop l (new "GFConcrete" [mapToJSObj JS.EStr $ cflags cnc,
+                               JS.EObj $ [JS.Prop (JS.IntPropName cat) (JS.EArray (map frule2js (Set.toList set))) | (cat,set) <- IntMap.toList (productions cnc)],
+                               JS.EArray $ (map ffun2js (Array.elems (functions cnc))),
+                               JS.EArray $ (map seq2js (Array.elems (sequences cnc))),
+                               JS.EObj $ map cats (Map.assocs (startCats cnc)),
+                               JS.EInt (totalCats cnc)])
   where 
-   flags = mapToJSObj JS.EStr $ cflags cnc
    l  = JS.IdentPropName (JS.Ident (showCId c))
-   ds = concatMap Map.assocs [lins cnc, opers cnc, lindefs cnc]
    litslins = [JS.Prop (JS.StringPropName    "Int") (JS.EFun [children] [JS.SReturn $ new "Arr" [JS.EIndex (JS.EVar children) (JS.EInt 0)]]), 
                JS.Prop (JS.StringPropName  "Float") (JS.EFun [children] [JS.SReturn $ new "Arr" [JS.EIndex (JS.EVar children) (JS.EInt 0)]]),
                JS.Prop (JS.StringPropName "String") (JS.EFun [children] [JS.SReturn $ new "Arr" [JS.EIndex (JS.EVar children) (JS.EInt 0)]])]
-
+   cats (c,(start,end,_)) = JS.Prop (JS.IdentPropName (JS.Ident (showCId c))) (JS.EObj [JS.Prop (JS.IdentPropName (JS.Ident "s")) (JS.EInt start)
+                                                                                       ,JS.Prop (JS.IdentPropName (JS.Ident "e")) (JS.EInt end)])
 
 cncdef2js :: String -> String -> (CId,Term) -> JS.Property
 cncdef2js n l (f, t) = JS.Prop (JS.IdentPropName (JS.Ident (showCId f))) (JS.EFun [children] [JS.SReturn (term2js n l t)])
@@ -88,17 +91,6 @@ argIdent n = JS.Ident ("x" ++ show n)
 children :: JS.Ident
 children = JS.Ident "cs"
 
--- Parser
-parser2js :: ParserInfo -> [JS.Expr]
-parser2js p  = [new "Parser" [JS.EObj $ [JS.Prop (JS.IntPropName cat) (JS.EArray (map frule2js (Set.toList set))) | (cat,set) <- IntMap.toList (productions p)],
-                              JS.EArray $ (map ffun2js (Array.elems (functions p))),
-                              JS.EArray $ (map seq2js (Array.elems (sequences p))),
-                              JS.EObj $ map cats (Map.assocs (startCats p)),
-                              JS.EInt (totalCats p)]]
-  where 
-    cats (c,(start,end,_)) = JS.Prop (JS.IdentPropName (JS.Ident (showCId c))) (JS.EObj [JS.Prop (JS.IdentPropName (JS.Ident "s")) (JS.EInt start)
-                                                                                      ,JS.Prop (JS.IdentPropName (JS.Ident "e")) (JS.EInt end)])
-
 frule2js :: Production -> JS.Expr
 frule2js (FApply funid args) = new "Rule"   [JS.EInt funid, JS.EArray (map JS.EInt args)]
 frule2js (FCoerce arg)       = new "Coerce" [JS.EInt arg]
diff --git a/src/compiler/GF/Compile/PGFtoProlog.hs b/src/compiler/GF/Compile/PGFtoProlog.hs
index 538430747..9effbec70 100644
--- a/src/compiler/GF/Compile/PGFtoProlog.hs
+++ b/src/compiler/GF/Compile/PGFtoProlog.hs
@@ -88,20 +88,11 @@ plFundef (fun, (_,_,eqs)) = [plFact "def" [plp fun, plp fundef']]
 -- concrete syntax
 
 plConcrete :: (CId, Concr) -> [String]
-plConcrete (cncname, Concr cflags lins opers lincats lindefs 
-                   _printnames _paramlincats _parser) =
+plConcrete (cncname, cnc) =
     ["", "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%",
      "%% concrete module: " ++ plp cncname] ++
     clauseHeader "%% cncflag(?Flag, ?Value): flags for concrete syntax"
-                     (map (mod . plpFact2 "cncflag") (Map.assocs cflags)) ++ 
-    clauseHeader "%% lincat(?Cat, ?Linearization type)"
-                     (map (mod . plpFact2 "lincat") (Map.assocs lincats)) ++ 
-    clauseHeader "%% lindef(?Cat, ?Linearization default)"
-                     (map (mod . plpFact2 "lindef") (Map.assocs lindefs)) ++ 
-    clauseHeader "%% lin(?Fun, ?Linearization)"
-                     (map (mod . plpFact2 "lin") (Map.assocs lins)) ++
-    clauseHeader "%% oper(?Oper, ?Linearization)"
-                     (map (mod . plpFact2 "oper") (Map.assocs opers))
+                     (map (mod . plpFact2 "cncflag") (Map.assocs (cflags cnc)))
     where mod clause = plp cncname ++ ": " ++ clause