{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}

-- | Bindings to the ssm-runtime library.
module Codegen.LibSSM where

import Common.Identifiers (
  DConId,
  Identifiable (..),
  Identifier (..),
  VarId (..),
  fromId,
 )
import Data.String (IsString (..))
import Language.C.Quote (
  Id (Id),
  ToIdent (..),
 )
import Language.C.Quote.GCC (
  cexp,
  cinit,
  cty,
 )
import qualified Language.C.Syntax as C


-- Allow snake_case for c literals
{-# ANN module ("HLint: ignore Use camelCase" :: String) #-}


-- | Identifiers in C.
newtype CIdent = CIdent Identifier
  deriving (CIdent -> CIdent -> Bool
(CIdent -> CIdent -> Bool)
-> (CIdent -> CIdent -> Bool) -> Eq CIdent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CIdent -> CIdent -> Bool
$c/= :: CIdent -> CIdent -> Bool
== :: CIdent -> CIdent -> Bool
$c== :: CIdent -> CIdent -> Bool
Eq)
  deriving (Eq CIdent
Eq CIdent
-> (CIdent -> CIdent -> Ordering)
-> (CIdent -> CIdent -> Bool)
-> (CIdent -> CIdent -> Bool)
-> (CIdent -> CIdent -> Bool)
-> (CIdent -> CIdent -> Bool)
-> (CIdent -> CIdent -> CIdent)
-> (CIdent -> CIdent -> CIdent)
-> Ord CIdent
CIdent -> CIdent -> Bool
CIdent -> CIdent -> Ordering
CIdent -> CIdent -> CIdent
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
min :: CIdent -> CIdent -> CIdent
$cmin :: CIdent -> CIdent -> CIdent
max :: CIdent -> CIdent -> CIdent
$cmax :: CIdent -> CIdent -> CIdent
>= :: CIdent -> CIdent -> Bool
$c>= :: CIdent -> CIdent -> Bool
> :: CIdent -> CIdent -> Bool
$c> :: CIdent -> CIdent -> Bool
<= :: CIdent -> CIdent -> Bool
$c<= :: CIdent -> CIdent -> Bool
< :: CIdent -> CIdent -> Bool
$c< :: CIdent -> CIdent -> Bool
compare :: CIdent -> CIdent -> Ordering
$ccompare :: CIdent -> CIdent -> Ordering
$cp1Ord :: Eq CIdent
Ord)
  deriving (Int -> CIdent -> ShowS
[CIdent] -> ShowS
CIdent -> String
(Int -> CIdent -> ShowS)
-> (CIdent -> String) -> ([CIdent] -> ShowS) -> Show CIdent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CIdent] -> ShowS
$cshowList :: [CIdent] -> ShowS
show :: CIdent -> String
$cshow :: CIdent -> String
showsPrec :: Int -> CIdent -> ShowS
$cshowsPrec :: Int -> CIdent -> ShowS
Show) via Identifier
  deriving (String -> CIdent
(String -> CIdent) -> IsString CIdent
forall a. (String -> a) -> IsString a
fromString :: String -> CIdent
$cfromString :: String -> CIdent
IsString) via Identifier
  deriving (Ord CIdent
Show CIdent
IsString CIdent
IsString CIdent
-> Ord CIdent
-> Show CIdent
-> (CIdent -> String)
-> Identifiable CIdent
CIdent -> String
forall i.
IsString i -> Ord i -> Show i -> (i -> String) -> Identifiable i
ident :: CIdent -> String
$cident :: CIdent -> String
$cp3Identifiable :: Show CIdent
$cp2Identifiable :: Ord CIdent
$cp1Identifiable :: IsString CIdent
Identifiable) via Identifier
  deriving (CIdent -> SrcLoc -> Id
(CIdent -> SrcLoc -> Id) -> ToIdent CIdent
forall a. (a -> SrcLoc -> Id) -> ToIdent a
toIdent :: CIdent -> SrcLoc -> Id
$ctoIdent :: CIdent -> SrcLoc -> Id
ToIdent) via Identifier
  deriving (b -> CIdent -> CIdent
NonEmpty CIdent -> CIdent
CIdent -> CIdent -> CIdent
(CIdent -> CIdent -> CIdent)
-> (NonEmpty CIdent -> CIdent)
-> (forall b. Integral b => b -> CIdent -> CIdent)
-> Semigroup CIdent
forall b. Integral b => b -> CIdent -> CIdent
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> CIdent -> CIdent
$cstimes :: forall b. Integral b => b -> CIdent -> CIdent
sconcat :: NonEmpty CIdent -> CIdent
$csconcat :: NonEmpty CIdent -> CIdent
<> :: CIdent -> CIdent -> CIdent
$c<> :: CIdent -> CIdent -> CIdent
Semigroup) via Identifier
  deriving (Semigroup CIdent
CIdent
Semigroup CIdent
-> CIdent
-> (CIdent -> CIdent -> CIdent)
-> ([CIdent] -> CIdent)
-> Monoid CIdent
[CIdent] -> CIdent
CIdent -> CIdent -> CIdent
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [CIdent] -> CIdent
$cmconcat :: [CIdent] -> CIdent
mappend :: CIdent -> CIdent -> CIdent
$cmappend :: CIdent -> CIdent -> CIdent
mempty :: CIdent
$cmempty :: CIdent
$cp1Monoid :: Semigroup CIdent
Monoid) via Identifier


