full disjunctive patterns ; more prec levels for Exp

1 files changed, 69 insertions, 75 deletions

diff --git a/src/GF/Source/PrintGF.hs b/src/GF/Source/PrintGF.hs
index 51e7317e3..c01329227 100644
--- a/src/GF/Source/PrintGF.hs
+++ b/src/GF/Source/PrintGF.hs
@@ -1,11 +1,10 @@
-
-module GF.Source.PrintGF where
+module GF.Source.PrintGF where --H
 
 -- pretty-printer generated by the BNF converter, except --H
 
 import GF.Infra.Ident --H
-import GF.Source.AbsGF
-import Data.Char
+import GF.Source.AbsGF --H
+import Data.Char --H
 
 -- the top-level printing method
 printTree :: Print a => a -> String
@@ -27,13 +26,11 @@ render d = rend 0 (map ($ "") $ d []) "" where
 
     "["      :ts -> showChar '[' . rend i ts
     "("      :ts -> showChar '(' . rend i ts
-    "%"      :ts -> showChar '%' . rend i ts
     "{"      :ts -> showChar '{' . new (i+1) . rend (i+1) ts
     "}" : ";":ts -> new (i-1) . space "}" . showChar ';' . new (i-1) . rend (i-1) ts
     "}"      :ts -> new (i-1) . showChar '}' . new (i-1) . rend (i-1) ts
     ";"      :ts -> showChar ';' . new i . rend i ts
     t  : "," :ts -> showString t . space "," . rend i ts
-    t  : "%" :ts -> showString t . showChar '%' . rend i ts
     t  : ")" :ts -> showString t . showChar ')' . rend i ts
     t  : "]" :ts -> showString t . showChar ']' . rend i ts
     t        :ts -> space t . rend i ts
@@ -62,12 +59,6 @@ class Print a where
 instance Print a => Print [a] where
   prt _ = prtList
 
-instance Print Integer where
-  prt _ x = doc (shows x)
-
-instance Print Double where
-  prt _ x = doc (shows x)
-
 instance Print Char where
   prt _ s = doc (showChar '\'' . mkEsc '\'' s . showChar '\'')
   prtList s = doc (showChar '"' . concatS (map (mkEsc '"') s) . showChar '"')
@@ -84,8 +75,16 @@ prPrec :: Int -> Int -> Doc -> Doc
 prPrec i j = if j<i then parenth else id
 
 
+instance Print Integer where
+  prt _ x = doc (shows x)
+
+
+instance Print Double where
+  prt _ x = doc (shows x)
+
+
 instance Print Ident where
-  prt _ i = doc (showString $ prIdent i)
+  prt _ i = doc (showString $ prIdent i) --H
   prtList es = case es of
    [x] -> (concatD [prt 0 x])
    x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])
@@ -192,6 +191,7 @@ instance Print Included where
   prt i e = case e of
    IAll id -> prPrec i 0 (concatD [prt 0 id])
    ISome id ids -> prPrec i 0 (concatD [prt 0 id , doc (showString "[") , prt 0 ids , doc (showString "]")])
+   IMinus id ids -> prPrec i 0 (concatD [prt 0 id , doc (showString "-") , doc (showString "[") , prt 0 ids , doc (showString "]")])
 
   prtList es = case es of
    [] -> (concatD [])
@@ -329,49 +329,50 @@ instance Print LocDef where
 
 instance Print Exp where
   prt i e = case e of
