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

14
generation/src/Base.hs
View File

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

8
generation/src/BinaryOps.hs
View File

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

8
generation/src/Compare.hs
View File

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

9
generation/src/Conversions.hs
View File

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

38
generation/src/CryptoNum.hs
View File

@@ -4,13 +4,11 @@ module CryptoNum(
)
where
import Control.Monad(forM_)
import File
import Gen
import Language.Rust.Data.Ident
import Language.Rust.Data.Position
import Language.Rust.Quote
import Language.Rust.Pretty
import Language.Rust.Syntax
cryptoNum :: File
@@ -20,12 +18,11 @@ cryptoNum = File {
generator = declareCryptoNumInstance
}
declareCryptoNumInstance :: Word -> Gen ()
declareCryptoNumInstance :: Word -> SourceFile Span
declareCryptoNumInstance bitsize =
do let sname = mkIdent ("U" ++ show bitsize)
let sname = mkIdent ("U" ++ show bitsize)
entries = bitsize `div` 64
entlit = Lit [] (Int Dec (fromIntegral entries) Unsuffixed mempty) mempty
top = entries - 1
zeroTests = generateZeroTests 0 entries
bitlength = toLit bitsize
bytelen = bitsize `div` 8
@@ -36,8 +33,7 @@ declareCryptoNumInstance bitsize =
Tree (Token mempty (LiteralTok (IntegerTok (show bytelen)) Nothing))
])
entrieslit = toLit entries
packerLines = generatePackerLines 0 (bitsize `div` 8)
out $ show $ pretty' $ [sourceFile|
in [sourceFile|
use core::cmp::min;
use crate::CryptoNum;
#[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 i max
| i == max = []
generateZeroTests i entries
| i == entries = []
| otherwise =
let ilit = toLit i
in [stmt| result = self.values[$$(ilit)] == 0; |] :
generateZeroTests (i + 1) max
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
generateZeroTests (i + 1) entries

57
generation/src/File.hs
View File

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

83
generation/src/Gen.hs
View File

@@ -1,95 +1,12 @@
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Gen(
Gen(Gen),
runGen,
gensym,
indent,
blank,
out,
wrapIndent,
implFor,
implFor',
implFor'',
toLit
)
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.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 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 Data.Maybe(mapMaybe)
import File(File,Task(..),addModuleTasks,makeTask)
import Gen(runGen)
import Language.Rust.Pretty(prettyAnnotated')
import System.Directory(createDirectoryIfMissing)
import System.Environment(getArgs)
import System.Exit(die)
@@ -56,4 +56,4 @@ main =
forM_ (zip [(1::Word)..] tasks) $ \ (i, task) ->
do putStrLn ("[" ++ show i ++ "/" ++ show total ++ "] " ++ outputFile task)
createDirectoryIfMissing True (takeDirectory (outputFile task))
runGen (outputFile task) (fileGenerator task)
writeFile (outputFile task) (show (prettyAnnotated' (fileData task)))