summaryrefslogtreecommitdiff
path: root/src/GF/Source/PrintGF.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/GF/Source/PrintGF.hs')
-rw-r--r--src/GF/Source/PrintGF.hs1068
1 files changed, 534 insertions, 534 deletions
diff --git a/src/GF/Source/PrintGF.hs b/src/GF/Source/PrintGF.hs
index ea2277e67..e501a33f5 100644
--- a/src/GF/Source/PrintGF.hs
+++ b/src/GF/Source/PrintGF.hs
@@ -1,534 +1,534 @@
-{-# OPTIONS -fno-warn-incomplete-patterns #-}
-module GF.Source.PrintGF where
-
--- pretty-printer generated by the BNF converter
-
-import GF.Source.AbsGF
-import Data.Char
-import qualified Data.ByteString.Char8 as BS
-
--- the top-level printing method
-printTree :: Print a => a -> String
-printTree = render . prt 0
-
-type Doc = [ShowS] -> [ShowS]
-
-doc :: ShowS -> Doc
-doc = (:)
-
-render :: Doc -> String
-render d = rend 0 (map ($ "") $ d []) "" where
- rend i ss = case ss of
- "[" :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 -> space t . rend i ts
- _ -> id
- new i = showChar '\n' . replicateS (2*i) (showChar ' ') . dropWhile isSpace
- space t = showString t . (\s -> if null s then "" else (' ':s))
-
-parenth :: Doc -> Doc
-parenth ss = doc (showChar '(') . ss . doc (showChar ')')
-
-concatS :: [ShowS] -> ShowS
-concatS = foldr (.) id
-
-concatD :: [Doc] -> Doc
-concatD = foldr (.) id
-
-replicateS :: Int -> ShowS -> ShowS
-replicateS n f = concatS (replicate n f)
-
--- the printer class does the job
-class Print a where
- prt :: Int -> a -> Doc
- prtList :: [a] -> Doc
- prtList = concatD . map (prt 0)
-
-instance Print a => Print [a] where
- prt _ = prtList
-
-instance Print Char where
- prt _ s = doc (showChar '\'' . mkEsc '\'' s . showChar '\'')
- prtList s = doc (showChar '"' . concatS (map (mkEsc '"') s) . showChar '"')
-
-mkEsc :: Char -> Char -> ShowS
-mkEsc q s = case s of
- _ | s == q -> showChar '\\' . showChar s
- '\\'-> showString "\\\\"
- '\n' -> showString "\\n"
- '\t' -> showString "\\t"
- _ -> showChar s
-
-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 LString where
- prt _ (LString i) = doc (showString (BS.unpack i))
-
-
-instance Print PIdent where
- prt _ (PIdent (_,i)) = doc (showString (BS.unpack i))
- prtList es = case es of
- [x] -> (concatD [prt 0 x])
- x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])
-
-
-
-instance Print Grammar where
- prt i e = case e of
- Gr moddefs -> prPrec i 0 (concatD [prt 0 moddefs])
-
-
-instance Print ModDef where
- prt i e = case e of
- MMain pident0 pident concspecs -> prPrec i 0 (concatD [doc (showString "grammar") , prt 0 pident0 , doc (showString "=") , doc (showString "{") , doc (showString "abstract") , doc (showString "=") , prt 0 pident , doc (showString ";") , prt 0 concspecs , doc (showString "}")])
- MModule complmod modtype modbody -> prPrec i 0 (concatD [prt 0 complmod , prt 0 modtype , doc (showString "=") , prt 0 modbody])
-
- prtList es = case es of
- [] -> (concatD [])
- x:xs -> (concatD [prt 0 x , prt 0 xs])
-
-instance Print ConcSpec where
- prt i e = case e of
- ConcSpec pident concexp -> prPrec i 0 (concatD [prt 0 pident , doc (showString "=") , prt 0 concexp])
-
- prtList es = case es of
- [] -> (concatD [])
- [x] -> (concatD [prt 0 x])
- x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
-
-instance Print ConcExp where
- prt i e = case e of
- ConcExp pident transfers -> prPrec i 0 (concatD [prt 0 pident , prt 0 transfers])
-
-
-instance Print Transfer where
- prt i e = case e of
- TransferIn open -> prPrec i 0 (concatD [doc (showString "(") , doc (showString "transfer") , doc (showString "in") , prt 0 open , doc (showString ")")])
- TransferOut open -> prPrec i 0 (concatD [doc (showString "(") , doc (showString "transfer") , doc (showString "out") , prt 0 open , doc (showString ")")])
-
- prtList es = case es of
- [] -> (concatD [])
- x:xs -> (concatD [prt 0 x , prt 0 xs])
-
-
-instance Print ModType where
- prt i e = case e of
- MTAbstract pident -> prPrec i 0 (concatD [doc (showString "abstract") , prt 0 pident])
- MTResource pident -> prPrec i 0 (concatD [doc (showString "resource") , prt 0 pident])
- MTInterface pident -> prPrec i 0 (concatD [doc (showString "interface") , prt 0 pident])
- MTConcrete pident0 pident -> prPrec i 0 (concatD [doc (showString "concrete") , prt 0 pident0 , doc (showString "of") , prt 0 pident])
- MTInstance pident0 pident -> prPrec i 0 (concatD [doc (showString "instance") , prt 0 pident0 , doc (showString "of") , prt 0 pident])
- MTTransfer pident open0 open -> prPrec i 0 (concatD [doc (showString "transfer") , prt 0 pident , doc (showString ":") , prt 0 open0 , doc (showString "->") , prt 0 open])
-
-
-instance Print ModBody where
- prt i e = case e of
- MBody extend opens topdefs -> prPrec i 0 (concatD [prt 0 extend , prt 0 opens , doc (showString "{") , prt 0 topdefs , doc (showString "}")])
- MNoBody includeds -> prPrec i 0 (concatD [prt 0 includeds])
- MWith included opens -> prPrec i 0 (concatD [prt 0 included , doc (showString "with") , prt 0 opens])
- MWithBody included opens0 opens topdefs -> prPrec i 0 (concatD [prt 0 included , doc (showString "with") , prt 0 opens0 , doc (showString "**") , prt 0 opens , doc (showString "{") , prt 0 topdefs , doc (showString "}")])
- MWithE includeds included opens -> prPrec i 0 (concatD [prt 0 includeds , doc (showString "**") , prt 0 included , doc (showString "with") , prt 0 opens])
- MWithEBody includeds included opens0 opens topdefs -> prPrec i 0 (concatD [prt 0 includeds , doc (showString "**") , prt 0 included , doc (showString "with") , prt 0 opens0 , doc (showString "**") , prt 0 opens , doc (showString "{") , prt 0 topdefs , doc (showString "}")])
- MReuse pident -> prPrec i 0 (concatD [doc (showString "reuse") , prt 0 pident])
- MUnion includeds -> prPrec i 0 (concatD [doc (showString "union") , prt 0 includeds])
-
-
-instance Print Extend where
- prt i e = case e of
- Ext includeds -> prPrec i 0 (concatD [prt 0 includeds , doc (showString "**")])
- NoExt -> prPrec i 0 (concatD [])
-
-
-instance Print Opens where
- prt i e = case e of
- NoOpens -> prPrec i 0 (concatD [])
- OpenIn opens -> prPrec i 0 (concatD [doc (showString "open") , prt 0 opens , doc (showString "in")])
-
-
-instance Print Open where
- prt i e = case e of
- OName pident -> prPrec i 0 (concatD [prt 0 pident])
- OQualQO qualopen pident -> prPrec i 0 (concatD [doc (showString "(") , prt 0 qualopen , prt 0 pident , doc (showString ")")])
- OQual qualopen pident0 pident -> prPrec i 0 (concatD [doc (showString "(") , prt 0 qualopen , prt 0 pident0 , doc (showString "=") , prt 0 pident , doc (showString ")")])
-
- prtList es = case es of
- [] -> (concatD [])
- [x] -> (concatD [prt 0 x])
- x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])
-
-instance Print ComplMod where
- prt i e = case e of
- CMCompl -> prPrec i 0 (concatD [])
- CMIncompl -> prPrec i 0 (concatD [doc (showString "incomplete")])
-
-
-instance Print QualOpen where
- prt i e = case e of
- QOCompl -> prPrec i 0 (concatD [])
- QOIncompl -> prPrec i 0 (concatD [doc (showString "incomplete")])
- QOInterface -> prPrec i 0 (concatD [doc (showString "interface")])
-
-
-instance Print Included where
- prt i e = case e of
- IAll pident -> prPrec i 0 (concatD [prt 0 pident])
- ISome pident pidents -> prPrec i 0 (concatD [prt 0 pident , doc (showString "[") , prt 0 pidents , doc (showString "]")])
- IMinus pident pidents -> prPrec i 0 (concatD [prt 0 pident , doc (showString "-") , doc (showString "[") , prt 0 pidents , doc (showString "]")])
-
- prtList es = case es of
- [] -> (concatD [])
- [x] -> (concatD [prt 0 x])
- x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])
-
-instance Print Def where
- prt i e = case e of
- DDecl names exp -> prPrec i 0 (concatD [prt 0 names , doc (showString ":") , prt 0 exp])
- DDef names exp -> prPrec i 0 (concatD [prt 0 names , doc (showString "=") , prt 0 exp])
- DPatt name patts exp -> prPrec i 0 (concatD [prt 0 name , prt 0 patts , doc (showString "=") , prt 0 exp])
- DFull names exp0 exp -> prPrec i 0 (concatD [prt 0 names , doc (showString ":") , prt 0 exp0 , doc (showString "=") , prt 0 exp])
-
- prtList es = case es of
- [x] -> (concatD [prt 0 x , doc (showString ";")])
- x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
-
-instance Print TopDef where
- prt i e = case e of
- DefCat catdefs -> prPrec i 0 (concatD [doc (showString "cat") , prt 0 catdefs])
- DefFun fundefs -> prPrec i 0 (concatD [doc (showString "fun") , prt 0 fundefs])
- DefFunData fundefs -> prPrec i 0 (concatD [doc (showString "data") , prt 0 fundefs])
- DefDef defs -> prPrec i 0 (concatD [doc (showString "def") , prt 0 defs])
- DefData datadefs -> prPrec i 0 (concatD [doc (showString "data") , prt 0 datadefs])
- DefTrans defs -> prPrec i 0 (concatD [doc (showString "transfer") , prt 0 defs])
- DefPar pardefs -> prPrec i 0 (concatD [doc (showString "param") , prt 0 pardefs])
- DefOper defs -> prPrec i 0 (concatD [doc (showString "oper") , prt 0 defs])
- DefLincat printdefs -> prPrec i 0 (concatD [doc (showString "lincat") , prt 0 printdefs])
- DefLindef defs -> prPrec i 0 (concatD [doc (showString "lindef") , prt 0 defs])
- DefLin defs -> prPrec i 0 (concatD [doc (showString "lin") , prt 0 defs])
- DefPrintCat printdefs -> prPrec i 0 (concatD [doc (showString "printname") , doc (showString "cat") , prt 0 printdefs])
- DefPrintFun printdefs -> prPrec i 0 (concatD [doc (showString "printname") , doc (showString "fun") , prt 0 printdefs])
- DefFlag flagdefs -> prPrec i 0 (concatD [doc (showString "flags") , prt 0 flagdefs])
- DefPrintOld printdefs -> prPrec i 0 (concatD [doc (showString "printname") , prt 0 printdefs])
- DefLintype defs -> prPrec i 0 (concatD [doc (showString "lintype") , prt 0 defs])
- DefPattern defs -> prPrec i 0 (concatD [doc (showString "pattern") , prt 0 defs])
- DefPackage pident topdefs -> prPrec i 0 (concatD [doc (showString "package") , prt 0 pident , doc (showString "=") , doc (showString "{") , prt 0 topdefs , doc (showString "}") , doc (showString ";")])
- DefVars defs -> prPrec i 0 (concatD [doc (showString "var") , prt 0 defs])
- DefTokenizer pident -> prPrec i 0 (concatD [doc (showString "tokenizer") , prt 0 pident , doc (showString ";")])
-
- prtList es = case es of
- [] -> (concatD [])
- x:xs -> (concatD [prt 0 x , prt 0 xs])
-
-instance Print CatDef where
- prt i e = case e of
- SimpleCatDef pident ddecls -> prPrec i 0 (concatD [prt 0 pident , prt 0 ddecls])
- ListCatDef pident ddecls -> prPrec i 0 (concatD [doc (showString "[") , prt 0 pident , prt 0 ddecls , doc (showString "]")])
- ListSizeCatDef pident ddecls n -> prPrec i 0 (concatD [doc (showString "[") , prt 0 pident , prt 0 ddecls , doc (showString "]") , doc (showString "{") , prt 0 n , doc (showString "}")])
-
- prtList es = case es of
- [x] -> (concatD [prt 0 x , doc (showString ";")])
- x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
-
-instance Print FunDef where
- prt i e = case e of
- FunDef pidents exp -> prPrec i 0 (concatD [prt 0 pidents , doc (showString ":") , prt 0 exp])
-
- prtList es = case es of
- [x] -> (concatD [prt 0 x , doc (showString ";")])
- x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
-
-instance Print DataDef where
- prt i e = case e of
- DataDef pident dataconstrs -> prPrec i 0 (concatD [prt 0 pident , doc (showString "=") , prt 0 dataconstrs])
-
- prtList es = case es of
- [x] -> (concatD [prt 0 x , doc (showString ";")])
- x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
-
-instance Print DataConstr where
- prt i e = case e of
- DataId pident -> prPrec i 0 (concatD [prt 0 pident])
- DataQId pident0 pident -> prPrec i 0 (concatD [prt 0 pident0 , doc (showString ".") , prt 0 pident])
-
- prtList es = case es of
- [] -> (concatD [])
- [x] -> (concatD [prt 0 x])
- x:xs -> (concatD [prt 0 x , doc (showString "|") , prt 0 xs])
-
-instance Print ParDef where
- prt i e = case e of
- ParDefDir pident parconstrs -> prPrec i 0 (concatD [prt 0 pident , doc (showString "=") , prt 0 parconstrs])
- ParDefIndir pident0 pident -> prPrec i 0 (concatD [prt 0 pident0 , doc (showString "=") , doc (showString "(") , doc (showString "in") , prt 0 pident , doc (showString ")")])
- ParDefAbs pident -> prPrec i 0 (concatD [prt 0 pident])
-
- prtList es = case es of
- [x] -> (concatD [prt 0 x , doc (showString ";")])
- x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
-
-instance Print ParConstr where
- prt i e = case e of
- ParConstr pident ddecls -> prPrec i 0 (concatD [prt 0 pident , prt 0 ddecls])
-
- prtList es = case es of
- [] -> (concatD [])
- [x] -> (concatD [prt 0 x])
- x:xs -> (concatD [prt 0 x , doc (showString "|") , prt 0 xs])
-
-instance Print PrintDef where
- prt i e = case e of
- PrintDef names exp -> prPrec i 0 (concatD [prt 0 names , doc (showString "=") , prt 0 exp])
-
- prtList es = case es of
- [x] -> (concatD [prt 0 x , doc (showString ";")])
- x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
-
-instance Print FlagDef where
- prt i e = case e of
- FlagDef pident0 pident -> prPrec i 0 (concatD [prt 0 pident0 , doc (showString "=") , prt 0 pident])
-
- prtList es = case es of
- [x] -> (concatD [prt 0 x , doc (showString ";")])
- x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
-
-instance Print Name where
- prt i e = case e of
- IdentName pident -> prPrec i 0 (concatD [prt 0 pident])
- ListName pident -> prPrec i 0 (concatD [doc (showString "[") , prt 0 pident , doc (showString "]")])
-
- prtList es = case es of
- [x] -> (concatD [prt 0 x])
- x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])
-
-instance Print LocDef where
- prt i e = case e of
- LDDecl pidents exp -> prPrec i 0 (concatD [prt 0 pidents , doc (showString ":") , prt 0 exp])
- LDDef pidents exp -> prPrec i 0 (concatD [prt 0 pidents , doc (showString "=") , prt 0 exp])
- LDFull pidents exp0 exp -> prPrec i 0 (concatD [prt 0 pidents , doc (showString ":") , prt 0 exp0 , doc (showString "=") , prt 0 exp])
-
- prtList es = case es of
- [] -> (concatD [])
- [x] -> (concatD [prt 0 x])
- x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
-
-instance Print Exp where
- prt i e = case e of
- EIdent pident -> prPrec i 6 (concatD [prt 0 pident])
- EConstr pident -> prPrec i 6 (concatD [doc (showString "{") , prt 0 pident , doc (showString "}")])
- ECons pident -> prPrec i 6 (concatD [doc (showString "%") , prt 0 pident , 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 pident exps -> prPrec i 6 (concatD [doc (showString "[") , prt 0 pident , 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 pident -> prPrec i 6 (concatD [doc (showString "(") , doc (showString "in") , prt 0 pident , 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 pident0 pident -> prPrec i 5 (concatD [doc (showString "{") , prt 0 pident0 , doc (showString ".") , prt 0 pident , doc (showString "}")])
- EQCons pident0 pident -> prPrec i 5 (concatD [doc (showString "%") , prt 0 pident0 , doc (showString ".") , prt 0 pident])
- 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 pident exp -> prPrec i 4 (concatD [prt 0 pident , doc (showString "@") , prt 6 exp])
- EPatt patt -> prPrec i 4 (concatD [doc (showString "#") , prt 2 patt])
- EPattType exp -> prPrec i 4 (concatD [doc (showString "pattern") , prt 5 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 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 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 "}")])
- 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 pident -> prPrec i 4 (concatD [doc (showString "Lin") , prt 0 pident])
-
- prtList es = case es of
- [] -> (concatD [])
- [x] -> (concatD [prt 0 x])
- x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
-
-instance Print Exps where
- prt i e = case e of
- NilExp -> prPrec i 0 (concatD [])
- ConsExp exp exps -> prPrec i 0 (concatD [prt 6 exp , prt 0 exps])
-
-
-instance Print Patt where
- prt i e = case e of
- PChar -> prPrec i 2 (concatD [doc (showString "?")])
- PChars str -> prPrec i 2 (concatD [doc (showString "[") , prt 0 str , doc (showString "]")])
- PMacro pident -> prPrec i 2 (concatD [doc (showString "#") , prt 0 pident])
- PM pident0 pident -> prPrec i 2 (concatD [doc (showString "#") , prt 0 pident0 , doc (showString ".") , prt 0 pident])
- PW -> prPrec i 2 (concatD [doc (showString "_")])
- PV pident -> prPrec i 2 (concatD [prt 0 pident])
- PCon pident -> prPrec i 2 (concatD [doc (showString "{") , prt 0 pident , doc (showString "}")])
- PQ pident0 pident -> prPrec i 2 (concatD [prt 0 pident0 , doc (showString ".") , prt 0 pident])
- 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 pident patts -> prPrec i 1 (concatD [prt 0 pident , prt 0 patts])
- PQC pident0 pident patts -> prPrec i 1 (concatD [prt 0 pident0 , doc (showString ".") , prt 0 pident , prt 0 patts])
- PDisj patt0 patt -> prPrec i 0 (concatD [prt 0 patt0 , doc (showString "|") , prt 1 patt])
- PSeq patt0 patt -> prPrec i 0 (concatD [prt 0 patt0 , doc (showString "+") , prt 1 patt])
- PRep patt -> prPrec i 1 (concatD [prt 2 patt , doc (showString "*")])
- PAs pident patt -> prPrec i 1 (concatD [prt 0 pident , doc (showString "@") , prt 2 patt])
- PNeg patt -> prPrec i 1 (concatD [doc (showString "-") , prt 2 patt])
-
- prtList es = case es of
- [x] -> (concatD [prt 2 x])
- x:xs -> (concatD [prt 2 x , prt 0 xs])
-
-instance Print PattAss where
- prt i e = case e of
- PA pidents patt -> prPrec i 0 (concatD [prt 0 pidents , doc (showString "=") , prt 0 patt])
-
- prtList es = case es of
- [] -> (concatD [])
- [x] -> (concatD [prt 0 x])
- x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
-
-instance Print Label where
- prt i e = case e of
- LIdent pident -> prPrec i 0 (concatD [prt 0 pident])
- LVar n -> prPrec i 0 (concatD [doc (showString "$") , prt 0 n])
-
-
-instance Print Sort where
- prt i e = case e of
- Sort_Type -> prPrec i 0 (concatD [doc (showString "Type")])
- Sort_PType -> prPrec i 0 (concatD [doc (showString "PType")])
- Sort_Tok -> prPrec i 0 (concatD [doc (showString "Tok")])
- Sort_Str -> prPrec i 0 (concatD [doc (showString "Str")])
- Sort_Strs -> prPrec i 0 (concatD [doc (showString "Strs")])
-
-
-instance Print Bind where
- prt i e = case e of
- BIdent pident -> prPrec i 0 (concatD [prt 0 pident])
- BWild -> prPrec i 0 (concatD [doc (showString "_")])
-
- prtList es = case es of
- [] -> (concatD [])
- [x] -> (concatD [prt 0 x])
- x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])
-
-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 4 exp])
-
-
-instance Print TupleComp where
- prt i e = case e of
- TComp exp -> prPrec i 0 (concatD [prt 0 exp])
-
- prtList es = case es of
- [] -> (concatD [])
- [x] -> (concatD [prt 0 x])
- x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])
-
-instance Print PattTupleComp where
- prt i e = case e of
- PTComp patt -> prPrec i 0 (concatD [prt 0 patt])
-
- prtList es = case es of
- [] -> (concatD [])
- [x] -> (concatD [prt 0 x])
- x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])
-
-instance Print Case where
- prt i e = case e of
- 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])
- x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
-
-instance Print Equation where
- prt i e = case e of
- Equ patts exp -> prPrec i 0 (concatD [prt 0 patts , doc (showString "->") , prt 0 exp])
-
- prtList es = case es of
- [] -> (concatD [])
- [x] -> (concatD [prt 0 x])
- x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
-
-instance Print Altern where
- prt i e = case e of
- Alt exp0 exp -> prPrec i 0 (concatD [prt 0 exp0 , doc (showString "/") , prt 0 exp])
-
- prtList es = case es of
- [] -> (concatD [])
- [x] -> (concatD [prt 0 x])
- x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
-
-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 6 exp])
-
- prtList es = case es of
- [] -> (concatD [])
- x:xs -> (concatD [prt 0 x , prt 0 xs])
-
-instance Print OldGrammar where
- prt i e = case e of
- OldGr include topdefs -> prPrec i 0 (concatD [prt 0 include , prt 0 topdefs])
-
-
-instance Print Include where
- prt i e = case e of
- NoIncl -> prPrec i 0 (concatD [])
- Incl filenames -> prPrec i 0 (concatD [doc (showString "include") , prt 0 filenames])
-
-
-instance Print FileName where
- prt i e = case e of
- FString str -> prPrec i 0 (concatD [prt 0 str])
- FIdent pident -> prPrec i 0 (concatD [prt 0 pident])
- FSlash filename -> prPrec i 0 (concatD [doc (showString "/") , prt 0 filename])
- FDot filename -> prPrec i 0 (concatD [doc (showString ".") , prt 0 filename])
- FMinus filename -> prPrec i 0 (concatD [doc (showString "-") , prt 0 filename])
- FAddId pident filename -> prPrec i 0 (concatD [prt 0 pident , prt 0 filename])
-
- prtList es = case es of
- [x] -> (concatD [prt 0 x , doc (showString ";")])
- x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
-
-
+{-# OPTIONS -fno-warn-incomplete-patterns #-}
+module GF.Source.PrintGF where
+
+-- pretty-printer generated by the BNF converter
+
+import GF.Source.AbsGF
+import Data.Char
+import qualified Data.ByteString.Char8 as BS
+
+-- the top-level printing method
+printTree :: Print a => a -> String
+printTree = render . prt 0
+
+type Doc = [ShowS] -> [ShowS]
+
+doc :: ShowS -> Doc
+doc = (:)
+
+render :: Doc -> String
+render d = rend 0 (map ($ "") $ d []) "" where
+ rend i ss = case ss of
+ "[" :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 -> space t . rend i ts
+ _ -> id
+ new i = showChar '\n' . replicateS (2*i) (showChar ' ') . dropWhile isSpace
+ space t = showString t . (\s -> if null s then "" else (' ':s))
+
+parenth :: Doc -> Doc
+parenth ss = doc (showChar '(') . ss . doc (showChar ')')
+
+concatS :: [ShowS] -> ShowS
+concatS = foldr (.) id
+
+concatD :: [Doc] -> Doc
+concatD = foldr (.) id
+
+replicateS :: Int -> ShowS -> ShowS
+replicateS n f = concatS (replicate n f)
+
+-- the printer class does the job
+class Print a where
+ prt :: Int -> a -> Doc
+ prtList :: [a] -> Doc
+ prtList = concatD . map (prt 0)
+
+instance Print a => Print [a] where
+ prt _ = prtList
+
+instance Print Char where
+ prt _ s = doc (showChar '\'' . mkEsc '\'' s . showChar '\'')
+ prtList s = doc (showChar '"' . concatS (map (mkEsc '"') s) . showChar '"')
+
+mkEsc :: Char -> Char -> ShowS
+mkEsc q s = case s of
+ _ | s == q -> showChar '\\' . showChar s
+ '\\'-> showString "\\\\"
+ '\n' -> showString "\\n"
+ '\t' -> showString "\\t"
+ _ -> showChar s
+
+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 LString where
+ prt _ (LString i) = doc (showString (BS.unpack i))
+
+
+instance Print PIdent where
+ prt _ (PIdent (_,i)) = doc (showString (BS.unpack i))
+ prtList es = case es of
+ [x] -> (concatD [prt 0 x])
+ x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])
+
+
+
+instance Print Grammar where
+ prt i e = case e of
+ Gr moddefs -> prPrec i 0 (concatD [prt 0 moddefs])
+
+
+instance Print ModDef where
+ prt i e = case e of
+ MMain pident0 pident concspecs -> prPrec i 0 (concatD [doc (showString "grammar") , prt 0 pident0 , doc (showString "=") , doc (showString "{") , doc (showString "abstract") , doc (showString "=") , prt 0 pident , doc (showString ";") , prt 0 concspecs , doc (showString "}")])
+ MModule complmod modtype modbody -> prPrec i 0 (concatD [prt 0 complmod , prt 0 modtype , doc (showString "=") , prt 0 modbody])
+
+ prtList es = case es of
+ [] -> (concatD [])
+ x:xs -> (concatD [prt 0 x , prt 0 xs])
+
+instance Print ConcSpec where
+ prt i e = case e of
+ ConcSpec pident concexp -> prPrec i 0 (concatD [prt 0 pident , doc (showString "=") , prt 0 concexp])
+
+ prtList es = case es of
+ [] -> (concatD [])
+ [x] -> (concatD [prt 0 x])
+ x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
+
+instance Print ConcExp where
+ prt i e = case e of
+ ConcExp pident transfers -> prPrec i 0 (concatD [prt 0 pident , prt 0 transfers])
+
+
+instance Print Transfer where
+ prt i e = case e of
+ TransferIn open -> prPrec i 0 (concatD [doc (showString "(") , doc (showString "transfer") , doc (showString "in") , prt 0 open , doc (showString ")")])
+ TransferOut open -> prPrec i 0 (concatD [doc (showString "(") , doc (showString "transfer") , doc (showString "out") , prt 0 open , doc (showString ")")])
+
+ prtList es = case es of
+ [] -> (concatD [])
+ x:xs -> (concatD [prt 0 x , prt 0 xs])
+
+
+instance Print ModType where
+ prt i e = case e of
+ MTAbstract pident -> prPrec i 0 (concatD [doc (showString "abstract") , prt 0 pident])
+ MTResource pident -> prPrec i 0 (concatD [doc (showString "resource") , prt 0 pident])
+ MTInterface pident -> prPrec i 0 (concatD [doc (showString "interface") , prt 0 pident])
+ MTConcrete pident0 pident -> prPrec i 0 (concatD [doc (showString "concrete") , prt 0 pident0 , doc (showString "of") , prt 0 pident])
+ MTInstance pident0 pident -> prPrec i 0 (concatD [doc (showString "instance") , prt 0 pident0 , doc (showString "of") , prt 0 pident])
+ MTTransfer pident open0 open -> prPrec i 0 (concatD [doc (showString "transfer") , prt 0 pident , doc (showString ":") , prt 0 open0 , doc (showString "->") , prt 0 open])
+
+
+instance Print ModBody where
+ prt i e = case e of
+ MBody extend opens topdefs -> prPrec i 0 (concatD [prt 0 extend , prt 0 opens , doc (showString "{") , prt 0 topdefs , doc (showString "}")])
+ MNoBody includeds -> prPrec i 0 (concatD [prt 0 includeds])
+ MWith included opens -> prPrec i 0 (concatD [prt 0 included , doc (showString "with") , prt 0 opens])
+ MWithBody included opens0 opens topdefs -> prPrec i 0 (concatD [prt 0 included , doc (showString "with") , prt 0 opens0 , doc (showString "**") , prt 0 opens , doc (showString "{") , prt 0 topdefs , doc (showString "}")])
+ MWithE includeds included opens -> prPrec i 0 (concatD [prt 0 includeds , doc (showString "**") , prt 0 included , doc (showString "with") , prt 0 opens])
+ MWithEBody includeds included opens0 opens topdefs -> prPrec i 0 (concatD [prt 0 includeds , doc (showString "**") , prt 0 included , doc (showString "with") , prt 0 opens0 , doc (showString "**") , prt 0 opens , doc (showString "{") , prt 0 topdefs , doc (showString "}")])
+ MReuse pident -> prPrec i 0 (concatD [doc (showString "reuse") , prt 0 pident])
+ MUnion includeds -> prPrec i 0 (concatD [doc (showString "union") , prt 0 includeds])
+
+
+instance Print Extend where
+ prt i e = case e of
+ Ext includeds -> prPrec i 0 (concatD [prt 0 includeds , doc (showString "**")])
+ NoExt -> prPrec i 0 (concatD [])
+
+
+instance Print Opens where
+ prt i e = case e of
+ NoOpens -> prPrec i 0 (concatD [])
+ OpenIn opens -> prPrec i 0 (concatD [doc (showString "open") , prt 0 opens , doc (showString "in")])
+
+
+instance Print Open where
+ prt i e = case e of
+ OName pident -> prPrec i 0 (concatD [prt 0 pident])
+ OQualQO qualopen pident -> prPrec i 0 (concatD [doc (showString "(") , prt 0 qualopen , prt 0 pident , doc (showString ")")])
+ OQual qualopen pident0 pident -> prPrec i 0 (concatD [doc (showString "(") , prt 0 qualopen , prt 0 pident0 , doc (showString "=") , prt 0 pident , doc (showString ")")])
+
+ prtList es = case es of
+ [] -> (concatD [])
+ [x] -> (concatD [prt 0 x])
+ x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])
+
+instance Print ComplMod where
+ prt i e = case e of
+ CMCompl -> prPrec i 0 (concatD [])
+ CMIncompl -> prPrec i 0 (concatD [doc (showString "incomplete")])
+
+
+instance Print QualOpen where
+ prt i e = case e of
+ QOCompl -> prPrec i 0 (concatD [])
+ QOIncompl -> prPrec i 0 (concatD [doc (showString "incomplete")])
+ QOInterface -> prPrec i 0 (concatD [doc (showString "interface")])
+
+
+instance Print Included where
+ prt i e = case e of
+ IAll pident -> prPrec i 0 (concatD [prt 0 pident])
+ ISome pident pidents -> prPrec i 0 (concatD [prt 0 pident , doc (showString "[") , prt 0 pidents , doc (showString "]")])
+ IMinus pident pidents -> prPrec i 0 (concatD [prt 0 pident , doc (showString "-") , doc (showString "[") , prt 0 pidents , doc (showString "]")])
+
+ prtList es = case es of
+ [] -> (concatD [])
+ [x] -> (concatD [prt 0 x])
+ x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])
+
+instance Print Def where
+ prt i e = case e of
+ DDecl names exp -> prPrec i 0 (concatD [prt 0 names , doc (showString ":") , prt 0 exp])
+ DDef names exp -> prPrec i 0 (concatD [prt 0 names , doc (showString "=") , prt 0 exp])
+ DPatt name patts exp -> prPrec i 0 (concatD [prt 0 name , prt 0 patts , doc (showString "=") , prt 0 exp])
+ DFull names exp0 exp -> prPrec i 0 (concatD [prt 0 names , doc (showString ":") , prt 0 exp0 , doc (showString "=") , prt 0 exp])
+
+ prtList es = case es of
+ [x] -> (concatD [prt 0 x , doc (showString ";")])
+ x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
+
+instance Print TopDef where
+ prt i e = case e of
+ DefCat catdefs -> prPrec i 0 (concatD [doc (showString "cat") , prt 0 catdefs])
+ DefFun fundefs -> prPrec i 0 (concatD [doc (showString "fun") , prt 0 fundefs])
+ DefFunData fundefs -> prPrec i 0 (concatD [doc (showString "data") , prt 0 fundefs])
+ DefDef defs -> prPrec i 0 (concatD [doc (showString "def") , prt 0 defs])
+ DefData datadefs -> prPrec i 0 (concatD [doc (showString "data") , prt 0 datadefs])
+ DefTrans defs -> prPrec i 0 (concatD [doc (showString "transfer") , prt 0 defs])
+ DefPar pardefs -> prPrec i 0 (concatD [doc (showString "param") , prt 0 pardefs])
+ DefOper defs -> prPrec i 0 (concatD [doc (showString "oper") , prt 0 defs])
+ DefLincat printdefs -> prPrec i 0 (concatD [doc (showString "lincat") , prt 0 printdefs])
+ DefLindef defs -> prPrec i 0 (concatD [doc (showString "lindef") , prt 0 defs])
+ DefLin defs -> prPrec i 0 (concatD [doc (showString "lin") , prt 0 defs])
+ DefPrintCat printdefs -> prPrec i 0 (concatD [doc (showString "printname") , doc (showString "cat") , prt 0 printdefs])
+ DefPrintFun printdefs -> prPrec i 0 (concatD [doc (showString "printname") , doc (showString "fun") , prt 0 printdefs])
+ DefFlag flagdefs -> prPrec i 0 (concatD [doc (showString "flags") , prt 0 flagdefs])
+ DefPrintOld printdefs -> prPrec i 0 (concatD [doc (showString "printname") , prt 0 printdefs])
+ DefLintype defs -> prPrec i 0 (concatD [doc (showString "lintype") , prt 0 defs])
+ DefPattern defs -> prPrec i 0 (concatD [doc (showString "pattern") , prt 0 defs])
+ DefPackage pident topdefs -> prPrec i 0 (concatD [doc (showString "package") , prt 0 pident , doc (showString "=") , doc (showString "{") , prt 0 topdefs , doc (showString "}") , doc (showString ";")])
+ DefVars defs -> prPrec i 0 (concatD [doc (showString "var") , prt 0 defs])
+ DefTokenizer pident -> prPrec i 0 (concatD [doc (showString "tokenizer") , prt 0 pident , doc (showString ";")])
+
+ prtList es = case es of
+ [] -> (concatD [])
+ x:xs -> (concatD [prt 0 x , prt 0 xs])
+
+instance Print CatDef where
+ prt i e = case e of
+ SimpleCatDef pident ddecls -> prPrec i 0 (concatD [prt 0 pident , prt 0 ddecls])
+ ListCatDef pident ddecls -> prPrec i 0 (concatD [doc (showString "[") , prt 0 pident , prt 0 ddecls , doc (showString "]")])
+ ListSizeCatDef pident ddecls n -> prPrec i 0 (concatD [doc (showString "[") , prt 0 pident , prt 0 ddecls , doc (showString "]") , doc (showString "{") , prt 0 n , doc (showString "}")])
+
+ prtList es = case es of
+ [x] -> (concatD [prt 0 x , doc (showString ";")])
+ x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
+
+instance Print FunDef where
+ prt i e = case e of
+ FunDef pidents exp -> prPrec i 0 (concatD [prt 0 pidents , doc (showString ":") , prt 0 exp])
+
+ prtList es = case es of
+ [x] -> (concatD [prt 0 x , doc (showString ";")])
+ x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
+
+instance Print DataDef where
+ prt i e = case e of
+ DataDef pident dataconstrs -> prPrec i 0 (concatD [prt 0 pident , doc (showString "=") , prt 0 dataconstrs])
+
+ prtList es = case es of
+ [x] -> (concatD [prt 0 x , doc (showString ";")])
+ x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
+
+instance Print DataConstr where
+ prt i e = case e of
+ DataId pident -> prPrec i 0 (concatD [prt 0 pident])
+ DataQId pident0 pident -> prPrec i 0 (concatD [prt 0 pident0 , doc (showString ".") , prt 0 pident])
+
+ prtList es = case es of
+ [] -> (concatD [])
+ [x] -> (concatD [prt 0 x])
+ x:xs -> (concatD [prt 0 x , doc (showString "|") , prt 0 xs])
+
+instance Print ParDef where
+ prt i e = case e of
+ ParDefDir pident parconstrs -> prPrec i 0 (concatD [prt 0 pident , doc (showString "=") , prt 0 parconstrs])
+ ParDefIndir pident0 pident -> prPrec i 0 (concatD [prt 0 pident0 , doc (showString "=") , doc (showString "(") , doc (showString "in") , prt 0 pident , doc (showString ")")])
+ ParDefAbs pident -> prPrec i 0 (concatD [prt 0 pident])
+
+ prtList es = case es of
+ [x] -> (concatD [prt 0 x , doc (showString ";")])
+ x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
+
+instance Print ParConstr where
+ prt i e = case e of
+ ParConstr pident ddecls -> prPrec i 0 (concatD [prt 0 pident , prt 0 ddecls])
+
+ prtList es = case es of
+ [] -> (concatD [])
+ [x] -> (concatD [prt 0 x])
+ x:xs -> (concatD [prt 0 x , doc (showString "|") , prt 0 xs])
+
+instance Print PrintDef where
+ prt i e = case e of
+ PrintDef names exp -> prPrec i 0 (concatD [prt 0 names , doc (showString "=") , prt 0 exp])
+
+ prtList es = case es of
+ [x] -> (concatD [prt 0 x , doc (showString ";")])
+ x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
+
+instance Print FlagDef where
+ prt i e = case e of
+ FlagDef pident0 pident -> prPrec i 0 (concatD [prt 0 pident0 , doc (showString "=") , prt 0 pident])
+
+ prtList es = case es of
+ [x] -> (concatD [prt 0 x , doc (showString ";")])
+ x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
+
+instance Print Name where
+ prt i e = case e of
+ IdentName pident -> prPrec i 0 (concatD [prt 0 pident])
+ ListName pident -> prPrec i 0 (concatD [doc (showString "[") , prt 0 pident , doc (showString "]")])
+
+ prtList es = case es of
+ [x] -> (concatD [prt 0 x])
+ x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])
+
+instance Print LocDef where
+ prt i e = case e of
+ LDDecl pidents exp -> prPrec i 0 (concatD [prt 0 pidents , doc (showString ":") , prt 0 exp])
+ LDDef pidents exp -> prPrec i 0 (concatD [prt 0 pidents , doc (showString "=") , prt 0 exp])
+ LDFull pidents exp0 exp -> prPrec i 0 (concatD [prt 0 pidents , doc (showString ":") , prt 0 exp0 , doc (showString "=") , prt 0 exp])
+
+ prtList es = case es of
+ [] -> (concatD [])
+ [x] -> (concatD [prt 0 x])
+ x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
+
+instance Print Exp where
+ prt i e = case e of
+ EIdent pident -> prPrec i 6 (concatD [prt 0 pident])
+ EConstr pident -> prPrec i 6 (concatD [doc (showString "{") , prt 0 pident , doc (showString "}")])
+ ECons pident -> prPrec i 6 (concatD [doc (showString "%") , prt 0 pident , 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 pident exps -> prPrec i 6 (concatD [doc (showString "[") , prt 0 pident , 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 pident -> prPrec i 6 (concatD [doc (showString "(") , doc (showString "in") , prt 0 pident , 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 pident0 pident -> prPrec i 5 (concatD [doc (showString "{") , prt 0 pident0 , doc (showString ".") , prt 0 pident , doc (showString "}")])
+ EQCons pident0 pident -> prPrec i 5 (concatD [doc (showString "%") , prt 0 pident0 , doc (showString ".") , prt 0 pident])
+ 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 pident exp -> prPrec i 4 (concatD [prt 0 pident , doc (showString "@") , prt 6 exp])
+ EPatt patt -> prPrec i 4 (concatD [doc (showString "#") , prt 2 patt])
+ EPattType exp -> prPrec i 4 (concatD [doc (showString "pattern") , prt 5 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 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 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 "}")])
+ 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 pident -> prPrec i 4 (concatD [doc (showString "Lin") , prt 0 pident])
+
+ prtList es = case es of
+ [] -> (concatD [])
+ [x] -> (concatD [prt 0 x])
+ x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
+
+instance Print Exps where
+ prt i e = case e of
+ NilExp -> prPrec i 0 (concatD [])
+ ConsExp exp exps -> prPrec i 0 (concatD [prt 6 exp , prt 0 exps])
+
+
+instance Print Patt where
+ prt i e = case e of
+ PChar -> prPrec i 2 (concatD [doc (showString "?")])
+ PChars str -> prPrec i 2 (concatD [doc (showString "[") , prt 0 str , doc (showString "]")])
+ PMacro pident -> prPrec i 2 (concatD [doc (showString "#") , prt 0 pident])
+ PM pident0 pident -> prPrec i 2 (concatD [doc (showString "#") , prt 0 pident0 , doc (showString ".") , prt 0 pident])
+ PW -> prPrec i 2 (concatD [doc (showString "_")])
+ PV pident -> prPrec i 2 (concatD [prt 0 pident])
+ PCon pident -> prPrec i 2 (concatD [doc (showString "{") , prt 0 pident , doc (showString "}")])
+ PQ pident0 pident -> prPrec i 2 (concatD [prt 0 pident0 , doc (showString ".") , prt 0 pident])
+ 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 pident patts -> prPrec i 1 (concatD [prt 0 pident , prt 0 patts])
+ PQC pident0 pident patts -> prPrec i 1 (concatD [prt 0 pident0 , doc (showString ".") , prt 0 pident , prt 0 patts])
+ PDisj patt0 patt -> prPrec i 0 (concatD [prt 0 patt0 , doc (showString "|") , prt 1 patt])
+ PSeq patt0 patt -> prPrec i 0 (concatD [prt 0 patt0 , doc (showString "+") , prt 1 patt])
+ PRep patt -> prPrec i 1 (concatD [prt 2 patt , doc (showString "*")])
+ PAs pident patt -> prPrec i 1 (concatD [prt 0 pident , doc (showString "@") , prt 2 patt])
+ PNeg patt -> prPrec i 1 (concatD [doc (showString "-") , prt 2 patt])
+
+ prtList es = case es of
+ [x] -> (concatD [prt 2 x])
+ x:xs -> (concatD [prt 2 x , prt 0 xs])
+
+instance Print PattAss where
+ prt i e = case e of
+ PA pidents patt -> prPrec i 0 (concatD [prt 0 pidents , doc (showString "=") , prt 0 patt])
+
+ prtList es = case es of
+ [] -> (concatD [])
+ [x] -> (concatD [prt 0 x])
+ x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
+
+instance Print Label where
+ prt i e = case e of
+ LIdent pident -> prPrec i 0 (concatD [prt 0 pident])
+ LVar n -> prPrec i 0 (concatD [doc (showString "$") , prt 0 n])
+
+
+instance Print Sort where
+ prt i e = case e of
+ Sort_Type -> prPrec i 0 (concatD [doc (showString "Type")])
+ Sort_PType -> prPrec i 0 (concatD [doc (showString "PType")])
+ Sort_Tok -> prPrec i 0 (concatD [doc (showString "Tok")])
+ Sort_Str -> prPrec i 0 (concatD [doc (showString "Str")])
+ Sort_Strs -> prPrec i 0 (concatD [doc (showString "Strs")])
+
+
+instance Print Bind where
+ prt i e = case e of
+ BIdent pident -> prPrec i 0 (concatD [prt 0 pident])
+ BWild -> prPrec i 0 (concatD [doc (showString "_")])
+
+ prtList es = case es of
+ [] -> (concatD [])
+ [x] -> (concatD [prt 0 x])
+ x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])
+
+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 4 exp])
+
+
+instance Print TupleComp where
+ prt i e = case e of
+ TComp exp -> prPrec i 0 (concatD [prt 0 exp])
+
+ prtList es = case es of
+ [] -> (concatD [])
+ [x] -> (concatD [prt 0 x])
+ x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])
+
+instance Print PattTupleComp where
+ prt i e = case e of
+ PTComp patt -> prPrec i 0 (concatD [prt 0 patt])
+
+ prtList es = case es of
+ [] -> (concatD [])
+ [x] -> (concatD [prt 0 x])
+ x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])
+
+instance Print Case where
+ prt i e = case e of
+ 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])
+ x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
+
+instance Print Equation where
+ prt i e = case e of
+ Equ patts exp -> prPrec i 0 (concatD [prt 0 patts , doc (showString "->") , prt 0 exp])
+
+ prtList es = case es of
+ [] -> (concatD [])
+ [x] -> (concatD [prt 0 x])
+ x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
+
+instance Print Altern where
+ prt i e = case e of
+ Alt exp0 exp -> prPrec i 0 (concatD [prt 0 exp0 , doc (showString "/") , prt 0 exp])
+
+ prtList es = case es of
+ [] -> (concatD [])
+ [x] -> (concatD [prt 0 x])
+ x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
+
+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 6 exp])
+
+ prtList es = case es of
+ [] -> (concatD [])
+ x:xs -> (concatD [prt 0 x , prt 0 xs])
+
+instance Print OldGrammar where
+ prt i e = case e of
+ OldGr include topdefs -> prPrec i 0 (concatD [prt 0 include , prt 0 topdefs])
+
+
+instance Print Include where
+ prt i e = case e of
+ NoIncl -> prPrec i 0 (concatD [])
+ Incl filenames -> prPrec i 0 (concatD [doc (showString "include") , prt 0 filenames])
+
+
+instance Print FileName where
+ prt i e = case e of
+ FString str -> prPrec i 0 (concatD [prt 0 str])
+ FIdent pident -> prPrec i 0 (concatD [prt 0 pident])
+ FSlash filename -> prPrec i 0 (concatD [doc (showString "/") , prt 0 filename])
+ FDot filename -> prPrec i 0 (concatD [doc (showString ".") , prt 0 filename])
+ FMinus filename -> prPrec i 0 (concatD [doc (showString "-") , prt 0 filename])
+ FAddId pident filename -> prPrec i 0 (concatD [prt 0 pident , prt 0 filename])
+
+ prtList es = case es of
+ [x] -> (concatD [prt 0 x , doc (showString ";")])
+ x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
+
+
generated by cgit v1.2.3 (git 2.39.1) at 2026-05-20 18:35:10 +0000