-- | Construct a type name from a C identifier.
ctype :: CIdent -> C.Type
ctype :: CIdent -> Type
ctype CIdent
i = [cty|typename $id:i|]


-- | Construct an expression from a C identifier.
cexpr :: CIdent -> C.Exp
cexpr :: CIdent -> Exp
cexpr CIdent
i = [cexp|$id:i|]


-- | Construct an expression of the size of a C type.
csizeof :: C.Type -> C.Exp
csizeof :: Type -> Exp
csizeof Type
t = [cexp|sizeof($ty:t)|]


-- | Construct an integer literal in C.
cint :: Int -> C.Exp
cint :: Int -> Exp
cint Int
i = [cexp|$int:i|]


ccall :: C.Exp -> [C.Exp] -> C.Exp
Exp
fn `ccall` [Exp]
args = [cexp|$exp:fn($args:args)|]


amp :: C.Exp -> C.Exp
amp :: Exp -> Exp
amp Exp
e = [cexp|&$exp:e|]


star :: C.Exp -> C.Exp
star :: Exp -> Exp
star Exp
e = [cexp|*$exp:e|]


-- | Natively supported sizes in C.
data CSize
  = Size8
  | Size16
  | Size32
  | Size64
  deriving (CSize -> CSize -> Bool
(CSize -> CSize -> Bool) -> (CSize -> CSize -> Bool) -> Eq CSize
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CSize -> CSize -> Bool
$c/= :: CSize -> CSize -> Bool
== :: CSize -> CSize -> Bool
$c== :: CSize -> CSize -> Bool
Eq, Eq CSize
Eq CSize
-> (CSize -> CSize -> Ordering)
-> (CSize -> CSize -> Bool)
-> (CSize -> CSize -> Bool)
-> (CSize -> CSize -> Bool)
-> (CSize -> CSize -> Bool)
-> (CSize -> CSize -> CSize)
-> (CSize -> CSize -> CSize)
-> Ord CSize
CSize -> CSize -> Bool
CSize -> CSize -> Ordering
CSize -> CSize -> CSize
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
min :: CSize -> CSize -> CSize
$cmin :: CSize -> CSize -> CSize
max :: CSize -> CSize -> CSize
$cmax :: CSize -> CSize -> CSize
>= :: CSize -> CSize -> Bool
$c>= :: CSize -> CSize -> Bool
> :: CSize -> CSize -> Bool
$c> :: CSize -> CSize -> Bool
<= :: CSize -> CSize -> Bool
$c<= :: CSize -> CSize -> Bool
< :: CSize -> CSize -> Bool
$c< :: CSize -> CSize -> Bool
compare :: CSize -> CSize -> Ordering
$ccompare :: CSize -> CSize -> Ordering
$cp1Ord :: Eq CSize
Ord)


