{-# OPTIONS_GHC -Wwarn #-}
{-# LANGUAGE NamedFieldPuns    #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE Strict            #-}
module Tokstyle.SemFmt.StructPack (descr) where

import           Data.Fix                     (Fix (..))
import           Data.Text                    (Text)
import qualified Data.Text                    as Text
import           Language.Cimple              (BinaryOp (..), Lexeme (..),
                                               LexemeClass (..),
                                               LiteralType (..), Node,
                                               NodeF (..), UnaryOp (..))
import           Tokstyle.Common.StructLinter (MkFunBody, analyseStructs, mkLAt)
import           Tokstyle.Common.TypeSystem   (StdType (..), TypeDescr (..),
                                               TypeInfo (..), TypeRef (..))


funSuffix :: Text
funSuffix :: Text
funSuffix = Text
"_pack"

{-
return bin_pack_array(bp, 5)
           && bin_pack_u08(bp, foo->some_byte)
           && bin_pack_u16(bp, foo->some_short)
           && some_enum_pack(bp, foo->type)
           && bin_pack_bin(bp, foo->message, foo->message_length)
           && bin_pack_bin(bp, foo->key, 32);
-}
mkFunBody :: MkFunBody
mkFunBody :: MkFunBody
mkFunBody TypeSystem
_ Lexeme Text
varName (StructDescr Lexeme Text
_ [(Lexeme Text, TypeInfo)
mem]) = do
    Node (Lexeme Text)
packMems <- Lexeme Text
-> (Lexeme Text, TypeInfo) -> Maybe (Node (Lexeme Text))
mkPackMember Lexeme Text
varName (Lexeme Text, TypeInfo)
mem
    Either Text (Node (Lexeme Text))
-> Maybe (Either Text (Node (Lexeme Text)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text (Node (Lexeme Text))
 -> Maybe (Either Text (Node (Lexeme Text))))
-> Either Text (Node (Lexeme Text))
-> Maybe (Either Text (Node (Lexeme Text)))
forall a b. (a -> b) -> a -> b
$ Node (Lexeme Text) -> Either Text (Node (Lexeme Text))
forall a b. b -> Either a b
Right (NodeF (Lexeme Text) (Node (Lexeme Text)) -> Node (Lexeme Text)
forall (f :: * -> *). f (Fix f) -> Fix f
Fix ([Node (Lexeme Text)] -> NodeF (Lexeme Text) (Node (Lexeme Text))
forall lexeme a. [a] -> NodeF lexeme a
CompoundStmt [NodeF (Lexeme Text) (Node (Lexeme Text)) -> Node (Lexeme Text)
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Maybe (Node (Lexeme Text))
-> NodeF (Lexeme Text) (Node (Lexeme Text))
forall lexeme a. Maybe a -> NodeF lexeme a
Return (Node (Lexeme Text) -> Maybe (Node (Lexeme Text))
forall a. a -> Maybe a
Just Node (Lexeme Text)
packMems))]))
mkFunBody TypeSystem
_ Lexeme Text
varName (StructDescr Lexeme Text
sname [(Lexeme Text, TypeInfo)]
mems) = do
    let packArray :: Node (Lexeme Text)
packArray = Lexeme Text -> Int -> Node (Lexeme Text)
mkPackArray Lexeme Text
sname ([(Lexeme Text, TypeInfo)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Lexeme Text, TypeInfo)]
mems)
    Node (Lexeme Text)
packMems <- (Node (Lexeme Text) -> Node (Lexeme Text) -> Node (Lexeme Text))
-> Node (Lexeme Text) -> [Node (Lexeme Text)] -> Node (Lexeme Text)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Node (Lexeme Text)
x Node (Lexeme Text)
y -> NodeF (Lexeme Text) (Node (Lexeme Text)) -> Node (Lexeme Text)
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Node (Lexeme Text)
-> BinaryOp
-> Node (Lexeme Text)
-> NodeF (Lexeme Text) (Node (Lexeme Text))
forall lexeme a. a -> BinaryOp -> a -> NodeF lexeme a
BinaryExpr Node (Lexeme Text)
y BinaryOp
BopAnd Node (Lexeme Text)
x)) Node (Lexeme Text)
packArray ([Node (Lexeme Text)] -> Node (Lexeme Text))
-> ([Node (Lexeme Text)] -> [Node (Lexeme Text)])
-> [Node (Lexeme Text)]
-> Node (Lexeme Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Node (Lexeme Text)] -> [Node (Lexeme Text)]
forall a. [a] -> [a]
reverse ([Node (Lexeme Text)] -> Node (Lexeme Text))
-> Maybe [Node (Lexeme Text)] -> Maybe (Node (Lexeme Text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Lexeme Text, TypeInfo) -> Maybe (Node (Lexeme Text)))
-> [(Lexeme Text, TypeInfo)] -> Maybe [Node (Lexeme Text)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Lexeme Text
-> (Lexeme Text, TypeInfo) -> Maybe (Node (Lexeme Text))
mkPackMember Lexeme Text
varName) [(Lexeme Text, TypeInfo)]
mems
    Either Text (Node (Lexeme Text))
