{-
    BNF Converter: Pretty-printer generator
    Copyright (C) 2005  Author:  Kristofer Johannisson

-}

-- based on BNFC Haskell backend

{-# LANGUAGE OverloadedStrings #-}

module BNFC.Backend.OCaml.CFtoOCamlPrinter (cf2Printer, prtFun) where

import Prelude hiding ((<>))

import Data.Char(toLower)
import Data.List (intersperse, sortBy)
import Data.Maybe (fromJust)

import BNFC.CF
import BNFC.Utils
import BNFC.Backend.OCaml.OCamlUtil
import BNFC.PrettyPrint
import BNFC.Backend.Haskell.CFtoPrinter (compareRules)


-- derive pretty-printer from a BNF grammar. AR 15/2/2002
cf2Printer :: String -> ModuleName -> CF -> String
cf2Printer :: [Char] -> [Char] -> CF -> [Char]
cf2Printer [Char]
_name [Char]
absMod CF
cf = [[Char]] -> [Char]
unlines [
  [Char]
prologue,
  CF -> [Char]
charRule CF
cf,
  CF -> [Char]
integerRule CF
cf,
  CF -> [Char]
doubleRule CF
cf,
  CF -> [Char]
stringRule CF
cf,
  if CF -> Bool
forall f. CFG f -> Bool
hasIdent CF
cf then [Char] -> CF -> [Char]
identRule [Char]
absMod CF
cf else [Char]
"",
  [[Char]] -> [Char]
unlines [[Char] -> CF -> [Char] -> [Char]
ownPrintRule [Char]
absMod CF
cf [Char]
own | ([Char]
own,Reg
_) <- CF -> [([Char], Reg)]
forall f. CFG f -> [([Char], Reg)]
tokenPragmas CF
cf],
  [Char] -> CF -> [Char]
rules [Char]
absMod CF
cf
  ]


prologue :: String
prologue :: [Char]
prologue = [[Char]] -> [Char]
unlines [
  [Char]
"(* pretty-printer generated by the BNF converter *)",
  [Char]
"",
  [Char]
"open Printf",
  [Char]
"",
  [Char]
"(* We use string buffers for efficient string concatenation.",
  [Char]
"   A document takes a buffer and an indentation, has side effects on the buffer",
  [Char]
"   and returns a new indentation. The indentation argument indicates the level",
  [Char]
"   of indentation to be used if a new line has to be started (because of what is",
  [Char]
"   already in the buffer) *)",
  [Char]
"type doc = Buffer.t -> int -> int",
  [Char]
"",
  [Char]
"let rec printTree (printer : int -> 'a -> doc) (tree : 'a) : string = ",
  [Char]
"    let buffer_init_size = 64 (* you may want to change this *)",
  [Char]
"    in let buffer = Buffer.create buffer_init_size",
  [Char]
"    in ",
  [Char]
"        let _ = printer 0 tree buffer 0 in (* discard return value *)",
  [Char]
"        Buffer.contents buffer",
  [Char]
"",
  [Char]
"let indent_width = 4",
  [Char]
"",
  [Char]
"let indent (i: int) : string = \"\\n\" ^ String.make i ' '",
  [Char]
"",
  [Char]
"(* To avoid dependency on package extlib, which has",
  [Char]
"   Extlib.ExtChar.Char.is_whitespace, we employ the following awkward",
  [Char]
"   way to check a character for whitespace.",
  [Char]
"   Note: String.trim exists in the core libraries since Ocaml 4.00. *)",
  [Char]
"let isWhiteSpace (c: char) : bool = String.trim (String.make 1 c) = \"\"",
  [Char]
"",
  [Char]
"(* this render function is written for C-style languages, you may want to change it *)",
  [Char]
"let render (s : string) : doc = fun buf i -> ",
  [Char]
"    (* invariant: last char of the buffer is never whitespace *)",
  [Char]
"    let n = Buffer.length buf in",
  [Char]
"    let last = if n = 0 then None else Some (Buffer.nth buf (n-1)) in",
  [Char]
"    let whitespace = match last with",
  [Char]
"        None -> \"\" ",
  [Char]
"      | Some '{' -> indent i",
  [Char]
"      | Some '}' -> (match s with",
  [Char]
"            \";\" -> \"\"",
  [Char]
"          | _ -> indent i)",
  [Char]
"      | Some ';' -> indent i",
  [Char]
"      | (Some '[') |  (Some '(') -> \"\"",
  [Char]
"      | Some c -> if isWhiteSpace c then \"\" else (match s with",
  [Char]
"            \",\" | \")\" | \"]\" -> \"\"",
  [Char]
"           | _ -> if String.trim s = \"\" then \"\" else \" \") in",
  [Char]
"    let newindent = match s with",
  [Char]
"        \"{\" -> i + indent_width",
  [Char]
"      | \"}\" -> i - indent_width",
  [Char]
"      | _ -> i in",
  [Char]
"    Buffer.add_string buf whitespace;",
  [Char]
"    Buffer.add_string buf s;",
  [Char]
"    newindent",
  [Char]
"",
  [Char]
"let emptyDoc : doc = fun buf i -> i",
  [Char]
"",
  [Char]
"let concatD (ds : doc list) : doc = fun buf i -> ",
  [Char]
"    List.fold_left (fun accIndent elemDoc -> elemDoc buf accIndent) (emptyDoc buf i) ds",
  [Char]
"",
  [Char]
"let parenth (d:doc) : doc = concatD [render \"(\"; d; render \")\"]",
  [Char]
"",
  [Char]
"let prPrec (i:int) (j:int) (d:doc) : doc = if j<i then parenth d else d",
  [Char]
""
  ]

charRule :: CF -> [Char]
charRule CF
cf = [[Char]] -> [Char]
unlines [
    [Char]
"let rec prtChar (_:int) (c:char) : doc = render (\"'\" ^ Char.escaped c ^ \"'\")",
    CF -> Cat -> [Char]
ifList CF
cf ([Char] -> Cat
TokenCat [Char]
catChar),
    [Char]
""
    ]

integerRule :: CF -> [Char]
integerRule CF
cf = [[Char]] -> [Char]
unlines [
    [Char]
"let rec prtInt (_:int) (i:int) : doc = render (string_of_int i)",
    CF -> Cat -> [Char]
ifList CF
cf ([Char] -> Cat
TokenCat [Char]
catInteger),
    [Char]
""
    ]

doubleRule :: CF -> [Char]
doubleRule CF
cf = [[Char]] -> [Char]
unlines [
    [Char]
"let rec prtFloat (_:int) (f:float) : doc = render (sprintf \"%.15g\" f)",
    CF -> Cat -> [Char]
ifList CF
cf ([Char] -> Cat
TokenCat [Char]
catDouble),
    [Char]
""
    ]

stringRule :: CF -> [Char]
stringRule CF
cf = [[Char]] -> [Char]
unlines [
    [Char]
"let rec prtString (_:int) (s:string) : doc = render (\"\\\"\" ^ String.escaped s ^ \"\\\"\")",
    CF -> Cat -> [Char]
ifList CF
cf ([Char] -> Cat
TokenCat [Char]
catString),
    [Char]
""
    ]

identRule :: [Char] -> CF -> [Char]
identRule [Char]
absMod CF
cf = [Char] -> CF -> [Char] -> [Char]
ownPrintRule [Char]
absMod CF
cf [Char]
catIdent

ownPrintRule :: ModuleName -> CF -> TokenCat -> String
ownPrintRule :: [Char] -> CF -> [Char] -> [Char]
ownPrintRule [Char]
absMod CF
cf [Char]
own = [[Char]] -> [Char]
unlines ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ [
  [Char]
"let rec" [Char] -> [Char] -> [Char]
+++ Cat -> [Char]
prtFun ([Char] -> Cat
TokenCat [Char]
own) [Char] -> [Char] -> [Char]
+++ [Char]
"_ (" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
absMod [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"." [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
own [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
posn [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
") : doc = render i",
  CF -> Cat -> [Char]
ifList CF
cf ([Char] -> Cat
TokenCat [Char]
own)
  ]
 where
   posn :: [Char]
posn = if CF -> [Char] -> Bool
forall f. CFG f -> [Char] -> Bool
isPositionCat CF
cf [Char]
own then [Char]
" (_,i)" else [Char]
" i"

-- copy and paste from CFtoTemplate

rules :: ModuleName -> CF -> String
rules :: [Char] -> CF -> [Char]
rules [Char]
absMod CF
cf = [[Char]] -> [Char]
unlines ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [[Char]]
mutualDefs ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$
  ((Cat, [([Char], [Cat])]) -> [Char])
-> [(Cat, [([Char], [Cat])])] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (\(Cat
s,[([Char], [Cat])]
xs) -> [Char]
-> Cat
-> [(([Char], [[Char]]), (Cat, [Either Cat [Char]]))]
-> [Char]
case_fun [Char]
absMod Cat
s ((([Char], [Cat])
 -> (([Char], [[Char]]), (Cat, [Either Cat [Char]])))
-> [([Char], [Cat])]
-> [(([Char], [[Char]]), (Cat, [Either Cat [Char]]))]
forall a b. (a -> b) -> [a] -> [b]
map ([Char], [Cat]) -> (([Char], [[Char]]), (Cat, [Either Cat [Char]]))
toArgs [([Char], [Cat])]
xs) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CF -> Cat -> [Char]
ifList CF
cf Cat
s) ([(Cat, [([Char], [Cat])])] -> [[Char]])
-> [(Cat, [([Char], [Cat])])] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ CF -> [(Cat, [([Char], [Cat])])]
cf2data CF
cf
 where
   reserved :: [[Char]]
reserved = [Char]
"i"[Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:[Char]
"e"[Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:[[Char]]
reservedOCaml
   toArgs :: ([Char], [Cat]) -> (([Char], [[Char]]), (Cat, [Either Cat [Char]]))
toArgs ([Char]
cons,[Cat]
args) = (([Char]
cons, [[Char]] -> NameStyle -> [[Char]] -> [[Char]]
mkNames [[Char]]
reserved NameStyle
LowerCase ((Cat -> [Char]) -> [Cat] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Cat -> [Char]
var [Cat]
args)), [Char] -> (Cat, [Either Cat [Char]])
ruleOf [Char]
cons)
   var :: Cat -> [Char]
var (ListCat Cat
c)  = Cat -> [Char]
var Cat
c [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"s"
   var (Cat [Char]
"Ident")   = [Char]
"id"
   var (Cat [Char]
"Integer") = [Char]
"n"
   var (Cat [Char]
"String")  = [Char]
"str"
   var (Cat [Char]
"Char")    = [Char]
"c"
   var (Cat [Char]
"Double")  = [Char]
"d"
   var Cat
xs        = (Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (Cat -> [Char]
forall a. Show a => a -> [Char]
show Cat
xs)
   ruleOf :: [Char] -> (Cat, [Either Cat [Char]])
ruleOf [Char]
s = Maybe (Cat, [Either Cat [Char]]) -> (Cat, [Either Cat [Char]])
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Cat, [Either Cat [Char]]) -> (Cat, [Either Cat [Char]]))
-> Maybe (Cat, [Either Cat [Char]]) -> (Cat, [Either Cat [Char]])
forall a b. (a -> b) -> a -> b
$ RFun -> [Rul RFun] -> Maybe (Cat, [Either Cat [Char]])
forall f. Eq f => f -> [Rul f] -> Maybe (Cat, [Either Cat [Char]])
lookupRule ([Char] -> RFun
forall a. a -> WithPosition a
noPosition [Char]
s) (CF -> [Rul RFun]
forall function. CFG function -> [Rul function]
cfgRules CF
cf)

--- case_fun :: Cat -> [(Constructor,Rule)] -> String
case_fun :: [Char]
-> Cat
-> [(([Char], [[Char]]), (Cat, [Either Cat [Char]]))]
-> [Char]
case_fun [Char]
absMod Cat
cat [(([Char], [[Char]]), (Cat, [Either Cat [Char]]))]
xs = [[Char]] -> [Char]
unlines [
--  "instance Print" +++ cat +++ "where",
  Cat -> [Char]
prtFun Cat
cat [Char] -> [Char] -> [Char]
+++[Char]
"(i:int)" [Char] -> [Char] -> [Char]
+++ [Char]
"(e : " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> Cat -> [Char]
fixTypeQual [Char]
absMod Cat
cat [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
") : doc = match e with",
  [[Char]] -> [Char]
unlines ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [[Char]]
insertBar ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ ((([Char], [[Char]]), (Cat, [Either Cat [Char]])) -> [Char])
-> [(([Char], [[Char]]), (Cat, [Either Cat [Char]]))] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (\ (([Char]
c,[[Char]]
xx),(Cat, [Either Cat [Char]])
r) ->
    [Char]
"   " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
absMod [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"." [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
c [Char] -> [Char] -> [Char]
+++ [[Char]] -> [Char]
mkTuple [[Char]]
xx [Char] -> [Char] -> [Char]
+++ [Char]
"->" [Char] -> [Char] -> [Char]
+++
    [Char]
"prPrec i" [Char] -> [Char] -> [Char]
+++ Integer -> [Char]
forall a. Show a => a -> [Char]
show (Cat -> Integer
precCat ((Cat, [Either Cat [Char]]) -> Cat
forall a b. (a, b) -> a
fst (Cat, [Either Cat [Char]])
r)) [Char] -> [Char] -> [Char]
+++ [[Char]] -> [Either Cat [Char]] -> [Char]
mkRhs [[Char]]
xx ((Cat, [Either Cat [Char]]) -> [Either Cat [Char]]
forall a b. (a, b) -> b
snd (Cat, [Either Cat [Char]])
r)) [(([Char], [[Char]]), (Cat, [Either Cat [Char]]))]
xs
  ]

-- ifList cf cat = mkListRule $ nil cat ++ one cat ++ cons cat where
--   nil cat  = ["    []    -> " ++ mkRhs [] its |
--                             Rule f c its <- rulesOfCF cf, isNilFun f , normCatOfList c == cat]
--   one cat  = ["  | [x]   -> " ++ mkRhs ["x"] its |
--                             Rule f c its <- rulesOfCF cf, isOneFun f , normCatOfList c == cat]
--   cons cat = ["  | x::xs -> " ++ mkRhs ["x","xs"] its |
--                             Rule f c its <- rulesOfCF cf, isConsFun f , normCatOfList c == cat]
--   mkListRule [] = ""
--   mkListRule rs = unlines $ ("and prt" ++ fixTypeUpper cat ++ "ListBNFC" +++ "_ es : doc = match es with"):rs

ifList :: CF -> Cat -> String
ifList :: CF -> Cat -> [Char]
ifList CF
cf Cat
cat = Doc -> [Char]
render (Doc -> [Char]) -> Doc -> [Char]
forall a b. (a -> b) -> a -> b
$
  case [Doc]
cases of
    []         -> Doc
empty
    Doc
first:[Doc]
rest -> [Doc] -> Doc
vcat
        [ Doc
"and prt" Doc -> Doc -> Doc
<> [Char] -> Doc
text (Cat -> [Char]
fixTypeUpper Cat
cat)  Doc -> Doc -> Doc
<> Doc
"ListBNFC i es : doc = match (i, es) with"
        , Int -> Doc -> Doc
nest Int
4 Doc
first
        , Int -> Doc -> Doc
nest Int
2 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat ((Doc -> Doc) -> [Doc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Doc
"|" Doc -> Doc -> Doc
<+>) [Doc]
rest)
        ]
  where
    rules :: [Rul RFun]
rules = (Rul RFun -> Rul RFun -> Ordering) -> [Rul RFun] -> [Rul RFun]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy Rul RFun -> Rul RFun -> Ordering
forall f. IsFun f => Rul f -> Rul f -> Ordering
compareRules ([Rul RFun] -> [Rul RFun]) -> [Rul RFun] -> [Rul RFun]
forall a b. (a -> b) -> a -> b
$ CF -> Cat -> [Rul RFun]
rulesForNormalizedCat CF
cf (Cat -> Cat
ListCat Cat
cat)
    cases :: [Doc]
cases = [ Doc
d | Rul RFun
r <- [Rul RFun]
rules, let d :: Doc
d = Rul RFun -> Doc
mkPrtListCase Rul RFun
r, Bool -> Bool
not (Doc -> Bool
isEmpty Doc
d) ]


-- | Pattern match on the list constructor and the coercion level
--
-- >>> mkPrtListCase (npRule "[]" (ListCat (Cat "Foo")) [] Parsable)
-- (_,[]) -> (concatD [])
--
-- >>> mkPrtListCase (npRule "(:[])" (ListCat (Cat "Foo")) [Left (Cat "Foo")] Parsable)
-- (_,[x]) -> (concatD [prtFoo 0 x])
--
-- >>> mkPrtListCase (npRule "(:)" (ListCat (Cat "Foo")) [Left (Cat "Foo"), Left (ListCat (Cat "Foo"))] Parsable)
-- (_,x::xs) -> (concatD [prtFoo 0 x ; prtFooListBNFC 0 xs])
--
-- >>> mkPrtListCase (npRule "[]" (ListCat (CoercCat "Foo" 2)) [] Parsable)
-- (2,[]) -> (concatD [])
--
-- >>> mkPrtListCase (npRule "(:[])" (ListCat (CoercCat "Foo" 2)) [Left (CoercCat "Foo" 2)] Parsable)
-- (2,[x]) -> (concatD [prtFoo 2 x])
--
-- >>> mkPrtListCase (npRule "(:)" (ListCat (CoercCat "Foo" 2)) [Left (CoercCat "Foo" 2), Left (ListCat (CoercCat "Foo" 2))] Parsable)
-- (2,x::xs) -> (concatD [prtFoo 2 x ; prtFooListBNFC 2 xs])
--
mkPrtListCase :: Rule -> Doc
mkPrtListCase :: Rul RFun -> Doc
mkPrtListCase (Rule RFun
f (WithPosition Position
_ (ListCat Cat
c)) [Either Cat [Char]]
rhs InternalRule
_)
  | RFun -> Bool
forall a. IsFun a => a -> Bool
isNilFun RFun
f  = Doc -> Doc
parens (Doc
precPattern Doc -> Doc -> Doc
<> Doc
"," Doc -> Doc -> Doc
<> Doc
"[]") Doc -> Doc -> Doc
<+> Doc
"->" Doc -> Doc -> Doc
<+> Doc
body
  | RFun -> Bool
forall a. IsFun a => a -> Bool
isOneFun RFun
f  = Doc -> Doc
parens (Doc
precPattern Doc -> Doc -> Doc
<> Doc
"," Doc -> Doc -> Doc
<> Doc
"[x]") Doc -> Doc -> Doc
<+> Doc
"->" Doc -> Doc -> Doc
<+> Doc
body
  | RFun -> Bool
forall a. IsFun a => a -> Bool
isConsFun RFun
f = Doc -> Doc
parens (Doc
precPattern Doc -> Doc -> Doc
<> Doc
"," Doc -> Doc -> Doc
<>Doc
"x::xs") Doc -> Doc -> Doc
<+> Doc
"->" Doc -> Doc -> Doc
<+> Doc
body
  | Bool
otherwise = Doc
empty -- (++) constructor
  where
    precPattern :: Doc
precPattern = case Cat -> Integer
precCat Cat
c of Integer
0 -> Doc
"_" ; Integer
p -> Integer -> Doc
integer Integer
p
    body :: Doc
body = [Char] -> Doc
text ([Char] -> Doc) -> [Char] -> Doc
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Either Cat [Char]] -> [Char]
mkRhs [[Char]
"x", [Char]
"xs"] [Either Cat [Char]]
rhs
mkPrtListCase Rul RFun
_ = [Char] -> Doc
forall a. HasCallStack => [Char] -> a
error [Char]
"mkPrtListCase undefined for non-list categories"

mkRhs :: [[Char]] -> [Either Cat [Char]] -> [Char]
mkRhs [[Char]]
args [Either Cat [Char]]
its =
  [Char]
"(concatD [" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
unwords ([Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
intersperse [Char]
";" ([[Char]] -> [Either Cat [Char]] -> [[Char]]
mk [[Char]]
args [Either Cat [Char]]
its)) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"])"
 where
  mk :: [[Char]] -> [Either Cat [Char]] -> [[Char]]
mk ([Char]
arg:[[Char]]
args) (Left Cat
c : [Either Cat [Char]]
items)  = (Cat -> [Char]
prt Cat
c [Char] -> [Char] -> [Char]
+++ [Char]
arg)        [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [[Char]] -> [Either Cat [Char]] -> [[Char]]
mk [[Char]]
args [Either Cat [Char]]
items
  mk [[Char]]
args       (Right [Char]
s : [Either Cat [Char]]
items) = ([Char]
"render " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
mkEsc [Char]
s) [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [[Char]] -> [Either Cat [Char]] -> [[Char]]
mk [[Char]]
args [Either Cat [Char]]
items
  mk [[Char]]
_ [Either Cat [Char]]
_ = []
  prt :: Cat -> [Char]
prt Cat
c = Cat -> [Char]
prtFun Cat
c [Char] -> [Char] -> [Char]
+++ Integer -> [Char]
forall a. Show a => a -> [Char]
show (Cat -> Integer
precCat Cat
c)

prtFun :: Cat -> String
prtFun :: Cat -> [Char]
prtFun (ListCat Cat
c) = Cat -> [Char]
prtFun Cat
c [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"ListBNFC"
prtFun Cat
c = [Char]
"prt" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Cat -> [Char]
fixTypeUpper (Cat -> Cat
normCat Cat
c)