-- | Convert a 'CSize' into an integer.
size_to_int :: CSize -> Int
size_to_int :: CSize -> Int
size_to_int CSize
Size8 = Int
8
size_to_int CSize
Size16 = Int
16
size_to_int CSize
Size32 = Int
32
size_to_int CSize
Size64 = Int
64


-- | Convert a 'CSize' into some string identifier of the size.
size_to_string :: IsString s => CSize -> s
size_to_string :: CSize -> s
size_to_string = String -> s
forall a. IsString a => String -> a
fromString (String -> s) -> (CSize -> String) -> CSize -> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show (Int -> String) -> (CSize -> Int) -> CSize -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CSize -> Int
size_to_int


{---- from ssm.h {{{ ----}

-- | @enum ssm_error@, an enumeration of possible runtime errors.
data SSMError
  = -- | Reserved for unforeseen, non-user-facing errors.
    INTERNAL_ERROR
  | -- | Tried to insert into full ready queue.
    EXHAUSTED_ACT_QUEUE
  | -- | Tried to insert into full event queue.
    EXHAUSTED_EVENT_QUEUE
  | -- | Could not allocate more memory.
    EXHAUSTED_MEMORY
  | -- | Tried to exceed available recursion depth.
    EXHAUSTED_PRIORITY
  | -- | Not yet ready to perform the requested action.
    NOT_READY
  | -- | Specified invalid time.
    INVALID_TIME
  | -- | Invalid memory layout.
    INVALID_MEMORY
  deriving (Int -> SSMError -> ShowS
[SSMError] -> ShowS
SSMError -> String
(Int -> SSMError -> ShowS)
-> (SSMError -> String) -> ([SSMError] -> ShowS) -> Show SSMError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SSMError] -> ShowS
$cshowList :: [SSMError] -> ShowS
show :: SSMError -> String
$cshow :: SSMError -> String
showsPrec :: Int -> SSMError -> ShowS
$cshowsPrec :: Int -> SSMError -> ShowS
Show)


instance ToIdent SSMError where
  toIdent :: SSMError -> SrcLoc -> Id
toIdent SSMError
e = String -> SrcLoc -> Id
Id (String -> SrcLoc -> Id) -> String -> SrcLoc -> Id
forall a b. (a -> b) -> a -> b
$ String
"SSM_" String -> ShowS
forall a. [a] -> [a] -> [a]
++ SSMError -> String
forall a. Show a => a -> String
show SSMError
e


-- | @SSM_THROW@, throw a runtime error.
throw :: SSMError -> C.Exp
throw :: SSMError -> Exp
throw SSMError
e = [cexp|SSM_THROW($id:e)|]


-- TODO: throw

-- | @ssm_word_t@, the largest supported machine word size.
word_t :: C.Type
word_t :: Type
word_t = [cty|typename ssm_word_t|]


-- | @ssm_value_t@, runtime representation for sslang values.
value_t :: C.Type
value_t :: Type
value_t = [cty|typename ssm_value_t|]


-- | Name of the @packed_val@ field in a 'value_t'.
packed_val :: CIdent
packed_val :: CIdent
packed_val = CIdent
"packed_val"


-- | Name of the @heap_ptr@ field in a 'value_t'.
heap_ptr :: CIdent
heap_ptr :: CIdent
heap_ptr = CIdent
"heap_ptr"


-- TODO: skip ssm mm

-- | @ssm_marshal@, construct a 'value_t' out of a 31-bit integral value.
marshal :: C.Exp -> C.Exp
marshal :: Exp -> Exp
marshal Exp
v = [cexp|ssm_marshal($exp:(cast_to_unsigned Size32 v))|]


-- | @ssm_unmarshal@, extract 31-bit integral value out of a 'value_t'.
unmarshal :: C.Exp -> C.Exp
unmarshal :: Exp -> Exp
unmarshal Exp
v = CSize -> Exp -> Exp
cast_to_unsigned CSize
Size32 [cexp|ssm_unmarshal($exp:v)|]


-- | @ssm_on_heap@, whether a 'value_t' points to something on the heap.
on_heap :: C.Exp -> C.Exp
on_heap :: Exp -> Exp
on_heap Exp
v = [cexp|ssm_on_heap($exp:v)|]


-- | @ssm_dup@, increment the reference count of a value.
dup :: C.Exp -> C.Exp
dup :: Exp -> Exp
dup Exp
v = [cexp|ssm_dup($exp:v)|]


-- | @ssm_dups@, increment the reference count on a vector of values.
dups :: C.Exp -> C.Exp -> C.Exp
dups :: Exp -> Exp -> Exp
dups Exp
c Exp
v = [cexp|ssm_dups($exp:c, $exp:v)|]


-- | @ssm_drop@, drop the reference count of a value and free if necessary.
drop :: C.Exp -> C.Exp
drop :: Exp -> Exp
drop Exp
v = [cexp|ssm_drop($exp:v)|]


-- | @ssm_time_t@, 64-bit time type.
time_t :: C.Type
time_t :: Type
time_t = [cty|typename ssm_time_t|]


-- | @struct ssm_time@, the heap-representation of a 'time_t'.
time_obj_t :: C.Type
time_obj_t :: Type
time_obj_t = [cty|struct ssm_time|]


-- | @SSM_NEVER@, a 'time_t' that is never reached.
never :: C.Exp
never :: Exp
never = [cexp|SSM_NEVER|]


-- TODO: time units

-- | @ssm_now@, the current time.
now :: C.Exp
now :: Exp
now = [cexp|ssm_now|]


-- | @ssm_new_time@, allocate a 'time_obj_t' on the heap.
new_time :: C.Exp -> C.Exp
new_time :: Exp -> Exp
new_time Exp
t = [cexp|ssm_new_time($exp:t)|]


-- | @ssm_time_read@, read the time in a 'time_obj_t'.
read_time :: C.Exp -> C.Exp
read_time :: Exp -> Exp
read_time Exp
to = [cexp|ssm_time_read($exp:to)|]


-- | Read the @last_updated@ field of an 'ssm_value_t' pointing to a scheduled variable.
sv_last_updated :: C.Exp -> C.Exp
sv_last_updated :: Exp -> Exp
sv_last_updated Exp
sv = [cexp|$exp:(to_sv sv)->last_updated|]


-- | @ssm_priority_t@, thread priority.
priority_t :: C.Type
priority_t :: Type
priority_t = [cty|typename ssm_priority_t|]


-- | @ssm_depth_t@, thread depth.
depth_t :: C.Type
depth_t :: Type
depth_t = [cty|typename ssm_depth_t|]


-- | @SSM_ROOT_PRIORITY@, the depth of the root process.
root_priority :: C.Exp
root_priority :: Exp
root_priority = [cexp|SSM_ROOT_PRIORITY|]


-- | @SSM_ROOT_DEPTH@, the depth of the root process.
root_depth :: C.Exp
root_depth :: Exp
root_depth = [cexp|SSM_ROOT_DEPTH|]


-- | @ssm_act_t@, the generic activation record type.
act_t :: C.Type
act_t :: Type
act_t = [cty|typename ssm_act_t|]


-- | Name of the program counter field in an 'act_t'.
act_pc :: CIdent
act_pc :: CIdent
act_pc = CIdent
"pc"


-- | Name of the caller field in an 'act_t'.
act_caller :: CIdent
act_caller :: CIdent
act_caller = CIdent
"caller"


-- | Name of the depth field in an 'act_t'.
act_depth :: CIdent
act_depth :: CIdent
act_depth = CIdent
"depth"


-- | Name of the priority field in an 'act_t'.
act_priority :: CIdent
act_priority :: CIdent
act_priority = CIdent
"priority"


-- | @ssm_trigger_t@, nodes in the linked list of triggers.
trigger_t :: C.Type
trigger_t :: Type
trigger_t = [cty|typename ssm_trigger_t|]


-- | @ssm_enter@, allocate and initialize activation record.
enter :: C.Exp -> C.Exp -> C.Exp -> C.Exp -> C.Exp -> C.Exp
enter :: Exp -> Exp -> Exp -> Exp -> Exp -> Exp
enter Exp
size Exp
step Exp
parent Exp
prio Exp
dep =
  [cexp|ssm_enter($exp:size, $exp:step, $exp:parent, $exp:prio, $exp:dep)|]


-- | @ssm_leave@, deallocate an activation record before leaving.
leave :: C.Exp -> C.Exp -> C.Exp
leave :: Exp -> Exp -> Exp
leave Exp
act Exp
size = [cexp|ssm_leave($exp:act, $exp:size)|]


-- | @ssm_has_children@, returns non-zero if @act@ has at least one child.
has_children :: C.Exp -> C.Exp
has_children :: Exp -> Exp
has_children Exp
act = [cexp|ssm_has_children($exp:act)|]


-- | @ssm_activate@, schedule an activation record on the ready queue.
activate :: C.Exp -> C.Exp
activate :: Exp -> Exp
activate Exp
act = [cexp|ssm_activate($exp:act)|]


-- | @ssm_top_parent@, Name of top level parent activation record
top_parent :: C.Exp
top_parent :: Exp
top_parent = [cexp|ssm_top_parent|]


-- | @ssm_sv_t@, polymorphic scheduled variables.
sv_t :: C.Type
sv_t :: Type
sv_t = [cty|typename ssm_sv_t|]


-- | @ssm_new_sv@, allocate a new 'sv_t' on the heap.
new_sv :: C.Exp -> C.Exp
new_sv :: Exp -> Exp
new_sv Exp
v = [cexp|ssm_new_sv($exp:v)|]


-- | @ssm_to_sv@, retrieve the 'sv_t' pointer pointed to by a 'value_t'.
to_sv :: C.Exp -> C.Exp
to_sv :: Exp -> Exp
to_sv Exp
v = [cexp|ssm_to_sv($exp:v)|]


-- | @ssm_deref@, read the value of an 'sv_t' pointed to by a 'value_t'.
deref :: C.Exp -> C.Exp
deref :: Exp -> Exp
deref Exp
v = [cexp|ssm_deref($exp:v)|]


-- | @ssm_assign@, assign to a scheduled variable.
assign :: C.Exp -> C.Exp -> C.Exp -> C.Exp
assign :: Exp -> Exp -> Exp -> Exp
assign Exp
var Exp
prio Exp
val = [cexp|ssm_assign($exp:var, $exp:prio, $exp:val)|]


-- | @ssm_later@, schedule a delayed assignment to a scheduled variable.
later :: C.Exp -> C.Exp -> C.Exp -> C.Exp
later :: Exp -> Exp -> Exp -> Exp
later Exp
var Exp
when Exp
val = [cexp|ssm_later($exp:var, $exp:when, $exp:val)|]


-- TODO: unsafe assign and later

-- | @ssm_sensitize@, sensitize a trigger to a variable.
sensitize :: C.Exp -> C.Exp -> C.Exp
sensitize :: Exp -> Exp -> Exp
sensitize Exp
var Exp
trig = [cexp|ssm_sensitize($exp:var, $exp:trig)|]


-- | @ssm_sensitize@, sensitize a trigger to a variable.
desensitize :: C.Exp -> C.Exp
desensitize :: Exp -> Exp
desensitize Exp
trig = [cexp|ssm_desensitize($exp:trig)|]


-- | @ssm_new_adt@, allocate a new ADT object on the heap.
new_adt :: Int -> DConId -> C.Exp
new_adt :: Int -> DConId -> Exp
new_adt Int
field_count DConId
tag = [cexp|ssm_new_adt($uint:field_count, $id:tag)|]


-- | @ssm_adt_field@, access the @i@th field of an ADT object. Assignable.
adt_field :: C.Exp -> Int -> C.Exp
adt_field :: Exp -> Int -> Exp
adt_field Exp
v Int
i = [cexp|ssm_adt_field($exp:v, $uint:i)|]


-- | @ssm_tag@, extract the tag of an ADT value.
adt_tag :: C.Exp -> C.Exp
adt_tag :: Exp -> Exp
adt_tag Exp
v = [cexp|ssm_tag($exp:v)|]


-- | @ssm_closure1_t@, the (template) type of a closure with a single argument.
closure1_t :: C.Type
closure1_t :: Type
closure1_t = [cty|struct ssm_closure1|]


{- | Inintializer for a "static" closure that contains no arguments.

 FIXME: An ugly hack that shouldn't exist because John didn't have the
 foresight to provide an interface to define static closures.
-}
static_closure :: C.Exp -> Int -> C.Initializer
static_closure :: Exp -> Int -> Initializer
static_closure Exp
f Int
argc =
  [cinit|{
    .mm = {
      .ref_count = 1,
      .kind = SSM_CLOSURE_K,
      .info = {
        .vector = {
          .count = 0,
          .cap = $int:argc,
        },
      },
    },
    .f = $exp:f,
    .argv = {{0}}, // https://stackoverflow.com/q/13746033/10497710
  }|]


-- | Promote a static object to an @ssm_value_t@ (warning: hacky!).
static_value :: CIdent -> C.Exp
static_value :: CIdent -> Exp
static_value CIdent
name = [cexp|($ty:value_t) { .heap_ptr = &$id:name.mm }|]


-- | @ssm_new_closure@, allocate a new closure object on the heap.
new_closure :: CIdent -> Int -> C.Exp
new_closure :: CIdent -> Int -> Exp
new_closure CIdent
f Int
n = [cexp|ssm_new_closure(&$id:f, $int:n)|]


-- | @ssm_closure_push@, add a new argument to a closure.
closure_push :: C.Exp -> C.Exp -> C.Exp
closure_push :: Exp -> Exp -> Exp
closure_push Exp
f Exp
a = [cexp|ssm_closure_push($exp:f, $exp:a)|]


-- | @ssm_closure_pop@, remove an argument from a closure.
closure_pop :: C.Exp -> C.Exp
closure_pop :: Exp -> Exp
closure_pop Exp
f = [cexp|ssm_closure_pop($exp:f)|]


-- | @ssm_closure_apply@, apply a closure to an argument.
closure_apply :: C.Exp -> C.Exp -> C.Exp -> C.Exp -> C.Exp -> C.Exp -> C.Exp
closure_apply :: Exp -> Exp -> Exp -> Exp -> Exp -> Exp -> Exp
closure_apply Exp
f Exp
a Exp
act Exp
prio Exp
depth Exp
ret =
  [cexp|ssm_closure_apply($exp:f, $exp:a, $exp:act, $exp:prio, $exp:depth, $exp:ret)|]


-- | @ssm_closure_apply@, apply a closure to an argument, consuming the closure.
closure_apply_final ::
  C.Exp -> C.Exp -> C.Exp -> C.Exp -> C.Exp -> C.Exp -> C.Exp
closure_apply_final :: Exp -> Exp -> Exp -> Exp -> Exp -> Exp -> Exp
closure_apply_final Exp
f Exp
a Exp
act Exp
prio Exp
depth Exp
ret =
  [cexp|ssm_closure_apply_final($exp:f, $exp:a, $exp:act, $exp:prio, $exp:depth, $exp:ret)|]


-- | @ssm_closure_free@, free a closure (without performing reference counting).
closure_free :: C.Exp -> C.Exp
closure_free :: Exp -> Exp
closure_free Exp
f = [cexp|ssm_closure_free($exp:f)|]


-- | Name of the pseudonymous macro from the Linux kernel.
container_of :: CIdent
container_of :: CIdent
container_of = CIdent
"container_of"


-- | Name of program initialization hook, called to set up program with runtime.
program_init :: CIdent
program_init :: CIdent
program_init = CIdent
"ssm_program_init"


-- | Name of program destruction hook, called before gracefully exiting program.
program_exit :: CIdent
program_exit :: CIdent
program_exit = CIdent
"ssm_program_exit"


{- | Name of stdout handler enter function, used to bind stdout for POSIX platforms.
 NOTE: this is a hack
-}
stdout_handler_enter :: CIdent
stdout_handler_enter :: CIdent
stdout_handler_enter = CIdent
"__enter_stdout_handler"


{- | Name of stdin handler spawner, used to bind stdin for POSIX platforms.
 NOTE: this is a hack
-}
stdin_handler_spawn :: CIdent
stdin_handler_spawn :: CIdent
stdin_handler_spawn = CIdent
"__spawn_stdin_handler"


{- | Name of stdin handler killer, used to destroy handler thread on POSIX.
 NOTE: this is a hack
-}
stdin_handler_kill :: CIdent
stdin_handler_kill :: CIdent
stdin_handler_kill = CIdent
"__kill_stdin_handler"


{---- from ssm.h }}} ----}