-> Maybe (Either Text (Node (Lexeme Text)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text (Node (Lexeme Text))
 -> Maybe (Either Text (Node (Lexeme Text))))
-> Either Text (Node (Lexeme Text))
-> Maybe (Either Text (Node (Lexeme Text)))
forall a b. (a -> b) -> a -> b
$ Node (Lexeme Text) -> Either Text (Node (Lexeme Text))
forall a b. b -> Either a b
Right (NodeF (Lexeme Text) (Node (Lexeme Text)) -> Node (Lexeme Text)
forall (f :: * -> *). f (Fix f) -> Fix f
Fix ([Node (Lexeme Text)] -> NodeF (Lexeme Text) (Node (Lexeme Text))
forall lexeme a. [a] -> NodeF lexeme a
CompoundStmt [NodeF (Lexeme Text) (Node (Lexeme Text)) -> Node (Lexeme Text)
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Maybe (Node (Lexeme Text))
-> NodeF (Lexeme Text) (Node (Lexeme Text))
forall lexeme a. Maybe a -> NodeF lexeme a
Return (Node (Lexeme Text) -> Maybe (Node (Lexeme Text))
forall a. a -> Maybe a
Just Node (Lexeme Text)
packMems))]))
mkFunBody TypeSystem
_ Lexeme Text
_ TypeDescr
ty = [Char] -> Maybe (Either Text (Node (Lexeme Text)))
forall a. HasCallStack => [Char] -> a
error ([Char] -> Maybe (Either Text (Node (Lexeme Text))))
-> [Char] -> Maybe (Either Text (Node (Lexeme Text)))
forall a b. (a -> b) -> a -> b
$ TypeDescr -> [Char]
forall a. Show a => a -> [Char]
show TypeDescr
ty

mkPackArray :: Lexeme Text -> Int -> Node (Lexeme Text)
mkPackArray :: Lexeme Text -> Int -> Node (Lexeme Text)
mkPackArray Lexeme Text
sname Int
size =
    NodeF (Lexeme Text) (Node (Lexeme Text)) -> Node (Lexeme Text)
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Node (Lexeme Text)
-> [Node (Lexeme Text)] -> NodeF (Lexeme Text) (Node (Lexeme Text))
forall lexeme a. a -> [a] -> NodeF lexeme a
FunctionCall (NodeF (Lexeme Text) (Node (Lexeme Text)) -> Node (Lexeme Text)
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Lexeme Text -> NodeF (Lexeme Text) (Node (Lexeme Text))
forall lexeme a. lexeme -> NodeF lexeme a
VarExpr (Lexeme Text -> LexemeClass -> Text -> Lexeme Text
forall a. Lexeme a -> LexemeClass -> a -> Lexeme a
mkLAt Lexeme Text
sname LexemeClass
IdVar Text
"bin_pack_array")))
        [ NodeF (Lexeme Text) (Node (Lexeme Text)) -> Node (Lexeme Text)
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Lexeme Text -> NodeF (Lexeme Text) (Node (Lexeme Text))
forall lexeme a. lexeme -> NodeF lexeme a
VarExpr (Lexeme Text -> LexemeClass -> Text -> Lexeme Text
forall a. Lexeme a -> LexemeClass -> a -> Lexeme a
mkLAt Lexeme Text
sname LexemeClass
IdVar Text
"bp"))
        , NodeF (Lexeme Text) (Node (Lexeme Text)) -> Node (Lexeme Text)
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (LiteralType
-> Lexeme Text -> NodeF (Lexeme Text) (Node (Lexeme Text))
forall lexeme a. LiteralType -> lexeme -> NodeF lexeme a
LiteralExpr LiteralType
Int (Lexeme Text -> LexemeClass -> Text -> Lexeme Text
forall a. Lexeme a -> LexemeClass -> a -> Lexeme a
mkLAt Lexeme Text
sname LexemeClass
LitInteger ([Char] -> Text
Text.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
size)))
        ])

