haquil 0.2.1.5 → 0.2.1.14

raw patch · 7 files changed

+483/−58 lines, 7 filesPVP: minor bump suggested

API additions: PVP suggests at least a minor version bump

API changes (from Hackage documentation)

Files

• ChangeLog.md +5/−0
• ReadMe.md +1/−1
• haquil.cabal +2/−2
• src/Data/Qubit.hs +94/−33
• src/Language/Quil/Execute.hs +43/−10
• src/Language/Quil/Types.hs +42/−11
• src/Test.hs +296/−1

@@ -1,5 +1,10 @@ # Revision history for quil +## 0.2.1.14  -- 2018-03-04++* execution of Quil programs+* additional test cases+ ## 0.2.0.0  -- 2017-12-19  * added types for Quil

@@ -13,7 +13,7 @@  	> import Control.Monad.Random (evalRandIO) 	> import Data.Qubit ((^^*), groundState, measure)-	> import Data.Qubit.Gate (H, CNOT)+	> import Data.Qubit.Gate (h, cnot) 	 	> -- Construct the Bell state. 	> let bell = [h 0, cnot 0 1] ^^* groundState 2

@@ -1,5 +1,5 @@ name               : haquil-version            : 0.2.1.5+version            : 0.2.1.14 synopsis           : A Haskell implementation of the Quil instruction set for quantum computing. description        : This Haskell library implements the Quil language for quantum computing, as specified in "A Practical Quantum Instruction Set Architecture" \<https:\/\/arxiv.org\/abs\/1608.03355\/\>. @@ -12,7 +12,7 @@  homepage           : https://bitbucket.org/functionally/haquil bug-reports        : https://bwbush.atlassian.net/projects/HQUIL/issues/-package-url        : https://bitbucket.org/functionally/quil/downloads/haquil-0.2.1.5.tar.gz+package-url        : https://bitbucket.org/functionally/quil/downloads/haquil-0.2.1.14.tar.gz  category           : Language stability          : Unstable

