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.hs435
1 files changed, 435 insertions, 0 deletions
diff --git a/src/GF/Source/PrintGF.hs b/src/GF/Source/PrintGF.hs
new file mode 100644
index 000000000..9d71dfe6e
--- /dev/null
+++ b/src/GF/Source/PrintGF.hs
@@ -0,0 +1,435 @@
+module PrintGF where
+
+-- pretty-printer generated by the BNF converter, except --H
+
+import AbsGF
+import Ident --H
+import Char
+
+-- the top-level printing method
+printTree :: Print a => a -> String
+printTree = render . prt 0
+
+-- you may want to change render and parenth
+
+render :: [String] -> String
+render = rend 0 where
+ rend i ss = case ss of
+
+ --H these three are hand-written
+ "{0" :ts -> cons "{" $ rend (i+1) ts
+ t :"}0" :ts -> cons t $ space "}" $ rend (i-1) ts
+ t : "." :ts -> cons t $ cons "." $ rend i ts
+
+ "[" :ts -> cons "[" $ rend i ts
+ "(" :ts -> cons "(" $ rend i ts
+ "{" :ts -> cons "{" $ new (i+1) $ rend (i+1) ts
+ "}" : ";":ts -> new (i-1) $ space "}" $ cons ";" $ new (i-1) $ rend (i-1) ts
+ "}" :ts -> new (i-1) $ cons "}" $ new (i-1) $ rend (i-1) ts
+ ";" :ts -> cons ";" $ new i $ rend i ts
+ t : "," :ts -> cons t $ space "," $ rend i ts
+ t : ")" :ts -> cons t $ cons ")" $ rend i ts
+ t : "]" :ts -> cons t $ cons "]" $ rend i ts
+ t :ts -> space t $ rend i ts
+ _ -> ""
+ cons s t = s ++ t
+ new i s = '\n' : replicate (2*i) ' ' ++ dropWhile isSpace s
+ space t s = if null s then t else t ++ " " ++ s
+
+parenth :: [String] -> [String]
+parenth ss = ["("] ++ ss ++ [")"]
+
+-- the printer class does the job
+class Print a where
+ prt :: Int -> a -> [String]
+ prtList :: [a] -> [String]
+ prtList = concat . map (prt 0)
+
+instance Print a => Print [a] where
+ prt _ = prtList
+
+instance Print Integer where
+ prt _ = (:[]) . show
+
+instance Print Double where
+ prt _ = (:[]) . show
+
+instance Print Char where
+ prt _ s = ["'" ++ mkEsc s ++ "'"]
+ prtList s = ["\"" ++ concatMap mkEsc s ++ "\""]
+
+mkEsc s = case s of
+ _ | elem s "\\\"'" -> '\\':[s]
+ '\n' -> "\\n"
+ '\t' -> "\\t"
+ _ -> [s]
+
+prPrec :: Int -> Int -> [String] -> [String]
+prPrec i j = if j<i then parenth else id
+
+
+instance Print Ident where
+ prt _ i = [prIdent i] --H
+ prtList es = case es of
+ [x] -> (concat [prt 0 x])
+ x:xs -> (concat [prt 0 x , [","] , prt 0 xs])
+
+
+instance Print LString where
+ prt _ (LString i) = [i]
+
+
+
+instance Print Grammar where
+ prt i e = case e of
+ Gr moddefs -> prPrec i 0 (concat [prt 0 moddefs])
+
+
+instance Print ModDef where
+ prt i e = case e of
+ MMain id0 id concspecs -> prPrec i 0 (concat [["grammar"] , prt 0 id0 , ["="] , ["{"] , ["abstract"] , ["="] , prt 0 id , [";"] , prt 0 concspecs , ["}"]])
+ MAbstract id extend opens topdefs -> prPrec i 0 (concat [["abstract"] , prt 0 id , ["="] , prt 0 extend , prt 0 opens , ["{"] , prt 0 topdefs , ["}"]])
+ MResource id extend opens topdefs -> prPrec i 0 (concat [["resource"] , prt 0 id , ["="] , prt 0 extend , prt 0 opens , ["{"] , prt 0 topdefs , ["}"]])
+ MResourceInt id extend opens topdefs -> prPrec i 0 (concat [["resource"] , ["abstract"] , prt 0 id , ["="] , prt 0 extend , prt 0 opens , ["{"] , prt 0 topdefs , ["}"]])
+ MResourceImp id0 id opens topdefs -> prPrec i 0 (concat [["resource"] , prt 0 id0 , ["of"] , prt 0 id , ["="] , prt 0 opens , ["{"] , prt 0 topdefs , ["}"]])
+ MConcrete id0 id extend opens topdefs -> prPrec i 0 (concat [["concrete"] , prt 0 id0 , ["of"] , prt 0 id , ["="] , prt 0 extend , prt 0 opens , ["{"] , prt 0 topdefs , ["}"]])
+ MConcreteInt id0 id extend opens topdefs -> prPrec i 0 (concat [["concrete"] , ["abstract"] , ["of"] , prt 0 id0 , ["in"] , prt 0 id , ["="] , prt 0 extend , prt 0 opens , ["{"] , prt 0 topdefs , ["}"]])
+ MConcreteImp open id0 id -> prPrec i 0 (concat [["concrete"] , ["of"] , prt 0 open , ["="] , prt 0 id0 , ["**"] , prt 0 id])
+ MTransfer id open0 open extend opens topdefs -> prPrec i 0 (concat [["transfer"] , prt 0 id , [":"] , prt 0 open0 , ["->"] , prt 0 open , ["="] , prt 0 extend , prt 0 opens , ["{"] , prt 0 topdefs , ["}"]])
+ MReuseAbs id0 id -> prPrec i 0 (concat [["resource"] , ["abstract"] , prt 0 id0 , ["="] , ["reuse"] , prt 0 id])
+ MReuseCnc id0 id -> prPrec i 0 (concat [["resource"] , ["concrete"] , prt 0 id0 , ["="] , ["reuse"] , prt 0 id])
+ MReuseAll id0 extend id -> prPrec i 0 (concat [["resource"] , prt 0 id0 , ["="] , prt 0 extend , ["reuse"] , prt 0 id])
+
+ prtList es = case es of
+ [] -> (concat [])
+ x:xs -> (concat [prt 0 x , prt 0 xs])
+
+instance Print ConcSpec where
+ prt i e = case e of
+ ConcSpec id concexp -> prPrec i 0 (concat [prt 0 id , ["="] , prt 0 concexp])
+
+ prtList es = case es of
+ [] -> (concat [])
+ [x] -> (concat [prt 0 x])
+ x:xs -> (concat [prt 0 x , [";"] , prt 0 xs])
+
+instance Print ConcExp where
+ prt i e = case e of
+ ConcExp id transfers -> prPrec i 0 (concat [prt 0 id , prt 0 transfers])
+
+
+instance Print Transfer where
+ prt i e = case e of
+ TransferIn open -> prPrec i 0 (concat [["("] , ["transfer"] , ["in"] , prt 0 open , [")"]])
+ TransferOut open -> prPrec i 0 (concat [["("] , ["transfer"] , ["out"] , prt 0 open , [")"]])
+
+ prtList es = case es of
+ [] -> (concat [])
+ x:xs -> (concat [prt 0 x , prt 0 xs])
+
+instance Print Extend where
+ prt i e = case e of
+ Ext id -> prPrec i 0 (concat [prt 0 id , ["**"]])
+ NoExt -> prPrec i 0 (concat [])
+
+
+instance Print Opens where
+ prt i e = case e of
+ NoOpens -> prPrec i 0 (concat [])
+ Opens opens -> prPrec i 0 (concat [["open"] , prt 0 opens , ["in"]])
+
+
+instance Print Open where
+ prt i e = case e of
+ OName id -> prPrec i 0 (concat [prt 0 id])
+ OQual id0 id -> prPrec i 0 (concat [["("] , prt 0 id0 , ["="] , prt 0 id , [")"]])
+
+ prtList es = case es of
+ [] -> (concat [])
+ [x] -> (concat [prt 0 x])
+ x:xs -> (concat [prt 0 x , [","] , prt 0 xs])
+
+instance Print Def where
+ prt i e = case e of
+ DDecl ids exp -> prPrec i 0 (concat [prt 0 ids , [":"] , prt 0 exp])
+ DDef ids exp -> prPrec i 0 (concat [prt 0 ids , ["="] , prt 0 exp])
+ DPatt id patts exp -> prPrec i 0 (concat [prt 0 id , prt 0 patts , ["="] , prt 0 exp])
+ DFull ids exp0 exp -> prPrec i 0 (concat [prt 0 ids , [":"] , prt 0 exp0 , ["="] , prt 0 exp])
+
+ prtList es = case es of
+ [x] -> (concat [prt 0 x , [";"]])
+ x:xs -> (concat [prt 0 x , [";"] , prt 0 xs])
+
+instance Print TopDef where
+ prt i e = case e of
+ DefCat catdefs -> prPrec i 0 (concat [["cat"] , prt 0 catdefs])
+ DefFun fundefs -> prPrec i 0 (concat [["fun"] , prt 0 fundefs])
+ DefDef defs -> prPrec i 0 (concat [["def"] , prt 0 defs])
+ DefData pardefs -> prPrec i 0 (concat [["data"] , prt 0 pardefs])
+ DefTrans flagdefs -> prPrec i 0 (concat [["transfer"] , prt 0 flagdefs])
+ DefPar pardefs -> prPrec i 0 (concat [["param"] , prt 0 pardefs])
+ DefOper defs -> prPrec i 0 (concat [["oper"] , prt 0 defs])
+ DefLincat printdefs -> prPrec i 0 (concat [["lincat"] , prt 0 printdefs])
+ DefLindef defs -> prPrec i 0 (concat [["lindef"] , prt 0 defs])
+ DefLin defs -> prPrec i 0 (concat [["lin"] , prt 0 defs])
+ DefPrintCat printdefs -> prPrec i 0 (concat [["printname"] , ["cat"] , prt 0 printdefs])
+ DefPrintFun printdefs -> prPrec i 0 (concat [["printname"] , ["fun"] , prt 0 printdefs])
+ DefFlag flagdefs -> prPrec i 0 (concat [["flags"] , prt 0 flagdefs])
+ DefPrintOld printdefs -> prPrec i 0 (concat [["printname"] , prt 0 printdefs])
+ DefLintype defs -> prPrec i 0 (concat [["lintype"] , prt 0 defs])
+ DefPattern defs -> prPrec i 0 (concat [["pattern"] , prt 0 defs])
+
+ prtList es = case es of
+ [] -> (concat [])
+ x:xs -> (concat [prt 0 x , prt 0 xs])
+
+instance Print CatDef where
+ prt i e = case e of
+ CatDef id ddecls -> prPrec i 0 (concat [prt 0 id , prt 0 ddecls])
+
+ prtList es = case es of
+ [x] -> (concat [prt 0 x , [";"]])
+ x:xs -> (concat [prt 0 x , [";"] , prt 0 xs])
+
+instance Print FunDef where
+ prt i e = case e of
+ FunDef ids exp -> prPrec i 0 (concat [prt 0 ids , [":"] , prt 0 exp])
+
+ prtList es = case es of
+ [x] -> (concat [prt 0 x , [";"]])
+ x:xs -> (concat [prt 0 x , [";"] , prt 0 xs])
+
+instance Print ParDef where
+ prt i e = case e of
+ ParDef id parconstrs -> prPrec i 0 (concat [prt 0 id , ["="] , prt 0 parconstrs])
+ ParDefIndir id0 id -> prPrec i 0 (concat [prt 0 id0 , ["="] , ["("] , ["in"] , prt 0 id , [")"]])
+ ParDefAbs id -> prPrec i 0 (concat [prt 0 id])
+
+ prtList es = case es of
+ [x] -> (concat [prt 0 x , [";"]])
+ x:xs -> (concat [prt 0 x , [";"] , prt 0 xs])
+
+instance Print ParConstr where
+ prt i e = case e of
+ ParConstr id ddecls -> prPrec i 0 (concat [prt 0 id , prt 0 ddecls])
+
+ prtList es = case es of
+ [] -> (concat [])
+ [x] -> (concat [prt 0 x])
+ x:xs -> (concat [prt 0 x , ["|"] , prt 0 xs])
+
+instance Print PrintDef where
+ prt i e = case e of
+ PrintDef ids exp -> prPrec i 0 (concat [prt 0 ids , ["="] , prt 0 exp])
+
+ prtList es = case es of
+ [x] -> (concat [prt 0 x , [";"]])
+ x:xs -> (concat [prt 0 x , [";"] , prt 0 xs])
+
+instance Print FlagDef where
+ prt i e = case e of
+ FlagDef id0 id -> prPrec i 0 (concat [prt 0 id0 , ["="] , prt 0 id])
+
+ prtList es = case es of
+ [x] -> (concat [prt 0 x , [";"]])
+ x:xs -> (concat [prt 0 x , [";"] , prt 0 xs])
+
+instance Print LocDef where
+ prt i e = case e of
+ LDDecl ids exp -> prPrec i 0 (concat [prt 0 ids , [":"] , prt 0 exp])
+ LDDef ids exp -> prPrec i 0 (concat [prt 0 ids , ["="] , prt 0 exp])
+ LDFull ids exp0 exp -> prPrec i 0 (concat [prt 0 ids , [":"] , prt 0 exp0 , ["="] , prt 0 exp])
+
+ prtList es = case es of
+ [] -> (concat [])
+ [x] -> (concat [prt 0 x])
+ x:xs -> (concat [prt 0 x , [";"] , prt 0 xs])
+
+instance Print Exp where
+ prt i e = case e of
+ EIdent id -> prPrec i 4 (concat [prt 0 id])
+ EConstr id -> prPrec i 4 (concat [["{0"] , prt 0 id , ["}0"]]) --H
+ ECons id -> prPrec i 4 (concat [["["] , prt 0 id , ["]"]])
+ ESort sort -> prPrec i 4 (concat [prt 0 sort])
+ EString str -> prPrec i 4 (concat [prt 0 str])
+ EInt n -> prPrec i 4 (concat [prt 0 n])
+ EMeta -> prPrec i 4 (concat [["?"]])
+ EEmpty -> prPrec i 4 (concat [["["] , ["]"]])
+ EStrings str -> prPrec i 4 (concat [["["] , prt 0 str , ["]"]])
+ ERecord locdefs -> prPrec i 4 (concat [["{"] , prt 0 locdefs , ["}"]])
+ ETuple tuplecomps -> prPrec i 4 (concat [["<"] , prt 0 tuplecomps , [">"]])
+ EIndir id -> prPrec i 4 (concat [["("] , ["in"] , prt 0 id , [")"]])
+ ETyped exp0 exp -> prPrec i 4 (concat [["<"] , prt 0 exp0 , [":"] , prt 0 exp , [">"]])
+ EProj exp label -> prPrec i 3 (concat [prt 3 exp , ["."] , prt 0 label])
+ EQConstr id0 id -> prPrec i 3 (concat [["{0"] , prt 0 id0 , ["."] , prt 0 id , ["}0"]]) --H
+ EQCons id0 id -> prPrec i 3 (concat [["["] , prt 0 id0 , ["."] , prt 0 id , ["]"]])
+ EApp exp0 exp -> prPrec i 2 (concat [prt 2 exp0 , prt 3 exp])
+ ETable cases -> prPrec i 2 (concat [["table"] , ["{"] , prt 0 cases , ["}"]])
+ ETTable exp cases -> prPrec i 2 (concat [["table"] , prt 4 exp , ["{"] , prt 0 cases , ["}"]])
+ ECase exp cases -> prPrec i 2 (concat [["case"] , prt 0 exp , ["of"] , ["{"] , prt 0 cases , ["}"]])
+ EVariants exps -> prPrec i 2 (concat [["variants"] , ["{"] , prt 0 exps , ["}"]])
+ EPre exp alterns -> prPrec i 2 (concat [["pre"] , ["{"] , prt 0 exp , [";"] , prt 0 alterns , ["}"]])
+ EStrs exps -> prPrec i 2 (concat [["strs"] , ["{"] , prt 0 exps , ["}"]])
+ EConAt id exp -> prPrec i 2 (concat [prt 0 id , ["@"] , prt 4 exp])
+ ESelect exp0 exp -> prPrec i 1 (concat [prt 1 exp0 , ["!"] , prt 2 exp])
+ ETupTyp exp0 exp -> prPrec i 1 (concat [prt 1 exp0 , ["*"] , prt 2 exp])
+ EExtend exp0 exp -> prPrec i 1 (concat [prt 1 exp0 , ["**"] , prt 2 exp])
+ EAbstr binds exp -> prPrec i 0 (concat [["\\"] , prt 0 binds , ["->"] , prt 0 exp])
+ ECTable binds exp -> prPrec i 0 (concat [["\\"] , ["\\"] , prt 0 binds , ["=>"] , prt 0 exp])
+ EProd decl exp -> prPrec i 0 (concat [prt 0 decl , ["->"] , prt 0 exp])
+ ETType exp0 exp -> prPrec i 0 (concat [prt 1 exp0 , ["=>"] , prt 0 exp])
+ EConcat exp0 exp -> prPrec i 0 (concat [prt 1 exp0 , ["++"] , prt 0 exp])
+ EGlue exp0 exp -> prPrec i 0 (concat [prt 1 exp0 , ["+"] , prt 0 exp])
+ ELet locdefs exp -> prPrec i 0 (concat [["let"] , ["{"] , prt 0 locdefs , ["}"] , ["in"] , prt 0 exp])
+ EEqs equations -> prPrec i 0 (concat [["fn"] , ["{"] , prt 0 equations , ["}"]])
+ ELString lstring -> prPrec i 4 (concat [prt 0 lstring])
+ ELin id -> prPrec i 2 (concat [["Lin"] , prt 0 id])
+
+ prtList es = case es of
+ [] -> (concat [])
+ [x] -> (concat [prt 0 x])
+ x:xs -> (concat [prt 0 x , [";"] , prt 0 xs])
+
+instance Print Patt where
+ prt i e = case e of
+ PW -> prPrec i 1 (concat [["_"]])
+ PV id -> prPrec i 1 (concat [prt 0 id])
+ PCon id -> prPrec i 1 (concat [["{0"] , prt 0 id , ["}0"]]) --H
+ PQ id0 id -> prPrec i 1 (concat [prt 0 id0 , ["."] , prt 0 id])
+ PInt n -> prPrec i 1 (concat [prt 0 n])
+ PStr str -> prPrec i 1 (concat [prt 0 str])
+ PR pattasss -> prPrec i 1 (concat [["{"] , prt 0 pattasss , ["}"]])
+ PTup patttuplecomps -> prPrec i 1 (concat [["<"] , prt 0 patttuplecomps , [">"]])
+ PC id patts -> prPrec i 0 (concat [prt 0 id , prt 0 patts])
+ PQC id0 id patts -> prPrec i 0 (concat [prt 0 id0 , ["."] , prt 0 id , prt 0 patts])
+
+ prtList es = case es of
+ [x] -> (concat [prt 1 x])
+ x:xs -> (concat [prt 1 x , prt 0 xs])
+
+instance Print PattAss where
+ prt i e = case e of
+ PA ids patt -> prPrec i 0 (concat [prt 0 ids , ["="] , prt 0 patt])
+
+ prtList es = case es of
+ [] -> (concat [])
+ [x] -> (concat [prt 0 x])
+ x:xs -> (concat [prt 0 x , [";"] , prt 0 xs])
+
+instance Print Label where
+ prt i e = case e of
+ LIdent id -> prPrec i 0 (concat [prt 0 id])
+ LVar n -> prPrec i 0 (concat [["$"] , prt 0 n])
+
+
+instance Print Sort where
+ prt i e = case e of
+ Sort_Type -> prPrec i 0 (concat [["Type"]])
+ Sort_PType -> prPrec i 0 (concat [["PType"]])
+ Sort_Tok -> prPrec i 0 (concat [["Tok"]])
+ Sort_Str -> prPrec i 0 (concat [["Str"]])
+ Sort_Strs -> prPrec i 0 (concat [["Strs"]])
+
+
+instance Print PattAlt where
+ prt i e = case e of
+ AltP patt -> prPrec i 0 (concat [prt 0 patt])
+
+ prtList es = case es of
+ [x] -> (concat [prt 0 x])
+ x:xs -> (concat [prt 0 x , ["|"] , prt 0 xs])
+
+instance Print Bind where
+ prt i e = case e of
+ BIdent id -> prPrec i 0 (concat [prt 0 id])
+ BWild -> prPrec i 0 (concat [["_"]])
+
+ prtList es = case es of
+ [] -> (concat [])
+ [x] -> (concat [prt 0 x])
+ x:xs -> (concat [prt 0 x , [","] , prt 0 xs])
+
+instance Print Decl where
+ prt i e = case e of
+ DDec binds exp -> prPrec i 0 (concat [["("] , prt 0 binds , [":"] , prt 0 exp , [")"]])
+ DExp exp -> prPrec i 0 (concat [prt 2 exp])
+
+
+instance Print TupleComp where
+ prt i e = case e of
+ TComp exp -> prPrec i 0 (concat [prt 0 exp])
+
+ prtList es = case es of
+ [] -> (concat [])
+ [x] -> (concat [prt 0 x])
+ x:xs -> (concat [prt 0 x , [","] , prt 0 xs])
+
+instance Print PattTupleComp where
+ prt i e = case e of
+ PTComp patt -> prPrec i 0 (concat [prt 0 patt])
+
+ prtList es = case es of
+ [] -> (concat [])
+ [x] -> (concat [prt 0 x])
+ x:xs -> (concat [prt 0 x , [","] , prt 0 xs])
+
+instance Print Case where
+ prt i e = case e of
+ Case pattalts exp -> prPrec i 0 (concat [prt 0 pattalts , ["=>"] , prt 0 exp])
+
+ prtList es = case es of
+ [x] -> (concat [prt 0 x])
+ x:xs -> (concat [prt 0 x , [";"] , prt 0 xs])
+
+instance Print Equation where
+ prt i e = case e of
+ Equ patts exp -> prPrec i 0 (concat [prt 0 patts , ["->"] , prt 0 exp])
+
+ prtList es = case es of
+ [] -> (concat [])
+ [x] -> (concat [prt 0 x])
+ x:xs -> (concat [prt 0 x , [";"] , prt 0 xs])
+
+instance Print Altern where
+ prt i e = case e of
+ Alt exp0 exp -> prPrec i 0 (concat [prt 0 exp0 , ["/"] , prt 0 exp])
+
+ prtList es = case es of
+ [] -> (concat [])
+ [x] -> (concat [prt 0 x])
+ x:xs -> (concat [prt 0 x , [";"] , prt 0 xs])
+
+instance Print DDecl where
+ prt i e = case e of
+ DDDec binds exp -> prPrec i 0 (concat [["("] , prt 0 binds , [":"] , prt 0 exp , [")"]])
+ DDExp exp -> prPrec i 0 (concat [prt 4 exp])
+
+ prtList es = case es of
+ [] -> (concat [])
+ x:xs -> (concat [prt 0 x , prt 0 xs])
+
+instance Print OldGrammar where
+ prt i e = case e of
+ OldGr include topdefs -> prPrec i 0 (concat [prt 0 include , prt 0 topdefs])
+
+
+instance Print Include where
+ prt i e = case e of
+ NoIncl -> prPrec i 0 (concat [])
+ Incl filenames -> prPrec i 0 (concat [["include"] , prt 0 filenames])
+
+
+instance Print FileName where
+ prt i e = case e of
+ FString str -> prPrec i 0 (concat [prt 0 str])
+ FIdent id -> prPrec i 0 (concat [prt 0 id])
+ FSlash filename -> prPrec i 0 (concat [["/"] , prt 0 filename])
+ FDot filename -> prPrec i 0 (concat [["."] , prt 0 filename])
+ FMinus filename -> prPrec i 0 (concat [["-"] , prt 0 filename])
+ FAddId id filename -> prPrec i 0 (concat [prt 0 id , prt 0 filename])
+
+ prtList es = case es of
+ [x] -> (concat [prt 0 x , [";"]])
+ x:xs -> (concat [prt 0 x , [";"] , prt 0 xs])
+
+
generated by cgit v1.2.3 (git 2.39.1) at 2026-05-20 16:24:34 +0000