builtinPackFunName :: StdType -> Maybe Text
builtinPackFunName :: StdType -> Maybe Text
builtinPackFunName StdType
BoolTy = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"bin_pack_bool"
builtinPackFunName StdType
U08Ty  = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"bin_pack_u08"
builtinPackFunName StdType
S08Ty  = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"bin_pack_s08"
builtinPackFunName StdType
U16Ty  = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"bin_pack_u16"
builtinPackFunName StdType
S16Ty  = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"bin_pack_s16"
builtinPackFunName StdType
U32Ty  = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"bin_pack_u32"
builtinPackFunName StdType
S32Ty  = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"bin_pack_s32"
builtinPackFunName StdType
U64Ty  = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"bin_pack_u64"
builtinPackFunName StdType
S64Ty  = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"bin_pack_s64"
builtinPackFunName StdType
_      = Maybe Text
forall a. Maybe a
Nothing

packFunName :: TypeInfo -> Maybe (Either Text (Node (Lexeme Text) -> Node (Lexeme Text), Text))
packFunName :: TypeInfo
-> Maybe
     (Either Text (Node (Lexeme Text) -> Node (Lexeme Text), Text))
packFunName (BuiltinType StdType
ty) =
    Text
-> Either Text (Node (Lexeme Text) -> Node (Lexeme Text), Text)
forall a b. a -> Either a b
Left (Text
 -> Either Text (Node (Lexeme Text) -> Node (Lexeme Text), Text))
