--  $Header: /data/cvs-rep/uust/lib/pretty/UU/Pretty/Basic.hs,v 1.2 2003/02/26 11:18:27 uust Exp $
--  $Name:  $ (version name)

module UU.Pretty.Basic ( PP (..), PP_Doc, PP_Exp
                   -- Single layout combinators
                 , empty, text, indent, (>|<), (>-<), fill , fillblock
                   -- Multiple layout combinators
                 , (>//<), join, par, (>>$<)
                 , eindent, (>>|<<), (>>-<<), (>>//<<), ejoin, (>>$<<)
                   -- Displaying the result
                 , render, renderAll, disp
                   -- Additional generated combinators
                 , c2e, element_h1, eelement_h1, vcenter, invisible
                   -- Additional derived combinators
                 , fpar, spar
                 ) where

{- Pretty-printers and pretty-printing combinators. Version 2.0d
   Authors: S. Doaitse Swierstra and Pablo R. Azero
   Date: July, 1999
 -}

-- ...................................................................
-- ..... Interface definition ........................................

infixr 3 >|< , >>|<<
infixr 2 >-< , >>-<<
infixr 1 >//<, >>//<<
infixr 0 >>$<, >>$<<

-- -------------------------------------------------------------------
-- PP class ----------------------------------------------------------

newtype PP_Doc = PPDoc T_PPS

class Show a => PP a where
  pp     :: a   -> PP_Doc
  pp       = String -> PP_Doc
text (String -> PP_Doc) -> (a -> String) -> a -> PP_Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

  ppList :: [a] -> PP_Doc
  ppList [a]
as = if [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
as
              then PP_Doc
empty
              else (PP_Doc -> PP_Doc -> PP_Doc) -> PP_Doc -> [PP_Doc] -> PP_Doc
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr PP_Doc -> PP_Doc -> PP_Doc
forall a b. (PP a, PP b) => a -> b -> PP_Doc
(>|<) PP_Doc
empty ([PP_Doc] -> PP_Doc) -> ([a] -> [PP_Doc]) -> [a] -> PP_Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> PP_Doc) -> [a] -> [PP_Doc]
forall a b. (a -> b) -> [a] -> [b]
map a -> PP_Doc
forall a. PP a => a -> PP_Doc
pp ([a] -> PP_Doc) -> [a] -> PP_Doc
forall a b. (a -> b) -> a -> b
$ [a]
as

instance PP PP_Doc where
  pp :: PP_Doc -> PP_Doc
pp     = PP_Doc -> PP_Doc
forall a. a -> a
id

instance PP Char where
  pp :: Char -> PP_Doc
pp Char
c   = String -> PP_Doc
text [Char
c]
  ppList :: String -> PP_Doc
ppList = String -> PP_Doc
text

instance PP a => PP [a] where
  pp :: [a] -> PP_Doc
pp = [a] -> PP_Doc
forall a. PP a => [a] -> PP_Doc
ppList

instance Show PP_Doc where
  show :: PP_Doc -> String
show PP_Doc
p = PP_Doc -> Int -> ShowS
disp PP_Doc
p Int
200 String
""

-- -------------------------------------------------------------------
-- Single layout combinators -----------------------------------------

empty :: PP_Doc
empty :: PP_Doc
empty = T_PPS -> PP_Doc
PPDoc T_PPS
sem_PPS_Empty

text :: String -> PP_Doc
text :: String -> PP_Doc
text  = T_PPS -> PP_Doc
PPDoc (T_PPS -> PP_Doc) -> (String -> T_PPS) -> String -> PP_Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> T_PPS
sem_PPS_Text

indent :: PP a => Int -> a -> PP_Doc
indent :: forall a. PP a => Int -> a -> PP_Doc
indent Int
i a
fs = T_PPS -> PP_Doc
PPDoc (Int -> T_PPS -> T_PPS
sem_PPS_Indent Int
i T_PPS
nfs)
   where (PPDoc T_PPS
nfs) = a -> PP_Doc
forall a. PP a => a -> PP_Doc
pp a
fs

(>|<) :: (PP a, PP b) => a -> b -> PP_Doc
a
l >|< :: forall a b. (PP a, PP b) => a -> b -> PP_Doc
>|< b
r  = T_PPS -> PP_Doc
PPDoc (T_PPS -> T_PPS -> T_PPS
sem_PPS_Beside T_PPS
ppl T_PPS
ppr)
  where (PPDoc T_PPS
ppl) = a -> PP_Doc
forall a. PP a => a -> PP_Doc
pp a
l
        (PPDoc T_PPS
ppr) = b -> PP_Doc
forall a. PP a => a -> PP_Doc
pp b
r

(>-<) :: (PP a, PP b) => a -> b -> PP_Doc
a
u >-< :: forall a b. (PP a, PP b) => a -> b -> PP_Doc
>-< b
l  = T_PPS -> PP_Doc
PPDoc (T_PPS -> T_PPS -> T_PPS
sem_PPS_Above T_PPS
ppu T_PPS
ppl)
  where (PPDoc T_PPS
ppu) = a -> PP_Doc
forall a. PP a => a -> PP_Doc
pp a
u
        (PPDoc T_PPS
ppl) = b -> PP_Doc
forall a. PP a => a -> PP_Doc
pp b
l

fill :: PP a => [a] -> PP_Doc
fill :: forall a. PP a => [a] -> PP_Doc
fill = T_PPS -> PP_Doc
PPDoc (T_PPS -> PP_Doc) -> ([a] -> T_PPS) -> [a] -> PP_Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T_FillList -> T_PPS
sem_PPS_Fill (T_FillList -> T_PPS) -> ([a] -> T_FillList) -> [a] -> T_PPS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> T_FillList -> T_FillList) -> T_FillList -> [a] -> T_FillList
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> T_FillList -> T_FillList
forall {a}. PP a => a -> T_FillList -> T_FillList
fill_alg T_FillList
sem_FillList_Nil
  where fill_alg :: a -> T_FillList -> T_FillList
fill_alg a
f
          = T_PPS -> T_FillList -> T_FillList
sem_FillList_Cons (case (a -> PP_Doc
forall a. PP a => a -> PP_Doc
pp a
f) of (PPDoc T_PPS
ppp) -> T_PPS
ppp)

fillblock :: PP a => Int -> [a] -> PP_Doc
fillblock :: forall a. PP a => Int -> [a] -> PP_Doc
fillblock Int
i = T_PPS -> PP_Doc
PPDoc (T_PPS -> PP_Doc) -> ([a] -> T_PPS) -> [a] -> PP_Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> T_FillList -> T_PPS
sem_PPS_FillBlock Int
i (T_FillList -> T_PPS) -> ([a] -> T_FillList) -> [a] -> T_PPS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> T_FillList -> T_FillList) -> T_FillList -> [a] -> T_FillList
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> T_FillList -> T_FillList
forall {a}. PP a => a -> T_FillList -> T_FillList
fill_alg T_FillList
sem_FillList_Nil
  where fill_alg :: a -> T_FillList -> T_FillList
fill_alg a
f
          = T_PPS -> T_FillList -> T_FillList
sem_FillList_Cons (case (a -> PP_Doc
forall a. PP a => a -> PP_Doc
pp a
f) of (PPDoc T_PPS
ppp) -> T_PPS
ppp)

-- -------------------------------------------------------------------
-- Multiple layout combinators ---------------------------------------

(>//<) :: (PP a, PP b) => a -> b -> PP_Doc
a
a  >//< :: forall a b. (PP a, PP b) => a -> b -> PP_Doc
>//<  b
b  = T_PPS -> PP_Doc
PPDoc (T_PPS -> T_PPS -> T_PPS
sem_PPS_Dup  T_PPS
ppa T_PPS
ppb)
  where (PPDoc T_PPS
ppa) = a -> PP_Doc
forall a. PP a => a -> PP_Doc
pp a
a
        (PPDoc T_PPS
ppb) = b -> PP_Doc
forall a. PP a => a -> PP_Doc
pp b
b

join :: PP_Doc -> PP_Doc
join :: PP_Doc -> PP_Doc
join (PPDoc T_PPS
d) = T_PPS -> PP_Doc
PPDoc (T_PPS -> PP_Doc) -> (T_PPS -> T_PPS) -> T_PPS -> PP_Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T_PPS -> T_PPS
sem_PPS_Join (T_PPS -> PP_Doc) -> T_PPS -> PP_Doc
forall a b. (a -> b) -> a -> b
$ T_PPS
d

newtype PP_Exp = PPExp T_PPC

eindent :: Int -> PP_Exp -> PP_Exp
eindent :: Int -> PP_Exp -> PP_Exp
eindent Int
i (PPExp T_PPC
ppc) = T_PPC -> PP_Exp
PPExp (Int -> T_PPC -> T_PPC
sem_PPC_Indent Int
i T_PPC
ppc)

(>>|<<), (>>-<<), (>>//<<) :: PP_Exp -> PP_Exp -> PP_Exp
(PPExp T_PPC
l)  >>|<< :: PP_Exp -> PP_Exp -> PP_Exp
>>|<< (PPExp T_PPC
r)  =  T_PPC -> PP_Exp
PPExp (T_PPC -> T_PPC -> T_PPC
sem_PPC_Beside T_PPC
l T_PPC
r)
(PPExp T_PPC
u)  >>-<< :: PP_Exp -> PP_Exp -> PP_Exp
>>-<< (PPExp T_PPC
l)  =  T_PPC -> PP_Exp
PPExp (T_PPC -> T_PPC -> T_PPC
sem_PPC_Above  T_PPC
u T_PPC
l)
(PPExp T_PPC
a) >>//<< :: PP_Exp -> PP_Exp -> PP_Exp
>>//<< (PPExp T_PPC
b)  =  T_PPC -> PP_Exp
PPExp (T_PPC -> T_PPC -> T_PPC
sem_PPC_Dup    T_PPC
a T_PPC
b)

ejoin :: PP_Exp -> PP_Exp
ejoin :: PP_Exp -> PP_Exp
ejoin (PPExp T_PPC
dc) = T_PPC -> PP_Exp
PPExp (T_PPC -> PP_Exp) -> (T_PPC -> T_PPC) -> T_PPC -> PP_Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T_PPC -> T_PPC
sem_PPC_Join (T_PPC -> PP_Exp) -> T_PPC -> PP_Exp
forall a b. (a -> b) -> a -> b
$ T_PPC
dc

par :: PP_Exp
par :: PP_Exp
par = T_PPC -> PP_Exp
PPExp T_PPC
sem_PPC_Par

(>>$<) :: PP a => PP_Exp -> [a] -> PP_Doc
(PPExp T_PPC
e) >>$< :: forall a. PP a => PP_Exp -> [a] -> PP_Doc
>>$< [a]
pl = T_PPS -> PP_Doc
PPDoc (T_PPS -> PP_Doc) -> ([a] -> T_PPS) -> [a] -> PP_Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T_PPC -> T_PPSArgs -> T_PPS
sem_PPS_Apply T_PPC
e (T_PPSArgs -> T_PPS) -> ([a] -> T_PPSArgs) -> [a] -> T_PPS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> T_PPSArgs -> T_PPSArgs) -> T_PPSArgs -> [a] -> T_PPSArgs
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> T_PPSArgs -> T_PPSArgs
forall {a}. PP a => a -> T_PPSArgs -> T_PPSArgs
ppslist T_PPSArgs
sem_PPSArgs_Nil ([a] -> PP_Doc) -> [a] -> PP_Doc
forall a b. (a -> b) -> a -> b
$ [a]
pl
  where ppslist :: a -> T_PPSArgs -> T_PPSArgs
ppslist a
p = T_PPS -> T_PPSArgs -> T_PPSArgs
sem_PPSArgs_Cons (case (a -> PP_Doc
forall a. PP a => a -> PP_Doc
pp a
p) of (PPDoc T_PPS
ppp) -> T_PPS
ppp)

