acw/cryptonum
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Complete the shift over to language-rust.

Browse Source
This commit is contained in:
Adam Wick
2019-10-22 22:06:34 -07:00
parent 2400b10fbc
commit 620048bce6
8 changed files with 103 additions and 196 deletions
Download Patch File Download Diff File Expand all files Collapse all files

24
generation/src/Base.hs
View File

@@ -4,13 +4,10 @@ module Base(
) )
where where
import Control.Monad(forM_)
import File import File
import Gen
import Language.Rust.Data.Ident import Language.Rust.Data.Ident
import Language.Rust.Data.Position import Language.Rust.Data.Position
import Language.Rust.Quote import Language.Rust.Quote
import Language.Rust.Pretty
import Language.Rust.Syntax import Language.Rust.Syntax
base :: File base :: File
@@ -20,18 +17,17 @@ base = File {
generator = declareBaseStructure generator = declareBaseStructure
} }
declareBaseStructure :: Word -> Gen () declareBaseStructure :: Word -> SourceFile Span
declareBaseStructure bitsize = declareBaseStructure bitsize =
do let name = "U" ++ show bitsize let tname = "U" ++ show bitsize
entries = bitsize `div` 64 entries = bitsize `div` 64
top = entries - 1 sname = mkIdent tname
sname = mkIdent name entriese = Lit [] (Int Dec (fromIntegral entries) Unsuffixed mempty) mempty
entriese = Lit [] (Int Dec (fromIntegral entries) Unsuffixed mempty) mempty strname = Lit [] (Str tname Cooked Unsuffixed mempty) mempty
strname = Lit [] (Str name Cooked Unsuffixed mempty) mempty debugExp = buildDebugExp 0 entries [expr| f.debug_tuple($$(strname)) |]
debugExp = buildDebugExp 0 entries [expr| f.debug_tuple($$(strname)) |] lowerPrints = buildPrints entries "x"
lowerPrints = buildPrints entries "x" upperPrints = buildPrints entries "X"
upperPrints = buildPrints entries "X" in [sourceFile|
out $ show $ pretty' $ [sourceFile|
use core::fmt; use core::fmt;
use quickcheck::{Arbitrary,Gen}; use quickcheck::{Arbitrary,Gen};

20
generation/src/BinaryOps.hs
View File

@@ -5,11 +5,9 @@ module BinaryOps(
where where
import File import File
import Gen
import Language.Rust.Data.Ident import Language.Rust.Data.Ident
import Language.Rust.Data.Position import Language.Rust.Data.Position
import Language.Rust.Quote import Language.Rust.Quote
import Language.Rust.Pretty
import Language.Rust.Syntax import Language.Rust.Syntax
binaryOps :: File binaryOps :: File
@@ -19,16 +17,16 @@ binaryOps = File {
generator = declareBinaryOperators generator = declareBinaryOperators
} }
declareBinaryOperators :: Word -> Gen () declareBinaryOperators :: Word -> SourceFile Span
declareBinaryOperators bitsize = declareBinaryOperators bitsize =
do let struct_name = mkIdent ("U" ++ show bitsize) let struct_name = mkIdent ("U" ++ show bitsize)
entries = bitsize `div` 64 entries = bitsize `div` 64
andOps = generateBinOps "BitAnd" struct_name "bitand" BitAndOp entries andOps = generateBinOps "BitAnd" struct_name "bitand" BitAndOp entries
orOps = generateBinOps "BitOr" struct_name "bitor" BitOrOp entries orOps = generateBinOps "BitOr" struct_name "bitor" BitOrOp entries
xorOps = generateBinOps "BitXor" struct_name "bitxor" BitXorOp entries xorOps = generateBinOps "BitXor" struct_name "bitxor" BitXorOp entries
baseNegationStmts = negationStatements "self" entries baseNegationStmts = negationStatements "self" entries
refNegationStmts = negationStatements "output" entries refNegationStmts = negationStatements "output" entries
out $ show $ pretty' $ [sourceFile| in [sourceFile|
use core::ops::{BitAnd,BitAndAssign}; use core::ops::{BitAnd,BitAndAssign};
use core::ops::{BitOr,BitOrAssign}; use core::ops::{BitOr,BitOrAssign};
use core::ops::{BitXor,BitXorAssign}; use core::ops::{BitXor,BitXorAssign};

14
generation/src/Compare.hs
View File

@@ -3,11 +3,9 @@ module Compare(comparisons)
where where
import File import File
import Gen
import Language.Rust.Data.Ident import Language.Rust.Data.Ident
import Language.Rust.Data.Position import Language.Rust.Data.Position
import Language.Rust.Quote import Language.Rust.Quote
import Language.Rust.Pretty
import Language.Rust.Syntax import Language.Rust.Syntax
comparisons :: File comparisons :: File
@@ -17,13 +15,13 @@ comparisons = File {
generator = declareComparators generator = declareComparators
} }
declareComparators :: Word -> Gen () declareComparators :: Word -> SourceFile Span
declareComparators bitsize = declareComparators bitsize =
do let sname = mkIdent ("U" ++ show bitsize) let sname = mkIdent ("U" ++ show bitsize)
entries = bitsize `div` 64 entries = bitsize `div` 64
eqStatements = buildEqStatements 0 entries eqStatements = buildEqStatements 0 entries
compareExp = buildCompareExp 0 entries compareExp = buildCompareExp 0 entries
out $ show $ pretty' $ [sourceFile| in [sourceFile|
use core::cmp::{Eq,Ordering,PartialEq}; use core::cmp::{Eq,Ordering,PartialEq};
#[cfg(test)] #[cfg(test)]
use quickcheck::quickcheck; use quickcheck::quickcheck;