-> Maybe Text
-> Maybe
     (Either Text (Node (Lexeme Text) -> Node (Lexeme Text), Text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StdType -> Maybe Text
builtinPackFunName StdType
ty
packFunName (TypeRef TypeRef
EnumRef (L AlexPosn
_ LexemeClass
_ Text
name)) =
    Either Text (Node (Lexeme Text) -> Node (Lexeme Text), Text)
-> Maybe
     (Either Text (Node (Lexeme Text) -> Node (Lexeme Text), Text))
forall a. a -> Maybe a
Just (Either Text (Node (Lexeme Text) -> Node (Lexeme Text), Text)
 -> Maybe
      (Either Text (Node (Lexeme Text) -> Node (Lexeme Text), Text)))
-> Either Text (Node (Lexeme Text) -> Node (Lexeme Text), Text)
-> Maybe
     (Either Text (Node (Lexeme Text) -> Node (Lexeme Text), Text))
forall a b. (a -> b) -> a -> b
$ (Node (Lexeme Text) -> Node (Lexeme Text), Text)
-> Either Text (Node (Lexeme Text) -> Node (Lexeme Text), Text)
forall a b. b -> Either a b
Right (Node (Lexeme Text) -> Node (Lexeme Text)
forall a. a -> a
id, Text -> Text
Text.toLower Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_pack")
packFunName (Pointer (TypeRef TypeRef
StructRef (L AlexPosn
_ LexemeClass
_ Text
name))) =
    Either Text (Node (Lexeme Text) -> Node (Lexeme Text), Text)
-> Maybe
     (Either Text (Node (Lexeme Text) -> Node (Lexeme Text), Text))
forall a. a -> Maybe a
Just (Either Text (Node (Lexeme Text) -> Node (Lexeme Text), Text)
 -> Maybe
      (Either Text (Node (Lexeme Text) -> Node (Lexeme Text), Text)))
-> Either Text (Node (Lexeme Text) -> Node (Lexeme Text), Text)
-> Maybe
     (Either Text (Node (Lexeme Text) -> Node (Lexeme Text), Text))
forall a b. (a -> b) -> a -> b
$ (Node (Lexeme Text) -> Node (Lexeme Text), Text)
-> Either Text (Node (Lexeme Text) -> Node (Lexeme Text), Text)
forall a b. b -> Either a b
Right (Node (Lexeme Text) -> Node (Lexeme Text)
forall a. a -> a
id, Text -> Text
Text.toLower Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_pack")
packFunName (TypeRef TypeRef
StructRef (L AlexPosn
_ LexemeClass
_ Text
name)) =
    Either Text (Node (Lexeme Text) -> Node (Lexeme Text), Text)
-> Maybe
     (Either Text (Node (Lexeme Text) -> Node (Lexeme Text), Text))
forall a. a -> Maybe a
Just (Either Text (Node (Lexeme Text) -> Node (Lexeme Text), Text)
 -> Maybe
      (Either Text (Node (Lexeme Text) -> Node (Lexeme Text), Text)))
-> Either Text (Node (Lexeme Text) -> Node (Lexeme Text), Text)
-> Maybe
     (Either Text (Node (Lexeme Text) -> Node (Lexeme Text), Text))
forall a b. (a -> b) -> a -> b
$ (Node (Lexeme Text) -> Node (Lexeme Text), Text)
-> Either Text (Node (Lexeme Text) -> Node (Lexeme Text), Text)
forall a b. b -> Either a b
Right (NodeF (Lexeme Text) (Node (Lexeme Text)) -> Node (Lexeme Text)
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NodeF (Lexeme Text) (Node (Lexeme Text)) -> Node (Lexeme Text))
-> (Node (Lexeme Text) -> NodeF (Lexeme Text) (Node (Lexeme Text)))
-> Node (Lexeme Text)
-> Node (Lexeme Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnaryOp
-> Node (Lexeme Text) -> NodeF (Lexeme Text) (Node (Lexeme Text))
forall lexeme a. UnaryOp -> a -> NodeF lexeme a
UnaryExpr UnaryOp
UopAddress, Text -> Text
Text.toLower Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_pack")
packFunName (Pointer Const{})    = Maybe
  (Either Text (Node (Lexeme Text) -> Node (Lexeme Text), Text))
forall a. Maybe a
Nothing
packFunName (TypeRef TypeRef
UnionRef Lexeme Text
_) = Maybe
  (Either Text (Node (Lexeme Text) -> Node (Lexeme Text), Text))
forall a. Maybe a
Nothing  -- TODO(iphydf): Union pack.
packFunName TypeInfo
x                    = [Char]
-> Maybe
     (Either Text (Node (Lexeme Text) -> Node (Lexeme Text), Text))
forall a. HasCallStack => [Char] -> a
error ([Char]
 -> Maybe
      (Either Text (Node (Lexeme Text) -> Node (Lexeme Text), Text)))
-> [Char]
-> Maybe
     (Either Text (Node (Lexeme Text) -> Node (Lexeme Text), Text))
forall a b. (a -> b) -> a -> b
$ TypeInfo -> [Char]
forall a. Show a => a -> [Char]
show TypeInfo
x

-- bin_pack_bin(bp, var->mem, size)
mkPackBin :: Lexeme Text -> Lexeme Text -> Node (Lexeme Text) -> Node (Lexeme Text)
mkPackBin :: Lexeme Text
-> Lexeme Text -> Node (Lexeme Text) -> Node (Lexeme Text)
mkPackBin Lexeme Text
varName Lexeme Text
memName Node (Lexeme Text)
size =
    NodeF (Lexeme Text) (Node (Lexeme Text)) -> Node (Lexeme Text)
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Node (Lexeme Text)
-> [Node (Lexeme Text)] -> NodeF (Lexeme Text) (Node (Lexeme Text))
forall lexeme a. a -> [a] -> NodeF lexeme a
FunctionCall (NodeF (Lexeme Text) (Node (Lexeme Text)) -> Node (Lexeme Text)
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Lexeme Text -> NodeF (Lexeme Text) (Node (Lexeme Text))
forall lexeme a. lexeme -> NodeF lexeme a
VarExpr (Lexeme Text -> LexemeClass -> Text -> Lexeme Text
forall a. Lexeme a -> LexemeClass -> a -> Lexeme a
mkLAt Lexeme Text
memName LexemeClass
IdVar Text
"bin_pack_bin")))
        [ NodeF (Lexeme Text) (Node (Lexeme Text)) -> Node (Lexeme Text)
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Lexeme Text -> NodeF (Lexeme Text) (Node (Lexeme Text))
forall lexeme a. lexeme -> NodeF lexeme a
VarExpr (Lexeme Text -> LexemeClass -> Text -> Lexeme Text
forall a. Lexeme a -> LexemeClass -> a -> Lexeme a
mkLAt Lexeme Text
memName LexemeClass
IdVar Text
"bp"))
        , NodeF (Lexeme Text) (Node (Lexeme Text)) -> Node (Lexeme Text)
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Node (Lexeme Text)
-> Lexeme Text -> NodeF (Lexeme Text) (Node (Lexeme Text))
forall lexeme a. a -> lexeme -> NodeF lexeme a
PointerAccess (NodeF (Lexeme Text) (Node (Lexeme Text)) -> Node (Lexeme Text)
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Lexeme Text -> NodeF (Lexeme Text) (Node (Lexeme Text))
forall lexeme a. lexeme -> NodeF lexeme a
VarExpr Lexeme Text
varName)) Lexeme Text
memName)
        , Node (Lexeme Text)
size
        ])