-   EIdent id -> prPrec i 4 (concatD [prt 0 id])
-   EConstr id -> prPrec i 4 (concatD [doc (showString "{0") , prt 0 id , doc (showString "}0")]) -- H
-   ECons id -> prPrec i 4 (concatD [doc (showString "%") , prt 0 id , doc (showString "%")])
-   ESort sort -> prPrec i 4 (concatD [prt 0 sort])
-   EString str -> prPrec i 4 (concatD [prt 0 str])
-   EInt n -> prPrec i 4 (concatD [prt 0 n])
-   EFloat n -> prPrec i 4 (concatD [prt 0 n])
-   EMeta  -> prPrec i 4 (concatD [doc (showString "?")])
-   EEmpty  -> prPrec i 4 (concatD [doc (showString "[") , doc (showString "]")])
-   EData  -> prPrec i 4 (concatD [doc (showString "data")])
-   EList id exps -> prPrec i 4 (concatD [doc (showString "[") , prt 0 id , prt 0 exps , doc (showString "]")])
-   EStrings str -> prPrec i 4 (concatD [doc (showString "[") , prt 0 str , doc (showString "]")])
-   ERecord locdefs -> prPrec i 4 (concatD [doc (showString "{") , prt 0 locdefs , doc (showString "}")])
-   ETuple tuplecomps -> prPrec i 4 (concatD [doc (showString "<") , prt 0 tuplecomps , doc (showString ">")])
-   EIndir id -> prPrec i 4 (concatD [doc (showString "(") , doc (showString "in") , prt 0 id , doc (showString ")")])
-   ETyped exp0 exp -> prPrec i 4 (concatD [doc (showString "<") , prt 0 exp0 , doc (showString ":") , prt 0 exp , doc (showString ">")])
-   EProj exp label -> prPrec i 3 (concatD [prt 3 exp , doc (showString ".") , prt 0 label])
-   EQConstr id0 id -> prPrec i 3 (concatD [doc (showString "{0") , prt 0 id0 , doc (showString ".") , prt 0 id , doc (showString "}0")]) -- H
-   EQCons id0 id -> prPrec i 3 (concatD [doc (showString "%") , prt 0 id0 , doc (showString ".") , prt 0 id])
-   EApp exp0 exp -> prPrec i 2 (concatD [prt 2 exp0 , prt 3 exp])
-   ETable cases -> prPrec i 2 (concatD [doc (showString "table") , doc (showString "{") , prt 0 cases , doc (showString "}")])
-   ETTable exp cases -> prPrec i 2 (concatD [doc (showString "table") , prt 4 exp , doc (showString "{") , prt 0 cases , doc (showString "}")])
-   EVTable exp exps -> prPrec i 2 (concatD [doc (showString "table") , prt 4 exp , doc (showString "[") , prt 0 exps , doc (showString "]")])
-   ECase exp cases -> prPrec i 2 (concatD [doc (showString "case") , prt 0 exp , doc (showString "of") , doc (showString "{") , prt 0 cases , doc (showString "}")])
-   EVariants exps -> prPrec i 2 (concatD [doc (showString "variants") , doc (showString "{") , prt 0 exps , doc (showString "}")])
-   EPre exp alterns -> prPrec i 2 (concatD [doc (showString "pre") , doc (showString "{") , prt 0 exp , doc (showString ";") , prt 0 alterns , doc (showString "}")])
-   EStrs exps -> prPrec i 2 (concatD [doc (showString "strs") , doc (showString "{") , prt 0 exps , doc (showString "}")])
-   EConAt id exp -> prPrec i 2 (concatD [prt 0 id , doc (showString "@") , prt 4 exp])
-   ESelect exp0 exp -> prPrec i 1 (concatD [prt 1 exp0 , doc (showString "!") , prt 2 exp])
-   ETupTyp exp0 exp -> prPrec i 1 (concatD [prt 1 exp0 , doc (showString "*") , prt 2 exp])
-   EExtend exp0 exp -> prPrec i 1 (concatD [prt 1 exp0 , doc (showString "**") , prt 2 exp])
+   EIdent id -> prPrec i 6 (concatD [prt 0 id])
+   EConstr id -> prPrec i 6 (concatD [doc (showString "{0") , prt 0 id , doc (showString "}0")]) --H
+   ECons id -> prPrec i 6 (concatD [doc (showString "%") , prt 0 id , doc (showString "%")])
+   ESort sort -> prPrec i 6 (concatD [prt 0 sort])
+   EString str -> prPrec i 6 (concatD [prt 0 str])
+   EInt n -> prPrec i 6 (concatD [prt 0 n])
+   EFloat d -> prPrec i 6 (concatD [prt 0 d])
+   EMeta  -> prPrec i 6 (concatD [doc (showString "?")])
+   EEmpty  -> prPrec i 6 (concatD [doc (showString "[") , doc (showString "]")])
+   EData  -> prPrec i 6 (concatD [doc (showString "data")])
+   EList id exps -> prPrec i 6 (concatD [doc (showString "[") , prt 0 id , prt 0 exps , doc (showString "]")])
+   EStrings str -> prPrec i 6 (concatD [doc (showString "[") , prt 0 str , doc (showString "]")])
+   ERecord locdefs -> prPrec i 6 (concatD [doc (showString "{") , prt 0 locdefs , doc (showString "}")])
+   ETuple tuplecomps -> prPrec i 6 (concatD [doc (showString "<") , prt 0 tuplecomps , doc (showString ">")])
+   EIndir id -> prPrec i 6 (concatD [doc (showString "(") , doc (showString "in") , prt 0 id , doc (showString ")")])
+   ETyped exp0 exp -> prPrec i 6 (concatD [doc (showString "<") , prt 0 exp0 , doc (showString ":") , prt 0 exp , doc (showString ">")])
+   EProj exp label -> prPrec i 5 (concatD [prt 5 exp , doc (showString ".") , prt 0 label])
+   EQConstr id0 id -> prPrec i 5 (concatD [doc (showString "{0") , prt 0 id0 , doc (showString ".") , prt 0 id , doc (showString "}0")]) --H
+   EQCons id0 id -> prPrec i 5 (concatD [doc (showString "%") , prt 0 id0 , doc (showString ".") , prt 0 id])
+   EApp exp0 exp -> prPrec i 4 (concatD [prt 4 exp0 , prt 5 exp])
+   ETable cases -> prPrec i 4 (concatD [doc (showString "table") , doc (showString "{") , prt 0 cases , doc (showString "}")])
+   ETTable exp cases -> prPrec i 4 (concatD [doc (showString "table") , prt 6 exp , doc (showString "{") , prt 0 cases , doc (showString "}")])
+   EVTable exp exps -> prPrec i 4 (concatD [doc (showString "table") , prt 6 exp , doc (showString "[") , prt 0 exps , doc (showString "]")])
+   ECase exp cases -> prPrec i 4 (concatD [doc (showString "case") , prt 0 exp , doc (showString "of") , doc (showString "{") , prt 0 cases , doc (showString "}")])
+   EVariants exps -> prPrec i 4 (concatD [doc (showString "variants") , doc (showString "{") , prt 0 exps , doc (showString "}")])
+   EPre exp alterns -> prPrec i 4 (concatD [doc (showString "pre") , doc (showString "{") , prt 0 exp , doc (showString ";") , prt 0 alterns , doc (showString "}")])
+   EStrs exps -> prPrec i 4 (concatD [doc (showString "strs") , doc (showString "{") , prt 0 exps , doc (showString "}")])
+   EConAt id exp -> prPrec i 4 (concatD [prt 0 id , doc (showString "@") , prt 6 exp])
+   ESelect exp0 exp -> prPrec i 3 (concatD [prt 3 exp0 , doc (showString "!") , prt 4 exp])
+   ETupTyp exp0 exp -> prPrec i 3 (concatD [prt 3 exp0 , doc (showString "*") , prt 4 exp])
+   EExtend exp0 exp -> prPrec i 3 (concatD [prt 3 exp0 , doc (showString "**") , prt 4 exp])
+   EGlue exp0 exp -> prPrec i 1 (concatD [prt 2 exp0 , doc (showString "+") , prt 1 exp])
+   EConcat exp0 exp -> prPrec i 0 (concatD [prt 1 exp0 , doc (showString "++") , prt 0 exp])
    EAbstr binds exp -> prPrec i 0 (concatD [doc (showString "\\") , prt 0 binds , doc (showString "->") , prt 0 exp])
    ECTable binds exp -> prPrec i 0 (concatD [doc (showString "\\") , doc (showString "\\") , prt 0 binds , doc (showString "=>") , prt 0 exp])
    EProd decl exp -> prPrec i 0 (concatD [prt 0 decl , doc (showString "->") , prt 0 exp])