(>>$<<) :: PP_Exp -> [PP_Exp] -> PP_Exp
(PPExp T_PPC
e) >>$<< :: PP_Exp -> [PP_Exp] -> PP_Exp
>>$<< [PP_Exp]
pl = T_PPC -> PP_Exp
PPExp (T_PPC -> PP_Exp) -> ([PP_Exp] -> T_PPC) -> [PP_Exp] -> PP_Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T_PPC -> T_PPCArgs -> T_PPC
sem_PPC_Apply T_PPC
e (T_PPCArgs -> T_PPC)
-> ([PP_Exp] -> T_PPCArgs) -> [PP_Exp] -> T_PPC
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PP_Exp -> T_PPCArgs -> T_PPCArgs)
-> T_PPCArgs -> [PP_Exp] -> T_PPCArgs
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr PP_Exp -> T_PPCArgs -> T_PPCArgs
ppclist T_PPCArgs
sem_PPCArgs_Nil ([PP_Exp] -> PP_Exp) -> [PP_Exp] -> PP_Exp
forall a b. (a -> b) -> a -> b
$ [PP_Exp]
pl
  where ppclist :: PP_Exp -> T_PPCArgs -> T_PPCArgs
ppclist (PPExp T_PPC
p) = T_PPC -> T_PPCArgs -> T_PPCArgs
sem_PPCArgs_Cons T_PPC
p

-- -------------------------------------------------------------------
-- Displaying the result ---------------------------------------------

render, renderAll   ::  PP_Doc -> Int -> IO ()
render :: PP_Doc -> Int -> IO ()
render    (PPDoc T_PPS
fs)  =  String -> IO ()
putStr (String -> IO ()) -> (Int -> String) -> Int -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T_PPS -> Int -> String
sem_Root_Best T_PPS
fs
renderAll :: PP_Doc -> Int -> IO ()
renderAll (PPDoc T_PPS
fs)  =  String -> IO ()
putStr (String -> IO ()) -> (Int -> String) -> Int -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T_PPS -> Int -> String
sem_Root_All T_PPS
fs

disp  ::  PP_Doc -> Int -> ShowS
disp :: PP_Doc -> Int -> ShowS
disp (PPDoc T_PPS
fs) =  T_PPS -> Int -> ShowS
sem_Disp_Disp T_PPS
fs

-- -------------------------------------------------------------------
-- Additional generated combinators ----------------------------------

c2e :: PP a => a -> PP_Exp
c2e :: forall a. PP a => a -> PP_Exp
c2e a
s = let (PPDoc T_PPS
s') = a -> PP_Doc
forall a. PP a => a -> PP_Doc
pp a
s in T_PPC -> PP_Exp
PPExp (T_PPC -> PP_Exp) -> (T_PPS -> T_PPC) -> T_PPS -> PP_Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T_PPS -> T_PPC
sem_PPC_Pps (T_PPS -> PP_Exp) -> T_PPS -> PP_Exp
forall a b. (a -> b) -> a -> b
$ T_PPS
s'

element_h1 :: PP_Doc -> PP_Doc
element_h1 :: PP_Doc -> PP_Doc
element_h1 = \(PPDoc T_PPS
fs) -> T_PPS -> PP_Doc
PPDoc (T_PPS -> T_PPS
sem_PPS_Filt T_PPS
fs)

eelement_h1 :: PP_Exp -> PP_Exp
eelement_h1 :: PP_Exp -> PP_Exp
eelement_h1 (PPExp T_PPC
pe) = T_PPC -> PP_Exp
PPExp (T_PPC -> PP_Exp) -> (T_PPC -> T_PPC) -> T_PPC -> PP_Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T_PPC -> T_PPC
sem_PPC_Filt (T_PPC -> PP_Exp) -> T_PPC -> PP_Exp
forall a b. (a -> b) -> a -> b
$ T_PPC
pe

vcenter :: PP a => [ a ] -> PP_Doc
vcenter :: forall a. PP a => [a] -> PP_Doc
vcenter = T_PPS -> PP_Doc
PPDoc (T_PPS -> PP_Doc) -> ([a] -> T_PPS) -> [a] -> PP_Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T_CenterList -> T_PPS
sem_PPS_Center (T_CenterList -> T_PPS) -> ([a] -> T_CenterList) -> [a] -> T_PPS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> T_CenterList -> T_CenterList)
-> T_CenterList -> [a] -> T_CenterList
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> T_CenterList -> T_CenterList
forall {a}. PP a => a -> T_CenterList -> T_CenterList
center_alg T_CenterList
sem_CenterList_Nil
  where center_alg :: a -> T_CenterList -> T_CenterList
center_alg a
f = T_PPS -> T_CenterList -> T_CenterList
sem_CenterList_Cons (case (a -> PP_Doc
forall a. PP a => a -> PP_Doc
pp a
f) of (PPDoc T_PPS
pf) -> T_PPS
pf)

invisible :: PP_Doc -> PP_Doc
invisible :: PP_Doc -> PP_Doc
invisible (PPDoc T_PPS
a) = T_PPS -> PP_Doc
PPDoc (T_PPS -> PP_Doc) -> (T_PPS -> T_PPS) -> T_PPS -> PP_Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T_PPS -> T_PPS
sem_PPS_Inv (T_PPS -> PP_Doc) -> T_PPS -> PP_Doc
forall a b. (a -> b) -> a -> b
$ T_PPS
a

-- -------------------------------------------------------------------
-- Additional derived combinators ------------------------------------

fpar, spar :: PP_Exp
fpar :: PP_Exp
fpar = (T_Formats -> (T_Formats, Bool)) -> PP_Exp -> PP_Exp
plift  T_Formats -> (T_Formats, Bool)
first   PP_Exp
par
spar :: PP_Exp
spar = (T_Formats -> (T_Formats, Bool)) -> PP_Exp -> PP_Exp
plift  T_Formats -> (T_Formats, Bool)
second  PP_Exp
par

first :: T_Formats -> (T_Formats, Bool)
first T_Formats
fs  = case T_Formats
fs of
              (TFormats Formats
fa Formats
_ Bool
ea Bool
_) -> (Formats -> T_Formats
AFormat Formats
fa, Bool
ea   )
              (AFormat Formats
fa)         -> (Formats -> T_Formats
AFormat Formats
fa, Bool
False)
second :: T_Formats -> (T_Formats, Bool)
second T_Formats
fs = case T_Formats
fs of
              (TFormats Formats
_ Formats
fb Bool
_ Bool
eb) -> (Formats -> T_Formats
AFormat Formats
fb, Bool
eb   )
              (AFormat Formats
fb)         -> (Formats -> T_Formats
AFormat Formats
fb, Bool
False)

-- Utilities

lift :: (T_Formats -> T_Formats) -> PP_Doc -> PP_Doc
lift :: (T_Formats -> T_Formats) -> PP_Doc -> PP_Doc
lift T_Formats -> T_Formats
f (PPDoc T_PPS
p) = T_PPS -> PP_Doc
PPDoc (T_PPS -> PP_Doc)
-> ((T_Formats -> T_Formats) -> T_PPS)
-> (T_Formats -> T_Formats)
-> PP_Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T_PPS -> (T_Formats -> T_Formats) -> T_PPS
sem_LiftS_Lift T_PPS
p ((T_Formats -> T_Formats) -> PP_Doc)
-> (T_Formats -> T_Formats) -> PP_Doc
forall a b. (a -> b) -> a -> b
$ T_Formats -> T_Formats
f

--elift :: (T_Formats -> T_Formats) -> T_PPC -> T_PPC
elift :: (T_Formats -> T_Formats) -> PP_Exp -> PP_Exp
elift T_Formats -> T_Formats
f (PPExp T_PPC
e) = T_PPC -> PP_Exp
PPExp (T_PPC -> PP_Exp)
-> ((T_Formats -> T_Formats) -> T_PPC)
-> (T_Formats -> T_Formats)
-> PP_Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T_PPC -> (T_Formats -> T_Formats) -> T_PPC
forall {p} {p} {p} {p} {t} {b} {c} {d} {e} {f} {g} {a}.
(p -> p -> p -> p -> (t, b, c, d, e, f, g))
-> (t -> a) -> p -> p -> p -> p -> (a, b, c, d, e, f, g)
sem_LiftC_Lift T_PPC
e ((T_Formats -> T_Formats) -> PP_Exp)
-> (T_Formats -> T_Formats) -> PP_Exp
forall a b. (a -> b) -> a -> b
$ T_Formats -> T_Formats
f

--plift :: (a -> b) -> T_PPC -> T_PPC
plift :: (T_Formats -> (T_Formats, Bool)) -> PP_Exp -> PP_Exp
plift T_Formats -> (T_Formats, Bool)
f (PPExp T_PPC
e) = T_PPC -> PP_Exp
PPExp (T_PPC -> PP_Exp)
-> ((T_Formats -> (T_Formats, Bool)) -> T_PPC)
-> (T_Formats -> (T_Formats, Bool))
-> PP_Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T_PPC -> (T_Formats -> (T_Formats, Bool)) -> T_PPC
forall {p} {p} {p} {p} {a} {c} {d} {e} {f} {g} {a}.
(p -> p -> p -> p -> (a, Bool, c, d, e, f, g))
-> (a -> (a, Bool)) -> p -> p -> p -> p -> (a, Bool, c, d, e, f, g)
sem_LiftC_Pair T_PPC
e ((T_Formats -> (T_Formats, Bool)) -> PP_Exp)
-> (T_Formats -> (T_Formats, Bool)) -> PP_Exp
forall a b. (a -> b) -> a -> b
$ T_Formats -> (T_Formats, Bool)
f

-- ...................................................................
-- ..... Basic machinery .............................................

type Formats = [Format]

{- Pretty-printer combinators with global page width -}

type T_PW  = Int
type T_PLL = Int
type T_PH  = Int
--                Width  Width last line
data T_Frame = F  T_PW   T_PLL
             deriving T_Frame -> T_Frame -> Bool
(T_Frame -> T_Frame -> Bool)
-> (T_Frame -> T_Frame -> Bool) -> Eq T_Frame
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: T_Frame -> T_Frame -> Bool
$c/= :: T_Frame -> T_Frame -> Bool
== :: T_Frame -> T_Frame -> Bool
$c== :: T_Frame -> T_Frame -> Bool
Eq

instance Ord T_Frame where
  (F Int
w Int
_) <= :: T_Frame -> T_Frame -> Bool
<= (F Int
w' Int
_) = Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
w'
  max :: T_Frame -> T_Frame -> T_Frame
max x :: T_Frame
x@(F Int
w Int
_) y :: T_Frame
y@(F Int
w' Int
_)
    | Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
w'    = T_Frame
x
    | Bool
otherwise = T_Frame
y

empty_fmts ::Formats
empty_fmts :: Formats
empty_fmts = []

text_fmts :: String -> Formats
text_fmts :: String -> Formats
text_fmts String
s = [ String -> Format
s2fmt String
s ]

indent_fmts :: T_Frame -> Int -> Formats -> Formats
indent_fmts :: T_Frame -> Int -> Formats -> Formats
indent_fmts (F Int
pw Int
_) Int
i = (Format -> Format) -> Formats -> Formats
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Format -> Format
indent_fmt Int
i)
                       (Formats -> Formats) -> (Formats -> Formats) -> Formats -> Formats
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Format -> Bool) -> Formats -> Formats
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Int -> Format -> Bool
notFits (Int
pw Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i))
notFits :: Int -> Format -> Bool
notFits Int
delta Format
e = Format -> Int
total_w Format
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
delta

beside_fmts :: T_Frame -> Formats -> Formats -> Formats
beside_fmts :: T_Frame -> Formats -> Formats -> Formats
beside_fmts (F Int
pw Int
_) Formats
left  Formats
right
  = [Formats] -> Formats
forall a. Ord a => [[a]] -> [a]
mergel [ (Format -> Format) -> Formats -> Formats
forall a b. (a -> b) -> [a] -> [b]
map (Format
l Format -> Format -> Format
`beside_fmt`)
           (Formats -> Formats) -> (Formats -> Formats) -> Formats -> Formats
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Format -> Bool) -> Formats -> Formats
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Int -> Format -> Format -> Bool
tooWide Int
pw Format
l)
           (Formats -> Formats) -> Formats -> Formats
forall a b. (a -> b) -> a -> b
$ Formats
right
           | Format
l <- Formats
left
           ]
tooWide :: Int -> Format -> Format -> Bool
tooWide Int
pw Format
x Format
y
  = (Format -> Int
total_w Format
x Int -> Int -> Int
forall a. Ord a => a -> a -> a
`max` (Format -> Int
last_w Format
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Format -> Int
total_w Format
y)) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
pw

above_fmts :: Formats -> Formats -> Formats
above_fmts :: Formats -> Formats -> Formats
above_fmts [] Formats
ls = []
above_fmts Formats
us [] = []
above_fmts up :: Formats
up@(Format
upper:Formats
ru) low :: Formats
low@(Format
lower:Formats
rl)
  | Int
