From c52dadcf22bed865a2ee98dc3c8b3190e769075e Mon Sep 17 00:00:00 2001 From: Adam Wick Date: Thu, 31 Oct 2019 16:37:16 -0400 Subject: [PATCH] Some commits in the way of cleaning up the Rust and generating module lists. --- generation/generation.cabal | 5 +- generation/src/Base.hs | 26 +----- generation/src/BinaryOps.hs | 6 +- generation/src/Compare.hs | 4 +- generation/src/Conversions.hs | 10 +- generation/src/CryptoNum.hs | 49 +++++++++- generation/src/File.hs | 166 +++++++++++++++++++++------------- generation/src/Generators.hs | 19 ++++ generation/src/Main.hs | 33 +++---- src/lib.rs | 1 + src/signed.rs | 0 11 files changed, 203 insertions(+), 116 deletions(-) create mode 100644 generation/src/Generators.hs create mode 100644 src/signed.rs diff --git a/generation/generation.cabal b/generation/generation.cabal index 5c5f675..4225bc5 100644 --- a/generation/generation.cabal +++ b/generation/generation.cabal @@ -17,14 +17,15 @@ extra-source-files: CHANGELOG.md executable generation main-is: Main.hs - other-modules: Base, BinaryOps, Compare, Conversions, CryptoNum, File, Gen + other-modules: Base, BinaryOps, Compare, Conversions, CryptoNum, File, Gen, Generators -- other-extensions: build-depends: base >= 4.12.0.0, containers, directory, filepath, language-rust, - mtl + mtl, + random hs-source-dirs: src default-language: Haskell2010 ghc-options: -Wall diff --git a/generation/src/Base.hs b/generation/src/Base.hs index fe52a76..f6ab57b 100644 --- a/generation/src/Base.hs +++ b/generation/src/Base.hs @@ -14,7 +14,9 @@ base :: File base = File { predicate = \ _ _ -> True, outputName = "base", - generator = declareBaseStructure + isUnsigned = True, + generator = declareBaseStructure, + testCase = Nothing } declareBaseStructure :: Word -> SourceFile Span @@ -86,25 +88,3 @@ buildPrints entries printer = go (entries - 1) -- Lit [] (Int Dec (fromIntegral x) Unsuffixed mempty) mempty cur = [stmt| write!(f, $$(litStr), self.value[$$(curi)])?; |] in cur : rest - --- implFor "fmt::UpperHex" name $ --- wrapIndent "fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result" $ --- do forM_ (reverse [1..top]) $ \ i -> --- out ("write!(f, \"{:X}\", self.value[" ++ show i ++ "])?;") --- out "write!(f, \"{:X}\", self.value[0])" --- blank --- implFor "fmt::LowerHex" name $ --- wrapIndent "fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result" $ --- do forM_ (reverse [1..top]) $ \ i -> --- out ("write!(f, \"{:x}\", self.value[" ++ show i ++ "])?;") --- out "write!(f, \"{:x}\", self.value[0])" --- blank --- implFor "Arbitrary" name $ --- wrapIndent "fn arbitrary(g: &mut G) -> Self" $ --- do out (name ++ " {") --- indent $ --- do out ("value: [") --- indent $ forM_ [0..top] $ \ _ -> --- out ("g.next_u64(),") --- out ("]") --- out ("}") diff --git a/generation/src/BinaryOps.hs b/generation/src/BinaryOps.hs index 6a8e5aa..f2cd991 100644 --- a/generation/src/BinaryOps.hs +++ b/generation/src/BinaryOps.hs @@ -15,7 +15,9 @@ binaryOps :: File binaryOps = File { predicate = \ _ _ -> True, outputName = "binary", - generator = declareBinaryOperators + isUnsigned = True, + generator = declareBinaryOperators, + testCase = Nothing } declareBinaryOperators :: Word -> SourceFile Span @@ -81,7 +83,7 @@ declareBinaryOperators bitsize = } fn or_associative(a: $$struct_name, b: $$struct_name, c: $$struct_name) -> bool { - ((&a | &b) & &c) == (&a | (&b | &c)) + ((&a | &b) | &c) == (&a | (&b | &c)) } fn or_commutative(a: $$struct_name, b: $$struct_name) -> bool { (&a | &b) == (&b | &a) diff --git a/generation/src/Compare.hs b/generation/src/Compare.hs index 18e0d54..2c5d189 100644 --- a/generation/src/Compare.hs +++ b/generation/src/Compare.hs @@ -12,7 +12,9 @@ comparisons :: File comparisons = File { predicate = \ _ _ -> True, outputName = "compare", - generator = declareComparators + isUnsigned = True, + generator = declareComparators, + testCase = Nothing } declareComparators :: Word -> SourceFile Span diff --git a/generation/src/Conversions.hs b/generation/src/Conversions.hs index ec5e8ab..ee98bd4 100644 --- a/generation/src/Conversions.hs +++ b/generation/src/Conversions.hs @@ -15,7 +15,9 @@ conversions :: File conversions = File { predicate = \ _ _ -> True, outputName = "conversions", - generator = declareConversions + isUnsigned = True, + generator = declareConversions, + testCase = Nothing } declareConversions :: Word -> SourceFile Span @@ -26,17 +28,17 @@ declareConversions bitsize = u16_prims = buildPrimitives sname (mkIdent "u16") entries u32_prims = buildPrimitives sname (mkIdent "u32") entries u64_prims = buildPrimitives sname (mkIdent "u64") entries + usz_prims = buildPrimitives sname (mkIdent "usize") entries u128_prims = generateU128Primitives sname entries i8_prims = generateSignedPrims sname (mkIdent "u8") (mkIdent "i8") i16_prims = generateSignedPrims sname (mkIdent "u16") (mkIdent "i16") i32_prims = generateSignedPrims sname (mkIdent "u32") (mkIdent "i32") i64_prims = generateSignedPrims sname (mkIdent "u64") (mkIdent "i64") + isz_prims = buildPrimitives sname (mkIdent "isize") entries i128_prims = generateI128Primitives sname in [sourceFile| use core::convert::{From,TryFrom}; use crate::CryptoNum; - #[cfg(test)] - use quickcheck::quickcheck; use super::$$sname; use crate::ConversionError; @@ -44,12 +46,14 @@ declareConversions bitsize = $@{u16_prims} $@{u32_prims} $@{u64_prims} + $@{usz_prims} $@{u128_prims} $@{i8_prims} $@{i16_prims} $@{i32_prims} $@{i64_prims} + $@{isz_prims} $@{i128_prims} |] diff --git a/generation/src/CryptoNum.hs b/generation/src/CryptoNum.hs index e498f40..d2840f8 100644 --- a/generation/src/CryptoNum.hs +++ b/generation/src/CryptoNum.hs @@ -4,18 +4,28 @@ module CryptoNum( ) where +import Data.Bits(testBit) +import Data.Map.Strict(Map) +import qualified Data.Map.Strict as Map import File import Gen +import Generators import Language.Rust.Data.Ident import Language.Rust.Data.Position import Language.Rust.Quote import Language.Rust.Syntax +import System.Random(RandomGen) + +numTestCases :: Int +numTestCases = 3000 cryptoNum :: File cryptoNum = File { predicate = \ _ _ -> True, outputName = "cryptonum", - generator = declareCryptoNumInstance + isUnsigned = True, + generator = declareCryptoNumInstance, + testCase = Just generateTests } declareCryptoNumInstance :: Word -> SourceFile Span @@ -35,6 +45,8 @@ declareCryptoNumInstance bitsize = entrieslit = toLit entries in [sourceFile| use core::cmp::min; + #[cfg(test)] + use core::convert::TryFrom; use crate::CryptoNum; #[cfg(test)] use crate::testing::{build_test_path,run_test}; @@ -134,6 +146,23 @@ declareCryptoNumInstance bitsize = let (neg5, rbytes) = case.get("r").unwrap(); let (neg6, bbytes) = case.get("b").unwrap(); let (neg7, tbytes) = case.get("t").unwrap(); + + assert!(!neg0 && !neg1 && !neg2 && !neg3 && + !neg4 && !neg5 && !neg6 && !neg7); + let mut x = $$sname::from_bytes(&xbytes); + let z = 1 == zbytes[0]; + let e = 1 == ebytes[0]; + let o = 1 == obytes[0]; + let t = 1 == tbytes[0]; + let m = usize::try_from($$sname::from_bytes(&mbytes)).unwrap(); + let b = usize::try_from($$sname::from_bytes(&bbytes)).unwrap(); + let r = $$sname::from_bytes(&rbytes); + assert_eq!(x.is_zero(), z); + assert_eq!(x.is_even(), e); + assert_eq!(x.is_odd(), o); + assert_eq!(x.testbit(b), t); + x.mask(m); + assert_eq!(x, r); }); } |] @@ -145,3 +174,21 @@ generateZeroTests i entries let ilit = toLit i in [stmt| result &= self.value[$$(ilit)] == 0; |] : generateZeroTests (i + 1) entries + +generateTests :: RandomGen g => Word -> g -> [Map String String] +generateTests size g = go g numTestCases + where + go _ 0 = [] + go g0 i = + let (x, g1) = generateNum g0 size + (m, g2) = generateNum g1 size + (b, g3) = generateNum g2 16 + m' = m `mod` (fromIntegral size `div` 64) + r = m `mod` (2 ^ (64 * m')) + t = x `testBit` (fromIntegral b) + tcase = Map.fromList [("x", showX x), ("z", showB (x == 0)), + ("e", showB (even x)), ("o", showB (odd x)), + ("m", showX m'), ("r", showX r), + ("b", showX b), ("t", showB t)] + in tcase : go g3 (i - 1) + diff --git a/generation/src/File.hs b/generation/src/File.hs index 619a657..9231f50 100644 --- a/generation/src/File.hs +++ b/generation/src/File.hs @@ -1,91 +1,129 @@ {-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE RankNTypes #-} module File( File(..), Task(..), - addModuleTasks, - makeTask + generateTasks ) where +import Control.Monad(forM_) import Data.Char(toUpper) +import Data.List(isPrefixOf) import Data.Map.Strict(Map) import qualified Data.Map.Strict as Map -import System.FilePath(takeBaseName,takeDirectory,takeFileName,()) -import Language.Rust.Data.Ident(Ident,mkIdent) +import Language.Rust.Data.Ident(mkIdent) import Language.Rust.Data.Position(Span) +import Language.Rust.Pretty(writeSourceFile) import Language.Rust.Quote(item,sourceFile) -import Language.Rust.Syntax(Item,SourceFile) +import Language.Rust.Syntax(SourceFile) +import System.FilePath(dropExtension,splitFileName,takeFileName,()) +import System.IO(Handle,hPutStrLn) +import System.Random(RandomGen(..)) data File = File { predicate :: Word -> [Word] -> Bool, outputName :: FilePath, - generator :: Word -> SourceFile Span + isUnsigned :: Bool, + generator :: Word -> SourceFile Span, + testCase :: forall g. RandomGen g => Maybe (Word -> g -> [Map String String]) } data Task = Task { outputFile :: FilePath, - fileData :: SourceFile Span + writer :: Handle -> IO () } -makeTask :: FilePath -> - Word -> [Word] -> - File -> - Maybe Task -makeTask base size allSizes file - | predicate file size allSizes = - Just Task { - outputFile = base ("u" ++ show size) outputName file <> ".rs", - fileData = generator file size - } - | otherwise = - Nothing - -addModuleTasks :: FilePath -> [Task] -> [Task] -addModuleTasks base baseTasks = unsignedTask : (baseTasks ++ moduleTasks) +show5 :: Word -> String +show5 = go . show where - moduleMap :: Map String [String] - moduleMap = foldr addModuleInfo Map.empty baseTasks + go x | length x < 5 = go ('0' : x) + | otherwise = x - addModuleInfo :: Task -> Map String [String] -> Map String [String] - addModuleInfo task = - Map.insertWith (++) (takeDirectory (outputFile task)) - [takeBaseName (outputFile task)] +generateTasks :: RandomGen g => g -> [File] -> [Word] -> [Task] +generateTasks rng files sizes = basicTasks ++ moduleTasks + where + basicTasks = go rng files sizes + moduleTasks = generateModules basicTasks + -- + go :: RandomGen g => g -> [File] -> [Word] -> [Task] + go _ [] _ = [] + go g (_:rest) [] = go g rest sizes + go g files'@(file:_) (size:rest) + | not (predicate file size sizes) = go g files' rest + | otherwise = + let (myg, theirg) = split g + tasks = go theirg files' rest + signedBit = if isUnsigned file then "unsigned" else "signed" + mainTask = Task { + outputFile = "src" signedBit ("u" ++ show size) + outputName file ++ ".rs", + writer = \ hndl -> writeSourceFile hndl (generator file size) + } + in case testCase file of + Nothing -> + mainTask : tasks + Just caseGenerator -> + let testTask = Task { + outputFile = "testdata" outputName file + ("U" ++ show5 size ++ ".test"), + writer = \ hndl -> writeTestCase hndl (caseGenerator size myg) + } + in testTask : mainTask : tasks - moduleTasks :: [Task] - moduleTasks = Map.foldrWithKey generateModuleTask [] moduleMap +generateModules :: [Task] -> [Task] +generateModules tasks = Map.foldrWithKey maddModule [] fileMap ++ [unsignedTask] + where + maddModule path mods acc + | "src/unsigned" `isPrefixOf` path = + let (basePath, lowerName) = splitFileName (init path) + upperName = map toUpper lowerName + task = Task { + outputFile = basePath lowerName ++ ".rs", + writer = \ hndl -> + do forM_ mods $ \ modl -> + hPutStrLn hndl ("mod " ++ modl ++ ";") + hPutStrLn hndl ("pub use base::" ++ upperName ++ ";") + } + in task : acc + | otherwise = + acc + fileMap = foldr buildBaseMap Map.empty tasks + buildBaseMap task acc = + let (dir, fileext) = splitFileName (outputFile task) + file = dropExtension fileext + in Map.insertWith (++) dir [file] acc + -- + unsignedTask = + let mods = Map.foldrWithKey topModule [] fileMap + pubuses = Map.foldrWithKey pubUse [] fileMap + in Task { + outputFile = "src" "unsigned.rs", + writer = \ hndl -> + writeSourceFile hndl [sourceFile| + $@{mods} + $@{pubuses} + |] + } + topModule path _ acc + | "src/unsigned" `isPrefixOf` path = + let lowerName = takeFileName (init path) + modl = mkIdent lowerName + in [item| mod $$modl; |] : acc + | otherwise = + acc + pubUse path _ acc + | "src/unsigned" `isPrefixOf` path = + let lowerName = takeFileName (init path) + tname = mkIdent (map toUpper lowerName) + modl = mkIdent lowerName + in [item| pub use $$modl::$$tname; |] : acc + | otherwise = + acc - generateModuleTask :: String -> [String] -> [Task] -> [Task] - generateModuleTask directory mods acc = acc ++ [Task { - outputFile = directory "mod.rs", - fileData = - let modules = map (buildModule . mkIdent) mods - user = mkIdent (upcase (takeFileName directory)) - in [sourceFile| - $@{modules} - pub use base::$$user; - |] - }] - unsignedTask :: Task - unsignedTask = Task { - outputFile = base "unsigned" "mod.rs", - fileData = - let modules = map (buildModule . mkIdent . takeFileName) (Map.keys moduleMap) - uses = map (buildUse . takeFileName) (Map.keys moduleMap) - in [sourceFile| - $@{modules} - $@{uses} - |] - } - -buildModule :: Ident -> Item Span -buildModule x = [item| mod $$x; |] - -buildUse :: String -> Item Span -buildUse x = - let base = mkIdent x - up = mkIdent (upcase x) - in [item| pub use $$base::$$up; |] - -upcase :: String -> String -upcase = map toUpper +writeTestCase :: Handle -> [Map String String] -> IO () +writeTestCase hndl tests = + forM_ tests $ \ test -> + forM_ (Map.toList test) $ \ (key, value) -> + hPutStrLn hndl (key ++ ": " ++ value) diff --git a/generation/src/Generators.hs b/generation/src/Generators.hs new file mode 100644 index 0000000..aa92f1a --- /dev/null +++ b/generation/src/Generators.hs @@ -0,0 +1,19 @@ +module Generators + where + +import Numeric(showHex) +import System.Random(RandomGen,random) + +generateNum :: RandomGen g => g -> Word -> (Integer, g) +generateNum g size = + let (x, g') = random g + x' = x `mod` (2 ^ size) + in (x', g') + +showX :: Integer -> String +showX x | x < 0 = "-" ++ showX (abs x) + | otherwise = showHex x "" + +showB :: Bool -> String +showB False = "0" +showB True = "1" diff --git a/generation/src/Main.hs b/generation/src/Main.hs index 30e63e4..5573a65 100644 --- a/generation/src/Main.hs +++ b/generation/src/Main.hs @@ -7,14 +7,13 @@ import Compare(comparisons) import Conversions(conversions) import CryptoNum(cryptoNum) import Control.Monad(forM_,unless) -import Data.Maybe(mapMaybe) -import File(File,Task(..),addModuleTasks,makeTask) -import Language.Rust.Pretty(writeSourceFile) +import File(File,Task(..),generateTasks) import System.Directory(createDirectoryIfMissing) import System.Environment(getArgs) import System.Exit(die) import System.FilePath(takeDirectory,()) -import System.IO(IOMode(..),hPutStrLn,withFile) +import System.IO(IOMode(..),withFile) +import System.Random(getStdGen) lowestBitsize :: Word lowestBitsize = 192 @@ -38,26 +37,20 @@ signedFiles :: [File] signedFiles = [ ] -makeTasks :: FilePath -> [File] -> [Task] -makeTasks basePath files = - concatMap (\ sz -> mapMaybe (makeTask basePath sz bitsizes) files) bitsizes - -makeAllTasks :: FilePath -> [Task] -makeAllTasks basePath = addModuleTasks basePath $ - makeTasks (basePath "unsigned") unsignedFiles ++ - makeTasks (basePath "signed") signedFiles +allFiles :: [File] +allFiles = unsignedFiles ++ signedFiles main :: IO () main = do args <- getArgs unless (length args == 1) $ die ("generation takes exactly one argument, the target directory") - let tasks = makeAllTasks (head args) - total = length tasks - forM_ (zip [(1::Word)..] tasks) $ \ (i, task) -> + g <- getStdGen + let allTasks = generateTasks g allFiles bitsizes + total = length allTasks + forM_ (zip [(1::Word)..] allTasks) $ \ (i, task) -> do putStrLn ("[" ++ show i ++ "/" ++ show total ++ "] " ++ outputFile task) - createDirectoryIfMissing True (takeDirectory (outputFile task)) - withFile (outputFile task) WriteMode $ \ targetHandle -> - do hPutStrLn targetHandle - "// WARNING: This file was automatically generated. Do not edit!" - writeSourceFile targetHandle (fileData task) + let target = head args outputFile task + createDirectoryIfMissing True (takeDirectory target) + withFile target WriteMode $ \ targetHandle -> + writer task targetHandle diff --git a/src/lib.rs b/src/lib.rs index de7a747..861a6b4 100644 --- a/src/lib.rs +++ b/src/lib.rs @@ -39,6 +39,7 @@ pub trait CryptoNum { } /// An error in conversion of large numbers (either to primitives or to other numbers +#[derive(Debug)] pub enum ConversionError { NegativeToUnsigned, Overflow diff --git a/src/signed.rs b/src/signed.rs new file mode 100644 index 0000000..e69de29