-- This corresponds to src/comp/Pragma.hs in bsc.
module Language.Bluespec.Classic.AST.Pragma
  ( Pragma(..)
  , PProp(..)
  , RulePragma(..)
  , SchedulePragma(..)
  , CSchedulePragma
  , IfcPragma(..)

  , ppPProp
  ) where

import Text.PrettyPrint.HughesPJClass

import Language.Bluespec.Classic.AST.Id
import Language.Bluespec.Classic.AST.Position
import Language.Bluespec.Classic.AST.SchedInfo
import Language.Bluespec.Prelude
import Language.Bluespec.Pretty
import Language.Bluespec.Util

data Pragma
        = Pproperties Id [PProp]-- module Id and properties associate with
        | Pnoinline [Id]        -- [Id] is a list of functions which should not be inlined
        deriving (Pragma -> Pragma -> Bool
(Pragma -> Pragma -> Bool)
-> (Pragma -> Pragma -> Bool) -> Eq Pragma
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Pragma -> Pragma -> Bool
== :: Pragma -> Pragma -> Bool
$c/= :: Pragma -> Pragma -> Bool
/= :: Pragma -> Pragma -> Bool
Eq, Eq Pragma
Eq Pragma =>
(Pragma -> Pragma -> Ordering)
-> (Pragma -> Pragma -> Bool)
-> (Pragma -> Pragma -> Bool)
-> (Pragma -> Pragma -> Bool)
-> (Pragma -> Pragma -> Bool)
-> (Pragma -> Pragma -> Pragma)
-> (Pragma -> Pragma -> Pragma)
-> Ord Pragma
Pragma -> Pragma -> Bool
Pragma -> Pragma -> Ordering
Pragma -> Pragma -> Pragma
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Pragma -> Pragma -> Ordering
compare :: Pragma -> Pragma -> Ordering
$c< :: Pragma -> Pragma -> Bool
< :: Pragma -> Pragma -> Bool
$c<= :: Pragma -> Pragma -> Bool
<= :: Pragma -> Pragma -> Bool
$c> :: Pragma -> Pragma -> Bool
> :: Pragma -> Pragma -> Bool
$c>= :: Pragma -> Pragma -> Bool
>= :: Pragma -> Pragma -> Bool
$cmax :: Pragma -> Pragma -> Pragma
max :: Pragma -> Pragma -> Pragma
$cmin :: Pragma -> Pragma -> Pragma
min :: Pragma -> Pragma -> Pragma
Ord, Int -> Pragma -> ShowS
[Pragma] -> ShowS
Pragma -> String
(Int -> Pragma -> ShowS)
-> (Pragma -> String) -> ([Pragma] -> ShowS) -> Show Pragma
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Pragma -> ShowS
showsPrec :: Int -> Pragma -> ShowS
$cshow :: Pragma -> String
show :: Pragma -> String
$cshowList :: [Pragma] -> ShowS
showList :: [Pragma] -> ShowS
Show)

instance Pretty Pragma where
    pPrintPrec :: PrettyLevel -> Rational -> Pragma -> Doc
pPrintPrec PrettyLevel
d Rational
_p (Pproperties Id
i [PProp]
pps) =
        (String -> Doc
text String
"{-# properties" Doc -> Doc -> Doc
<+> PrettyLevel -> Id -> Doc
ppId PrettyLevel
d Id
i Doc -> Doc -> Doc
<+> String -> Doc
text String
"= { ") Doc -> Doc -> Doc
<>
          [Doc] -> Doc -> Doc
sepList ((PProp -> Doc) -> [PProp] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (PrettyLevel -> Rational -> PProp -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d Rational
0) [PProp]
pps) (String -> Doc
text String
",") Doc -> Doc -> Doc
<> String -> Doc
text String
" } #-}"
    pPrintPrec PrettyLevel
d Rational
_p (Pnoinline [Id]
is) =
        String -> Doc
text String
"{-# noinline" Doc -> Doc -> Doc
<+> [Doc] -> Doc
sep ((Id -> Doc) -> [Id] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (PrettyLevel -> Id -> Doc
ppId PrettyLevel
d) [Id]
is) Doc -> Doc -> Doc
<+> String -> Doc
text String
" #-}"

instance HasPosition Pragma where
    getPosition :: Pragma -> Position
