mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-14 23:39:32 -06:00
128 lines
3.7 KiB
Haskell
128 lines
3.7 KiB
Haskell
----------------------------------------------------------------------
|
|
-- |
|
|
-- 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
|