diff options
Diffstat (limited to 'src/GF/Printing')
| -rw-r--r-- | src/GF/Printing/PrintParser.hs | 83 | ||||
| -rw-r--r-- | src/GF/Printing/PrintSimplifiedTerm.hs | 127 |
2 files changed, 0 insertions, 210 deletions
diff --git a/src/GF/Printing/PrintParser.hs b/src/GF/Printing/PrintParser.hs deleted file mode 100644 index d9041ecaa..000000000 --- a/src/GF/Printing/PrintParser.hs +++ /dev/null @@ -1,83 +0,0 @@ ----------------------------------------------------------------------- --- | --- Module : PrintParser --- Maintainer : PL --- Stability : (stable) --- Portability : (portable) --- --- > CVS $Date: 2005/04/21 16:23:16 $ --- > CVS $Author: bringert $ --- > CVS $Revision: 1.3 $ --- --- Pretty-printing of parser objects ------------------------------------------------------------------------------ - -module GF.Printing.PrintParser (Print(..), - prtBefore, prtAfter, prtSep, - prtBeforeAfter, - prIO - ) where - --- haskell modules: -import Data.List (intersperse) --- gf modules: -import GF.Data.Operations (Err(..)) -import GF.Infra.Ident (Ident(..)) -import qualified GF.Canon.PrintGFC as P - ------------------------------------------------------------- - -prtBefore :: Print a => String -> [a] -> String -prtBefore before = prtBeforeAfter before "" - -prtAfter :: Print a => String -> [a] -> String -prtAfter after = prtBeforeAfter "" after - -prtSep :: Print a => String -> [a] -> String -prtSep sep = concat . intersperse sep . map prt - -prtBeforeAfter :: Print a => String -> String -> [a] -> String -prtBeforeAfter before after as = concat [ before ++ prt a ++ after | a <- as ] - -prIO :: Print a => a -> IO () -prIO = putStr . prt - -class Print a where - prt :: a -> String - prtList :: [a] -> String - prtList as = "[" ++ prtSep "," as ++ "]" - -instance Print a => Print [a] where - prt = prtList - -instance (Print a, Print b) => Print (a, b) where - prt (a, b) = "(" ++ prt a ++ "," ++ prt b ++ ")" - -instance (Print a, Print b, Print c) => Print (a, b, c) where - prt (a, b, c) = "(" ++ prt a ++ "," ++ prt b ++ "," ++ prt c ++ ")" - -instance (Print a, Print b, Print c, Print d) => Print (a, b, c, d) where - prt (a, b, c, d) = "(" ++ prt a ++ "," ++ prt b ++ "," ++ prt c ++ "," ++ prt d ++ ")" - -instance Print Char where - prt = return - prtList = id - -instance Print Int where - prt = show - -instance Print Integer where - prt = show - -instance Print a => Print (Maybe a) where - prt (Just a) = "!" ++ prt a - prt Nothing = "Nothing" - -instance Print a => Print (Err a) where - prt (Ok a) = prt a - prt (Bad str) = str - -instance Print Ident where - prt ident = str - where str = P.printTree ident - diff --git a/src/GF/Printing/PrintSimplifiedTerm.hs b/src/GF/Printing/PrintSimplifiedTerm.hs deleted file mode 100644 index ccd107558..000000000 --- a/src/GF/Printing/PrintSimplifiedTerm.hs +++ /dev/null @@ -1,127 +0,0 @@ ----------------------------------------------------------------------- --- | --- Module : PrintSimplifiedTerm --- Maintainer : PL --- Stability : (stable) --- Portability : (portable) --- --- > CVS $Date: 2005/06/17 14:15:19 $ --- > CVS $Author: bringert $ --- > CVS $Revision: 1.4 $ --- --- Instances for printing terms in a simplified format ------------------------------------------------------------------------------ - - -module GF.Printing.PrintSimplifiedTerm () where - -import GF.Canon.AbsGFC -import GF.CF.CF -import GF.CF.CFIdent -import GF.Printing.PrintParser -import qualified GF.Canon.PrintGFC as P - -instance Print Term where - prt (Arg arg) = prt arg - prt (con `Par` []) = prt con - prt (con `Par` terms) = prt con ++ "(" ++ prtSep ", " terms ++ ")" - prt (LI ident) = prt ident - prt (R record) = "{" ++ prtSep ";" record ++ "}" - prt (term `P` lbl) = prt term ++ "." ++ prt lbl - prt (T _ table) = "table{" ++ prtSep ";" table ++ "}" - prt (term `S` sel) = prt term ++ "!" ++ prt sel - prt (FV terms) = "variants{" ++ prtSep "|" terms ++ "}" - prt (term `C` term') = prt term ++ " " ++ prt term' - prt (K tokn) = show (prt tokn) - prt (E) = show "" - -instance Print Patt where - prt (con `PC` []) = prt con - prt (con `PC` pats) = prt con ++ "(" ++ prtSep "," pats ++ ")" - prt (PV ident) = prt ident - prt (PW) = "_" - prt (PR record) = "{" ++ prtSep ";" record ++ "}" - -instance Print Label where - prt (L ident) = prt ident - prt (LV nr) = "$" ++ show nr - -instance Print Tokn where - prt (KS str) = str - prt tokn@(KP _ _) = show tokn - -instance Print ArgVar where - prt (A cat argNr) = prt cat ++ "#" ++ show argNr - -instance Print CIdent where - prt (CIQ _ ident) = prt ident - -instance Print Case where - prt (pats `Cas` term) = prtSep "|" pats ++ "=>" ++ prt term - -instance Print Assign where - prt (lbl `Ass` term) = prt lbl ++ "=" ++ prt term - -instance Print PattAssign where - prt (lbl `PAss` pat) = prt lbl ++ "=" ++ prt pat - -instance Print Atom where - prt (AC c) = prt c - prt (AD c) = "<" ++ prt c ++ ">" - prt (AV i) = "$" ++ prt i - prt (AM n) = "?" ++ show n - prt (AS s) = show s - prt (AI n) = show n - prt (AT s) = show s - -instance Print CType where - prt (RecType rtype) = "{" ++ prtSep ";" rtype ++ "}" - prt (Table ptype vtype) = "(" ++ prt ptype ++ "=>" ++ prt vtype ++ ")" - prt (Cn cn) = prt cn - prt (TStr) = "Str" - -instance Print Labelling where - prt (lbl `Lbg` ctype) = prt lbl ++ ":" ++ prt ctype - -instance Print CFItem where - prt (CFTerm regexp) = prt regexp - prt (CFNonterm cat) = prt cat - -instance Print RegExp where - prt (RegAlts words) = "("++prtSep "|" words ++ ")" - prt (RegSpec tok) = prt tok - -instance Print CFTok where - prt (TS str) = str - prt tok = show tok - -instance Print CFCat where - prt (CFCat (cid,lbl)) = prt cid ++ "-" ++ prt lbl - -instance Print CFFun where - prt (CFFun fun) = prt (fst fun) - -instance Print Exp where - prt = P.printTree - - -sizeCT :: CType -> Int -sizeCT (RecType rt) = 1 + sum [ sizeCT t | _ `Lbg` t <- rt ] -sizeCT (Table pt vt) = 1 + sizeCT pt + sizeCT vt -sizeCT (Cn cn) = 1 -sizeCT (TStr) = 1 - -sizeT :: Term -> Int -sizeT (_ `Par` ts) = 2 + sum (map sizeT ts) -sizeT (R rec) = 1 + sum [ sizeT t | _ `Ass` t <- rec ] -sizeT (t `P` _) = 1 + sizeT t -sizeT (T _ tbl) = 1 + sum [ sum (map sizeP ps) + sizeT t | ps `Cas` t <- tbl ] -sizeT (t `S` s) = 1 + sizeT t + sizeT s -sizeT (t `C` t') = 1 + sizeT t + sizeT t' -sizeT (FV ts) = 1 + sum (map sizeT ts) -sizeT _ = 1 - -sizeP :: Patt -> Int -sizeP (con `PC` pats) = 2 + sum (map sizeP pats) -sizeP (PR record) = 1 + sum [ sizeP p | _ `PAss` p <- record ] -sizeP _ = 1 |