diff --git a/.github/workflows/nightly.yml b/.github/workflows/nightly.yml index 2fd65442..79a57934 100644 --- a/.github/workflows/nightly.yml +++ b/.github/workflows/nightly.yml @@ -38,7 +38,7 @@ jobs: ghc-version: "8.8" - shell: bash - run: cabal v2-build exe:cryptol exe:cryptol-html + run: cabal -j1 v2-build exe:cryptol exe:cryptol-html - shell: bash run: .github/ci.sh setup_dist_bins diff --git a/src/Cryptol/Eval.hs b/src/Cryptol/Eval.hs index 8e56f4a3..eb86a8f0 100644 --- a/src/Cryptol/Eval.hs +++ b/src/Cryptol/Eval.hs @@ -359,7 +359,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 :: diff --git a/src/Cryptol/Eval/Generic.hs b/src/Cryptol/Eval/Generic.hs index 955b07e1..0f7ae997 100644 --- a/src/Cryptol/Eval/Generic.hs +++ b/src/Cryptol/Eval/Generic.hs @@ -871,7 +871,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 @@ -879,7 +879,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 diff --git a/src/Cryptol/Parser.y b/src/Cryptol/Parser.y index 02917161..3f68ad03 100644 --- a/src/Cryptol/Parser.y +++ b/src/Cryptol/Parser.y @@ -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 [] } diff --git a/src/Cryptol/Parser/AST.hs b/src/Cryptol/Parser/AST.hs index 9509a8f9..391d0769 100644 --- a/src/Cryptol/Parser/AST.hs +++ b/src/Cryptol/Parser/AST.hs @@ -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 diff --git a/src/Cryptol/Parser/LexerUtils.hs b/src/Cryptol/Parser/LexerUtils.hs index 9781accd..a5030ad6 100644 --- a/src/Cryptol/Parser/LexerUtils.hs +++ b/src/Cryptol/Parser/LexerUtils.hs @@ -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' diff --git a/src/Cryptol/Parser/ParserUtils.hs b/src/Cryptol/Parser/ParserUtils.hs index 60f57fa2..cbca9cb7 100644 --- a/src/Cryptol/Parser/ParserUtils.hs +++ b/src/Cryptol/Parser/ParserUtils.hs @@ -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 diff --git a/src/Cryptol/Parser/Utils.hs b/src/Cryptol/Parser/Utils.hs index 858c179b..1a5e35c0 100644 --- a/src/Cryptol/Parser/Utils.hs +++ b/src/Cryptol/Parser/Utils.hs @@ -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 diff --git a/src/Cryptol/TypeCheck/Infer.hs b/src/Cryptol/TypeCheck/Infer.hs index 4406f8c3..59f9d5ca 100644 --- a/src/Cryptol/TypeCheck/Infer.hs +++ b/src/Cryptol/TypeCheck/Infer.hs @@ -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))