-   ETType exp0 exp -> prPrec i 0 (concatD [prt 1 exp0 , doc (showString "=>") , prt 0 exp])
-   EConcat exp0 exp -> prPrec i 0 (concatD [prt 1 exp0 , doc (showString "++") , prt 0 exp])
-   EGlue exp0 exp -> prPrec i 0 (concatD [prt 1 exp0 , doc (showString "+") , prt 0 exp])
+   ETType exp0 exp -> prPrec i 0 (concatD [prt 3 exp0 , doc (showString "=>") , prt 0 exp])
    ELet locdefs exp -> prPrec i 0 (concatD [doc (showString "let") , doc (showString "{") , prt 0 locdefs , doc (showString "}") , doc (showString "in") , prt 0 exp])
    ELetb locdefs exp -> prPrec i 0 (concatD [doc (showString "let") , prt 0 locdefs , doc (showString "in") , prt 0 exp])
-   EWhere exp locdefs -> prPrec i 0 (concatD [prt 1 exp , doc (showString "where") , doc (showString "{") , prt 0 locdefs , doc (showString "}")])
+   EWhere exp locdefs -> prPrec i 0 (concatD [prt 3 exp , doc (showString "where") , doc (showString "{") , prt 0 locdefs , doc (showString "}")])
    EEqs equations -> prPrec i 0 (concatD [doc (showString "fn") , doc (showString "{") , prt 0 equations , doc (showString "}")])
