{- 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 . -}
{- |
Module : $Header$
Description : Mapping of CAO syntax to operation codes.
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
-}
module Language.CAO.Syntax.Codes where
import Language.CAO.Platform.Naming
import Language.CAO.Common.SrcLoc
import Language.CAO.Syntax
instance Codes a => Codes (Located a) where
codeOf (L _ e) = codeOf e
instance Codes a => Codes (TExpr a) where
codeOf (TyE _ e) = codeOf e
instance Codes (Expr a) where
codeOf = opCode
-- Operation names --
opCode :: Expr a -> OpCode
opCode (Lit _) = code_init
opCode (StructProj _ _) = code_select
opCode (UnaryOp op _) = codeOf op
opCode (BinaryOp op _ _) = codeOf op
opCode (Access _ op) = codeOf op
opCode _ =
error $ ". - Not implemented translation"
instance Codes UOp where
codeOf = uopCode
uopCode :: UOp -> OpCode
uopCode op =
case op of
Sym -> code_sym
Not -> code_not
BNot -> code_not
instance Codes (BinOp id) where
codeOf = bopCode
bopCode :: BinOp id -> OpCode
bopCode (ArithOp op) =
case op of
Plus -> code_add
Minus -> code_sub
Times -> code_mul
Power -> code_pow
Div -> code_div
ModOp -> code_mod
bopCode (BoolOp op) =
case op of
Or -> code_or
And -> code_and
Xor -> code_xor
bopCode (BitOp op) =
case op of
BWOr -> code_or
BWAnd -> code_and
BWXor -> code_xor
bopCode (BitsSROp op) =
case op of
SUp -> code_shift_up
SDown -> code_shift_down
RUp -> code_rot_up
RDown -> code_rot_down
bopCode (CmpOp _ op) =
case op of
Eq -> code_equal
Neq -> code_nequal
Leq -> code_lte
Lt -> code_lt
Gt -> code_gt
Geq -> code_gte
bopCode Concat = code_concat
instance Codes (APat id) where
codeOf = apatCode
apatCode :: APat id -> OpCode
apatCode pat =
case pat of
VectP (CElem _) -> code_select
VectP (CRange _ _) -> code_range_select
MatP (CElem _) (CElem _) -> code_select
MatP (CRange _ _) (CRange _ _) -> code_range_select
MatP (CRange _ _) (CElem _) -> code_row_range_select
MatP (CElem _) (CRange _ _) -> code_col_range_select