    --  $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       = text . show

      ppList :: [a] -> PP_Doc
      ppList as = if null as
                  then empty
                  else foldr (>|<) empty . map pp $ as

    instance PP PP_Doc where
      pp     = id

    instance PP Char where
      pp c   = text [c]
      ppList = text

    instance PP a => PP [a] where
      pp = ppList

    instance Show PP_Doc where
      show p = disp p 200 ""

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

    empty :: PP_Doc
    empty = PPDoc sem_PPS_Empty

    text :: String -> PP_Doc
    text  = PPDoc . sem_PPS_Text

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

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

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

    fill :: PP a => [a] -> PP_Doc
    fill = PPDoc . sem_PPS_Fill . foldr fill_alg sem_FillList_Nil
      where fill_alg f
              = sem_FillList_Cons (case (pp f) of (PPDoc ppp) -> ppp)

    fillblock :: PP a => Int -> [a] -> PP_Doc
    fillblock i = PPDoc . sem_PPS_FillBlock i . foldr fill_alg sem_FillList_Nil
      where fill_alg f
              = sem_FillList_Cons (case (pp f) of (PPDoc ppp) -> ppp)

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

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

    join :: PP_Doc -> PP_Doc
    join (PPDoc d) = PPDoc . sem_PPS_Join $ d

    newtype PP_Exp = PPExp T_PPC

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

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

    ejoin :: PP_Exp -> PP_Exp
    ejoin (PPExp dc) = PPExp . sem_PPC_Join $ dc

    par :: PP_Exp
    par = PPExp sem_PPC_Par

    (>>$<) :: PP a => PP_Exp -> [a] -> PP_Doc
    (PPExp e) >>$< pl = PPDoc . sem_PPS_Apply e . foldr ppslist sem_PPSArgs_Nil $ pl
      where ppslist p = sem_PPSArgs_Cons (case (pp p) of (PPDoc ppp) -> ppp)

    (>>$<<) :: PP_Exp -> [PP_Exp] -> PP_Exp
    (PPExp e) >>$<< pl = PPExp . sem_PPC_Apply e . foldr ppclist sem_PPCArgs_Nil $ pl
      where ppclist (PPExp p) = sem_PPCArgs_Cons p

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

    render, renderAll   ::  PP_Doc -> Int -> IO ()
    render    (PPDoc fs)  =  putStr . sem_Root_Best fs
    renderAll (PPDoc fs)  =  putStr . sem_Root_All fs

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

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

    c2e :: PP a => a -> PP_Exp
    c2e s = let (PPDoc s') = pp s in PPExp . sem_PPC_Pps $ s'

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

    eelement_h1 :: PP_Exp -> PP_Exp
    eelement_h1 (PPExp pe) = PPExp . sem_PPC_Filt $ pe

    vcenter :: PP a => [ a ] -> PP_Doc
    vcenter = PPDoc . sem_PPS_Center . foldr center_alg sem_CenterList_Nil
      where center_alg f = sem_CenterList_Cons (case (pp f) of (PPDoc pf) -> pf)

    invisible :: PP_Doc -> PP_Doc
    invisible (PPDoc a) = PPDoc . sem_PPS_Inv $ a

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

    fpar, spar :: PP_Exp
    fpar = plift  first   par
    spar = plift  second  par

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

    -- Utilities

    lift :: (T_Formats -> T_Formats) -> PP_Doc -> PP_Doc
    lift f (PPDoc p) = PPDoc . sem_LiftS_Lift p $ f

    --elift :: (T_Formats -> T_Formats) -> T_PPC -> T_PPC
    elift f (PPExp e) = PPExp . sem_LiftC_Lift e $ f

    --plift :: (a -> b) -> T_PPC -> T_PPC
    plift f (PPExp e) = PPExp . sem_LiftC_Pair e $ 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 Eq

    instance Ord T_Frame where
      max x@(F w _) y@(F w' _)
        | w > w'    = x
        | otherwise = y

    empty_fmts ::Formats
    empty_fmts = []

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

    indent_fmts :: T_Frame -> Int -> Formats -> Formats
    indent_fmts (F pw _) i = map (indent_fmt i)
                           . dropWhile (notFits (pw - i))
    notFits delta e = total_w e > delta

    beside_fmts :: T_Frame -> Formats -> Formats -> Formats
    beside_fmts (F pw _) left  right
      = mergel [ map (l `beside_fmt`)
               . dropWhile (tooWide pw l)
               $ right
               | l <- left
               ]
    tooWide pw x y
      = (total_w x `max` (last_w x + total_w y)) > pw

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

    {- Pretty-printing with error correction -}

    error_indent :: Int -> Formats -> Formats
    error_indent i = map (indent_fmt i)

    error_beside :: Formats -> Formats -> Formats
    error_beside left right = mergel [ map (l `beside_fmt`) right
                                     | l <- left
                                     ]

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

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

    instance Eq Format  where
      x == y =  height x  == height y
             && total_w x == total_w y
             && last_w  x == last_w  y

    instance Ord Format where
      x <  y =  height x < height y
             || (  height x == height y
                && total_w x < total_w y )

    s2fmt     :: String -> Format
    s2fmt s   = Elem 1 l l (\_ -> (s++))
      where l = length s

    indent_fmt :: Int -> Format -> Format
    indent_fmt i   (Elem dh dl dw dt)
       = Elem dh (i + dl) (i + dw) (\n -> ((sp i) ++) . dt (i + n))

    above_fmt, beside_fmt :: Format -> Format -> Format
    (Elem uh ul uw ut) `above_fmt` (Elem lh ll lw lt)
      = Elem (uh + lh) ll (uw `max` lw)
             (make_ts_above ut lt)
      where make_ts_above ut lt = \n -> let nl_skip = (('\n':sp n)++)
                                        in  ut n . nl_skip . lt n
    (Elem lh ll lw lt) `beside_fmt` (Elem rh rl rw rt)
      = Elem (lh + rh - 1) (ll + rl)
             (lw `max` (ll + rw)) (\n -> lt n . rt (ll + n))

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

    best fs  = if null fs then "" else (txtstr . head $ fs) 0 ""
    allf     = concatMap (\fmt -> (txtstr fmt) 0 "\n\n")
    dispf fs = if null fs then id else (txtstr . head $ fs) 0

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

    merge []        ys        = ys
    merge xs        []        = xs
    merge xl@(x:xs) yl@(y:ys)
      | x == y    = x : merge xs ys
      | x <  y    = x : merge xs yl
      | otherwise = y : merge xl ys

    spaces = ' ':spaces
    sp n = if n >= 0 then take n spaces else ""

    mergel :: Ord a => [[a]] -> [a]
    mergel = foldr merge []

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

    narrow_frame i  (F s l) = F (s - i)  (l - i)
    narrow_ll    i  (F s l) = F s        (l - i)

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

    set_var_apply cond va vb = if cond then va else vb

    type T_Reqs  = [ T_Frame ]

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

    beside_height lh rh
      = lh + rh - if (lh == 0 || rh == 0) then 0 else 1

    cons_height pPh acth avail
      | acth == 0  = if pPh > 0 then 1 else 0
      | otherwise  = acth + if avail then 0 else 1

    type T_Error = Bool

    data T_Formats = AFormat   Formats
                   | TFormats  Formats  Formats  T_Error  T_Error

    afmt_txt = AFormat . text_fmts

    set_fmts_empty = AFormat empty_fmts

    set_fmts_text string minw error
      = afmt_txt string
      --(if error then (asts minw) else string)

    set_fmts_indent int fmts pw minw frame error
      | int < 0    = afmt_txt "<Error: negative indentation>"
     -- int > pw   = afmt_txt . asts $ minw
      | error      = set_fmts_indent' error_indent
      | otherwise  = set_fmts_indent' (indent_fmts frame)
      where set_fmts_indent' fmt_fc
              = case fmts of
                  AFormat fs -> AFormat (fmt_fc int fs)
                  TFormats as bs ae be
                             -> TFormats (fmt_fc int as)
                                         (fmt_fc int bs) ae be

    set_fmts_beside ls rs lh rh frame err
      = set_fmts_ab ls rs set_fmts_beside' "<Error: can't beside two pairs>"
      where set_fmts_beside' as bs
              = set_ab (lh == 0) (rh == 0) as bs
                   (if err then error_beside
                           else beside_fmts frame)

    set_fmts_above us ls uh lh
      = set_fmts_ab us ls set_fmts_above' "<Error: can't above two pairs>"
      where set_fmts_above' as bs = set_ab (uh == 0) (lh == 0) as bs above_fmts

    set_ab aempty bempty as bs fmt_fc
      = if aempty       {- left operand empty?  -}
        then bs
        else if bempty  {- right operand empty? -}
             then as
             else fmt_fc as bs

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

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

    set_fmts_join    (TFormats as bs ae be)  err
      = ( AFormat $ if be
                    then (if null as then bs else as)
                    else if ae
                         then (if null bs then as else bs)
                         else merge as bs
        , False
        )
    set_fmts_join fs@(AFormat _) err
      = if err then (fs, err)
               else (afmt_txt "<Error: can't join a single result>", True)

    set_fmts_apply True  a  _  =  a
    set_fmts_apply False _  b  =  b

    set_fmts_fillblock int fmts
      | int < 0     = afmt_txt "<Error: negative page width in fillblock>"
      | otherwise   = AFormat fmts

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

    set_error_msg' apars bpars
      =  "<Error: incorrect choice expression. #pars left " ++ show apars
      ++ " /= #pars right " ++ show bpars
      ++ ">"

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

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

    type T_Function = T_Formats -> T_Formats

    set_fmts_filt (AFormat  fs     ) minw
      = {-if null height1 then ( afmt_txt . asts $ minw , True  )
                        else-} ( AFormat height1        , False )
      where height1 = takeWhile ((<=1).height) fs
    set_fmts_filt _ _
      = ( afmt_txt $ "<Error: can not filter a pair>", True )

    set_fmts_inv fs
      = case fs of
          AFormat fmts         -> AFormat . set_inv $ fmts
          TFormats as bs ae be -> TFormats (set_inv as) (set_inv bs) ae be
      where set_inv = (:[]) . (Elem 1 0 0) . txtstr . head

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

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