-   ELString lstring -> prPrec i 4 (concatD [prt 0 lstring])
-   ELin id -> prPrec i 2 (concatD [doc (showString "Lin") , prt 0 id])
+   EExample exp str -> prPrec i 0 (concatD [doc (showString "in") , prt 5 exp , prt 0 str])
+   ELString lstring -> prPrec i 6 (concatD [prt 0 lstring])
+   ELin id -> prPrec i 4 (concatD [doc (showString "Lin") , prt 0 id])
 
   prtList es = case es of
    [] -> (concatD [])
@@ -381,26 +382,27 @@ instance Print Exp where
 instance Print Exps where
   prt i e = case e of
    NilExp  -> prPrec i 0 (concatD [])
-   ConsExp exp exps -> prPrec i 0 (concatD [prt 4 exp , prt 0 exps])
+   ConsExp exp exps -> prPrec i 0 (concatD [prt 6 exp , prt 0 exps])
 
 
 instance Print Patt where
   prt i e = case e of
-   PW  -> prPrec i 1 (concatD [doc (showString "_")])
-   PV id -> prPrec i 1 (concatD [prt 0 id])
-   PCon id -> prPrec i 1 (concatD [doc (showString "{0") , prt 0 id , doc (showString "}0")]) -- H
-   PQ id0 id -> prPrec i 1 (concatD [prt 0 id0 , doc (showString ".") , prt 0 id])
-   PInt n -> prPrec i 1 (concatD [prt 0 n])
-   PFloat n -> prPrec i 1 (concatD [prt 0 n])
-   PStr str -> prPrec i 1 (concatD [prt 0 str])
-   PR pattasss -> prPrec i 1 (concatD [doc (showString "{") , prt 0 pattasss , doc (showString "}")])
-   PTup patttuplecomps -> prPrec i 1 (concatD [doc (showString "<") , prt 0 patttuplecomps , doc (showString ">")])
-   PC id patts -> prPrec i 0 (concatD [prt 0 id , prt 0 patts])
-   PQC id0 id patts -> prPrec i 0 (concatD [prt 0 id0 , doc (showString ".") , prt 0 id , prt 0 patts])
+   PW  -> prPrec i 2 (concatD [doc (showString "_")])
+   PV id -> prPrec i 2 (concatD [prt 0 id])
+   PCon id -> prPrec i 2 (concatD [doc (showString "{0") , prt 0 id , doc (showString "}0")]) --H
+   PQ id0 id -> prPrec i 2 (concatD [prt 0 id0 , doc (showString ".") , prt 0 id])
+   PInt n -> prPrec i 2 (concatD [prt 0 n])
+   PFloat d -> prPrec i 2 (concatD [prt 0 d])
+   PStr str -> prPrec i 2 (concatD [prt 0 str])
+   PR pattasss -> prPrec i 2 (concatD [doc (showString "{") , prt 0 pattasss , doc (showString "}")])
+   PTup patttuplecomps -> prPrec i 2 (concatD [doc (showString "<") , prt 0 patttuplecomps , doc (showString ">")])
+   PC id patts -> prPrec i 1 (concatD [prt 0 id , prt 0 patts])
+   PQC id0 id patts -> prPrec i 1 (concatD [prt 0 id0 , doc (showString ".") , prt 0 id , prt 0 patts])
+   PDisj patt0 patt -> prPrec i 0 (concatD [prt 0 patt0 , doc (showString "|") , prt 1 patt])
 
   prtList es = case es of
