mirror of
https://github.com/GaloisInc/cryptol.git
synced 2024-11-24 15:08:58 +03:00
868 lines
23 KiB
Plaintext
868 lines
23 KiB
Plaintext
/*
|
|
* Copyright (c) 2013-2016 Galois, Inc.
|
|
* Distributed under the terms of the BSD3 license (see LICENSE file)
|
|
*/
|
|
|
|
module Cryptol where
|
|
|
|
/**
|
|
* The value corresponding to a numeric type.
|
|
*/
|
|
primitive number : {val, rep} Literal val rep => rep
|
|
|
|
/**
|
|
* An alternative name for 'number', present for backward compatibility.
|
|
*/
|
|
demote : {val, rep} Literal val rep => rep
|
|
demote = number`{val}
|
|
|
|
infixr 5 ==>
|
|
infixr 10 \/
|
|
infixr 15 /\
|
|
infix 20 ==, ===, !=, !==
|
|
infix 30 >, >=, <, <=, <$, >$, <=$, >=$
|
|
infixr 40 ||
|
|
infixl 45 ^
|
|
infixr 50 &&
|
|
infixr 60 #
|
|
infixl 70 <<, <<<, >>, >>>, >>$
|
|
infixl 80 +, -
|
|
infixl 90 *, /, %, /$, %$, %^, /^
|
|
infixr 95 ^^
|
|
infixl 100 @, @@, !, !!
|
|
|
|
// -----------------------------------------------------------------------------
|
|
|
|
/** A numeric type representing infinity. */
|
|
primitive type inf : #
|
|
|
|
/** The type of boolean values. */
|
|
primitive type Bit : *
|
|
|
|
/** The type of unbounded integers. */
|
|
primitive type Integer : *
|
|
|
|
/** 'Z n' is the type of integers, modulo 'n'. */
|
|
primitive type {n : #} (fin n, n >= 1) => Z n : *
|
|
|
|
|
|
|
|
/** Assert that two numeric types are equal. */
|
|
primitive type (==) : # -> # -> Prop
|
|
|
|
/** Assert that two numeric types are different. */
|
|
primitive type (!=) : # -> # -> Prop
|
|
|
|
/** Assert that the first numeric type is larger than, or equal to the second.*/
|
|
primitive type (>=) : # -> # -> Prop
|
|
|
|
/** Assert that a numeric type is a proper natural number (not 'inf'). */
|
|
primitive type fin : * -> Prop
|
|
|
|
/** Value types that have a notion of 'zero'. */
|
|
primitive type Zero : * -> Prop
|
|
|
|
/** Value types that support logical operations. */
|
|
primitive type Logic : * -> Prop
|
|
|
|
/** Value types that support arithmetic. */
|
|
primitive type Arith : * -> Prop
|
|
|
|
/** Value types that support unsigned comparisons. */
|
|
primitive type Cmp : * -> Prop
|
|
|
|
/** Value types that support signed comparisons. */
|
|
primitive type SignedCmp : * -> Prop
|
|
|
|
/** 'Literal n a' asserts that type 'a' contains the number 'n'. */
|
|
primitive type Literal : # -> * -> Prop
|
|
|
|
|
|
|
|
/** Add numeric types. */
|
|
primitive type (+) : # -> # -> #
|
|
|
|
/** Subtract numeric types. */
|
|
primitive type
|
|
{m : #, n : # }
|
|
(fin n, m >= n) =>
|
|
m - n : #
|
|
|
|
/** Multiply numeric types. */
|
|
primitive type (*) : # -> # -> #
|
|
|
|
/** Divide numeric types, rounding down. */
|
|
primitive type
|
|
{ m : #, n : # }
|
|
(fin m, n >= 1) =>
|
|
m / n : #
|
|
|
|
/** Remainder of numeric type division. */
|
|
primitive type
|
|
{ m : #, n : # }
|
|
(fin m, n >= 1) =>
|
|
m % n : #
|
|
|
|
/** Exponentiate numeric types. */
|
|
primitive type (^^) : # -> # -> #
|
|
|
|
/** The number of bits required to represent the value of a numeric type. */
|
|
primitive type width : # -> #
|
|
|
|
/** The smaller of two numeric types. */
|
|
primitive type min : # -> # -> #
|
|
|
|
/** The larger of two numeric types. */
|
|
primitive type max : # -> # -> #
|
|
|
|
/** Divide numeric types, rounding up. */
|
|
primitive type
|
|
{ m : #, n : # }
|
|
(fin m, fin n, n >= 1) =>
|
|
m /^ n : #
|
|
|
|
/** How much we need to add to make a proper multiple of the second argument. */
|
|
primitive type
|
|
{ m : #, n : # }
|
|
(fin m, fin n, n >= 1) =>
|
|
m %^ n : #
|
|
|
|
/** The length of an enumeration. */
|
|
primitive type
|
|
{ start : #, next : #, last : # }
|
|
(fin start, fin next, fin last, start != next) =>
|
|
lengthFromThenTo start next last : #
|
|
|
|
|
|
|
|
|
|
// -----------------------------------------------------------------------------
|
|
|
|
/**
|
|
* Assert that the first numeric type is less than or equal to the second.
|
|
*/
|
|
type constraint i <= j = (j >= i)
|
|
|
|
/**
|
|
* Assert that the first numeric type is greater than the second.
|
|
*/
|
|
type constraint i > j = i >= j + 1
|
|
|
|
/**
|
|
* Assert that the first numeric type is less than the second.
|
|
*/
|
|
type constraint i < j = j >= i + 1
|
|
|
|
/**
|
|
* Add two values.
|
|
* * For type [n], addition is modulo 2^^n.
|
|
* * Structured values are added element-wise.
|
|
*/
|
|
primitive (+) : {a} (Arith a) => a -> a -> a
|
|
|
|
/**
|
|
* Subtract two values.
|
|
* * For type [n], subtraction is modulo 2^^n.
|
|
* * Structured values are subtracted element-wise.
|
|
* * Satisfies 'a - b = a + negate b'.
|
|
* See also: 'negate'.
|
|
*/
|
|
primitive (-) : {a} (Arith a) => a -> a -> a
|
|
|
|
/**
|
|
* Multiply two values.
|
|
* * For type [n], multiplication is modulo 2^^n.
|
|
* * Structured values are multiplied element-wise.
|
|
*/
|
|
primitive (*) : {a} (Arith a) => a -> a -> a
|
|
|
|
/**
|
|
* Divide two values, rounding down.
|
|
* * For type [n], the arguments are treated as unsigned.
|
|
* * Structured values are divided element-wise.
|
|
* * Division by zero is undefined.
|
|
*/
|
|
primitive (/) : {a} (Arith a) => a -> a -> a
|
|
|
|
/**
|
|
* Compute the remainder from dividing two values.
|
|
* * For type [n], the arguments are treated as unsigned.
|
|
* * Structured values are combined element-wise.
|
|
* * Remainder of division by zero is undefined.
|
|
* * Satisfies 'x % y == x - (x / y) * y'.
|
|
*/
|
|
primitive (%) : {a} (Arith a) => a -> a -> a
|
|
|
|
/**
|
|
* Compute the exponentiation of two values.
|
|
* * For type [n], the exponent is treated as unsigned,
|
|
* and the result is reduced modulo 2^^n.
|
|
* * For type Integer, negative powers are undefined.
|
|
* * Structured values are combined element-wise.
|
|
*/
|
|
primitive (^^) : {a} (Arith a) => a -> a -> a
|
|
|
|
/**
|
|
* Log base two.
|
|
*
|
|
* For words, computes the ceiling of log, base 2, of a number.
|
|
* Over structured values, operates element-wise.
|
|
*/
|
|
primitive lg2 : {a} (Arith a) => a -> a
|
|
|
|
|
|
type Bool = Bit
|
|
|
|
/**
|
|
* The constant True. Corresponds to the bit value 1.
|
|
*/
|
|
primitive True : Bit
|
|
|
|
/**
|
|
* The constant False. Corresponds to the bit value 0.
|
|
*/
|
|
primitive False : Bit
|
|
|
|
/**
|
|
* Returns the two's complement of its argument.
|
|
* Over structured values, operates element-wise.
|
|
* The prefix notation '- x' is syntactic sugar
|
|
* for 'negate x'.
|
|
* Satisfies 'negate a = ~a + 1'.
|
|
*/
|
|
primitive negate : {a} (Arith a) => a -> a
|
|
|
|
/**
|
|
* Bitwise complement. The prefix notation '~ x'
|
|
* is syntactic sugar for 'complement x'.
|
|
*/
|
|
primitive complement : {a} (Logic a) => a -> a
|
|
|
|
/**
|
|
* Less-than. Only works on comparable arguments.
|
|
*
|
|
* Bitvectors are compared using unsigned arithmetic.
|
|
*/
|
|
primitive (<) : {a} (Cmp a) => a -> a -> Bit
|
|
|
|
/**
|
|
* Greater-than of two comparable arguments.
|
|
*
|
|
* Bitvectors are compared using unsigned arithmetic.
|
|
*/
|
|
primitive (>) : {a} (Cmp a) => a -> a -> Bit
|
|
|
|
/**
|
|
* Less-than or equal of two comparable arguments.
|
|
*
|
|
* Bitvectors are compared using unsigned arithmetic.
|
|
*/
|
|
primitive (<=) : {a} (Cmp a) => a -> a -> Bit
|
|
|
|
/**
|
|
* Greater-than or equal of two comparable arguments.
|
|
*
|
|
* Bitvectors are compared using unsigned arithmetic.
|
|
*/
|
|
primitive (>=) : {a} (Cmp a) => a -> a -> Bit
|
|
|
|
/**
|
|
* Compares any two values of the same type for equality.
|
|
*/
|
|
primitive (==) : {a} (Cmp a) => a -> a -> Bit
|
|
|
|
/**
|
|
* Compares any two values of the same type for inequality.
|
|
*/
|
|
primitive (!=) : {a} (Cmp a) => a -> a -> Bit
|
|
|
|
/**
|
|
* Compare the outputs of two functions for equality.
|
|
*/
|
|
(===) : {a, b} (Cmp b) => (a -> b) -> (a -> b) -> (a -> Bit)
|
|
f === g = \ x -> f x == g x
|
|
|
|
/**
|
|
* Compare the outputs of two functions for inequality.
|
|
*/
|
|
(!==) : {a, b} (Cmp b) => (a -> b) -> (a -> b) -> (a -> Bit)
|
|
f !== g = \x -> f x != g x
|
|
|
|
/**
|
|
* Returns the smaller of two comparable arguments.
|
|
* Bitvectors are compared using unsigned arithmetic.
|
|
*/
|
|
min : {a} (Cmp a) => a -> a -> a
|
|
min x y = if x < y then x else y
|
|
|
|
/**
|
|
* Returns the greater of two comparable arguments.
|
|
* Bitvectors are compared using unsigned arithmetic.
|
|
*/
|
|
max : {a} (Cmp a) => a -> a -> a
|
|
max x y = if x > y then x else y
|
|
|
|
|
|
/**
|
|
* 2's complement signed less-than.
|
|
*/
|
|
primitive (<$) : {a} (SignedCmp a) => a -> a -> Bit
|
|
|
|
/**
|
|
* 2's complement signed greater-than.
|
|
*/
|
|
(>$) : {a} (SignedCmp a) => a -> a -> Bit
|
|
x >$ y = y <$ x
|
|
|
|
/**
|
|
* 2's complement signed less-than-or-equal.
|
|
*/
|
|
(<=$) : {a} (SignedCmp a) => a -> a -> Bit
|
|
x <=$ y = ~(y <$ x)
|
|
|
|
/**
|
|
* 2's complement signed greater-than-or-equal.
|
|
*/
|
|
(>=$) : {a} (SignedCmp a) => a -> a -> Bit
|
|
x >=$ y = ~(x <$ y)
|
|
|
|
/**
|
|
* 2's complement signed division. Division rounds toward 0.
|
|
*/
|
|
primitive (/$) : {a} (Arith a) => a -> a -> a
|
|
|
|
/**
|
|
* 2's complement signed remainder. Division rounds toward 0.
|
|
*/
|
|
primitive (%$) : {a} (Arith a) => a -> a -> a
|
|
|
|
/**
|
|
* Unsigned carry. Returns true if the unsigned addition of the given
|
|
* bitvector arguments would result in an unsigned overflow.
|
|
*/
|
|
carry : {n} (fin n) => [n] -> [n] -> Bit
|
|
carry x y = (x + y) < x
|
|
|
|
/**
|
|
* Signed carry. Returns true if the 2's complement signed addition of the
|
|
* given bitvector arguments would result in a signed overflow.
|
|
*/
|
|
scarry : {n} (fin n, n >= 1) => [n] -> [n] -> Bit
|
|
scarry x y = (sx == sy) && (sx != sz)
|
|
where
|
|
z = x + y
|
|
sx = x@0
|
|
sy = y@0
|
|
sz = z@0
|
|
|
|
/**
|
|
* Signed borrow. Returns true if the 2's complement signed subtraction of the
|
|
* given bitvector arguments would result in a signed overflow.
|
|
*/
|
|
sborrow : {n} (fin n, n >= 1) => [n] -> [n] -> Bit
|
|
sborrow x y = ( x <$ (x-y) ) ^ y@0
|
|
|
|
/**
|
|
* Zero extension of a bitvector.
|
|
*/
|
|
zext : {m, n} (fin m, m >= n) => [n] -> [m]
|
|
zext x = zero # x
|
|
|
|
/**
|
|
* Sign extension of a bitvector.
|
|
*/
|
|
sext : {m, n} (fin m, m >= n, n >= 1) => [n] -> [m]
|
|
sext x = newbits # x
|
|
where newbits = if x@0 then ~zero else zero
|
|
|
|
/**
|
|
* Short-cutting boolean conjunction function.
|
|
* If the first argument is False, the second argument
|
|
* is not evaluated.
|
|
*/
|
|
(/\) : Bit -> Bit -> Bit
|
|
x /\ y = if x then y else False
|
|
|
|
/**
|
|
* Short-cutting boolean disjunction function.
|
|
* If the first argument is True, the second argument
|
|
* is not evaluated.
|
|
*/
|
|
(\/) : Bit -> Bit -> Bit
|
|
x \/ y = if x then True else y
|
|
|
|
/**
|
|
* Short-cutting logical implication.
|
|
* If the first argument is False, the second argument is
|
|
* not evaluated.
|
|
*/
|
|
(==>) : Bit -> Bit -> Bit
|
|
a ==> b = if a then b else True
|
|
|
|
/**
|
|
* Logical 'and' over bits. Extends element-wise over sequences, tuples.
|
|
*/
|
|
primitive (&&) : {a} (Logic a) => a -> a -> a
|
|
|
|
/**
|
|
* Logical 'or' over bits. Extends element-wise over sequences, tuples.
|
|
*/
|
|
primitive (||) : {a} (Logic a) => a -> a -> a
|
|
|
|
/**
|
|
* Logical 'exclusive or' over bits. Extends element-wise over sequences, tuples.
|
|
*/
|
|
primitive (^) : {a} (Logic a) => a -> a -> a
|
|
|
|
/**
|
|
* Gives an arbitrary shaped value whose bits are all False.
|
|
* ~zero likewise gives an arbitrary shaped value whose bits are all True.
|
|
*/
|
|
primitive zero : {a} (Zero a) => a
|
|
|
|
/**
|
|
* Converts a bitvector to a non-negative integer in the range 0 to 2^^n-1.
|
|
*/
|
|
primitive toInteger : {bits} (fin bits) => [bits] -> Integer
|
|
|
|
/**
|
|
* Converts an unbounded integer to another arithmetic type. When converting
|
|
* to the bitvector type [n], the value is reduced modulo 2^^n.
|
|
*/
|
|
primitive fromInteger : {a} (Arith a) => Integer -> a
|
|
|
|
/**
|
|
* Converts an integer modulo n to an unbounded integer in the range 0 to n-1.
|
|
*/
|
|
primitive fromZ : {n} (fin n, n >= 1) => Z n -> Integer
|
|
|
|
/**
|
|
* Left shift. The first argument is the sequence to shift, the second is the
|
|
* number of positions to shift by.
|
|
*/
|
|
primitive (<<) : {n, ix, a} (fin ix, Zero a) => [n]a -> [ix] -> [n]a
|
|
|
|
/**
|
|
* Right shift. The first argument is the sequence to shift, the second is the
|
|
* number of positions to shift by.
|
|
*/
|
|
primitive (>>) : {n, ix, a} (fin ix, Zero a) => [n]a -> [ix] -> [n]a
|
|
|
|
/**
|
|
* Left rotate. The first argument is the sequence to rotate, the second is the
|
|
* number of positions to rotate by.
|
|
*/
|
|
primitive (<<<) : {n, ix, a} (fin n, fin ix) => [n]a -> [ix] -> [n]a
|
|
|
|
/**
|
|
* Right rotate. The first argument is the sequence to rotate, the second is
|
|
* the number of positions to rotate by.
|
|
*/
|
|
primitive (>>>) : {n, ix, a} (fin n, fin ix) => [n]a -> [ix] -> [n]a
|
|
|
|
/**
|
|
* 2's complement signed (arithmetic) right shift. The first argument
|
|
* is the sequence to shift (considered as a signed value),
|
|
* the second argument is the number of positions to shift
|
|
* by (considered as an unsigned value).
|
|
*/
|
|
primitive (>>$) : {n, ix} (fin n, n >= 1, fin ix) => [n] -> [ix] -> [n]
|
|
|
|
|
|
|
|
/**
|
|
* Concatenates two sequences. On bitvectors, the most-significant bits
|
|
* are in the left argument, and the least-significant bits are in the right.
|
|
*/
|
|
primitive (#) : {front, back, a} (fin front) => [front]a -> [back]a
|
|
-> [front + back] a
|
|
|
|
/**
|
|
* Splits a sequence into a pair of sequences.
|
|
* 'splitAt z = (x, y)' iff 'x # y = z'.
|
|
*/
|
|
primitive splitAt : {front, back, a} (fin front) => [front + back]a
|
|
-> ([front]a, [back]a)
|
|
|
|
/**
|
|
* Concatenates a list of sequences.
|
|
* 'join' is the inverse function to 'split'.
|
|
*/
|
|
primitive join : {parts, each, a} (fin each) => [parts][each]a
|
|
-> [parts * each]a
|
|
|
|
/**
|
|
* Splits a sequence into 'parts' groups with 'each' elements.
|
|
* 'split' is the inverse function to 'join'.
|
|
*/
|
|
primitive split : {parts, each, a} (fin each) => [parts * each]a
|
|
-> [parts][each]a
|
|
|
|
/**
|
|
* Reverses the elements in a sequence.
|
|
*/
|
|
primitive reverse : {n, a} (fin n) => [n]a -> [n]a
|
|
|
|
/**
|
|
* Transposes a matrix.
|
|
* Satisfies the property 'transpose m @ i @ j == m @ j @ i'.
|
|
*/
|
|
primitive transpose : {rows, cols, a} [rows][cols]a -> [cols][rows]a
|
|
|
|
/**
|
|
* Index operator. The first argument is a sequence. The second argument is
|
|
* the zero-based index of the element to select from the sequence.
|
|
*/
|
|
primitive (@) : {n, a, ix} (fin ix) => [n]a -> [ix] -> a
|
|
|
|
/**
|
|
* Bulk index operator. The first argument is a sequence. The second argument
|
|
* is a sequence of the zero-based indices of the elements to select.
|
|
*/
|
|
(@@) : {n, k, ix, a} (fin ix) => [n]a -> [k][ix] -> [k]a
|
|
xs @@ is = [ xs @ i | i <- is ]
|
|
|
|
/**
|
|
* Reverse index operator. The first argument is a finite sequence. The second
|
|
* argument is the zero-based index of the element to select, starting from the
|
|
* end of the sequence.
|
|
*/
|
|
primitive (!) : {n, a, ix} (fin n, fin ix) => [n]a -> [ix] -> a
|
|
|
|
/**
|
|
* Bulk reverse index operator. The first argument is a finite sequence. The
|
|
* second argument is a sequence of the zero-based indices of the elements to
|
|
* select, starting from the end of the sequence.
|
|
*/
|
|
(!!) : {n, k, ix, a} (fin n, fin ix) => [n]a -> [k][ix] -> [k]a
|
|
xs !! is = [ xs ! i | i <- is ]
|
|
|
|
/**
|
|
* Update the given sequence with new value at the given index position.
|
|
* The first argument is a sequence. The second argument is the zero-based
|
|
* index of the element to update, starting from the front of the sequence.
|
|
* The third argument is the new element. The return value is the
|
|
* initial sequence updated so that the indicated index has the given value.
|
|
*/
|
|
primitive update : {n, a, ix} (fin ix) => [n]a -> [ix] -> a -> [n]a
|
|
|
|
/**
|
|
* Update the given sequence with new value at the given index position.
|
|
* The first argument is a sequence. The second argument is the zero-based
|
|
* index of the element to update, starting from the end of the sequence.
|
|
* The third argument is the new element. The return value is the
|
|
* initial sequence updated so that the indicated index has the given value.
|
|
*/
|
|
primitive updateEnd : {n, a, ix} (fin n, fin ix) => [n]a -> [ix] -> a -> [n]a
|
|
|
|
/**
|
|
* Perform a series of updates to a sequence. The first argument is
|
|
* the initial sequence to update. The second argument is a sequence
|
|
* of indices, and the third argument is a sequence of values.
|
|
* This function applies the 'update' function in sequence with the
|
|
* given update pairs.
|
|
*/
|
|
updates : {n, k, ix, a} (fin ix, fin k) => [n]a -> [k][ix] -> [k]a -> [n]a
|
|
updates xs0 idxs vals = xss!0
|
|
where
|
|
xss = [ xs0 ] #
|
|
[ update xs i b
|
|
| xs <- xss
|
|
| i <- idxs
|
|
| b <- vals
|
|
]
|
|
|
|
/**
|
|
* Perform a series of updates to a sequence. The first argument is
|
|
* the initial sequence to update. The second argument is a sequence
|
|
* of indices, and the third argument is a sequence of values.
|
|
* This function applies the 'updateEnd' function in sequence with the
|
|
* given update pairs.
|
|
*/
|
|
updatesEnd : {n, k, ix, a} (fin n, fin ix, fin k) => [n]a -> [k][ix] -> [k]a -> [n]a
|
|
updatesEnd xs0 idxs vals = xss!0
|
|
where
|
|
xss = [ xs0 ] #
|
|
[ updateEnd xs i b
|
|
| xs <- xss
|
|
| i <- idxs
|
|
| b <- vals
|
|
]
|
|
|
|
/**
|
|
* A finite sequence counting up from 'first' to 'last'.
|
|
*
|
|
* '[a..b]' is syntactic sugar for 'fromTo`{first=a,last=b}'.
|
|
*/
|
|
primitive fromTo : {first, last, a} (fin last, last >= first, Literal last a) =>
|
|
[1 + (last - first)]a
|
|
|
|
/**
|
|
* A finite arithmetic sequence starting with 'first' and 'next',
|
|
* stopping when the values reach or would skip over 'last'.
|
|
*
|
|
* '[a,b..c]' is syntactic sugar for 'fromThenTo`{first=a,next=b,last=c}'.
|
|
*/
|
|
primitive fromThenTo : {first, next, last, a, len}
|
|
( fin first, fin next, fin last
|
|
, Literal first a, Literal next a, Literal last a
|
|
, first != next
|
|
, lengthFromThenTo first next last == len) => [len]a
|
|
|
|
/**
|
|
* An infinite sequence counting up from the given starting value.
|
|
* '[x...]' is syntactic sugar for 'infFrom x'.
|
|
*/
|
|
primitive infFrom : {a} (Arith a) => a -> [inf]a
|
|
|
|
/**
|
|
* An infinite arithmetic sequence starting with the given two values.
|
|
* '[x,y...]' is syntactic sugar for 'infFromThen x y'.
|
|
*/
|
|
primitive infFromThen : {a} (Arith a) => a -> a -> [inf]a
|
|
|
|
/**
|
|
* Produce a sequence using a generating function.
|
|
* Satisfies 'generate f @ i == f i' for all 'i' between '0' and 'n-1'.
|
|
*
|
|
* Declarations of the form 'x @ i = e' are syntactic sugar for
|
|
* 'x = generate (\i -> e)'.
|
|
*/
|
|
generate : {n, ix, a}
|
|
(fin ix, n >= 1, ix >= width (n - 1)) => ([ix] -> a) -> [n]a
|
|
generate f = [ f i | i <- [0 .. n-1] ]
|
|
|
|
primitive error : {a, len} (fin len) => [len][8] -> a
|
|
|
|
|
|
/**
|
|
* Performs multiplication of polynomials over GF(2).
|
|
*/
|
|
pmult : {u, v} (fin u, fin v) => [1 + u] -> [1 + v] -> [1 + u + v]
|
|
pmult x y = last zs
|
|
where
|
|
zs = [0] # [ (z << 1) ^ (if yi then 0 # x else 0) | yi <- y | z <- zs ]
|
|
|
|
/**
|
|
* Performs division of polynomials over GF(2).
|
|
*/
|
|
pdiv : {u, v} (fin u, fin v) => [u] -> [v] -> [u]
|
|
pdiv x y = [ z ! degree | z <- zs ]
|
|
where
|
|
degree : [width v]
|
|
degree = last (ds : [1 + v]_)
|
|
where ds = [0/0] # [if yi then i else d | yi <- reverse y | i <- [0..v] | d <- ds ]
|
|
|
|
reduce : [v] -> [v]
|
|
reduce u = if u ! degree then u ^ y else u
|
|
|
|
zs : [u][v]
|
|
zs = [ tail (reduce z # [xi]) | z <- [0] # zs | xi <- x ]
|
|
|
|
/**
|
|
* Performs modulus of polynomials over GF(2).
|
|
*/
|
|
pmod : {u, v} (fin u, fin v) => [u] -> [1 + v] -> [v]
|
|
pmod x y = if y == 0 then 0/0 else last zs
|
|
where
|
|
degree : [width v]
|
|
degree = last (ds : [2 + v]_)
|
|
where ds = [0/0] # [if yi then i else d | yi <- reverse y | i <- [0..v] | d <- ds ]
|
|
|
|
reduce : [1 + v] -> [1 + v]
|
|
reduce u = if u ! degree then u ^ y else u
|
|
|
|
powers : [inf][1 + v]
|
|
powers = [reduce 1] # [ reduce (p << 1) | p <- powers ]
|
|
|
|
zs = [0] # [ z ^ (if xi then tail p else 0) | xi <- reverse x | p <- powers | z <- zs ]
|
|
|
|
/**
|
|
* Generates random values from a seed. When called with a function, currently
|
|
* generates a function that always returns zero.
|
|
*/
|
|
primitive random : {a} [256] -> a
|
|
|
|
type String n = [n][8]
|
|
type Word n = [n]
|
|
type Char = [8]
|
|
|
|
take : {front, back, a} (fin front) => [front + back]a -> [front]a
|
|
take (x # _) = x
|
|
|
|
drop : {front, back, a} (fin front) => [front + back]a -> [back]a
|
|
drop ((_ : [front] _) # y) = y
|
|
|
|
tail : {n, a} [1 + n]a -> [n]a
|
|
tail xs = drop`{1} xs
|
|
|
|
/**
|
|
* Return the left-most element of a sequence.
|
|
*/
|
|
head : {n, a} [1 + n]a -> a
|
|
head xs = xs @ 0
|
|
|
|
/**
|
|
* Return the right-most element of a sequence.
|
|
*/
|
|
last : {n, a} (fin n) => [1 + n]a -> a
|
|
last xs = xs ! 0
|
|
|
|
/**
|
|
* Return the length of a sequence. Note that the result depends only
|
|
* on the type of the argument, not its value.
|
|
*/
|
|
length : {n, a, b} (fin n, Literal n b) => [n]a -> b
|
|
length _ = `n
|
|
|
|
undefined : {a} a
|
|
undefined = error "undefined"
|
|
|
|
groupBy : {each, parts, a} (fin each) => [parts * each]a -> [parts][each]a
|
|
groupBy = split`{parts=parts}
|
|
|
|
/**
|
|
* Define the base 2 logarithm function in terms of width
|
|
*/
|
|
type lg2 n = width (max n 1 - 1)
|
|
|
|
/**
|
|
* Debugging function for tracing. The first argument is a string,
|
|
* which is prepended to the printed value of the second argument.
|
|
* This combined string is then printed when the trace function is
|
|
* evaluated. The return value is equal to the third argument.
|
|
*
|
|
* The exact timing and number of times the trace message is printed
|
|
* depend on the internal details of the Cryptol evaluation order,
|
|
* which are unspecified. Thus, the output produced by this
|
|
* operation may be difficult to predict.
|
|
*/
|
|
primitive trace : {n, a, b} (fin n) => [n][8] -> a -> b -> b
|
|
|
|
/**
|
|
* Debugging function for tracing values. The first argument is a string,
|
|
* which is prepended to the printed value of the second argument.
|
|
* This combined string is then printed when the trace function is
|
|
* evaluated. The return value is equal to the second argument.
|
|
*
|
|
* The exact timing and number of times the trace message is printed
|
|
* depend on the internal details of the Cryptol evaluation order,
|
|
* which are unspecified. Thus, the output produced by this
|
|
* operation may be difficult to predict.
|
|
*/
|
|
traceVal : {n, a} (fin n) => [n][8] -> a -> a
|
|
traceVal msg x = trace msg x x
|
|
|
|
/* Functions previously in Cryptol::Extras */
|
|
|
|
/**
|
|
* Conjunction of all bits in a sequence.
|
|
*/
|
|
and : {n} (fin n) => [n]Bit -> Bit
|
|
and xs = ~zero == xs
|
|
|
|
/**
|
|
* Disjunction of all bits in a sequence.
|
|
*/
|
|
or : {n} (fin n) => [n]Bit -> Bit
|
|
or xs = zero != xs
|
|
|
|
/**
|
|
* Conjunction after applying a predicate to all elements.
|
|
*/
|
|
all : {n, a} (fin n) => (a -> Bit) -> [n]a -> Bit
|
|
all f xs = and (map f xs)
|
|
|
|
/**
|
|
* Disjunction after applying a predicate to all elements.
|
|
*/
|
|
any : {n, a} (fin n) => (a -> Bit) -> [n]a -> Bit
|
|
any f xs = or (map f xs)
|
|
|
|
/**
|
|
* Map a function over a sequence.
|
|
*/
|
|
map : {n, a, b} (a -> b) -> [n]a -> [n]b
|
|
map f xs = [f x | x <- xs]
|
|
|
|
/**
|
|
* Functional left fold.
|
|
*
|
|
* foldl (+) 0 [1,2,3] = ((0 + 1) + 2) + 3
|
|
*/
|
|
foldl : {n, a, b} (fin n) => (a -> b -> a) -> a -> [n]b -> a
|
|
foldl f acc xs = ys ! 0
|
|
where ys = [acc] # [f a x | a <- ys | x <- xs]
|
|
|
|
/**
|
|
* Functional right fold.
|
|
*
|
|
* foldr (-) 0 [1,2,3] = 0 - (1 - (2 - 3))
|
|
*/
|
|
foldr : {n, a, b} (fin n) => (a -> b -> b) -> b -> [n]a -> b
|
|
foldr f acc xs = ys ! 0
|
|
where ys = [acc] # [f x a | a <- ys | x <- reverse xs]
|
|
|
|
/**
|
|
* Compute the sum of the values in the sequence.
|
|
*/
|
|
sum : {n, a} (fin n, Arith a) => [n]a -> a
|
|
sum xs = foldl (+) (fromInteger 0) xs
|
|
|
|
/**
|
|
* Scan left is like a foldl that also emits the intermediate values.
|
|
*/
|
|
scanl : {n, b, a} (b -> a -> b) -> b -> [n]a -> [n+1]b
|
|
scanl f acc xs = ys
|
|
where ys = [acc] # [f a x | a <- ys | x <- xs]
|
|
|
|
/**
|
|
* Scan right is like a foldr that also emits the intermediate values.
|
|
*/
|
|
scanr : {n, a, b} (fin n) => (a -> b -> b) -> b -> [n]a -> [n+1]b
|
|
scanr f acc xs = reverse ys
|
|
where ys = [acc] # [f x a | a <- ys | x <- reverse xs]
|
|
|
|
/**
|
|
* Repeat a value.
|
|
*/
|
|
repeat : {n, a} a -> [n]a
|
|
repeat x = [ x | _ <- zero : [n] ]
|
|
|
|
/**
|
|
* 'elem x xs' returns true if x is equal to a value in xs.
|
|
*/
|
|
elem : {n, a} (fin n, Cmp a) => a -> [n]a -> Bit
|
|
elem a xs = any (\x -> x == a) xs
|
|
|
|
/**
|
|
* Create a list of tuples from two lists.
|
|
*/
|
|
zip : {n, a, b} [n]a -> [n]b -> [n](a, b)
|
|
zip xs ys = [(x,y) | x <- xs | y <- ys]
|
|
|
|
/**
|
|
* Create a list by applying the function to each pair of elements in the input.
|
|
*/
|
|
zipWith : {n, a, b, c} (a -> b -> c) -> [n]a -> [n]b -> [n]c
|
|
zipWith f xs ys = [f x y | x <- xs | y <- ys]
|
|
|
|
/**
|
|
* Transform a function into uncurried form.
|
|
*/
|
|
uncurry : {a, b, c} (a -> b -> c) -> (a, b) -> c
|
|
uncurry f = \(a, b) -> f a b
|
|
|
|
/**
|
|
* Transform a function into curried form.
|
|
*/
|
|
curry : {a, b, c} ((a, b) -> c) -> a -> b -> c
|
|
curry f = \a b -> f (a, b)
|
|
|
|
/**
|
|
* Map a function iteratively over a seed value, producing an infinite
|
|
* list of successive function applications.
|
|
*/
|
|
iterate : {a} (a -> a) -> a -> [inf]a
|
|
iterate f x = [x] # [ f v | v <- iterate f x ]
|