getPosition (Pproperties Id
i [PProp]
_) = Id -> Position
forall a. HasPosition a => a -> Position
getPosition Id
i
    getPosition (Pnoinline (Id
i:[Id]
_)) = Id -> Position
forall a. HasPosition a => a -> Position
getPosition Id
i
    getPosition (Pnoinline [])    = String -> Position
forall a. HasCallStack => String -> a
error String
"HasPosition(Pragma).getPosition: Pnoinline []"

-- Module definition properties:
data PProp
        = PPverilog                        -- generate verilog
        | PPforeignImport Id               -- wrapper for a foreign import
            -- (Id is link name, needed for dependency check, if we're
            --  generating the .ba file for the link name, not the src name)
        | PPalwaysReady        [Longname]         -- no ready signals for these methods ([] means all)
        | PPalwaysEnabled [Longname]       -- execute on every cycle
        | PPenabledWhenReady [Longname]    -- enable is equivalent to ready
        | PPscanInsert Integer             -- insert scan chain ports
        | PPbitBlast                       -- do "bit blasting",
                                           --     e.g., split multibit ports
        | PPCLK String                     -- clock port prefix
        | PPGATE String                    -- gate port prefix
        | PPRSTN String                    -- reset port prefix
        | PPclock_osc  [(Id,String)]       -- port name for clock
        | PPclock_gate [(Id,String)]       -- port name for gate
        | PPgate_inhigh [Id]               -- clock args with inhigh gates
        | PPgate_unused [Id]               -- clock args with unused gates
        | PPreset_port [(Id,String)]       -- port name for reset
        | PParg_param [(Id,String)]        -- name for parameter argument
        | PParg_port [(Id,String)]         -- port name for other arguments
        | PParg_clocked_by [(Id,String)]   -- clocks of module arguments
        | PParg_reset_by [(Id,String)]     -- resets of module arguments
        | PPoptions [String]               -- compiler options
        | PPgate_input_clocks [Id]         -- list of clock args with gates
        | PPmethod_scheduling (MethodConflictInfo Longname)
                        -- scheduling constraints for interface arg methods
        | PPdoc String          -- comment to carry through to Verilog
        | PPperf_spec [[Id]]    -- method composition order for performance specs
        | PPclock_family    [Id]   -- ids of input clocks in the same family
        | PPclock_ancestors [[Id]] -- input clock ancestry sequences
        -- module arguments which should generate to params instead of ports
        | PPparam [Id]
        | PPinst_name Id
        | PPinst_hide
        | PPinst_hide_all
        | PPdeprecate String
      deriving (PProp -> PProp -> Bool
(PProp -> PProp -> Bool) -> (PProp -> PProp -> Bool) -> Eq PProp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PProp -> PProp -> Bool
== :: PProp -> PProp -> Bool
$c/= :: PProp -> PProp -> Bool
/= :: PProp -> PProp -> Bool
Eq, Eq PProp
Eq PProp =>
(PProp -> PProp -> Ordering)
-> (PProp -> PProp -> Bool)
-> (PProp -> PProp -> Bool)
-> (PProp -> PProp -> Bool)
-> (PProp -> PProp -> Bool)
-> (PProp -> PProp -> PProp)
-> (PProp -> PProp -> PProp)
-> Ord PProp
PProp -> PProp -> Bool
PProp -> PProp -> Ordering
PProp -> PProp -> PProp
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PProp -> PProp -> Ordering
compare :: PProp -> PProp -> Ordering
$c< :: PProp -> PProp -> Bool
< :: PProp -> PProp -> Bool
$c<= :: PProp -> PProp -> Bool
<= :: PProp -> PProp -> Bool
$c> :: PProp -> PProp -> Bool
> :: PProp -> PProp -> Bool
$c>= :: PProp -> PProp -> Bool
>= :: PProp -> PProp -> Bool
$cmax :: PProp -> PProp -> PProp
max :: PProp -> PProp -> PProp
$cmin :: PProp -> PProp -> PProp
min :: PProp -> PProp -> PProp
Ord, Int -> PProp -> ShowS
[PProp] -> ShowS
PProp -> String
(Int -> PProp -> ShowS)
-> (PProp -> String) -> ([PProp] -> ShowS) -> Show PProp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PProp -> ShowS
showsPrec :: Int -> PProp -> ShowS
$cshow :: PProp -> String
show :: PProp -> String
$cshowList :: [PProp] -> ShowS
showList :: [PProp] -> ShowS
Show)

instance Pretty PProp where
    pPrintPrec :: PrettyLevel -> Rational -> PProp -> Doc
