@@ -17,7 +17,7 @@ data SC = Case Name [CaseAlt] -- invariant: lowest tags first
1717 | ProjCase Term [CaseAlt] -- special case for projections
1818 | STerm Term
1919 | UnmatchedCase String -- error message
20− deriving (Show, Eq, Ord)
20+ deriving (Eq, Ord)
2121{-!
2222deriving instance Binary SC
2323!-}
@@ -30,6 +30,27 @@ data CaseAlt = ConCase Name Int [Name] SC
3030deriving instance Binary CaseAlt
3131!-}
3232
33+instance Show SC where
34+ show sc = show' 1 sc
35+ where
36+ show' i (Case n alts) = "case " ++ show n ++ " of\n" ++ indent i ++
37+ showSep ("\n" ++ indent i) (map (showA i) alts)
38+ show' i (ProjCase tm alts) = "case " ++ show tm ++ " of " ++
39+ showSep ("\n" ++ indent i) (map (showA i) alts)
40+ show' i (STerm tm) = show tm
41+ show' i (UnmatchedCase str) = "error " ++ show str
42+
43+ indent i = concat $ take i (repeat " ")
44+
45+ showA i (ConCase n t args sc)
46+ = show n ++ "(" ++ showSep (", ") (map show args) ++ ") => "
47+ ++ show' (i+1) sc
48+ showA i (ConstCase t sc)
49+ = show t ++ " => " ++ show' (i+1) sc
50+ showA i (DefaultCase sc)
51+ = "_ => " ++ show' (i+1) sc
52+
53+
3354type CaseTree = SC
3455type Clause = ([Pat], (Term, Term))
3556type CS = ([Term], Int)