Some commits in the way of cleaning up the Rust and generating module lists.
This commit is contained in:
@@ -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
|
||||
|
||||
@@ -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: Gen>(g: &mut G) -> Self" $
|
||||
-- do out (name ++ " {")
|
||||
-- indent $
|
||||
-- do out ("value: [")
|
||||
-- indent $ forM_ [0..top] $ \ _ ->
|
||||
-- out ("g.next_u64(),")
|
||||
-- out ("]")
|
||||
-- out ("}")
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -12,7 +12,9 @@ comparisons :: File
|
||||
comparisons = File {
|
||||
predicate = \ _ _ -> True,
|
||||
outputName = "compare",
|
||||
generator = declareComparators
|
||||
isUnsigned = True,
|
||||
generator = declareComparators,
|
||||
testCase = Nothing
|
||||
}
|
||||
|
||||
declareComparators :: Word -> SourceFile Span
|
||||
|
||||
@@ -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}
|
||||
|]
|
||||
|
||||
|
||||
@@ -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)
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
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}
|
||||
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
|
||||
|
||||
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)
|
||||
|
||||
19
generation/src/Generators.hs
Normal file
19
generation/src/Generators.hs
Normal file
@@ -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"
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
0
src/signed.rs
Normal file
0
src/signed.rs
Normal file
Reference in New Issue
Block a user