{---- Naming conventions {{{ ----}

-- | Obtain the name of a process activation record struct.
act_typename :: VarId -> CIdent
act_typename :: VarId -> CIdent
act_typename VarId
name = CIdent
"act_" CIdent -> CIdent -> CIdent
forall a. Semigroup a => a -> a -> a
<> VarId -> CIdent
forall a b. (Identifiable a, Identifiable b) => a -> b
fromId VarId
name CIdent -> CIdent -> CIdent
forall a. Semigroup a => a -> a -> a
<> CIdent
"_t"


-- | Identifier for act member in act struct.
act_member :: CIdent
act_member :: CIdent
act_member = CIdent
"act"


-- | Obtain the type of a process activation record.
act_ :: VarId -> C.Type
act_ :: VarId -> Type
act_ VarId
name = [cty|typename $id:(act_typename name)|]


-- | Obtain the process-specific activation record from a generic one.
to_act :: C.Exp -> VarId -> C.Exp
to_act :: Exp -> VarId -> Exp
to_act Exp
act VarId
name =
  [cexp|$id:container_of($exp:act, $id:(act_typename name), $id:act_member)|]


-- | Obtain the name for the enter function of a routine.
enter_ :: VarId -> CIdent
enter_ :: VarId -> CIdent
enter_ VarId
name = CIdent
"__enter_" CIdent -> CIdent -> CIdent
forall a. Semigroup a => a -> a -> a
<> VarId -> CIdent
forall a b. (Identifiable a, Identifiable b) => a -> b
fromId VarId
name


-- | Obtain the name for the static closure of a routine.
closure_ :: VarId -> CIdent
closure_ :: VarId -> CIdent
closure_ VarId
name = CIdent
"__closure_" CIdent -> CIdent -> CIdent
forall a. Semigroup a => a -> a -> a
<> VarId -> CIdent
forall a b. (Identifiable a, Identifiable b) => a -> b
fromId VarId
name


-- | Obtain the name of the step function of a routine.
step_ :: VarId -> CIdent
step_ :: VarId -> CIdent
step_ VarId
name = CIdent
"__step_" CIdent -> CIdent -> CIdent
forall a. Semigroup a => a -> a -> a
<> VarId -> CIdent
forall a b. (Identifiable a, Identifiable b) => a -> b
fromId VarId
name


-- | Obtain the name of each trigger for a routine.
trig_ :: Int -> CIdent
trig_ :: Int -> CIdent
trig_ Int
i = CIdent
"__trig_" CIdent -> CIdent -> CIdent
forall a. Semigroup a => a -> a -> a
<> String -> CIdent
forall a. IsString a => String -> a
fromString (Int -> String
forall a. Show a => a -> String
show Int
i)


-- | Obtain the name of a temporary variable.
tmp_ :: Int -> CIdent
tmp_ :: Int -> CIdent
tmp_ Int
i = CIdent
"__tmp_" CIdent -> CIdent -> CIdent
forall a. Semigroup a => a -> a -> a
<> String -> CIdent
forall a. IsString a => String -> a
fromString (Int -> String
forall a. Show a => a -> String
show Int
i)


-- | Obtain the name of a label.
label_ :: Int -> CIdent
label_ :: Int -> CIdent
label_ Int
i = CIdent
"__label_" CIdent -> CIdent -> CIdent
forall a. Semigroup a => a -> a -> a
<> String -> CIdent
forall a. IsString a => String -> a
fromString (Int -> String
forall a. Show a => a -> String
show Int
i)


-- | Obtain the name of an argument variable.
arg_ :: Int -> CIdent
arg_ :: Int -> CIdent
arg_ Int
i = CIdent
"__arg_" CIdent -> CIdent -> CIdent
forall a. Semigroup a => a -> a -> a
<> String -> CIdent
forall a. IsString a => String -> a
fromString (Int -> String
forall a. Show a => a -> String
show Int
i)


-- | Obtain the name of an argument variable.
argv :: CIdent
argv :: CIdent
argv = CIdent
"__argv"


-- | Name of return argument.
ret_val :: CIdent
ret_val :: CIdent
ret_val = CIdent
"__return_val"


-- | Identifier for generic (inner) struct act.
actg :: CIdent
actg :: CIdent
actg = CIdent
"actg"


-- | Identifier for specialized (outer) struct act.
acts :: CIdent
acts :: CIdent
acts = CIdent
"acts"


-- | Access activation record member.
acts_ :: CIdent -> C.Exp
acts_ :: CIdent -> Exp
acts_ CIdent
i = [cexp|$id:acts->$id:i|]


-- | Name of the caller argument of an enter call.
enter_caller :: CIdent
enter_caller :: CIdent
enter_caller = CIdent
"caller"


-- | Name of the priority argument of an enter call.
enter_priority :: CIdent
enter_priority :: CIdent
enter_priority = CIdent
"priority"


-- | Name of the depth argument of an enter call.
enter_depth :: CIdent
enter_depth :: CIdent
enter_depth = CIdent
"depth"


-- | Label to jump to terminate execution.
leave_label :: CIdent
leave_label :: CIdent
leave_label = CIdent
"__leave_step"


{---- Naming conventions }}} ----}