utw Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
ltw = Format
firstelem Format -> Formats -> Formats
forall a. a -> [a] -> [a]
: Formats -> Formats -> Formats
above_fmts Formats
ru Formats
low
  | Int
utw Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<  Int
ltw = Format
firstelem Format -> Formats -> Formats
forall a. a -> [a] -> [a]
: Formats -> Formats -> Formats
above_fmts Formats
up Formats
rl
  where utw :: Int
utw = Format -> Int
total_w Format
upper
        ltw :: Int
ltw = Format -> Int
total_w Format
lower
        firstelem :: Format
firstelem = Format
upper Format -> Format -> Format
`above_fmt` Format
lower

{- Pretty-printing with error correction -}

error_indent :: Int -> Formats -> Formats
error_indent :: Int -> Formats -> Formats
error_indent Int
i = (Format -> Format) -> Formats -> Formats
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Format -> Format
indent_fmt Int
i)

error_beside :: Formats -> Formats -> Formats
error_beside :: Formats -> Formats -> Formats
error_beside Formats
left Formats
right = [Formats] -> Formats
forall a. Ord a => [[a]] -> [a]
mergel [ (Format -> Format) -> Formats -> Formats
forall a b. (a -> b) -> [a] -> [b]
map (Format
l Format -> Format -> Format
`beside_fmt`) Formats
right
                                 | Format
l <- Formats
left
                                 ]

-- -------------------------------------------------------------------
-- Formatting one layout ---------------------------------------------

data Format = Elem { Format -> Int
height  :: T_PH
                   , Format -> Int
last_w  :: T_PLL
                   , Format -> Int
total_w :: T_PW
                   , Format -> Int -> ShowS
txtstr  :: Int -> String -> String
                   }

instance Eq Format  where
  Format
x == :: Format -> Format -> Bool
== Format
y =  Format -> Int
height Format
x  Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Format -> Int
height Format
y
         Bool -> Bool -> Bool
&& Format -> Int
total_w Format
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Format -> Int
total_w Format
y
         Bool -> Bool -> Bool
&& Format -> Int
last_w  Format
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Format -> Int
last_w  Format
y

instance Ord Format where
  Format
x <= :: Format -> Format -> Bool
<= Format
y =  Format -> Int
height Format
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Format -> Int
height Format
y
         Bool -> Bool -> Bool
|| (  Format -> Int
height Format
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Format -> Int
height Format
y
            Bool -> Bool -> Bool
&& Format -> Int
total_w Format
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Format -> Int
total_w Format
y )
  Format
x < :: Format -> Format -> Bool
<  Format
y =  Format -> Int
height Format
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Format -> Int
height Format
y
         Bool -> Bool -> Bool
|| (  Format -> Int
height Format
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Format -> Int
height Format
y
            Bool -> Bool -> Bool
&& Format -> Int
total_w Format
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Format -> Int
total_w Format
y )

s2fmt     :: String -> Format
s2fmt :: String -> Format
s2fmt String
s   = Int -> Int -> Int -> (Int -> ShowS) -> Format
Elem Int
1 Int
l Int
l (\Int
_ -> (String
sString -> ShowS
forall a. [a] -> [a] -> [a]
++))
  where l :: Int
l = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s

indent_fmt :: Int -> Format -> Format
indent_fmt :: Int -> Format -> Format
indent_fmt Int
i   (Elem Int
dh Int
dl Int
dw Int -> ShowS
dt)
   = Int -> Int -> Int -> (Int -> ShowS) -> Format
Elem Int
dh (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dl) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dw) (\Int
n -> ((Int -> String
sp Int
i) String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
dt (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n))

above_fmt, beside_fmt :: Format -> Format -> Format
(Elem Int
uh Int
ul Int
uw Int -> ShowS
ut) above_fmt :: Format -> Format -> Format
`above_fmt` (Elem Int
lh Int
ll Int
lw Int -> ShowS
lt)
  = Int -> Int -> Int -> (Int -> ShowS) -> Format
Elem (Int
uh Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
lh) Int
ll (Int
uw Int -> Int -> Int
forall a. Ord a => a -> a -> a
`max` Int
lw)
         ((Int -> ShowS) -> (Int -> ShowS) -> Int -> ShowS
forall {c} {a}.
(Int -> String -> c) -> (Int -> a -> String) -> Int -> a -> c
make_ts_above Int -> ShowS
ut Int -> ShowS
lt)
  where make_ts_above :: (Int -> String -> c) -> (Int -> a -> String) -> Int -> a -> c
make_ts_above Int -> String -> c
ut Int -> a -> String
lt = \Int
n -> let nl_skip :: ShowS
nl_skip = ((Char
'\n'Char -> ShowS
forall a. a -> [a] -> [a]
:Int -> String
sp Int
n)String -> ShowS
forall a. [a] -> [a] -> [a]
++)
                                    in  Int -> String -> c
ut Int
n (String -> c) -> (a -> String) -> a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
nl_skip ShowS -> (a -> String) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> String
lt Int
n
(Elem Int
lh Int
ll Int
lw Int -> ShowS
lt) beside_fmt :: Format -> Format -> Format
`beside_fmt` (Elem Int
rh Int
rl Int
rw Int -> ShowS
rt)
  = Int -> Int -> Int -> (Int -> ShowS) -> Format
Elem (Int
lh Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rh Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int
ll Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rl)
         (Int
lw Int -> Int -> Int
forall a. Ord a => a -> a -> a
`max` (Int
ll Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rw)) (\Int
n -> Int -> ShowS
lt Int
n ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
rt (Int
ll Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n))

-- -------------------------------------------------------------------
-- Display the layout found ------------------------------------------

best :: Formats -> String
best Formats
fs  = if Formats -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Formats
fs then String
"" else (Format -> Int -> ShowS
txtstr (Format -> Int -> ShowS)
-> (Formats -> Format) -> Formats -> Int -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Formats -> Format
forall a. [a] -> a
head (Formats -> Int -> ShowS) -> Formats -> Int -> ShowS
forall a b. (a -> b) -> a -> b
$ Formats
fs) Int
0 String
""
allf :: Formats -> String
allf     = (Format -> String) -> Formats -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Format
fmt -> (Format -> Int -> ShowS
txtstr Format
fmt) Int
0 String
"\n\n")
dispf :: Formats -> ShowS
dispf Formats
fs = if Formats -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Formats
fs then ShowS
forall a. a -> a
id else (Format -> Int -> ShowS
txtstr (Format -> Int -> ShowS)
-> (Formats -> Format) -> Formats -> Int -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Formats -> Format
forall a. [a] -> a
head (Formats -> Int -> ShowS) -> Formats -> Int -> ShowS
forall a b. (a -> b) -> a -> b
$ Formats
fs) Int
0

-- -------------------------------------------------------------------
-- Utility functions -------------------------------------------------

merge :: [a] -> [a] -> [a]
merge []        [a]
ys        = [a]
ys
merge [a]
xs        []        = [a]
xs
merge xl :: [a]
xl@(a
x:[a]
xs) yl :: [a]
yl@(a
y:[a]
ys)
  | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y    = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
merge [a]
xs [a]
ys
  | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<  a
y    = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
merge [a]
xs [a]
yl
  | Bool
otherwise = a
y a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
merge [a]
xl [a]
ys

spaces :: String
spaces = Char
' 'Char -> ShowS
forall a. a -> [a] -> [a]
:String
spaces
sp :: Int -> String
sp Int
n = if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 then Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
n String
spaces else String
""

mergel :: Ord a => [[a]] -> [a]
mergel :: forall a. Ord a => [[a]] -> [a]
mergel = ([a] -> [a] -> [a]) -> [a] -> [[a]] -> [a]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr [a] -> [a] -> [a]
forall {a}. Ord a => [a] -> [a] -> [a]
merge []

-- ...................................................................
-- ..... Generated code from Pretty.ag ...............................

narrow_frame :: Int -> T_Frame -> T_Frame
narrow_frame Int
i  (F Int
s Int
l) = Int -> Int -> T_Frame
F (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i)  (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i)
narrow_ll :: Int -> T_Frame -> T_Frame
narrow_ll    Int
i  (F Int
s Int
l) = Int -> Int -> T_Frame
F Int
s        (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i)

type T_Mins  = [ (T_PW, T_PLL, T_PH) ]

set_var_apply :: Bool -> p -> p -> p
set_var_apply Bool
cond p
va p
vb = if Bool
cond then p
va else p
vb

type T_Reqs  = [ T_Frame ]

type T_Fmts = [ T_Formats ]
type T_Errs = [ T_Error ]

beside_height :: a -> a -> a
beside_height a
lh a
rh
  = a
lh a -> a -> a
forall a. Num a => a -> a -> a
+ a
rh a -> a -> a
forall a. Num a => a -> a -> a
- if (a
lh a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 Bool -> Bool -> Bool
|| a
rh a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0) then a
0 else a
1

cons_height :: a -> p -> Bool -> p
cons_height a
pPh p
acth Bool
avail
  | p
acth p -> p -> Bool
forall a. Eq a => a -> a -> Bool
== p
0  = if a
pPh a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
0 then p
1 else p
0
  | Bool
otherwise  = p
acth p -> p -> p
forall a. Num a => a -> a -> a
+ if Bool
avail then p
0 else p
1

type T_Error = Bool

data T_Formats = AFormat   Formats
               | TFormats  Formats  Formats  T_Error  T_Error

afmt_txt :: String -> T_Formats
afmt_txt = Formats -> T_Formats
AFormat (Formats -> T_Formats)
-> (String -> Formats) -> String -> T_Formats
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Formats
text_fmts

set_fmts_empty :: T_Formats
set_fmts_empty = Formats -> T_Formats
AFormat Formats
empty_fmts

set_fmts_text :: String -> p -> p -> T_Formats
set_fmts_text String
string p
minw p
error
  = String -> T_Formats
afmt_txt String
string
  --(if error then (asts minw) else string)

set_fmts_indent :: Int -> T_Formats -> p -> p -> T_Frame -> Bool -> T_Formats
set_fmts_indent Int
int T_Formats
fmts p
pw p
minw T_Frame
frame Bool
error
  | Int
int Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0    = String -> T_Formats
afmt_txt String
"<Error: negative indentation>"
 -- int > pw   = afmt_txt . asts $ minw
  | Bool
error      = (Int -> Formats -> Formats) -> T_Formats
set_fmts_indent' Int -> Formats -> Formats
error_indent
  | Bool
otherwise  = (Int -> Formats -> Formats) -> T_Formats
set_fmts_indent' (T_Frame -> Int -> Formats -> Formats
indent_fmts T_Frame
frame)
  where set_fmts_indent' :: (Int -> Formats -> Formats) -> T_Formats
set_fmts_indent' Int -> Formats -> Formats
fmt_fc
          = case T_Formats
fmts of
              AFormat Formats
fs -> Formats -> T_Formats
AFormat (Int -> Formats -> Formats
fmt_fc Int
int Formats
fs)
              TFormats Formats
as Formats
bs Bool
ae Bool
be
                         -> Formats -> Formats -> Bool -> Bool -> T_Formats
TFormats (Int -> Formats -> Formats
fmt_fc Int
int Formats
as)
                                     (Int -> Formats -> Formats
fmt_fc Int
int Formats
bs) Bool
ae Bool
be

set_fmts_beside :: T_Formats
-> T_Formats -> p -> p -> T_Frame -> Bool -> (T_Formats, Bool)
set_fmts_beside T_Formats
ls T_Formats
rs p
lh p
rh T_Frame
frame Bool
err
  = T_Formats
-> T_Formats
-> (Formats -> Formats -> Formats)
-> String
-> (T_Formats, Bool)
set_fmts_ab T_Formats
ls T_Formats
rs Formats -> Formats -> Formats
set_fmts_beside' String
"<Error: can't beside two pairs>"
  where set_fmts_beside' :: Formats -> Formats -> Formats
set_fmts_beside' Formats
as Formats
bs
          = Bool
-> Bool
-> Formats
-> Formats
-> (Formats -> Formats -> Formats)
-> Formats
forall {t}. Bool -> Bool -> t -> t -> (t -> t -> t) -> t
set_ab (p
lh p -> p -> Bool
forall a. Eq a => a -> a -> Bool
== p
0) (p
rh p -> p -> Bool
forall a. Eq a => a -> a -> Bool
== p
0) Formats
as Formats
bs
               (if Bool
err then Formats -> Formats -> Formats
error_beside
                       else T_Frame -> Formats -> Formats -> Formats
beside_fmts T_Frame
frame)

