module Cryptol.Prims.Syntax
( TFun(..)
, ECon(..)
, eBinOpPrec
, tBinOpPrec
, ppPrefix
) where
import Cryptol.Utils.PP
import qualified Data.Map as Map
data TFun
= TCAdd
| TCSub
| TCMul
| TCDiv
| TCMod
| TCLg2
| TCExp
| TCWidth
| TCMin
| TCMax
| TCLenFromThen
| TCLenFromThenTo
deriving (Show, Eq, Ord, Bounded, Enum)
data ECon
= ECTrue
| ECFalse
| ECDemote
| ECPlus | ECMinus | ECMul | ECDiv | ECMod
| ECExp | ECLg2 | ECNeg
| ECLt | ECGt | ECLtEq | ECGtEq | ECEq | ECNotEq
| ECFunEq | ECFunNotEq
| ECMin | ECMax
| ECAnd | ECOr | ECXor | ECCompl | ECZero
| ECShiftL | ECShiftR | ECRotL | ECRotR
| ECCat | ECSplitAt
| ECJoin | ECSplit
| ECReverse | ECTranspose
| ECAt | ECAtRange | ECAtBack | ECAtRangeBack
| ECFromThen | ECFromTo | ECFromThenTo
| ECInfFrom | ECInfFromThen
| ECError
| ECPMul | ECPDiv | ECPMod
| ECRandom
deriving (Eq,Ord,Show,Bounded,Enum)
eBinOpPrec :: Map.Map ECon (Assoc,Int)
tBinOpPrec :: Map.Map TFun (Assoc,Int)
(eBinOpPrec, tBinOpPrec) = (mkMap e_table, mkMap t_table)
where
mkMap t = Map.fromList [ (op,(a,n)) | ((a,ops),n) <- zip t [0..] , op <- ops ]
e_table =
[ (LeftAssoc, [ ECOr ])
, (LeftAssoc, [ ECXor ])
, (LeftAssoc, [ ECAnd ])
, (NonAssoc, [ ECEq, ECNotEq, ECFunEq, ECFunNotEq ])
, (NonAssoc, [ ECLt, ECGt, ECLtEq, ECGtEq ])
, (RightAssoc, [ ECCat ])
, (LeftAssoc, [ ECShiftL, ECShiftR, ECRotL, ECRotR ])
, (LeftAssoc, [ ECPlus, ECMinus ])
, (LeftAssoc, [ ECMul, ECDiv, ECMod ])
, (RightAssoc, [ ECExp ])
, (LeftAssoc, [ ECAt, ECAtRange, ECAtBack, ECAtRangeBack ])
]
t_table =
[ (LeftAssoc, [ TCAdd, TCSub ])
, (LeftAssoc, [ TCMul, TCDiv, TCMod ])
, (RightAssoc, [ TCExp ])
]
instance PP TFun where
ppPrec _ tcon =
case tcon of
TCAdd -> text "+"
TCSub -> text "-"
TCMul -> text "*"
TCDiv -> text "/"
TCMod -> text "%"
TCLg2 -> text "lg2"
TCExp -> text "^^"
TCWidth -> text "width"
TCMin -> text "min"
TCMax -> text "max"
TCLenFromThen -> text "lengthFromThen"
TCLenFromThenTo -> text "lengthFromThenTo"
instance PP ECon where
ppPrec _ con =
case con of
ECTrue -> text "True"
ECFalse -> text "False"
ECPlus -> text "+"
ECMinus -> text "-"
ECMul -> text "*"
ECDiv -> text "/"
ECMod -> text "%"
ECExp -> text "^^"
ECLg2 -> text "lg2"
ECNeg -> text "-"
ECLt -> text "<"
ECGt -> text ">"
ECLtEq -> text "<="
ECGtEq -> text ">="
ECEq -> text "=="
ECNotEq -> text "!="
ECFunEq -> text "==="
ECFunNotEq -> text "!=="
ECAnd -> text "&&"
ECOr -> text "||"
ECXor -> text "^"
ECCompl -> text "~"
ECShiftL -> text "<<"
ECShiftR -> text ">>"
ECRotL -> text "<<<"
ECRotR -> text ">>>"
ECCat -> text "#"
ECAt -> text "@"
ECAtRange -> text "@@"
ECAtBack -> text "!"
ECAtRangeBack -> text "!!"
ECMin -> text "min"
ECMax -> text "max"
ECSplitAt -> text "splitAt"
ECZero -> text "zero"
ECJoin -> text "join"
ECSplit -> text "split"
ECReverse -> text "reverse"
ECTranspose -> text "transpose"
ECDemote -> text "demote"
ECFromThen -> text "fromThen"
ECFromTo -> text "fromTo"
ECFromThenTo -> text "fromThenTo"
ECInfFrom -> text "infFrom"
ECInfFromThen -> text "infFromThen"
ECError -> text "error"
ECPMul -> text "pmult"
ECPDiv -> text "pdiv"
ECPMod -> text "pmod"
ECRandom -> text "random"
ppPrefix :: ECon -> Doc
ppPrefix con = optParens (Map.member con eBinOpPrec) (pp con)