@@ -9,7 +9,34 @@ -- Portability :  Portable -- -- | Qubits and operations on them, using the indexing conventions of \<<https://arxiv.org/abs/1711.02086/>\>.---+-- +-- The example below creates a wavefunction for the [Bell state](https://en.wikipedia.org/wiki/Bell_state) and then performs a measurement on its highest qubit.+-- +-- > >>> import Control.Monad.Random (evalRandIO)+-- > >>> import Data.Qubit ((^^*), groundState, measure)+-- > >>> import Data.Qubit.Gate (h, cnot)+-- >+-- > -- Construct the Bell state.+-- > >>> let bell = [h 0, cnot 0 1] ^^* groundState 2+-- > >>> bell+-- > 0.7071067811865475|00> + 0.7071067811865475|11> @ [1,0]+-- >+-- > -- Measure the Bell wavefunction.+-- > >>> bell' <- evalRandIO $ measure [1] bell+-- > >>> bell'+-- > ([(1,0)],1.0|00> @ [1,0])+-- >+-- > -- Measure it again.+-- > >>> evalRandIO $ measure [1] bell'+-- > ([(1,0)],1.0|00> @ [1,0])+-- >+-- > -- Measure another Bell wavefunction.+-- > >>> evalRandIO $ measure [1] bell+-- > ([(1,0)],1.0|00> @ [1,0])+-- >+-- > -- Measure another Bell wavefunction.+-- > >>> evalRandIO $ measure [1] bell+-- > ([(1,1)],1.0|11> @ [1,0]) -----------------------------------------------------------------------------  @@ -53,19 +80,19 @@   import Control.Arrow (first, second)-import Control.Monad (replicateM)+import Control.Monad (ap, mapM, replicateM) import Control.Monad.Random.Class (fromList) import Control.Monad.Random.Lazy (Rand, RandomGen)-import Data.Complex (Complex(..), magnitude)+import Data.Complex (Complex(..), conjugate, magnitude) import Data.Function (on) import Data.Int.Util (ilog2, isqrt) import Data.List (elemIndex, groupBy, intersect, intercalate, sortBy) import Data.Maybe (catMaybes) import Numeric.LinearAlgebra.Array ((.*))-import Numeric.LinearAlgebra.Array.Util (Idx(iName), asScalar, coords, dims, order, outers, renameExplicit, reorder)-import Numeric.LinearAlgebra.Tensor (Tensor, Variant(..), listTensor, switch)+import Numeric.LinearAlgebra.Array.Util (Idx(iName), asScalar, coords, dims, mapArray, order, outers, renameExplicit, reorder, setType)+import Numeric.LinearAlgebra.Tensor (Tensor, Variant(..), contrav, listTensor, switch) -import qualified Data.Vector.Storable as V (toList)+import qualified Data.Vector.Storable as V (map, toList)   -- | States of a quibit.@@ -90,12 +117,25 @@ names = fmap iName . dims  --- | Prefixes for 'Tensor' indices.-indexPrefix :: Variant -> Char-indexPrefix Contra = 'm'-indexPrefix Co     = 'n'+-- | Prefixes for 'Tensor' variants.+variantPrefix :: Variant -> Char+variantPrefix Contra = 'm'+variantPrefix Co     = 'n'  +-- | 'Tensor' variants for index prefixes.+prefixVariant :: String -> Variant+prefixVariant ('m' : _) = Contra+prefixVariant ('n' : _) = Co+prefixVariant _         = error "Unexpected index."+++prefixDimension :: String -> Int+prefixDimension ('m' : _) = 2+prefixDimension ('n' : _) = -2+prefixDimension _         = error "Unexpected index."++ -- | 'Tensor' index for a collection of qubits. indexLabels :: Variant            -- ^ Whether contravariant or covariant.             -> [QIndex]           -- ^ Indices of the qubits.@@ -108,7 +148,7 @@         Contra -> 0         Co     -> n   in-    zipWith (\k v -> (show k, indexPrefix variant : show v)) [(1+o)..] $ reverse indices+    zipWith (\k v -> (show k, variantPrefix variant : show v)) [(1+o)..] $ reverse indices   -- | 'Tensor' index for a wavefunction.@@ -132,6 +172,7 @@ showAmplitude (a :+ b)   | b == 0    = show a   | a == 0    = show b ++ "i"+  | b <  0    = "(" ++ show a ++        show b ++ "i)"   | otherwise = "(" ++ show a ++ "+" ++ show b ++ "i)"  @@ -147,16 +188,16 @@            -> a                       -- ^ What to show.            -> String                  -- ^ The string respresentation. showTensor toTensor format x =-    let-      x' = canonicalOrder $ toTensor x-      n = order x'-    in-      (++ (show $ tensorIndices x'))-      . (++ " @ ")-      . intercalate " + "-        . fmap (format n)-        . filter ((/= 0) . snd)-        $ tensorAmplitudes x'+  let+    x' = canonicalOrder $ toTensor x+    n = order x'+  in+    (++ (show $ tensorIndices x'))+    . (++ " @ ")+    . intercalate " + "+      . fmap (format n)+      . filter ((/= 0) . snd)+      $ tensorAmplitudes x'   -- | Indices in a tensor.@@ -164,19 +205,39 @@               -> [QIndex]         -- ^ The qubit indices. tensorIndices =   fmap (read . tail)-    . filter ((== indexPrefix Contra) . head)+    . filter ((== variantPrefix Contra) . head)     . names   -- | Transpose a tensor to canonical order. canonicalOrder :: Tensor Amplitude -> Tensor Amplitude canonicalOrder x =-  let-    f (v : i) (v' : i') = (v, - read i :: Int) `compare` (v', - read i')-    f _ _ = undefined-  in-    reorder (sortBy f $ names x) x-+  if False+    then let -- See <https://bwbush.atlassian.net/browse/HQUIL-9>.+           n = order x+           f (v : i) (v' : i') = (v, - read i :: Int) `compare` (v', - read i')+           f _ _ = undefined+           ns = names x+           ns' = sortBy f ns+           Just permutation = (mapM . flip elemIndex) ns ns'+           permute y = map (y !!) permutation+           x' =+             renameExplicit (zip (show <$> ([1..] :: [Int])) ns')+               . listTensor (prefixDimension <$> ns')+               . fmap snd+               . sortBy (compare `on` fst)+               . fmap (first permute)+               . zip (replicateM n [(minBound::QState)..maxBound])+               . V.toList+              $ coords x+         in+           foldl (flip $ ap setType prefixVariant) (contrav x') ns'+    else let+           f (v : i) (v' : i') = (v, - read i :: Int) `compare` (v', - read i')+           f _ _ = undefined+         in+           reorder (sortBy f $ names x) x+   -- | Amplitudes in a tensor. tensorAmplitudes :: Tensor Amplitude        -- ^ The tensor.@@ -231,7 +292,7 @@       -> Wavefunction           -- ^ The wavefunction for the qubit. qubit index (a0, a1) =   Wavefunction-    . renameExplicit [("1", indexPrefix Contra : show index)]+    . renameExplicit [("1", variantPrefix Contra : show index)]     $ listTensor [2] [a0, a1]  @@ -345,8 +406,8 @@ mult :: Tensor Amplitude -> Tensor Amplitude -> Tensor Amplitude mult x y =   let-    lft  = filter ((== indexPrefix Co    ) . head) $ names x-    rght = filter ((== indexPrefix Contra) . head) $ names y+    lft  = filter ((== variantPrefix Co    ) . head) $ names x+    rght = filter ((== variantPrefix Contra) . head) $ names y     cmmn = fmap tail lft `intersect` fmap tail rght     x' = renameExplicit [(i, '@' : tail i) | i <- filter ((`elem` cmmn) . tail) lft ] x     y' = renameExplicit [(i, '@' : tail i) | i <- filter ((`elem` cmmn) . tail) rght] y@@ -427,7 +488,7 @@         ]     z = p .* y   in-    Wavefunction $ z / sqrt (z * switch z)+    Wavefunction $ z / sqrt (mapArray (V.map conjugate) z * switch z)   -- | Measure qubits in a wavefunction.@@ -446,4 +507,4 @@ -- | The total probability for the wave function, which should be 1. wavefunctionProbability :: Wavefunction                         -> Amplitude-wavefunctionProbability (Wavefunction x) = asScalar $ x * switch x+wavefunctionProbability (Wavefunction x) = asScalar $ mapArray (V.map conjugate) x * switch x

