From 86a30ef99213670b305934a4d0976d458db7db97 Mon Sep 17 00:00:00 2001 From: bjorn Date: Thu, 2 Oct 2008 13:23:54 +0000 Subject: Converted GF/Source/*.hs to Unix line endings, to be able to see what happens when I regenerated the files. --- src/GF/Source/PrintGF.hs | 1068 +++++++++++++++++++++++----------------------- 1 file changed, 534 insertions(+), 534 deletions(-) (limited to 'src/GF/Source/PrintGF.hs') 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 (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 (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]) + + -- cgit v1.2.3