mkPackMember :: Lexeme Text -> (Lexeme Text, TypeInfo) -> Maybe (Node (Lexeme Text))
mkPackMember :: Lexeme Text
-> (Lexeme Text, TypeInfo) -> Maybe (Node (Lexeme Text))
mkPackMember Lexeme Text
varName (Lexeme Text
memName, Sized (Pointer (BuiltinType StdType
U08Ty)) Lexeme Text
arrSize) = Node (Lexeme Text) -> Maybe (Node (Lexeme Text))
forall a. a -> Maybe a
Just (Node (Lexeme Text) -> Maybe (Node (Lexeme Text)))
-> Node (Lexeme Text) -> Maybe (Node (Lexeme Text))
forall a b. (a -> b) -> a -> b
$
    Lexeme Text
-> Lexeme Text -> Node (Lexeme Text) -> Node (Lexeme Text)
mkPackBin Lexeme Text
varName Lexeme Text
memName (Node (Lexeme Text) -> Node (Lexeme Text))
-> Node (Lexeme Text) -> Node (Lexeme Text)
forall a b. (a -> b) -> a -> b
$ NodeF (Lexeme Text) (Node (Lexeme Text)) -> Node (Lexeme Text)
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Node (Lexeme Text)
-> Lexeme Text -> NodeF (Lexeme Text) (Node (Lexeme Text))
forall lexeme a. a -> lexeme -> NodeF lexeme a
PointerAccess (NodeF (Lexeme Text) (Node (Lexeme Text)) -> Node (Lexeme Text)
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Lexeme Text -> NodeF (Lexeme Text) (Node (Lexeme Text))
forall lexeme a. lexeme -> NodeF lexeme a
VarExpr Lexeme Text
varName)) Lexeme Text
arrSize)
mkPackMember Lexeme Text
varName (Lexeme Text
memName, Sized (Array (Just (BuiltinType StdType
U08Ty)) [TypeInfo]
_) Lexeme Text
arrSize) = Node (Lexeme Text) -> Maybe (Node (Lexeme Text))
forall a. a -> Maybe a
Just (Node (Lexeme Text) -> Maybe (Node (Lexeme Text)))
-> Node (Lexeme Text) -> Maybe (Node (Lexeme Text))
forall a b. (a -> b) -> a -> b
$
    Lexeme Text
-> Lexeme Text -> Node (Lexeme Text) -> Node (Lexeme Text)
mkPackBin Lexeme Text
varName Lexeme Text
memName (Node (Lexeme Text) -> Node (Lexeme Text))
-> Node (Lexeme Text) -> Node (Lexeme Text)
forall a b. (a -> b) -> a -> b
$ NodeF (Lexeme Text) (Node (Lexeme Text)) -> Node (Lexeme Text)
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Node (Lexeme Text)
-> Lexeme Text -> NodeF (Lexeme Text) (Node (Lexeme Text))
forall lexeme a. a -> lexeme -> NodeF lexeme a
PointerAccess (NodeF (Lexeme Text) (Node (Lexeme Text)) -> Node (Lexeme Text)
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Lexeme Text -> NodeF (Lexeme Text) (Node (Lexeme Text))
forall lexeme a. lexeme -> NodeF lexeme a
VarExpr Lexeme Text
varName)) Lexeme Text
arrSize)
mkPackMember Lexeme Text
varName (Lexeme Text
memName, Array (Just (BuiltinType StdType
U08Ty)) [NameLit Lexeme Text
arrSize]) = Node (Lexeme Text) -> Maybe (Node (Lexeme Text))
forall a. a -> Maybe a
Just (Node (Lexeme Text) -> Maybe (Node (Lexeme Text)))
-> Node (Lexeme Text) -> Maybe (Node (Lexeme Text))
forall a b. (a -> b) -> a -> b
$
    Lexeme Text