set_fmts_above :: T_Formats -> T_Formats -> p -> p -> (T_Formats, Bool)
set_fmts_above T_Formats
us T_Formats
ls p
uh p
lh
  = T_Formats
-> T_Formats
-> (Formats -> Formats -> Formats)
-> String
-> (T_Formats, Bool)
set_fmts_ab T_Formats
us T_Formats
ls Formats -> Formats -> Formats
set_fmts_above' String
"<Error: can't above two pairs>"
  where set_fmts_above' :: Formats -> Formats -> Formats
set_fmts_above' Formats
as Formats
bs = Bool
-> Bool
-> Formats
-> Formats
-> (Formats -> Formats -> Formats)
-> Formats
forall {t}. Bool -> Bool -> t -> t -> (t -> t -> t) -> t
set_ab (p
uh p -> p -> Bool
forall a. Eq a => a -> a -> Bool
== p
0) (p
lh p -> p -> Bool
forall a. Eq a => a -> a -> Bool
== p
0) Formats
as Formats
bs Formats -> Formats -> Formats
above_fmts

set_ab :: Bool -> Bool -> t -> t -> (t -> t -> t) -> t
set_ab Bool
aempty Bool
bempty t
as t
bs t -> t -> t
fmt_fc
  = if Bool
aempty       {- left operand empty?  -}
    then t
bs
    else if Bool
bempty  {- right operand empty? -}
         then t
as
         else t -> t -> t
fmt_fc t
as t
bs

set_fmts_ab :: T_Formats
-> T_Formats
-> (Formats -> Formats -> Formats)
-> String
-> (T_Formats, Bool)
set_fmts_ab T_Formats
fs T_Formats
gs Formats -> Formats -> Formats
fmt_fc String
etxt
  = case T_Formats
fs of
      AFormat Formats
ffmts -> case T_Formats
gs of
                         AFormat Formats
gfmts -> ( Formats -> T_Formats
AFormat (Formats -> Formats -> Formats
fmt_fc Formats
ffmts Formats
gfmts), Bool
False )
                         TFormats Formats
as Formats
bs Bool
ae Bool
be
                                       -> ( Formats -> Formats -> Bool -> Bool -> T_Formats
TFormats (Formats -> Formats -> Formats
fmt_fc Formats
ffmts Formats
as)
                                                     (Formats -> Formats -> Formats
fmt_fc Formats
ffmts Formats
bs) Bool
ae Bool
be
                                          , Bool
False )
      TFormats Formats
as Formats
bs Bool
ae Bool
be
                    -> case T_Formats
gs of
                         AFormat Formats
gfmts -> ( Formats -> Formats -> Bool -> Bool -> T_Formats
TFormats (Formats -> Formats -> Formats
fmt_fc Formats
as Formats
gfmts)
                                                     (Formats -> Formats -> Formats
fmt_fc Formats
bs Formats
gfmts) Bool
ae Bool
be
                                          , Bool
False )
                         T_Formats
otherwise     -> ( String -> T_Formats
afmt_txt String
etxt, Bool
True )

sem_fmts_dup :: T_Formats -> T_Formats -> Bool -> Bool -> p -> T_Formats
sem_fmts_dup T_Formats
afs T_Formats
bfs Bool
ae Bool
be p
minw
  = {-if (ae && be)
    then afmt_txt . asts $ minw
    else-}
         let get_fmts :: T_Formats -> Formats
get_fmts T_Formats
fs
               = case T_Formats
fs of
                   AFormat Formats
as       -> Formats
as
                   TFormats Formats
_ Formats
_ Bool
_ Bool
_ -> String -> Formats
text_fmts String
"<Error: can't dup a dup>"
             afmts :: Formats
afmts = T_Formats -> Formats
get_fmts T_Formats
afs
             bfmts :: Formats
bfmts = T_Formats -> Formats
get_fmts T_Formats
bfs
         in  Formats -> Formats -> Bool -> Bool -> T_Formats
TFormats Formats
afmts Formats
bfmts Bool
ae Bool
be

set_fmts_join :: T_Formats -> Bool -> (T_Formats, Bool)
set_fmts_join    (TFormats Formats
as Formats
bs Bool
ae Bool
be)  Bool
err
  = ( Formats -> T_Formats
AFormat (Formats -> T_Formats) -> Formats -> T_Formats
forall a b. (a -> b) -> a -> b
$ if Bool
be
                then (if Formats -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Formats
as then Formats
bs else Formats
as)
                else if Bool
ae
                     then (if Formats -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Formats
bs then Formats
as else Formats
bs)
                     else Formats -> Formats -> Formats
forall {a}. Ord a => [a] -> [a] -> [a]
merge Formats
as Formats
bs
    , Bool
False
    )
set_fmts_join fs :: T_Formats
fs@(AFormat Formats
_) Bool
err
  = if Bool
err then (T_Formats
fs, Bool
err)
           else (String -> T_Formats
afmt_txt String
"<Error: can't join a single result>", Bool
True)

set_fmts_apply :: Bool -> p -> p -> p
set_fmts_apply Bool
True  p
a  p
_  =  p
a
set_fmts_apply Bool
False p
_  p
b  =  p
b

set_fmts_fillblock :: a -> Formats -> T_Formats
set_fmts_fillblock a
int Formats
fmts
  | a
int a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0     = String -> T_Formats
afmt_txt String
"<Error: negative page width in fillblock>"
  | Bool
otherwise   = Formats -> T_Formats
AFormat Formats
fmts

set_error_msg :: a -> a -> String
set_error_msg a
numpars a
len
  = String
"<Error: incorrect apply expression. #pars "
  String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
numpars String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" /= #args "
  String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
len     String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
">"
{-
asts 0 = ""
asts 1 = "*"
asts s = '<' : replicate (s-2) '*' ++ ">"
-}
sem_fmts_cdup :: T_Formats
-> T_Formats -> Bool -> Bool -> a -> a -> p -> String -> T_Formats
sem_fmts_cdup T_Formats
afs T_Formats
bfs Bool
ae Bool
be a
an a
bn p
minw String
em
  = if a
an a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
bn then String -> T_Formats
afmt_txt String
em
                else T_Formats -> T_Formats -> Bool -> Bool -> p -> T_Formats
forall {p}.
T_Formats -> T_Formats -> Bool -> Bool -> p -> T_Formats
sem_fmts_dup T_Formats
afs T_Formats
bfs Bool
ae Bool
be p
minw

set_error_msg' :: a -> a -> String
set_error_msg' a
apars a
bpars
  =  String
"<Error: incorrect choice expression. #pars left " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
apars
  String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" /= #pars right " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
bpars
  String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
">"

set_fmts_filllist :: Formats
-> T_Formats -> a -> a -> T_Frame -> Bool -> (Formats, Bool)
set_fmts_filllist Formats
ifmts T_Formats
nfmts a
ih a
nh T_Frame
frame Bool
avail
  = case T_Formats
nfmts of
      AFormat Formats
ns -> if a
ih a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0                       {- left operand empty?   -}
                    then (Formats
ns, Bool
False)
                    else if a
nh a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0                  {- right operand empty?  -}
                         then (Formats
ifmts, Bool
False)
                         else if a
nh a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
1
                              then ( (Formats -> Formats -> Formats) -> Formats -> Formats -> Formats
choose_ab (T_Frame -> Formats -> Formats -> Formats
beside_fmts T_Frame
frame) Formats
ifmts Formats
ns, Bool
False )
                              else ( (Formats -> Formats -> Formats) -> Formats -> Formats -> Formats
choose_ab Formats -> Formats -> Formats
error_beside
                                       Formats
ifmts (String -> Formats
text_fmts String
"<Error: element in fill higher than 1>")
                                   , Bool
True )
      T_Formats
otherwise  -> ( Formats -> Formats
set_fmts_filllist' (Formats -> Formats) -> (String -> Formats) -> String -> Formats
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Formats
text_fmts (String -> Formats) -> String -> Formats
forall a b. (a -> b) -> a -> b
$ String
"<Error: element in fill list is a pair>"
                    , Bool
True )
  where set_fmts_filllist' :: Formats -> Formats
set_fmts_filllist' Formats
fs
          = Bool
-> Bool
-> Formats
-> Formats
-> (Formats -> Formats -> Formats)
-> Formats
forall {t}. Bool -> Bool -> t -> t -> (t -> t -> t) -> t
set_ab (a
ih a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0) (a
nh a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0) Formats
fs Formats
ifmts ((Formats -> Formats -> Formats) -> Formats -> Formats -> Formats
choose_ab Formats -> Formats -> Formats
error_beside)
        choose_ab :: (Formats -> Formats -> Formats) -> Formats -> Formats -> Formats
choose_ab Formats -> Formats -> Formats
bsd_fc = if Bool
avail then Formats -> Formats -> Formats
bsd_fc else Formats -> Formats -> Formats
above_fmts

set_fmts_render :: a -> T_Formats -> Formats
set_fmts_render a
pw T_Formats
fs
  = if a
pw a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0
    then String -> Formats
text_fmts String
"<Error: negative page width >"
    else case T_Formats
fs of
           AFormat Formats
fmts -> Formats
fmts
           T_Formats
otherwise    -> String -> Formats
text_fmts String
"<Error: can't render a pair>"

type T_Function = T_Formats -> T_Formats

set_fmts_filt :: T_Formats -> p -> (T_Formats, Bool)
set_fmts_filt (AFormat  Formats
fs     ) p
minw
  = {-if null height1 then ( afmt_txt . asts $ minw , True  )
                    else-} ( Formats -> T_Formats
AFormat Formats
height1        , Bool
False )
  where height1 :: Formats
height1 = (Format -> Bool) -> Formats -> Formats
forall a. (a -> Bool) -> [a] -> [a]
takeWhile ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<=Int
1)(Int -> Bool) -> (Format -> Int) -> Format -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Format -> Int
height) Formats
fs
set_fmts_filt T_Formats
_ p
_
  = ( String -> T_Formats
afmt_txt (String -> T_Formats) -> String -> T_Formats
forall a b. (a -> b) -> a -> b
$ String
"<Error: can not filter a pair>", Bool
True )

set_fmts_inv :: T_Formats -> T_Formats
set_fmts_inv T_Formats
fs
  = case T_Formats
fs of
      AFormat Formats
fmts         -> Formats -> T_Formats
AFormat (Formats -> T_Formats)
-> (Formats -> Formats) -> Formats -> T_Formats
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Formats -> Formats
set_inv (Formats -> T_Formats) -> Formats -> T_Formats
forall a b. (a -> b) -> a -> b
$ Formats
fmts
      TFormats Formats
as Formats
bs Bool
ae Bool
be -> Formats -> Formats -> Bool -> Bool -> T_Formats
TFormats (Formats -> Formats
set_inv Formats
as) (Formats -> Formats
set_inv Formats
bs) Bool
ae Bool
be
  where set_inv :: Formats -> Formats
set_inv = (Format -> Formats -> Formats
forall a. a -> [a] -> [a]
:[]) (Format -> Formats) -> (Formats -> Format) -> Formats -> Formats
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int -> (Int -> ShowS) -> Format
Elem Int
1 Int
0 Int
0) ((Int -> ShowS) -> Format)
-> (Formats -> Int -> ShowS) -> Formats -> Format
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format -> Int -> ShowS
txtstr (Format -> Int -> ShowS)
-> (Formats -> Format) -> Formats -> Int -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Formats -> Format
forall a. [a] -> a
head

type T_SynPPS = ( T_Formats, T_Error, T_PH, T_PLL, T_PW )

vapp :: (T_Formats, Bool, Int, Int, Int) -> Int -> T_PPS -> T_PPS
vapp (T_Formats, Bool, Int, Int, Int)
fmts Int
spaces T_PPS
pPS T_Frame
frame
  = T_PPS -> T_PPS -> T_PPS
sem_PPS_Above (\T_Frame
frame -> (T_Formats, Bool, Int, Int, Int)
fmts) (Int -> T_PPS -> T_PPS
sem_PPS_Indent Int
spaces T_PPS
pPS) T_Frame
frame

