Names.hs

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE PatternGuards    #-}

{- |
Module      :  $Header$
Description :  CAO Translation naming.
Copyright   :  (c) SMART Team / HASLab
License     :  GPL

Maintainer  :  Paulo Silva <paufil@di.uminho.pt>
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