{- 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