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

Start working on switching to language-rust as a generator, for fun.

Browse Source
This commit is contained in:
Adam Wick
2019-10-22 20:12:08 -07:00
parent d7665acf64
commit 2400b10fbc
9 changed files with 723 additions and 404 deletions
Download Patch File Download Diff File Expand all files Collapse all files

300
generation/src/BinaryOps.hs
View File

@@ -1,11 +1,16 @@
{-# LANGUAGE QuasiQuotes #-}
module BinaryOps(
binaryOps
)
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
binaryOps :: File
binaryOps = File {
@@ -16,130 +21,177 @@ binaryOps = File {
declareBinaryOperators :: Word -> Gen ()
declareBinaryOperators bitsize =
do let name = "U" ++ show bitsize
do let struct_name = mkIdent ("U" ++ show bitsize)
entries = bitsize `div` 64
out "use core::ops::{BitAnd,BitAndAssign};"
out "use core::ops::{BitOr,BitOrAssign};"
out "use core::ops::{BitXor,BitXorAssign};"
out "use core::ops::Not;"
out "#[cfg(test)]"
out "use crate::CryptoNum;"
out "#[cfg(test)]"
out "use quickcheck::quickcheck;"
out ("use super::U" ++ show bitsize ++ ";")
blank
generateBinOps "BitAnd" name "bitand" "&=" entries
blank
generateBinOps "BitOr" name "bitor" "|=" entries
blank
generateBinOps "BitXor" name "bitxor" "^=" entries
blank
implFor "Not" name $
do out "type Output = Self;"
blank
wrapIndent "fn not(mut self) -> Self" $
do forM_ [0..entries-1] $ \ i ->
out ("self.value[" ++ show i ++ "] = !self.value[" ++ show i ++ "];")
out "self"
blank
implFor' "Not" ("&'a " ++ name) $
do out ("type Output = " ++ name ++ ";")
blank
wrapIndent ("fn not(self) -> " ++ name) $
do out "let mut output = self.clone();"
forM_ [0..entries-1] $ \ i ->
out ("output.value[" ++ show i ++ "] = !self.value[" ++ show i ++ "];")
out "output"
blank
addBinaryLaws name
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|
use core::ops::{BitAnd,BitAndAssign};
use core::ops::{BitOr,BitOrAssign};
use core::ops::{BitXor,BitXorAssign};
use core::ops::Not;
#[cfg(test)]
use crate::CryptoNum;
#[cfg(test)]
use quickcheck::quickcheck;
use super::$$struct_name;
generateBinOps :: String -> String -> String -> String -> Word -> Gen ()
generateBinOps trait name fun op entries =
do implFor (trait ++ "Assign") name $
wrapIndent ("fn " ++ fun ++ "_assign(&mut self, rhs: Self)") $
forM_ [0..entries-1] $ \ i ->
out ("self.value[" ++ show i ++ "] "++op++" rhs.value[" ++ show i ++ "];")
blank
implFor' (trait ++ "Assign<&'a " ++ name ++ ">") name $
wrapIndent ("fn " ++ fun ++ "_assign(&mut self, rhs: &Self)") $
forM_ [0..entries-1] $ \ i ->
out ("self.value[" ++ show i ++ "] "++op++" rhs.value[" ++ show i ++ "];")
blank
generateBinOpsFromAssigns trait name fun op
$@{andOps}
$@{orOps}
$@{xorOps}
generateBinOpsFromAssigns :: String -> String -> String -> String -> Gen ()
generateBinOpsFromAssigns trait name fun op =
do implFor trait name $
do out "type Output = Self;"
blank
wrapIndent ("fn " ++ fun ++ "(mut self, rhs: Self) -> Self") $
do out ("self " ++ op ++ " rhs;")
out "self"
blank
implFor' (trait ++ "<&'a " ++ name ++ ">") name $
do out "type Output = Self;"
blank
wrapIndent ("fn " ++ fun ++ "(mut self, rhs: &Self) -> Self") $
do out ("self " ++ op ++ " rhs;")
out "self"
blank
implFor' (trait ++ "<" ++ name ++ ">") ("&'a " ++ name) $
do out ("type Output = " ++ name ++ ";")
blank
wrapIndent ("fn " ++ fun ++ "(self, mut rhs: " ++ name ++ ") -> " ++ name) $
do out ("rhs " ++ op ++ " self;")
out "rhs"
blank
implFor'' (trait ++ "<&'a " ++ name ++ ">") ("&'b " ++ name) $
do out ("type Output = " ++ name ++ ";")
blank
wrapIndent ("fn " ++ fun ++ "(self, rhs: &" ++ name ++ ") -> " ++ name) $
do out "let mut output = self.clone();"
out ("output " ++ op ++ " rhs;")
out "output"
impl Not for $$struct_name {
type Output = Self;
addBinaryLaws :: String -> Gen ()
addBinaryLaws name =
do let args3 = "(a: " ++ name ++ ", b: " ++ name ++ ", c: " ++ name ++ ")"
args2 = "(a: " ++ name ++ ", b: " ++ name ++ ")"
out "#[cfg(test)]"
wrapIndent "quickcheck!" $
do wrapIndent ("fn and_associative" ++ args3 ++ " -> bool") $
out ("((&a & &b) & &c) == (&a & (&b & &c))")
blank
wrapIndent ("fn and_commutative" ++ args2 ++ " -> bool") $
out ("(&a & &b) == (&b & &a)")
blank
wrapIndent ("fn and_idempotent" ++ args2 ++ " -> bool") $
out ("(&a & &b) == (&a & &b & &a)")
blank
wrapIndent ("fn xor_associative" ++ args3 ++ " -> bool") $
out ("((&a ^ &b) ^ &c) == (&a ^ (&b ^ &c))")
blank
wrapIndent ("fn xor_commutative" ++ args2 ++ " -> bool") $
out ("(&a ^ &b) == (&b ^ &a)")
blank
wrapIndent ("fn or_associative" ++ args3 ++ " -> bool") $
out ("((&a | &b) | &c) == (&a | (&b | &c))")
blank
wrapIndent ("fn or_commutative" ++ args2 ++ " -> bool") $
out ("(&a | &b) == (&b | &a)")
blank
wrapIndent ("fn or_idempotent" ++ args2 ++ " -> bool") $
out ("(&a | &b) == (&a | &b | &a)")
blank
wrapIndent ("fn and_or_distribution" ++ args3 ++ "-> bool") $
out ("(&a & (&b | &c)) == ((&a & &b) | (&a & &c))")
blank
wrapIndent ("fn xor_clears(a: " ++ name ++ ") -> bool") $
out (name ++ "::zero() == (&a ^ &a)")
blank
wrapIndent ("fn double_neg_ident(a: " ++ name ++ ") -> bool") $
out ("a == !!&a")
blank
wrapIndent ("fn and_ident(a: " ++ name ++ ") -> bool") $
do out ("let ones = !" ++ name ++ "::zero();")
out ("(&a & &ones) == a")
blank
wrapIndent ("fn or_ident(a: " ++ name ++ ") -> bool") $
out ("(&a | " ++ name ++ "::zero()) == a")
fn not(mut self) -> Self {
$@{baseNegationStmts}
self
}
}
impl<'a> Not for &'a $$struct_name {
type Output = Self;
fn not(self) -> Self {
let mut output = self.clone();
$@{refNegationStmts}
output
}
}
quickcheck! {
fn and_associative(a: $$struct_name, b: $$struct_name, c: $$struct_name) -> bool {
((&a & &b) & &c) == (&a & (&b & &c))
}
fn and_commutative(a: $$struct_name, b: $$struct_name) -> bool {
(&a & &b) == (&b & &a)
}
fn and_idempotent(a: $$struct_name, b: $$struct_name) -> bool {
(&a & &b) == (&a & &b & &a)
}
fn xor_associative(a: $$struct_name, b: $$struct_name, c: $$struct_name) -> bool {
((&a ^ &b) ^ &c) == (&a ^ (&b ^ &c))
}
fn xor_commutative(a: $$struct_name, b: $$struct_name) -> bool {
(&a ^ &b) == (&b ^ &a)
}
fn or_associative(a: $$struct_name, b: $$struct_name, c: $$struct_name) -> bool {
((&a | &b) & &c) == (&a | (&b | &c))
}
fn or_commutative(a: $$struct_name, b: $$struct_name) -> bool {
(&a | &b) == (&b | &a)
}
fn or_idempotent(a: $$struct_name, b: $$struct_name) -> bool {
(&a | &b) == (&a | &b | &a)
}
fn and_or_distribution(a: $$struct_name, b: $$struct_name, c: $$struct_name) -> bool {
(&a & (&b | &c)) == ((&a & &b) | (&a & &c))
}
fn xor_clears(a: $$struct_name) -> bool {
$$struct_name::zero() == (&a ^ *a)
}
fn double_neg_ident(a: $$struct_name) -> bool {
a == !!$a
}
fn and_ident(a: $$struct_name) -> bool {
let ones = !$$struct_name::zero();
(&a & &ones) == a
}
fn or_ident(a: $$struct_name) -> bool {
(&a | $$struct_name::zero()) == a
}
}
|]
negationStatements :: String -> Word -> [Stmt Span]
negationStatements target entries = map genStatement [0..entries-1]
where
genStatement i =
let idx = Lit [] (Int Dec (fromIntegral i) Unsuffixed mempty) mempty
v = mkIdent target
in [stmt| $$v.value[$$(idx)] = !self.value[$$(idx)]; |]
generateBinOps :: String -> Ident -> String -> BinOp -> Word -> [Item Span]
generateBinOps trait sname func oper entries =
[normAssign, refAssign] ++ generateAllTheVariants traitIdent funcIdent sname oper
where
traitIdent = mkIdent trait
assignIdent = mkIdent (trait ++ "Assign")
funcIdent = mkIdent func
funcAssignIdent = mkIdent (func ++ "_assign")
--
normAssign = [item|
impl $$assignIdent for $$sname {
fn $$funcAssignIdent(&mut self, rhs: Self) {
$@{assignStatements}
}
}
|]
refAssign = [item|
impl $$assignIdent<&'a $$sname> for $$sname {
fn $$funcAssignIdent(&mut self, rhs: &Self) {
$@{assignStatements}
}
}
|]
--
assignStatements :: [Stmt Span]
assignStatements = map genAssign [0..entries-1]
genAssign i =
let idx = Lit [] (Int Dec (fromIntegral i) Unsuffixed mempty) mempty
left = [expr| self.value[$$(idx)] |]
right = [expr| rhs.value[$$(idx)] |]
in Semi (AssignOp [] oper left right mempty) mempty
generateAllTheVariants :: Ident -> Ident -> Ident -> BinOp -> [Item Span]
generateAllTheVariants traitname func sname oper = [
[item|
impl $$traitname for $$sname {
type Output = Self;
fn $$func(mut self, rhs: Self) -> Self {
$${assigner_self_rhs}
self
}
}|]
, [item|
impl<'a> $$traitname<&'a $$sname> for $$sname {
type Output = Self;
fn $$func(mut self, rhs: Self) -> Self {
$${assigner_self_rhs}
self
}
}|]
, [item|
impl<'a> $$traitname for &'a $$sname {
type Output = Self;
fn $$func(mut self, rhs: Self) -> Self {
$${assigner_rhs_self}
self
}
}|]
, [item|
impl<'a,'b> $$traitname<&'a $$sname> for &'b $$sname {
type Output = Self;
fn $$func(mut self, rhs: Self) -> Self {
let mut out = self.clone();
$${assigner_out_rhs}
out
}
}|]
]
where
assigner_self_rhs = assigner [expr| self |] [expr| rhs |]
assigner_rhs_self = assigner [expr| rhs |] [expr| self |]
assigner_out_rhs = assigner [expr| out |] [expr| rhs |]
assigner left right =
Semi (AssignOp [] oper left right mempty) mempty