mirror of
https://github.com/GaloisInc/cryptol.git
synced 2024-09-11 14:06:13 +03:00
Merge pull request #720 from GaloisInc/fromInteger
Avoid using `fromInteger`.
This commit is contained in:
commit
63bfdb2c06
@ -358,7 +358,7 @@ etaWord ::
|
||||
etaWord sym n val = do
|
||||
w <- sDelay sym Nothing (fromWordVal "during eta-expansion" =<< val)
|
||||
xs <- memoMap $ IndexSeqMap $ \i ->
|
||||
do w' <- w; VBit <$> indexWordValue sym w' (toInteger i)
|
||||
do w' <- w; VBit <$> indexWordValue sym w' i
|
||||
pure $ LargeBitsVal n xs
|
||||
|
||||
{-# SPECIALIZE etaDelay ::
|
||||
|
@ -708,7 +708,7 @@ joinSeq sym (Nat parts) each TVBit xs
|
||||
= do let zs = IndexSeqMap $ \i ->
|
||||
do let (q,r) = divMod i each
|
||||
ys <- fromWordVal "join seq" =<< lookupSeqMap xs q
|
||||
VBit <$> indexWordValue sym ys (fromInteger r)
|
||||
VBit <$> indexWordValue sym ys r
|
||||
return $ VWord (parts * each) $ pure $ LargeBitsVal (parts * each) zs
|
||||
|
||||
-- infinite sequence of words
|
||||
@ -716,7 +716,7 @@ joinSeq sym Inf each TVBit xs
|
||||
= return $ VStream $ IndexSeqMap $ \i ->
|
||||
do let (q,r) = divMod i each
|
||||
ys <- fromWordVal "join seq" =<< lookupSeqMap xs q
|
||||
VBit <$> indexWordValue sym ys (fromInteger r)
|
||||
VBit <$> indexWordValue sym ys r
|
||||
|
||||
-- finite or infinite sequence of non-words
|
||||
joinSeq _sym parts each _a xs
|
||||
|
@ -484,7 +484,7 @@ no_sel_aexpr :: { Expr PName }
|
||||
|
||||
| NUM { at $1 $ numLit (tokenType (thing $1)) }
|
||||
| STRLIT { at $1 $ ELit $ ECString $ getStr $1 }
|
||||
| CHARLIT { at $1 $ ELit $ ECNum (getNum $1) CharLit }
|
||||
| CHARLIT { at $1 $ ELit $ ECChar $ getChr $1 }
|
||||
| '_' { at $1 $ EVar $ mkUnqual $ mkIdent "_" }
|
||||
|
||||
| '(' expr ')' { at ($1,$3) $ EParens $2 }
|
||||
@ -672,8 +672,7 @@ atype :: { Type PName }
|
||||
: qname { at $1 $ TUser (thing $1) [] }
|
||||
| '(' qop ')' { at $1 $ TUser (thing $2) [] }
|
||||
| NUM { at $1 $ TNum (getNum $1) }
|
||||
| CHARLIT { at $1 $ TChar (toEnum $ fromInteger
|
||||
$ getNum $1) }
|
||||
| CHARLIT { at $1 $ TChar (getChr $1) }
|
||||
| '[' type ']' { at ($1,$3) $ TSeq $2 TBit }
|
||||
| '(' type ')' { at ($1,$3) $ TParens $2 }
|
||||
| '(' ')' { at ($1,$2) $ TTuple [] }
|
||||
|
@ -277,12 +277,12 @@ data NumInfo = BinLit Int -- ^ n-digit binary literal
|
||||
| OctLit Int -- ^ n-digit octal literal
|
||||
| DecLit -- ^ overloaded decimal literal
|
||||
| HexLit Int -- ^ n-digit hex literal
|
||||
| CharLit -- ^ character literal
|
||||
| PolyLit Int -- ^ polynomial literal
|
||||
deriving (Eq, Show, Generic, NFData)
|
||||
|
||||
-- | Literals.
|
||||
data Literal = ECNum Integer NumInfo -- ^ @0x10@ (HexLit 2)
|
||||
| ECChar Char -- ^ @'a'@
|
||||
| ECString String -- ^ @\"hello\"@
|
||||
deriving (Eq, Show, Generic, NFData)
|
||||
|
||||
@ -623,6 +623,7 @@ instance PP Literal where
|
||||
ppPrec _ lit =
|
||||
case lit of
|
||||
ECNum n i -> ppNumLit n i
|
||||
ECChar c -> text (show c)
|
||||
ECString s -> text (show s)
|
||||
|
||||
|
||||
@ -630,7 +631,6 @@ ppNumLit :: Integer -> NumInfo -> Doc
|
||||
ppNumLit n info =
|
||||
case info of
|
||||
DecLit -> integer n
|
||||
CharLit -> text (show (toEnum (fromInteger n) :: Char))
|
||||
BinLit w -> pad 2 "0b" w
|
||||
OctLit w -> pad 8 "0o" w
|
||||
HexLit w -> pad 16 "0x" w
|
||||
|
@ -213,11 +213,11 @@ splitQual t =
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
numToken :: Integer -> Text -> TokenT
|
||||
numToken rad ds = Num (toVal ds') (fromInteger rad) (T.length ds')
|
||||
numToken :: Int {- ^ base -} -> Text -> TokenT
|
||||
numToken rad ds = Num (toVal ds') rad (T.length ds')
|
||||
where
|
||||
ds' = T.filter (/= '_') ds
|
||||
toVal = T.foldl' (\x c -> rad * x + fromDigit c) 0
|
||||
toVal = T.foldl' (\x c -> toInteger rad * x + fromDigit c) 0
|
||||
|
||||
fromDigit :: Char -> Integer
|
||||
fromDigit x'
|
||||
|
@ -190,6 +190,11 @@ getNum l = case thing l of
|
||||
Token (ChrLit x) _ -> toInteger (fromEnum x)
|
||||
_ -> panic "[Parser] getNum" ["not a number:", show l]
|
||||
|
||||
getChr :: Located Token -> Char
|
||||
getChr l = case thing l of
|
||||
Token (ChrLit x) _ -> x
|
||||
_ -> panic "[Parser] getChr" ["not a char:", show l]
|
||||
|
||||
getStr :: Located Token -> String
|
||||
getStr l = case thing l of
|
||||
Token (StrLit x) _ -> x
|
||||
|
@ -53,6 +53,6 @@ translateExprToNumT expr =
|
||||
TUser f ts -> return (TUser f (ts ++ [t]))
|
||||
_ -> Nothing
|
||||
|
||||
cvtLit (ECNum n CharLit) = return (TChar $ toEnum $ fromInteger n)
|
||||
cvtLit (ECNum n _) = return (TNum n)
|
||||
cvtLit (ECChar c) = return (TChar c)
|
||||
cvtLit (ECString _) = Nothing
|
||||
|
@ -115,7 +115,6 @@ desugarLiteral fixDec lit =
|
||||
P.BinLit n -> [ ("rep", tBits (1 * toInteger n)) ]
|
||||
P.OctLit n -> [ ("rep", tBits (3 * toInteger n)) ]
|
||||
P.HexLit n -> [ ("rep", tBits (4 * toInteger n)) ]
|
||||
P.CharLit -> [ ("rep", tBits (8 :: Integer)) ]
|
||||
P.DecLit
|
||||
| fixDec -> if num == 0
|
||||
then [ ("rep", tBits 0)]
|
||||
@ -125,9 +124,12 @@ desugarLiteral fixDec lit =
|
||||
| otherwise -> [ ]
|
||||
P.PolyLit _n -> [ ("rep", P.TSeq P.TWild P.TBit) ]
|
||||
|
||||
P.ECChar c ->
|
||||
number [ ("val", P.TNum (toInteger (fromEnum c)))
|
||||
, ("rep", tBits (8 :: Integer)) ]
|
||||
|
||||
P.ECString s ->
|
||||
P.ETyped (P.EList [ P.ELit (P.ECNum (toInteger (fromEnum c))
|
||||
P.CharLit) | c <- s ])
|
||||
P.ETyped (P.EList [ P.ELit (P.ECChar c) | c <- s ])
|
||||
(P.TSeq P.TWild (P.TSeq (P.TNum 8) P.TBit))
|
||||
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user