GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-05-15 06:02:55 -06:00
Code Issues Packages Projects Releases Wiki Activity

full disjunctive patterns ; more prec levels for Exp

Browse Source
This commit is contained in:
aarne
2005-12-20 22:38:38 +00:00
parent 5d61388d77
commit a7d36ea1f8
9 changed files with 805 additions and 732 deletions
Download Patch File Download Diff File Expand all files Collapse all files

144
src/GF/Source/PrintGF.hs
View File

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