31
generation/src/Conversions.hs
View File

@@ -5,11 +5,10 @@ module Conversions(
where where
import File import File
import Gen(Gen,toLit,out) import Gen(toLit)
import Language.Rust.Data.Ident import Language.Rust.Data.Ident
import Language.Rust.Data.Position import Language.Rust.Data.Position
import Language.Rust.Quote import Language.Rust.Quote
import Language.Rust.Pretty
import Language.Rust.Syntax import Language.Rust.Syntax
conversions :: File conversions :: File
@@ -19,21 +18,21 @@ conversions = File {
generator = declareConversions generator = declareConversions
} }
declareConversions :: Word -> Gen () declareConversions :: Word -> SourceFile Span
declareConversions bitsize = declareConversions bitsize =
do let sname = mkIdent ("U" ++ show bitsize) let sname = mkIdent ("U" ++ show bitsize)
entries = bitsize `div` 64 entries = bitsize `div` 64
u8_prims = buildPrimitives sname (mkIdent "u8") entries u8_prims = buildPrimitives sname (mkIdent "u8") entries
u16_prims = buildPrimitives sname (mkIdent "u16") entries u16_prims = buildPrimitives sname (mkIdent "u16") entries
u32_prims = buildPrimitives sname (mkIdent "u32") entries u32_prims = buildPrimitives sname (mkIdent "u32") entries
u64_prims = buildPrimitives sname (mkIdent "u64") entries u64_prims = buildPrimitives sname (mkIdent "u64") entries
u128_prims = generateU128Primitives sname entries u128_prims = generateU128Primitives sname entries
i8_prims = generateSignedPrims sname (mkIdent "u8") (mkIdent "i8") i8_prims = generateSignedPrims sname (mkIdent "u8") (mkIdent "i8")
i16_prims = generateSignedPrims sname (mkIdent "u16") (mkIdent "i16") i16_prims = generateSignedPrims sname (mkIdent "u16") (mkIdent "i16")
i32_prims = generateSignedPrims sname (mkIdent "u32") (mkIdent "i32") i32_prims = generateSignedPrims sname (mkIdent "u32") (mkIdent "i32")
i64_prims = generateSignedPrims sname (mkIdent "u64") (mkIdent "i64") i64_prims = generateSignedPrims sname (mkIdent "u64") (mkIdent "i64")
i128_prims = generateI128Primitives sname i128_prims = generateI128Primitives sname
out $ show $ pretty' $ [sourceFile| in [sourceFile|
use core::convert::{From,TryFrom}; use core::convert::{From,TryFrom};
use core::num::TryFromIntError; use core::num::TryFromIntError;
#[cfg(test)] #[cfg(test)]

