unpar

3 files changed, 73 insertions, 6 deletions

diff --git a/src/GF/Canon/Unparametrize.hs b/src/GF/Canon/Unparametrize.hs
new file mode 100644
index 000000000..0ca6a2d9c
--- /dev/null
+++ b/src/GF/Canon/Unparametrize.hs
@@ -0,0 +1,63 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : Unparametrize
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/09/14 16:26:21 $ 
+-- > CVS $Author: aarne $
+-- > CVS $Revision: 1.1 $
+--
+-- Taking away parameters from a canonical grammar. All param
+-- types are replaced by {}, and only one branch is left in
+-- all tables. AR 14\/9\/2005.
+-----------------------------------------------------------------------------
+
+module GF.Canon.Unparametrize (unparametrizeCanon) where
+
+import GF.Canon.AbsGFC
+import GF.Infra.Ident
+import GF.Canon.GFC
+import qualified GF.Canon.CMacros as C
+import GF.Data.Operations
+import qualified GF.Infra.Modules as M
+
+unparametrizeCanon :: CanonGrammar -> CanonGrammar
+unparametrizeCanon (M.MGrammar modules) = 
+    M.MGrammar $ map unparModule modules where 
+
+  unparModule (i,m) = case m of
+    M.ModMod (M.Module mt@(M.MTConcrete _) st fs me ops js) ->
+      let me' = [(unparIdent j,incl) | (j,incl) <- me] in 
+      (unparIdent i, M.ModMod (M.Module mt st fs me' ops (mapTree unparInfo js)))
+    _ -> (i,m)
+
+  unparInfo (c,info) = case info of
+    CncCat ty t m   -> (c, CncCat   (unparCType ty) (unparTerm t) m)
+    CncFun k xs t m -> (c, CncFun k xs (unparTerm t) m)
+    AnyInd b i      -> (c, AnyInd b (unparIdent i))
+    _ -> (c,info)
+
+  unparCType ty = case ty of
+    RecType ls -> RecType [Lbg lab (unparCType t) | Lbg lab t <- ls]
+    Table _ v  -> unparCType v --- Table unitType (unparCType v)
+    Cn _       -> unitType
+    _ -> ty
+
+  unparTerm t = case t of
+    Par _ _ -> unitTerm
+    T _ cs  -> unparTerm (head [t | Cas _ t <- cs])
+    V _ ts  -> unparTerm (head ts)
+    S t _   -> unparTerm t
+{-
+    T _ cs  -> V unitType [unparTerm (head [t | Cas _ t <- cs])]
+    V _ ts  -> V unitType [unparTerm (head ts)]
+    S t _   -> S (unparTerm t) unitTerm
+-}
+    _ -> C.composSafeOp unparTerm t
+
+  unitType = RecType []
+  unitTerm = R []
+
+  unparIdent (IC s) = IC $ "UP_" ++ s
diff --git a/src/GF/Shell/HelpFile.hs b/src/GF/Shell/HelpFile.hs
index 6a5b1c7e1..e0c03fd8c 100644
--- a/src/GF/Shell/HelpFile.hs
+++ b/src/GF/Shell/HelpFile.hs
@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/09/13 08:33:58 $
--- > CVS $Author: bringert $
--- > CVS $Revision: 1.11 $
+-- > CVS $Date: 2005/09/14 16:26:22 $
+-- > CVS $Author: aarne $
+-- > CVS $Revision: 1.12 $
 --
 -- Help on shell commands. Generated from HelpFile by 'make help'.
 -- PLEASE DON'T EDIT THIS FILE.
@@ -530,6 +530,7 @@ txtHelpFile =
   "\n    -printer=slf_graphviz   the same automaton as in SLF, but in Graphviz format" ++
   "\n    -printer=fa_graphviz    a finite automaton with labelled edges" ++
   "\n    -printer=regular        a regular grammar in a simple BNF" ++
+  "\n    -printer=unpar          a gfc grammar with parameters eliminated" ++
   "\n" ++
   "\n-startcat, like -cat, but used in grammars (to avoid clash with keyword cat)" ++
   "\n" ++
diff --git a/src/GF/UseGrammar/Custom.hs b/src/GF/UseGrammar/Custom.hs
index e9a72f0f4..19af14984 100644
--- a/src/GF/UseGrammar/Custom.hs
+++ b/src/GF/UseGrammar/Custom.hs
@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/09/12 16:10:24 $ 
--- > CVS $Author: bringert $
--- > CVS $Revision: 1.72 $
+-- > CVS $Date: 2005/09/14 16:26:22 $ 
+-- > CVS $Author: aarne $
+-- > CVS $Revision: 1.73 $
 --
 -- A database for customizable GF shell commands. 
 --
@@ -81,6 +81,7 @@ import qualified GF.Conversion.GFC as Cnv
 import qualified GF.Conversion.Types as CnvTypes
 import qualified GF.Conversion.Haskell as CnvHaskell
 import qualified GF.Conversion.Prolog as CnvProlog
+import GF.Canon.Unparametrize
 
 import GF.Canon.GFC
 import qualified GF.Canon.MkGFC as MC
@@ -258,6 +259,8 @@ customGrammarPrinter =
   ,(strCI "words",   unwords . stateGrammarWords)
   ,(strCI "printnames", C.prPrintnamesGrammar . stateGrammarST)
   ,(strCI "stat",    prStatistics . stateGrammarST)
+  ,(strCI "unpar",   prCanon . unparametrizeCanon . stateGrammarST)
+
 {- ----
    (strCI "gf",      prt  . st2grammar . stateGrammarST)  -- DEFAULT
   ,(strCI "canon",   showCanon "Lang" . stateGrammarST)