{- CAO Compiler
Copyright (C) 2014 Cryptography and Information Security Group, HASLab - INESC TEC and Universidade do Minho
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see . -}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE PatternGuards #-}
{- |
Module : $Header$
Description : CAO Translation naming.
Copyright : (C) 2014 Cryptography and Information Security Group, HASLab - INESC TEC and Universidade do Minho
License : GPL
Maintainer : Paulo Silva
Stability : experimental
Portability : non-portable
CAO to C tranlation naming.
-}
module Language.CAO.Translation.Names
( moduleHeader
, typePrefix
, fOpCall
, fCastCall
, initName
, disposeName
, opCode
, fCall
, lopName
) where
import Data.List (nub)
import Language.CAO.Common.Outputable
import Language.CAO.Common.Var
import Language.CAO.Platform.Naming
import Language.CAO.Platform.Query
import Language.CAO.Platform.Specification
import Language.CAO.Syntax
import Language.CAO.Syntax.Codes
import Language.CAO.Type
-- Header --
-- This code is importing the headers for all the types defined in the specification of
-- the platform. A more sophisticated mechanism would register the types of the used operations
-- and only generate imports for those.
moduleHeader :: String -> TranslationSpec -> String
moduleHeader fn tspec =
banner ++ concatMap (\m -> "#include \"" ++ m ++ "\"\n")
( nub $ defaultHeader (globalTransSpec tspec) : map headerFile (queryTTS (typeTransSpec tspec)) )
where
banner =
"/*\n\tAutomatically generated by the CAO compiler from file:\n\t" ++
fn ++ "\n*/\n"
lopName :: Type Var -> APat Var -> OpCode
lopName t p =
case p of
VectP (CElem _) -> case t of
Bits _ _ -> code_set
_ -> code_ref
VectP (CRange _ _) -> code_range_set
MatP (CElem _) (CElem _) -> code_ref
MatP (CRange _ _) (CRange _ _) -> code_range_set
MatP (CRange _ _) (CElem _) -> code_row_range_set
MatP (CElem _) (CRange _ _) -> code_col_range_set
fCall :: TranslationSpec -> String -> OpCode -> String
fCall tspec n fs = callPrefix (globalTransSpec tspec) ++ "_" ++ n ++ "_" ++ operName fs
fCastCall :: TranslationSpec -> String -> String -> String
fCastCall tspec orig dest = callPrefix (globalTransSpec tspec) ++ orig ++ "_" ++ (operName code_cast) ++ "_" ++ dest
fOpCall :: PP a => TranslationSpec -> Expr a -> String -> String
fOpCall tspec ex typ = callPrefix (globalTransSpec tspec) ++ typ ++ operName (codeOf ex)
initName, disposeName, typePrefix :: TranslationSpec -> String
initName = initProcName . globalTransSpec
disposeName = disposeProcName . globalTransSpec
typePrefix = tpPrefix . globalTransSpec