62
generation/src/CryptoNum.hs
View File

@@ -4,13 +4,11 @@ module CryptoNum(
) )
where where
import Control.Monad(forM_)
import File import File
import Gen import Gen
import Language.Rust.Data.Ident import Language.Rust.Data.Ident
import Language.Rust.Data.Position import Language.Rust.Data.Position
import Language.Rust.Quote import Language.Rust.Quote
import Language.Rust.Pretty
import Language.Rust.Syntax import Language.Rust.Syntax
cryptoNum :: File cryptoNum :: File
@@ -20,24 +18,22 @@ cryptoNum = File {
generator = declareCryptoNumInstance generator = declareCryptoNumInstance
} }
declareCryptoNumInstance :: Word -> Gen () declareCryptoNumInstance :: Word -> SourceFile Span
declareCryptoNumInstance bitsize = declareCryptoNumInstance bitsize =
do let sname = mkIdent ("U" ++ show bitsize) let sname = mkIdent ("U" ++ show bitsize)
entries = bitsize `div` 64 entries = bitsize `div` 64
entlit = Lit [] (Int Dec (fromIntegral entries) Unsuffixed mempty) mempty entlit = Lit [] (Int Dec (fromIntegral entries) Unsuffixed mempty) mempty
top = entries - 1 zeroTests = generateZeroTests 0 entries
zeroTests = generateZeroTests 0 entries bitlength = toLit bitsize
bitlength = toLit bitsize bytelen = bitsize `div` 8
bytelen = bitsize `div` 8 bytelenlit = toLit bytelen
bytelenlit = toLit bytelen bytebuffer = Delimited mempty Brace (Stream [
bytebuffer = Delimited mempty Brace (Stream [ Tree (Token mempty (LiteralTok (IntegerTok "0") Nothing)),
Tree (Token mempty (LiteralTok (IntegerTok "0") Nothing)), Tree (Token mempty Semicolon),
Tree (Token mempty Semicolon), Tree (Token mempty (LiteralTok (IntegerTok (show bytelen)) Nothing))
Tree (Token mempty (LiteralTok (IntegerTok (show bytelen)) Nothing)) ])
]) entrieslit = toLit entries
entrieslit = toLit entries in [sourceFile|
packerLines = generatePackerLines 0 (bitsize `div` 8)
out $ show $ pretty' $ [sourceFile|
use core::cmp::min; use core::cmp::min;
use crate::CryptoNum; use crate::CryptoNum;
#[cfg(test)] #[cfg(test)]
@@ -142,32 +138,10 @@ declareCryptoNumInstance bitsize =
} }
|] |]
byteShiftInfo :: Word -> (Word, Word)
byteShiftInfo idx =
(idx `div` 8, (idx `mod` 8) * 8)
pad :: Int -> Char -> String -> String
pad len c str
| length str >= len = str
| otherwise = pad len c (c:str)
generateZeroTests :: Word -> Word -> [Stmt Span] generateZeroTests :: Word -> Word -> [Stmt Span]
generateZeroTests i max generateZeroTests i entries
| i == max = [] | i == entries = []
| otherwise = | otherwise =
let ilit = toLit i let ilit = toLit i
in [stmt| result = self.values[$$(ilit)] == 0; |] : in [stmt| result = self.values[$$(ilit)] == 0; |] :
generateZeroTests (i + 1) max generateZeroTests (i + 1) entries
generatePackerLines :: Word -> Word -> [Stmt Span]
generatePackerLines i max
| i == max = []
| otherwise =
let ilit = toLit i
nextLit = toLit (i + 1)
validx = toLit (i `div` 8)
shiftx = toLit ((i `mod` 8) * 8)
writeLine = [stmt| bytes[$$(ilit)] = (self.values[$$(validx)] >> $$(shiftx)) as u8; |]
ifLine = [stmt| if bytes.len() == $$(nextLit) { return; } |]
in writeLine : ifLine : generatePackerLines (i + 1) max

61
generation/src/File.hs
View File

