Founding the newly structured GF2.0 cvs archive.

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])
+
+