pPrintPrec  PrettyLevel
d Rational
_ (PPscanInsert Integer
i) = String -> Doc
text String
"scanInsert = " Doc -> Doc -> Doc
<+> PrettyLevel -> Rational -> Integer -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d Rational
0 Integer
i
    pPrintPrec PrettyLevel
_d Rational
_ (PPCLK String
s) = String -> Doc
text (String
"clock_prefix = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s)
    pPrintPrec PrettyLevel
_d Rational
_ (PPGATE String
s) = String -> Doc
text (String
"gate_prefix = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s)
    pPrintPrec PrettyLevel
_d Rational
_ (PPRSTN String
s) = String -> Doc
text (String
"reset_prefix = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s)
    pPrintPrec  PrettyLevel
d Rational
_ (PPclock_osc [(Id, String)]
xs) =
        String -> Doc
text String
"clock_osc = {"
        Doc -> Doc -> Doc
<> [Doc] -> Doc -> Doc
sepList [ String -> Doc
text String
"(" Doc -> Doc -> Doc
<> PrettyLevel -> Id -> Doc
ppId PrettyLevel
d Id
i Doc -> Doc -> Doc
<> String -> Doc
text String
"," Doc -> Doc -> Doc
<> (String -> Doc
text String
s) Doc -> Doc -> Doc
<> String -> Doc
text String
")"
                   | (Id
i,String
s) <- [(Id, String)]
xs ]
                   (String -> Doc
text String
",")
        Doc -> Doc -> Doc
<> String -> Doc
text String
"}"
    pPrintPrec PrettyLevel
d Rational
_ (PPclock_gate [(Id, String)]
xs) =
        String -> Doc
text String
"clock_gate = {"
        Doc -> Doc -> Doc
<> [Doc] -> Doc -> Doc
sepList [ String -> Doc
text String
"(" Doc -> Doc -> Doc
<> PrettyLevel -> Id -> Doc
ppId PrettyLevel
d Id
i Doc -> Doc -> Doc
<> String -> Doc
text String
"," Doc -> Doc -> Doc
<> (String -> Doc
text String
s) Doc -> Doc -> Doc
<> String -> Doc
text String
")"
                   | (Id
i,String
s) <- [(Id, String)]
xs ]
                   (String -> Doc
text String
",")
        Doc -> Doc -> Doc
<> String -> Doc
text String
"}"
    pPrintPrec PrettyLevel
d Rational
_ (PPgate_inhigh [Id]
is) =
        String -> Doc
text String
"gate_inhigh = {" Doc -> Doc -> Doc
<> [Doc] -> Doc -> Doc
sepList ((Id -> Doc) -> [Id] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (PrettyLevel -> Id -> Doc
ppId PrettyLevel
d) [Id]
is) (String -> Doc
text String
",") Doc -> Doc -> Doc
<> String -> Doc
text String
"}"
    pPrintPrec PrettyLevel
d Rational
_ (PPgate_unused [Id]
is) =
        String -> Doc
text String
"gate_unused = {" Doc -> Doc -> Doc
<> [Doc] -> Doc -> Doc
sepList ((Id -> Doc) -> [Id] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (PrettyLevel -> Id -> Doc
ppId PrettyLevel
d) [Id]
is) (String -> Doc
text String
",") Doc -> Doc -> Doc
<> String -> Doc
text String
"}"
    pPrintPrec PrettyLevel
d Rational
_ (PPreset_port [(Id, String)]
xs) =
        String -> Doc
text String
"reset_port = {"
        Doc -> Doc -> Doc
<> [Doc] -> Doc -> Doc
sepList [ String -> Doc
text String
"(" Doc -> Doc -> Doc
<> PrettyLevel -> Id -> Doc
ppId PrettyLevel
d Id
i Doc -> Doc -> Doc
<> String -> Doc
text String
"," Doc -> Doc -> Doc
<> (String -> Doc
text String
s) Doc -> Doc -> Doc
<> String -> Doc
text String
")"
                   | (Id
i,String
s) <- [(Id, String)]
xs ]
                   (String -> Doc
text String
",")
        Doc -> Doc -> Doc
<> String -> Doc
text String
"}"
    pPrintPrec PrettyLevel
d Rational
_ (PParg_param [(Id, String)]
xs) =
        String -> Doc
text String
"arg_param = {"
        Doc -> Doc -> Doc
<> [Doc] -> Doc -> Doc
sepList [ String -> Doc
text String
"(" Doc -> Doc -> Doc
<> PrettyLevel -> Id -> Doc
ppId PrettyLevel
d Id
i Doc -> Doc -> Doc
<> String -> Doc
text String
"," Doc -> Doc -> Doc
<> (String -> Doc
text String
s) Doc -> Doc -> Doc
<> String -> Doc
text String
")"
                   | (Id
i,String
s) <- [(Id, String)]
xs ]
                   (String -> Doc
text String
",")
        Doc -> Doc -> Doc
<> String -> Doc
text String
"}"
    pPrintPrec PrettyLevel
d Rational
_ (PParg_port [(Id, String)]
xs) =
        String -> Doc
text String
"arg_port = {"
        Doc -> Doc -> Doc
<> [Doc] -> Doc -> Doc
sepList [ String -> Doc
text String
"(" Doc -> Doc -> Doc
<> PrettyLevel -> Id -> Doc
ppId PrettyLevel
d Id
i Doc -> Doc -> Doc
<> String -> Doc
text String
"," Doc -> Doc -> Doc
<> (String -> Doc
text String
s) Doc -> Doc -> Doc
<> String -> Doc
text String
")"
                   | (Id
i,String
s) <- [(Id, String)]
xs ]
                   (String -> Doc
text String
",")
        Doc -> Doc -> Doc
<> String -> Doc
text String
"}"
    pPrintPrec PrettyLevel
d Rational
_ (PParg_clocked_by [(Id, String)]
xs) =
        String -> Doc
text String
"clocked_by = {"
        Doc -> Doc -> Doc
<> [Doc] -> Doc -> Doc
sepList [ String -> Doc
text String
"(" Doc -> Doc -> Doc
<> PrettyLevel -> Id -> Doc
ppId PrettyLevel
d Id
i Doc -> Doc -> Doc
<> String -> Doc
text String
"," Doc -> Doc -> Doc
<> (String -> Doc
text String
s) Doc -> Doc -> Doc
<> String -> Doc
text String
")"
                   | (Id
i,String
s) <- [(Id, String)]
xs ]
                   (String -> Doc
text String
",")
        Doc -> Doc -> Doc
<> String -> Doc
text String
"}"
    pPrintPrec PrettyLevel
d Rational
_ (PParg_reset_by [(Id, String)]
xs) =
        String -> Doc
text String
"reset_by = {"
        Doc -> Doc -> Doc
<> [Doc] -> Doc -> Doc
sepList [ String -> Doc
text String
"(" Doc -> Doc -> Doc
<> PrettyLevel -> Id -> Doc
ppId PrettyLevel
d Id
i Doc -> Doc -> Doc
<> String -> Doc
text String
"," Doc -> Doc -> Doc
<> (String -> Doc
text String
s) Doc -> Doc -> Doc
<> String -> Doc
text String
")"
                   | (Id
i,String
s) <- [(Id, String)]
xs ]
                   (String -> Doc
text String
",")
        Doc -> Doc -> Doc
<> String -> Doc
text String
"}"
    pPrintPrec PrettyLevel
_d Rational
_ (PPoptions [String]
os) =
        String -> Doc
text String
"options = {"
        Doc -> Doc -> Doc
<> [Doc] -> Doc -> Doc
sepList ((String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Doc
text (String -> Doc) -> ShowS -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
forall a. Show a => a -> String
show) [String]
os) (String -> Doc
text String
",")
        Doc -> Doc -> Doc
<> String -> Doc
text String
"}"
    pPrintPrec PrettyLevel
_d Rational
_ (PPdoc String
comment) = String -> Doc
text (String
"doc = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
doubleQuote String
comment)
    pPrintPrec PrettyLevel
_d Rational
_ (PPdeprecate String
comment) = String -> Doc
text (String
"deprecate = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
doubleQuote String
comment)
    pPrintPrec PrettyLevel
_d Rational
_ (PProp
PPinst_hide) = String -> Doc
text String
"hide"
    pPrintPrec PrettyLevel
_d Rational
_p PProp
v = String -> Doc
text (Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
2 (PProp -> String
forall a. Show a => a -> String
show PProp
v))

ppPProp :: PDetail -> PProp -> Doc
ppPProp :: PrettyLevel -> PProp -> Doc
ppPProp PrettyLevel
d PProp
pprop = String -> Doc
text String
"{-#" Doc -> Doc -> Doc
<+> PrettyLevel -> Rational -> PProp -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d Rational
0 PProp
pprop Doc -> Doc -> Doc
<+> String -> Doc
text String
"#-};"

data RulePragma
    = RPfireWhenEnabled
    | RPnoImplicitConditions
    | RPaggressiveImplicitConditions
    | RPconservativeImplicitConditions
    | RPnoWarn -- suppress (on a per-rule basis) warnings G0023, G0036, and G0117
    | RPwarnAllConflicts
    | RPcanScheduleFirst
    | RPclockCrossingRule
    | RPdoc String  -- comment to carry through to Verilog
    | RPhide
      deriving (RulePragma -> RulePragma -> Bool
(RulePragma -> RulePragma -> Bool)
-> (RulePragma -> RulePragma -> Bool) -> Eq RulePragma
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RulePragma -> RulePragma -> Bool
== :: RulePragma -> RulePragma -> Bool
$c/= :: RulePragma -> RulePragma -> Bool
/= :: RulePragma -> RulePragma -> Bool
Eq, Eq RulePragma
Eq RulePragma =>
(RulePragma -> RulePragma -> Ordering)
-> (RulePragma -> RulePragma -> Bool)
-> (RulePragma -> RulePragma -> Bool)
-> (RulePragma -> RulePragma -> Bool)
-> (RulePragma -> RulePragma -> Bool)
-> (RulePragma -> RulePragma -> RulePragma)
-> (RulePragma -> RulePragma -> RulePragma)
-> Ord RulePragma
RulePragma -> RulePragma -> Bool
RulePragma -> RulePragma -> Ordering
RulePragma -> RulePragma -> RulePragma
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: RulePragma -> RulePragma -> Ordering
compare :: RulePragma -> RulePragma -> Ordering
$c< :: RulePragma -> RulePragma -> Bool
< :: RulePragma -> RulePragma -> Bool
$c<= :: RulePragma -> RulePragma -> Bool
<= :: RulePragma -> RulePragma -> Bool
$c> :: RulePragma -> RulePragma -> Bool
> :: RulePragma -> RulePragma -> Bool
$c>= :: RulePragma -> RulePragma -> Bool
>= :: RulePragma -> RulePragma -> Bool
$cmax :: RulePragma -> RulePragma -> RulePragma
max :: RulePragma -> RulePragma -> RulePragma
$cmin :: RulePragma -> RulePragma -> RulePragma
min :: RulePragma -> RulePragma -> RulePragma
Ord, Int -> RulePragma -> ShowS
[RulePragma] -> ShowS
RulePragma -> String
(Int -> RulePragma -> ShowS)
-> (RulePragma -> String)
-> ([RulePragma] -> ShowS)
-> Show RulePragma
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RulePragma -> ShowS
showsPrec :: Int -> RulePragma -> ShowS
$cshow :: RulePragma -> String
show :: RulePragma -> String
$cshowList :: [RulePragma] -> ShowS
showList :: [RulePragma] -> ShowS
Show)

-- used for classic printing of CSyntax
-- and by various internal dumps of ISyntax/ASyntax
instance Pretty RulePragma where
    pPrintPrec :: PrettyLevel -> Rational -> RulePragma -> Doc
pPrintPrec PrettyLevel
_d Rational
_p RulePragma
RPfireWhenEnabled = String -> Doc
text String
"{-# ASSERT fire when enabled #-}"
    pPrintPrec PrettyLevel
_d Rational
_p RulePragma
RPnoImplicitConditions =
        String -> Doc
text String
"{-# ASSERT no implicit conditions #-}"
    pPrintPrec PrettyLevel
_d Rational
_p RulePragma
RPcanScheduleFirst =
        String -> Doc
text String
"{-# ASSERT can schedule first #-}"
    pPrintPrec PrettyLevel
_d Rational
_p RulePragma
RPaggressiveImplicitConditions =
        String -> Doc
text String
"{-# aggressive_implicit_conditions #-}"
    pPrintPrec PrettyLevel
_d Rational
_p RulePragma
RPconservativeImplicitConditions =
        String -> Doc
text String
"{-# conservative_implicit_conditions #-}"
    pPrintPrec PrettyLevel
_d Rational
_p RulePragma
RPnoWarn =
        String -> Doc
text String
"{-# no_warn #-}"
    pPrintPrec PrettyLevel
_d Rational
_p RulePragma
RPwarnAllConflicts =
        String -> Doc
text String
"{-# warn_all_conflicts #-}"
    pPrintPrec PrettyLevel
_d Rational
_p RulePragma
RPclockCrossingRule =
        String -> Doc
text String
"{-# clock-crossing rule #-}"
    pPrintPrec PrettyLevel
_d Rational
_p (RPdoc String
comment) =
        String -> Doc
text (String
"{-# doc = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
doubleQuote String
comment String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" #-}")
    pPrintPrec PrettyLevel
_d Rational
_p RulePragma
RPhide =
        String -> Doc
text (String
"{-# hide #-}")

data SchedulePragma id_t
    = SPUrgency [id_t]
    | SPExecutionOrder [id_t]
    | SPMutuallyExclusive [[id_t]]
    | SPConflictFree [[id_t]]
    | SPPreempt [id_t] [id_t]
    | SPSchedule (MethodConflictInfo id_t)
      deriving (SchedulePragma id_t -> SchedulePragma id_t -> Bool
(SchedulePragma id_t -> SchedulePragma id_t -> Bool)
-> (SchedulePragma id_t -> SchedulePragma id_t -> Bool)
-> Eq (SchedulePragma id_t)
forall id_t.
Eq id_t =>
SchedulePragma id_t -> SchedulePragma id_t -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall id_t.
Eq id_t =>
SchedulePragma id_t -> SchedulePragma id_t -> Bool
== :: SchedulePragma id_t -> SchedulePragma id_t -> Bool
$c/= :: forall id_t.
Eq id_t =>
SchedulePragma id_t -> SchedulePragma id_t -> Bool
/= :: SchedulePragma id_t -> SchedulePragma id_t -> Bool
Eq, Eq (SchedulePragma id_t)
Eq (SchedulePragma id_t) =>
(SchedulePragma id_t -> SchedulePragma id_t -> Ordering)
-> (SchedulePragma id_t -> SchedulePragma id_t -> Bool)
-> (SchedulePragma id_t -> SchedulePragma id_t -> Bool)
-> (SchedulePragma id_t -> SchedulePragma id_t -> Bool)
-> (SchedulePragma id_t -> SchedulePragma id_t -> Bool)
-> (SchedulePragma id_t
    -> SchedulePragma id_t -> SchedulePragma id_t)
-> (SchedulePragma id_t
    -> SchedulePragma id_t -> SchedulePragma id_t)
-> Ord (SchedulePragma id_t)
SchedulePragma id_t -> SchedulePragma id_t -> Bool
SchedulePragma id_t -> SchedulePragma id_t -> Ordering
SchedulePragma id_t -> SchedulePragma id_t -> SchedulePragma id_t
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall id_t. Ord id_t => Eq (SchedulePragma id_t)
forall id_t.
Ord id_t =>
SchedulePragma id_t -> SchedulePragma id_t -> Bool
forall id_t.
Ord id_t =>
SchedulePragma id_t -> SchedulePragma id_t -> Ordering
forall id_t.
Ord id_t =>
SchedulePragma id_t -> SchedulePragma id_t -> SchedulePragma id_t
$ccompare :: forall id_t.
Ord id_t =>
SchedulePragma id_t -> SchedulePragma id_t -> Ordering
compare :: SchedulePragma id_t -> SchedulePragma id_t -> Ordering
$c< :: forall id_t.
Ord id_t =>
SchedulePragma id_t -> SchedulePragma id_t -> Bool
< :: SchedulePragma id_t -> SchedulePragma id_t -> Bool
$c<= :: forall id_t.
Ord id_t =>
SchedulePragma id_t -> SchedulePragma id_t -> Bool
<= :: SchedulePragma id_t -> SchedulePragma id_t -> Bool
$c> :: forall id_t.
Ord id_t =>
SchedulePragma id_t -> SchedulePragma id_t -> Bool
> :: SchedulePragma id_t -> SchedulePragma id_t -> Bool
$c>= :: forall id_t.
Ord id_t =>
SchedulePragma id_t -> SchedulePragma id_t -> Bool
>= :: SchedulePragma id_t -> SchedulePragma id_t -> Bool
$cmax :: forall id_t.
Ord id_t =>
SchedulePragma id_t -> SchedulePragma id_t -> SchedulePragma id_t
max :: SchedulePragma id_t -> SchedulePragma id_t -> SchedulePragma id_t
$cmin :: forall id_t.
Ord id_t =>
SchedulePragma id_t -> SchedulePragma id_t -> SchedulePragma id_t
min :: SchedulePragma id_t -> SchedulePragma id_t -> SchedulePragma id_t
Ord, Int -> SchedulePragma id_t -> ShowS
[SchedulePragma id_t] -> ShowS
SchedulePragma id_t -> String
(Int -> SchedulePragma id_t -> ShowS)
-> (SchedulePragma id_t -> String)
-> ([SchedulePragma id_t] -> ShowS)
-> Show (SchedulePragma id_t)
forall id_t. Show id_t => Int -> SchedulePragma id_t -> ShowS
forall id_t. Show id_t => [SchedulePragma id_t] -> ShowS
forall id_t. Show id_t => SchedulePragma id_t -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall id_t. Show id_t => Int -> SchedulePragma id_t -> ShowS
showsPrec :: Int -> SchedulePragma id_t -> ShowS
$cshow :: forall id_t. Show id_t => SchedulePragma id_t -> String
show :: SchedulePragma id_t -> String
$cshowList :: forall id_t. Show id_t => [SchedulePragma id_t] -> ShowS
showList :: [SchedulePragma id_t] -> ShowS
Show)

instance (Pretty t, Ord t) => Pretty (SchedulePragma t) where
    pPrintPrec :: PrettyLevel -> Rational -> SchedulePragma t -> Doc
pPrintPrec PrettyLevel
d Rational
p (SPUrgency [t]
ids) =
        String -> Doc
text String
"{-# ASSERT descending urgency: " Doc -> Doc -> Doc
<+>
            PrettyLevel -> Rational -> [t] -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d Rational
p [t]
ids Doc -> Doc -> Doc
<+> String -> Doc
text String
"#-}"
    pPrintPrec PrettyLevel
d Rational
p (SPExecutionOrder [t]
ids) =
        String -> Doc
text String
"{-# ASSERT execution order: " Doc -> Doc -> Doc
<+>
            PrettyLevel -> Rational -> [t] -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d Rational
p [t]
ids Doc -> Doc -> Doc
<+> String -> Doc
text String
"#-}"
    pPrintPrec PrettyLevel
d Rational
p (SPMutuallyExclusive [[t]]
idss) =
        String -> Doc
text String
"{-# ASSERT mutually exclusive: " Doc -> Doc -> Doc
<+>
            PrettyLevel -> Rational -> [[t]] -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d Rational
p [[t]]
idss Doc -> Doc -> Doc
<+> String -> Doc
text String
"#-}"
    pPrintPrec PrettyLevel
d Rational
p (SPConflictFree [[t]]
idss) =
        String -> Doc
text String
"{-# ASSERT conflict-free: " Doc -> Doc -> Doc
<+>
            PrettyLevel -> Rational -> [[t]] -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d Rational
p [[t]]
idss Doc -> Doc -> Doc
<+> String -> Doc
text String
"#-}"
    pPrintPrec PrettyLevel
d Rational
p (SPPreempt [t]
ids1 [t]
ids2) =
        String -> Doc
text String
"{-# ASSERT preempt: " Doc -> Doc -> Doc
<+>
            PrettyLevel -> Rational -> [t] -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d Rational
p [t]
ids1 Doc -> Doc -> Doc
<+> PrettyLevel -> Rational -> [t] -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d Rational
p [t]
ids2 Doc -> Doc -> Doc
<+> String -> Doc
text String
"#-}"
    pPrintPrec PrettyLevel
d Rational
p (SPSchedule MethodConflictInfo t
s) =
        String -> Doc
text String
"{-# ASSERT schedule: " Doc -> Doc -> Doc
<+>
            PrettyLevel -> Rational -> MethodConflictInfo t -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d Rational
p MethodConflictInfo t
s Doc -> Doc -> Doc
<+>  String -> Doc
text String
"#-}"

type CSchedulePragma = SchedulePragma Longname

-- Interface definition pragmas
-- These pragma are associated with interfaces and/or the fields within the interface
-- The first arg is the field name which the attribute is associated with
data IfcPragma
    =  PIArgNames     [Id]      -- arg names used as dummy names (XX this can be removed?)
    | PIPrefixStr     String    -- Method or interface
    | PIResultName    String    -- name for the result of the method AV or value methods
    | PIRdySignalName String    -- name for the ready signal on this method
    | PIEnSignalName  String    -- name for the enable signal
    | PIAlwaysRdy               -- ifc or methods tagged as always ready
    | PIAlwaysEnabled           -- ifc or methods tagged as always enabled
      deriving (IfcPragma -> IfcPragma -> Bool
(IfcPragma -> IfcPragma -> Bool)
-> (IfcPragma -> IfcPragma -> Bool) -> Eq IfcPragma
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IfcPragma -> IfcPragma -> Bool
== :: IfcPragma -> IfcPragma -> Bool
$c/= :: IfcPragma -> IfcPragma -> Bool
/= :: IfcPragma -> IfcPragma -> Bool
Eq, Eq IfcPragma
Eq IfcPragma =>
(IfcPragma -> IfcPragma -> Ordering)
-> (IfcPragma -> IfcPragma -> Bool)
-> (IfcPragma -> IfcPragma -> Bool)
-> (IfcPragma -> IfcPragma -> Bool)
-> (IfcPragma -> IfcPragma -> Bool)
-> (IfcPragma -> IfcPragma -> IfcPragma)
-> (IfcPragma -> IfcPragma -> IfcPragma)
-> Ord IfcPragma
IfcPragma -> IfcPragma -> Bool
IfcPragma -> IfcPragma -> Ordering
IfcPragma -> IfcPragma -> IfcPragma
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: IfcPragma -> IfcPragma -> Ordering
compare :: IfcPragma -> IfcPragma -> Ordering
$c< :: IfcPragma -> IfcPragma -> Bool
< :: IfcPragma -> IfcPragma -> Bool
$c<= :: IfcPragma -> IfcPragma -> Bool
<= :: IfcPragma -> IfcPragma -> Bool
$c> :: IfcPragma -> IfcPragma -> Bool
> :: IfcPragma -> IfcPragma -> Bool
$c>= :: IfcPragma -> IfcPragma -> Bool
>= :: IfcPragma -> IfcPragma -> Bool
$cmax :: IfcPragma -> IfcPragma -> IfcPragma
max :: IfcPragma -> IfcPragma -> IfcPragma
$cmin :: IfcPragma -> IfcPragma -> IfcPragma
min :: IfcPragma -> IfcPragma -> IfcPragma
Ord, Int -> IfcPragma -> ShowS
[IfcPragma] -> ShowS
IfcPragma -> String
(Int -> IfcPragma -> ShowS)
-> (IfcPragma -> String)
-> ([IfcPragma] -> ShowS)
-> Show IfcPragma
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IfcPragma -> ShowS
showsPrec :: Int -> IfcPragma -> ShowS
$cshow :: IfcPragma -> String
show :: IfcPragma -> String
$cshowList :: [IfcPragma] -> ShowS
showList :: [IfcPragma] -> ShowS
Show)

instance Pretty IfcPragma where
    pPrintPrec :: PrettyLevel -> Rational -> IfcPragma -> Doc
pPrintPrec  PrettyLevel
d Rational
_ (PIArgNames [Id]
ids)       = String -> Doc
text String
"arg_names ="   Doc -> Doc -> Doc
<+>
                                             Doc -> Doc
brackets ( ([Doc] -> Doc -> Doc
sepList ((Id -> Doc) -> [Id] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (PrettyLevel -> Id -> Doc
ppVarId PrettyLevel
d) [Id]
ids) Doc
comma) )
    pPrintPrec PrettyLevel
_d Rational
_ (PIPrefixStr String
flds)     = String -> Doc
text String
"prefixs ="       Doc -> Doc -> Doc
<+> Doc -> Doc
doubleQuotes (String -> Doc
text String
flds)
    pPrintPrec PrettyLevel
_d Rational
_ (PIRdySignalName String
flds) = String -> Doc
text String
"ready ="        Doc -> Doc -> Doc
<+> Doc -> Doc
doubleQuotes (String -> Doc
text String
flds)
    pPrintPrec PrettyLevel
_d Rational
_ (PIEnSignalName String
flds)  = String -> Doc
text String
"enable ="       Doc -> Doc -> Doc
<+> Doc -> Doc
doubleQuotes (String -> Doc
text String
flds)
    pPrintPrec PrettyLevel
_d Rational
_ (PIResultName String
flds)    = String -> Doc
text String
"result ="       Doc -> Doc -> Doc
<+> Doc -> Doc
doubleQuotes (String -> Doc
text String
flds)
    pPrintPrec PrettyLevel
_d Rational
_ (IfcPragma
PIAlwaysRdy )         = String -> Doc
text String
"always_ready "
    pPrintPrec PrettyLevel
_d Rational
_ (IfcPragma
PIAlwaysEnabled )     = String -> Doc
text String
"always_enabled "