-> Lexeme Text -> Node (Lexeme Text) -> Node (Lexeme Text)
mkPackBin Lexeme Text
varName Lexeme Text
memName (Node (Lexeme Text) -> Node (Lexeme Text))
-> Node (Lexeme Text) -> Node (Lexeme Text)
forall a b. (a -> b) -> a -> b
$ NodeF (Lexeme Text) (Node (Lexeme Text)) -> Node (Lexeme Text)
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (LiteralType
-> Lexeme Text -> NodeF (Lexeme Text) (Node (Lexeme Text))
forall lexeme a. LiteralType -> lexeme -> NodeF lexeme a
LiteralExpr LiteralType
ConstId Lexeme Text
arrSize)
mkPackMember Lexeme Text
varName (Lexeme Text
memName, Array (Just (BuiltinType StdType
U08Ty)) [IntLit Lexeme Text
arrSize]) = Node (Lexeme Text) -> Maybe (Node (Lexeme Text))
forall a. a -> Maybe a
Just (Node (Lexeme Text) -> Maybe (Node (Lexeme Text)))
-> Node (Lexeme Text) -> Maybe (Node (Lexeme Text))
forall a b. (a -> b) -> a -> b
$
    Lexeme Text
-> Lexeme Text -> Node (Lexeme Text) -> Node (Lexeme Text)
mkPackBin Lexeme Text
varName Lexeme Text
memName (Node (Lexeme Text) -> Node (Lexeme Text))
-> Node (Lexeme Text) -> Node (Lexeme Text)
forall a b. (a -> b) -> a -> b
$ NodeF (Lexeme Text) (Node (Lexeme Text)) -> Node (Lexeme Text)
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (LiteralType
-> Lexeme Text -> NodeF (Lexeme Text) (Node (Lexeme Text))
forall lexeme a. LiteralType -> lexeme -> NodeF lexeme a
LiteralExpr LiteralType
Int Lexeme Text
arrSize)
mkPackMember Lexeme Text
varName (Lexeme Text
memName, TypeInfo
memType) = do
    Either Text (Node (Lexeme Text) -> Node (Lexeme Text), Text)
funName <- TypeInfo
-> Maybe
     (Either Text (Node (Lexeme Text) -> Node (Lexeme Text), Text))
packFunName TypeInfo
memType
    Node (Lexeme Text) -> Maybe (Node (Lexeme Text))
forall (m :: * -> *) a. Monad m => a -> m a
return (Node (Lexeme Text) -> Maybe (Node (Lexeme Text)))
-> Node (Lexeme Text) -> Maybe (Node (Lexeme Text))
forall a b. (a -> b) -> a -> b
$ case Either Text (Node (Lexeme Text) -> Node (Lexeme Text), Text)
funName of
        Left Text
