<commit_before>-- | Ivory backend for AADL descriptions of struct types

module Ivory.Compile.AADL.Gen where

import qualified Ivory.Language.Syntax as I

import qualified Data.Set as Set
import Data.List (find)

import Ivory.Compile.AADL.AST
import Ivory.Compile.AADL.Monad
import Ivory.Compile.AADL.Identifier

--------------------------------------------------------------------------------
-- | Compile a struct.
compileStruct :: I.Struct -> Compile
compileStruct def = case def of
  I.Struct n fs -> do
    ftypes <- mapM mkField fs
    writeImport "Data_Model"
    writeTypeDefinition $ DTStruct (identifier n) ftypes
  _ -> return ()

mkField :: I.Typed String -> CompileM DTField
mkField field = do
  t <- mkType (I.tType field)
  return $ DTField (I.tValue field) t

mkType :: I.Type -> CompileM TypeName
mkType ty = case ty of
    I.TyVoid              -> basetype "Void"
    I.TyChar              -> basetype "Char"
    I.TyInt i             -> intSize i
    I.TyWord w            -> wordSize w
    I.TyBool              -> basetype "Bool"
    I.TyFloat             -> basetype "Float"
    I.TyDouble            -> basetype "Double"
    I.TyStruct n          -> structType n
    I.TyConstRef _t       -> error "cannot translate TyConstRef"
    I.TyRef t             -> mkType t  -- LOSSY
    I.TyPtr _t            -> error "cannot translate TyPtr"
    I.TyArr len t         -> mkType t >>= \t' -> arrayType len t'
    I.TyCArray _t         -> error "cannot translate TyCArray"
    I.TyProc _retT _argTs -> error "cannot translate TyProc"
    I.TyOpaque            -> error "cannot translate TyOpaque"
  where
  basetype :: String -> CompileM TypeName
  basetype t = qualTypeName "Base_Types" t

  intSize :: I.IntSize -> CompileM TypeName
  intSize I.Int8  = basetype "Signed_8"
  intSize I.Int16 = basetype "Signed_16"
  intSize I.Int32 = basetype "Signed_32"
  intSize I.Int64 = basetype "Signed_64"

  wordSize :: I.WordSize -> CompileM TypeName
  wordSize I.Word8  = basetype "Unsigned_8"
  wordSize I.Word16 = basetype "Unsigned_16"
  wordSize I.Word32 = basetype "Unsigned_32"
  wordSize I.Word64 = basetype "Unsigned_64"

arrayType :: Int -> TypeName -> CompileM TypeName
arrayType len basetype = do
  writeImport "Data_Model"
  writeTypeDefinition dtarray
  return $ UnqualTypeName (identifier arraytn)<commit_msg>aadl: change bool and integer base type names<commit_after>-- | Ivory backend for AADL descriptions of struct types

module Ivory.Compile.AADL.Gen where

import qualified Ivory.Language.Syntax as I

import qualified Data.Set as Set
import Data.List (find)

import Ivory.Compile.AADL.AST
import Ivory.Compile.AADL.Monad
import Ivory.Compile.AADL.Identifier

--------------------------------------------------------------------------------
-- | Compile a struct.
compileStruct :: I.Struct -> Compile
compileStruct def = case def of
  I.Struct n fs -> do
    ftypes <- mapM mkField fs
    writeImport "Data_Model"
    writeTypeDefinition $ DTStruct (identifier n) ftypes
  _ -> return ()

mkField :: I.Typed String -> CompileM DTField
mkField field = do
  t <- mkType (I.tType field)
  return $ DTField (I.tValue field) t

mkType :: I.Type -> CompileM TypeName
mkType ty = case ty of
    I.TyVoid              -> basetype "Void"
    I.TyChar              -> basetype "Char"
    I.TyInt i             -> intSize i
    I.TyWord w            -> wordSize w
    I.TyBool              -> basetype "Boolean"
    I.TyFloat             -> basetype "Float"
    I.TyDouble            -> basetype "Double"
    I.TyStruct n          -> structType n
    I.TyConstRef _t       -> error "cannot translate TyConstRef"
    I.TyRef t             -> mkType t  -- LOSSY
    I.TyPtr _t            -> error "cannot translate TyPtr"
    I.TyArr len t         -> mkType t >>= \t' -> arrayType len t'
    I.TyCArray _t         -> error "cannot translate TyCArray"
    I.TyProc _retT _argTs -> error "cannot translate TyProc"
    I.TyOpaque            -> error "cannot translate TyOpaque"
  where
  basetype :: String -> CompileM TypeName
  basetype t = qualTypeName "Base_Types" t

  intSize :: I.IntSize -> CompileM TypeName
  intSize I.Int8  = basetype "Integer_8"
  intSize I.Int16 = basetype "Integer_16"
  intSize I.Int32 = basetype "Integer_32"
  intSize I.Int64 = basetype "Integer_64"

  wordSize :: I.WordSize -> CompileM TypeName
  wordSize I.Word8  = basetype "Unsigned_8"
  wordSize I.Word16 = basetype "Unsigned_16"
  wordSize I.Word32 = basetype "Unsigned_32"
  wordSize I.Word64 = basetype "Unsigned_64"

arrayType :: Int -> TypeName -> CompileM TypeName
arrayType len basetype = do
  writeImport "Data_Model"
  writeTypeDefinition dtarray
  return $ UnqualTypeName (identifier arraytn)
{'fraction_non_alphanumeric': 0.12136025504782147, 'fraction_numerical': 0.011902231668437832, 'mean_word_length': 2.2590027700831024, 'pattern_counts': {'":': 0, '<': 7, '<?xml version=': 0, '>': 59, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '3741774', 'n_tokens_mistral': 1561, 'n_tokens_neox': 1479, 'n_words': 460}