@@ -10,6 +10,33 @@ -- -- | Executing Quil programs. --+-- This example makes measurements on a prepared state.+--+-- > >>> import Language.Quil.Execute+-- > >>> import Language.Quil.Types+-- >+-- > -- Run a simple program and examine the quantum and classical states..+-- > >>> let program = [H 0, CNOT 0 1, RX (Expression . Number $ pi/4) 1]+-- > >>> runProgramWithStdRandom 2 [BoolBit False] program+-- > Quantum state:   0.6532814824381882|00> + -0.27059805007309845i|01> + -0.27059805007309845i|10> + 0.6532814824381882|11> @ [1,0]+-- > Classical state: 0x0 [1]+-- > Program counter: 3+-- > Halted?          False+-- >+-- > -- Add measurement to the program and re-run it.+-- > >>> let program' = program ++ [MEASURE 0 (Just 0)]+-- > >>> runProgramWithStdRandom 2 [BoolBit False] program'+-- > Quantum state:   0.9238795325112867|00> + -0.3826834323650897i|10> @ [1,0]+-- > Classical state: 0x0 [1]+-- > Program counter: 4+-- > Halted?          False+-- >+-- > -- Run the program again.+-- > >>> runProgramWithStdRandom 2 [BoolBit False] program'+-- > Quantum state:   -0.3826834323650897i|01> + 0.9238795325112867|11> @ [1,0]+-- > Classical state: 0x1 [1]+-- > Program counter: 4+-- > Halted?          False -----------------------------------------------------------------------------  @@ -29,10 +56,10 @@ ) where  -import Control.Monad (foldM)+import Control.Monad (foldM, join) import Control.Monad.Random.Lazy (Rand, RandomGen, evalRand, evalRandIO)-import Data.Bits (clearBit, complementBit, setBit, testBit)-import Data.BitVector (BV)+import Data.Bits (complementBit, setBit, testBit)+import Data.BitVector (BV, size) import Data.Complex (Complex((:+))) import Data.Function (on) import Data.Qubit (Operator, Wavefunction, (^*), groundState, measure, qubitsOperator, wavefunctionOrder)@@ -48,7 +75,7 @@ runProgramWithStdGen :: StdGen        -- ^ The random number generator.                      -> Int           -- ^ The number of qubits.                      -> [BitData]     -- ^ The classical bits.-                     -> [Instruction] -- ^ The instructions+                     -> [Instruction] -- ^ The instructions.                      -> Machine       -- ^ The resulting state of the machine. runProgramWithStdGen stdGen n cstate' instructions = runProgram n cstate' instructions `evalRand` stdGen @@ -56,7 +83,7 @@ -- | Run a program, starting from the ground state and using a particular random-number generator. runProgramWithStdRandom :: Int           -- ^ The number of qubits.                         -> [BitData]     -- ^ The classical bits.-                        -> [Instruction] -- ^ The instructions+                        -> [Instruction] -- ^ The instructions.                         -> IO Machine    -- ^ Action for the resulting state of the machine. runProgramWithStdRandom n cstate' instructions = evalRandIO $ runProgram n cstate' instructions @@ -65,14 +92,14 @@ runProgram :: RandomGen g            => Int            -- ^ The number of qubits.            -> [BitData]      -- ^ The classical bits.-           -> [Instruction]  -- ^ The instructions+           -> [Instruction]  -- ^ The instructions.            -> Rand g Machine -- ^ Action for the resulting state of the machine. runProgram n cstate' instructions = executeInstructions instructions $ Q.machine n cstate'   -- | Execute a series of instructions. executeInstructions :: RandomGen g-                    => [Instruction]  -- ^ The instructions+                    => [Instruction]  -- ^ The instructions.                     -> Machine        -- ^ The state of the machine.                     -> Rand g Machine -- ^ Action for the resulting state of the machine. executeInstructions = flip $ foldM (flip executeInstruction)@@ -204,7 +231,13 @@        => (BV -> BV)     -- ^ The transformation of the bits.        -> Machine        -- ^ THe machine.        -> Rand g Machine -- ^ Action for the resulting state of the machine.-onBits transition machine@Machine{..} = noop machine { cstate = transition cstate }+onBits transition machine@Machine{..} =+  let+    cstate' = transition cstate+  in+    if size cstate == size cstate'+      then noop machine { cstate = transition cstate }+      else error "Cannot enlarge tne number of classical bits."   -- | Set a bit.@@ -213,7 +246,7 @@         -> BV   -- ^ The initial bits.         -> BV   -- ^ The result. setBit' True  = flip setBit-setBit' False = flip clearBit+setBit' False = flip (join . (complementBit .) . setBit) -- See <https://bwbush.atlassian.net/browse/HQUIL-7>.   -- | Compile a gate.@@ -230,7 +263,7 @@ -- | Compile an expression. compileExpression :: Parameters -- ^ The formal parameters.                   -> Expression -- ^ The expression.-                  -> Arguments  -- ^ The argument.+                  -> Arguments  -- ^ The arguments.                   -> Number     -- ^ The result. compileExpression parameters (Power  x y) = \z -> ((**) `on` flip (compileExpression parameters) z) x y compileExpression parameters (Times  x y) = \z -> ((*)  `on` flip (compileExpression parameters) z) x y