fun ->
            NodeF (Lexeme Text) (Node (Lexeme Text)) -> Node (Lexeme Text)
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Node (Lexeme Text)
-> [Node (Lexeme Text)] -> NodeF (Lexeme Text) (Node (Lexeme Text))
forall lexeme a. a -> [a] -> NodeF lexeme a
FunctionCall (NodeF (Lexeme Text) (Node (Lexeme Text)) -> Node (Lexeme Text)
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Lexeme Text -> NodeF (Lexeme Text) (Node (Lexeme Text))
forall lexeme a. lexeme -> NodeF lexeme a
VarExpr (Lexeme Text -> LexemeClass -> Text -> Lexeme Text
forall a. Lexeme a -> LexemeClass -> a -> Lexeme a
mkLAt Lexeme Text
memName LexemeClass
IdVar Text
fun)))
                [ NodeF (Lexeme Text) (Node (Lexeme Text)) -> Node (Lexeme Text)
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Lexeme Text -> NodeF (Lexeme Text) (Node (Lexeme Text))
forall lexeme a. lexeme -> NodeF lexeme a
VarExpr (Lexeme Text -> LexemeClass -> Text -> Lexeme Text
forall a. Lexeme a -> LexemeClass -> a -> Lexeme a
mkLAt Lexeme Text
memName LexemeClass
IdVar Text
"bp"))
                , NodeF (Lexeme Text) (Node (Lexeme Text)) -> Node (Lexeme Text)
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Node (Lexeme Text)
-> Lexeme Text -> NodeF (Lexeme Text) (Node (Lexeme Text))
forall lexeme a. a -> lexeme -> NodeF lexeme a
PointerAccess (NodeF (Lexeme Text) (Node (Lexeme Text)) -> Node (Lexeme Text)
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Lexeme Text -> NodeF (Lexeme Text) (Node (Lexeme Text))
forall lexeme a. lexeme -> NodeF lexeme a
VarExpr Lexeme Text
varName)) Lexeme Text
memName)
                ])
        Right (Node (Lexeme Text) -> Node (Lexeme Text)
prefix, Text
fun) ->
            NodeF (Lexeme Text) (Node (Lexeme Text)) -> Node (Lexeme Text)
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Node (Lexeme Text)
-> [Node (Lexeme Text)] -> NodeF (Lexeme Text) (Node (Lexeme Text))
forall lexeme a. a -> [a] -> NodeF lexeme a
FunctionCall (NodeF (Lexeme Text) (Node (Lexeme Text)) -> Node (Lexeme Text)
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Lexeme Text -> NodeF (Lexeme Text) (Node (Lexeme Text))
forall lexeme a. lexeme -> NodeF lexeme a
VarExpr (Lexeme Text -> LexemeClass -> Text -> Lexeme Text
forall a. Lexeme a -> LexemeClass -> a -> Lexeme a
mkLAt Lexeme Text
memName LexemeClass
IdVar Text
fun)))
                [ Node (Lexeme Text) -> Node (Lexeme Text)
prefix (NodeF (Lexeme Text) (Node (Lexeme Text)) -> Node (Lexeme Text)
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Node (Lexeme Text)
-> Lexeme Text -> NodeF (Lexeme Text) (Node (Lexeme Text))
forall lexeme a. a -> lexeme -> NodeF lexeme a
PointerAccess (NodeF (Lexeme Text) (Node (Lexeme Text)) -> Node (Lexeme Text)
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Lexeme Text -> NodeF (Lexeme Text) (Node (Lexeme Text))
forall lexeme a. lexeme -> NodeF lexeme a
VarExpr Lexeme Text
varName)) Lexeme Text
memName))
                , NodeF (Lexeme Text) (Node (Lexeme Text)) -> Node (Lexeme Text)
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Lexeme Text -> NodeF (Lexeme Text) (Node (Lexeme Text))
forall lexeme a. lexeme -> NodeF lexeme a
VarExpr (Lexeme Text -> LexemeClass -> Text -> Lexeme Text
forall a. Lexeme a -> LexemeClass -> a -> Lexeme a
mkLAt Lexeme Text
memName LexemeClass
IdVar Text
"bp"))
                ])


analyse :: [(FilePath, [Node (Lexeme Text)])] -> [Text]
analyse :: [([Char], [Node (Lexeme Text)])] -> [Text]
analyse = Text -> MkFunBody -> [([Char], [Node (Lexeme Text)])] -> [Text]
analyseStructs Text
funSuffix MkFunBody
mkFunBody

descr :: ([(FilePath, [Node (Lexeme Text)])] -> [Text], (Text, Text))
descr :: ([([Char], [Node (Lexeme Text)])] -> [Text], (Text, Text))
descr = ([([Char], [Node (Lexeme Text)])] -> [Text]
analyse, (Text
"struct-pack", [Text] -> Text
Text.unlines
    [ Text
"Checks that `_pack` functions for `struct`s are complete and correct."
    , Text
""
    , Text
"**Reason:** we provide `pack` functions for `struct` but don't want to"
    , Text
"manually maintain them. This linter checks that the function is exactly what"
    , Text
"we want it to be, and the error message will say what the function should look"
    , Text
"like."
    ]))