-   [x] -> (concatD [prt 1 x])
-   x:xs -> (concatD [prt 1 x , prt 0 xs])
+   [x] -> (concatD [prt 2 x])
+   x:xs -> (concatD [prt 2 x , prt 0 xs])
 
 instance Print PattAss where
   prt i e = case e of
@@ -426,14 +428,6 @@ instance Print Sort where
    Sort_Strs  -> prPrec i 0 (concatD [doc (showString "Strs")])
 
 
-instance Print PattAlt where
-  prt i e = case e of
-   AltP patt -> prPrec i 0 (concatD [prt 0 patt])
-
-  prtList es = case es of
-   [x] -> (concatD [prt 0 x])
-   x:xs -> (concatD [prt 0 x , doc (showString "|") , prt 0 xs])
-
 instance Print Bind where
   prt i e = case e of
    BIdent id -> prPrec i 0 (concatD [prt 0 id])
@@ -447,7 +441,7 @@ instance Print Bind where
 instance Print Decl where
   prt i e = case e of
    DDec binds exp -> prPrec i 0 (concatD [doc (showString "(") , prt 0 binds , doc (showString ":") , prt 0 exp , doc (showString ")")])
-   DExp exp -> prPrec i 0 (concatD [prt 2 exp])
+   DExp exp -> prPrec i 0 (concatD [prt 4 exp])
 
 
 instance Print TupleComp where
@@ -470,7 +464,7 @@ instance Print PattTupleComp where
 
 instance Print Case where
   prt i e = case e of
-   Case pattalts exp -> prPrec i 0 (concatD [prt 0 pattalts , doc (showString "=>") , prt 0 exp])
+   Case patt exp -> prPrec i 0 (concatD [prt 0 patt , doc (showString "=>") , prt 0 exp])
 
   prtList es = case es of
    [x] -> (concatD [prt 0 x])
@@ -497,7 +491,7 @@ instance Print Altern where
 instance Print DDecl where
   prt i e = case e of
    DDDec binds exp -> prPrec i 0 (concatD [doc (showString "(") , prt 0 binds , doc (showString ":") , prt 0 exp , doc (showString ")")])
-   DDExp exp -> prPrec i 0 (concatD [prt 4 exp])
+   DDExp exp -> prPrec i 0 (concatD [prt 6 exp])
 
   prtList es = case es of
    [] -> (concatD [])