@@ -1,3 +1,4 @@
{-# LANGUAGE QuasiQuotes #-}
module File( module File(
File(..), File(..),
Task(..), Task(..),
@@ -6,21 +7,24 @@ module File(
) )
where where
import Control.Monad(forM_)
import Data.Char(toUpper) import Data.Char(toUpper)
import Data.Map.Strict(Map)
import qualified Data.Map.Strict as Map import qualified Data.Map.Strict as Map
import Gen(Gen,blank,out)
import System.FilePath(takeBaseName,takeDirectory,takeFileName,(</>)) import System.FilePath(takeBaseName,takeDirectory,takeFileName,(</>))
import Language.Rust.Data.Ident(Ident,mkIdent)
import Language.Rust.Data.Position(Span)
import Language.Rust.Quote(item,sourceFile)
import Language.Rust.Syntax(Item,SourceFile)
data File = File { data File = File {
predicate :: Word -> [Word] -> Bool, predicate :: Word -> [Word] -> Bool,
outputName :: FilePath, outputName :: FilePath,
generator :: Word -> Gen () generator :: Word -> SourceFile Span
} }
data Task = Task { data Task = Task {
outputFile :: FilePath, outputFile :: FilePath,
fileGenerator :: Gen () fileData :: SourceFile Span
} }
makeTask :: FilePath -> makeTask :: FilePath ->
@@ -31,7 +35,7 @@ makeTask base size allSizes file
| predicate file size allSizes = | predicate file size allSizes =
Just Task { Just Task {
outputFile = base </> ("u" ++ show size) </> outputName file <> ".rs", outputFile = base </> ("u" ++ show size) </> outputName file <> ".rs",
fileGenerator = generator file size fileData = generator file size
} }
| otherwise = | otherwise =
Nothing Nothing
@@ -39,28 +43,49 @@ makeTask base size allSizes file
addModuleTasks :: FilePath -> [Task] -> [Task] addModuleTasks :: FilePath -> [Task] -> [Task]
addModuleTasks base baseTasks = unsignedTask : (baseTasks ++ moduleTasks) addModuleTasks base baseTasks = unsignedTask : (baseTasks ++ moduleTasks)
where where
moduleMap :: Map String [String]
moduleMap = foldr addModuleInfo Map.empty baseTasks moduleMap = foldr addModuleInfo Map.empty baseTasks
addModuleInfo :: Task -> Map String [String] -> Map String [String]
addModuleInfo task = addModuleInfo task =
Map.insertWith (++) (takeDirectory (outputFile task)) Map.insertWith (++) (takeDirectory (outputFile task))
[takeBaseName (outputFile task)] [takeBaseName (outputFile task)]
moduleTasks :: [Task]
moduleTasks = Map.foldrWithKey generateModuleTask [] moduleMap moduleTasks = Map.foldrWithKey generateModuleTask [] moduleMap
generateModuleTask :: String -> [String] -> [Task] -> [Task]
generateModuleTask directory mods acc = acc ++ [Task { generateModuleTask directory mods acc = acc ++ [Task {
outputFile = directory </> "mod.rs", outputFile = directory </> "mod.rs",
fileGenerator = fileData =
do forM_ mods $ \ modle -> out ("mod " ++ modle ++ ";") let modules = map (buildModule . mkIdent) mods
blank user = mkIdent (upcase (takeFileName directory))
out ("pub use base::" ++ upcase (takeFileName directory) ++ ";") in [sourceFile|
$@{modules}
pub use base::$$user;
|]
}] }]
unsignedTask :: Task
unsignedTask = Task { unsignedTask = Task {
outputFile = base </> "unsigned" </> "mod.rs", outputFile = base </> "unsigned" </> "mod.rs",
fileGenerator = fileData =
do forM_ (Map.keys moduleMap) $ \ key -> let modules = map (buildModule . mkIdent . takeFileName) (Map.keys moduleMap)
out ("mod " ++ takeFileName key ++ ";") uses = map (buildUse . takeFileName) (Map.keys moduleMap)
blank in [sourceFile|
forM_ (Map.keys moduleMap) $ \ key -> $@{modules}
out ("pub use " ++ takeFileName key ++ "::" ++ $@{uses}
upcase (takeFileName key) ++ ";") |]
} }
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 :: String -> String
upcase = map toUpper upcase = map toUpper

83
generation/src/Gen.hs
View File

@@ -1,95 +1,12 @@
{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Gen( module Gen(
Gen(Gen),
runGen,
gensym,
indent,
blank,
out,
wrapIndent,
implFor,
implFor',
implFor'',
toLit toLit
) )
where where
import Control.Monad.RWS.Strict(RWS,evalRWS)
import Control.Monad.State.Class(MonadState,get,put)
import Control.Monad.Writer.Class(MonadWriter,tell)
import Data.List(replicate)
import Data.Word(Word)
import Language.Rust.Data.Position import Language.Rust.Data.Position
import Language.Rust.Syntax import Language.Rust.Syntax
newtype Gen a = Gen { unGen :: RWS () String GenState a}
deriving (Applicative, Functor, Monad, MonadState GenState, MonadWriter String)
tabAmount :: Word
tabAmount = 4
data GenState = GenState {
indentAmount :: Word,
gensymIndex :: Word
}
initGenState :: GenState
initGenState = GenState { indentAmount = 0, gensymIndex = 0 }
runGen :: FilePath -> Gen a -> IO a
runGen path action =
do let (res, contents) = evalRWS (unGen action) () initGenState
writeFile path contents
return res
gensym :: String -> Gen String
gensym prefix =
do gs <- get
let gs' = gs{ gensymIndex = gensymIndex gs + 1 }
put gs'
return (prefix ++ show (gensymIndex gs))
indent :: Gen a -> Gen a
indent action =
do gs <- get
put gs{ indentAmount = indentAmount gs + tabAmount }
res <- action
put gs
return res
blank :: Gen ()
blank = tell "\n"
out :: String -> Gen ()
out val =
do gs <- get
tell (replicate (fromIntegral (indentAmount gs)) ' ')
tell val
tell "\n"
wrapIndent :: String -> Gen a -> Gen a
wrapIndent val middle =
do gs <- get
tell (replicate (fromIntegral (indentAmount gs)) ' ')
tell val
tell " {\n"
res <- indent middle
tell (replicate (fromIntegral (indentAmount gs)) ' ')
tell "}\n"
return res
implFor :: String -> String -> Gen a -> Gen a
implFor trait name middle =
wrapIndent ("impl " ++ trait ++ " for " ++ name) middle
implFor' :: String -> String -> Gen a -> Gen a
implFor' trait name middle =
wrapIndent ("impl<'a> " ++ trait ++ " for " ++ name) middle
implFor'' :: String -> String -> Gen a -> Gen a
implFor'' trait name middle =
wrapIndent ("impl<'a,'b> " ++ trait ++ " for " ++ name) middle
toLit :: Word -> Expr Span toLit :: Word -> Expr Span
toLit i = Lit [] (Int Dec (fromIntegral i) Unsuffixed mempty) mempty toLit i = Lit [] (Int Dec (fromIntegral i) Unsuffixed mempty) mempty

4
generation/src/Main.hs
View File

@@ -9,7 +9,7 @@ import CryptoNum(cryptoNum)
import Control.Monad(forM_,unless) import Control.Monad(forM_,unless)
import Data.Maybe(mapMaybe) import Data.Maybe(mapMaybe)
import File(File,Task(..),addModuleTasks,makeTask) import File(File,Task(..),addModuleTasks,makeTask)
import Gen(runGen) import Language.Rust.Pretty(prettyAnnotated')
import System.Directory(createDirectoryIfMissing) import System.Directory(createDirectoryIfMissing)
import System.Environment(getArgs) import System.Environment(getArgs)
import System.Exit(die) import System.Exit(die)
@@ -56,4 +56,4 @@ main =
forM_ (zip [(1::Word)..] tasks) $ \ (i, task) -> forM_ (zip [(1::Word)..] tasks) $ \ (i, task) ->
do putStrLn ("[" ++ show i ++ "/" ++ show total ++ "] " ++ outputFile task) do putStrLn ("[" ++ show i ++ "/" ++ show total ++ "] " ++ outputFile task)
createDirectoryIfMissing True (takeDirectory (outputFile task)) createDirectoryIfMissing True (takeDirectory (outputFile task))
runGen (outputFile task) (fileGenerator task) writeFile (outputFile task) (show (prettyAnnotated' (fileData task)))