@@ -43,6 +43,7 @@ , BitData(..) , toBitVector , boolFromBitVector+, finiteBitsFromBitVector , integerFromBitVector , doubleFromBitVector , complexFromBitVector@@ -50,12 +51,15 @@   import Data.Binary.IEEE754 (doubleToWord, wordToDouble)-import Data.BitVector (BV, bitVec, extract, showHex, testBit)+import Data.BitVector (BV, bitVec, extract, showHex, size, testBit)+import Data.Bits (FiniteBits(finiteBitSize)) import Data.Complex (Complex((:+)), imagPart, realPart) import Data.Default (Default(def))+import Data.Int (Int8, Int16, Int32, Int64) import Data.Monoid ((<>)) import Data.Qubit (Operator, Wavefunction, groundState) import Data.Vector (Vector)+import Data.Word (Word8, Word16, Word32, Word64)   -- | A quantum abstract machine.@@ -63,7 +67,7 @@   Machine   {     qstate       :: Wavefunction -- ^ The qubits.-  , cstate       :: BV           -- ^ The classical bits+  , cstate       :: BV           -- ^ The classical bits.   , definitions  :: Definitions  -- ^ Definitions of gates and circuits.   , counter      :: Int          -- ^ The program counter.   , halted       :: Bool         -- ^ Whether the machine has halted.@@ -74,7 +78,7 @@     unlines       [         "Quantum state:   " ++ show    qstate-      , "Classical state: " ++ showHex cstate+      , "Classical state: " ++ showHex cstate ++ " [" ++ show (size cstate) ++ "]"       , "Program counter: " ++ show    counter       , "Halted?          " ++ show    halted       ]@@ -101,6 +105,14 @@ -- | Data types for encoding as bit vectors. data BitData =     BoolBit Bool+  | IntBits8 Int8+  | IntBits16 Int16+  | IntBits32 Int32+  | IntBits64 Int64+  | WordBits8 Word8+  | WordBits16 Word16+  | WordBits32 Word32+  | WordBits64 Word64   | IntegerBits Int Integer   | DoubleBits Double   | ComplexBits Number@@ -109,10 +121,18 @@  -- | Encode data as a bit vector. toBitVector :: BitData -> BV-toBitVector (BoolBit       x) = bitVec 1 $ fromEnum x-toBitVector (IntegerBits n x) = bitVec n x+toBitVector (BoolBit       x) = bitVec  1 $ fromEnum x+toBitVector (IntBits8      x) = bitVec  8 $ toInteger x+toBitVector (IntBits16     x) = bitVec 16 $ toInteger x+toBitVector (IntBits32     x) = bitVec 32 $ toInteger x+toBitVector (IntBits64     x) = bitVec 64 $ toInteger x+toBitVector (WordBits8     x) = bitVec  8 $ toInteger x+toBitVector (WordBits16    x) = bitVec 16 $ toInteger x+toBitVector (WordBits32    x) = bitVec 32 $ toInteger x+toBitVector (WordBits64    x) = bitVec 64 $ toInteger x+toBitVector (IntegerBits n x) = bitVec  n   x toBitVector (DoubleBits    x) = bitVec 64 $ doubleToWord x-toBitVector (ComplexBits   x) = bitVec 64 (doubleToWord $ realPart x) <> bitVec 64 (doubleToWord $ imagPart x)+toBitVector (ComplexBits   x) = bitVec 64   (doubleToWord $ realPart x) <> bitVec 64 (doubleToWord $ imagPart x)   -- | Extract a boolean from a bit vector.@@ -122,11 +142,22 @@ boolFromBitVector = flip testBit  +-- | Extract a finite bits from a bit vector.+finiteBitsFromBitVector :: (Integral a, FiniteBits a)+                        => Int  -- ^ Which bit to start from, counting from zero.+                        -> BV   -- ^ The bit vector.+                        -> a    -- ^ The finite bits.+finiteBitsFromBitVector k v =+  let+    y = fromIntegral . toInteger $ extract (k + finiteBitSize y - 1) k v+  in+    y+ -- | Extract an integer from a bit vector. integerFromBitVector :: Int -- ^ Which bit to start from, counting from zero.-                     -> Int -- ^ How many bits to encode.-                     -> BV  -- ^ The bit vector-                     -> Integer -- ^ The integer.+                     -> Int     -- ^ How many bits to encode.+                     -> BV      -- ^ The bit vector+                     -> Integer -- ^ The integer (unsigned). integerFromBitVector k n = toInteger . extract (k + n - 1) k  @@ -134,14 +165,14 @@ doubleFromBitVector :: Int    -- ^ Which bit to start from, counting from zero.                     -> BV     -- ^ THe bit vector.                     -> Double -- ^ The double.-doubleFromBitVector k = wordToDouble . toEnum . fromEnum . extract (k + 63) k+doubleFromBitVector k = wordToDouble . fromIntegral . extract (k + 63) k   -- | Extract a complex number from a bit vector. complexFromBitVector :: Int -- ^ Which bit to start from, counting from zero.                      -> BV  -- ^ THe bit vector.                      -> Number -- ^ The complex number.-complexFromBitVector k x = doubleFromBitVector k x :+ doubleFromBitVector (k + 64) x+complexFromBitVector k x = doubleFromBitVector (k + 64) x :+ doubleFromBitVector k x   -- | Definitions of gates and circuits.

@@ -14,6 +14,7 @@ -----------------------------------------------------------------------------  +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TemplateHaskell #-}  {-# OPTIONS_GHC -fno-warn-missing-signatures #-}@@ -25,20 +26,38 @@   import Control.Monad (replicateM)+import Control.Monad.Random.Lazy (evalRandIO)+import Data.BitVector (BV)+import Data.Bits (bit, complementBit, setBit, testBit, xor) import Data.Complex (Complex(..), cis, magnitude) import Data.Int.Util (ilog2) import Data.Qubit (QState(..), (^*), groundState, pureQubit, pureState, qubit, qubits, rawWavefunction, wavefunctionAmplitudes, wavefunctionIndices, wavefunctionOrder)+import Language.Quil.Execute (compileExpression, executeInstruction, runProgramWithStdRandom)+import Language.Quil.Types (Address, BitData(..), Expression(..), Instruction(..), Machine(..), Parameter(..), boolFromBitVector, complexFromBitVector, doubleFromBitVector, finiteBitsFromBitVector, integerFromBitVector, machine, toBitVector) import Numeric.LinearAlgebra.Array ((.*))-import Numeric.LinearAlgebra.Array.Util (coords, scalar)+import Numeric.LinearAlgebra.Array.Util (asScalar, coords, scalar)+import Numeric.LinearAlgebra.Tensor (switch) import Test.QuickCheck.All (quickCheckAll)+import Test.QuickCheck.Monadic (assert, monadicIO, run)+import Test.QuickCheck.Property (Property) import System.Exit (exitFailure, exitSuccess)  import qualified Data.Qubit.Gate as G+import qualified Data.Vector as V (empty, fromList) import qualified Data.Vector.Storable as V (toList)   -- Helper functions. +p = Expression . Number++clearBit x k = -- See <https://bwbush.atlassian.net/browse/HQUIL-7>.+  if testBit x k+    then x `xor` bit k+    else x++few = (+ 1) . (`mod` 10)+ i = scalar $ 0 :+ 1  cos' = scalar . (:+ 0) . cos@@ -54,6 +73,11 @@  (~~~) = (and .) . zipWith (\x y -> magnitude (x - y) <= epsilon) +(~=~) x y =+  let+    z = rawWavefunction x - rawWavefunction y+  in+    magnitude (asScalar  $ z * switch z) < epsilon  -- Wavefunction tests. @@ -324,6 +348,277 @@     && g b101 ~~ b110     && g b110 ~~ b101     && g b111 ~~ b111++-- Bit data.++prop_bitdata_bool x =+  x == boolFromBitVector 0 (toBitVector $ BoolBit x)++prop_bitdata_int8 x =+  x == finiteBitsFromBitVector 0 (toBitVector $ IntBits8 x)++prop_bitdata_int16 x =+  x == finiteBitsFromBitVector 0 (toBitVector $ IntBits16 x)++prop_bitdata_int32 x =+  x == finiteBitsFromBitVector 0 (toBitVector $ IntBits32 x)++prop_bitdata_int64 x =+  x == finiteBitsFromBitVector 0 (toBitVector $ IntBits64 x)++prop_bitdata_word8 x =+  x == finiteBitsFromBitVector 0 (toBitVector $ WordBits8 x)++prop_bitdata_word16 x =+  x == finiteBitsFromBitVector 0 (toBitVector $ WordBits16 x)++prop_bitdata_word32 x =+  x == finiteBitsFromBitVector 0 (toBitVector $ WordBits32 x)++prop_bitdata_word64 x =+  x == finiteBitsFromBitVector 0 (toBitVector $ WordBits64 x)++prop_bitdata_integer x =+  x < 0 || x == integerFromBitVector 0 n (toBitVector $ IntegerBits n x)+    where+      n = if x == 0 then 1 else fromIntegral (ilog2 x + 1)++prop_bitdata_double x =+  x == doubleFromBitVector 0 (toBitVector $ DoubleBits x)++prop_bitdata_complex x =+  x == complexFromBitVector 0 (toBitVector $ ComplexBits x)+++-- Expressions.++prop_expression_power x y =+  x ** y == compileExpression V.empty (Power (Number x) (Number y)) V.empty++prop_expression_times x y =+  x * y == compileExpression V.empty (Times (Number x) (Number y)) V.empty++prop_expression_divide x y =+  y == 0 || x / y == compileExpression V.empty (Divide (Number x) (Number y)) V.empty++prop_expression_plus x y =+  x + y == compileExpression V.empty (Plus (Number x) (Number y)) V.empty++prop_expression_minus x y =+  x - y == compileExpression V.empty (Minus (Number x) (Number y)) V.empty++prop_expression_negate x =+  - x == compileExpression V.empty (Negate $ Number x) V.empty++prop_expression_sin x =+  sin x == compileExpression V.empty (Sin $ Number x) V.empty++prop_expression_cos x =+  cos x == compileExpression V.empty (Cos $ Number x) V.empty++prop_expression_sqrt x =+  sqrt x == compileExpression V.empty (Sqrt $ Number x) V.empty++prop_expression_exp x =+  exp x == compileExpression V.empty (Exp $ Number x) V.empty++prop_expression_cis x =+  cis x == compileExpression V.empty (Cis .Number $ x :+ 0) V.empty++prop_expression_number x =+  x == compileExpression V.empty (Number x) V.empty++prop_expression_variable x y z w =+  y == compileExpression (V.fromList [x, z]) (Variable x) (V.fromList [y, w])+++-- Classical bits.++classicalSingle :: (Address -> Instruction) -> (BV -> Int -> BV) -> Integer -> Int -> Property+classicalSingle g f x k =+  monadicIO+    $ do+      let+        n = if x <= 0 then 1 else fromIntegral (ilog2 x + 1)+        k' = k `mod` n+        m = machine 1 [IntegerBits n x]+      m' <- run . evalRandIO $ executeInstruction (g k') m+      assert $ x < 0 || f (cstate m) k' == cstate m'++classicalDouble :: (Address -> Address -> Instruction) -> (BV -> Int -> Int -> BV) -> Integer -> Int -> Int -> Property+classicalDouble g f x k l =+  monadicIO+    $ do+      let+        n = if x <= 0 then 1 else fromIntegral (ilog2 x + 1)+        k' = k `mod` n+        l' = l `mod` n+        m = machine 1 [IntegerBits n x]+      m' <- run . evalRandIO $ executeInstruction (g k' l') m+      assert $ x < 0 || f (cstate m) k' l' == cstate m'++prop_classical_false =+  classicalSingle FALSE clearBit++prop_classical_true =+  classicalSingle TRUE setBit++prop_classical_not =+  classicalSingle NOT complementBit++prop_classical_and =+  classicalDouble AND+    $ \bv k l -> +      if testBit bv k && testBit bv l+        then bv `setBit` l+        else bv `clearBit` l+++prop_classical_or =+  classicalDouble OR+    $ \bv k l -> +      if testBit bv k || testBit bv l+        then bv `setBit` l+        else bv `clearBit` l++prop_classical_move =+  classicalDouble MOVE+    $ \bv k l -> +      if testBit bv k+        then bv `setBit` l+        else bv `clearBit` l++prop_classical_exchange =+  classicalDouble EXCHANGE+    $ \bv k l -> +      case (testBit bv k, testBit bv l) of+        (False, True ) -> bv `setBit`   k `clearBit` l+        (True , False) -> bv `clearBit` k `setBit`   l+        _              -> bv+++-- Quantum bits.++prop_quantum_reset n =+  monadicIO+    $ do+      let n' = few n+      Machine{..} <- run $ runProgramWithStdRandom n' [] [RESET]+      assert $ qstate == groundState n'++prop_quantum_one =+  monadicIO+    $ do+      Machine{..} <-+        run+          $ runProgramWithStdRandom 1 [IntBits8 0]+          [+            RX (p $ pi/2) 0+          , T 0+          , H 0+          , S 0+          , RY (p 0.2) 0+          , I 0+          , PHASE (p 0.3) 0+          ]+      assert $ qstate ~=~ qubits [+                                    0.8845856219   :+ (-0.3664073617)+                                 , (-0.2872987275) :+   0.0267088763+                                 ]++prop_quantum_two =+  monadicIO+    $ do+      Machine{..} <-+        run+          $ runProgramWithStdRandom 2 [IntBits8 0]+          [+            RX (p $ pi/2) 0+          , T 1+          , H 0+          , S 0+          , RY (p 0.2) 1+          , I 0+          , PHASE (p 0.3) 0+          ]+      assert $ qstate ~=~ qubits [+                                     0.4975020826  :+ (-0.4975020826)+                                 , (-0.6223038112) :+   0.3282599747+                                 ,   0.0499167083  :+ (-0.0499167083)+                                 , (-0.0624386488) :+   0.0329358569+                                 ]++prop_quantum_three =+  monadicIO+    $ do+      Machine{..} <-+        run+          $ runProgramWithStdRandom 3 [IntBits8 0]+          [+            RX (p 0.1) 0+          , RY (p 0.2) 1+          , H 0+          , RZ (p 0.3) 2+          , PSWAP (p 0.4) 2 1+          , CSWAP 1 0 2+          , H 1+          ]+      assert $ qstate ~=~ qubits [+                                   0.4875851636 :+ (-0.0988384058)+                                 , 0.4950166445 :+ (-0.0496673327)+                                 , 0.4875851636 :+ (-0.0988384058)+                                 , 0.4950166445 :+ (-0.0496673327)+                                 , 0.0489216975 :+   0.009916919+                                 , 0.0476872529 :+   0.014751396+                                 , 0.0489216975 :+   0.009916919+                                 , 0.0476872529 :+   0.014751396+                                 ]++prop_quantum_four =+  monadicIO+    $ do+      Machine{..} <-+        run+          $ runProgramWithStdRandom 4 [IntBits8 0]+          [+            CPHASE00 (p 0.1) 0 1+          , H 3+          , CPHASE01 (p 0.2) 2 3+          , CCNOT 3 0 1+          , CPHASE10 (p 0.3) 2 1+          , ISWAP 3 2+          , PHASE (p 0.5) 3+          , CPHASE (p 0.4) 3 0+          , Z 3+          , CZ 1 3+          ]+      assert $ qstate ~=~ qubits [+                                     0.7035741926  :+ 0.0705928859 -- |0000>+                                 ,   0+                                 ,   0+                                 ,   0+                                 , (-0.2089643421) :+ 0.6755249098 -- |0100>+                                 ,   0+                                 ,   0+                                 ,   0+                                 ,   0+                                 ,   0+                                 ,   0+                                 ,   0+                                 ,   0+                                 ,   0+                                 ,   0+                                 ,   0+                                 ]++prop_quantum_measure =+  monadicIO+    $ do+      Machine{..} <-+        run+          $ runProgramWithStdRandom 2 [IntBits8 0] [H 0, CNOT 0 1, MEASURE 1 (Just 2)]+      assert $  cstate == toBitVector (IntBits8 0) && qstate ~=~ qubits [1, 0, 0, 0]+             || cstate == toBitVector (IntBits8 4) && qstate ~=~ qubits [0, 0, 0, 1]   -- Run tests.