---------------------- PPS -------------------------
-- semantic domains
type T_PPS =  T_Frame ->(T_Formats,T_Error,T_PH,T_PLL,T_PW)
-- funcs
sem_PPS_Empty :: T_PPS
sem_PPS_Empty :: T_PPS
sem_PPS_Empty T_Frame
lhs_frame =  ( (T_Formats
set_fmts_empty), Bool
False, Int
0, (Int
0), (Int
0) )
sem_PPS_Text ::String -> T_PPS
sem_PPS_Text :: String -> T_PPS
sem_PPS_Text String
string T_Frame
lhs_frame
 = let{ minw :: Int
minw = (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
string)
   ;    error :: Bool
error = (Int
minw Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
pw)
   ;    f :: T_Frame
f@(F Int
pw Int
_ ) = (T_Frame
lhs_frame)
   }in  ( (String -> Int -> Bool -> T_Formats
forall {p} {p}. String -> p -> p -> T_Formats
set_fmts_text String
string Int
minw Bool
error), Bool
error, (Int
1), (Int
minw), Int
minw )
sem_PPS_Indent ::Int -> T_PPS -> T_PPS
sem_PPS_Indent :: Int -> T_PPS -> T_PPS
sem_PPS_Indent Int
int T_PPS
pPS T_Frame
lhs_frame
 = let{ ( T_Formats
pPS_fmts, Bool
pPS_error, Int
pPS_maxh, Int
pPS_minll, Int
pPS_minw )  = T_PPS
pPS (Int -> T_Frame -> T_Frame
narrow_frame Int
int T_Frame
lhs_frame)
   ;    minw :: Int
minw = (Int
int Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
pPS_minw)
   ;    f :: T_Frame
f@(F Int
pw Int
_ ) = (T_Frame
lhs_frame)
   }in  ( (Int -> T_Formats -> Int -> Int -> T_Frame -> Bool -> T_Formats
forall {p} {p}.
Int -> T_Formats -> p -> p -> T_Frame -> Bool -> T_Formats
set_fmts_indent Int
int T_Formats
pPS_fmts Int
pw Int
minw T_Frame
lhs_frame Bool
pPS_error)
        , ([Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [Int
int Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0, Int
int Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
pw, Bool
pPS_error])
        , Int
pPS_maxh
        , (Int
int Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
pPS_minll)
        , (Int
minw)
        )
sem_PPS_Beside :: T_PPS -> T_PPS -> T_PPS
sem_PPS_Beside :: T_PPS -> T_PPS -> T_PPS
sem_PPS_Beside T_PPS
left T_PPS
right T_Frame
lhs_frame
 = let{ ( T_Formats
left_fmts, Bool
left_error, Int
left_maxh, Int
left_minll, Int
left_minw )  = T_PPS
left (Int -> T_Frame -> T_Frame
narrow_ll Int
right_minw T_Frame
lhs_frame)
   ;    ( T_Formats
right_fmts, Bool
right_error, Int
right_maxh, Int
right_minll, Int
right_minw )  = T_PPS
right (Int -> T_Frame -> T_Frame
narrow_frame Int
left_minll T_Frame
lhs_frame)
   ;    error :: Bool
error = (Bool
left_error Bool -> Bool -> Bool
|| Bool
right_error)
   ;    fe :: (T_Formats, Bool)
fe@(T_Formats
bfmts,Bool
berror) = (T_Formats
-> T_Formats -> Int -> Int -> T_Frame -> Bool -> (T_Formats, Bool)
forall {p} {p}.
(Eq p, Eq p, Num p, Num p) =>
T_Formats
-> T_Formats -> p -> p -> T_Frame -> Bool -> (T_Formats, Bool)
set_fmts_beside T_Formats
left_fmts T_Formats
right_fmts Int
left_maxh Int
right_maxh T_Frame
lhs_frame Bool
error)
   }in  ( (T_Formats
bfmts)
        , (Bool
error Bool -> Bool -> Bool
|| Bool
berror)
        , (Int -> Int -> Int
forall {a}. (Num a, Eq a) => a -> a -> a
beside_height Int
left_maxh Int
right_maxh)
        , (Int
left_minll Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
right_minll)
        , (Int
left_minw Int -> Int -> Int
forall a. Ord a => a -> a -> a
`max` (Int
left_minll Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
right_minw))
        )
sem_PPS_Above :: T_PPS -> T_PPS -> T_PPS
sem_PPS_Above :: T_PPS -> T_PPS -> T_PPS
sem_PPS_Above T_PPS
upper T_PPS
lower T_Frame
lhs_frame
 = let{ ( T_Formats
upper_fmts, Bool
upper_error, Int
upper_maxh, Int
upper_minll, Int
upper_minw )  = T_PPS
upper T_Frame
lhs_frame
   ;    ( T_Formats
lower_fmts, Bool
lower_error, Int
lower_maxh, Int
lower_minll, Int
lower_minw )  = T_PPS
lower T_Frame
lhs_frame
   ;    fe :: (T_Formats, Bool)
fe@(T_Formats
afmts,Bool
aerror) = (T_Formats -> T_Formats -> Int -> Int -> (T_Formats, Bool)
forall {p} {p}.
(Eq p, Eq p, Num p, Num p) =>
T_Formats -> T_Formats -> p -> p -> (T_Formats, Bool)
set_fmts_above T_Formats
upper_fmts T_Formats
lower_fmts Int
upper_maxh Int
lower_maxh)
   }in  ( (T_Formats
afmts)
        , ([Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [Bool
lower_error, Bool
upper_error, Bool
aerror])
        , Int
upper_maxh Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
lower_maxh
        , (Int
lower_minll)
        , (Int
upper_minw Int -> Int -> Int
forall a. Ord a => a -> a -> a
`max` Int
lower_minw)
        )
sem_PPS_Dup :: T_PPS -> T_PPS -> T_PPS
sem_PPS_Dup :: T_PPS -> T_PPS -> T_PPS
sem_PPS_Dup T_PPS
opta T_PPS
optb T_Frame
lhs_frame
 = let{ ( T_Formats
opta_fmts, Bool
opta_error, Int
opta_maxh, Int
opta_minll, Int
opta_minw )  = T_PPS
opta T_Frame
lhs_frame
   ;    ( T_Formats
optb_fmts, Bool
optb_error, Int
optb_maxh, Int
optb_minll, Int
optb_minw )  = T_PPS
optb T_Frame
lhs_frame
   ;    minw :: Int
minw = (Int
opta_minw Int -> Int -> Int
forall a. Ord a => a -> a -> a
`min` Int
optb_minw)
   ;    error :: Bool
error = (Bool
opta_error Bool -> Bool -> Bool
&& Bool
optb_error)
   }in  ( (T_Formats -> T_Formats -> Bool -> Bool -> Int -> T_Formats
forall {p}.
T_Formats -> T_Formats -> Bool -> Bool -> p -> T_Formats
sem_fmts_dup T_Formats
opta_fmts T_Formats
optb_fmts Bool
opta_error Bool
optb_error Int
minw)
        , (Bool
error)
        , (Int
opta_maxh Int -> Int -> Int
forall a. Ord a => a -> a -> a
`max` Int
optb_maxh)
        , (Int
opta_minll Int -> Int -> Int
forall a. Ord a => a -> a -> a
`min` Int
optb_minll)
        , (Int
minw)
        )
sem_PPS_Join :: T_PPS -> T_PPS
sem_PPS_Join :: T_PPS -> T_PPS
sem_PPS_Join T_PPS
pPS T_Frame
lhs_frame
 = let{ ( T_Formats
pPS_fmts, Bool
pPS_error, Int
pPS_maxh, Int
pPS_minll, Int
pPS_minw )  = T_PPS
pPS T_Frame
lhs_frame
   ;    fe :: (T_Formats, Bool)
fe@(T_Formats
jfmts,Bool
jerror) = (T_Formats -> Bool -> (T_Formats, Bool)
set_fmts_join T_Formats
pPS_fmts Bool
pPS_error)
   }in  ( (T_Formats
jfmts), (Bool
pPS_error Bool -> Bool -> Bool
|| Bool
jerror), Int
pPS_maxh, Int
pPS_minll, Int
pPS_minw )
sem_PPS_Apply :: T_PPC -> T_PPSArgs -> T_PPS
sem_PPS_Apply :: T_PPC -> T_PPSArgs -> T_PPS
sem_PPS_Apply T_PPC
pPC T_PPSArgs
pPSArgs T_Frame
lhs_frame
 = let{ ( T_Formats
pPC_fmts, Bool
pPC_error, Int
pPC_maxh, T_Reqs
pPC_reqs, Int
pPC_minll, Int
pPC_minw, Int
pPC_numpars )
         = T_PPC
pPC ([Bool]
pPSArgs_error) (T_Fmts
pPSArgs_fmts) T_Frame
lhs_frame (T_Mins
pPSArgs_mins)
   ;    ( [Bool]
pPSArgs_error, T_Fmts
pPSArgs_fmts, T_Mins
pPSArgs_mins, Int
pPSArgs_len )  = T_PPSArgs
pPSArgs T_Reqs
pPC_reqs
   ;    error :: Bool
error = (Bool -> Bool -> Bool -> Bool
forall {p}. Bool -> p -> p -> p
set_var_apply Bool
error_cond Bool
True Bool
pPC_error)
   ;    error_cond :: Bool
error_cond = (Int
pPC_numpars Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
pPSArgs_len)
   ;    lem :: Int
lem = (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
error_msg)
   ;    error_msg :: String
error_msg = (Int -> Int -> String
forall {a} {a}. (Show a, Show a) => a -> a -> String
set_error_msg Int
pPC_numpars Int
pPSArgs_len)
   }in  ( (Bool -> T_Formats -> T_Formats -> T_Formats
forall {p}. Bool -> p -> p -> p
set_fmts_apply Bool
error_cond (Formats -> T_Formats
AFormat (Formats -> T_Formats)
-> (String -> Formats) -> String -> T_Formats
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Formats
text_fmts (String -> T_Formats) -> String -> T_Formats
forall a b. (a -> b) -> a -> b
$ String
error_msg) T_Formats
pPC_fmts)
        , (Bool
error)
        , (Bool -> Int -> Int -> Int
forall {p}. Bool -> p -> p -> p
set_var_apply Bool
error_cond Int
1 Int
pPC_maxh)
        , (Bool -> Int -> Int -> Int
forall {p}. Bool -> p -> p -> p
set_var_apply Bool
error_cond Int
lem Int
pPC_minll)
        , (Bool -> Int -> Int -> Int
forall {p}. Bool -> p -> p -> p
set_var_apply Bool
error_cond Int
lem Int
pPC_minw)
        )
sem_PPS_Fill :: T_FillList -> T_PPS
sem_PPS_Fill :: T_FillList -> T_PPS
sem_PPS_Fill T_FillList
fillList T_Frame
lhs_frame
 = let{ ( Formats
fillList_fmts, Bool
fillList_error, Int
fillList_maxh, Int
fillList_minw, Int
fillList_minll )
         = T_FillList
fillList (Formats
empty_fmts) (Bool
False) (Int
0) (Int
0) (Int
0) (Int -> Int -> T_Frame
F Int
w Int
w) (Int
w)
   ;    f :: T_Frame
f@(F Int
w Int
_ ) = (T_Frame
lhs_frame)
   }in  ( (Formats -> T_Formats
AFormat Formats
fillList_fmts), Bool
fillList_error, Int
fillList_maxh, Int
fillList_minll, Int
fillList_minw )
sem_PPS_FillBlock ::Int -> T_FillList -> T_PPS
sem_PPS_FillBlock :: Int -> T_FillList -> T_PPS
sem_PPS_FillBlock Int
int T_FillList
fillList T_Frame
lhs_frame
 = let{ ( Formats
fillList_fmts, Bool
fillList_error, Int
fillList_maxh, Int
fillList_minw, Int
fillList_minll )
         = T_FillList
fillList (Formats
empty_fmts) (Bool
False) (Int
0) (Int
0) (Int
0) (T_Frame
f_frame) (Int
f_width)
   ;    f :: T_Frame
f@(F Int
w Int
_ ) = (T_Frame
lhs_frame)
   ;    f_width :: Int
f_width = (if Int
int Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
w then Int
w else Int
int)
   ;    f_frame :: T_Frame
f_frame = (if Int
int Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
w then T_Frame
lhs_frame else (Int -> Int -> T_Frame
F Int
int Int
int))
   ;    error :: Bool
error = ([Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [Int
int Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0, Bool
fillList_error])
   }in  ( (Int -> Formats -> T_Formats
forall {a}. (Ord a, Num a) => a -> Formats -> T_Formats
set_fmts_fillblock Int
int Formats
fillList_fmts), (Bool
error), Int
fillList_maxh, Int
fillList_minll, Int
fillList_minw )
sem_PPS_Filt :: T_PPS -> T_PPS
sem_PPS_Filt :: T_PPS -> T_PPS
sem_PPS_Filt T_PPS
pPS T_Frame
lhs_frame
 = let{ ( T_Formats
pPS_fmts, Bool
pPS_error, Int
pPS_maxh, Int
pPS_minll, Int
pPS_minw )  = T_PPS
pPS T_Frame
lhs_frame
   ;    ef :: (T_Formats, Bool)
ef@(T_Formats
fmts,Bool
error) = (T_Formats -> Int -> (T_Formats, Bool)
forall {p}. T_Formats -> p -> (T_Formats, Bool)
set_fmts_filt T_Formats
pPS_fmts Int
pPS_minw)
   }in  ( (T_Formats
fmts), (Bool
error Bool -> Bool -> Bool
|| Bool
pPS_error), Int
pPS_maxh, Int
pPS_minll, Int
pPS_minw )
sem_PPS_Inv :: T_PPS -> T_PPS
sem_PPS_Inv :: T_PPS -> T_PPS
sem_PPS_Inv T_PPS
pPS T_Frame
lhs_frame
 = let{ ( T_Formats
pPS_fmts, Bool
pPS_error, Int
pPS_maxh, Int
pPS_minll, Int
pPS_minw )  = T_PPS
pPS (Int -> Int -> T_Frame
F Int
forall a. Bounded a => a
maxBound Int
forall a. Bounded a => a
maxBound)
   }in  ( (T_Formats -> T_Formats
set_fmts_inv T_Formats
pPS_fmts), (Bool
False), (Int
1), (Int
0), (Int
0) )
sem_PPS_Center :: T_CenterList -> T_PPS
sem_PPS_Center :: T_CenterList -> T_PPS
sem_PPS_Center T_CenterList
centerList T_Frame
lhs_frame
 = let{ ( Int
centerList_maxw, (T_Formats, Bool, Int, Int, Int)
centerList_fmts )  = T_CenterList
centerList (Int
centerList_maxw) (T_PPS
sem_PPS_Empty T_Frame
lhs_frame) T_Frame
lhs_frame
   ;    clf :: (T_Formats, Bool, Int, Int, Int)
clf@(T_Formats
fmts,Bool
error,Int
maxh,Int
minll,Int
minw) = ((T_Formats, Bool, Int, Int, Int)
centerList_fmts)
   }in  ( (T_Formats
fmts), (Bool
error), (Int
maxh), (Int
minll), (Int
minw) )
---------------------- PPC -------------------------
-- semantic domains
type T_PPC =  T_Errs -> T_Fmts -> T_Frame -> T_Mins ->
              (T_Formats,T_Error,T_PH,T_Reqs,T_PLL
              ,T_PW,Int)
-- funcs
sem_PPC_Indent ::Int -> T_PPC -> T_PPC
sem_PPC_Indent :: Int -> T_PPC -> T_PPC
sem_PPC_Indent Int
int T_PPC
pPC [Bool]
lhs_fillerrs T_Fmts
lhs_fillfmts T_Frame
lhs_frame T_Mins
lhs_fillmins
 = let{ ( T_Formats
pPC_fmts, Bool
pPC_error, Int
pPC_maxh, T_Reqs
pPC_reqs, Int
pPC_minll, Int
pPC_minw, Int
pPC_numpars )
         = T_PPC
pPC [Bool]
lhs_fillerrs T_Fmts
lhs_fillfmts (Int -> T_Frame -> T_Frame
narrow_frame Int
int T_Frame
lhs_frame) T_Mins
lhs_fillmins
   ;    minw :: Int
minw = (Int
int Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
pPC_minw)
   ;    f :: T_Frame
f@(F Int
pw Int
_ ) = (T_Frame
lhs_frame)
   }in  ( (Int -> T_Formats -> Int -> Int -> T_Frame -> Bool -> T_Formats
forall {p} {p}.
Int -> T_Formats -> p -> p -> T_Frame -> Bool -> T_Formats
set_fmts_indent Int
int T_Formats
pPC_fmts Int
pw Int
minw T_Frame
lhs_frame Bool
pPC_error)
        , ([Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [Int
int Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0, Int
int Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
pw, Bool
pPC_error])
        , Int
pPC_maxh
        , T_Reqs
pPC_reqs
        , (Int
int Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
pPC_minll)
        , (Int
minw)
        , Int
pPC_numpars
        )
sem_PPC_Beside :: T_PPC -> T_PPC -> T_PPC
sem_PPC_Beside :: T_PPC -> T_PPC -> T_PPC
sem_PPC_Beside T_PPC
left T_PPC
right [Bool]
lhs_fillerrs T_Fmts
lhs_fillfmts T_Frame
lhs_frame T_Mins
lhs_fillmins
 = let{ ( T_Formats
left_fmts, Bool
left_error, Int
left_maxh, T_Reqs
left_reqs, Int
left_minll, Int
left_minw, Int
left_numpars )
         = T_PPC
left ([Bool]
les) (T_Fmts
lfs) (Int -> T_Frame -> T_Frame
narrow_ll Int
right_minw T_Frame
lhs_frame) (T_Mins
lim)
   ;    ( T_Formats
right_fmts, Bool
right_error, Int
right_maxh, T_Reqs
right_reqs, Int
right_minll, Int
right_minw, Int
right_numpars )
         = T_PPC
right ([Bool]
res) (T_Fmts
rfs) (Int -> T_Frame -> T_Frame
narrow_frame Int
left_minll T_Frame
lhs_frame) (T_Mins
rim)
   ;    i :: (T_Mins, T_Mins)
i@(T_Mins
lim,T_Mins
rim) = (Int -> T_Mins -> (T_Mins, T_Mins)
forall a. Int -> [a] -> ([a], [a])
splitAt Int
left_numpars T_Mins
lhs_fillmins)
   ;    e :: ([Bool], [Bool])
e@([Bool]
les,[Bool]
res) = (Int -> [Bool] -> ([Bool], [Bool])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
left_numpars [Bool]
lhs_fillerrs)
   ;    m :: (T_Fmts, T_Fmts)
m@(T_Fmts
lfs,T_Fmts
rfs) = (Int -> T_Fmts -> (T_Fmts, T_Fmts)
forall a. Int -> [a] -> ([a], [a])
splitAt Int
left_numpars T_Fmts
lhs_fillfmts)
   ;    error :: Bool
error = (Bool
left_error Bool -> Bool -> Bool
|| Bool
right_error)
   ;    fe :: (T_Formats, Bool)
fe@(T_Formats
bfmts,Bool
berror) = (T_Formats
-> T_Formats -> Int -> Int -> T_Frame -> Bool -> (T_Formats, Bool)
forall {p} {p}.
(Eq p, Eq p, Num p, Num p) =>
T_Formats
-> T_Formats -> p -> p -> T_Frame -> Bool -> (T_Formats, Bool)
set_fmts_beside T_Formats
left_fmts T_Formats
right_fmts Int
left_maxh Int
right_maxh T_Frame
lhs_frame Bool
error)
   }in  ( (T_Formats
bfmts)
        , (Bool
error Bool -> Bool -> Bool
|| Bool
berror)
        , (Int -> Int -> Int
forall {a}. (Num a, Eq a) => a -> a -> a
beside_height Int
left_maxh Int
right_maxh)
        , T_Reqs
left_reqs T_Reqs -> T_Reqs -> T_Reqs
forall a. [a] -> [a] -> [a]
++ T_Reqs
right_reqs
        , (Int
left_minll Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
right_minll)
        , (Int
left_minw Int -> Int -> Int
forall a. Ord a => a -> a -> a
`max` (Int
left_minll Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
right_minw))
        , Int
left_numpars Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
right_numpars
        )
sem_PPC_Above :: T_PPC -> T_PPC -> T_PPC
sem_PPC_Above :: T_PPC -> T_PPC -> T_PPC
sem_PPC_Above T_PPC
upper T_PPC
lower [Bool]
lhs_fillerrs T_Fmts
lhs_fillfmts T_Frame
lhs_frame T_Mins
lhs_fillmins
 = let{ ( T_Formats
upper_fmts, Bool
upper_error, Int
upper_maxh, T_Reqs
upper_reqs, Int
upper_minll, Int
upper_minw, Int
upper_numpars )
         = T_PPC
upper ([Bool]
ues) (T_Fmts
ufs) T_Frame
lhs_frame (T_Mins
uim)
   ;    ( T_Formats
lower_fmts, Bool
lower_error, Int
lower_maxh, T_Reqs
lower_reqs, Int
lower_minll, Int
lower_minw, Int
lower_numpars )
         = T_PPC
lower ([Bool]
les) (T_Fmts
lfs) T_Frame
lhs_frame (T_Mins
lim)
   ;    i :: (T_Mins, T_Mins)
i@(T_Mins
uim,T_Mins
lim) = (Int -> T_Mins -> (T_Mins, T_Mins)
forall a. Int -> [a] -> ([a], [a])
splitAt Int
upper_numpars T_Mins
lhs_fillmins)
   ;    e :: ([Bool], [Bool])
e@([Bool]
ues,[Bool]
les) = (Int -> [Bool] -> ([Bool], [Bool])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
upper_numpars [Bool]
lhs_fillerrs)
   ;    m :: (T_Fmts, T_Fmts)
m@(T_Fmts
ufs,T_Fmts
lfs) = (Int -> T_Fmts -> (T_Fmts, T_Fmts)
forall a. Int -> [a] -> ([a], [a])
splitAt Int
upper_numpars T_Fmts
lhs_fillfmts)
   ;    fe :: (T_Formats, Bool)
fe@(T_Formats
afmts,Bool
aerror) = (T_Formats -> T_Formats -> Int -> Int -> (T_Formats, Bool)
forall {p} {p}.
(Eq p, Eq p, Num p, Num p) =>
T_Formats -> T_Formats -> p -> p -> (T_Formats, Bool)
set_fmts_above T_Formats
upper_fmts T_Formats
lower_fmts Int
upper_maxh Int
lower_maxh)
   }in  ( (T_Formats
afmts)
        , ([Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [Bool
lower_error, Bool
upper_error, Bool
aerror])
        , (Int
upper_maxh Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
lower_maxh)
        , T_Reqs
upper_reqs T_Reqs -> T_Reqs -> T_Reqs
forall a. [a] -> [a] -> [a]
++ T_Reqs
lower_reqs
        , Int
lower_minll
        , (Int
upper_minw Int -> Int -> Int
forall a. Ord a => a -> a -> a
`max` Int
lower_minw)
        , Int
upper_numpars Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
lower_numpars
        )
sem_PPC_Dup :: T_PPC -> T_PPC -> T_PPC
sem_PPC_Dup :: T_PPC -> T_PPC -> T_PPC
sem_PPC_Dup T_PPC
opta T_PPC
optb [Bool]
lhs_fillerrs T_Fmts
lhs_fillfmts T_Frame
lhs_frame T_Mins
lhs_fillmins
 = let{ ( T_Formats
opta_fmts, Bool
opta_error, Int
opta_maxh, T_Reqs
opta_reqs, Int
opta_minll, Int
opta_minw, Int
opta_numpars )
         = T_PPC
opta [Bool]
lhs_fillerrs T_Fmts
lhs_fillfmts T_Frame
lhs_frame T_Mins
lhs_fillmins
   ;    ( T_Formats
optb_fmts, Bool
optb_error, Int
optb_maxh, T_Reqs
optb_reqs, Int
optb_minll, Int
optb_minw, Int
optb_numpars )
         = T_PPC
optb [Bool]
lhs_fillerrs T_Fmts
lhs_fillfmts T_Frame
lhs_frame T_Mins
lhs_fillmins
   ;    minw :: Int
minw = (Int
opta_minw Int -> Int -> Int
forall a. Ord a => a -> a -> a
`min` Int
optb_minw)
   ;    error :: Bool
error = ([Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [Int
opta_numpars Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
optb_numpars, Bool
opta_error Bool -> Bool -> Bool
&& Bool
optb_error])
   ;    error_msg :: String
error_msg = (Int -> Int -> String
forall {a} {a}. (Show a, Show a) => a -> a -> String
set_error_msg' Int
opta_numpars Int
optb_numpars)
   }in  ( (T_Formats
-> T_Formats
-> Bool
-> Bool
-> Int
-> Int
-> Int
-> String
-> T_Formats
forall {a} {p}.
Eq a =>
T_Formats
-> T_Formats -> Bool -> Bool -> a -> a -> p -> String -> T_Formats
sem_fmts_cdup T_Formats
opta_fmts T_Formats
optb_fmts Bool
opta_error Bool
optb_error Int
opta_numpars Int
optb_numpars Int
minw String
error_msg)
        , (Bool
error)
        , (Int
opta_maxh Int -> Int -> Int
forall a. Ord a => a -> a -> a
`max` Int
optb_maxh)
        , ((T_Frame -> T_Frame -> T_Frame) -> T_Reqs -> T_Reqs -> T_Reqs
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith T_Frame -> T_Frame -> T_Frame
forall a. Ord a => a -> a -> a
max T_Reqs
opta_reqs T_Reqs
optb_reqs)
        , (Int
opta_minll Int -> Int -> Int
forall a. Ord a => a -> a -> a
`min` Int
optb_minll)
        , (Int
minw)
        , (Int
opta_numpars)
        )
sem_PPC_Join :: T_PPC -> T_PPC
sem_PPC_Join :: T_PPC -> T_PPC
sem_PPC_Join T_PPC
pPC [Bool]
lhs_fillerrs T_Fmts
lhs_fillfmts T_Frame
lhs_frame T_Mins
lhs_fillmins
 = let{ ( T_Formats
pPC_fmts, Bool
pPC_error, Int
pPC_maxh, T_Reqs
pPC_reqs, Int
pPC_minll, Int
pPC_minw, Int
pPC_numpars )
         = T_PPC
pPC [Bool]
lhs_fillerrs T_Fmts
lhs_fillfmts T_Frame
lhs_frame T_Mins
lhs_fillmins
   ;    fe :: (T_Formats, Bool)
fe@(T_Formats
jfmts,Bool
jerror) = (T_Formats -> Bool -> (T_Formats, Bool)
set_fmts_join T_Formats
pPC_fmts Bool
pPC_error)
   }in  ( (T_Formats
jfmts), (Bool
pPC_error Bool -> Bool -> Bool
|| Bool
jerror), Int
pPC_maxh, T_Reqs
pPC_reqs, Int
pPC_minll, Int
pPC_minw, Int
pPC_numpars )
sem_PPC_Par :: T_PPC
sem_PPC_Par :: T_PPC
sem_PPC_Par [Bool]
lhs_fillerrs T_Fmts
lhs_fillfmts T_Frame
lhs_frame T_Mins
lhs_fillmins
 = let{ m :: (Int, Int, Int)
m@(Int
minw,Int
minll,Int
maxh) = (T_Mins -> (Int, Int, Int)
forall a. [a] -> a
head T_Mins
lhs_fillmins)
   ;    error :: Bool
error = ([Bool] -> Bool
forall a. [a] -> a
head [Bool]
lhs_fillerrs)
   ;    fmts :: T_Formats
fmts = (T_Fmts -> T_Formats
forall a. [a] -> a
head T_Fmts
lhs_fillfmts)
   }in  ( T_Formats
fmts, Bool
error, Int
maxh, ([T_Frame
lhs_frame]), Int
minll, Int
minw, Int
1 )
sem_PPC_Apply :: T_PPC -> T_PPCArgs -> T_PPC
sem_PPC_Apply :: T_PPC -> T_PPCArgs -> T_PPC
sem_PPC_Apply T_PPC
pPC T_PPCArgs
pPCArgs [Bool]
lhs_fillerrs T_Fmts
lhs_fillfmts T_Frame
lhs_frame T_Mins
lhs_fillmins
 = let{ ( T_Formats
pPC_fmts, Bool
pPC_error, Int
pPC_maxh, T_Reqs
pPC_reqs, Int
pPC_minll, Int
pPC_minw, Int
pPC_numpars )
         = T_PPC
pPC ([Bool]
pPCArgs_error) (T_Fmts
pPCArgs_fmts) (T_Frame
lhs_frame) (T_Mins
pPCArgs_ofillmins)
   ;    ( [Bool]
pPCArgs_error, T_Fmts
pPCArgs_fmts, T_Reqs
pPCArgs_reqs, T_Mins
pPCArgs_ofillmins, Int
pPCArgs_numpars, Int
pPCArgs_len )
         = T_PPCArgs
pPCArgs ([Bool]
lhs_fillerrs) (T_Fmts
lhs_fillfmts) (T_Reqs
pPC_reqs) (T_Mins
lhs_fillmins)
   ;    error :: Bool
error = (Bool -> Bool -> Bool -> Bool
forall {p}. Bool -> p -> p -> p
set_var_apply Bool
error_cond Bool
True Bool
pPC_error)
   ;    error_cond :: Bool
error_cond = (Int
pPC_numpars Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
pPCArgs_len)
   ;    lem :: Int
lem = (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
error_msg)
   ;    error_msg :: String
error_msg = (Int -> Int -> String
forall {a} {a}. (Show a, Show a) => a -> a -> String
set_error_msg Int
pPC_numpars Int
pPCArgs_len)
   }in  ( (Bool -> T_Formats -> T_Formats -> T_Formats
forall {p}. Bool -> p -> p -> p
set_fmts_apply Bool
error_cond (Formats -> T_Formats
AFormat (Formats -> T_Formats)
-> (String -> Formats) -> String -> T_Formats
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Formats
text_fmts (String -> T_Formats) -> String -> T_Formats
forall a b. (a -> b) -> a -> b
$ String
error_msg) T_Formats
pPC_fmts)
        , (Bool
error)
        , (Bool -> Int -> Int -> Int
forall {p}. Bool -> p -> p -> p
set_var_apply Bool
error_cond Int
1 Int
pPC_maxh)
        , (T_Reqs
pPCArgs_reqs)
        , (Bool -> Int -> Int -> Int
forall {p}. Bool -> p -> p -> p
set_var_apply Bool
error_cond Int
lem Int
pPC_minll)
        , (Bool -> Int -> Int -> Int
forall {p}. Bool -> p -> p -> p
set_var_apply Bool
error_cond Int
lem Int
pPC_minw)
        , (Int
pPCArgs_numpars)
        )
sem_PPC_Pps :: T_PPS -> T_PPC
sem_PPC_Pps :: T_PPS -> T_PPC
sem_PPC_Pps T_PPS
pPS [Bool]
lhs_fillerrs T_Fmts
lhs_fillfmts T_Frame
lhs_frame T_Mins
lhs_fillmins
 = let{ ( T_Formats
pPS_fmts, Bool
pPS_error, Int
pPS_maxh, Int
pPS_minll, Int
pPS_minw )  = T_PPS
pPS T_Frame
lhs_frame
   }in  ( T_Formats
pPS_fmts, Bool
pPS_error, Int
pPS_maxh, ([]), Int
pPS_minll, Int
pPS_minw, (Int
0) )
sem_PPC_Filt :: T_PPC -> T_PPC
sem_PPC_Filt :: T_PPC -> T_PPC
sem_PPC_Filt T_PPC
pPC [Bool]
lhs_fillerrs T_Fmts
lhs_fillfmts T_Frame
lhs_frame T_Mins
lhs_fillmins
 = let{ ( T_Formats
pPC_fmts, Bool
pPC_error, Int
pPC_maxh, T_Reqs
pPC_reqs, Int
pPC_minll, Int
pPC_minw, Int
pPC_numpars )
         = T_PPC
pPC [Bool]
lhs_fillerrs T_Fmts
lhs_fillfmts T_Frame
lhs_frame T_Mins
lhs_fillmins
   ;    ef :: (T_Formats, Bool)
ef@(T_Formats
fmts,Bool
error) = (T_Formats -> Int -> (T_Formats, Bool)
forall {p}. T_Formats -> p -> (T_Formats, Bool)
set_fmts_filt T_Formats
pPC_fmts Int
pPC_minw)
   }in  ( (T_Formats
fmts), (Bool
error Bool -> Bool -> Bool
|| Bool
pPC_error), Int
pPC_maxh, T_Reqs
pPC_reqs, Int
pPC_minll, Int
pPC_minw, Int
pPC_numpars )
---------------------- PPSArgs -------------------------
-- semantic domains
type T_PPSArgs =  T_Reqs ->(T_Errs,T_Fmts,T_Mins,Int)
-- funcs
sem_PPSArgs_Nil :: T_PPSArgs
sem_PPSArgs_Nil :: T_PPSArgs
sem_PPSArgs_Nil T_Reqs
lhs_reqs =  ( ([]), ([]), ([]), (Int
0) )
sem_PPSArgs_Cons :: T_PPS -> T_PPSArgs -> T_PPSArgs
sem_PPSArgs_Cons :: T_PPS -> T_PPSArgs -> T_PPSArgs
sem_PPSArgs_Cons T_PPS
pPS T_PPSArgs
pPSArgs T_Reqs
lhs_reqs
 = let{ ( T_Formats
pPS_fmts, Bool
pPS_error, Int
pPS_maxh, Int
pPS_minll, Int
pPS_minw )  = T_PPS
pPS (T_Reqs -> T_Frame
forall a. [a] -> a
head T_Reqs
lhs_reqs)
   ;    ( [Bool]
pPSArgs_error, T_Fmts
pPSArgs_fmts, T_Mins
pPSArgs_mins, Int
pPSArgs_len )  = T_PPSArgs
pPSArgs (T_Reqs -> T_Reqs
forall a. [a] -> [a]
tail T_Reqs
lhs_reqs)
   }in  ( (Bool
pPS_errorBool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
:[Bool]
pPSArgs_error), (T_Formats
pPS_fmtsT_Formats -> T_Fmts -> T_Fmts
forall a. a -> [a] -> [a]
:T_Fmts
pPSArgs_fmts), ((Int
pPS_minw ,Int
pPS_minll, Int
pPS_maxh)(Int, Int, Int) -> T_Mins -> T_Mins
forall a. a -> [a] -> [a]
:T_Mins
pPSArgs_mins), (Int
pPSArgs_len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) )
---------------------- PPCArgs -------------------------
-- semantic domains
type T_PPCArgs =  T_Errs -> T_Fmts -> T_Reqs -> T_Mins ->(T_Errs,T_Fmts,T_Reqs,T_Mins,Int,Int)
-- funcs
sem_PPCArgs_Nil :: T_PPCArgs
sem_PPCArgs_Nil :: T_PPCArgs
sem_PPCArgs_Nil [Bool]
lhs_ifillerrs T_Fmts
lhs_ifillfmts T_Reqs
lhs_ireqs T_Mins
lhs_ifillmins =  ( ([]), ([]), [], ([]), Int
0, (Int
0) )
sem_PPCArgs_Cons :: T_PPC -> T_PPCArgs -> T_PPCArgs
sem_PPCArgs_Cons :: T_PPC -> T_PPCArgs -> T_PPCArgs
sem_PPCArgs_Cons T_PPC
pPC T_PPCArgs
pPCArgs [Bool]
lhs_ifillerrs T_Fmts
lhs_ifillfmts T_Reqs
lhs_ireqs T_Mins
lhs_ifillmins
 = let{ ( T_Formats
pPC_fmts, Bool
pPC_error, Int
pPC_maxh, T_Reqs
pPC_reqs, Int
pPC_minll, Int
pPC_minw, Int
pPC_numpars )  = T_PPC
pPC ([Bool]
pef) (T_Fmts
pff) (T_Reqs -> T_Frame
forall a. [a] -> a
head T_Reqs
lhs_ireqs) (T_Mins
pim)
   ;    ( [Bool]
pPCArgs_error, T_Fmts
pPCArgs_fmts, T_Reqs
pPCArgs_reqs, T_Mins
pPCArgs_ofillmins, Int
pPCArgs_numpars, Int
pPCArgs_len )
         = T_PPCArgs
pPCArgs ([Bool]
lef) (T_Fmts
lff) (T_Reqs -> T_Reqs
forall a. [a] -> [a]
tail T_Reqs
lhs_ireqs) (T_Mins
lim)
   ;    i :: (T_Mins, T_Mins)
i@(T_Mins
pim,T_Mins
lim) = (Int -> T_Mins -> (T_Mins, T_Mins)
forall a. Int -> [a] -> ([a], [a])
splitAt Int
pPC_numpars T_Mins
lhs_ifillmins)
   ;    e :: ([Bool], [Bool])
e@([Bool]
pef,[Bool]
lef) = (Int -> [Bool] -> ([Bool], [Bool])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
pPC_numpars [Bool]
lhs_ifillerrs)
   ;    m :: (T_Fmts, T_Fmts)
m@(T_Fmts
pff,T_Fmts
lff) = (Int -> T_Fmts -> (T_Fmts, T_Fmts)
forall a. Int -> [a] -> ([a], [a])
splitAt Int
pPC_numpars T_Fmts
lhs_ifillfmts)
   }in  ( (Bool
pPC_errorBool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
:[Bool]
pPCArgs_error)
        , (T_Formats
pPC_fmtsT_Formats -> T_Fmts -> T_Fmts
forall a. a -> [a] -> [a]
:T_Fmts
pPCArgs_fmts)
        , T_Reqs
pPC_reqs T_Reqs -> T_Reqs -> T_Reqs
forall a. [a] -> [a] -> [a]
++ T_Reqs
pPCArgs_reqs
        , ((Int
pPC_minw ,Int
pPC_minll,Int
pPC_maxh)(Int, Int, Int) -> T_Mins -> T_Mins
forall a. a -> [a] -> [a]
:T_Mins
pPCArgs_ofillmins)
        , Int
pPC_numpars Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
pPCArgs_numpars
        , (Int
pPCArgs_len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
        )
---------------------- FillList -------------------------
-- semantic domains
type T_FillList =  Formats -> T_Error -> T_PH -> T_PW -> T_PLL -> T_Frame -> T_PW ->(Formats,T_Error,T_PH,T_PW,T_PLL)
-- funcs
sem_FillList_Nil :: T_FillList
sem_FillList_Nil :: T_FillList
sem_FillList_Nil Formats
lhs_fmts Bool
lhs_error Int
lhs_maxh Int
lhs_minw Int
lhs_minll T_Frame
lhs_frame Int
lhs_pw
 =  ( Formats
lhs_fmts, Bool
lhs_error, Int
lhs_maxh, Int
lhs_minw, Int
lhs_minll )
sem_FillList_Cons :: T_PPS -> T_FillList -> T_FillList
sem_FillList_Cons :: T_PPS -> T_FillList -> T_FillList
sem_FillList_Cons T_PPS
pPS T_FillList
fillList Formats
lhs_fmts Bool
lhs_error Int
lhs_maxh Int
lhs_minw Int
lhs_minll T_Frame
lhs_frame Int
lhs_pw
 = let{ ( T_Formats
pPS_fmts, Bool
pPS_error, Int
pPS_maxh, Int
pPS_minll, Int
pPS_minw )  = T_PPS
pPS (T_Frame
lhs_frame)
   ;    ( Formats
fillList_fmts, Bool
fillList_error, Int
fillList_maxh, Int
fillList_minw, Int
fillList_minll )
         = T_FillList
fillList (Formats
ffmts)
                    (Bool
lhs_error Bool -> Bool -> Bool
|| Bool
ferror)
                    (Int -> Int -> Bool -> Int
forall {a} {p}. (Ord a, Num p, Num a, Eq p) => a -> p -> Bool -> p
cons_height Int
pPS_maxh Int
lhs_maxh Bool
avail)
                    (if (Bool -> Bool
not Bool
avail) Bool -> Bool -> Bool
|| (Int
lhs_minw Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
lhs_pw) then Int
lhs_pw else Int
lhs_minll)
                    (if Bool
ferror then Int
lhs_pw Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 else if Bool
avail then Int
newll else Int
pPS_minw)
                    T_Frame
lhs_frame
                    Int
lhs_pw
   ;    avail :: Bool
avail = (Int
lhs_pw Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
newll Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0)
   ;    newll :: Int
newll = (Int
lhs_minll Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
pPS_minw)
   ;    fe :: (Formats, Bool)
fe@(Formats
ffmts,Bool
ferror) = (Formats
-> T_Formats -> Int -> Int -> T_Frame -> Bool -> (Formats, Bool)
forall {a} {a}.
(Ord a, Eq a, Num a, Num a) =>
Formats
-> T_Formats -> a -> a -> T_Frame -> Bool -> (Formats, Bool)
set_fmts_filllist Formats
lhs_fmts T_Formats
pPS_fmts Int
lhs_maxh Int
pPS_maxh T_Frame
lhs_frame Bool
avail)
   }in  ( Formats
fillList_fmts, (Bool
fillList_error Bool -> Bool -> Bool
|| Bool
pPS_error), Int
fillList_maxh, Int
fillList_minw, Int
fillList_minll )
---------------------- Root -------------------------
-- semantic domains
type T_Root =  T_PW ->String
-- funcs
sem_Root_Best :: T_PPS -> T_Root
sem_Root_Best :: T_PPS -> Int -> String
sem_Root_Best T_PPS
pPS Int
lhs_pw
 = let{ ( T_Formats
pPS_fmts, Bool
pPS_error, Int
pPS_maxh, Int
pPS_minll, Int
pPS_minw )  = T_PPS
pPS (Int -> Int -> T_Frame
F Int
lhs_pw Int
lhs_pw)
   }in  (Formats -> String
best (Formats -> String)
-> (T_Formats -> Formats) -> T_Formats -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> T_Formats -> Formats
forall {a}. (Ord a, Num a) => a -> T_Formats -> Formats
set_fmts_render Int
lhs_pw (T_Formats -> String) -> T_Formats -> String
forall a b. (a -> b) -> a -> b
$ T_Formats
pPS_fmts)
sem_Root_All :: T_PPS -> T_Root
sem_Root_All :: T_PPS -> Int -> String
sem_Root_All T_PPS
pPS Int
lhs_pw
 = let{ ( T_Formats
pPS_fmts, Bool
pPS_error, Int
pPS_maxh, Int
pPS_minll, Int
pPS_minw )  = T_PPS
pPS (Int -> Int -> T_Frame
F Int
lhs_pw Int
lhs_pw)
   }in  (Formats -> String
allf (Formats -> String)
-> (T_Formats -> Formats) -> T_Formats -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> T_Formats -> Formats
forall {a}. (Ord a, Num a) => a -> T_Formats -> Formats
set_fmts_render Int
lhs_pw (T_Formats -> String) -> T_Formats -> String
forall a b. (a -> b) -> a -> b
$ T_Formats
pPS_fmts)
---------------------- Disp -------------------------
-- semantic domains
type T_Disp =  T_PW ->ShowS
-- funcs
sem_Disp_Disp :: T_PPS -> T_Disp
sem_Disp_Disp :: T_PPS -> Int -> ShowS
sem_Disp_Disp T_PPS
pPS Int
lhs_pw
 = let{ ( T_Formats
pPS_fmts, Bool
pPS_error, Int
pPS_maxh, Int
pPS_minll, Int
pPS_minw )  = T_PPS
pPS (Int -> Int -> T_Frame
F Int
lhs_pw Int
lhs_pw)
   }in  (Formats -> ShowS
dispf (Formats -> ShowS) -> (T_Formats -> Formats) -> T_Formats -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> T_Formats -> Formats
forall {a}. (Ord a, Num a) => a -> T_Formats -> Formats
set_fmts_render Int
lhs_pw (T_Formats -> ShowS) -> T_Formats -> ShowS
forall a b. (a -> b) -> a -> b
$ T_Formats
pPS_fmts)
---------------------- LiftS -------------------------
-- semantic domains
type T_LiftS =  T_Function -> T_Frame ->(T_Formats,T_Error,T_PH,T_PLL,T_PW)
-- funcs
sem_LiftS_Lift :: T_PPS -> T_LiftS
sem_LiftS_Lift :: T_PPS -> (T_Formats -> T_Formats) -> T_PPS
sem_LiftS_Lift T_PPS
pPS T_Formats -> T_Formats
lhs_f T_Frame
lhs_frame
 = let{ ( T_Formats
pPS_fmts, Bool
pPS_error, Int
pPS_maxh, Int
pPS_minll, Int
pPS_minw )  = T_PPS
pPS T_Frame
lhs_frame
   }in  ( (T_Formats -> T_Formats
lhs_f T_Formats
pPS_fmts), Bool
pPS_error, Int
pPS_maxh, Int
pPS_minll, Int
pPS_minw )
---------------------- LiftC -------------------------
-- funcs
sem_LiftC_Lift :: (p -> p -> p -> p -> (t, b, c, d, e, f, g))
-> (t -> a) -> p -> p -> p -> p -> (a, b, c, d, e, f, g)
sem_LiftC_Lift p -> p -> p -> p -> (t, b, c, d, e, f, g)
pPC t -> a
lhs_f p
lhs_fillerrs p
lhs_fillfmts p
lhs_frame p
lhs_fillmins
 = let{ ( t
pPC_fmts, b
pPC_error, c
pPC_maxh, d
pPC_reqs, e
pPC_minll, f
pPC_minw, g
pPC_numpars )
         = p -> p -> p -> p -> (t, b, c, d, e, f, g)
pPC p
lhs_fillerrs p
lhs_fillfmts p
lhs_frame p
lhs_fillmins
   }in  ( (t -> a
lhs_f t
pPC_fmts), b
pPC_error, c
pPC_maxh, d
pPC_reqs, e
pPC_minll, f
pPC_minw, g
pPC_numpars )
sem_LiftC_Pair :: (p -> p -> p -> p -> (a, Bool, c, d, e, f, g))
-> (a -> (a, Bool)) -> p -> p -> p -> p -> (a, Bool, c, d, e, f, g)
sem_LiftC_Pair p -> p -> p -> p -> (a, Bool, c, d, e, f, g)
pPC a -> (a, Bool)
lhs_f p
lhs_fillerrs p
lhs_fillfmts p
lhs_frame p
lhs_fillmins
 = let{ ( a
pPC_fmts, Bool
pPC_error, c
pPC_maxh, d
pPC_reqs, e
pPC_minll, f
pPC_minw, g
pPC_numpars )
         = p -> p -> p -> p -> (a, Bool, c, d, e, f, g)
pPC p
lhs_fillerrs p
lhs_fillfmts p
lhs_frame p
lhs_fillmins
   ;    fe :: (a, Bool)
fe@(a
fmts,Bool
error) = (a -> (a, Bool)
lhs_f a
pPC_fmts)
   }in  ( (a
fmts), (Bool
pPC_error Bool -> Bool -> Bool
|| Bool
error), c
pPC_maxh, d
pPC_reqs, e
pPC_minll, f
pPC_minw, g
pPC_numpars )
---------------------- CenterList -------------------------
-- semantic domains
type T_CenterList =  Int -> T_SynPPS -> T_Frame ->(Int,T_SynPPS)
-- funcs
sem_CenterList_Nil :: T_CenterList
sem_CenterList_Nil :: T_CenterList
sem_CenterList_Nil Int
lhs_maxw (T_Formats, Bool, Int, Int, Int)
lhs_fmts T_Frame
lhs_frame =  ( (Int
0), (T_Formats, Bool, Int, Int, Int)
lhs_fmts )
sem_CenterList_Cons :: T_PPS -> T_CenterList -> T_CenterList
sem_CenterList_Cons :: T_PPS -> T_CenterList -> T_CenterList
sem_CenterList_Cons T_PPS
pPS T_CenterList
centerList Int
lhs_maxw (T_Formats, Bool, Int, Int, Int)
lhs_fmts T_Frame
lhs_frame
 = let{ ( T_Formats
pPS_fmts, Bool
pPS_error, Int
pPS_maxh, Int
pPS_minll, Int
pPS_minw )  = T_PPS
pPS (T_Frame
lhs_frame)
   ;    ( Int
centerList_maxw, (T_Formats, Bool, Int, Int, Int)
centerList_fmts )  = T_CenterList
centerList Int
lhs_maxw ((T_Formats, Bool, Int, Int, Int) -> Int -> T_PPS -> T_PPS
vapp (T_Formats, Bool, Int, Int, Int)
lhs_fmts Int
spaces T_PPS
pPS T_Frame
lhs_frame) T_Frame
lhs_frame
   ;    spaces :: Int
spaces = ((Int
lhs_maxw Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
pPS_minw) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2)
   }in  ( (Int
pPS_minw Int -> Int -> Int
forall a. Ord a => a -> a -> a
`max` Int
centerList_maxw), (T_Formats, Bool, Int, Int, Int)
centerList_fmts )