{---- Quasiquoting helpers {{{ ----}

-- | Cast to a signed integer of a particular size.
cast_to_signed :: CSize -> C.Exp -> C.Exp
cast_to_signed :: CSize -> Exp -> Exp
cast_to_signed = Bool -> CSize -> Exp -> Exp
cast_to_int Bool
True


-- | Cast to an unsigned integer of a particular size.
cast_to_unsigned :: CSize -> C.Exp -> C.Exp
cast_to_unsigned :: CSize -> Exp -> Exp
cast_to_unsigned = Bool -> CSize -> Exp -> Exp
cast_to_int Bool
False


-- | Cast to an integer of a particular size and signedness.
cast_to_int :: Bool -> CSize -> C.Exp -> C.Exp
cast_to_int :: Bool -> CSize -> Exp -> Exp
cast_to_int Bool
signed CSize
size Exp
e = [cexp|(typename $id:int_t) $exp:e|]
 where
  int_t :: CIdent
  int_t :: CIdent
int_t = (if Bool
signed then CIdent
"int" else CIdent
"uint") CIdent -> CIdent -> CIdent
forall a. Semigroup a => a -> a -> a
<> CSize -> CIdent
forall s. IsString s => CSize -> s
size_to_string CSize
size CIdent -> CIdent -> CIdent
forall a. Semigroup a => a -> a -> a
<> CIdent
"_t"


-- | Shift left by the specified amount.
shl :: C.Exp -> C.Exp -> C.Exp
shl :: Exp -> Exp -> Exp
shl Exp
l Exp
r = [cexp|$exp:l << $exp:r|]


-- | Shift right by the specified amount.
shr :: C.Exp -> C.Exp -> C.Exp
shr :: Exp -> Exp -> Exp
shr Exp
l Exp
r = [cexp|$exp:l >> $exp:r|]

{---- Quasiquoting helpers }}} ----}