Morphological analysis and glueing.

1 files changed, 16 insertions, 2 deletions

diff --git a/src/GF/Grammar/PrGrammar.hs b/src/GF/Grammar/PrGrammar.hs
index 607b766da..2b5648d8a 100644
--- a/src/GF/Grammar/PrGrammar.hs
+++ b/src/GF/Grammar/PrGrammar.hs
@@ -62,15 +62,20 @@ prContext co = unwords $ map prParenth [prt x +++ ":" +++ prt t | (x,t) <- co]
 
 instance Print A.Exp where prt = C.printTree
 instance Print A.Term where prt = C.printTree
-instance Print A.Patt where prt = C.printTree
 instance Print A.Case where prt = C.printTree
 instance Print A.Atom where prt = C.printTree
-instance Print A.CIdent where prt = C.printTree
 instance Print A.CType where prt = C.printTree
 instance Print A.Label where prt = C.printTree
 instance Print A.Module where prt = C.printTree
 instance Print A.Sort where prt = C.printTree
 
+instance Print A.Patt where 
+  prt = C.printTree
+  prt_ = prPatt
+
+instance Print A.CIdent where 
+  prt = C.printTree
+  prt_ (A.CIQ _ c) = prt c
 
 -- printing values and trees in editing
 
@@ -183,6 +188,15 @@ prExp e = case e of
      App _ _ -> prParenth $ prExp e
      _ -> pr1 e
 
+prPatt :: A.Patt -> String
+prPatt p = case p of
+  A.PC c ps -> prt_ c +++ unwords (map pr1 ps)
+  _ -> prt p --- PR
+ where
+   pr1 p = case p of
+     A.PC _ (_:_) -> prParenth $ prPatt p
+     _ -> prPatt p
+
 -- option -strip strips qualifications
 prTermOpt opts = if oElem nostripQualif opts then prt else prExp