module Cryptol.Prims.Syntax
( TFun(..), tBinOpPrec, tfunNames
) where
import Cryptol.Parser.Name (PName,mkUnqual)
import Cryptol.Utils.Ident (packIdent,packInfix)
import Cryptol.Utils.PP
import qualified Data.Map as Map
import GHC.Generics (Generic)
import Control.DeepSeq.Generics
data TFun
= TCAdd
| TCSub
| TCMul
| TCDiv
| TCMod
| TCExp
| TCWidth
| TCMin
| TCMax
| TCLenFromThen
| TCLenFromThenTo
deriving (Show, Eq, Ord, Bounded, Enum, Generic)
instance NFData TFun where rnf = genericRnf
tBinOpPrec :: Map.Map TFun (Assoc,Int)
tBinOpPrec = mkMap t_table
where
mkMap t = Map.fromList [ (op,(a,n)) | ((a,ops),n) <- zip t [1..] , op <- ops ]
t_table =
[ (LeftAssoc, [ TCAdd, TCSub ])
, (LeftAssoc, [ TCMul, TCDiv, TCMod ])
, (RightAssoc, [ TCExp ])
]
tfunNames :: Map.Map PName TFun
tfunNames = Map.fromList
[ tinfix "+" TCAdd
, tinfix "-" TCSub
, tinfix "*" TCMul
, tinfix "/" TCDiv
, tinfix "%" TCMod
, tinfix "^^" TCExp
, tprefix "width" TCWidth
, tprefix "min" TCMin
, tprefix "max" TCMax
, tprefix "lengthFromThen" TCLenFromThen
, tprefix "lengthFromThenTo" TCLenFromThenTo
]
where
tprefix n p = (mkUnqual (packIdent n), p)
tinfix n p = (mkUnqual (packInfix n), p)
instance PP TFun where
ppPrec _ tcon =
case tcon of
TCAdd -> text "+"
TCSub -> text "-"
TCMul -> text "*"
TCDiv -> text "/"
TCMod -> text "%"
TCExp -> text "^^"
TCWidth -> text "width"
TCMin -> text "min"
TCMax -> text "max"
TCLenFromThen -> text "lengthFromThen"
TCLenFromThenTo -> text "lengthFromThenTo"