From f70d4e592c8f06f6e153253cc0153a0ffdda945f Mon Sep 17 00:00:00 2001
From: peb <peb@cs.chalmers.se>
Date: Thu, 9 Mar 2006 12:39:11 +0000
Subject: [PATCH] fixing prolog printing

---
 src/GF/Conversion/Prolog.hs        | 6 ++++--
 src/GF/Conversion/RemoveErasing.hs | 8 +++++++-
 2 files changed, 11 insertions(+), 3 deletions(-)

diff --git a/src/GF/Conversion/Prolog.hs b/src/GF/Conversion/Prolog.hs
index 235f31198..ebad8e587 100644
--- a/src/GF/Conversion/Prolog.hs
+++ b/src/GF/Conversion/Prolog.hs
@@ -36,6 +36,8 @@ import GF.Infra.Ident (Ident(..))
 import Data.Maybe (maybeToList, listToMaybe)
 import Data.Char (isLower, isAlphaNum)
 
+import GF.System.Tracing
+
 ----------------------------------------------------------------------
 -- | printing multiple languages at the same time
 
@@ -172,8 +174,8 @@ prtProfile (Unify args) = foldr1 (prtOper "=") (map (show . succ) args)
 prtProfile (Constant forest) = prtForest forest
 
 prtForest (FMeta) = " ? "
-prtForest (FNode fun [fs]) = prtFunctor (prtQ fun) (prtPList (map prtForest fs))
-prtForest (FNode fun fss) = prtPList [ prtFunctor (prtQ fun) (prtPList (map prtForest fs)) |
+prtForest (FNode fun [fs]) = prtFunctor (prtQ fun) (map prtForest fs)
+prtForest (FNode fun fss) = prtPList [ prtFunctor (prtQ fun) (map prtForest fs) |
                                        fs <- fss ]
 
 prtQ atom = prtQStr (prt atom)
diff --git a/src/GF/Conversion/RemoveErasing.hs b/src/GF/Conversion/RemoveErasing.hs
index 0062e5f36..8185e4f02 100644
--- a/src/GF/Conversion/RemoveErasing.hs
+++ b/src/GF/Conversion/RemoveErasing.hs
@@ -80,11 +80,17 @@ newRules grammar chart (NC newCat@(MCat cat lbls))
 	     newProfile = snd $ mapAccumL accumProf 0 $
 			  map (lookupAssoc argsInLin) [0 .. length args-1]
 	     accumProf nr = maybe (nr, Unify []) $ const (nr+1, Unify [nr])
-	     newName = Name fun (newProfile `composeProfiles` profile)
+	     newName = -- tracePrt "newName" (prtNewName profile newProfile) $
+                       Name fun (profile `composeProfiles` newProfile)
 
          guard $ all (not . null) argLbls
 	 return $ NR (Rule (Abs newCat newArgs newName) (Cnc lbls argLbls newLins))
 
+
+prtNewName :: [Profile (SyntaxForest Fun)] -> [Profile (SyntaxForest Fun)] -> Name -> String
+prtNewName p p' n = prt p ++ " .o. " ++ prt p' ++ " : " ++ prt n
+
+
 initialCatsTD grammar starts =
     [ cat | cat@(NC (MCat (ECat start _) _)) <- initialCatsBU grammar,
       start `elem` starts ]