packages feed

quipper-demos (empty) → 0.9.0.0

raw patch · 173 files changed

+7576/−0 lines, 173 filesdep +basedep +containersdep +newsynthbuild-type:Customsetup-changedbinary-added

Dependencies added: base, containers, newsynth, quipper-language, quipper-libraries, quipper-utils, random

Files

@@ -0,0 +1,66 @@+Contributors are listed here, in alphabetical order by last name.+Unless otherwise noted, the copyright for his or her contributions+rests with each individual author. For contributions by authors whose+name is marked (ACS), the copyright rests with Applied Communication+Sciences.++Copyright (C) 2011-2019. All rights reserved.+Copyright (C) 2012-2013 Applied Communication Sciences. All rights+reserved.++Richard Eisenberg+Alexander S. Green+Peter LeFanu Lumsdaine+Keith Kim (ACS)+Siun-Chuon Mau (ACS)+Baranidharan Mohan+Won Ng (ACS)+Joel Ravelomanantsoa-Ratsimihah+Neil J. Ross+Artur Scherer (ACS)+Peter Selinger+Benoît Valiron+Alexandr Virodov (ACS)+Stephan A. Zdancewic++This research was supported by the Intelligence Advanced Research+Projects Activity (IARPA) via Department of Interior National Business+Center contract numbers D11PC20168 and D12PC00527. The U.S. Government+is authorized to reproduce and distribute reprints for Governmental+purposes notwithstanding any copyright annotation thereon. Disclaimer:+The views and conclusions contained herein are those of the authors+and should not be interpreted as necessarily representing the official+policies or endorsements, either expressed or implied, of IARPA,+DoI/NBC, or the U.S. Government.++----------------------------------------------------------------------+LICENSE++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++1. Redistributions of source code must retain the above copyright+  notice, this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright+  notice, this list of conditions and the following disclaimer in the+  documentation and/or other materials provided with the+  distribution.++3. The name of the authors and copyright holders may not be used to+  endorse or promote products derived from this software without+  specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR+IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY DIRECT,+INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,+STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING+IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+POSSIBILITY OF SUCH DAMAGE.+----------------------------------------------------------------------
+ ChangeLog view
@@ -0,0 +1,76 @@+December 29, 2019: Release 0.9.0.0++ * Overhauled module structure:+ +   Old:                New:+   ====                ====+   +   Quipper.XYZ         Quipper.Internal.XYZ+   QuipperLib.XYZ      Quipper.Libraries.XYZ+   Libraries.XYZ       Quipper.Utils.XYZ+   Algorithms.XYZ      Quipper.Algorithms.XYZ+   tests               Quipper.Demos+   Programs            Quipper.Programs++ * Re-packaged Quipper as Cabal packages. Added executables quipper,+   quipper-pp, quipperi, quipperdoc in lieu of shell scripts.+ * Moved PDF Previewer to a separate library in Quipper.Utils.Preview+ * Added a MonadFail instance to Circ, to keep ghc >= 7.4 happy+ * Use type class synonyms to avoid warnings about simplifiable class.+ * Compatibility: removed obsolete functoin Map.insertWith'.+ * Added MultiControlledNot demo.+ * Removed dependency on set-monad, which is broken upstream.+ * Fixed some bugs in the stabilizer simulation.+ * Moved QuantumIf from BF to Libraries.+ * Added --help option to all Quipper tools.+ * Removed Quipper.Utils.ShowAll+ * Fixed some compiler errors and removed some unnecessary type class+   assumptions.++July 27, 2016: Release 0.8++ * Portability: compatibility fixes for GHC 8.0. Note: GHC 7.10 is too+   broken and will not be supported by Quipper.+ * Added tests/SimulationTest+ * Added QPrep and QUnPrep to the simulator++October 14, 2014: Release 0.7++ * Portability: compatibility fixes for GHC 7.8.++January 16, 2014: Release 0.6++ * Minor edits and documentation updates.+ * Added a new gate gate_iX_inv+ * Added "alternate" version of synthesis algorithm, using only+   generators of determinant 1 if possible.+ * Synthesis code is now in an external package "newsynth".+ * Rendering code is now in an external package "easyrender".+ * Updated for use with fixedprec-0.2.1.0.++September 2, 2013: Release 0.5++ * Portability: compatibility fixes for GHC 7.6.2.+ * Portability: fixed Windows incompatibility bug. Handling of Ctrl-C+   may or may not work on Windows, depending on console.+ * Added quipperi script, analogous to ghci.+ * New library QuipperLib.ClassicalOptim: algebraic optimization of+   auto-generated classical circuits. Added "optimized" oracle to BWT+   algorithm.+ * QuipperLib.Decompose: Added decomposition into a "standard" gate+   set, consisting of X, Y, Z, H, S, S-dagger, T, T-dagger, and CNOT.+   Added KeepPhase flag to some transformers.+ * QuipperLib.GateDecompositions: added more gates.+ * New library Libraries.Synthesis.RotationDecomposition: implements a+   variant of the algorithm from Nielsen and Chuang to decompose an+   nxn unitary operator into one- and two-level rotations.+ * New library QuipperLib.Unboxing: unboxing transformers.+ * Updated ASCII output format; improved circuit parser efficiency.+ * Miscellaneous bug fixes: malformed W-gates, qdata_of_qubits,+   floorlog.+ * Fixed handling of iterated subroutines in depth transformer.+ * Documentation updates and minor refactoring.++June 19, 2013: Release 0.4++ * First public release.
+ Quipper/Algorithms/BWT/Alternative.hs view
@@ -0,0 +1,755 @@+{-# LANGUAGE FlexibleContexts #-}++-- | Alternative implementations for the binary welded tree algorithm.+-- The purpose of these is to experiment with and potentially+-- illustrate a more functional programming style.++module Quipper.Algorithms.BWT.Alternative where++import Quipper++import Quipper.Libraries.Qureg+import Quipper.Libraries.Simulation++import Quipper.Algorithms.BWT.Definitions++-- import other Quipper stuff+import qualified Quipper.Algorithms.BWT.BWT as BWT++import Quipper.Utils.Sampling+import Quipper.Utils.Auxiliary++-- import other stuff+import Control.Monad+import Text.Printf+import Data.Bits (xor)+import Text.Printf++import Data.Map (Map)+import qualified Data.Map as Map+++-- ======================================================================+-- * Oracle abstraction++-- | This is a version of 'BWT.Oracle' that uses 'Qulist' instead of+--   'Qureg'.  An oracle provides the following information: the tree+--   depth /n/, the label length /m/, the number of edge colors /k/,+--   the entrance label /ENTRANCE/, and for each color 0 ≤ /c/ < /k/,+--   a reversible circuit /ORACLE[sub c](a,b,r)/.++data Oracle = Oracle {+    n :: Int,+    m :: Int,+    k :: Int,+    entrance :: Boollist,+    oraclefun :: Int -> (Qulist, Qulist, Qubit) -> Circ ()+}++-- | Convert a "Alternative".'Oracle' into a "BWT".'BWT.Oracle'.+convert_oracle :: Oracle -> BWT.Oracle+convert_oracle Oracle { n=n, m=m, k=k, entrance=e, oraclefun=f1 } =+  BWT.Oracle { BWT.n=n, BWT.m=m, BWT.k=k, BWT.entrance=e, BWT.oraclefun=f2 } +    where +      f2 c (a, b, r) = f1 c (qulist_of_qureg_te a, qulist_of_qureg_te b, r)++-- ======================================================================+-- * Top-level algorithm++-- | Do a quantum random walk on the binary welded tree given by the+-- oracle, for /s/ times steps of length /dt/.  Return a bit list+-- corresponding to the probable exit label.  This is a more+-- functional implementation of 'BWT.qrwbwt' from the module "BWT".+-- +-- Note: This implementation does not rely on the oracle being+-- self-inverse, and therefore only requires that+-- +-- > ORACLE[sub c](a, 0, 0) = (a, v[sub c](a), f[sub c](a)), +-- +-- rather than the more general property +-- +-- > ORACLE[sub c](a, b, r) = (a, b ⊕ v[sub c](a), r ⊕ f[sub c](a)).  +-- +-- This gives us the freedom to build more efficient oracles, where+-- appropriate.+qrwbwt :: Oracle -> Timestep -> Int -> Circ Bitlist+qrwbwt oracle dt s = do+  comment (printf "ENTER: qrwbwt (dt=%.3e, s=%d)" dt s)+  -- Initialize a to the entrance label.+  a <- qinit (entrance oracle)++  -- Run the Hamiltonian /s/ times for time step /dt/.+  replicateM s $ hamiltonian dt oracle a++  -- Measure /a/.+  exit <- measure a+  comment_with_label "EXIT: qrwbwt" exit "exit"+  return exit++-- | Apply one round of the Hamiltonian for time step /dt/ to /a/.+hamiltonian :: Timestep -> Oracle -> Qulist -> Circ ()+hamiltonian dt oracle a = do+  comment_with_label "ENTER: hamiltonian" a "a"+  for 0 ((k oracle)-1) 1 $ \c -> do+    -- for c from 0 to k-1++    -- create ancillas b and r+    with_ancilla_list (length a) $ \b -> do+      with_ancilla $ \r -> do++        -- perform computations+        (oraclefun oracle) c (a,b,r)+        time_step dt (a,b,r)+        reverse_generic_imp ((oraclefun oracle) c) (a,b,r)+        -- "reverse" here is not quite GFI+  comment_with_label "EXIT: hamiltonian" a "a"++-- | Apply the diffusion step to /(a,b,r)/. Here /a/ and /b/ must be+-- of equal length.+time_step :: Timestep -> (Qulist, Qulist, Qubit) -> Circ ()+time_step dt (a,b,r) = do+  comment_with_label "ENTER: time_step" (a,b,r) ("a","b","r")+  with_ancilla $ \h -> do+    basischange (a,b,h)+    controlledExpGate (dt,r,h)+    (reverse_generic_imp basischange) (a,b,h)+  comment_with_label "EXIT: time_step" (a,b,r) ("a","b","r")++-- | Apply the basis change from Figure 3 of \[Childs et al.\] to /a/,+-- /b/, and /h/. Here /a/ and /b/ must be of equal length.+basischange :: (Qulist, Qulist, Qubit) -> Circ ()+basischange (a,b,h) = do+  comment_with_label "ENTER: basischange" (a,b,h) ("a","b","h")+  -- apply W gates+  zipWithM_ gate_W a b+  -- apply doubly-controlled not-gates+  zipWithM_ (dc_not h) a b+  comment_with_label "EXIT: basischange" (a,b,h) ("a","b","h")+    where+      dc_not h x y = qnot_at h `controlled` (x .==. 1 .&&. y .==. 0)+  +-- | Compute the required number of iterations as a function of ε and+-- /dt/.+-- +-- Inputs: /n/ is the tree depth, ε is the desired precision, /dt/ is+-- the simulation time step. Intermediate values: /t/ is the+-- simulation time. Output: /s/, the upper bound on the number of+-- simulation time steps.+-- +-- Note: \[Childs et al\] specifies that /t/ should be chosen+-- uniformly at random within the interval 0 < /t/ ≤ /n/[sup 4]\/2ε.+-- Here, for simplicity, we just use /t/ = ⌊/n/[sup 4]\/2ε⌋. Also note+-- that this function is for information only, as it is not actually+-- used. Users should specify /s/ directly.+compute_steps :: Int -> Double -> Double -> Int+compute_steps n epsilon dt =+  floor (t / dt)+  where+    t = fromIntegral (n * n * n * n) / (2.0 * epsilon)++-- ======================================================================+-- * Oracle implementations++-- ** Blackbox oracle++-- | A blackbox oracle for testing. This just produces a labelled box+-- in place of the actual oracle circuit. The argument is the tree+-- height.+oracle_blackbox :: Int -> Oracle+oracle_blackbox n = +  let m = n+2 in+  Oracle {+    n = n,+    m = m,+    k = 4,+    entrance = boollist_of_int_bh (n+2) 1,+    oraclefun = \c (a, b, r) ->+    do+      named_gate_at ("O(" ++ show c ++ ")") (a ++ b ++ [r])+      return ()+  }++-- ----------------------------------------------------------------------+-- ** A simple \"exponential\" oracle.++-- | This oracle, which works only for the fixed tree height 3, works+-- by explicitly listing all the edges. It serves only to illustrate+-- how the edge information is encoded. Listing all edges explicitly+-- obviously would not scale well to larger graphs.+oracle_simple :: Oracle+oracle_simple =+  let n = 3+      m = 5+      k = 4++      invalid = 0    -- also works correctly for invalid = 31+      invalid_vec = boollist_of_int_bh m invalid++      green = 0+      blue = 1+      red = 2+      black = 3++      edges :: Int -> [(Int, Int)]+      edges 0 = [(1,3), (2,5), (4,8), (6,12), (7,15), (9,17), (10,18),+                 (13,21), (19,25), (22,27), (24,28), (26,29)]+      edges 1 = [(2,4), (3,6), (5,10), (7,14), (8,16), (11,19), (12,20),+                 (17,24), (21,26), (23,27), (25,28), (29,30)]+      edges 2 = [(1,2), (3,7), (4,9), (5,11), (6,13), (14,22), (15,23),+                 (16,24), (18,25), (20,26), (27,29), (28,30)]+      edges 3 = [(8,17), (9,18), (10,19), (11,20), (12,21), (13,22),+                 (14,23), (15,16)]+      edges n = error ("oracle_simple: illegal color: " ++ show n)++      -- apply an (a,n1)-controlled not operation to (v,n2)+      multi_controlled_multi_not :: Int -> (Qulist, Qulist) -> (Int, Int) -> Circ ()+      multi_controlled_multi_not m (a,v) (n1, n2) = do+        let vec1 = boollist_of_int_bh m n1+        let vec2 = boollist_of_int_bh m n2+        bool_controlled_not v vec2 `controlled` a .==. vec1+        return ()++      -- the O_c circuit+      oracle_O :: Int -> (Qulist, Qulist) -> Circ ()+      oracle_O c (a,v) = do+        let e = edges c+        foreach e $ \(n1, n2) -> do+          multi_controlled_multi_not m (a,v) (n1, invalid `xor` n2)+          multi_controlled_multi_not m (a,v) (n2, invalid `xor` n1)++      -- the B_c circuit+      oracle_B :: (Qulist, Qulist) -> Circ ()+      oracle_B (v,b) =+        for 0 (m-1) 1 $ \i -> do+          qnot_at (b !! i) `controlled` (v !! i) .==. 1++      -- the R_c circuit+      oracle_R :: (Qulist, Qubit) -> Circ ()+      oracle_R (v,r) = do+        qnot_at r `controlled` v .==. invalid_vec++      -- the oracle circuit+      oraclefun :: Int -> (Qulist, Qulist, Qubit) -> Circ ()+      oraclefun c (a,b,r) = do+        comment_with_label "ENTER: oracle_simple" (a,b,r) ("a","b","r")+        with_ancilla_init invalid_vec $ \v -> do+          oracle_O c (a,v)+          oracle_B (v,b)+          oracle_R (v,r)+          oracle_O c (a,v)+        comment_with_label "EXIT: oracle_simple" (a,b,r) ("a","b","r")++  in++   -- return the oracle object+   Oracle { n = n,+            m = m,+            k = k,+            entrance = boollist_of_int_bh m 1,+            oraclefun = oraclefun+          }++-- ======================================================================+-- ** Alternate implementations of the \"orthodox\" oracle++-- ----------------------------------------------------------------------+-- *** Classical implementation++-- $ In this section, we first implement the oracle function +-- /v[sub c](a)/ as a classical boolean function. This implementation+-- is just for reference, and attempts to be neither efficient nor+-- quantum. It can, however, be used as a specification to test the +-- actual quantum oracles against. +-- +-- Both the classical circuit implementation (below) and the Template+-- Haskell implementation (in the module "BWT.Template") were derived+-- from this.+-- +-- We start with several auxiliary functions.++-- | The type of nodes: a pair of a tree bit and a node address.+type Node = (Bool, [Bool])++-- | Convert integers to nodes, mainly for testing.+node_of_int :: Int -> Int -> Node+node_of_int m a = node_of_boollist (boollist_of_int_bh m a)++-- | Convert nodes to integers, mainly for testing.+int_of_node :: Node -> Int+int_of_node n = int_of_boollist_unsigned_bh (boollist_of_node n)++-- | Convert a bit vector to a node.+node_of_boollist :: [Bool] -> Node+node_of_boollist (t:a) = (t,a)+node_of_boollist [] = error "node_of_boollist: empty boollist"++-- | Convert a node to a bit vector.+boollist_of_node :: Node -> [Bool]+boollist_of_node (t,a) = t:a++-- | Input a node /a/ and return the parent of /a/. We assume that /a/+-- is not a root or invalid.+parent :: Node -> Node+parent (t, aa) = (t, False : init aa)++-- | Input a node /a/ and return the left or right child of /a/+-- (depending on whether the /childbit/ is 'False' or 'True',+-- respectively). Assumes that /a/ is not a leaf.+childintree :: Node -> Bool -> Node+childintree (t, h:aa) childbit = (t, aa ++ [childbit])+childintree _ _ = error "childintree: invalid node"++-- | @'bit_adder' 'False'@ is a one-bit adder, and @'bit_adder' 'True'@ is+-- a one-bit subtracter (i.e., add the 2's complement of /y/).+bit_adder :: Bool -> (Bool, Bool, Bool) -> (Bool, Bool)+bit_adder sign (carry, x, y) = (carry', z)+  where+    y' = y `bool_xor` sign+    z = carry `bool_xor` x `bool_xor` y'+    carry' = majority carry x y'+    majority a b c = if a==b then a else c++-- | Input an /n/+1-bit leaf node /a/:/aa/ (without the tree bit; /a/+-- is the highest bit and /aa/ is the remaining /n/ bits) and a sign+-- /s/ (where 'True' = negative, 'False' = positive).  Return+-- /a/:(/aa/ + /s/ * /f/). The first input is the /n/-bit welding+-- vector /f/ (a parameter to the oracle). Note that /f/ is a+-- parameter and /s/, /aa/ are inputs.+doweld1 :: Boollist -> Bool -> [Bool] -> [Bool]+doweld1 f s (a:aa) = a : aa' where+  aa' = snd $ fold_right_zip (bit_adder s) (s, aa, f)+doweld1 f s [] = error "doweld1: invalid node"++-- | Input an /n/+1-bit leaf node /a/:/aa/ (without the tree bit), and+-- return /a/:(/aa/ ⊕ /g/). The first input is the /n/-bit welding+-- vector /g/ (a parameter to the oracle).+doweld0 :: Boollist -> [Bool] -> [Bool]+doweld0 g (a:aa) = a : aa' where+  aa' = g `boollist_xor` aa+doweld0 g [] = error "doweld0: invalid node"++-- | Input a leaf node /a/ and return the left or right weld of /a/ in+-- the other tree (depending on whether the /weldbit/ is 'False' or+-- 'True').  Assumes that /a/ is a leaf.+weld :: Boollist -> Boollist -> Node -> Bool -> Node+weld f g (t, aa) weldbit = (not t, bb)+  where+    bb = if weldbit+         then doweld1 g t aa+         else doweld0 f aa++-- | Input a node /a/ and return the left or right child of /a/+-- (depending on whether the /childbit/ is 'False' or 'True'. This+-- works for leaf and non-leaf nodes.+child :: Boollist -> Boollist -> Node -> Bool -> Node+child f g (t, aa) childbit =+  case aa of+    True : _ ->  -- This is a leaf+      weld f g (t, aa) childbit+    False : _ -> -- This is not a leaf+      childintree (t, aa) childbit+    _ -> error "child: invalid node"++-- | Input a node address (without the tree bit) and return the parity+-- of the node level expressed as a boolean either 'False' or+-- 'True'. Leaves have parity 'False', and other levels have+-- alternating parities. In other words: count the number of leading+-- zeros modulo 2.+level_parity :: [Bool] -> Bool+level_parity [] = False+level_parity (h:t) = if h then False else not (level_parity t)++-- | Input a node address (without the tree bit) and return 'True' iff+-- the node address is invalid. In other words, return 'True' iff the+-- list consists of all 0's.+is_zero :: [Bool] -> Bool+is_zero [] = True+is_zero (h:t) = if h then False else is_zero t++-- | Input a node address (without the tree bit) and return 'True' iff+-- the node is a root or invalid. In other words, check whether all+-- digits but the last are 0's.+is_root :: [Bool] -> Bool+is_root [] = True+is_root (h:[]) = True+is_root (h:t) = if h then False else is_root t++-- | @'v_function' f g c a@: returns /v/[sub /c/](/a/), the label of the+-- node connected to /a/ by an edge of color /c/, or 'Nothing' if+-- there is no such node. The parameters /f/ and /g/ encode the+-- welding functions, and are lists of length /n/. /c/ is a color in+-- the range 0..3, and /a/ is an (/n/+2)-bit node label.+v_function :: Boollist -> Boollist -> Int -> Node -> Maybe Node+v_function f g c a =+  let (t,aa) = a+      bc_hi = level_parity aa+      z = is_zero aa+      e = is_root aa+      a1 = if last aa then True else False+      [c_hi, c_lo] = boollist_of_int_bh 2 c+      [cbc_hi, cbc_lo] = [c_hi `bool_xor` bc_hi, c_lo]+  in+   if not e && [cbc_hi, cbc_lo] == [True, a1] then Just(parent a) else+   if not z && cbc_hi == False then Just(child f g a cbc_lo) else+   Nothing++-- ----------------------------------------------------------------------+-- *** Auxiliary functions++-- | The type of nodes: a pair of a tree bit and a node address.+type CNode = (Bit, Bitlist)++-- | Like 'CNode', but uses qubits instead of classical bits.+type QNode = (Qubit, [Qubit])++-- | Convert a 'Qulist' to a 'QNode'.+qnode_of_qulist :: Qulist -> QNode+qnode_of_qulist (t:a) = (t,a)+qnode_of_qulist [] = error "qnode_of_qulist: empty list"++-- | Convert a 'Bitlist' to a 'CNode'.+cnode_of_bitlist :: Bitlist -> CNode+cnode_of_bitlist (t:a) = (t,a)+cnode_of_bitlist [] = error "cnode_of_bitlist: empty list"++-- | Exclusive or operation on bit vectors.+cboollist_xor :: Bitlist -> Bitlist -> Circ Bitlist+cboollist_xor = zipWithM (\x y -> cgate_xor [x,y])++-- ----------------------------------------------------------------------+-- *** Classical circuit implementation++-- $ We now implement the oracle function v[sub c](a) as a classical+-- circuit, with /c/ as a parameter. We don't try to be clever or+-- efficient yet.  The implementation follows the \"classical+-- implementation\" above, but must be reformulated due to the need to+-- work within the 'Circ' monad.++-- | Input a node /a/ and return the parent of /a/. We assume that /a/+-- is not a root or invalid.+cparent :: CNode -> Circ CNode+cparent (t, aa_in) = do+  comment_with_label "ENTER: cparent" (t, aa_in) ("t", "aa_in")+  false <- cinit False+  let aa_out = false : init aa_in+  comment_with_label "EXIT: cparent" (t, aa_out) ("t", "aa_out")+  return (t, aa_out)++-- | Input a node /a/ and return the left or right child of /a/+-- (depending on whether the /childbit/ is 'False' or 'True',+-- respectively). Assumes that /a/ is not a leaf.+cchildintree :: CNode -> Bit -> Circ CNode+cchildintree (t, node_in@(h:aa)) childbit = do+  comment_with_label "ENTER: cchildintree" (t, node_in) ("t", "node_in")+  let node_out = aa ++ [childbit]+  comment_with_label "EXIT: cchildintree" (t, node_out) ("t", "node_out")+  return (t, node_out)+cchildintree _ _ = error "cchildintree: invalid node"++-- | @'bit_adder' 'False'@ is a one-bit adder, and @'bit_adder' 'True'@ is+-- a one-bit subtracter (i.e., add the 2's complement of /y/).+cbit_adder :: Bit -> (Bit, Bit, Bit) -> Circ (Bit, Bit)+cbit_adder sign (carry_in, x, y) = do+    comment_with_label "ENTER: cbit_adder" (sign, carry_in, x, y) ("sign", "carry_in", "x", "y")+    y' <- cgate_xor [y, sign]+    z <- cgate_xor [carry_in, x, y']+    carry_out <- cmajority carry_in x y'+    comment_with_label "EXIT: cbit_adder" (carry_out, z) ("carry_out", "z")+    return (carry_out, z)+  where+    cmajority a b c = do+      cond <- cgate_eq a b+      cgate_if cond a c++-- | Input an /n/+1-bit leaf node /a/:/aa/ (without the tree bit; /a/+-- is the highest bit and /aa/ is the remaining /n/ bits) and a sign+-- /s/ (where 'True' = negative, 'False' = positive).  Return+-- /a/:(/aa/ + /s/ * /f/). The first input is the /n/-bit welding+-- vector /f/ (a parameter to the oracle). Note that /f/ is a+-- parameter and /s/, /aa/ are inputs.+cdoweld1 :: Boollist -> Bit -> Bitlist -> Circ Bitlist+cdoweld1 f s node_in@(a:aa) = do+  comment_with_label "ENTER: cdoweld1" (s, node_in) ("s", "node_in")+  f' <- cinit f+  (_,aa') <- fold_right_zipM (cbit_adder s) (s, aa, f')+  let node_out = a : aa'+  comment_with_label "EXIT: cdoweld1" node_out "node_out"+  return node_out+cdoweld1 f s [] = error "cdoweld1: invalid node"++-- | Input an /n/+1-bit leaf node /a/:/aa/ (without the tree bit), and+-- return /a/:(/aa/ ⊕ /g/). The first input is the /n/-bit welding+-- vector /g/ (a parameter to the oracle).+cdoweld0 :: Boollist -> Bitlist -> Circ Bitlist+cdoweld0 g node_in@(a:aa) = do+  comment_with_label "ENTER: cdoweld0" node_in "node_in"+  g' <- cinit g+  aa' <- g' `cboollist_xor` aa+  let node_out = a:aa'+  comment_with_label "EXIT: cdoweld0" node_out "node_out"+  return node_out+cdoweld0 g [] = error "cdoweld0: invalid node"++-- | Input a leaf node /a/ and return the left or right weld of /a/ in+-- the other tree (depending on whether the /weldbit/ is 'False' or+-- 'True').  Assumes that /a/ is a leaf.+cweld :: Boollist -> Boollist -> CNode -> Bit -> Circ CNode+cweld f g node_in@(t, aa) weldbit = do+  comment_with_label "ENTER: cweld" (node_in, weldbit) ("node_in", "weldbit")+  bb <- circ_if weldbit (+    cdoweld1 g t aa+    )(+    cdoweld0 f aa+    )+  t' <- cgate_not t+  let node_out = (t', bb)+  comment_with_label "EXIT: cweld" node_out "node_out"+  return node_out++-- | Input a node /a/ and return the left or right child of /a/+-- (depending on whether the /childbit/ is 'False' or 'True'. This+-- works for leaf and non-leaf nodes.+cchild :: Boollist -> Boollist -> CNode -> Bit -> Circ CNode+cchild f g node_in@(t, a:aa) childbit = do+  comment_with_label "ENTER: cchild" (node_in, childbit) ("node_in", "childbit")+  node_out <- circ_if a (+    -- This is a leaf+    cweld f g (t, a:aa) childbit+    )(            +    -- This is not a leaf+    cchildintree (t, a:aa) childbit+    )+  comment_with_label "EXIT: cchild" node_out "node_out"+  return node_out++cchild f g (t, _) childbit = +  error "cchild: invalid node"++-- | Input a node address (without the tree bit) and return the parity+-- of the node level expressed as a boolean either 'False' or+-- 'True'. Leaves have parity 'False', and other levels have+-- alternating parities. In other words: count the number of leading+-- zeros modulo 2.+clevel_parity :: Bitlist -> Circ Bit+clevel_parity node = do+  comment_with_label "ENTER: clevel_parity" node "node"+  parity <- clevel_parity_rec node+  comment_with_label "EXIT: clevel_parity" parity "parity"+  return parity++  where+    clevel_parity_rec :: Bitlist -> Circ Bit+    clevel_parity_rec [] = cinit False+    clevel_parity_rec (h:t) = do+      r <- clevel_parity_rec t+      circ_if h (+        cinit False+        )(+        cgate_not r+        )++-- | Input a node address (without the tree bit) and return 'True' iff+-- the node address is invalid. In other words, return 'True' iff the+-- list consists of all 0's.+cis_zero :: Bitlist -> Circ Bit+cis_zero node = do+  comment_with_label "ENTER: cis_zero" node "node"+  is_zero <- cis_zero_rec node+  comment_with_label "EXIT: cis_zero" is_zero "is_zero"+  return is_zero+  +  where+    cis_zero_rec :: Bitlist -> Circ Bit+    cis_zero_rec [] = cinit True+    cis_zero_rec (h:t) = do+      circ_if h (+        cinit False+        )(+        cis_zero_rec t+        )++-- | Input a node address (without the tree bit) and return 'True' iff+-- the node is a root or invalid. In other words, check whether all+-- digits but the last are 0's.+cis_root :: Bitlist -> Circ Bit+cis_root node = do+  comment_with_label "ENTER: cis_root" node "node"+  is_root <- cis_root_rec node+  comment_with_label "EXIT: cis_root" is_root "is_root"+  return is_root++  where+    cis_root_rec :: Bitlist -> Circ Bit+    cis_root_rec [] = cinit True+    cis_root_rec (h:[]) = cinit True+    cis_root_rec (h:t) = do+      circ_if h (+        cinit False+        )(+        cis_root_rec t+        )++-- | @'cv_function' f g c a@: returns /v/[sub /c/](/a/), the label of the+-- node connected to /a/ by an edge of color /c/, or 'Nothing' if+-- there is no such node. The parameters /f/ and /g/ encode the+-- welding functions, and are lists of length /n/. /c/ is a color in+-- the range 0..3, and /a/ is an (/n/+2)-bit node label.+-- +-- We currently implement @'Maybe' 'CNode'@ as an indexed union, and+-- specifically as @('CNode','Bit')@. When /Bit/='True', the value of+-- 'CNode' is undefined (doesn't matter); in particular, this value+-- may contain garbage.+cv_function :: Boollist -> Boollist -> Int -> CNode -> Circ (CNode,Bit)+cv_function f g color a = do+  comment_with_label (printf "ENTER: cv_function (color=%d)" color) a "a"+  let (t,aa) = a+  bc_hi <- clevel_parity aa+  z <- cis_zero aa+  e <- cis_root aa+  let a1 = last aa+  let [c_hi', c_lo'] = boollist_of_int_bh 2 color+  c_hi <- cinit c_hi'+  c_lo <- cinit c_lo'+  cbc_hi <- cgate_xor [c_hi, bc_hi]+  let cbc_lo = c_lo+  not_e <- cgate_not e+  cbc_lo_eq_a1 <- cgate_eq cbc_lo a1+  cond1 <- cgate_and [not_e, cbc_hi, cbc_lo_eq_a1]+  (b, invalid) <- circ_if cond1 (+    do +      cparent_a <- cparent a+      false <- cinit False+      return (cparent_a, false)+    )(+    do+      cchild_a_cbc_lo <- cchild f g a cbc_lo+      not_z <- cgate_not z+      cbc_hi_eq_false <- cgate_not cbc_hi+      valid <- cgate_and [not_z, cbc_hi_eq_false]+      not_valid <- cgate_not valid+      -- a slight optimization here: we return garbage in the+      -- first register if not_valid == True+      return (cchild_a_cbc_lo, not_valid)+    )+  comment_with_label (printf "EXIT: cv_function (color=%d)" color) (b, invalid) ("b", "invalid")+  return (b, invalid)++-- ======================================================================+-- *** Oracle abstraction++-- | The classical oracle implementation, packaged into the 'Oracle'+-- abstraction. This oracle has two parameters, namely the welding+-- vectors /f/ and /g/. Note: this oracle has not been optimized+-- whatsoever.+oracle_classical :: Boollist -> Boollist -> Oracle+oracle_classical f g =+  Oracle { n = n,+           m = m,+           k = k,+           entrance = entrance,+           oraclefun = oraclefun+         } where+    n = length f+    m = n+2+    k = 4+    entrance = boollist_of_int_bh m 1+      +    oraclefun :: Int -> (Qulist, Qulist, Qubit) -> Circ ()+    oraclefun color (a,b,r) = do+      let an = qnode_of_qulist a+      let bn = qnode_of_qulist b+      (classical_to_quantum . classical_to_reversible) (cv_function f g color) (an, (bn, r))+      return ()+      +-- ======================================================================+-- * Testing functions++-- | Output the list of colored edges as computed by the classical+-- 'v_function', for some arbitrary choice of /f/ and /g/ and /n/=3.+main_edges1 :: IO()+main_edges1 = mapM_ output (sample_all0 (127,3))+  where+    f = take 5 (True : False : f)    +    g = take 5 (False : True : g)+    +    output :: (Int,Int) -> IO()+    output (a,c) =+      case v_function f g c (node_of_int 7 a) of+        Nothing -> printf "%d ---%d---> None\n" a c+        Just b -> printf "%d ---%d---> %d\n" a c (int_of_node b)++-- | For debugging: 'circfun' is similar to 'v_function', except it+-- works by calling 'cv_function' to assemble the circuit, then+-- simulates it. This is for testing whether the assembled circuit is+-- correct. Returns @('Bool', 'Node')@ instead of @'Maybe' 'Node'@, so+-- that we can see any garbage that is output in case of an invalid+-- node.+circfun :: Boollist -> Boollist -> Int -> Node -> (Node, Bool)+circfun f g color nd = +  run_classical_generic (cv_function f g color) nd++-- | Output the list of colored edges as computed by simulating the+-- circuit 'cv_function', for some arbitrary choice of /f/ and /g/ and+-- /n/=3. This is like 'main_edges1', except it actually assembles and+-- simulates the classical circuit.+main_edges2 :: IO()+main_edges2 = mapM_ output (sample_all0 (127,3))+  where+    f = take 5 (True : False : f)    +    g = take 5 (False : True : g)+    output :: (Int,Int) -> IO()+    output (a,c) =+      case circfun f g c (node_of_int 7 a) of+        (node, False) -> printf "%d ---%d---> %d\n" a c (int_of_node node)+        (garbage, True) -> printf "%d ---%d---> None (%d)\n" a c (int_of_node garbage)+    +-- | Graphically output the classical oracle circuit for color /c/,+-- using /n/ from the oracle data structure, and for some arbitrary+-- /f/ and /g/.+main_oraclec :: Format -> BWT.Oracle -> Int -> IO()+main_oraclec format oracle color =+  print_generic format circuit cnode_shape+    where+      m' = BWT.m oracle+      n' = BWT.n oracle+      f = take n' (True : False : f)+      g = take n' (False : True : g)+      cnode_shape = cnode_of_bitlist (replicate m' bit)+      circuit n = cv_function f g color n++-- | Like 'main_oraclec', except it rewrites the classical circuit in+-- terms of Toffoli gates.+main_oracle2 :: Format -> BWT.Oracle -> Int -> IO()+main_oracle2 format oracle color =+  print_generic format circuit cnode_shape+    where+      m' = BWT.m oracle+      n' = BWT.n oracle+      f = take n' (True : False : f)+      g = take n' (False : True : g)+      cnode_shape = cnode_of_bitlist (replicate m' bit)+      circuit n = classical_to_cnot (cv_function f g color n)++-- | Like 'main_oraclec', except it makes the classical circuit+-- reversible first.+main_oracle3 :: Format -> BWT.Oracle -> Int -> IO()+main_oracle3 format oracle color =+  print_generic format circuit (cnode_shape, (cnode_shape, qubit))+    where+      m' = BWT.m oracle+      n' = BWT.n oracle+      f = take n' (True : False : f)+      g = take n' (False : True : g)+      cnode_shape = qnode_of_qulist (replicate m' qubit)+      circuit = (classical_to_quantum . classical_to_reversible) (cv_function f g color)++-- | Output the top-level circuit for the binary welded tree algorithm+-- with the classical oracle, using some arbitrary welding vectors /f/+-- and /g/, and /s/=1.+main_qrwbwt :: IO()+main_qrwbwt =+   print_simple EPS (qrwbwt (oracle_classical f g) dt 1)+     where +       f = [False, False, True]+       g = [True, False, True]+       dt = pi/180
+ Quipper/Algorithms/BWT/BWT.hs view
@@ -0,0 +1,600 @@+-- | This module provides an implementation of the main binary welded+-- tree algorithm and oracle, using a more-or-less imperative+-- programming style. We abstract the oracle into a data type, so that+-- different oracles can be plugged into the main algorithm.++module Quipper.Algorithms.BWT.BWT where++-- import other Quipper stuff+import Quipper+import Quipper.Algorithms.BWT.Definitions++import Quipper.Libraries.Qureg+import Quipper.Libraries.Decompose++import Quipper.Utils.Auxiliary++import Text.Printf++-- ======================================================================+-- * Oracle abstraction++-- | A data structure to hold an oracle. The binary welded tree+-- algorithm is parametric on an oracle. An oracle encodes a graph,+-- and provides the following information: the tree depth /n/ (in the+-- above example: 3), the label length /m/ (in bits; 5 in the above+-- example), the number of edge colors /k/, the entrance label+-- /ENTRANCE/, and for each color 0 ≤ /c/ < /k/, a reversible circuit+-- /ORACLE/[sub /c/](/a/,/b/,/r/). On basis vectors, this circuit+-- encodes the edge information in the following sense:+-- +-- > ORACLE[sub c](a, b, r) = (a, b ⊕ v[sub c](a), r ⊕ f[sub c](a)),+-- +-- where /f/[sub /c/](/a/) is 1 if the node /a/ is connected to an+-- edge of color /c/, and 0 otherwise; and /v/[sub /c/](a) is the+-- node label connected to node /a/ along an edge of color /c/ (if+-- any), and arbitrary otherwise. +-- +-- Not all available node labels need to be used (for example, 0 and+-- 16 are unused in the graph in the above illustration).++data Oracle = Oracle {+    n :: Int,+    m :: Int,+    k :: Int,+    entrance :: Boollist,+    oraclefun :: Int -> (Qureg, Qureg, Qubit) -> Circ ()+}++-- ======================================================================+-- * Top-level algorithm++-- | The main loop of the binary welded tree algorithm. +-- +-- @qrwbwt oracle s dt@: Do a quantum random walk on the binary welded+-- tree given by the oracle /oracle/, for /s/ times steps of length+-- /dt/. Returns a bit list corresponding to the computed exit node+-- label.++qrwbwt :: Oracle -> Int -> Timestep -> Circ [Bit]+qrwbwt oracle s dt = do+  comment (printf "ENTER: qrwbwt (s=%d, dt=%.3e)" s dt)+  -- initialize a to the entrance label+  a <- qinit_register (entrance oracle)+  with_ancilla_reg (m oracle) $ \b -> do+    with_ancilla $ \r -> do+      loopM_boxed_if (s > 1) "qrwbwt_loop" s (a,b,r) $ \(a,b,r) -> do+        for 0 (k oracle-1) 1 $ \c -> do+          (oraclefun oracle) c (a, b, r)+          timestep (a, b, r, dt, m oracle)+          (oraclefun oracle) c (a, b, r)+        endfor+        return (a,b,r)+      endfor+  exit <- qmeasure_register a+  comment_with_label "EXIT: qrwbwt" exit "exit"+  return exit++-- | @timestep (a, b, r, dt, m)@: Perform a single time step /dt/ of+-- the quantum walk. This is done by iterating through each of the+-- available edge colors, and performing a diffusion step for each+-- color. Here, /a/ is an /m/-qubit registers holding (a superposition+-- of) the current node label. /b/ is an /m/-qubit ancilla register,+-- and /r/ is an ancilla qubit. Both /b/ and /r/ are expected to be+-- initialized to |0〉 by the caller, and will be returned in state+-- |0〉.+timestep :: (Qureg, Qureg, Qubit, Timestep, Int) -> Circ ()+timestep (a, b, r, dt, m) = do+  comment_with_label "ENTER: timestep" (a,b,r) ("a","b","r")+  with_ancilla $ \h -> do+    for 0 (m-1) 1 $ \i -> do+      wGate (a.!(i), b.!(i))+    endfor+    for 0 (m-1) 1 $ \i -> do+      toffoliGate (a.!(i), b.!(i), h)+    endfor+    controlledExpGate (dt, r, h)+    for (m-1) 0 (-1) $ \i -> do+      toffoliGate (a.!(i), b.!(i), h)+    endfor+    for (m-1) 0 (-1) $ \i -> do+      wGateInverse (a.!(i), b.!(i))+    endfor+  comment_with_label "EXIT: timestep" (a,b,r) ("a","b","r")+  return ()++-- ======================================================================+-- * Oracle implementation++-- $ The functions in this section implement a particular oracle for a+-- binary welded tree. The oracle is parametric on:+-- +-- * the tree depth /n/;+-- +-- * two \"welding vectors\" /f/ and /g/, specifying how the leaves of+-- the two binary trees are connected to each other. Specifically, /f/+-- and /g/ encode the permutations of leaves given by a ↦ a ⊕ f and +-- a ↦ a + g, respectively, where \"⊕\" denotes bitwise exclusive or,+-- and \"+\" denotes binary addition.++-- ----------------------------------------------------------------------+-- ** Oracle subroutines++-- | The top-level oracle circuit. The arguments are of the form (/a/,+-- /b/, /r/, /color/, /f/, /g/, /n/), where /a/, /b/ are quantum+-- registers of length /n/+2, /color/ is a boolean register of length+-- 2, and /f/ and /g/ are boolean registers of length /n/.+oracle :: (Qureg, Qureg, Qubit, Boolreg, Boolreg, Boolreg, Int) -> Circ ()+oracle (a, b, r, color, f, g, n) = do+  let c = int_of_boolreg_unsigned_le color :: Int+  comment_with_label (printf "ENTER: oracle (color=%d)" c) (a,b,r) ("a","b","r")+  with_ancilla $ \root -> do+    with_ancilla $ \even -> do+      with_ancilla $ \isparent -> do+        with_ancilla $ \ischild -> do+          with_ancilla $ \direction -> do+            with_ancilla $ \ismatch -> do+              parseNodeRoot (a, root, even, n)+              parseNodeEven (a, even, n)+              testIsParent (a, root, even, isparent, color, n, 1, ismatch)+              testIsChild (even, ischild, direction, color, n)+              setParent (a, b, isparent, n)+              setChild (a, b, ischild, direction, f, g, n)+              with_controls (isparent .==. 0 .&&. ischild .==. 0) $ do {+                qnot_at r+              }+              testIsChild (even, ischild, direction, color, n)+              testIsParent (a, root, even, isparent, color, n, 0, ismatch)+              parseNodeEven (a, even, n)+              parseNodeRoot (a, root, even, n)+  comment_with_label (printf "EXIT: oracle (color=%d)" c) (a,b,r) ("a","b","r")+  return ()++-- | Input a node label /a/ of length at least /n/+1. Negate both+-- /root/ and /even/ if /a/ is a root node.+parseNodeRoot :: (Qureg, Qubit, Qubit, Int) -> Circ ()+parseNodeRoot (a, root, even, n) = do+  comment_with_label "ENTER: parseNodeRoot" (a, root, even) ("a", "root", "even")+  with_ancilla_reg (n+1) $ \scratch -> do+    for n 1 (-1) $ \index -> do +      with_controls (scratch.!(index) .==. 0 .&&. a.!(index) .==. 1) $ do {+        qnot_at (scratch.!(index - 1))+      }+      with_controls (scratch.!(index) .==. 1) $ do {+        qnot_at (scratch.!(index - 1))+      }+    endfor+    with_controls (scratch.!(0) .==. 0) $ do {+      qnot_at root;+      qnot_at even+    }+    for 1 n 1 $ \index -> do    +      with_controls (scratch.!(index) .==. 1) $ do {+        qnot_at (scratch.!(index - 1))+      }+      with_controls (scratch.!(index) .==. 0 .&&. a.!(index) .==. 1) $ do {+        qnot_at (scratch.!(index-1))+      }+    endfor+  comment_with_label "EXIT: parseNodeRoot" (a, root, even) ("a", "root", "even")+  return ()+      +-- | Input a node label /a/ of length at least /n/+1. Negate /even/+-- if the node /a/ occurs at an even height in the tree.+parseNodeEven :: (Qureg, Qubit, Int) -> Circ ()+parseNodeEven (a, even, n) = do+  comment_with_label "ENTER: parseNodeEven" (a, even) ("a", "even")+  with_ancilla_reg (n+1) $ \scratch -> do+    for n 1 (-1) $ \index -> do+      with_controls (scratch.!(n) .==. 0 .&&. a.!(index) .==. 1) $ do {+        qnot_at (scratch.!(index-1));+        with_controls (Prelude.even index) $ do {+          qnot_at even+        }+      }+      with_controls (scratch.!(index-1) .==. 1) $ do {+        qnot_at (scratch.!(n))+      }+    endfor+    for 1 n 1 $ \index -> do+      with_controls (scratch.!(index-1) .==. 1) $ do {+        qnot_at (scratch.!(n))+      }            +      with_controls (scratch.!(n) .==. 0 .&&. a.!(index) .==. 1) $ do {+        qnot_at (scratch.!(index-1))+      }+    endfor+  comment_with_label "EXIT: parseNodeEven" (a, even) ("a", "even")+  return ()++-- | Input a node label /a/ of length at least 1, and flags /root/+-- and /even/ describing whether /a/ is a root and at an even level,+-- respectively. Negate /isparent/ if /a/ has a parent of color+-- /color/ in the tree. +-- +-- The qubit /ismatch/ is an ancilla, and /really/ is either 0 or+-- 1. They are jointly used to control uncomputation, so that the+-- following sequence will compute and then uncompute 'testIsParent':+-- +-- > ismatch <- qinit 0+-- > testIsParent (a, root, even, isparent, color, n, 1, ismatch)+-- > testIsParent (a, root, even, isparent, color, n, 0, ismatch)+-- > qterm 0 ismatch+testIsParent :: (Qureg, Qubit, Qubit, Qubit, Boolreg, Int, Int, Qubit) -> Circ ()+testIsParent (a, root, even, isparent, color, n, really, ismatch) = do+    let c = int_of_boolreg_unsigned_le color :: Int+    comment_with_label (printf "ENTER: testIsParent (color=%d really=%d)" c really) (a, root, even, isparent, ismatch) ("a", "root", "even", "isparent", "ismatch")+    with_controls (really == 0) $ do {+      with_controls (root .==. 0 .&&. ismatch .==. 1) $ do {+        qnot_at isparent+      }+    }+    if color.!(1) == 1+      then+        if color.!(0) == 1 then+          with_controls (even .==. 1 .&&. a.!(0) .==. 1) $ do {+            qnot_at ismatch+          }+        else+          with_controls (even .==. 1 .&&. a.!(0) .==. 0) $ do {+            qnot_at ismatch+          }+      else+        if color.!(0) == 1 then+          with_controls (even .==. 0 .&&. a.!(0) .==. 1) $ do {+            qnot_at isparent+          }+        else+          with_controls (even .==. 0 .&&. a.!(0) .==. 0) $ do {+            qnot_at isparent+          }+    with_controls (root .==. 0 .&&. ismatch .==. 1) $ do {+      qnot_at isparent+    }+    comment_with_label (printf "EXIT: testIsParent (color=%d really=%d)" c really) (a, root, even, isparent, ismatch) ("a", "root", "even", "isparent", "ismatch")+    return ()++-- | Consider a node /a/, and negate /ischild/ if /a/ has a child+-- node of color /color/. Also set /direction/ to indicate whether+-- it is a \"left\" or \"right\" child. Here, /color/ is a boolean+-- register of length 2, representing a color. This function is+-- self-inverse.+testIsChild :: (Qubit, Qubit, Qubit, Boolreg, Int) -> Circ ()+testIsChild (even, ischild, direction, color, n) = do+  comment_with_label "ENTER: testIsChild" (even, ischild, direction) ("even", "ischild", "direction")+  if color.!(1) == 1+    then+      with_controls (even .==. 0) $ do {+        qnot_at ischild+      }+    else+      with_controls (even .==. 1) $ do {+        qnot_at ischild+      }+  with_controls (color.!(0) == 1) $ do {+    qnot_at direction+  }+  comment_with_label "EXIT: testIsChild" (even, ischild, direction) ("even", "ischild", "direction")+  return ()++-- | Input a node label /a/ of length at least /n/+2, and a flag+-- /isparent/ that has been initialized accordingly. Also input a+-- register /b/ of length at least /n/+2, initialized to |0〉.  If+-- /isparent/ is set, set /b/ to the node label of the parent of+-- /a/. This is self-inverse.+setParent :: (Qureg, Qureg, Qubit, Int) -> Circ ()+setParent (a, b, isparent, n) = do+  comment_with_label "ENTER: setParent" (a, b, isparent) ("a", "b", "isparent")+  for 0 (n-1) 1 $ \index -> do+    with_controls (isparent .==. 1 .&&. a.!(index+1) .==. 1) $ do {+      qnot_at (b.!(index))+    }+  endfor+  with_controls (isparent .==. 1 .&&. a.!(n+1) .==. 1) $ do {+    qnot_at (b.!(n+1))+  }+  comment_with_label "EXIT: setParent" (a, b, isparent) ("a", "b", "isparent")+  return ()++-- | Similar to 'setParent', but set /b/ to the node label of the+-- indicated child of /a/. Here /a/ and /b/ are quantum registers of+-- length at least /n/+2, and /f/ and /g/ are boolean registers of+-- length /n/.+setChild :: (Qureg, Qureg, Qubit, Qubit, Boolreg, Boolreg, Int) -> Circ ()+setChild (a, b, ischild, direction, f, g, n) = do+  comment_with_label "ENTER: setChild" (a, b, ischild, direction) ("a", "b", "ischild", "direction")+  with_ancilla $ \childctrl -> do+    with_controls (ischild .==. 1 .&&. a.!(n) .==. 1) $ do {+      qnot_at childctrl+    }+    setWeld (a, b, childctrl, direction, f, g, n)+    with_controls (ischild .==. 1) $ do {+      qnot_at childctrl+    }+    setChildInTree (a, b, childctrl, direction, n)+    with_controls (ischild .==. 1 .&&. a.!(n) .==. 0) $ do {+      qnot_at childctrl+    }+  comment_with_label "EXIT: setChild" (a, b, ischild, direction) ("a", "b", "ischild", "direction")+  return ()+      +-- | A special case of 'setChild', where the child is inside the same+-- binary tree (i.e., not via the welding). +setChildInTree :: (Qureg, Qureg, Qubit, Qubit, Int) -> Circ ()+setChildInTree (a, b, childctrl, direction, n) = do+  comment_with_label "ENTER: setChildInTree" (a, b, childctrl, direction) ("a", "b", "childctrl", "direction")+  with_controls (childctrl .==. 1 .&&. direction .==. 1) $ do {+    qnot_at (b.!(0))+  }+  for 1 n 1 $ \index -> do+    with_controls (childctrl .==. 1 .&&. a.!(index-1) .==. 1) $ do {+      qnot_at (b.!(index))+    }+  endfor+  with_controls (childctrl .==. 1 .&&. a.!(n+1) .==. 1) $ do {+    qnot_at (b.!(n+1))+  }+  comment_with_label "EXIT: setChildInTree" (a, b, childctrl, direction) ("a", "b", "childctrl", "direction")+  return ()++-- | A special case of 'setChild', where the child is in the opposite+-- binary tree, i.e., we follow one of the welding edges.+setWeld :: (Qureg, Qureg, Qubit, Qubit, Boolreg, Boolreg, Int) -> Circ ()+setWeld (a, b, childctrl, direction, f, g, n) = do+  comment_with_label "ENTER: setWeld" (a, b, childctrl, direction) ("a", "b", "childctrl", "direction")+  with_ancilla $ \weldctrl -> do+    with_controls (childctrl .==. 1 .&&. direction .==. 0) $ do {+      qnot_at weldctrl+    }+    doWeld0 (a, b, weldctrl, f, n)+    with_controls (childctrl .==. 1) $ do {+      qnot_at weldctrl+    }+    doWeld1 (a, b, weldctrl, g, n)+    with_controls (childctrl .==. 1 .&&. direction .==. 1) $ do {+      qnot_at weldctrl+    }+    with_controls (childctrl .==. 1 .&&. a.!(n+1) .==. 1) $ do {+      qnot_at (b.!(n+1))+    }+    with_controls (childctrl .==. 1) $ do {+      qnot_at (b.!(n));+      qnot_at (b.!(n+1))+    }+  comment_with_label "EXIT: setWeld" (a, b, childctrl, direction) ("a", "b", "childctrl", "direction")+  return ()++-- | Input a node label /a/, and a register /b/ initialized to+-- |0〉. If /weldctrl/ is set, set /b/ to the node connected to /a/+-- by the welding function /f/. This is self-inverse. Here, /a/ and+-- /b/ are quantum registers of length at least /n/+2, and /f/ is a+-- boolean register of length /n/.+doWeld1 :: (Qureg, Qureg, Qubit, Boolreg, Int) -> Circ ()+doWeld1 (a, b, weldctrl, g, n) = do+  comment_with_label "ENTER: doWeld1" (a, b, weldctrl) ("a", "b", "weldctrl")+  with_ancilla $ \addsub -> do+    with_controls (weldctrl .==. 1 .&&. a.!(n+1) .==. 0) $ do {+      qnot_at addsub+    }+    cAddNum (addsub, b, a, g, n)+    with_controls (weldctrl .==. 1) $ do {+      qnot_at addsub+    }+    cSubNum (addsub, b, a, g, n)+    with_controls (weldctrl .==. 1 .&&. a.!(n+1) .==. 1) $ do {+      qnot_at addsub+    }+  comment_with_label "EXIT: doWeld1" (a, b, weldctrl) ("a", "b", "weldctrl")+  return ()++-- | Input a node label /a/, and a register /b/ initialized to+-- |0〉. If /weldctrl/ is set, set /b/ to the node connected to /a/+-- by the welding function /g/. This is self-inverse. Here, /a/ and+-- /b/ are quantum registers of length at least /n/+2, and /g/ is a+-- boolean register of length /n/.+doWeld0 :: (Qureg, Qureg, Qubit, Boolreg, Int) -> Circ ()+doWeld0 (a, b, weldctrl, f, n) = do+  comment_with_label "ENTER: doWeld0" (a, b, weldctrl) ("a", "b", "weldctrl")+  for 0 (n-1) 1 $ \index -> do+    with_controls (weldctrl .==. 1) $ do {+      qnot_at (b.!(index)) `controlled` a.!(index) ./=. f.!(index)+    }+  endfor+  comment_with_label "EXIT: doWeld0" (a, b, weldctrl) ("a", "b", "weldctrl")+  return ()++-- | This function implements integer addition. Input a quantum+-- register /input/ and a boolean register /num/, representing+-- integers, and a quantum register /out/ initialized to |0〉. If+-- /control/ is set, set /out/ to /input/ + /num/, otherwise do+-- nothing.  Here /input/ and /out/ are quantum registers of length at+-- least /n/, /num/ is a boolean register of length /n/.+cAddNum :: (Qubit, Qureg, Qureg, Boolreg, Int) -> Circ ()+cAddNum (control, out, input, num, n) = do+  comment_with_label "ENTER: cAddNum" (control, out, input) ("control", "out", "input")+  -- we represent mask as 1 << maskbit+  with_ancilla_reg n $ \scratch -> do+    let maskbit = 0  -- invariant: mask = 1 << maskbit+    with_controls (control .==. 1 .&&. input.!(0) .==. 1) $ do {+      qnot_at (out.!(0))+    }+    with_controls (num.!(maskbit) /= 0) $ do {+      with_controls (control .==. 1) $ do {+        qnot_at (out.!(0))+      };+      with_controls (input.!(0) .==. 1) $ do {+        qnot_at (scratch.!(0))+      }+    }+    for 1 (n-1) 1 $ \index -> do+      let maskbit = index   -- invariant: mask = 1 << maskbit+      with_controls (control .==. 1 .&&. input.!(index) .==. 1) $ do {+        qnot_at (out.!(index))+      }+      with_controls (num.!(maskbit) /= 0 .&&. control .==. 1) $ do {+        qnot_at (out.!(index))+      }+      with_controls (control .==. 1 .&&. scratch.!(index-1) .==. 1) $ do {+        qnot_at (out.!(index))+      }+      with_controls (num.!(maskbit) /= 0 .&&. input.!(index) .==. 1) $ do {+        qnot_at (scratch.!(index))+      }+      with_controls (input.!(index) .==. 1 .&&. scratch.!(index-1) .==. 1) $ do {+        qnot_at (scratch.!(index))+      }+      with_controls (num.!(maskbit) /= 0 .&&. scratch.!(index-1) .==. 1) $ do {+        qnot_at (scratch.!(index))+      }+    endfor+    cAddNumClear (control, scratch, input, num, n)+  comment_with_label "EXIT: cAddNum" (control, out, input) ("control", "out", "input")+  return ()++-- | A helper function for clearing the scratch space used by 'cAddNum'.+cAddNumClear :: (Qubit, Qureg, Qureg, Boolreg, Int) -> Circ ()+cAddNumClear (control, scratch, input, num, n) = do+  comment_with_label "ENTER: cAddNumClear" (control, scratch, input) ("control", "scratch", "input")+  -- we represent mask as 1 << maskbit+  for (n-1) 1 (-1) $ \index -> do+    let maskbit = index   -- invariant: mask = 1 << maskbit+    with_controls (num.!(maskbit) /= 0 .&&. scratch.!(index-1) .==. 1) $ do {+      qnot_at (scratch.!(index))+    }+    with_controls (input.!(index) .==. 1 .&&. scratch.!(index-1) .==. 1) $ do {+      qnot_at (scratch.!(index))+    }+    with_controls (num.!(maskbit) /= 0 .&&. input.!(index) .==. 1) $ do {+      qnot_at (scratch.!(index))+    }+  endfor+  let maskbit = 0  -- invariant: mask = 1 << maskbit+  with_controls (num.!(maskbit) /= 0 .&&. input.!(0) .==. 1) $ do {+    qnot_at (scratch.!(0))+  }+  comment_with_label "EXIT: cAddNumClear" (control, scratch, input) ("control", "scratch", "input")+  return ()++-- | Like 'cAddNum', except subtract instead of adding. +cSubNum :: (Qubit, Qureg, Qureg, Boolreg, Int) -> Circ ()+cSubNum (control, out, input, num, n) = do+  comment_with_label "ENTER: cSubNum" (control, out, input) ("control", "out", "input")+  -- we represent mask as 1 << maskbit+  with_ancilla_reg n $ \scratch -> do+    let maskbit = 0  -- invariant: mask = 1 << maskbit+    with_controls (control .==. 1 .&&. input.!(0) .==. 1) $ do {+      qnot_at (out.!(0))+    }+    with_controls (num.!(maskbit) /= 0) $ do {+      with_controls (control .==. 1) $ do {+        qnot_at (out.!(0))+      };+      with_controls (input.!(0) .==. 0) $ do {+        qnot_at (scratch.!(0))+      }+    }+    for 1 (n-1) 1 $ \index -> do+      let maskbit = index    -- invariant: mask = 1 << maskbit+      with_controls (control .==. 1 .&&. input.!(index) .==. 1) $ do {+        qnot_at (out.!(index))+      }+      with_controls (num.!(maskbit) /= 0 .&&. control .==. 1) $ do {+        qnot_at (out.!(index))+      }+      with_controls (control .==. 1 .&&. scratch.!(index-1) .==. 1) $ do {+        qnot_at (out.!(index))+      }+      with_controls (num.!(maskbit) /= 0 .&&. input.!(index) .==. 0) $ do {+        qnot_at (scratch.!(index))+      }+      with_controls (input.!(index) .==. 0 .&&. scratch.!(index-1) .==. 1) $ do {+        qnot_at (scratch.!(index))+      }+      with_controls (num.!(maskbit) /= 0 .&&. scratch.!(index-1) .==. 1) $ do {+        qnot_at (scratch.!(index))+      }+    endfor+    cSubNumClear (control, scratch, input, num, n)+  comment_with_label "EXIT: cSubNum" (control, out, input) ("control", "out", "input")+  return ()++-- | A helper function for clearing the scratch space used by 'cSubNum'.+cSubNumClear :: (Qubit, Qureg, Qureg, Boolreg, Int) -> Circ ()+cSubNumClear (control, scratch, input, num, n) = do+  comment_with_label "ENTER: cSubNumClear" (control, scratch, input) ("control", "scratch", "input")+  -- we represent mask as 1 << maskbit+  for (n-1) 1 (-1) $ \index -> do+    let maskbit = index  -- invariant: mask = 1 << maskbit+    with_controls (num.!(maskbit) /= 0 .&&. scratch.!(index-1) .==. 1) $ do {+      qnot_at (scratch.!(index))+    }+    with_controls (input.!(index) .==. 0 .&&. scratch.!(index-1) .==. 1) $ do {+      qnot_at (scratch.!(index))+    }+    with_controls (num.!(maskbit) /= 0 .&&. input.!(index) .==. 0) $ do {+      qnot_at (scratch.!(index))+    }+  endfor+  let maskbit = 0  -- invariant: mask = 1 << maskbit+  with_controls (num.!(maskbit) /= 0 .&&. input.!(0) .==. 0) $ do {+    qnot_at (scratch.!(0))+  }+  comment_with_label "EXIT: cSubNumClear" (control, scratch, input) ("control", "scratch", "input")+  return ()++-- ----------------------------------------------------------------------+-- ** The oracle data structure++-- | This function inputs two welding functions /f/ and /g/, and+-- returns the oracle defined by the preceding functions. +-- +-- We call this the \"orthodox\" oracle, because the implementation+-- follows its specification very closely. For example, it uses a very+-- \"imperative\" programming style. For alternative implementations+-- of this and other oracles, see the modules+-- "Quipper.Algorithms.BWT.Alternative" and "Quipper.Algorithms.BWT.Template".+oracle_orthodox :: Boollist -> Boollist -> Oracle+oracle_orthodox f g =+  Oracle { n = n,+           m = m,+           k = k,+           entrance = entrance,+           oraclefun = oraclefun+         } where+    n = length f+    m = n+2+    k = 4+    entrance = boollist_of_int_bh m 1+    f_reg = boolreg_of_boollist_te f+    g_reg = boolreg_of_boollist_te g+    +    oraclefun :: Int -> (Qureg, Qureg, Qubit) -> Circ ()+    oraclefun c (a,b,r) = do+      let color = boolreg_of_int_le 2 c+      oracle (a, b, r, color, f_reg, g_reg, n)+      return ()++-- ======================================================================+-- * Main functions++-- These functions are so that the user can output something.++-- | Output the circuit for the quantum walk and a binary welded tree,+-- for the given 'Oracle' in the specified 'Format' and using the+-- specified 'GateBase'. Use /s/ time steps of length /dt/.+main_circuit :: Format -> GateBase -> Oracle -> Int -> Timestep -> IO()+main_circuit format base oracle s dt =+  print_generic format (decompose_generic base circuit)+  where+    circuit = qrwbwt oracle s dt++-- | Output the circuit for the given 'Oracle' and the given color+-- (specified as an 'Int'). Use the specified output 'Format' and+-- 'GateBase'.+main_oracle :: Format -> GateBase -> Oracle -> Int -> IO()+main_oracle format base oracle c =+  let m' = m oracle +      ofun = oraclefun oracle+      circuit = (\(a,b,r) -> ofun c (qureg_of_qulist_te a, qureg_of_qulist_te b, r))+  in+   print_generic format (decompose_generic base circuit) (replicate m' qubit, replicate m' qubit, qubit)
+ Quipper/Algorithms/BWT/Definitions.hs view
@@ -0,0 +1,35 @@+-- | This module provides some convenient definitions for the Binary+-- Welded Tree algorithm implementation.++module Quipper.Algorithms.BWT.Definitions where++import Quipper++-- ======================================================================+-- * Some convenient gates++-- | Apply the binary /W/-gate to a pair of qubits. The W-gate+-- diagonalizes the SWAP operation.+wGate :: (Qubit, Qubit) -> Circ ()+wGate (a,b) = do+  gate_W a b+  return ()++-- | Apply the /inverse/ of the /W/-gate. Note: since the /W/-gate is+-- self-inverse, this is really the same as 'wGate'. However, we+-- define this as a separate function for clarity. +wGateInverse :: (Qubit, Qubit) -> Circ ()+wGateInverse = wGate++-- | Apply a doubly-controlled not gate to a triple of qubits (/a/,+-- /b/, /c/). Here the qubit /c/ is negated if /a/=1 and /b/=0.+toffoliGate :: (Qubit, Qubit, Qubit) -> Circ ()+toffoliGate (a, b, c) =+  qnot_at c `controlled` (a .==. 1 .&&. b .==. 0)++-- | @controlledExpGate(t, r, h):@+-- Apply the [exp −/iZt/] gate to the qubit /h/, provided that /r/=0. +controlledExpGate :: (Timestep, Qubit, Qubit) -> Circ ()+controlledExpGate (t, r, h) = do+  expZt t h `controlled` (r .==. 0)+  return ()
+ Quipper/Demos/And_gate.hs view
@@ -0,0 +1,10 @@+import Quipper++and_gate :: (Qubit, Qubit) -> Circ (Qubit)+and_gate (a, b) = do+  c <- qinit False+  qnot_at c `controlled` [a, b]+  return c++main =+  print_simple Preview and_gate
+ Quipper/Demos/And_list.hs view
@@ -0,0 +1,20 @@+import Quipper++and_gate :: (Qubit, Qubit) -> Circ (Qubit)+and_gate (a, b) = do+  c <- qinit False+  qnot_at c `controlled` [a, b]+  return c++and_list :: [Qubit] -> Circ Qubit+and_list [] = do+  c <- qinit True+  return c+and_list [q] = do+  return q+and_list (q:t) = do+  d <- and_list t+  e <- and_gate (d, q)+  return e++main = print_generic Preview and_list (replicate 10 qubit)
+ Quipper/Demos/And_rev.hs view
@@ -0,0 +1,26 @@+import Quipper++and_gate :: (Qubit, Qubit) -> Circ (Qubit)+and_gate (a, b) = do+  c <- qinit False+  qnot_at c `controlled` [a, b]+  return c++and_list :: [Qubit] -> Circ Qubit+and_list [] = do+  c <- qinit True+  return c+and_list [q] = do+  return q+and_list (q:t) = do+  d <- and_list t+  e <- and_gate (d, q)+  return e++and_rev :: ([Qubit], Qubit) -> Circ ([Qubit], Qubit)+and_rev = classical_to_reversible and_list++main =+  print_generic Preview and_rev (replicate 10 qubit, qubit)++
+ Quipper/Demos/Arith.hs view
@@ -0,0 +1,13 @@+import Quipper+import Quipper.Libraries.Arith++main :: IO ()+main = print_generic Preview labelled_add (qdint_shape 3) (qdint_shape 3)+++labelled_add :: QDInt -> QDInt -> Circ (QDInt, QDInt,QDInt)+labelled_add x y = do+  label (x,y) ("x","y")+  xy <- q_add x y+  label xy ("x","y","x+y")+  return xy
+ Quipper/Demos/Box.hs view
@@ -0,0 +1,112 @@+import Quipper+import Quipper.Libraries.Unboxing++main :: IO ()+main = do+  print_generic Preview boxed_unboxed (replicate 5 qubit) (replicate 5 qubit)+  --print_simple Preview boxed_unboxed2+  --print_simple Preview boxed_unboxed3+  --print_simple Preview boxed_unboxed4++sub_notboxed :: [Qubit] -> Circ [Qubit]+sub_notboxed [] = return []+sub_notboxed [a] = return [a]+sub_notboxed (a:(b:cs)) = do+  a' <- hadamard a `controlled` b+  bcs' <- sub_notboxed (b:cs)+  return (bcs' ++ [a'])++sub_boxed :: [Qubit] -> Circ [Qubit]+sub_boxed = box "sub" sub_notboxed++my_circuit :: ([Qubit] -> Circ [Qubit]) -> [Qubit] -> [Qubit] -> Circ ([Qubit],[Qubit])+my_circuit sub as bs = do+  comment_with_label "ENTER: my_circuit" (as,bs) ("a","b")+  as' <- sub (reverse as) `controlled` (head bs)+  label (as',bs) ("a","b")+  bs' <- sub bs +  label (as',bs') ("a","b")+  as'' <- reverse_generic_endo sub (reverse as') `controlled` (head bs')+  comment_with_label "EXIT: my_circuit" (as'',bs') ("a","b")+  return (as'',bs')++boxed_unboxed :: [Qubit] -> [Qubit] -> Circ ([Qubit],[Qubit])+boxed_unboxed as bs = do+  label (as,bs) ("a","b")+  (as,bs) <- my_circuit sub_notboxed as bs+  label (as,bs) ("a","b")+  (as,bs) <- my_circuit sub_boxed as bs+  label (as,bs) ("a","b")+  (as,bs) <- unbox (my_circuit sub_boxed) as bs+  label (as,bs) ("a","b")+  return (as,bs)++my_subroutine2 :: (Qubit,Qubit,Qubit) -> Circ (Qubit,Qubit,Qubit)+my_subroutine2 (a,b,c) = do+   qnot_at c `controlled` [a,b]+   return (a,b,c)++sub2 :: (Qubit,Qubit,Qubit) -> Circ (Qubit,Qubit,Qubit)+sub2 = box "tof" my_subroutine2++my_subroutine2' :: (Qubit,Qubit,Qubit,Qubit) -> Circ (Qubit,Qubit,Qubit,Qubit)+my_subroutine2' (a,b,c,d) = do+     (b',c',d') <- sub2 (b,c,d) `controlled` a+     return (a,b',c',d')++sub2' :: (Qubit,Qubit,Qubit,Qubit) -> Circ (Qubit,Qubit,Qubit,Qubit)+sub2' = box "ss" my_subroutine2'++my_circuit2 :: (Qubit,Qubit,Qubit,Qubit) -> (Qubit,Qubit,Qubit,Qubit) -> Circ ((Qubit,Qubit,Qubit,Qubit),(Qubit,Qubit,Qubit,Qubit))+my_circuit2 as bs = do+  (a1,a2,a3,a4) <- sub2' as+  (b1,b2,b3,b4) <- sub2' bs +  return ((a1,a2,a3,a4),(b1,b2,b3,b4))++boxed_unboxed2 :: (Qubit,Qubit,Qubit,Qubit) -> (Qubit,Qubit,Qubit,Qubit) -> Circ ((Qubit,Qubit,Qubit,Qubit),(Qubit,Qubit,Qubit,Qubit))+boxed_unboxed2 as bs = do+  (as',bs') <- my_circuit2 as bs+  (as'',bs'') <- (unbox my_circuit2) as' bs'+  (unbox (unbox my_circuit2)) as'' bs''++my_subroutine3 :: (Qubit,Qubit,Qubit) -> Circ Qubit+my_subroutine3 (a,b,c) = do+  qdiscard (c,a)+  return b++sub3 :: (Qubit,Qubit,Qubit) -> Circ Qubit+sub3 = box "term" my_subroutine3++my_circuit3 :: (Qubit,Qubit,Qubit,Qubit,Qubit,Qubit) -> Circ (Qubit,Qubit)+my_circuit3 (a,b,c,d,e,f) = do+  b' <- sub3 (a,b,c)+  e' <- sub3 (d,e,f)+  qnot_at e' `controlled` b' +  return (b',e')++boxed_unboxed3 :: ((Qubit,Qubit,Qubit,Qubit,Qubit,Qubit),(Qubit,Qubit,Qubit,Qubit)) -> Circ (Qubit,Qubit)+boxed_unboxed3 ((a,b,c,d,e,f),(c',d',e',f')) = do+  (a',b') <-  my_circuit3 (a,b,c,d,e,f)+  (unbox my_circuit3) (a',b',c',d',e',f')++my_subroutine4 :: Qubit -> Circ (Qubit,Qubit,Qubit)+my_subroutine4 a = do+  (b,c) <- qinit (False,False)+  return (a,b,c)++sub4 :: Qubit -> Circ (Qubit,Qubit,Qubit)+sub4 = box "init" my_subroutine4++my_circuit4 :: (Qubit,Qubit) -> Circ (Qubit,Qubit,Qubit,Qubit,Qubit,Qubit)+my_circuit4 (a,b) = do+  (a',c,d) <- sub4 a +  (b',e,f) <- sub4 b+  return (a',b',c,d,e,f)++boxed_unboxed4 :: (Qubit,Qubit) -> Circ ((Qubit,Qubit,Qubit,Qubit),(Qubit,Qubit,Qubit,Qubit,Qubit,Qubit))+boxed_unboxed4 (a,b) = do+  (a',b',c,d,e,f) <- my_circuit4 (a,b)+  (a'',b'',g,h,i,j) <- unbox my_circuit4 (a',b')+  return ((c,d,e,f),(a'',b'',g,h,i,j))++
+ Quipper/Demos/BoxExample.hs view
@@ -0,0 +1,36 @@+import Quipper++-- Unboxed version of subroutine+my_sub :: (Qubit, Qubit, Qubit) -> Circ (Qubit, Qubit, Qubit)+my_sub (a,b,c) = do+  hadamard_at a `controlled` b+  hadamard_at a `controlled` c+  hadamard_at b `controlled` c+  return (a,b,c)+  +-- Boxed version of subroutine+boxed_sub :: (Qubit, Qubit, Qubit) -> Circ (Qubit, Qubit, Qubit)+boxed_sub = box "my_sub" my_sub++-- Unboxed version of circuit+my_circuit :: [Qubit] -> Circ [Qubit]+my_circuit [] = return []+my_circuit [a] = return [a]+my_circuit [a,b] = return [a,b]+my_circuit (a:b:c:rest) = do+  (a,b,c) <- my_sub (a,b,c)+  x <- my_circuit (b:c:rest)+  return (a:x)++-- Boxed version of circuit+my_circuit_boxed :: [Qubit] -> Circ [Qubit]+my_circuit_boxed [] = return []+my_circuit_boxed [a] = return [a]+my_circuit_boxed [a,b] = return [a,b]+my_circuit_boxed (a:b:c:rest) = do+  (a,b,c) <- boxed_sub (a,b,c)+  x <- my_circuit_boxed (b:c:rest)+  return (a:x)++main = do+  print_generic Preview my_circuit_boxed (replicate 6 qubit)
+ Quipper/Demos/Classical.hs view
@@ -0,0 +1,12 @@+import Quipper++circuit :: (Bit, Qubit) -> Circ (Qubit, Qubit)+circuit (b,q) = do+  qnot_at q `controlled` b+  r <- prepare b+  gate_W_at q r+  return (q,r)+  +main =   +  print_simple Preview circuit+
+ Quipper/Demos/Comments.hs view
@@ -0,0 +1,25 @@+import Quipper++example1 :: (Qubit,Qubit,[Qubit]) -> Circ (Qubit,Qubit,[Qubit])+example1 (q, a, b) = do+    comment_with_label "Start of example 1" (q,a,b) ("q","a","b")+    hadamard a+    qnot_at a `controlled` b+    hadamard q `controlled` a+    qnot_at a `controlled` b+    hadamard a+    comment "End of example 1"+    return (q, a, b)++example3 :: (Qubit,Qubit,[Qubit],Qubit,Qubit) -> Circ (Qubit,Qubit,[Qubit],Qubit,Qubit)+example3 (q, a, b, d, e) = do+    comment_with_label "Start of example 3" (q,a,b,d,e) ("q","a","b","d","e")+    example1 (q, a, b)+    with_controls (d .==. 0 .&&. e .==. 1) $ do+      example1 (q, a, b)+      example1 (q, a, b)+    example1 (q, a, b)+    comment "End of example 3"+    return (q, a, b, d, e)++main = print_generic Preview example3 (qubit, qubit, replicate 3 qubit, qubit, qubit)
+ Quipper/Demos/CountAccess.hs view
@@ -0,0 +1,63 @@+-- | Consider the following problem, suggested by Dmitry Maslov: Input+-- a list of bits. Let /i/ be the weight of the list, i.e., the number+-- of \"1\" bits in the list. Output the /i/th element, where elements+-- are counted from 0 and we wrap around cyclically if /i/ equals the+-- length of the list.++import Quipper+import Quipper.Libraries.Arith+import Quipper.Libraries.Qram++import Prelude hiding (truncate)++-- | Figure out how many bits are needed to store a given integer. +hibit :: Int -> Int+hibit 0 = 0+hibit n = 1 + hibit (n `div` 2)++-- | @'truncate' n q@: Input a classical integer /n/ and a quantum+-- integer /q/. Output /0/ if /q/=/n/, and /q/ otherwise. For the+-- problem at hand, this is cheaper than full modular arithmetic. +truncate :: IntM -> QDInt -> Circ QDInt+truncate n q = do+  q' <- qc_copy q+  with_controls (q .==. n) $ do+    controlled_not q' q+  return q'++-- | Input a list of qubits and return its weight.+weight :: [Qubit] -> Circ QDInt+weight qs = q where+  len = length qs+  bits = hibit len+  zero = intm bits 0+  q = do+    q <- qinit zero+    q <- aux qs q+    q1 <- truncate (intm bits (toInteger len)) q+    return q1++  aux [] q = return q+  aux (h:t) q = do+    q <- q_increment q `controlled` h+    q <- aux t q+    return q++-- | Input a list of qubits, and output the /i/th qubit, where /i/ is+-- the weight of the list.+countshift :: [Qubit] -> Circ Qubit+countshift qs = do+  q <- weight qs+  a <- indexed_access qs q+  return a++-- | Reversible version of 'countshift'. +countshift_rev :: [Qubit] -> Circ ([Qubit], Qubit)+countshift_rev qs = do+  b <- with_computed (countshift qs) $ \a -> do+    qc_copy a+  return (qs, b)++-- | A main function to print the circuit.+main = +  print_generic Preview countshift_rev (replicate 7 qubit)
+ Quipper/Demos/Decompose_test.hs view
@@ -0,0 +1,23 @@+import Quipper+import Quipper.Libraries.Decompose++toffoli :: (Qubit,Qubit,Qubit) -> Circ (Qubit,Qubit,Qubit)+toffoli (q1,q2,q3) = do+ qnot_at q3 `controlled` (q1,q2)+ return (q1,q2,q3)++boxed :: (Qubit,Qubit,Qubit) -> Circ (Qubit,Qubit,Qubit)+boxed = box "Toffoli" toffoli+++tof :: (Qubit,Qubit,Qubit,Qubit,Qubit) -> Circ ()+tof (q1,q2,q3,q4,q5) = do+ boxed (q3,q4,q5) `controlled` (q1,q2)+ return ()+ +main :: IO ()+main = do+  print_simple Preview tof+  print_simple Preview (decompose_generic Logical tof)+  print_simple Preview (decompose_generic Toffoli tof)+  print_simple Preview (decompose_generic Binary tof)
+ Quipper/Demos/DynamicLifting.hs view
@@ -0,0 +1,23 @@+-- Test the dynamic lifting feature. ++import Quipper++-- | A circuit in which some future gates depend on a prior measurement.+circuit :: Qubit -> Qubit -> Circ Qubit+circuit a b = do+  qnot_at a `controlled` b+  m <- measure a+  bool <- dynamic_lift m+  if bool == 0 then+      do+       hadamard_at b+       return b+    else+      do+       c <- qinit False+       qnot_at c `controlled` b+       qdiscard b+       return c++main = do+  print_simple ASCII circuit
+ Quipper/Demos/ErrorCircuit.hs view
@@ -0,0 +1,28 @@+import Quipper+import Quipper.Libraries.Decompose++-- Outputs a partially undefined circuit. This illustrates the use of+-- laziness in the Quipper circuit generation code.++-- Please note that currently only the ASCII backend can make actual+-- use of laziness; the graphics-based backends must generate the+-- whole circuit before it can be printed.++-- We also apply a transformer, to illustrate the laziness of+-- transformers as well.++circuit_with_error :: Qubit -> Qubit -> Qubit -> Circ (Qubit, Qubit, Qubit)+circuit_with_error q r s = do+  qnot_at q `controlled` [r,s]+  hadamard_at r+  error "A runtime error occurred!"+  hadamard_at r+  return (q, r, s)  +  +circuit_with_error_transformed = decompose_generic Binary circuit_with_error++main =+  print_simple ASCII circuit_with_error++main2 = +  print_simple ASCII circuit_with_error_transformed
+ Quipper/Demos/Example.hs view
@@ -0,0 +1,37 @@++import Quipper+import Prelude hiding (and)++example1 :: (Qubit, Qubit, Qubit) -> Circ (Qubit, Qubit, Qubit)+example1 (a,b,c) = do+  qnot_at a `controlled` [b, c]+  hadamard b `controlled` [a]+  qnot_at a `controlled` [b, c]+  hadamard c `controlled` [a]+  return (a,b,c)++example2 :: Qubit -> Qubit -> Qubit -> Qubit -> Circ ()+example2 h a b c = do+  qnot_at c `controlled` [a, b]+  hadamard h `controlled` [c]+  qnot_at c `controlled` [a, b]++example3 :: Qubit -> Qubit -> Qubit -> Circ ()+example3 h a b = do+  with_ancilla $ \c -> do+    qnot_at c `controlled` [a, b]+    hadamard h `controlled` [c]+    qnot_at c `controlled` [a, b]++example4 :: (Qubit, Qubit, Qubit, Qubit) -> Circ (Qubit, Qubit, Qubit, Qubit)+example4 (a,b,c,d) = do+  qnot_at a+  qnot_at b+  with_controls (c .&&. d) $ do+    qnot_at a+    qnot_at b+  qnot_at c+  return (a,b,c,d)++main =+  print_simple Preview example4
+ Quipper/Demos/Example1.hs view
@@ -0,0 +1,10 @@+  import Quipper++  example1 (q, a, b, c) = do+    hadamard a+    qnot_at c `controlled` [a, b]+    hadamard q `controlled` [c]+    qnot_at c `controlled` [a, b]+    hadamard a++  main = print_simple Preview example1
+ Quipper/Demos/Example2.hs view
@@ -0,0 +1,12 @@+  import Quipper++  example2 (q, a, b) = do+    hadamard a+    with_ancilla $ \c -> do+      qnot_at c `controlled` [a, b]+      hadamard_at q `controlled` [c]+      qnot_at c `controlled` [a, b]+    hadamard_at a+    return (q, a, b)++  main = print_simple Preview example2
+ Quipper/Demos/Example3.hs view
@@ -0,0 +1,21 @@+import Quipper++example1 :: (Qubit,Qubit,Qubit,Qubit) -> Circ (Qubit,Qubit,Qubit,Qubit)+example1 (q, a, b, c) = do+    hadamard a+    qnot_at c `controlled` [a, b]+    hadamard q `controlled` [c]+    qnot_at c `controlled` [a, b]+    hadamard a+    return (q, a, b, c)++example3 :: (Qubit,Qubit,Qubit,Qubit,Qubit,Qubit) -> Circ (Qubit,Qubit,Qubit,Qubit,Qubit,Qubit)+example3 (q, a, b, c, d, e) = do+    example1 (q, a, b, c)+    with_controls (d .==. 0 .&&. e .==. 1) $ do+      example1 (q, a, b, c)+      example1 (q, a, b, c)+    example1 (q, a, b, c)+    return (q, a, b, c, d, e)++main = print_simple Preview example3
+ Quipper/Demos/Example4.hs view
@@ -0,0 +1,11 @@+import Quipper++example4 :: (Qubit, Qubit, Qubit) -> Circ (Qubit, Qubit, Qubit)+example4(q, a, b) = do+  with_ancilla $ \c -> do+    qnot_at c `controlled` [a, b]+    hadamard q `controlled` [c]+    qnot_at c `controlled` [a, b]+  return (q, a, b)++main = print_simple Preview example4
+ Quipper/Demos/GPhase.hs view
@@ -0,0 +1,33 @@+-- This file illustrates how global phase gates will be rendered in+-- graphical circuit diagrams.++import Quipper++mycirc :: (Qubit, Qubit, Qubit) -> Circ ()+mycirc (a,b,c) = do+  comment "Unanchored"+  global_phase 1.0+  +  comment "Anchored at a"+  global_phase_anchored 1.0 a+  +  comment "Anchored at b"+  global_phase_anchored 1.0 b+  +  comment "Anchored at c"+  global_phase_anchored 1.0 c+  +  comment "Anchored at (a,b)"+  global_phase_anchored 1.0 (a,b)+  +test :: (Qubit, Qubit, Qubit) -> Circ ()+test (a,b,c) = do +  label (a,b,c) ("a", "b", "c")+  mycirc (a,b,c)+  mycirc (a,b,c) `controlled` a+  mycirc (a,b,c) `controlled` b+  mycirc (a,b,c) `controlled` c+  mycirc (a,b,c) `controlled` a .==. 1 .&&. b .==. 0 .&&. c .==. 0++main = +  print_simple Preview test
+ Quipper/Demos/HelloWorld.hs view
@@ -0,0 +1,11 @@+import Quipper++circuit :: Qubit -> Qubit -> Qubit -> Circ (Qubit, Qubit, Qubit, Qubit)+circuit a b c = do+  qnot_at a `controlled` c .==. 1+  hadamard_at b `controlled` c .==. 0+  d <- qinit False+  qnot_at d `controlled` b .==. 1+  return (a,b,c,d)++main = print_simple Preview circuit
+ Quipper/Demos/Infinite.hs view
@@ -0,0 +1,26 @@+import Quipper+import Quipper.Libraries.Decompose++-- Outputs an infinite circuit. This illustrates the use of laziness+-- in the Quipper circuit generation code. ++-- Please note that currently only the ASCII backend can make actual+-- use of laziness; the graphics-based backends must generate the+-- whole circuit before it can be printed.++-- We also apply a transformer, to illustrate the laziness of+-- transformers as well.++infinite_circuit :: Qubit -> Qubit -> Qubit -> Circ (Qubit, Qubit, Qubit)+infinite_circuit q r s = do+  qnot_at q `controlled` [r,s]+  hadamard_at r+  infinite_circuit s q r+  +infinite_circuit_transformed = decompose_generic Binary infinite_circuit++main1 = +  print_simple ASCII infinite_circuit++main = +  print_simple ASCII infinite_circuit_transformed
+ Quipper/Demos/MultiControlledNot.hs view
@@ -0,0 +1,30 @@+-- | Demonstrates Quipper's decomposition of multiply-controlled+-- not-gates into the Clifford+/T/ gate set.++import Quipper+import Quipper.Libraries.Decompose++multi_cnot :: [Qubit] -> Qubit -> Circ ()+multi_cnot controls target = do+  qnot_at target `controlled` controls++multi_cnot_decomposed :: [Qubit] -> Qubit -> Circ ()+multi_cnot_decomposed = decompose_generic Exact multi_cnot++main_n :: Int -> IO ()+main_n n = do+  putStrLn ("Gate counts for " ++ show n ++ " controls:")+  putStrLn ""+  print_generic GateCount multi_cnot_decomposed (replicate n qubit) qubit+  putStrLn ""+  print_generic Preview multi_cnot_decomposed (replicate n qubit) qubit+ +main :: IO ()+main = do+  main_n 0+  main_n 1+  main_n 2+  main_n 3+  main_n 4+  main_n 5+  main_n 6
+ Quipper/Demos/NBox.hs view
@@ -0,0 +1,22 @@+import Quipper+import Quipper.Libraries.Unboxing++rep :: Integer+rep = 3++myfunc :: (Qubit, Qubit) -> Circ (Qubit, Qubit)+myfunc (a,b) = do+  hadamard_at a `controlled` b+  return (b,a)+  +circuit :: (Qubit, Qubit, Qubit, Qubit, Qubit, Qubit) -> Circ (Qubit, Qubit, Qubit, Qubit, Qubit, Qubit)+circuit (a,b,c,d,e,f) = do+  label (a,b,c,d,e,f) ("a","b","c","d","e","f")+  (a,b) <- loopM rep (a,b) myfunc+  (c,d) <- box_loopM "box1" rep (c,d) myfunc+  (e,f) <- unbox (\x -> box_loopM "box1" rep x myfunc) (e,f)+  label (a,b,c,d,e,f) ("a","b","c","d","e","f") +  return (a,b,c,d,e,f)+  +main = +  print_simple Preview circuit
+ Quipper/Demos/NamedGate.hs view
@@ -0,0 +1,30 @@+import Quipper hiding (gate_V)++my_unary_gate :: Qubit -> Circ Qubit+my_unary_gate = named_gate "Q"++my_binary_gate :: (Qubit, Qubit) -> Circ (Qubit, Qubit)+my_binary_gate = named_gate "R"++my_unary_gate_at :: Qubit -> Circ ()+my_unary_gate_at = named_gate_at "Q"++my_binary_gate_at :: (Qubit, Qubit) -> Circ ()+my_binary_gate_at = named_gate_at "R"++gate_V :: Qubit -> Circ Qubit+gate_V = named_gate "V"++circuit :: Qubit -> Qubit -> Circ (Qubit, Qubit)+circuit a b = do+  a <- gate_V a+  (c,d) <- my_binary_gate (a,b)+  c <- my_unary_gate a `controlled` d+  my_binary_gate_at (c, d)+  my_binary_gate_at (d, c)+  my_unary_gate_at d+  c <- gate_V c+  d <- gate_V d+  return (c,d)++main = print_simple Preview circuit
+ Quipper/Demos/NoControl.hs view
@@ -0,0 +1,74 @@+import Quipper++-- | 'example1': do a basis change, then perform some operation, then+-- uncompute the basis change. Drawback: if this is later controlled,+-- then the controls are applied to the basis change too, which is+-- unnecessary.++example1 :: Qubit -> Qubit -> Circ ()+example1 a b = do+  -- basis change+  gate_W_at a b+  qnot_at b `controlled` a+  +  -- some operation+  hadamard_at b `controlled` a+  +  -- undo basis change+  qnot_at b `controlled` a+  gate_W_at a b  ++-- | 'example2': low-level solution. The 'without_controls' operator+-- can be used to inhibit the addition of further controls to blocks+-- of code.  (However, this is not very safe. A better way to do this+-- is shown in 'example3').++example2 :: Qubit -> Qubit -> Circ ()+example2 a b = do+  -- basis change+  without_controls $ do+    gate_W_at a b+    qnot_at b `controlled` a+  -- some operation+  hadamard_at b `controlled` a+  -- undo basis change+  without_controls $ do+    qnot_at b `controlled` a+    gate_W_at a b++-- | 'example3': a better way to achieve the effect of 'example2' is+-- to use the operator 'with_basis_change'. This will take care of the+-- uncomputation automatically, and also ensure that controls will not+-- be added to the basis change.+example3 :: Qubit -> Qubit -> Circ ()    +example3 a b = do+  with_basis_change basischange $ do+    hadamard_at b `controlled` a++    where+      basischange = do+        gate_W_at a b+        qnot_at b `controlled` a++-- | 'example4': a similar effect is introduced by the operator+-- 'with_ancilla'. Normally, the gates that initialize and terminate+-- ancillas cannot be controlled. However, when using the+-- 'with_ancilla' operator, the resulting circuit can be controlled as+-- a whole, provided that the body is controllable.++example4 :: Qubit -> Qubit -> Circ ()+example4 a b = do+  with_ancilla $ \d -> do+    with_basis_change (qnot_at d `controlled` b .==. False) $ do+      hadamard_at a `controlled` d++my_circuit :: Qubit -> Qubit -> Qubit -> Circ ()+my_circuit ctrl a b = do+  example1 a b `controlled` ctrl+  example2 a b `controlled` ctrl+  example3 a b `controlled` ctrl+  example4 a b `controlled` ctrl++main =+  print_simple Preview my_circuit+
+ Quipper/Demos/OptimTest.hs view
@@ -0,0 +1,53 @@+-- | A test for the 'simplify_classical' function. As an example, we use+-- a simple adder defined using the @build_circuit@ keyword. 'main1'+-- outputs the unoptimized circuit, and 'main2' outputs the optimized+-- version.++import Quipper+import Quipper.Libraries.ClassicalOptim+import Quipper.Utils.Auxiliary++-- | Return the majority of three booleans.+build_circuit+majority :: Bool -> Bool -> Bool -> Bool+majority a b c = if (a `bool_xor` b) then c else a++-- | Bit adder. The first input is 'False' for adding, and 'True' for+-- subtracting. The second input is a triple consisting of a carry,+-- and two bits to be added. The output consists of the new carry and+-- the sum.+build_circuit+bit_adder :: Bool -> (Bool,Bool,Bool) -> (Bool,Bool)+bit_adder sign (carry, x,y) =+      let y' = y `bool_xor` sign in+      let z = carry `bool_xor` x `bool_xor` y' in+      let carry' = majority carry x y' in+      (carry', z)++-- | Multi-bit adder. Add two /n/-bit integers, represented as+-- little-tailian bit lists.+build_circuit+adder :: [Bool] -> [Bool] -> [Bool]+adder f l = +  reverse $ snd $ fold_right_zip (bit_adder False) (False, reverse l, reverse f)++-- | Wrapper around 'template_adder'.+myAdder :: ([Qubit],[Qubit]) -> Circ [Qubit]+myAdder (x,y) = do+  label (x,y) ("x","y")+  z <- unpack template_adder x y+  label z "z"+  return (z)++main1 :: IO()+main1 = do+  print_generic Preview myAdder (replicate 3 qubit, replicate 3 qubit)++main2 :: IO()+main2 = do+  print_generic Preview (simplify_classical myAdder) (replicate 3 qubit, replicate 3 qubit)++main :: IO()+main = main2++
+ Quipper/Demos/ParseNodeRoot.hs view
@@ -0,0 +1,39 @@+import Quipper++import Quipper.Libraries.Qureg++-- | Algorithm 7. The arguments are of the form (/a/, /root/, /even/,+-- /n/). Precondition: /a/ is a quantum register of length at least+-- /n/+1.+parseNodeRoot :: (Qureg, Qubit, Qubit, Int) -> Circ ()+parseNodeRoot (a, root, even, n) = do+  comment_with_label "ENTER: parseNodeRoot" (a, root, even) ("a", "root", "even")+  with_ancilla_reg (n+1) $ \scratch -> do+    for n 1 (-1) $ \index -> do +      with_controls (scratch.!(index) .==. 0 .&&. a.!(index) .==. 1) $ do {+        qnot_at (scratch.!(index - 1))+      }+      with_controls (scratch.!(index) .==. 1) $ do {+        qnot_at (scratch.!(index - 1))+      }+    endfor+    with_controls (scratch.!(0) .==. 0) $ do {+      qnot_at root;+      qnot_at even+    }+    for 1 n 1 $ \index -> do    +      with_controls (scratch.!(index) .==. 1) $ do {+        qnot_at (scratch.!(index - 1))+      }+      with_controls (scratch.!(index) .==. 0 .&&. a.!(index) .==. 1) $ do {+        qnot_at (scratch.!(index-1))+      }+    endfor+  comment_with_label "EXIT: parseNodeRoot" (a, root, even) ("a", "root", "even")+  return ()+      +main = print_generic Preview circuit (qureg_shape (n+1), qubit, qubit) +  where+    circuit (a, root, even) = parseNodeRoot (a, root, even, n)+    n = 4+
+ Quipper/Demos/PhaseTest.hs view
@@ -0,0 +1,22 @@+-- $ Test whether the quantum simulator works correctly on a global+-- phase gate.++import Quipper+import Quipper.Libraries.Simulation++-- | This function should compute a Not gate.+testcirc :: Qubit -> Circ Qubit+testcirc a = do+  hadamard_at a+  global_phase 1.0 `controlled` a+  hadamard_at a+  return a+  +main = do+  b <- run_generic_io d testcirc False+  putStrLn ("testcirc False = " ++ show b)+  b <- run_generic_io d testcirc True+  putStrLn ("testcirc True = " ++ show b)+ where+  d :: Double+  d = undefined
+ Quipper/Demos/QEC.hs view
@@ -0,0 +1,139 @@++import Quipper++-- import other stuff+import Control.Monad (zipWithM_)++-- ======================================================================+-- ALGORITHM SPECIFIC CODE++{- the test circuit from Alex V. and Benoit's email. It looks like+this:++In Alex's notation: ++  H(a)+  c = meas(a)+  if c then+    X(b)+  else Y(b)++In circuit notation:++ a -H--Meas===x==o==|+              |  |+ b -----------X--Y----++In QPL notation: +-} ++testcircuit :: (Qubit, Qubit) -> Circ Qubit+testcircuit (a,b) = do+  hadamard a+  c <- measure a+  with_controls (c .==. 1) $ do {+    gate_X_at b+  }+  with_controls (c .==. 0) $ do {+    gate_Y_at b+  }+  cdiscard c+  return b++-- Let's see if we can implement some parts of the Steane+-- code. Working from Alex V.'s notes.+++-- prepare the logical |+〉 state for the Steane code. This returns a list+-- of 7 qubits+plusState :: Circ [Qubit]+plusState = do+  -- prepare (a...g) in the state "00+0+++"+  [a,b,c,d,e,f,g] <- qinit_of_string "00+0+++"++  qnot_at a `controlled` c .==. 1+  qnot_at d `controlled` f .==. 1+  qnot_at b `controlled` g .==. 1+  qnot_at a `controlled` e .==. 1+  qnot_at d `controlled` g .==. 1+  qnot_at b `controlled` f .==. 1+  qnot_at a `controlled` g .==. 1+  qnot_at b `controlled` c .==. 1+  qnot_at d `controlled` e .==. 1+  +  return [a,b,c,d,e,f,g]++-- prepare the logical |0〉 state for the Steane code+zeroState :: Circ [Qubit]+zeroState = do+  -- prepare (a...g) in the state "00+0+++"+  [a,b,c,d,e,f,g] <- qinit_of_string "++0+000"++  qnot_at c `controlled` a .==. 1+  qnot_at f `controlled` d .==. 1+  qnot_at g `controlled` b .==. 1+  qnot_at e `controlled` a .==. 1+  qnot_at g `controlled` d .==. 1+  qnot_at f `controlled` b .==. 1+  qnot_at g `controlled` a .==. 1+  qnot_at c `controlled` b .==. 1+  qnot_at e `controlled` d .==. 1+  +  return [a,b,c,d,e,f,g]++preparePlus :: Circ ([Qubit], Bit)+preparePlus = do+  qs <- plusState+  vs <- plusState+  zipWithM_ (\q v -> qnot_at q `controlled` v .==. 1) qs vs+  measure <- mapM measure vs+  result <- cgate_and measure+  mapM_ cdiscard measure+  return (qs, result)++{-+-- this function operates on a 7-tuple of qubits, which are inputs and+-- outputs. The additional output Bit is 0 when the error correction+-- fails, else 1+preGateCorrection :: (Qubit,Qubit,Qubit,Qubit,Qubit,Qubit,Qubit) -> Bit+preGateCorrection q = do+  result = cinit_bit False+  (a, av, result_a) <- preparePlus []+  with_controls (result_a .==. 1) $ do {+    (b, bv, result_b) <- prepareZero+    with_controls (result_b .==. 1) $ do {+      zRecover(q, a),+      xRecover(q, b),+      cnot result+    }+    with_controls (result_b .==. 0) $ do {+      .....+-}++    +-- ======================================================================+-- main functions (ugly, don't follow an "idiom" yet)++-- this is just a main function to print the circuit+main_testcircuit :: IO()+main_testcircuit =+  print_generic Preview testcircuit (qubit,qubit)++-- this is just a main function to print the circuit+main_plusState :: IO()+main_plusState =+  print_generic Preview plusState++-- this is just a main function to print the circuit+main_zeroState :: IO()+main_zeroState =+  print_generic Preview zeroState+   +-- this is just a main function to print the circuit+main_preparePlus :: IO()+main_preparePlus =+  print_generic Preview preparePlus+   +main = main_preparePlus++
+ Quipper/Demos/QFT.hs view
@@ -0,0 +1,5 @@+import Quipper+import Quipper.Libraries.QFT++main :: IO ()+main = print_generic Preview qft_little_endian (replicate 5 qubit)
+ Quipper/Demos/QFTAdder.hs view
@@ -0,0 +1,64 @@+import Quipper+import Quipper.Libraries.Arith+import Quipper.Libraries.QFTAdd+import Quipper.Libraries.Simulation+import Quipper.Libraries.Unboxing++import System.Environment++------ Functions for testing the QFTAdd circuit --------++-- | Output a preview of the qft_add_in_place circuit for quantum integers of+-- the given size+print_qft_add :: Int -> IO ()+print_qft_add m = print_generic Preview qft_add_in_place (qdint_shape m) (qdint_shape m)++-- | Simulate the running of the qft_add_in_place circuit for the given IntM inputs+run_qft_add :: IntM -> IntM -> IO (IntM,IntM)+run_qft_add = run_generic_io (undefined :: Double) (unbox qft_add_in_place)++-- | A wrapper around 'run_qft_add' so that it can be used with standard Integer+-- arguments.+test_add :: Integer -> Integer -> IO Integer+test_add a b = if (a < 0) || (b < 0) then error "test_add: negative argument" else+ do+  let m = 2 + ceiling (log (fromInteger (a+b)) / log 2) -- a slight cheat to work out how many qubits to use+  let a' = intm m a+  let b' = intm m b+  (_,ab) <- run_qft_add a' b'+  return (fromIntegral ab)++-- | A datatype for the possible command line arguments+data Args = Usage | One Int | Two Integer Integer ++-- | A function to parse the command line arguments+parseArgs :: [String] -> Args+parseArgs [s1] = case reads s1 of+  [(x1,_)] -> One x1+  _ -> Usage+parseArgs [s1,s2] = case (reads s1,reads s2) of+  ([(x1,_)],[(x2,_)]) -> Two  x1 x2+  _ -> Usage+parseArgs _ = Usage++-- | The main function calls either test_add or print_qft_add depending upon+-- command line arguments.+main ::  IO ()+main = do+  args <- getArgs+  case parseArgs args of+   Usage -> usage+   One x -> print_qft_add x+   Two x1 x2 -> do+     res <- test_add x1 x2+     putStrLn (show x1 ++ " + " ++ show x2 ++ " = " ++ show res)++usage :: IO ()+usage = do+  name <- getProgName+  putStrLn ("usage: " ++ name ++ " num1 <num2>") +  putStrLn "  - one argument:"+  putStrLn "     preview the circuit for quantum integers of that length"+  putStrLn "  - two arguments:"+  putStrLn "     simulate the circuit for adding the two numbers"+  putStrLn "     (note that quantum simulation is not efficient)"
+ Quipper/Demos/QRAM.hs view
@@ -0,0 +1,15 @@++import Quipper+import Quipper.Libraries.Qram+import Quipper.Libraries.Arith++test_qram :: [Qubit] -> QDInt -> Circ ()+test_qram list index = do+  label (list,index) ("list","index")+  with_computed (indexed_access list index) $ \element -> do+    label element "element"+    hadamard_at element+++main :: IO ()+main = print_generic Preview test_qram (replicate 8 qubit) (qdint_shape 3)
+ Quipper/Demos/QuantumIfTest.hs view
@@ -0,0 +1,125 @@+import Quipper+import Quipper.Libraries.Simulation+import Quipper.Libraries.QuantumIf++-- ----------------------------------------------------------------------+-- * Testing quantum \"if then else\"++-- | A dummy value of type Double, to feed the type in the simulator+double :: Double+double = undefined++-- | A testing function that displays a circuit that tests the 'if_then_elseQ'+-- statement, and the results of running the circuit on various inputs.+if_test :: IO ()+if_test = do+    print_simple ASCII ifTest2+    print_simple Preview ifTest2+    res0 <- run_generic_io double ifTest2 (False,False,False)+    putStrLn (show res0)+    res1 <- run_generic_io double ifTest2 (False,False,True)+    putStrLn (show res1)+    res2 <- run_generic_io double ifTest2 (False,True,False)+    putStrLn (show res2)+    res3 <- run_generic_io double ifTest2 (False,True,True)+    putStrLn (show res3)+    res4 <- run_generic_io double ifTest2 (True,False,False)+    putStrLn (show res4)+    res5 <- run_generic_io double ifTest2 (True,False,True)+    putStrLn (show res5)+    res6 <- run_generic_io double ifTest2 (True,True,False)+    putStrLn (show res6)+    res7 <- run_generic_io double ifTest2 (True,True,True) +    putStrLn (show res7)++-- | A test of the 'if_then_elseQ' function.+ifTest :: Circ (Qubit,Qubit,Qubit)+ifTest = do+    (q0,q1,q2,q3,q4,q5,q6) <- qinit (False,False,False,False,False,False,False)+    qnot_at q4+    if_then_elseQ (Or (A q0) (And (A q1) (Not (A q2))))+     ( --if q0 | (q1 & !q2)+      qnot_at q4+     )+     (+      if_then_elseQ (And (A q2) (A q3))+      ( --else if+       qnot_at q5 +      )+      ( -- else+        qnot_at q6+      )+     )+    return (q4,q5,q6)   ++-- | Another test of the 'if_then_elseQ' function.+ifTest2 :: (Qubit,Qubit,Qubit) -> Circ (Qubit,Qubit)+ifTest2 (l,p,d) = do+   ctrl <- qinit True+   (x,y) <- qinit (False,False)+   with_controls ctrl +    (+    do +    if_then_elseQ (Or (A l) (And (A p) (Not (A d))))+     ( --if l | (p & !d) +      qnot_at x+     )+     ( -- else+      qnot_at y+     )+    )+   qdiscard (l,p,d)+   qterm True ctrl+   return (x,y)++-- | A simple test of the 'if_then_elseQ' function.+ifTest3 :: Qubit -> Circ (Qubit,Qubit)+ifTest3 q = do+    (q0,q1) <- qinit (False,False)+    if_then_elseQ (A q)+     (+        qnot_at q0+     )+     (+       qnot_at q1+     )+    qdiscard q+    return (q0,q1) ++-- | A small circuit for testing 'if_then_elseQinv' statements.+small_circ :: [Qubit] -> Circ ([Qubit],Qubit,Qubit)+small_circ qs = do+   (q1,q2) <- qinit (False,False)+   tempReg0 <- qinit (replicate (length qs) False)+   tempReg1 <- qinit (replicate (length qs) True)+   let boolean_statement = foldr1 (\x y -> And x y) (map A qs)+   let boolean_statement_out = Not boolean_statement+   if_then_elseQinv boolean_statement+    (+     do+     qnot_at q1+     swap (reverse tempReg0) (reverse qs)+     return ()+    )+    (+     do+     swap tempReg1 qs+     qnot_at q2+    ) boolean_statement_out+   return (qs,q1,q2) ++-- | Display the 'small_circ'.+print_small_circ :: IO ()+print_small_circ = print_generic Preview small_circ (replicate 4 qubit) ++-- | Simulate the 'small_circ'.+test_small_circ :: [Bool] -> IO ()+test_small_circ bs = do+    putStr (show bs ++ " -> ")+    res <- run_generic_io double small_circ bs+    putStrLn (show res)++-- | A main function.+main :: IO ()+main = test_small_circ [True,True,False]+
+ Quipper/Demos/Reverse.hs view
@@ -0,0 +1,13 @@+import Quipper++my_circuit :: (Qubit, Qubit) -> Circ (Qubit, Qubit)+my_circuit (a,b) = do+  qnot_at a `controlled` b+  hadamard b `controlled` a+  return (a,b) +  +rev_circuit :: (Qubit, Qubit) -> Circ (Qubit, Qubit)+rev_circuit = reverse_simple my_circuit++main =+  print_simple Preview rev_circuit
+ Quipper/Demos/SimpleOracleSimulation.hs view
@@ -0,0 +1,85 @@+-- | A test file to simulate various decompositions of the simple oracle circuit,+-- from the BWT algorithm.++import Quipper+import Quipper.Libraries.Simulation+import Quipper.Libraries.Decompose++-- import other Quipper stuff+import Quipper.Algorithms.BWT.Alternative+import Quipper.Utils.Auxiliary++-- | Extract the circuit from an oracle.+oracleCircuit :: Oracle -> Int -> Int -> Circ (Qubit,[Qubit])+oracleCircuit oracle color i = do+  input <- qinit (boollist_of_int_bh (m oracle) i)+  output <- qinit (boollist_of_int_bh (m oracle) 0)+  q <- qinit False+  oraclefun oracle color (input,output,q)+  return (q, output)+                             +-- | Run the simple oracle with a given decomposition, and given inputs.+run_simple' :: GateBase -> Int -> Int -> IO (Bool,Int)+run_simple' gb color i = do (b,bs) <- run_generic_io (undefined :: Double) (decompose_generic gb (oracleCircuit oracle_simple color i))+                            return (b, int_of_boollist_unsigned_bh bs)++-- | Run the simple oracle  with a given decomposition, and given inputs, and print the result in a more readable manner.+run_simple :: GateBase -> Int -> Int -> IO ()+run_simple gb color i = do (b,bs) <- run_simple' gb color i+                           if not b +                             then putStrLn (show i ++ " --( " ++ show color ++ " )--> " ++ show bs)+                             else return ()++-- | Run the simple oracle with a given decomposition, mapped over all possible inputs.+main_run' :: GateBase -> IO ()+main_run' gb = mapM_ (\(x,y) -> run_simple gb x y) [(x,y) | y <- [0..31], x <- [0..3]]++-- | Run each decomposition of the oracle circuit and print out the resulting edges.+main_run :: IO ()+main_run = do putStrLn "Logical"+              main_run' Logical+              putStrLn "Toffoli"+              main_run' Toffoli+              putStrLn "Binary"+              main_run' Binary  ++-- | Simumlate the simple oracle with a given decomposition, and given inputs.+sim_simple' :: GateBase -> Int -> Int -> ProbabilityDistribution Double (Bool,Int)+sim_simple' gb color i = do (b,bs) <- sim_generic undefined (decompose_generic gb (oracleCircuit oracle_simple color i))+                            return (b, int_of_boollist_unsigned_bh bs)++-- | Simulate the simple oracle with a given decomposition,+-- and given inputs, and print the result in a more readable manner.+sim_simple :: GateBase -> Int -> Int -> ProbabilityDistribution Double (IO ())+sim_simple gb color i = do (b,bs) <- sim_simple' gb color i+                           if not b +                             then return $ putStr (show i ++ " --( " ++ show color ++ " )--> " ++ show bs)+                             else Vector [(return (),0.0)]++sequenceP :: ProbabilityDistribution Double (IO ()) -> IO ()+sequenceP (Vector []) = return ()+sequenceP (Vector ((io,prob):ps)) = do if prob /= 0.0 then do io+                                                              putStrLn (" - " ++ show prob)+                                                      else return ()+                                       sequenceP (Vector ps)  ++-- | Simulate the simple oracle with a given decomposition, mapped over all possible inputs.+main_sim' :: GateBase -> IO ()+main_sim' gb = mapM_ (\(x,y) -> sequenceP (sim_simple gb x y)) [(x,y) | y <- [0..31], x <- [0..3]]++main_sim'' :: GateBase -> Int -> Int -> IO ()+main_sim'' gb x y = sequenceP (sim_simple gb x y)++-- | Simulate each decomposition of the oracle circuit and print out the resulting edges.+main_sim :: IO ()+main_sim = do putStrLn "Logical"+              main_sim' Logical+              putStrLn "Toffoli"+              main_sim' Toffoli+              putStrLn "Binary"+              main_sim' Binary  ++main :: IO ()+main = do main_run+          main_sim+
+ Quipper/Demos/SimulationTest.hs view
@@ -0,0 +1,30 @@+import Quipper+import Quipper.Libraries.Simulation+import System.Random++circuit :: (Qubit, Qubit) -> Circ (Qubit, Qubit)+circuit (q,r) = do+  with_computed code $ \x -> do+    qnot r `controlled` [r,x]+    hadamard r+  return (q,r)++  where+    code = do+      s <- cinit False+      s <- prepare s+      hadamard q+      qnot s `controlled` q+      ++circuit2 :: (Qubit, Qubit, Qubit) -> Circ (Qubit, Qubit, Qubit)+circuit2 (s,q,r) = do+  circuit (q,r) `controlled` s+  return (s,q,r)++main =+  print_simple Preview circuit2+  +main2 = do+  g <- newStdGen+  print $ run_generic g (0.0 :: Double) circuit2 (True,True,True)
+ Quipper/Demos/SynthesisTest.hs view
@@ -0,0 +1,106 @@+-- | Some demos for "Quipper.Libraries.Synthesis".++import Quipper+import Quipper.Libraries.Synthesis++import Quantum.Synthesis.Ring+import Quantum.Synthesis.Matrix+import Quantum.Synthesis.MultiQubitSynthesis++import System.Random++-- ----------------------------------------------------------------------+-- * Some demos for Quipper.Libraries.Synthesis++-- | Import a compressed Clifford+/T/ operator as a Quipper circuit.+main1 :: IO ()+main1 = do+  print_simple Preview (exact_synthesis1 (0x1d00d27a0188b095b8cdd4ead9a244198d8b22e :: Integer))+  +-- | Exact synthesis of a Clifford+/T/ circuit from an exact matrix+-- representation.+main2 :: IO ()+main2 = do+  print_simple Preview (exact_synthesis1 op)+  where+    op :: Matrix Two Two DOmega+    op = roothalf^4 * matrix2x2 ( 1 - 2*roottwo,    2 + roottwo - i )+                                ( -2 - roottwo - i, 1 - 2*roottwo   )++-- | Exact synthesis of a multi-qubit Clifford+/T/ circuit from an+-- exact matrix representation.+main3 :: IO ()+main3 = do+  print_generic Preview (exact_synthesis_alt op) [qubit, qubit]+  where+    op :: Matrix Four Four DOmega+    op = matrix4x4 ( 1,  0,  0, 0 )+                   ( 0, -s,  s, 0 )+                   ( 0,  0,  0, 1 )+                   ( 0,  s,  s, 0 ) +    s = roothalf+    +-- | Exact synthesis of a multi-qubit Clifford+/T/ circuit from an+-- exact matrix representation.+main3a :: IO ()+main3a = do+  print_generic Preview (exact_synthesis_alt op) [qubit, qubit, qubit]+  where+    op :: Matrix Eight Eight DOmega+    op = matrix [[ 1, 0,  0, 0, 0, 0, 0, 0 ],+                 [ 0, s, -s, 0, 0, 0, 0, 0 ],+                 [ 0, 0,  0, 1, 0, 0, 0, 0 ],+                 [ 0, s,  s, 0, 0, 0, 0, 0 ],+                 [ 0, 0,  0, 0, 1, 0, 0, 0 ],+                 [ 0, 0,  0, 0, 0, 1, 0, 0 ],+                 [ 0, 0,  0, 0, 0, 0, 0, 1 ],+                 [ 0, 0,  0, 0, 0, 0, 1, 0 ]] +    s = roothalf+    +-- | Approximate synthesis of a /z/-rotation as a Clifford+/T/ circuit.+-- Angle θ = π\/128, precision ε = 10[sup −30].+main4 :: IO ()+main4 = do+  g <- newStdGen  -- a source of randomness+  print_simple Preview (approximate_synthesis_zrot prec (pi/128) g)+  where+    prec = 30 * digits++-- | Approximate synthesis of a global phase. +-- Angle α = π\/128, precision ε = 10[sup −30].+main5 :: IO ()+main5 = do+  g <- newStdGen  -- a source of randomness+  print_simple Preview (approximate_synthesis_phase True prec (pi/128) g)+  where  +    prec = 30 * digits++-- | Approximate synthesis of an arbitrary single-qubit operator,+-- given by Euler angles. Precision ε = 2[sup −50].+main6 :: IO ()+main6 = do+  g <- newStdGen  -- a source of randomness+  let circ = approximate_synthesis_euler True prec (alpha, beta, gamma, delta) g+  print_simple Preview circ+  where+    prec = 50 * bits+    alpha = 0.1 * pi+    beta = 0.2 * pi+    gamma = 0.5 * pi+    delta = -0.6 * pi+    +-- | Approximate synthesis of an arbitrary single-qubit operator,+-- given as a matrix. The matrix is given in an exact notation.+-- Precision ε = 10[sup −10].+main7 :: IO ()+main7 = do+  g <- newStdGen  -- a source of randomness+  let circ = approximate_synthesis_u2 True prec op g+  print_simple Preview circ+  where+    prec = 10 * digits+    op = matrix2x2 ( 0.6, 0.8*i )+                   (-0.8, 0.6*i )++-- | Run any of the above main functions:+main = main3a
+ Quipper/Demos/Teleport.hs view
@@ -0,0 +1,55 @@+import Quipper++plus_minus :: Bool -> Circ Qubit+plus_minus b = do+    q <- qinit b+    q <- hadamard q+    return q++share :: Qubit -> Circ (Qubit, Qubit)+share a = do+    b <- qinit False+    b <- qnot b `controlled` a+    return (a,b)++bell00 :: Circ (Qubit, Qubit)+bell00 = do+    a <- plus_minus False+    (a,b) <- share a+    return (a,b)++alice :: Qubit -> Qubit -> Circ (Bit,Bit)+alice q a = do+    a <- qnot a `controlled` q+    q <- hadamard q+    (x,y) <- measure (q,a)+    return (x,y)++bob :: Qubit -> (Bit,Bit) -> Circ Qubit+bob b (x,y) = do+    b <- gate_X b `controlled` y+    b <- gate_Z b `controlled` x+    cdiscard (x,y)+    return b++teleport :: Qubit -> Circ Qubit+teleport q = do+    (a,b) <- bell00+    (x,y) <- alice q a+    b <- bob b (x,y)+    return b++-- ----------------------------------------------------------------------+-- main functions++main_alice =+  print_simple Preview alice++main_bob =+  print_simple Preview bob++main_teleport =+  print_simple Preview teleport++main = main_teleport+
+ Quipper/Demos/TeleportGeneric.hs view
@@ -0,0 +1,170 @@+import Quipper+import Quipper.Libraries.Simulation++import System.Random+import System.Environment+import System.CPUTime++plus_minus :: (QShape a qa ca) => a -> Circ qa+plus_minus a = do +    qs <- qinit a+    qs <- mapUnary hadamard qs+    return qs++share :: (QShape a qa ca) => qa -> Circ (qa, qa)+share qa = do +    qb <- qinit (qc_false qa)+    (qb, qa) <- mapBinary controlled_not qb qa+    return (qa, qb)++bell00 :: (QShape a qa ca) => a -> Circ (qa, qa)+bell00 shape = do +    qa <- plus_minus shape+    (qa, qb) <- share qa+    return (qa, qb)++alice :: (QShape a qa ca) => qa -> qa -> Circ (ca,ca)+alice q a = do +    (a, q) <- mapBinary controlled_not a q+    q <- mapUnary hadamard q+    (x,y) <- measure (q,a)+    return (x,y)++bob :: (QShape a qa ca) => qa -> (ca,ca) -> Circ qa+bob b (x,y) = do+     (b, y) <- mapBinary_c controlled_X b y+     (b, x) <- mapBinary_c controlled_Z b x+     cdiscard (x,y)+     return b+  where+    controlled_X b x = do+      gate_X b `controlled` x+      return (b,x)+    +    controlled_Z b x = do+      gate_Z b `controlled` x+      return (b,x)+    +teleport :: (QData qa) => qa -> Circ qa+teleport q = do+    (a,b) <- bell00 (qc_false q)+    (x,y) <- alice q a+    b <- bob b (x,y)+    return b++teleport_labeled :: (QData qa) => qa -> Circ qa+teleport_labeled q = do+    comment_with_label "ENTER: teleport_labeled" q "q"+    comment "ENTER: bell00"+    (a,b) <- bell00 (qc_false q)+    comment_with_label "EXIT: bell00" (a,b) ("a","b")+    comment "ENTER: alice"+    (x,y) <- alice q a+    comment_with_label "EXIT: alice" (x,y) ("x","y")+    comment "ENTER: bob"+    b <- bob b (x,y)+    comment_with_label "EXIT: bob" b "b"+    comment "EXIT: teleport_labeled"+    return b++-- | A test that should help see how many qubits we can simulate+test_teleport :: [Bool] -> IO [Bool]+test_teleport = run_clifford_generic teleport++data What = Sim | Circ | Usage deriving Eq++-- | The main method deals with command line arguments, and timing of the simulation+main :: IO ()+main = do+  args <- getArgs+  if (length args /= 2) then usage else do+  let arg1 = head args+  let flag = case arg1 of+              "--sim" -> Sim+              "--circ" -> Circ +              _ -> Usage+  if (flag == Usage) then usage else do +   let arg = head (tail args)+   case reads arg of+    [(n,_)] -> do+     if (n < 0) then usage else do+     if (flag == Circ) then print_generic Preview teleport_labeled (replicate n qubit) else do+     input <- randomBools n+     putStrLn ("Input: " ++ show input)+     start <- getCPUTime+     output <- test_teleport input+     end <- getCPUTime+     putStrLn ("Output: " ++ show output)+     let time = end - start+     putStrLn ("Time: (" ++ show time ++ ")")+     show_time time+    _ -> usage++-- | Produce the given number of random boolean values+randomBools :: Int -> IO [Bool]+randomBools 0 = return []+randomBools n = do+  b <- randomIO+  bs <- randomBools (n-1)+  return (b:bs)++-- | Give a usage message if not being run from GHCI+usage :: IO ()+usage = do+  name <- getProgName+  if name == "<interactive>" then prompt else do+  putStrLn ("usage: " ++ name ++ " flag num_qubits")+  putStrLn ("  where flag = --sim or --circ") ++-- | If we're in GHCI then we can prompt for the number of qubits to teleport+prompt :: IO ()+prompt = do+  putStrLn "Enter flag (--sim or --circ): "+  f <- getLine+  putStrLn "Enter number of qubits: "+  n <- getLine+  withArgs [f,n] main      ++-- | Display an integer representing pico-seconds in a more readable format+show_time :: Integer -> IO ()+show_time t = case range t of+  Pico -> putStrLn (show t ++ " " ++ show Pico ++ ".")+  r -> do+   putStr (show (div t (ps' r)) ++ " " ++ show r ++ ", ")+   show_time (rem t (ps' r))++-- | Helper data-type for show_time function+data Range = Pico | Nano | Micro | Milli | Seconds | Minutes | Hours | Days+ deriving Eq++instance Show Range where+ show Pico = "picoseconds"+ show Nano = "nanoseconds"+ show Micro = "microseconds"+ show Milli = "milliseconds"+ show Seconds = "seconds"+ show Minutes = "minutes"+ show Hours = "hours"+ show Days = "days"++-- | Helper function for show_time function+ps' :: Range -> Integer+ps' Pico = 1+ps' Nano = 10^3 * ps' Pico+ps' Micro = 10^3 * ps' Nano+ps' Milli = 10^3 * ps' Micro+ps' Seconds = 10^3 * ps' Milli +ps' Minutes = 60 * ps' Seconds+ps' Hours = 60 * ps' Minutes+ps' Days = 24 * ps' Hours++-- | Helper function for show_time function+range :: Integer -> Range+range t = +  if (t < 10^3) then Pico else+  if (t < 10^6) then Nano else+  if (t < 10^9) then Micro else+  if (t < 10^12) then Milli else+  if (t < 60*(10^12)) then Seconds else+  if (t < 60*60*(10^12)) then Minutes else+  if (t < 24*60*60*(10^12)) then Hours else Days
+ Quipper/Demos/TemplateTest.hs view
@@ -0,0 +1,67 @@+-- | This file illustrates the most basic use of Template Haskell.++import Quipper++-- | A classical implementation of some boolean function.+build_circuit+example1 :: Bool -> Bool -> Bool+example1 a b = (a && b) || not a++-- $ The keyword \"build_circuit\" causes an equivalent quantum function+-- to be built automatically. It will have the following name and+-- type:+-- +-- > template_example1 :: Circ (Qubit -> Circ (Qubit -> Circ Qubit))+-- +-- The various nested 'Circ' applications are an artifact, and can and+-- should be removed using the 'unpack' operator:+-- +-- > (unpack template_example1) :: Qubit -> Qubit -> Circ Qubit++-- | This main function prints the circuit generated from 'example1'.+main1 :: IO ()+main1 =+  print_simple Preview (unpack template_example1)++-- | Here is some other boolean function. We do not use the+-- \"build_circuit\" keyword.+fake :: Bool -> Bool+fake b = not b++-- $ Suppose we want to use the function 'fake' as a subroutine+-- elsewhere:+{-+build_circuit+example2 :: Bool -> Bool -> Bool+example2 a b = fake (a && b) || not a+-}++-- | This will fail, because build_circuit does not know how to+-- translate the 'fake' function. +-- +-- We can fix this by manually providing a template. This is useful in+-- two situations:+-- +-- 1. To provide a template for a Haskell built-in function;+-- +-- 2. To provide a more efficient template for some function than the+-- one build_circuit can build automatically.+template_fake :: Circ (Qubit -> Circ Qubit)+template_fake = return f where+  f q = do+    qnot_at q+    return q++-- | Now that a template for 'fake' has been defined, the definition+-- of 'example2' works:+build_circuit+example2 :: Bool -> Bool -> Bool+example2 a b = fake (a && b) || not a+++-- | This main function prints the circuit generated from 'example2'. +main2 :: IO ()+main2 =+  print_simple Preview (unpack template_example2)++main = main2
+ Quipper/Demos/Test.hs view
@@ -0,0 +1,31 @@+import Quipper++circuit :: (Qubit, Qubit, Qubit) -> Circ (Qubit, Qubit, Qubit)+circuit (a, b, c) = do+  qnot_at a `controlled` [b]+  qnot_at b `controlled` [c]+  hadamard c `controlled` [a,b]+  return (a, b, c)++hadamard2 :: (Qubit, Qubit, Qubit) -> Circ (Qubit, Qubit, Qubit)+hadamard2 (h, a, b) = do+  with_ancilla $ \c -> do+    qnot_at c `controlled` [a, b]+    hadamard h `controlled` [c]+    qnot_at c `controlled` [a, b]+  return (h, a, b)++example :: (Qubit, Qubit, Qubit, Qubit, Qubit) -> Circ (Qubit, Qubit, Qubit, Qubit, Qubit)+example (a, b, c, d, e) = do+  circuit (a, b, c)+  circuit (b, c, a)+  with_controls (d .==. 1 .&&. e .==. 0) $ do {+    circuit (a, b, c);+    circuit (b, c, a);+  }+  circuit (a, b, c)+  circuit (b, c, a)+  return (a, b, c, d, e)++main =+  print_simple Preview example
+ Quipper/Demos/Testing.hs view
@@ -0,0 +1,79 @@+{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}++-- $+-- Generate some circuits for the slides in the PI presentation.++import Quipper++example_H3 :: Qubit -> Qubit -> Qubit -> Qubit -> Circ ()+example_H3 h a b c = do+  with_ancilla $ \d -> do+    with_ancilla $ \e -> do+      qnot_at d `controlled` a .==. 1 .&&. b .==. 1+      qnot_at e `controlled` c .==. 1 .&&. d .==. 1+      hadamard_at h `controlled` e .==. 1+      qnot_at e `controlled` c .==. 1 .&&. d .==. 1+      qnot_at d `controlled` a .==. 1 .&&. b .==. 1++example_H3' :: Qubit -> Qubit -> Qubit -> Qubit -> Qubit -> Qubit -> Circ ()+example_H3' h a b c d e = do+      qnot_at d `controlled` a .==. 1 .&&. b .==. 1+      qnot_at e `controlled` c .==. 1 .&&. d .==. 1+      hadamard_at h `controlled` e .==. 1+      qnot_at e `controlled` c .==. 1 .&&. d .==. 1+      qnot_at d `controlled` a .==. 1 .&&. b .==. 1++example :: Qubit -> Qubit -> Qubit -> Qubit -> Circ ()+example a b c d = do+  example_H3 a b c d+  qnot_at a `controlled` b .==. 1+  qnot_at b `controlled` c .==. 1+  qnot_at c `controlled` d .==. 1 .&&. a .==. 1+  qnot_at b `controlled` c .==. 1+  qnot_at a `controlled` b .==. 1+  example_H3 b c d a++example' :: Qubit -> Qubit -> Qubit -> Qubit -> Qubit -> Qubit -> Circ ()+example' a b c d anc1 anc2 = do+  example_H3' a b c d anc1 anc2+  qnot_at a `controlled` b .==. 1+  qnot_at b `controlled` c .==. 1+  qnot_at c `controlled` d .==. 1 .&&. a .==. 1+  qnot_at b `controlled` c .==. 1+  qnot_at a `controlled` b .==. 1+  example_H3' b c d a anc1 anc2+++main3 =+  print_generic Preview example qubit qubit qubit qubit++main =+  print_simple Preview example'++ec1 :: Qubit -> Circ [Qubit]+ec1 a = do+  b <- qinit False+  c <- qinit False+  qmultinot_at (b,c) `controlled` a .==. 1+  return [a,b,c]++corr :: [Qubit] -> Circ Qubit+corr [a,b,c] = do+  qmultinot_at (a,c) `controlled` b .==. 1+  (a',c') <- measure (a,c)+  qnot_at b `controlled` a' .==. 1 .&&. c' .==. 1+  cdiscard (a',c')+  return b++ec2 :: [Qubit] -> Circ [Qubit]+ec2 [a,b,c] = do+  [a1,a2,a3] <- ec1 a+  [b1,b2,b3] <- ec1 b+  [c1,c2,c3] <- ec1 c+  x1 <- corr [a1,b1,c1]+  x2 <- corr [a2,b2,c2]+  x3 <- corr [a3,b3,c3]+  return [x1,x2,x3]+++main4 = print_generic Preview ec2 [qubit, qubit, qubit]
+ Quipper/Demos/TimeStep-binary.hs view
@@ -0,0 +1,36 @@+import Quipper+import Quipper.Libraries.Qureg+import Quipper.Libraries.Decompose++import Quipper.Algorithms.BWT.Definitions++-- | Algorithm 3. @timestep (a, b, r, dt, m)@: Apply the+-- time step /dt/ to (/a/,/b/,/r/). Here /a/ and /b/ are /m/-qubit+-- registers while /r/ is a single qubit.+timestep :: (Qureg, Qureg, Qubit, Timestep, Int) -> Circ ()+timestep (a, b, r, dt, m) = do+  comment_with_label "ENTER: timestep" (a,b,r) ("a","b","r")+  with_ancilla $ \h -> do+    for 0 (m-1) 1 $ \i -> do+      wGate (a.!(i), b.!(i))+    endfor+    for 0 (m-1) 1 $ \i -> do+      toffoliGate (a.!(i), b.!(i), h)+    endfor+    controlledExpGate (dt, r, h)+    for (m-1) 0 (-1) $ \i -> do+      toffoliGate (a.!(i), b.!(i), h)+    endfor+    for (m-1) 0 (-1) $ \i -> do+      wGateInverse (a.!(i), b.!(i))+    endfor+  comment_with_label "EXIT: timestep" (a,b,r) ("a","b","r")+  return ()++main = print_generic Preview (decompose_generic Binary circuit) (nodeshape, nodeshape, qubit)+  where+    circuit (a, b, r) = timestep (a, b, r, dt, m)+    n = 4+    m = n+2+    dt = pi/180+    nodeshape = qureg_shape m
+ Quipper/Demos/TimeStep.hs view
@@ -0,0 +1,34 @@+import Quipper+import Quipper.Libraries.Qureg+import Quipper.Algorithms.BWT.Definitions++-- | Algorithm 3. @timestep (a, b, r, dt, m)@: Apply the+-- time step /dt/ to (/a/,/b/,/r/). Here /a/ and /b/ are /m/-qubit+-- registers while /r/ is a single qubit.+timestep :: (Qureg, Qureg, Qubit, Timestep, Int) -> Circ ()+timestep (a, b, r, dt, m) = do+  comment_with_label "ENTER: timestep" (a,b,r) ("a","b","r")+  with_ancilla $ \h -> do+    for 0 (m-1) 1 $ \i -> do+      wGate (a.!(i), b.!(i))+    endfor+    for 0 (m-1) 1 $ \i -> do+      toffoliGate (a.!(i), b.!(i), h)+    endfor+    controlledExpGate (dt, r, h)+    for (m-1) 0 (-1) $ \i -> do+      toffoliGate (a.!(i), b.!(i), h)+    endfor+    for (m-1) 0 (-1) $ \i -> do+      wGateInverse (a.!(i), b.!(i))+    endfor+  comment_with_label "EXIT: timestep" (a,b,r) ("a","b","r")+  return ()++main = print_generic Preview circuit (nodeshape, nodeshape, qubit)+  where+    circuit (a, b, r) = timestep (a, b, r, dt, m)+    n = 4+    m = n+2+    dt = pi/180+    nodeshape = qureg_shape m
+ Quipper/Demos/TransformerExample.hs view
@@ -0,0 +1,23 @@+import Quipper+  +mytransformer :: Transformer Circ Qubit Bit+mytransformer (T_QGate "swap" 2 0 _ ncf f) = f $+  \[q0, q1] [] ctrls -> do+    without_controls_if ncf $ do+      with_controls ctrls $ do+        qnot_at q0 `controlled` q1+        qnot_at q1 `controlled` q0+        qnot_at q0 `controlled` q1+        return ([q0, q1], [], ctrls)+mytransformer g = identity_transformer g++mycirc a b c d = do+  swap_at a b+  hadamard_at b+  swap_at b c `controlled` [a, d]+  hadamard_at c+  swap_at c d++mycirc2 = transform_generic mytransformer mycirc++main = print_simple Preview mycirc2
+ Quipper/Demos/WithComputed.hs view
@@ -0,0 +1,40 @@+import Quipper++crazy :: (QData a, QCData b) => (a -> Circ b) -> (a -> Circ (a,b))+crazy f a = do+  mapUnary hadamard a+  y <- with_computed (f a) $ \b -> do+    b' <- qc_copy b+    return (a,b')+  return y++circuit :: [Qubit] -> Circ ([Qubit], [Qubit])+circuit qs = do+  y <- with_computed values $ \values -> do+    qc_copy values+  return (qs, y)+  +    where+      values = do+        mapUnary hadamard qs+        a <- qinit True+        b <- qinit False+        qnot_at a `controlled` qs+        qnot_at b `controlled` qs .==. [0,0..]+        c <- qinit False+        qnot_at c `controlled` [a,b]+        qnot_at b `controlled` qs .==. [0,0..]+        qnot_at a `controlled` qs+        qterm False b  +        qterm True a+        return (c:qs)++circuit2 :: [Qubit] -> Circ ([Qubit], ([Qubit], [Qubit]))+circuit2 = crazy circuit++circuit3 :: [Qubit] -> Circ ([Qubit], ([Qubit], ([Qubit], [Qubit])))+circuit3 = crazy circuit2++circuit4 = crazy circuit3++main = print_generic Preview circuit4 (replicate 5 qubit)
+ Setup.hs view
@@ -0,0 +1,15 @@+{-# LANGUAGE CPP #-}++import Distribution.Simple+import Quipper.Distribution.Preprocessor++-- The following is needed because of an incompatible change in Cabal 2.+#if MIN_VERSION_Cabal(2,0,0)+wrap x = \_ _ _ -> x+#else+wrap x = \_ _ -> x+#endif++main = defaultMainWithHooks simpleUserHooks {+  hookedPreProcessors = [("hs", wrap ppQuipper)]+  }
+ dist/build/And_gate/And_gate-tmp/Quipper/Demos/And_gate.hs view
@@ -0,0 +1,14 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}+{-# LINE 1 "Quipper/Demos/And_gate.hs" #-}+import Quipper++and_gate :: (Qubit, Qubit) -> Circ (Qubit)+and_gate (a, b) = do+  c <- qinit False+  qnot_at c `controlled` [a, b]+  return c++main =+  print_simple Preview and_gate
+ dist/build/And_list/And_list-tmp/Quipper/Demos/And_list.hs view
@@ -0,0 +1,24 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}+{-# LINE 1 "Quipper/Demos/And_list.hs" #-}+import Quipper++and_gate :: (Qubit, Qubit) -> Circ (Qubit)+and_gate (a, b) = do+  c <- qinit False+  qnot_at c `controlled` [a, b]+  return c++and_list :: [Qubit] -> Circ Qubit+and_list [] = do+  c <- qinit True+  return c+and_list [q] = do+  return q+and_list (q:t) = do+  d <- and_list t+  e <- and_gate (d, q)+  return e++main = print_generic Preview and_list (replicate 10 qubit)
+ dist/build/And_rev/And_rev-tmp/Quipper/Demos/And_rev.hs view
@@ -0,0 +1,30 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}+{-# LINE 1 "Quipper/Demos/And_rev.hs" #-}+import Quipper++and_gate :: (Qubit, Qubit) -> Circ (Qubit)+and_gate (a, b) = do+  c <- qinit False+  qnot_at c `controlled` [a, b]+  return c++and_list :: [Qubit] -> Circ Qubit+and_list [] = do+  c <- qinit True+  return c+and_list [q] = do+  return q+and_list (q:t) = do+  d <- and_list t+  e <- and_gate (d, q)+  return e++and_rev :: ([Qubit], Qubit) -> Circ ([Qubit], Qubit)+and_rev = classical_to_reversible and_list++main =+  print_generic Preview and_rev (replicate 10 qubit, qubit)++
+ dist/build/Arith/Arith-tmp/Quipper/Demos/Arith.hs view
@@ -0,0 +1,17 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}+{-# LINE 1 "Quipper/Demos/Arith.hs" #-}+import Quipper+import Quipper.Libraries.Arith++main :: IO ()+main = print_generic Preview labelled_add (qdint_shape 3) (qdint_shape 3)+++labelled_add :: QDInt -> QDInt -> Circ (QDInt, QDInt,QDInt)+labelled_add x y = do+  label (x,y) ("x","y")+  xy <- q_add x y+  label xy ("x","y","x+y")+  return xy
+ dist/build/Box/Box-tmp/Quipper/Demos/Box.hs view
@@ -0,0 +1,116 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}+{-# LINE 1 "Quipper/Demos/Box.hs" #-}+import Quipper+import Quipper.Libraries.Unboxing++main :: IO ()+main = do+  print_generic Preview boxed_unboxed (replicate 5 qubit) (replicate 5 qubit)+  --print_simple Preview boxed_unboxed2+  --print_simple Preview boxed_unboxed3+  --print_simple Preview boxed_unboxed4++sub_notboxed :: [Qubit] -> Circ [Qubit]+sub_notboxed [] = return []+sub_notboxed [a] = return [a]+sub_notboxed (a:(b:cs)) = do+  a' <- hadamard a `controlled` b+  bcs' <- sub_notboxed (b:cs)+  return (bcs' ++ [a'])++sub_boxed :: [Qubit] -> Circ [Qubit]+sub_boxed = box "sub" sub_notboxed++my_circuit :: ([Qubit] -> Circ [Qubit]) -> [Qubit] -> [Qubit] -> Circ ([Qubit],[Qubit])+my_circuit sub as bs = do+  comment_with_label "ENTER: my_circuit" (as,bs) ("a","b")+  as' <- sub (reverse as) `controlled` (head bs)+  label (as',bs) ("a","b")+  bs' <- sub bs +  label (as',bs') ("a","b")+  as'' <- reverse_generic_endo sub (reverse as') `controlled` (head bs')+  comment_with_label "EXIT: my_circuit" (as'',bs') ("a","b")+  return (as'',bs')++boxed_unboxed :: [Qubit] -> [Qubit] -> Circ ([Qubit],[Qubit])+boxed_unboxed as bs = do+  label (as,bs) ("a","b")+  (as,bs) <- my_circuit sub_notboxed as bs+  label (as,bs) ("a","b")+  (as,bs) <- my_circuit sub_boxed as bs+  label (as,bs) ("a","b")+  (as,bs) <- unbox (my_circuit sub_boxed) as bs+  label (as,bs) ("a","b")+  return (as,bs)++my_subroutine2 :: (Qubit,Qubit,Qubit) -> Circ (Qubit,Qubit,Qubit)+my_subroutine2 (a,b,c) = do+   qnot_at c `controlled` [a,b]+   return (a,b,c)++sub2 :: (Qubit,Qubit,Qubit) -> Circ (Qubit,Qubit,Qubit)+sub2 = box "tof" my_subroutine2++my_subroutine2' :: (Qubit,Qubit,Qubit,Qubit) -> Circ (Qubit,Qubit,Qubit,Qubit)+my_subroutine2' (a,b,c,d) = do+     (b',c',d') <- sub2 (b,c,d) `controlled` a+     return (a,b',c',d')++sub2' :: (Qubit,Qubit,Qubit,Qubit) -> Circ (Qubit,Qubit,Qubit,Qubit)+sub2' = box "ss" my_subroutine2'++my_circuit2 :: (Qubit,Qubit,Qubit,Qubit) -> (Qubit,Qubit,Qubit,Qubit) -> Circ ((Qubit,Qubit,Qubit,Qubit),(Qubit,Qubit,Qubit,Qubit))+my_circuit2 as bs = do+  (a1,a2,a3,a4) <- sub2' as+  (b1,b2,b3,b4) <- sub2' bs +  return ((a1,a2,a3,a4),(b1,b2,b3,b4))++boxed_unboxed2 :: (Qubit,Qubit,Qubit,Qubit) -> (Qubit,Qubit,Qubit,Qubit) -> Circ ((Qubit,Qubit,Qubit,Qubit),(Qubit,Qubit,Qubit,Qubit))+boxed_unboxed2 as bs = do+  (as',bs') <- my_circuit2 as bs+  (as'',bs'') <- (unbox my_circuit2) as' bs'+  (unbox (unbox my_circuit2)) as'' bs''++my_subroutine3 :: (Qubit,Qubit,Qubit) -> Circ Qubit+my_subroutine3 (a,b,c) = do+  qdiscard (c,a)+  return b++sub3 :: (Qubit,Qubit,Qubit) -> Circ Qubit+sub3 = box "term" my_subroutine3++my_circuit3 :: (Qubit,Qubit,Qubit,Qubit,Qubit,Qubit) -> Circ (Qubit,Qubit)+my_circuit3 (a,b,c,d,e,f) = do+  b' <- sub3 (a,b,c)+  e' <- sub3 (d,e,f)+  qnot_at e' `controlled` b' +  return (b',e')++boxed_unboxed3 :: ((Qubit,Qubit,Qubit,Qubit,Qubit,Qubit),(Qubit,Qubit,Qubit,Qubit)) -> Circ (Qubit,Qubit)+boxed_unboxed3 ((a,b,c,d,e,f),(c',d',e',f')) = do+  (a',b') <-  my_circuit3 (a,b,c,d,e,f)+  (unbox my_circuit3) (a',b',c',d',e',f')++my_subroutine4 :: Qubit -> Circ (Qubit,Qubit,Qubit)+my_subroutine4 a = do+  (b,c) <- qinit (False,False)+  return (a,b,c)++sub4 :: Qubit -> Circ (Qubit,Qubit,Qubit)+sub4 = box "init" my_subroutine4++my_circuit4 :: (Qubit,Qubit) -> Circ (Qubit,Qubit,Qubit,Qubit,Qubit,Qubit)+my_circuit4 (a,b) = do+  (a',c,d) <- sub4 a +  (b',e,f) <- sub4 b+  return (a',b',c,d,e,f)++boxed_unboxed4 :: (Qubit,Qubit) -> Circ ((Qubit,Qubit,Qubit,Qubit),(Qubit,Qubit,Qubit,Qubit,Qubit,Qubit))+boxed_unboxed4 (a,b) = do+  (a',b',c,d,e,f) <- my_circuit4 (a,b)+  (a'',b'',g,h,i,j) <- unbox my_circuit4 (a',b')+  return ((c,d,e,f),(a'',b'',g,h,i,j))++
+ dist/build/BoxExample/BoxExample-tmp/Quipper/Demos/BoxExample.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}+{-# LINE 1 "Quipper/Demos/BoxExample.hs" #-}+import Quipper++-- Unboxed version of subroutine+my_sub :: (Qubit, Qubit, Qubit) -> Circ (Qubit, Qubit, Qubit)+my_sub (a,b,c) = do+  hadamard_at a `controlled` b+  hadamard_at a `controlled` c+  hadamard_at b `controlled` c+  return (a,b,c)+  +-- Boxed version of subroutine+boxed_sub :: (Qubit, Qubit, Qubit) -> Circ (Qubit, Qubit, Qubit)+boxed_sub = box "my_sub" my_sub++-- Unboxed version of circuit+my_circuit :: [Qubit] -> Circ [Qubit]+my_circuit [] = return []+my_circuit [a] = return [a]+my_circuit [a,b] = return [a,b]+my_circuit (a:b:c:rest) = do+  (a,b,c) <- my_sub (a,b,c)+  x <- my_circuit (b:c:rest)+  return (a:x)++-- Boxed version of circuit+my_circuit_boxed :: [Qubit] -> Circ [Qubit]+my_circuit_boxed [] = return []+my_circuit_boxed [a] = return [a]+my_circuit_boxed [a,b] = return [a,b]+my_circuit_boxed (a:b:c:rest) = do+  (a,b,c) <- boxed_sub (a,b,c)+  x <- my_circuit_boxed (b:c:rest)+  return (a:x)++main = do+  print_generic Preview my_circuit_boxed (replicate 6 qubit)
+ dist/build/Classical/Classical-tmp/Quipper/Demos/Classical.hs view
@@ -0,0 +1,16 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}+{-# LINE 1 "Quipper/Demos/Classical.hs" #-}+import Quipper++circuit :: (Bit, Qubit) -> Circ (Qubit, Qubit)+circuit (b,q) = do+  qnot_at q `controlled` b+  r <- prepare b+  gate_W_at q r+  return (q,r)+  +main =   +  print_simple Preview circuit+
+ dist/build/Comments/Comments-tmp/Quipper/Demos/Comments.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}+{-# LINE 1 "Quipper/Demos/Comments.hs" #-}+import Quipper++example1 :: (Qubit,Qubit,[Qubit]) -> Circ (Qubit,Qubit,[Qubit])+example1 (q, a, b) = do+    comment_with_label "Start of example 1" (q,a,b) ("q","a","b")+    hadamard a+    qnot_at a `controlled` b+    hadamard q `controlled` a+    qnot_at a `controlled` b+    hadamard a+    comment "End of example 1"+    return (q, a, b)++example3 :: (Qubit,Qubit,[Qubit],Qubit,Qubit) -> Circ (Qubit,Qubit,[Qubit],Qubit,Qubit)+example3 (q, a, b, d, e) = do+    comment_with_label "Start of example 3" (q,a,b,d,e) ("q","a","b","d","e")+    example1 (q, a, b)+    with_controls (d .==. 0 .&&. e .==. 1) $ do+      example1 (q, a, b)+      example1 (q, a, b)+    example1 (q, a, b)+    comment "End of example 3"+    return (q, a, b, d, e)++main = print_generic Preview example3 (qubit, qubit, replicate 3 qubit, qubit, qubit)
+ dist/build/CountAccess/CountAccess-tmp/Quipper/Demos/CountAccess.hs view
@@ -0,0 +1,67 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}+{-# LINE 1 "Quipper/Demos/CountAccess.hs" #-}+-- | Consider the following problem, suggested by Dmitry Maslov: Input+-- a list of bits. Let /i/ be the weight of the list, i.e., the number+-- of \"1\" bits in the list. Output the /i/th element, where elements+-- are counted from 0 and we wrap around cyclically if /i/ equals the+-- length of the list.++import Quipper+import Quipper.Libraries.Arith+import Quipper.Libraries.Qram++import Prelude hiding (truncate)++-- | Figure out how many bits are needed to store a given integer. +hibit :: Int -> Int+hibit 0 = 0+hibit n = 1 + hibit (n `div` 2)++-- | @'truncate' n q@: Input a classical integer /n/ and a quantum+-- integer /q/. Output /0/ if /q/=/n/, and /q/ otherwise. For the+-- problem at hand, this is cheaper than full modular arithmetic. +truncate :: IntM -> QDInt -> Circ QDInt+truncate n q = do+  q' <- qc_copy q+  with_controls (q .==. n) $ do+    controlled_not q' q+  return q'++-- | Input a list of qubits and return its weight.+weight :: [Qubit] -> Circ QDInt+weight qs = q where+  len = length qs+  bits = hibit len+  zero = intm bits 0+  q = do+    q <- qinit zero+    q <- aux qs q+    q1 <- truncate (intm bits (toInteger len)) q+    return q1++  aux [] q = return q+  aux (h:t) q = do+    q <- q_increment q `controlled` h+    q <- aux t q+    return q++-- | Input a list of qubits, and output the /i/th qubit, where /i/ is+-- the weight of the list.+countshift :: [Qubit] -> Circ Qubit+countshift qs = do+  q <- weight qs+  a <- indexed_access qs q+  return a++-- | Reversible version of 'countshift'. +countshift_rev :: [Qubit] -> Circ ([Qubit], Qubit)+countshift_rev qs = do+  b <- with_computed (countshift qs) $ \a -> do+    qc_copy a+  return (qs, b)++-- | A main function to print the circuit.+main = +  print_generic Preview countshift_rev (replicate 7 qubit)
+ dist/build/Decompose_test/Decompose_test-tmp/Quipper/Demos/Decompose_test.hs view
@@ -0,0 +1,27 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}+{-# LINE 1 "Quipper/Demos/Decompose_test.hs" #-}+import Quipper+import Quipper.Libraries.Decompose++toffoli :: (Qubit,Qubit,Qubit) -> Circ (Qubit,Qubit,Qubit)+toffoli (q1,q2,q3) = do+ qnot_at q3 `controlled` (q1,q2)+ return (q1,q2,q3)++boxed :: (Qubit,Qubit,Qubit) -> Circ (Qubit,Qubit,Qubit)+boxed = box "Toffoli" toffoli+++tof :: (Qubit,Qubit,Qubit,Qubit,Qubit) -> Circ ()+tof (q1,q2,q3,q4,q5) = do+ boxed (q3,q4,q5) `controlled` (q1,q2)+ return ()+ +main :: IO ()+main = do+  print_simple Preview tof+  print_simple Preview (decompose_generic Logical tof)+  print_simple Preview (decompose_generic Toffoli tof)+  print_simple Preview (decompose_generic Binary tof)
+ dist/build/DynamicLifting/DynamicLifting-tmp/Quipper/Demos/DynamicLifting.hs view
@@ -0,0 +1,27 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}+{-# LINE 1 "Quipper/Demos/DynamicLifting.hs" #-}+-- Test the dynamic lifting feature. ++import Quipper++-- | A circuit in which some future gates depend on a prior measurement.+circuit :: Qubit -> Qubit -> Circ Qubit+circuit a b = do+  qnot_at a `controlled` b+  m <- measure a+  bool <- dynamic_lift m+  if bool == 0 then+      do+       hadamard_at b+       return b+    else+      do+       c <- qinit False+       qnot_at c `controlled` b+       qdiscard b+       return c++main = do+  print_simple ASCII circuit
+ dist/build/ErrorCircuit/ErrorCircuit-tmp/Quipper/Demos/ErrorCircuit.hs view
@@ -0,0 +1,32 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}+{-# LINE 1 "Quipper/Demos/ErrorCircuit.hs" #-}+import Quipper+import Quipper.Libraries.Decompose++-- Outputs a partially undefined circuit. This illustrates the use of+-- laziness in the Quipper circuit generation code.++-- Please note that currently only the ASCII backend can make actual+-- use of laziness; the graphics-based backends must generate the+-- whole circuit before it can be printed.++-- We also apply a transformer, to illustrate the laziness of+-- transformers as well.++circuit_with_error :: Qubit -> Qubit -> Qubit -> Circ (Qubit, Qubit, Qubit)+circuit_with_error q r s = do+  qnot_at q `controlled` [r,s]+  hadamard_at r+  error "A runtime error occurred!"+  hadamard_at r+  return (q, r, s)  +  +circuit_with_error_transformed = decompose_generic Binary circuit_with_error++main =+  print_simple ASCII circuit_with_error++main2 = +  print_simple ASCII circuit_with_error_transformed
+ dist/build/Example/Example-tmp/Quipper/Demos/Example.hs view
@@ -0,0 +1,41 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}+{-# LINE 1 "Quipper/Demos/Example.hs" #-}++import Quipper+import Prelude hiding (and)++example1 :: (Qubit, Qubit, Qubit) -> Circ (Qubit, Qubit, Qubit)+example1 (a,b,c) = do+  qnot_at a `controlled` [b, c]+  hadamard b `controlled` [a]+  qnot_at a `controlled` [b, c]+  hadamard c `controlled` [a]+  return (a,b,c)++example2 :: Qubit -> Qubit -> Qubit -> Qubit -> Circ ()+example2 h a b c = do+  qnot_at c `controlled` [a, b]+  hadamard h `controlled` [c]+  qnot_at c `controlled` [a, b]++example3 :: Qubit -> Qubit -> Qubit -> Circ ()+example3 h a b = do+  with_ancilla $ \c -> do+    qnot_at c `controlled` [a, b]+    hadamard h `controlled` [c]+    qnot_at c `controlled` [a, b]++example4 :: (Qubit, Qubit, Qubit, Qubit) -> Circ (Qubit, Qubit, Qubit, Qubit)+example4 (a,b,c,d) = do+  qnot_at a+  qnot_at b+  with_controls (c .&&. d) $ do+    qnot_at a+    qnot_at b+  qnot_at c+  return (a,b,c,d)++main =+  print_simple Preview example4
+ dist/build/Example1/Example1-tmp/Quipper/Demos/Example1.hs view
@@ -0,0 +1,14 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}+{-# LINE 1 "Quipper/Demos/Example1.hs" #-}+  import Quipper++  example1 (q, a, b, c) = do+    hadamard a+    qnot_at c `controlled` [a, b]+    hadamard q `controlled` [c]+    qnot_at c `controlled` [a, b]+    hadamard a++  main = print_simple Preview example1
+ dist/build/Example2/Example2-tmp/Quipper/Demos/Example2.hs view
@@ -0,0 +1,16 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}+{-# LINE 1 "Quipper/Demos/Example2.hs" #-}+  import Quipper++  example2 (q, a, b) = do+    hadamard a+    with_ancilla $ \c -> do+      qnot_at c `controlled` [a, b]+      hadamard_at q `controlled` [c]+      qnot_at c `controlled` [a, b]+    hadamard_at a+    return (q, a, b)++  main = print_simple Preview example2
+ dist/build/Example3/Example3-tmp/Quipper/Demos/Example3.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}+{-# LINE 1 "Quipper/Demos/Example3.hs" #-}+import Quipper++example1 :: (Qubit,Qubit,Qubit,Qubit) -> Circ (Qubit,Qubit,Qubit,Qubit)+example1 (q, a, b, c) = do+    hadamard a+    qnot_at c `controlled` [a, b]+    hadamard q `controlled` [c]+    qnot_at c `controlled` [a, b]+    hadamard a+    return (q, a, b, c)++example3 :: (Qubit,Qubit,Qubit,Qubit,Qubit,Qubit) -> Circ (Qubit,Qubit,Qubit,Qubit,Qubit,Qubit)+example3 (q, a, b, c, d, e) = do+    example1 (q, a, b, c)+    with_controls (d .==. 0 .&&. e .==. 1) $ do+      example1 (q, a, b, c)+      example1 (q, a, b, c)+    example1 (q, a, b, c)+    return (q, a, b, c, d, e)++main = print_simple Preview example3
+ dist/build/Example4/Example4-tmp/Quipper/Demos/Example4.hs view
@@ -0,0 +1,15 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}+{-# LINE 1 "Quipper/Demos/Example4.hs" #-}+import Quipper++example4 :: (Qubit, Qubit, Qubit) -> Circ (Qubit, Qubit, Qubit)+example4(q, a, b) = do+  with_ancilla $ \c -> do+    qnot_at c `controlled` [a, b]+    hadamard q `controlled` [c]+    qnot_at c `controlled` [a, b]+  return (q, a, b)++main = print_simple Preview example4
+ dist/build/GPhase/GPhase-tmp/Quipper/Demos/GPhase.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}+{-# LINE 1 "Quipper/Demos/GPhase.hs" #-}+-- This file illustrates how global phase gates will be rendered in+-- graphical circuit diagrams.++import Quipper++mycirc :: (Qubit, Qubit, Qubit) -> Circ ()+mycirc (a,b,c) = do+  comment "Unanchored"+  global_phase 1.0+  +  comment "Anchored at a"+  global_phase_anchored 1.0 a+  +  comment "Anchored at b"+  global_phase_anchored 1.0 b+  +  comment "Anchored at c"+  global_phase_anchored 1.0 c+  +  comment "Anchored at (a,b)"+  global_phase_anchored 1.0 (a,b)+  +test :: (Qubit, Qubit, Qubit) -> Circ ()+test (a,b,c) = do +  label (a,b,c) ("a", "b", "c")+  mycirc (a,b,c)+  mycirc (a,b,c) `controlled` a+  mycirc (a,b,c) `controlled` b+  mycirc (a,b,c) `controlled` c+  mycirc (a,b,c) `controlled` a .==. 1 .&&. b .==. 0 .&&. c .==. 0++main = +  print_simple Preview test
+ dist/build/HelloWorld/HelloWorld-tmp/Quipper/Demos/HelloWorld.hs view
@@ -0,0 +1,15 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}+{-# LINE 1 "Quipper/Demos/HelloWorld.hs" #-}+import Quipper++circuit :: Qubit -> Qubit -> Qubit -> Circ (Qubit, Qubit, Qubit, Qubit)+circuit a b c = do+  qnot_at a `controlled` c .==. 1+  hadamard_at b `controlled` c .==. 0+  d <- qinit False+  qnot_at d `controlled` b .==. 1+  return (a,b,c,d)++main = print_simple Preview circuit
+ dist/build/Infinite/Infinite-tmp/Quipper/Demos/Infinite.hs view
@@ -0,0 +1,30 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}+{-# LINE 1 "Quipper/Demos/Infinite.hs" #-}+import Quipper+import Quipper.Libraries.Decompose++-- Outputs an infinite circuit. This illustrates the use of laziness+-- in the Quipper circuit generation code. ++-- Please note that currently only the ASCII backend can make actual+-- use of laziness; the graphics-based backends must generate the+-- whole circuit before it can be printed.++-- We also apply a transformer, to illustrate the laziness of+-- transformers as well.++infinite_circuit :: Qubit -> Qubit -> Qubit -> Circ (Qubit, Qubit, Qubit)+infinite_circuit q r s = do+  qnot_at q `controlled` [r,s]+  hadamard_at r+  infinite_circuit s q r+  +infinite_circuit_transformed = decompose_generic Binary infinite_circuit++main1 = +  print_simple ASCII infinite_circuit++main = +  print_simple ASCII infinite_circuit_transformed
+ dist/build/MultiControlledNot/MultiControlledNot-tmp/Quipper/Demos/MultiControlledNot.hs view
@@ -0,0 +1,34 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}+{-# LINE 1 "Quipper/Demos/MultiControlledNot.hs" #-}+-- | Demonstrates Quipper's decomposition of multiply-controlled+-- not-gates into the Clifford+/T/ gate set.++import Quipper+import Quipper.Libraries.Decompose++multi_cnot :: [Qubit] -> Qubit -> Circ ()+multi_cnot controls target = do+  qnot_at target `controlled` controls++multi_cnot_decomposed :: [Qubit] -> Qubit -> Circ ()+multi_cnot_decomposed = decompose_generic Exact multi_cnot++main_n :: Int -> IO ()+main_n n = do+  putStrLn ("Gate counts for " ++ show n ++ " controls:")+  putStrLn ""+  print_generic GateCount multi_cnot_decomposed (replicate n qubit) qubit+  putStrLn ""+  print_generic Preview multi_cnot_decomposed (replicate n qubit) qubit+ +main :: IO ()+main = do+  main_n 0+  main_n 1+  main_n 2+  main_n 3+  main_n 4+  main_n 5+  main_n 6
+ dist/build/NBox/NBox-tmp/Quipper/Demos/NBox.hs view
@@ -0,0 +1,26 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}+{-# LINE 1 "Quipper/Demos/NBox.hs" #-}+import Quipper+import Quipper.Libraries.Unboxing++rep :: Integer+rep = 3++myfunc :: (Qubit, Qubit) -> Circ (Qubit, Qubit)+myfunc (a,b) = do+  hadamard_at a `controlled` b+  return (b,a)+  +circuit :: (Qubit, Qubit, Qubit, Qubit, Qubit, Qubit) -> Circ (Qubit, Qubit, Qubit, Qubit, Qubit, Qubit)+circuit (a,b,c,d,e,f) = do+  label (a,b,c,d,e,f) ("a","b","c","d","e","f")+  (a,b) <- loopM rep (a,b) myfunc+  (c,d) <- box_loopM "box1" rep (c,d) myfunc+  (e,f) <- unbox (\x -> box_loopM "box1" rep x myfunc) (e,f)+  label (a,b,c,d,e,f) ("a","b","c","d","e","f") +  return (a,b,c,d,e,f)+  +main = +  print_simple Preview circuit
+ dist/build/NamedGate/NamedGate-tmp/Quipper/Demos/NamedGate.hs view
@@ -0,0 +1,34 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}+{-# LINE 1 "Quipper/Demos/NamedGate.hs" #-}+import Quipper hiding (gate_V)++my_unary_gate :: Qubit -> Circ Qubit+my_unary_gate = named_gate "Q"++my_binary_gate :: (Qubit, Qubit) -> Circ (Qubit, Qubit)+my_binary_gate = named_gate "R"++my_unary_gate_at :: Qubit -> Circ ()+my_unary_gate_at = named_gate_at "Q"++my_binary_gate_at :: (Qubit, Qubit) -> Circ ()+my_binary_gate_at = named_gate_at "R"++gate_V :: Qubit -> Circ Qubit+gate_V = named_gate "V"++circuit :: Qubit -> Qubit -> Circ (Qubit, Qubit)+circuit a b = do+  a <- gate_V a+  (c,d) <- my_binary_gate (a,b)+  c <- my_unary_gate a `controlled` d+  my_binary_gate_at (c, d)+  my_binary_gate_at (d, c)+  my_unary_gate_at d+  c <- gate_V c+  d <- gate_V d+  return (c,d)++main = print_simple Preview circuit
+ dist/build/NoControl/NoControl-tmp/Quipper/Demos/NoControl.hs view
@@ -0,0 +1,78 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}+{-# LINE 1 "Quipper/Demos/NoControl.hs" #-}+import Quipper++-- | 'example1': do a basis change, then perform some operation, then+-- uncompute the basis change. Drawback: if this is later controlled,+-- then the controls are applied to the basis change too, which is+-- unnecessary.++example1 :: Qubit -> Qubit -> Circ ()+example1 a b = do+  -- basis change+  gate_W_at a b+  qnot_at b `controlled` a+  +  -- some operation+  hadamard_at b `controlled` a+  +  -- undo basis change+  qnot_at b `controlled` a+  gate_W_at a b  ++-- | 'example2': low-level solution. The 'without_controls' operator+-- can be used to inhibit the addition of further controls to blocks+-- of code.  (However, this is not very safe. A better way to do this+-- is shown in 'example3').++example2 :: Qubit -> Qubit -> Circ ()+example2 a b = do+  -- basis change+  without_controls $ do+    gate_W_at a b+    qnot_at b `controlled` a+  -- some operation+  hadamard_at b `controlled` a+  -- undo basis change+  without_controls $ do+    qnot_at b `controlled` a+    gate_W_at a b++-- | 'example3': a better way to achieve the effect of 'example2' is+-- to use the operator 'with_basis_change'. This will take care of the+-- uncomputation automatically, and also ensure that controls will not+-- be added to the basis change.+example3 :: Qubit -> Qubit -> Circ ()    +example3 a b = do+  with_basis_change basischange $ do+    hadamard_at b `controlled` a++    where+      basischange = do+        gate_W_at a b+        qnot_at b `controlled` a++-- | 'example4': a similar effect is introduced by the operator+-- 'with_ancilla'. Normally, the gates that initialize and terminate+-- ancillas cannot be controlled. However, when using the+-- 'with_ancilla' operator, the resulting circuit can be controlled as+-- a whole, provided that the body is controllable.++example4 :: Qubit -> Qubit -> Circ ()+example4 a b = do+  with_ancilla $ \d -> do+    with_basis_change (qnot_at d `controlled` b .==. False) $ do+      hadamard_at a `controlled` d++my_circuit :: Qubit -> Qubit -> Qubit -> Circ ()+my_circuit ctrl a b = do+  example1 a b `controlled` ctrl+  example2 a b `controlled` ctrl+  example3 a b `controlled` ctrl+  example4 a b `controlled` ctrl++main =+  print_simple Preview my_circuit+
+ dist/build/OptimTest/OptimTest-tmp/Quipper/Demos/OptimTest.hs view
@@ -0,0 +1,86 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}+{-# LINE 1 "Quipper/Demos/OptimTest.hs" #-}+-- | A test for the 'simplify_classical' function. As an example, we use+-- a simple adder defined using the @build_circuit@ keyword. 'main1'+-- outputs the unoptimized circuit, and 'main2' outputs the optimized+-- version.++import Quipper+import Quipper.Libraries.ClassicalOptim+import Quipper.Utils.Auxiliary++-- | Return the majority of three booleans.++majority :: Bool -> Bool -> Bool -> Bool+majority a b c = if (a `bool_xor` b) then c else a+++{-# LINE 14 "Quipper/Demos/OptimTest.hs" #-}+$( decToCircMonad [d| majority :: Bool -> Bool -> Bool -> Bool+                      majority a b c = if (a `bool_xor` b) then c else a+                      +                      + |] ) +{-# LINE 15 "Quipper/Demos/OptimTest.hs" #-}+-- | Bit adder. The first input is 'False' for adding, and 'True' for+-- subtracting. The second input is a triple consisting of a carry,+-- and two bits to be added. The output consists of the new carry and+-- the sum.++bit_adder :: Bool -> (Bool,Bool,Bool) -> (Bool,Bool)+bit_adder sign (carry, x,y) =+      let y' = y `bool_xor` sign in+      let z = carry `bool_xor` x `bool_xor` y' in+      let carry' = majority carry x y' in+      (carry', z)+++{-# LINE 26 "Quipper/Demos/OptimTest.hs" #-}+$( decToCircMonad [d| bit_adder :: Bool -> (Bool,Bool,Bool) -> (Bool,Bool)+                      bit_adder sign (carry, x,y) =+                            let y' = y `bool_xor` sign in+                            let z = carry `bool_xor` x `bool_xor` y' in+                            let carry' = majority carry x y' in+                            (carry', z)+                      +                      + |] ) +{-# LINE 27 "Quipper/Demos/OptimTest.hs" #-}+-- | Multi-bit adder. Add two /n/-bit integers, represented as+-- little-tailian bit lists.++adder :: [Bool] -> [Bool] -> [Bool]+adder f l = +  reverse $ snd $ fold_right_zip (bit_adder False) (False, reverse l, reverse f)+++{-# LINE 33 "Quipper/Demos/OptimTest.hs" #-}+$( decToCircMonad [d| adder :: [Bool] -> [Bool] -> [Bool]+                      adder f l = +                        reverse $ snd $ fold_right_zip (bit_adder False) (False, reverse l, reverse f)+                      +                      + |] ) +{-# LINE 34 "Quipper/Demos/OptimTest.hs" #-}+-- | Wrapper around 'template_adder'.+myAdder :: ([Qubit],[Qubit]) -> Circ [Qubit]+myAdder (x,y) = do+  label (x,y) ("x","y")+  z <- unpack template_adder x y+  label z "z"+  return (z)++main1 :: IO()+main1 = do+  print_generic Preview myAdder (replicate 3 qubit, replicate 3 qubit)++main2 :: IO()+main2 = do+  print_generic Preview (simplify_classical myAdder) (replicate 3 qubit, replicate 3 qubit)++main :: IO()+main = main2++
+ dist/build/ParseNodeRoot/ParseNodeRoot-tmp/Quipper/Demos/ParseNodeRoot.hs view
@@ -0,0 +1,43 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}+{-# LINE 1 "Quipper/Demos/ParseNodeRoot.hs" #-}+import Quipper++import Quipper.Libraries.Qureg++-- | Algorithm 7. The arguments are of the form (/a/, /root/, /even/,+-- /n/). Precondition: /a/ is a quantum register of length at least+-- /n/+1.+parseNodeRoot :: (Qureg, Qubit, Qubit, Int) -> Circ ()+parseNodeRoot (a, root, even, n) = do+  comment_with_label "ENTER: parseNodeRoot" (a, root, even) ("a", "root", "even")+  with_ancilla_reg (n+1) $ \scratch -> do+    for n 1 (-1) $ \index -> do +      with_controls (scratch.!(index) .==. 0 .&&. a.!(index) .==. 1) $ do {+        qnot_at (scratch.!(index - 1))+      }+      with_controls (scratch.!(index) .==. 1) $ do {+        qnot_at (scratch.!(index - 1))+      }+    endfor+    with_controls (scratch.!(0) .==. 0) $ do {+      qnot_at root;+      qnot_at even+    }+    for 1 n 1 $ \index -> do    +      with_controls (scratch.!(index) .==. 1) $ do {+        qnot_at (scratch.!(index - 1))+      }+      with_controls (scratch.!(index) .==. 0 .&&. a.!(index) .==. 1) $ do {+        qnot_at (scratch.!(index-1))+      }+    endfor+  comment_with_label "EXIT: parseNodeRoot" (a, root, even) ("a", "root", "even")+  return ()+      +main = print_generic Preview circuit (qureg_shape (n+1), qubit, qubit) +  where+    circuit (a, root, even) = parseNodeRoot (a, root, even, n)+    n = 4+
+ dist/build/PhaseTest/PhaseTest-tmp/Quipper/Demos/PhaseTest.hs view
@@ -0,0 +1,26 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}+{-# LINE 1 "Quipper/Demos/PhaseTest.hs" #-}+-- $ Test whether the quantum simulator works correctly on a global+-- phase gate.++import Quipper+import Quipper.Libraries.Simulation++-- | This function should compute a Not gate.+testcirc :: Qubit -> Circ Qubit+testcirc a = do+  hadamard_at a+  global_phase 1.0 `controlled` a+  hadamard_at a+  return a+  +main = do+  b <- run_generic_io d testcirc False+  putStrLn ("testcirc False = " ++ show b)+  b <- run_generic_io d testcirc True+  putStrLn ("testcirc True = " ++ show b)+ where+  d :: Double+  d = undefined
+ dist/build/QEC/QEC-tmp/Quipper/Demos/QEC.hs view
@@ -0,0 +1,143 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}+{-# LINE 1 "Quipper/Demos/QEC.hs" #-}++import Quipper++-- import other stuff+import Control.Monad (zipWithM_)++-- ======================================================================+-- ALGORITHM SPECIFIC CODE++{- the test circuit from Alex V. and Benoit's email. It looks like+this:++In Alex's notation: ++  H(a)+  c = meas(a)+  if c then+    X(b)+  else Y(b)++In circuit notation:++ a -H--Meas===x==o==|+              |  |+ b -----------X--Y----++In QPL notation: +-} ++testcircuit :: (Qubit, Qubit) -> Circ Qubit+testcircuit (a,b) = do+  hadamard a+  c <- measure a+  with_controls (c .==. 1) $ do {+    gate_X_at b+  }+  with_controls (c .==. 0) $ do {+    gate_Y_at b+  }+  cdiscard c+  return b++-- Let's see if we can implement some parts of the Steane+-- code. Working from Alex V.'s notes.+++-- prepare the logical |+〉 state for the Steane code. This returns a list+-- of 7 qubits+plusState :: Circ [Qubit]+plusState = do+  -- prepare (a...g) in the state "00+0+++"+  [a,b,c,d,e,f,g] <- qinit_of_string "00+0+++"++  qnot_at a `controlled` c .==. 1+  qnot_at d `controlled` f .==. 1+  qnot_at b `controlled` g .==. 1+  qnot_at a `controlled` e .==. 1+  qnot_at d `controlled` g .==. 1+  qnot_at b `controlled` f .==. 1+  qnot_at a `controlled` g .==. 1+  qnot_at b `controlled` c .==. 1+  qnot_at d `controlled` e .==. 1+  +  return [a,b,c,d,e,f,g]++-- prepare the logical |0〉 state for the Steane code+zeroState :: Circ [Qubit]+zeroState = do+  -- prepare (a...g) in the state "00+0+++"+  [a,b,c,d,e,f,g] <- qinit_of_string "++0+000"++  qnot_at c `controlled` a .==. 1+  qnot_at f `controlled` d .==. 1+  qnot_at g `controlled` b .==. 1+  qnot_at e `controlled` a .==. 1+  qnot_at g `controlled` d .==. 1+  qnot_at f `controlled` b .==. 1+  qnot_at g `controlled` a .==. 1+  qnot_at c `controlled` b .==. 1+  qnot_at e `controlled` d .==. 1+  +  return [a,b,c,d,e,f,g]++preparePlus :: Circ ([Qubit], Bit)+preparePlus = do+  qs <- plusState+  vs <- plusState+  zipWithM_ (\q v -> qnot_at q `controlled` v .==. 1) qs vs+  measure <- mapM measure vs+  result <- cgate_and measure+  mapM_ cdiscard measure+  return (qs, result)++{-+-- this function operates on a 7-tuple of qubits, which are inputs and+-- outputs. The additional output Bit is 0 when the error correction+-- fails, else 1+preGateCorrection :: (Qubit,Qubit,Qubit,Qubit,Qubit,Qubit,Qubit) -> Bit+preGateCorrection q = do+  result = cinit_bit False+  (a, av, result_a) <- preparePlus []+  with_controls (result_a .==. 1) $ do {+    (b, bv, result_b) <- prepareZero+    with_controls (result_b .==. 1) $ do {+      zRecover(q, a),+      xRecover(q, b),+      cnot result+    }+    with_controls (result_b .==. 0) $ do {+      .....+-}++    +-- ======================================================================+-- main functions (ugly, don't follow an "idiom" yet)++-- this is just a main function to print the circuit+main_testcircuit :: IO()+main_testcircuit =+  print_generic Preview testcircuit (qubit,qubit)++-- this is just a main function to print the circuit+main_plusState :: IO()+main_plusState =+  print_generic Preview plusState++-- this is just a main function to print the circuit+main_zeroState :: IO()+main_zeroState =+  print_generic Preview zeroState+   +-- this is just a main function to print the circuit+main_preparePlus :: IO()+main_preparePlus =+  print_generic Preview preparePlus+   +main = main_preparePlus++
+ dist/build/QFT/QFT-tmp/Quipper/Demos/QFT.hs view
@@ -0,0 +1,9 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}+{-# LINE 1 "Quipper/Demos/QFT.hs" #-}+import Quipper+import Quipper.Libraries.QFT++main :: IO ()+main = print_generic Preview qft_little_endian (replicate 5 qubit)
+ dist/build/QFTAdder/QFTAdder-tmp/Quipper/Demos/QFTAdder.hs view
@@ -0,0 +1,68 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}+{-# LINE 1 "Quipper/Demos/QFTAdder.hs" #-}+import Quipper+import Quipper.Libraries.Arith+import Quipper.Libraries.QFTAdd+import Quipper.Libraries.Simulation+import Quipper.Libraries.Unboxing++import System.Environment++------ Functions for testing the QFTAdd circuit --------++-- | Output a preview of the qft_add_in_place circuit for quantum integers of+-- the given size+print_qft_add :: Int -> IO ()+print_qft_add m = print_generic Preview qft_add_in_place (qdint_shape m) (qdint_shape m)++-- | Simulate the running of the qft_add_in_place circuit for the given IntM inputs+run_qft_add :: IntM -> IntM -> IO (IntM,IntM)+run_qft_add = run_generic_io (undefined :: Double) (unbox qft_add_in_place)++-- | A wrapper around 'run_qft_add' so that it can be used with standard Integer+-- arguments.+test_add :: Integer -> Integer -> IO Integer+test_add a b = if (a < 0) || (b < 0) then error "test_add: negative argument" else+ do+  let m = 2 + ceiling (log (fromInteger (a+b)) / log 2) -- a slight cheat to work out how many qubits to use+  let a' = intm m a+  let b' = intm m b+  (_,ab) <- run_qft_add a' b'+  return (fromIntegral ab)++-- | A datatype for the possible command line arguments+data Args = Usage | One Int | Two Integer Integer ++-- | A function to parse the command line arguments+parseArgs :: [String] -> Args+parseArgs [s1] = case reads s1 of+  [(x1,_)] -> One x1+  _ -> Usage+parseArgs [s1,s2] = case (reads s1,reads s2) of+  ([(x1,_)],[(x2,_)]) -> Two  x1 x2+  _ -> Usage+parseArgs _ = Usage++-- | The main function calls either test_add or print_qft_add depending upon+-- command line arguments.+main ::  IO ()+main = do+  args <- getArgs+  case parseArgs args of+   Usage -> usage+   One x -> print_qft_add x+   Two x1 x2 -> do+     res <- test_add x1 x2+     putStrLn (show x1 ++ " + " ++ show x2 ++ " = " ++ show res)++usage :: IO ()+usage = do+  name <- getProgName+  putStrLn ("usage: " ++ name ++ " num1 <num2>") +  putStrLn "  - one argument:"+  putStrLn "     preview the circuit for quantum integers of that length"+  putStrLn "  - two arguments:"+  putStrLn "     simulate the circuit for adding the two numbers"+  putStrLn "     (note that quantum simulation is not efficient)"
+ dist/build/QRAM/QRAM-tmp/Quipper/Demos/QRAM.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}+{-# LINE 1 "Quipper/Demos/QRAM.hs" #-}++import Quipper+import Quipper.Libraries.Qram+import Quipper.Libraries.Arith++test_qram :: [Qubit] -> QDInt -> Circ ()+test_qram list index = do+  label (list,index) ("list","index")+  with_computed (indexed_access list index) $ \element -> do+    label element "element"+    hadamard_at element+++main :: IO ()+main = print_generic Preview test_qram (replicate 8 qubit) (qdint_shape 3)
+ dist/build/QuantumIfTest/QuantumIfTest-tmp/Quipper/Demos/QuantumIfTest.hs view
@@ -0,0 +1,129 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}+{-# LINE 1 "Quipper/Demos/QuantumIfTest.hs" #-}+import Quipper+import Quipper.Libraries.Simulation+import Quipper.Libraries.QuantumIf++-- ----------------------------------------------------------------------+-- * Testing quantum \"if then else\"++-- | A dummy value of type Double, to feed the type in the simulator+double :: Double+double = undefined++-- | A testing function that displays a circuit that tests the 'if_then_elseQ'+-- statement, and the results of running the circuit on various inputs.+if_test :: IO ()+if_test = do+    print_simple ASCII ifTest2+    print_simple Preview ifTest2+    res0 <- run_generic_io double ifTest2 (False,False,False)+    putStrLn (show res0)+    res1 <- run_generic_io double ifTest2 (False,False,True)+    putStrLn (show res1)+    res2 <- run_generic_io double ifTest2 (False,True,False)+    putStrLn (show res2)+    res3 <- run_generic_io double ifTest2 (False,True,True)+    putStrLn (show res3)+    res4 <- run_generic_io double ifTest2 (True,False,False)+    putStrLn (show res4)+    res5 <- run_generic_io double ifTest2 (True,False,True)+    putStrLn (show res5)+    res6 <- run_generic_io double ifTest2 (True,True,False)+    putStrLn (show res6)+    res7 <- run_generic_io double ifTest2 (True,True,True) +    putStrLn (show res7)++-- | A test of the 'if_then_elseQ' function.+ifTest :: Circ (Qubit,Qubit,Qubit)+ifTest = do+    (q0,q1,q2,q3,q4,q5,q6) <- qinit (False,False,False,False,False,False,False)+    qnot_at q4+    if_then_elseQ (Or (A q0) (And (A q1) (Not (A q2))))+     ( --if q0 | (q1 & !q2)+      qnot_at q4+     )+     (+      if_then_elseQ (And (A q2) (A q3))+      ( --else if+       qnot_at q5 +      )+      ( -- else+        qnot_at q6+      )+     )+    return (q4,q5,q6)   ++-- | Another test of the 'if_then_elseQ' function.+ifTest2 :: (Qubit,Qubit,Qubit) -> Circ (Qubit,Qubit)+ifTest2 (l,p,d) = do+   ctrl <- qinit True+   (x,y) <- qinit (False,False)+   with_controls ctrl +    (+    do +    if_then_elseQ (Or (A l) (And (A p) (Not (A d))))+     ( --if l | (p & !d) +      qnot_at x+     )+     ( -- else+      qnot_at y+     )+    )+   qdiscard (l,p,d)+   qterm True ctrl+   return (x,y)++-- | A simple test of the 'if_then_elseQ' function.+ifTest3 :: Qubit -> Circ (Qubit,Qubit)+ifTest3 q = do+    (q0,q1) <- qinit (False,False)+    if_then_elseQ (A q)+     (+        qnot_at q0+     )+     (+       qnot_at q1+     )+    qdiscard q+    return (q0,q1) ++-- | A small circuit for testing 'if_then_elseQinv' statements.+small_circ :: [Qubit] -> Circ ([Qubit],Qubit,Qubit)+small_circ qs = do+   (q1,q2) <- qinit (False,False)+   tempReg0 <- qinit (replicate (length qs) False)+   tempReg1 <- qinit (replicate (length qs) True)+   let boolean_statement = foldr1 (\x y -> And x y) (map A qs)+   let boolean_statement_out = Not boolean_statement+   if_then_elseQinv boolean_statement+    (+     do+     qnot_at q1+     swap (reverse tempReg0) (reverse qs)+     return ()+    )+    (+     do+     swap tempReg1 qs+     qnot_at q2+    ) boolean_statement_out+   return (qs,q1,q2) ++-- | Display the 'small_circ'.+print_small_circ :: IO ()+print_small_circ = print_generic Preview small_circ (replicate 4 qubit) ++-- | Simulate the 'small_circ'.+test_small_circ :: [Bool] -> IO ()+test_small_circ bs = do+    putStr (show bs ++ " -> ")+    res <- run_generic_io double small_circ bs+    putStrLn (show res)++-- | A main function.+main :: IO ()+main = test_small_circ [True,True,False]+
+ dist/build/Reverse/Reverse-tmp/Quipper/Demos/Reverse.hs view
@@ -0,0 +1,17 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}+{-# LINE 1 "Quipper/Demos/Reverse.hs" #-}+import Quipper++my_circuit :: (Qubit, Qubit) -> Circ (Qubit, Qubit)+my_circuit (a,b) = do+  qnot_at a `controlled` b+  hadamard b `controlled` a+  return (a,b) +  +rev_circuit :: (Qubit, Qubit) -> Circ (Qubit, Qubit)+rev_circuit = reverse_simple my_circuit++main =+  print_simple Preview rev_circuit
+ dist/build/SimpleOracleSimulation/SimpleOracleSimulation-tmp/Quipper/Algorithms/BWT/Alternative.hs view
@@ -0,0 +1,759 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}+{-# LINE 1 "Quipper/Algorithms/BWT/Alternative.hs" #-}+{-# LANGUAGE FlexibleContexts #-}++-- | Alternative implementations for the binary welded tree algorithm.+-- The purpose of these is to experiment with and potentially+-- illustrate a more functional programming style.++module Quipper.Algorithms.BWT.Alternative where++import Quipper++import Quipper.Libraries.Qureg+import Quipper.Libraries.Simulation++import Quipper.Algorithms.BWT.Definitions++-- import other Quipper stuff+import qualified Quipper.Algorithms.BWT.BWT as BWT++import Quipper.Utils.Sampling+import Quipper.Utils.Auxiliary++-- import other stuff+import Control.Monad+import Text.Printf+import Data.Bits (xor)+import Text.Printf++import Data.Map (Map)+import qualified Data.Map as Map+++-- ======================================================================+-- * Oracle abstraction++-- | This is a version of 'BWT.Oracle' that uses 'Qulist' instead of+--   'Qureg'.  An oracle provides the following information: the tree+--   depth /n/, the label length /m/, the number of edge colors /k/,+--   the entrance label /ENTRANCE/, and for each color 0 ≤ /c/ < /k/,+--   a reversible circuit /ORACLE[sub c](a,b,r)/.++data Oracle = Oracle {+    n :: Int,+    m :: Int,+    k :: Int,+    entrance :: Boollist,+    oraclefun :: Int -> (Qulist, Qulist, Qubit) -> Circ ()+}++-- | Convert a "Alternative".'Oracle' into a "BWT".'BWT.Oracle'.+convert_oracle :: Oracle -> BWT.Oracle+convert_oracle Oracle { n=n, m=m, k=k, entrance=e, oraclefun=f1 } =+  BWT.Oracle { BWT.n=n, BWT.m=m, BWT.k=k, BWT.entrance=e, BWT.oraclefun=f2 } +    where +      f2 c (a, b, r) = f1 c (qulist_of_qureg_te a, qulist_of_qureg_te b, r)++-- ======================================================================+-- * Top-level algorithm++-- | Do a quantum random walk on the binary welded tree given by the+-- oracle, for /s/ times steps of length /dt/.  Return a bit list+-- corresponding to the probable exit label.  This is a more+-- functional implementation of 'BWT.qrwbwt' from the module "BWT".+-- +-- Note: This implementation does not rely on the oracle being+-- self-inverse, and therefore only requires that+-- +-- > ORACLE[sub c](a, 0, 0) = (a, v[sub c](a), f[sub c](a)), +-- +-- rather than the more general property +-- +-- > ORACLE[sub c](a, b, r) = (a, b ⊕ v[sub c](a), r ⊕ f[sub c](a)).  +-- +-- This gives us the freedom to build more efficient oracles, where+-- appropriate.+qrwbwt :: Oracle -> Timestep -> Int -> Circ Bitlist+qrwbwt oracle dt s = do+  comment (printf "ENTER: qrwbwt (dt=%.3e, s=%d)" dt s)+  -- Initialize a to the entrance label.+  a <- qinit (entrance oracle)++  -- Run the Hamiltonian /s/ times for time step /dt/.+  replicateM s $ hamiltonian dt oracle a++  -- Measure /a/.+  exit <- measure a+  comment_with_label "EXIT: qrwbwt" exit "exit"+  return exit++-- | Apply one round of the Hamiltonian for time step /dt/ to /a/.+hamiltonian :: Timestep -> Oracle -> Qulist -> Circ ()+hamiltonian dt oracle a = do+  comment_with_label "ENTER: hamiltonian" a "a"+  for 0 ((k oracle)-1) 1 $ \c -> do+    -- for c from 0 to k-1++    -- create ancillas b and r+    with_ancilla_list (length a) $ \b -> do+      with_ancilla $ \r -> do++        -- perform computations+        (oraclefun oracle) c (a,b,r)+        time_step dt (a,b,r)+        reverse_generic_imp ((oraclefun oracle) c) (a,b,r)+        -- "reverse" here is not quite GFI+  comment_with_label "EXIT: hamiltonian" a "a"++-- | Apply the diffusion step to /(a,b,r)/. Here /a/ and /b/ must be+-- of equal length.+time_step :: Timestep -> (Qulist, Qulist, Qubit) -> Circ ()+time_step dt (a,b,r) = do+  comment_with_label "ENTER: time_step" (a,b,r) ("a","b","r")+  with_ancilla $ \h -> do+    basischange (a,b,h)+    controlledExpGate (dt,r,h)+    (reverse_generic_imp basischange) (a,b,h)+  comment_with_label "EXIT: time_step" (a,b,r) ("a","b","r")++-- | Apply the basis change from Figure 3 of \[Childs et al.\] to /a/,+-- /b/, and /h/. Here /a/ and /b/ must be of equal length.+basischange :: (Qulist, Qulist, Qubit) -> Circ ()+basischange (a,b,h) = do+  comment_with_label "ENTER: basischange" (a,b,h) ("a","b","h")+  -- apply W gates+  zipWithM_ gate_W a b+  -- apply doubly-controlled not-gates+  zipWithM_ (dc_not h) a b+  comment_with_label "EXIT: basischange" (a,b,h) ("a","b","h")+    where+      dc_not h x y = qnot_at h `controlled` (x .==. 1 .&&. y .==. 0)+  +-- | Compute the required number of iterations as a function of ε and+-- /dt/.+-- +-- Inputs: /n/ is the tree depth, ε is the desired precision, /dt/ is+-- the simulation time step. Intermediate values: /t/ is the+-- simulation time. Output: /s/, the upper bound on the number of+-- simulation time steps.+-- +-- Note: \[Childs et al\] specifies that /t/ should be chosen+-- uniformly at random within the interval 0 < /t/ ≤ /n/[sup 4]\/2ε.+-- Here, for simplicity, we just use /t/ = ⌊/n/[sup 4]\/2ε⌋. Also note+-- that this function is for information only, as it is not actually+-- used. Users should specify /s/ directly.+compute_steps :: Int -> Double -> Double -> Int+compute_steps n epsilon dt =+  floor (t / dt)+  where+    t = fromIntegral (n * n * n * n) / (2.0 * epsilon)++-- ======================================================================+-- * Oracle implementations++-- ** Blackbox oracle++-- | A blackbox oracle for testing. This just produces a labelled box+-- in place of the actual oracle circuit. The argument is the tree+-- height.+oracle_blackbox :: Int -> Oracle+oracle_blackbox n = +  let m = n+2 in+  Oracle {+    n = n,+    m = m,+    k = 4,+    entrance = boollist_of_int_bh (n+2) 1,+    oraclefun = \c (a, b, r) ->+    do+      named_gate_at ("O(" ++ show c ++ ")") (a ++ b ++ [r])+      return ()+  }++-- ----------------------------------------------------------------------+-- ** A simple \"exponential\" oracle.++-- | This oracle, which works only for the fixed tree height 3, works+-- by explicitly listing all the edges. It serves only to illustrate+-- how the edge information is encoded. Listing all edges explicitly+-- obviously would not scale well to larger graphs.+oracle_simple :: Oracle+oracle_simple =+  let n = 3+      m = 5+      k = 4++      invalid = 0    -- also works correctly for invalid = 31+      invalid_vec = boollist_of_int_bh m invalid++      green = 0+      blue = 1+      red = 2+      black = 3++      edges :: Int -> [(Int, Int)]+      edges 0 = [(1,3), (2,5), (4,8), (6,12), (7,15), (9,17), (10,18),+                 (13,21), (19,25), (22,27), (24,28), (26,29)]+      edges 1 = [(2,4), (3,6), (5,10), (7,14), (8,16), (11,19), (12,20),+                 (17,24), (21,26), (23,27), (25,28), (29,30)]+      edges 2 = [(1,2), (3,7), (4,9), (5,11), (6,13), (14,22), (15,23),+                 (16,24), (18,25), (20,26), (27,29), (28,30)]+      edges 3 = [(8,17), (9,18), (10,19), (11,20), (12,21), (13,22),+                 (14,23), (15,16)]+      edges n = error ("oracle_simple: illegal color: " ++ show n)++      -- apply an (a,n1)-controlled not operation to (v,n2)+      multi_controlled_multi_not :: Int -> (Qulist, Qulist) -> (Int, Int) -> Circ ()+      multi_controlled_multi_not m (a,v) (n1, n2) = do+        let vec1 = boollist_of_int_bh m n1+        let vec2 = boollist_of_int_bh m n2+        bool_controlled_not v vec2 `controlled` a .==. vec1+        return ()++      -- the O_c circuit+      oracle_O :: Int -> (Qulist, Qulist) -> Circ ()+      oracle_O c (a,v) = do+        let e = edges c+        foreach e $ \(n1, n2) -> do+          multi_controlled_multi_not m (a,v) (n1, invalid `xor` n2)+          multi_controlled_multi_not m (a,v) (n2, invalid `xor` n1)++      -- the B_c circuit+      oracle_B :: (Qulist, Qulist) -> Circ ()+      oracle_B (v,b) =+        for 0 (m-1) 1 $ \i -> do+          qnot_at (b !! i) `controlled` (v !! i) .==. 1++      -- the R_c circuit+      oracle_R :: (Qulist, Qubit) -> Circ ()+      oracle_R (v,r) = do+        qnot_at r `controlled` v .==. invalid_vec++      -- the oracle circuit+      oraclefun :: Int -> (Qulist, Qulist, Qubit) -> Circ ()+      oraclefun c (a,b,r) = do+        comment_with_label "ENTER: oracle_simple" (a,b,r) ("a","b","r")+        with_ancilla_init invalid_vec $ \v -> do+          oracle_O c (a,v)+          oracle_B (v,b)+          oracle_R (v,r)+          oracle_O c (a,v)+        comment_with_label "EXIT: oracle_simple" (a,b,r) ("a","b","r")++  in++   -- return the oracle object+   Oracle { n = n,+            m = m,+            k = k,+            entrance = boollist_of_int_bh m 1,+            oraclefun = oraclefun+          }++-- ======================================================================+-- ** Alternate implementations of the \"orthodox\" oracle++-- ----------------------------------------------------------------------+-- *** Classical implementation++-- $ In this section, we first implement the oracle function +-- /v[sub c](a)/ as a classical boolean function. This implementation+-- is just for reference, and attempts to be neither efficient nor+-- quantum. It can, however, be used as a specification to test the +-- actual quantum oracles against. +-- +-- Both the classical circuit implementation (below) and the Template+-- Haskell implementation (in the module "BWT.Template") were derived+-- from this.+-- +-- We start with several auxiliary functions.++-- | The type of nodes: a pair of a tree bit and a node address.+type Node = (Bool, [Bool])++-- | Convert integers to nodes, mainly for testing.+node_of_int :: Int -> Int -> Node+node_of_int m a = node_of_boollist (boollist_of_int_bh m a)++-- | Convert nodes to integers, mainly for testing.+int_of_node :: Node -> Int+int_of_node n = int_of_boollist_unsigned_bh (boollist_of_node n)++-- | Convert a bit vector to a node.+node_of_boollist :: [Bool] -> Node+node_of_boollist (t:a) = (t,a)+node_of_boollist [] = error "node_of_boollist: empty boollist"++-- | Convert a node to a bit vector.+boollist_of_node :: Node -> [Bool]+boollist_of_node (t,a) = t:a++-- | Input a node /a/ and return the parent of /a/. We assume that /a/+-- is not a root or invalid.+parent :: Node -> Node+parent (t, aa) = (t, False : init aa)++-- | Input a node /a/ and return the left or right child of /a/+-- (depending on whether the /childbit/ is 'False' or 'True',+-- respectively). Assumes that /a/ is not a leaf.+childintree :: Node -> Bool -> Node+childintree (t, h:aa) childbit = (t, aa ++ [childbit])+childintree _ _ = error "childintree: invalid node"++-- | @'bit_adder' 'False'@ is a one-bit adder, and @'bit_adder' 'True'@ is+-- a one-bit subtracter (i.e., add the 2's complement of /y/).+bit_adder :: Bool -> (Bool, Bool, Bool) -> (Bool, Bool)+bit_adder sign (carry, x, y) = (carry', z)+  where+    y' = y `bool_xor` sign+    z = carry `bool_xor` x `bool_xor` y'+    carry' = majority carry x y'+    majority a b c = if a==b then a else c++-- | Input an /n/+1-bit leaf node /a/:/aa/ (without the tree bit; /a/+-- is the highest bit and /aa/ is the remaining /n/ bits) and a sign+-- /s/ (where 'True' = negative, 'False' = positive).  Return+-- /a/:(/aa/ + /s/ * /f/). The first input is the /n/-bit welding+-- vector /f/ (a parameter to the oracle). Note that /f/ is a+-- parameter and /s/, /aa/ are inputs.+doweld1 :: Boollist -> Bool -> [Bool] -> [Bool]+doweld1 f s (a:aa) = a : aa' where+  aa' = snd $ fold_right_zip (bit_adder s) (s, aa, f)+doweld1 f s [] = error "doweld1: invalid node"++-- | Input an /n/+1-bit leaf node /a/:/aa/ (without the tree bit), and+-- return /a/:(/aa/ ⊕ /g/). The first input is the /n/-bit welding+-- vector /g/ (a parameter to the oracle).+doweld0 :: Boollist -> [Bool] -> [Bool]+doweld0 g (a:aa) = a : aa' where+  aa' = g `boollist_xor` aa+doweld0 g [] = error "doweld0: invalid node"++-- | Input a leaf node /a/ and return the left or right weld of /a/ in+-- the other tree (depending on whether the /weldbit/ is 'False' or+-- 'True').  Assumes that /a/ is a leaf.+weld :: Boollist -> Boollist -> Node -> Bool -> Node+weld f g (t, aa) weldbit = (not t, bb)+  where+    bb = if weldbit+         then doweld1 g t aa+         else doweld0 f aa++-- | Input a node /a/ and return the left or right child of /a/+-- (depending on whether the /childbit/ is 'False' or 'True'. This+-- works for leaf and non-leaf nodes.+child :: Boollist -> Boollist -> Node -> Bool -> Node+child f g (t, aa) childbit =+  case aa of+    True : _ ->  -- This is a leaf+      weld f g (t, aa) childbit+    False : _ -> -- This is not a leaf+      childintree (t, aa) childbit+    _ -> error "child: invalid node"++-- | Input a node address (without the tree bit) and return the parity+-- of the node level expressed as a boolean either 'False' or+-- 'True'. Leaves have parity 'False', and other levels have+-- alternating parities. In other words: count the number of leading+-- zeros modulo 2.+level_parity :: [Bool] -> Bool+level_parity [] = False+level_parity (h:t) = if h then False else not (level_parity t)++-- | Input a node address (without the tree bit) and return 'True' iff+-- the node address is invalid. In other words, return 'True' iff the+-- list consists of all 0's.+is_zero :: [Bool] -> Bool+is_zero [] = True+is_zero (h:t) = if h then False else is_zero t++-- | Input a node address (without the tree bit) and return 'True' iff+-- the node is a root or invalid. In other words, check whether all+-- digits but the last are 0's.+is_root :: [Bool] -> Bool+is_root [] = True+is_root (h:[]) = True+is_root (h:t) = if h then False else is_root t++-- | @'v_function' f g c a@: returns /v/[sub /c/](/a/), the label of the+-- node connected to /a/ by an edge of color /c/, or 'Nothing' if+-- there is no such node. The parameters /f/ and /g/ encode the+-- welding functions, and are lists of length /n/. /c/ is a color in+-- the range 0..3, and /a/ is an (/n/+2)-bit node label.+v_function :: Boollist -> Boollist -> Int -> Node -> Maybe Node+v_function f g c a =+  let (t,aa) = a+      bc_hi = level_parity aa+      z = is_zero aa+      e = is_root aa+      a1 = if last aa then True else False+      [c_hi, c_lo] = boollist_of_int_bh 2 c+      [cbc_hi, cbc_lo] = [c_hi `bool_xor` bc_hi, c_lo]+  in+   if not e && [cbc_hi, cbc_lo] == [True, a1] then Just(parent a) else+   if not z && cbc_hi == False then Just(child f g a cbc_lo) else+   Nothing++-- ----------------------------------------------------------------------+-- *** Auxiliary functions++-- | The type of nodes: a pair of a tree bit and a node address.+type CNode = (Bit, Bitlist)++-- | Like 'CNode', but uses qubits instead of classical bits.+type QNode = (Qubit, [Qubit])++-- | Convert a 'Qulist' to a 'QNode'.+qnode_of_qulist :: Qulist -> QNode+qnode_of_qulist (t:a) = (t,a)+qnode_of_qulist [] = error "qnode_of_qulist: empty list"++-- | Convert a 'Bitlist' to a 'CNode'.+cnode_of_bitlist :: Bitlist -> CNode+cnode_of_bitlist (t:a) = (t,a)+cnode_of_bitlist [] = error "cnode_of_bitlist: empty list"++-- | Exclusive or operation on bit vectors.+cboollist_xor :: Bitlist -> Bitlist -> Circ Bitlist+cboollist_xor = zipWithM (\x y -> cgate_xor [x,y])++-- ----------------------------------------------------------------------+-- *** Classical circuit implementation++-- $ We now implement the oracle function v[sub c](a) as a classical+-- circuit, with /c/ as a parameter. We don't try to be clever or+-- efficient yet.  The implementation follows the \"classical+-- implementation\" above, but must be reformulated due to the need to+-- work within the 'Circ' monad.++-- | Input a node /a/ and return the parent of /a/. We assume that /a/+-- is not a root or invalid.+cparent :: CNode -> Circ CNode+cparent (t, aa_in) = do+  comment_with_label "ENTER: cparent" (t, aa_in) ("t", "aa_in")+  false <- cinit False+  let aa_out = false : init aa_in+  comment_with_label "EXIT: cparent" (t, aa_out) ("t", "aa_out")+  return (t, aa_out)++-- | Input a node /a/ and return the left or right child of /a/+-- (depending on whether the /childbit/ is 'False' or 'True',+-- respectively). Assumes that /a/ is not a leaf.+cchildintree :: CNode -> Bit -> Circ CNode+cchildintree (t, node_in@(h:aa)) childbit = do+  comment_with_label "ENTER: cchildintree" (t, node_in) ("t", "node_in")+  let node_out = aa ++ [childbit]+  comment_with_label "EXIT: cchildintree" (t, node_out) ("t", "node_out")+  return (t, node_out)+cchildintree _ _ = error "cchildintree: invalid node"++-- | @'bit_adder' 'False'@ is a one-bit adder, and @'bit_adder' 'True'@ is+-- a one-bit subtracter (i.e., add the 2's complement of /y/).+cbit_adder :: Bit -> (Bit, Bit, Bit) -> Circ (Bit, Bit)+cbit_adder sign (carry_in, x, y) = do+    comment_with_label "ENTER: cbit_adder" (sign, carry_in, x, y) ("sign", "carry_in", "x", "y")+    y' <- cgate_xor [y, sign]+    z <- cgate_xor [carry_in, x, y']+    carry_out <- cmajority carry_in x y'+    comment_with_label "EXIT: cbit_adder" (carry_out, z) ("carry_out", "z")+    return (carry_out, z)+  where+    cmajority a b c = do+      cond <- cgate_eq a b+      cgate_if cond a c++-- | Input an /n/+1-bit leaf node /a/:/aa/ (without the tree bit; /a/+-- is the highest bit and /aa/ is the remaining /n/ bits) and a sign+-- /s/ (where 'True' = negative, 'False' = positive).  Return+-- /a/:(/aa/ + /s/ * /f/). The first input is the /n/-bit welding+-- vector /f/ (a parameter to the oracle). Note that /f/ is a+-- parameter and /s/, /aa/ are inputs.+cdoweld1 :: Boollist -> Bit -> Bitlist -> Circ Bitlist+cdoweld1 f s node_in@(a:aa) = do+  comment_with_label "ENTER: cdoweld1" (s, node_in) ("s", "node_in")+  f' <- cinit f+  (_,aa') <- fold_right_zipM (cbit_adder s) (s, aa, f')+  let node_out = a : aa'+  comment_with_label "EXIT: cdoweld1" node_out "node_out"+  return node_out+cdoweld1 f s [] = error "cdoweld1: invalid node"++-- | Input an /n/+1-bit leaf node /a/:/aa/ (without the tree bit), and+-- return /a/:(/aa/ ⊕ /g/). The first input is the /n/-bit welding+-- vector /g/ (a parameter to the oracle).+cdoweld0 :: Boollist -> Bitlist -> Circ Bitlist+cdoweld0 g node_in@(a:aa) = do+  comment_with_label "ENTER: cdoweld0" node_in "node_in"+  g' <- cinit g+  aa' <- g' `cboollist_xor` aa+  let node_out = a:aa'+  comment_with_label "EXIT: cdoweld0" node_out "node_out"+  return node_out+cdoweld0 g [] = error "cdoweld0: invalid node"++-- | Input a leaf node /a/ and return the left or right weld of /a/ in+-- the other tree (depending on whether the /weldbit/ is 'False' or+-- 'True').  Assumes that /a/ is a leaf.+cweld :: Boollist -> Boollist -> CNode -> Bit -> Circ CNode+cweld f g node_in@(t, aa) weldbit = do+  comment_with_label "ENTER: cweld" (node_in, weldbit) ("node_in", "weldbit")+  bb <- circ_if weldbit (+    cdoweld1 g t aa+    )(+    cdoweld0 f aa+    )+  t' <- cgate_not t+  let node_out = (t', bb)+  comment_with_label "EXIT: cweld" node_out "node_out"+  return node_out++-- | Input a node /a/ and return the left or right child of /a/+-- (depending on whether the /childbit/ is 'False' or 'True'. This+-- works for leaf and non-leaf nodes.+cchild :: Boollist -> Boollist -> CNode -> Bit -> Circ CNode+cchild f g node_in@(t, a:aa) childbit = do+  comment_with_label "ENTER: cchild" (node_in, childbit) ("node_in", "childbit")+  node_out <- circ_if a (+    -- This is a leaf+    cweld f g (t, a:aa) childbit+    )(            +    -- This is not a leaf+    cchildintree (t, a:aa) childbit+    )+  comment_with_label "EXIT: cchild" node_out "node_out"+  return node_out++cchild f g (t, _) childbit = +  error "cchild: invalid node"++-- | Input a node address (without the tree bit) and return the parity+-- of the node level expressed as a boolean either 'False' or+-- 'True'. Leaves have parity 'False', and other levels have+-- alternating parities. In other words: count the number of leading+-- zeros modulo 2.+clevel_parity :: Bitlist -> Circ Bit+clevel_parity node = do+  comment_with_label "ENTER: clevel_parity" node "node"+  parity <- clevel_parity_rec node+  comment_with_label "EXIT: clevel_parity" parity "parity"+  return parity++  where+    clevel_parity_rec :: Bitlist -> Circ Bit+    clevel_parity_rec [] = cinit False+    clevel_parity_rec (h:t) = do+      r <- clevel_parity_rec t+      circ_if h (+        cinit False+        )(+        cgate_not r+        )++-- | Input a node address (without the tree bit) and return 'True' iff+-- the node address is invalid. In other words, return 'True' iff the+-- list consists of all 0's.+cis_zero :: Bitlist -> Circ Bit+cis_zero node = do+  comment_with_label "ENTER: cis_zero" node "node"+  is_zero <- cis_zero_rec node+  comment_with_label "EXIT: cis_zero" is_zero "is_zero"+  return is_zero+  +  where+    cis_zero_rec :: Bitlist -> Circ Bit+    cis_zero_rec [] = cinit True+    cis_zero_rec (h:t) = do+      circ_if h (+        cinit False+        )(+        cis_zero_rec t+        )++-- | Input a node address (without the tree bit) and return 'True' iff+-- the node is a root or invalid. In other words, check whether all+-- digits but the last are 0's.+cis_root :: Bitlist -> Circ Bit+cis_root node = do+  comment_with_label "ENTER: cis_root" node "node"+  is_root <- cis_root_rec node+  comment_with_label "EXIT: cis_root" is_root "is_root"+  return is_root++  where+    cis_root_rec :: Bitlist -> Circ Bit+    cis_root_rec [] = cinit True+    cis_root_rec (h:[]) = cinit True+    cis_root_rec (h:t) = do+      circ_if h (+        cinit False+        )(+        cis_root_rec t+        )++-- | @'cv_function' f g c a@: returns /v/[sub /c/](/a/), the label of the+-- node connected to /a/ by an edge of color /c/, or 'Nothing' if+-- there is no such node. The parameters /f/ and /g/ encode the+-- welding functions, and are lists of length /n/. /c/ is a color in+-- the range 0..3, and /a/ is an (/n/+2)-bit node label.+-- +-- We currently implement @'Maybe' 'CNode'@ as an indexed union, and+-- specifically as @('CNode','Bit')@. When /Bit/='True', the value of+-- 'CNode' is undefined (doesn't matter); in particular, this value+-- may contain garbage.+cv_function :: Boollist -> Boollist -> Int -> CNode -> Circ (CNode,Bit)+cv_function f g color a = do+  comment_with_label (printf "ENTER: cv_function (color=%d)" color) a "a"+  let (t,aa) = a+  bc_hi <- clevel_parity aa+  z <- cis_zero aa+  e <- cis_root aa+  let a1 = last aa+  let [c_hi', c_lo'] = boollist_of_int_bh 2 color+  c_hi <- cinit c_hi'+  c_lo <- cinit c_lo'+  cbc_hi <- cgate_xor [c_hi, bc_hi]+  let cbc_lo = c_lo+  not_e <- cgate_not e+  cbc_lo_eq_a1 <- cgate_eq cbc_lo a1+  cond1 <- cgate_and [not_e, cbc_hi, cbc_lo_eq_a1]+  (b, invalid) <- circ_if cond1 (+    do +      cparent_a <- cparent a+      false <- cinit False+      return (cparent_a, false)+    )(+    do+      cchild_a_cbc_lo <- cchild f g a cbc_lo+      not_z <- cgate_not z+      cbc_hi_eq_false <- cgate_not cbc_hi+      valid <- cgate_and [not_z, cbc_hi_eq_false]+      not_valid <- cgate_not valid+      -- a slight optimization here: we return garbage in the+      -- first register if not_valid == True+      return (cchild_a_cbc_lo, not_valid)+    )+  comment_with_label (printf "EXIT: cv_function (color=%d)" color) (b, invalid) ("b", "invalid")+  return (b, invalid)++-- ======================================================================+-- *** Oracle abstraction++-- | The classical oracle implementation, packaged into the 'Oracle'+-- abstraction. This oracle has two parameters, namely the welding+-- vectors /f/ and /g/. Note: this oracle has not been optimized+-- whatsoever.+oracle_classical :: Boollist -> Boollist -> Oracle+oracle_classical f g =+  Oracle { n = n,+           m = m,+           k = k,+           entrance = entrance,+           oraclefun = oraclefun+         } where+    n = length f+    m = n+2+    k = 4+    entrance = boollist_of_int_bh m 1+      +    oraclefun :: Int -> (Qulist, Qulist, Qubit) -> Circ ()+    oraclefun color (a,b,r) = do+      let an = qnode_of_qulist a+      let bn = qnode_of_qulist b+      (classical_to_quantum . classical_to_reversible) (cv_function f g color) (an, (bn, r))+      return ()+      +-- ======================================================================+-- * Testing functions++-- | Output the list of colored edges as computed by the classical+-- 'v_function', for some arbitrary choice of /f/ and /g/ and /n/=3.+main_edges1 :: IO()+main_edges1 = mapM_ output (sample_all0 (127,3))+  where+    f = take 5 (True : False : f)    +    g = take 5 (False : True : g)+    +    output :: (Int,Int) -> IO()+    output (a,c) =+      case v_function f g c (node_of_int 7 a) of+        Nothing -> printf "%d ---%d---> None\n" a c+        Just b -> printf "%d ---%d---> %d\n" a c (int_of_node b)++-- | For debugging: 'circfun' is similar to 'v_function', except it+-- works by calling 'cv_function' to assemble the circuit, then+-- simulates it. This is for testing whether the assembled circuit is+-- correct. Returns @('Bool', 'Node')@ instead of @'Maybe' 'Node'@, so+-- that we can see any garbage that is output in case of an invalid+-- node.+circfun :: Boollist -> Boollist -> Int -> Node -> (Node, Bool)+circfun f g color nd = +  run_classical_generic (cv_function f g color) nd++-- | Output the list of colored edges as computed by simulating the+-- circuit 'cv_function', for some arbitrary choice of /f/ and /g/ and+-- /n/=3. This is like 'main_edges1', except it actually assembles and+-- simulates the classical circuit.+main_edges2 :: IO()+main_edges2 = mapM_ output (sample_all0 (127,3))+  where+    f = take 5 (True : False : f)    +    g = take 5 (False : True : g)+    output :: (Int,Int) -> IO()+    output (a,c) =+      case circfun f g c (node_of_int 7 a) of+        (node, False) -> printf "%d ---%d---> %d\n" a c (int_of_node node)+        (garbage, True) -> printf "%d ---%d---> None (%d)\n" a c (int_of_node garbage)+    +-- | Graphically output the classical oracle circuit for color /c/,+-- using /n/ from the oracle data structure, and for some arbitrary+-- /f/ and /g/.+main_oraclec :: Format -> BWT.Oracle -> Int -> IO()+main_oraclec format oracle color =+  print_generic format circuit cnode_shape+    where+      m' = BWT.m oracle+      n' = BWT.n oracle+      f = take n' (True : False : f)+      g = take n' (False : True : g)+      cnode_shape = cnode_of_bitlist (replicate m' bit)+      circuit n = cv_function f g color n++-- | Like 'main_oraclec', except it rewrites the classical circuit in+-- terms of Toffoli gates.+main_oracle2 :: Format -> BWT.Oracle -> Int -> IO()+main_oracle2 format oracle color =+  print_generic format circuit cnode_shape+    where+      m' = BWT.m oracle+      n' = BWT.n oracle+      f = take n' (True : False : f)+      g = take n' (False : True : g)+      cnode_shape = cnode_of_bitlist (replicate m' bit)+      circuit n = classical_to_cnot (cv_function f g color n)++-- | Like 'main_oraclec', except it makes the classical circuit+-- reversible first.+main_oracle3 :: Format -> BWT.Oracle -> Int -> IO()+main_oracle3 format oracle color =+  print_generic format circuit (cnode_shape, (cnode_shape, qubit))+    where+      m' = BWT.m oracle+      n' = BWT.n oracle+      f = take n' (True : False : f)+      g = take n' (False : True : g)+      cnode_shape = qnode_of_qulist (replicate m' qubit)+      circuit = (classical_to_quantum . classical_to_reversible) (cv_function f g color)++-- | Output the top-level circuit for the binary welded tree algorithm+-- with the classical oracle, using some arbitrary welding vectors /f/+-- and /g/, and /s/=1.+main_qrwbwt :: IO()+main_qrwbwt =+   print_simple EPS (qrwbwt (oracle_classical f g) dt 1)+     where +       f = [False, False, True]+       g = [True, False, True]+       dt = pi/180
+ dist/build/SimpleOracleSimulation/SimpleOracleSimulation-tmp/Quipper/Algorithms/BWT/BWT.hs view
@@ -0,0 +1,604 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}+{-# LINE 1 "Quipper/Algorithms/BWT/BWT.hs" #-}+-- | This module provides an implementation of the main binary welded+-- tree algorithm and oracle, using a more-or-less imperative+-- programming style. We abstract the oracle into a data type, so that+-- different oracles can be plugged into the main algorithm.++module Quipper.Algorithms.BWT.BWT where++-- import other Quipper stuff+import Quipper+import Quipper.Algorithms.BWT.Definitions++import Quipper.Libraries.Qureg+import Quipper.Libraries.Decompose++import Quipper.Utils.Auxiliary++import Text.Printf++-- ======================================================================+-- * Oracle abstraction++-- | A data structure to hold an oracle. The binary welded tree+-- algorithm is parametric on an oracle. An oracle encodes a graph,+-- and provides the following information: the tree depth /n/ (in the+-- above example: 3), the label length /m/ (in bits; 5 in the above+-- example), the number of edge colors /k/, the entrance label+-- /ENTRANCE/, and for each color 0 ≤ /c/ < /k/, a reversible circuit+-- /ORACLE/[sub /c/](/a/,/b/,/r/). On basis vectors, this circuit+-- encodes the edge information in the following sense:+-- +-- > ORACLE[sub c](a, b, r) = (a, b ⊕ v[sub c](a), r ⊕ f[sub c](a)),+-- +-- where /f/[sub /c/](/a/) is 1 if the node /a/ is connected to an+-- edge of color /c/, and 0 otherwise; and /v/[sub /c/](a) is the+-- node label connected to node /a/ along an edge of color /c/ (if+-- any), and arbitrary otherwise. +-- +-- Not all available node labels need to be used (for example, 0 and+-- 16 are unused in the graph in the above illustration).++data Oracle = Oracle {+    n :: Int,+    m :: Int,+    k :: Int,+    entrance :: Boollist,+    oraclefun :: Int -> (Qureg, Qureg, Qubit) -> Circ ()+}++-- ======================================================================+-- * Top-level algorithm++-- | The main loop of the binary welded tree algorithm. +-- +-- @qrwbwt oracle s dt@: Do a quantum random walk on the binary welded+-- tree given by the oracle /oracle/, for /s/ times steps of length+-- /dt/. Returns a bit list corresponding to the computed exit node+-- label.++qrwbwt :: Oracle -> Int -> Timestep -> Circ [Bit]+qrwbwt oracle s dt = do+  comment (printf "ENTER: qrwbwt (s=%d, dt=%.3e)" s dt)+  -- initialize a to the entrance label+  a <- qinit_register (entrance oracle)+  with_ancilla_reg (m oracle) $ \b -> do+    with_ancilla $ \r -> do+      loopM_boxed_if (s > 1) "qrwbwt_loop" s (a,b,r) $ \(a,b,r) -> do+        for 0 (k oracle-1) 1 $ \c -> do+          (oraclefun oracle) c (a, b, r)+          timestep (a, b, r, dt, m oracle)+          (oraclefun oracle) c (a, b, r)+        endfor+        return (a,b,r)+      endfor+  exit <- qmeasure_register a+  comment_with_label "EXIT: qrwbwt" exit "exit"+  return exit++-- | @timestep (a, b, r, dt, m)@: Perform a single time step /dt/ of+-- the quantum walk. This is done by iterating through each of the+-- available edge colors, and performing a diffusion step for each+-- color. Here, /a/ is an /m/-qubit registers holding (a superposition+-- of) the current node label. /b/ is an /m/-qubit ancilla register,+-- and /r/ is an ancilla qubit. Both /b/ and /r/ are expected to be+-- initialized to |0〉 by the caller, and will be returned in state+-- |0〉.+timestep :: (Qureg, Qureg, Qubit, Timestep, Int) -> Circ ()+timestep (a, b, r, dt, m) = do+  comment_with_label "ENTER: timestep" (a,b,r) ("a","b","r")+  with_ancilla $ \h -> do+    for 0 (m-1) 1 $ \i -> do+      wGate (a.!(i), b.!(i))+    endfor+    for 0 (m-1) 1 $ \i -> do+      toffoliGate (a.!(i), b.!(i), h)+    endfor+    controlledExpGate (dt, r, h)+    for (m-1) 0 (-1) $ \i -> do+      toffoliGate (a.!(i), b.!(i), h)+    endfor+    for (m-1) 0 (-1) $ \i -> do+      wGateInverse (a.!(i), b.!(i))+    endfor+  comment_with_label "EXIT: timestep" (a,b,r) ("a","b","r")+  return ()++-- ======================================================================+-- * Oracle implementation++-- $ The functions in this section implement a particular oracle for a+-- binary welded tree. The oracle is parametric on:+-- +-- * the tree depth /n/;+-- +-- * two \"welding vectors\" /f/ and /g/, specifying how the leaves of+-- the two binary trees are connected to each other. Specifically, /f/+-- and /g/ encode the permutations of leaves given by a ↦ a ⊕ f and +-- a ↦ a + g, respectively, where \"⊕\" denotes bitwise exclusive or,+-- and \"+\" denotes binary addition.++-- ----------------------------------------------------------------------+-- ** Oracle subroutines++-- | The top-level oracle circuit. The arguments are of the form (/a/,+-- /b/, /r/, /color/, /f/, /g/, /n/), where /a/, /b/ are quantum+-- registers of length /n/+2, /color/ is a boolean register of length+-- 2, and /f/ and /g/ are boolean registers of length /n/.+oracle :: (Qureg, Qureg, Qubit, Boolreg, Boolreg, Boolreg, Int) -> Circ ()+oracle (a, b, r, color, f, g, n) = do+  let c = int_of_boolreg_unsigned_le color :: Int+  comment_with_label (printf "ENTER: oracle (color=%d)" c) (a,b,r) ("a","b","r")+  with_ancilla $ \root -> do+    with_ancilla $ \even -> do+      with_ancilla $ \isparent -> do+        with_ancilla $ \ischild -> do+          with_ancilla $ \direction -> do+            with_ancilla $ \ismatch -> do+              parseNodeRoot (a, root, even, n)+              parseNodeEven (a, even, n)+              testIsParent (a, root, even, isparent, color, n, 1, ismatch)+              testIsChild (even, ischild, direction, color, n)+              setParent (a, b, isparent, n)+              setChild (a, b, ischild, direction, f, g, n)+              with_controls (isparent .==. 0 .&&. ischild .==. 0) $ do {+                qnot_at r+              }+              testIsChild (even, ischild, direction, color, n)+              testIsParent (a, root, even, isparent, color, n, 0, ismatch)+              parseNodeEven (a, even, n)+              parseNodeRoot (a, root, even, n)+  comment_with_label (printf "EXIT: oracle (color=%d)" c) (a,b,r) ("a","b","r")+  return ()++-- | Input a node label /a/ of length at least /n/+1. Negate both+-- /root/ and /even/ if /a/ is a root node.+parseNodeRoot :: (Qureg, Qubit, Qubit, Int) -> Circ ()+parseNodeRoot (a, root, even, n) = do+  comment_with_label "ENTER: parseNodeRoot" (a, root, even) ("a", "root", "even")+  with_ancilla_reg (n+1) $ \scratch -> do+    for n 1 (-1) $ \index -> do +      with_controls (scratch.!(index) .==. 0 .&&. a.!(index) .==. 1) $ do {+        qnot_at (scratch.!(index - 1))+      }+      with_controls (scratch.!(index) .==. 1) $ do {+        qnot_at (scratch.!(index - 1))+      }+    endfor+    with_controls (scratch.!(0) .==. 0) $ do {+      qnot_at root;+      qnot_at even+    }+    for 1 n 1 $ \index -> do    +      with_controls (scratch.!(index) .==. 1) $ do {+        qnot_at (scratch.!(index - 1))+      }+      with_controls (scratch.!(index) .==. 0 .&&. a.!(index) .==. 1) $ do {+        qnot_at (scratch.!(index-1))+      }+    endfor+  comment_with_label "EXIT: parseNodeRoot" (a, root, even) ("a", "root", "even")+  return ()+      +-- | Input a node label /a/ of length at least /n/+1. Negate /even/+-- if the node /a/ occurs at an even height in the tree.+parseNodeEven :: (Qureg, Qubit, Int) -> Circ ()+parseNodeEven (a, even, n) = do+  comment_with_label "ENTER: parseNodeEven" (a, even) ("a", "even")+  with_ancilla_reg (n+1) $ \scratch -> do+    for n 1 (-1) $ \index -> do+      with_controls (scratch.!(n) .==. 0 .&&. a.!(index) .==. 1) $ do {+        qnot_at (scratch.!(index-1));+        with_controls (Prelude.even index) $ do {+          qnot_at even+        }+      }+      with_controls (scratch.!(index-1) .==. 1) $ do {+        qnot_at (scratch.!(n))+      }+    endfor+    for 1 n 1 $ \index -> do+      with_controls (scratch.!(index-1) .==. 1) $ do {+        qnot_at (scratch.!(n))+      }            +      with_controls (scratch.!(n) .==. 0 .&&. a.!(index) .==. 1) $ do {+        qnot_at (scratch.!(index-1))+      }+    endfor+  comment_with_label "EXIT: parseNodeEven" (a, even) ("a", "even")+  return ()++-- | Input a node label /a/ of length at least 1, and flags /root/+-- and /even/ describing whether /a/ is a root and at an even level,+-- respectively. Negate /isparent/ if /a/ has a parent of color+-- /color/ in the tree. +-- +-- The qubit /ismatch/ is an ancilla, and /really/ is either 0 or+-- 1. They are jointly used to control uncomputation, so that the+-- following sequence will compute and then uncompute 'testIsParent':+-- +-- > ismatch <- qinit 0+-- > testIsParent (a, root, even, isparent, color, n, 1, ismatch)+-- > testIsParent (a, root, even, isparent, color, n, 0, ismatch)+-- > qterm 0 ismatch+testIsParent :: (Qureg, Qubit, Qubit, Qubit, Boolreg, Int, Int, Qubit) -> Circ ()+testIsParent (a, root, even, isparent, color, n, really, ismatch) = do+    let c = int_of_boolreg_unsigned_le color :: Int+    comment_with_label (printf "ENTER: testIsParent (color=%d really=%d)" c really) (a, root, even, isparent, ismatch) ("a", "root", "even", "isparent", "ismatch")+    with_controls (really == 0) $ do {+      with_controls (root .==. 0 .&&. ismatch .==. 1) $ do {+        qnot_at isparent+      }+    }+    if color.!(1) == 1+      then+        if color.!(0) == 1 then+          with_controls (even .==. 1 .&&. a.!(0) .==. 1) $ do {+            qnot_at ismatch+          }+        else+          with_controls (even .==. 1 .&&. a.!(0) .==. 0) $ do {+            qnot_at ismatch+          }+      else+        if color.!(0) == 1 then+          with_controls (even .==. 0 .&&. a.!(0) .==. 1) $ do {+            qnot_at isparent+          }+        else+          with_controls (even .==. 0 .&&. a.!(0) .==. 0) $ do {+            qnot_at isparent+          }+    with_controls (root .==. 0 .&&. ismatch .==. 1) $ do {+      qnot_at isparent+    }+    comment_with_label (printf "EXIT: testIsParent (color=%d really=%d)" c really) (a, root, even, isparent, ismatch) ("a", "root", "even", "isparent", "ismatch")+    return ()++-- | Consider a node /a/, and negate /ischild/ if /a/ has a child+-- node of color /color/. Also set /direction/ to indicate whether+-- it is a \"left\" or \"right\" child. Here, /color/ is a boolean+-- register of length 2, representing a color. This function is+-- self-inverse.+testIsChild :: (Qubit, Qubit, Qubit, Boolreg, Int) -> Circ ()+testIsChild (even, ischild, direction, color, n) = do+  comment_with_label "ENTER: testIsChild" (even, ischild, direction) ("even", "ischild", "direction")+  if color.!(1) == 1+    then+      with_controls (even .==. 0) $ do {+        qnot_at ischild+      }+    else+      with_controls (even .==. 1) $ do {+        qnot_at ischild+      }+  with_controls (color.!(0) == 1) $ do {+    qnot_at direction+  }+  comment_with_label "EXIT: testIsChild" (even, ischild, direction) ("even", "ischild", "direction")+  return ()++-- | Input a node label /a/ of length at least /n/+2, and a flag+-- /isparent/ that has been initialized accordingly. Also input a+-- register /b/ of length at least /n/+2, initialized to |0〉.  If+-- /isparent/ is set, set /b/ to the node label of the parent of+-- /a/. This is self-inverse.+setParent :: (Qureg, Qureg, Qubit, Int) -> Circ ()+setParent (a, b, isparent, n) = do+  comment_with_label "ENTER: setParent" (a, b, isparent) ("a", "b", "isparent")+  for 0 (n-1) 1 $ \index -> do+    with_controls (isparent .==. 1 .&&. a.!(index+1) .==. 1) $ do {+      qnot_at (b.!(index))+    }+  endfor+  with_controls (isparent .==. 1 .&&. a.!(n+1) .==. 1) $ do {+    qnot_at (b.!(n+1))+  }+  comment_with_label "EXIT: setParent" (a, b, isparent) ("a", "b", "isparent")+  return ()++-- | Similar to 'setParent', but set /b/ to the node label of the+-- indicated child of /a/. Here /a/ and /b/ are quantum registers of+-- length at least /n/+2, and /f/ and /g/ are boolean registers of+-- length /n/.+setChild :: (Qureg, Qureg, Qubit, Qubit, Boolreg, Boolreg, Int) -> Circ ()+setChild (a, b, ischild, direction, f, g, n) = do+  comment_with_label "ENTER: setChild" (a, b, ischild, direction) ("a", "b", "ischild", "direction")+  with_ancilla $ \childctrl -> do+    with_controls (ischild .==. 1 .&&. a.!(n) .==. 1) $ do {+      qnot_at childctrl+    }+    setWeld (a, b, childctrl, direction, f, g, n)+    with_controls (ischild .==. 1) $ do {+      qnot_at childctrl+    }+    setChildInTree (a, b, childctrl, direction, n)+    with_controls (ischild .==. 1 .&&. a.!(n) .==. 0) $ do {+      qnot_at childctrl+    }+  comment_with_label "EXIT: setChild" (a, b, ischild, direction) ("a", "b", "ischild", "direction")+  return ()+      +-- | A special case of 'setChild', where the child is inside the same+-- binary tree (i.e., not via the welding). +setChildInTree :: (Qureg, Qureg, Qubit, Qubit, Int) -> Circ ()+setChildInTree (a, b, childctrl, direction, n) = do+  comment_with_label "ENTER: setChildInTree" (a, b, childctrl, direction) ("a", "b", "childctrl", "direction")+  with_controls (childctrl .==. 1 .&&. direction .==. 1) $ do {+    qnot_at (b.!(0))+  }+  for 1 n 1 $ \index -> do+    with_controls (childctrl .==. 1 .&&. a.!(index-1) .==. 1) $ do {+      qnot_at (b.!(index))+    }+  endfor+  with_controls (childctrl .==. 1 .&&. a.!(n+1) .==. 1) $ do {+    qnot_at (b.!(n+1))+  }+  comment_with_label "EXIT: setChildInTree" (a, b, childctrl, direction) ("a", "b", "childctrl", "direction")+  return ()++-- | A special case of 'setChild', where the child is in the opposite+-- binary tree, i.e., we follow one of the welding edges.+setWeld :: (Qureg, Qureg, Qubit, Qubit, Boolreg, Boolreg, Int) -> Circ ()+setWeld (a, b, childctrl, direction, f, g, n) = do+  comment_with_label "ENTER: setWeld" (a, b, childctrl, direction) ("a", "b", "childctrl", "direction")+  with_ancilla $ \weldctrl -> do+    with_controls (childctrl .==. 1 .&&. direction .==. 0) $ do {+      qnot_at weldctrl+    }+    doWeld0 (a, b, weldctrl, f, n)+    with_controls (childctrl .==. 1) $ do {+      qnot_at weldctrl+    }+    doWeld1 (a, b, weldctrl, g, n)+    with_controls (childctrl .==. 1 .&&. direction .==. 1) $ do {+      qnot_at weldctrl+    }+    with_controls (childctrl .==. 1 .&&. a.!(n+1) .==. 1) $ do {+      qnot_at (b.!(n+1))+    }+    with_controls (childctrl .==. 1) $ do {+      qnot_at (b.!(n));+      qnot_at (b.!(n+1))+    }+  comment_with_label "EXIT: setWeld" (a, b, childctrl, direction) ("a", "b", "childctrl", "direction")+  return ()++-- | Input a node label /a/, and a register /b/ initialized to+-- |0〉. If /weldctrl/ is set, set /b/ to the node connected to /a/+-- by the welding function /f/. This is self-inverse. Here, /a/ and+-- /b/ are quantum registers of length at least /n/+2, and /f/ is a+-- boolean register of length /n/.+doWeld1 :: (Qureg, Qureg, Qubit, Boolreg, Int) -> Circ ()+doWeld1 (a, b, weldctrl, g, n) = do+  comment_with_label "ENTER: doWeld1" (a, b, weldctrl) ("a", "b", "weldctrl")+  with_ancilla $ \addsub -> do+    with_controls (weldctrl .==. 1 .&&. a.!(n+1) .==. 0) $ do {+      qnot_at addsub+    }+    cAddNum (addsub, b, a, g, n)+    with_controls (weldctrl .==. 1) $ do {+      qnot_at addsub+    }+    cSubNum (addsub, b, a, g, n)+    with_controls (weldctrl .==. 1 .&&. a.!(n+1) .==. 1) $ do {+      qnot_at addsub+    }+  comment_with_label "EXIT: doWeld1" (a, b, weldctrl) ("a", "b", "weldctrl")+  return ()++-- | Input a node label /a/, and a register /b/ initialized to+-- |0〉. If /weldctrl/ is set, set /b/ to the node connected to /a/+-- by the welding function /g/. This is self-inverse. Here, /a/ and+-- /b/ are quantum registers of length at least /n/+2, and /g/ is a+-- boolean register of length /n/.+doWeld0 :: (Qureg, Qureg, Qubit, Boolreg, Int) -> Circ ()+doWeld0 (a, b, weldctrl, f, n) = do+  comment_with_label "ENTER: doWeld0" (a, b, weldctrl) ("a", "b", "weldctrl")+  for 0 (n-1) 1 $ \index -> do+    with_controls (weldctrl .==. 1) $ do {+      qnot_at (b.!(index)) `controlled` a.!(index) ./=. f.!(index)+    }+  endfor+  comment_with_label "EXIT: doWeld0" (a, b, weldctrl) ("a", "b", "weldctrl")+  return ()++-- | This function implements integer addition. Input a quantum+-- register /input/ and a boolean register /num/, representing+-- integers, and a quantum register /out/ initialized to |0〉. If+-- /control/ is set, set /out/ to /input/ + /num/, otherwise do+-- nothing.  Here /input/ and /out/ are quantum registers of length at+-- least /n/, /num/ is a boolean register of length /n/.+cAddNum :: (Qubit, Qureg, Qureg, Boolreg, Int) -> Circ ()+cAddNum (control, out, input, num, n) = do+  comment_with_label "ENTER: cAddNum" (control, out, input) ("control", "out", "input")+  -- we represent mask as 1 << maskbit+  with_ancilla_reg n $ \scratch -> do+    let maskbit = 0  -- invariant: mask = 1 << maskbit+    with_controls (control .==. 1 .&&. input.!(0) .==. 1) $ do {+      qnot_at (out.!(0))+    }+    with_controls (num.!(maskbit) /= 0) $ do {+      with_controls (control .==. 1) $ do {+        qnot_at (out.!(0))+      };+      with_controls (input.!(0) .==. 1) $ do {+        qnot_at (scratch.!(0))+      }+    }+    for 1 (n-1) 1 $ \index -> do+      let maskbit = index   -- invariant: mask = 1 << maskbit+      with_controls (control .==. 1 .&&. input.!(index) .==. 1) $ do {+        qnot_at (out.!(index))+      }+      with_controls (num.!(maskbit) /= 0 .&&. control .==. 1) $ do {+        qnot_at (out.!(index))+      }+      with_controls (control .==. 1 .&&. scratch.!(index-1) .==. 1) $ do {+        qnot_at (out.!(index))+      }+      with_controls (num.!(maskbit) /= 0 .&&. input.!(index) .==. 1) $ do {+        qnot_at (scratch.!(index))+      }+      with_controls (input.!(index) .==. 1 .&&. scratch.!(index-1) .==. 1) $ do {+        qnot_at (scratch.!(index))+      }+      with_controls (num.!(maskbit) /= 0 .&&. scratch.!(index-1) .==. 1) $ do {+        qnot_at (scratch.!(index))+      }+    endfor+    cAddNumClear (control, scratch, input, num, n)+  comment_with_label "EXIT: cAddNum" (control, out, input) ("control", "out", "input")+  return ()++-- | A helper function for clearing the scratch space used by 'cAddNum'.+cAddNumClear :: (Qubit, Qureg, Qureg, Boolreg, Int) -> Circ ()+cAddNumClear (control, scratch, input, num, n) = do+  comment_with_label "ENTER: cAddNumClear" (control, scratch, input) ("control", "scratch", "input")+  -- we represent mask as 1 << maskbit+  for (n-1) 1 (-1) $ \index -> do+    let maskbit = index   -- invariant: mask = 1 << maskbit+    with_controls (num.!(maskbit) /= 0 .&&. scratch.!(index-1) .==. 1) $ do {+      qnot_at (scratch.!(index))+    }+    with_controls (input.!(index) .==. 1 .&&. scratch.!(index-1) .==. 1) $ do {+      qnot_at (scratch.!(index))+    }+    with_controls (num.!(maskbit) /= 0 .&&. input.!(index) .==. 1) $ do {+      qnot_at (scratch.!(index))+    }+  endfor+  let maskbit = 0  -- invariant: mask = 1 << maskbit+  with_controls (num.!(maskbit) /= 0 .&&. input.!(0) .==. 1) $ do {+    qnot_at (scratch.!(0))+  }+  comment_with_label "EXIT: cAddNumClear" (control, scratch, input) ("control", "scratch", "input")+  return ()++-- | Like 'cAddNum', except subtract instead of adding. +cSubNum :: (Qubit, Qureg, Qureg, Boolreg, Int) -> Circ ()+cSubNum (control, out, input, num, n) = do+  comment_with_label "ENTER: cSubNum" (control, out, input) ("control", "out", "input")+  -- we represent mask as 1 << maskbit+  with_ancilla_reg n $ \scratch -> do+    let maskbit = 0  -- invariant: mask = 1 << maskbit+    with_controls (control .==. 1 .&&. input.!(0) .==. 1) $ do {+      qnot_at (out.!(0))+    }+    with_controls (num.!(maskbit) /= 0) $ do {+      with_controls (control .==. 1) $ do {+        qnot_at (out.!(0))+      };+      with_controls (input.!(0) .==. 0) $ do {+        qnot_at (scratch.!(0))+      }+    }+    for 1 (n-1) 1 $ \index -> do+      let maskbit = index    -- invariant: mask = 1 << maskbit+      with_controls (control .==. 1 .&&. input.!(index) .==. 1) $ do {+        qnot_at (out.!(index))+      }+      with_controls (num.!(maskbit) /= 0 .&&. control .==. 1) $ do {+        qnot_at (out.!(index))+      }+      with_controls (control .==. 1 .&&. scratch.!(index-1) .==. 1) $ do {+        qnot_at (out.!(index))+      }+      with_controls (num.!(maskbit) /= 0 .&&. input.!(index) .==. 0) $ do {+        qnot_at (scratch.!(index))+      }+      with_controls (input.!(index) .==. 0 .&&. scratch.!(index-1) .==. 1) $ do {+        qnot_at (scratch.!(index))+      }+      with_controls (num.!(maskbit) /= 0 .&&. scratch.!(index-1) .==. 1) $ do {+        qnot_at (scratch.!(index))+      }+    endfor+    cSubNumClear (control, scratch, input, num, n)+  comment_with_label "EXIT: cSubNum" (control, out, input) ("control", "out", "input")+  return ()++-- | A helper function for clearing the scratch space used by 'cSubNum'.+cSubNumClear :: (Qubit, Qureg, Qureg, Boolreg, Int) -> Circ ()+cSubNumClear (control, scratch, input, num, n) = do+  comment_with_label "ENTER: cSubNumClear" (control, scratch, input) ("control", "scratch", "input")+  -- we represent mask as 1 << maskbit+  for (n-1) 1 (-1) $ \index -> do+    let maskbit = index  -- invariant: mask = 1 << maskbit+    with_controls (num.!(maskbit) /= 0 .&&. scratch.!(index-1) .==. 1) $ do {+      qnot_at (scratch.!(index))+    }+    with_controls (input.!(index) .==. 0 .&&. scratch.!(index-1) .==. 1) $ do {+      qnot_at (scratch.!(index))+    }+    with_controls (num.!(maskbit) /= 0 .&&. input.!(index) .==. 0) $ do {+      qnot_at (scratch.!(index))+    }+  endfor+  let maskbit = 0  -- invariant: mask = 1 << maskbit+  with_controls (num.!(maskbit) /= 0 .&&. input.!(0) .==. 0) $ do {+    qnot_at (scratch.!(0))+  }+  comment_with_label "EXIT: cSubNumClear" (control, scratch, input) ("control", "scratch", "input")+  return ()++-- ----------------------------------------------------------------------+-- ** The oracle data structure++-- | This function inputs two welding functions /f/ and /g/, and+-- returns the oracle defined by the preceding functions. +-- +-- We call this the \"orthodox\" oracle, because the implementation+-- follows its specification very closely. For example, it uses a very+-- \"imperative\" programming style. For alternative implementations+-- of this and other oracles, see the modules+-- "Quipper.Algorithms.BWT.Alternative" and "Quipper.Algorithms.BWT.Template".+oracle_orthodox :: Boollist -> Boollist -> Oracle+oracle_orthodox f g =+  Oracle { n = n,+           m = m,+           k = k,+           entrance = entrance,+           oraclefun = oraclefun+         } where+    n = length f+    m = n+2+    k = 4+    entrance = boollist_of_int_bh m 1+    f_reg = boolreg_of_boollist_te f+    g_reg = boolreg_of_boollist_te g+    +    oraclefun :: Int -> (Qureg, Qureg, Qubit) -> Circ ()+    oraclefun c (a,b,r) = do+      let color = boolreg_of_int_le 2 c+      oracle (a, b, r, color, f_reg, g_reg, n)+      return ()++-- ======================================================================+-- * Main functions++-- These functions are so that the user can output something.++-- | Output the circuit for the quantum walk and a binary welded tree,+-- for the given 'Oracle' in the specified 'Format' and using the+-- specified 'GateBase'. Use /s/ time steps of length /dt/.+main_circuit :: Format -> GateBase -> Oracle -> Int -> Timestep -> IO()+main_circuit format base oracle s dt =+  print_generic format (decompose_generic base circuit)+  where+    circuit = qrwbwt oracle s dt++-- | Output the circuit for the given 'Oracle' and the given color+-- (specified as an 'Int'). Use the specified output 'Format' and+-- 'GateBase'.+main_oracle :: Format -> GateBase -> Oracle -> Int -> IO()+main_oracle format base oracle c =+  let m' = m oracle +      ofun = oraclefun oracle+      circuit = (\(a,b,r) -> ofun c (qureg_of_qulist_te a, qureg_of_qulist_te b, r))+  in+   print_generic format (decompose_generic base circuit) (replicate m' qubit, replicate m' qubit, qubit)
+ dist/build/SimpleOracleSimulation/SimpleOracleSimulation-tmp/Quipper/Algorithms/BWT/Definitions.hs view
@@ -0,0 +1,39 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}+{-# LINE 1 "Quipper/Algorithms/BWT/Definitions.hs" #-}+-- | This module provides some convenient definitions for the Binary+-- Welded Tree algorithm implementation.++module Quipper.Algorithms.BWT.Definitions where++import Quipper++-- ======================================================================+-- * Some convenient gates++-- | Apply the binary /W/-gate to a pair of qubits. The W-gate+-- diagonalizes the SWAP operation.+wGate :: (Qubit, Qubit) -> Circ ()+wGate (a,b) = do+  gate_W a b+  return ()++-- | Apply the /inverse/ of the /W/-gate. Note: since the /W/-gate is+-- self-inverse, this is really the same as 'wGate'. However, we+-- define this as a separate function for clarity. +wGateInverse :: (Qubit, Qubit) -> Circ ()+wGateInverse = wGate++-- | Apply a doubly-controlled not gate to a triple of qubits (/a/,+-- /b/, /c/). Here the qubit /c/ is negated if /a/=1 and /b/=0.+toffoliGate :: (Qubit, Qubit, Qubit) -> Circ ()+toffoliGate (a, b, c) =+  qnot_at c `controlled` (a .==. 1 .&&. b .==. 0)++-- | @controlledExpGate(t, r, h):@+-- Apply the [exp −/iZt/] gate to the qubit /h/, provided that /r/=0. +controlledExpGate :: (Timestep, Qubit, Qubit) -> Circ ()+controlledExpGate (t, r, h) = do+  expZt t h `controlled` (r .==. 0)+  return ()
+ dist/build/SimpleOracleSimulation/SimpleOracleSimulation-tmp/Quipper/Demos/SimpleOracleSimulation.hs view
@@ -0,0 +1,89 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}+{-# LINE 1 "Quipper/Demos/SimpleOracleSimulation.hs" #-}+-- | A test file to simulate various decompositions of the simple oracle circuit,+-- from the BWT algorithm.++import Quipper+import Quipper.Libraries.Simulation+import Quipper.Libraries.Decompose++-- import other Quipper stuff+import Quipper.Algorithms.BWT.Alternative+import Quipper.Utils.Auxiliary++-- | Extract the circuit from an oracle.+oracleCircuit :: Oracle -> Int -> Int -> Circ (Qubit,[Qubit])+oracleCircuit oracle color i = do+  input <- qinit (boollist_of_int_bh (m oracle) i)+  output <- qinit (boollist_of_int_bh (m oracle) 0)+  q <- qinit False+  oraclefun oracle color (input,output,q)+  return (q, output)+                             +-- | Run the simple oracle with a given decomposition, and given inputs.+run_simple' :: GateBase -> Int -> Int -> IO (Bool,Int)+run_simple' gb color i = do (b,bs) <- run_generic_io (undefined :: Double) (decompose_generic gb (oracleCircuit oracle_simple color i))+                            return (b, int_of_boollist_unsigned_bh bs)++-- | Run the simple oracle  with a given decomposition, and given inputs, and print the result in a more readable manner.+run_simple :: GateBase -> Int -> Int -> IO ()+run_simple gb color i = do (b,bs) <- run_simple' gb color i+                           if not b +                             then putStrLn (show i ++ " --( " ++ show color ++ " )--> " ++ show bs)+                             else return ()++-- | Run the simple oracle with a given decomposition, mapped over all possible inputs.+main_run' :: GateBase -> IO ()+main_run' gb = mapM_ (\(x,y) -> run_simple gb x y) [(x,y) | y <- [0..31], x <- [0..3]]++-- | Run each decomposition of the oracle circuit and print out the resulting edges.+main_run :: IO ()+main_run = do putStrLn "Logical"+              main_run' Logical+              putStrLn "Toffoli"+              main_run' Toffoli+              putStrLn "Binary"+              main_run' Binary  ++-- | Simumlate the simple oracle with a given decomposition, and given inputs.+sim_simple' :: GateBase -> Int -> Int -> ProbabilityDistribution Double (Bool,Int)+sim_simple' gb color i = do (b,bs) <- sim_generic undefined (decompose_generic gb (oracleCircuit oracle_simple color i))+                            return (b, int_of_boollist_unsigned_bh bs)++-- | Simulate the simple oracle with a given decomposition,+-- and given inputs, and print the result in a more readable manner.+sim_simple :: GateBase -> Int -> Int -> ProbabilityDistribution Double (IO ())+sim_simple gb color i = do (b,bs) <- sim_simple' gb color i+                           if not b +                             then return $ putStr (show i ++ " --( " ++ show color ++ " )--> " ++ show bs)+                             else Vector [(return (),0.0)]++sequenceP :: ProbabilityDistribution Double (IO ()) -> IO ()+sequenceP (Vector []) = return ()+sequenceP (Vector ((io,prob):ps)) = do if prob /= 0.0 then do io+                                                              putStrLn (" - " ++ show prob)+                                                      else return ()+                                       sequenceP (Vector ps)  ++-- | Simulate the simple oracle with a given decomposition, mapped over all possible inputs.+main_sim' :: GateBase -> IO ()+main_sim' gb = mapM_ (\(x,y) -> sequenceP (sim_simple gb x y)) [(x,y) | y <- [0..31], x <- [0..3]]++main_sim'' :: GateBase -> Int -> Int -> IO ()+main_sim'' gb x y = sequenceP (sim_simple gb x y)++-- | Simulate each decomposition of the oracle circuit and print out the resulting edges.+main_sim :: IO ()+main_sim = do putStrLn "Logical"+              main_sim' Logical+              putStrLn "Toffoli"+              main_sim' Toffoli+              putStrLn "Binary"+              main_sim' Binary  ++main :: IO ()+main = do main_run+          main_sim+
+ dist/build/SimulationTest/SimulationTest-tmp/Quipper/Demos/SimulationTest.hs view
@@ -0,0 +1,34 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}+{-# LINE 1 "Quipper/Demos/SimulationTest.hs" #-}+import Quipper+import Quipper.Libraries.Simulation+import System.Random++circuit :: (Qubit, Qubit) -> Circ (Qubit, Qubit)+circuit (q,r) = do+  with_computed code $ \x -> do+    qnot r `controlled` [r,x]+    hadamard r+  return (q,r)++  where+    code = do+      s <- cinit False+      s <- prepare s+      hadamard q+      qnot s `controlled` q+      ++circuit2 :: (Qubit, Qubit, Qubit) -> Circ (Qubit, Qubit, Qubit)+circuit2 (s,q,r) = do+  circuit (q,r) `controlled` s+  return (s,q,r)++main =+  print_simple Preview circuit2+  +main2 = do+  g <- newStdGen+  print $ run_generic g (0.0 :: Double) circuit2 (True,True,True)
+ dist/build/SynthesisTest/SynthesisTest-tmp/Quipper/Demos/SynthesisTest.hs view
@@ -0,0 +1,110 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}+{-# LINE 1 "Quipper/Demos/SynthesisTest.hs" #-}+-- | Some demos for "Quipper.Libraries.Synthesis".++import Quipper+import Quipper.Libraries.Synthesis++import Quantum.Synthesis.Ring+import Quantum.Synthesis.Matrix+import Quantum.Synthesis.MultiQubitSynthesis++import System.Random++-- ----------------------------------------------------------------------+-- * Some demos for Quipper.Libraries.Synthesis++-- | Import a compressed Clifford+/T/ operator as a Quipper circuit.+main1 :: IO ()+main1 = do+  print_simple Preview (exact_synthesis1 (0x1d00d27a0188b095b8cdd4ead9a244198d8b22e :: Integer))+  +-- | Exact synthesis of a Clifford+/T/ circuit from an exact matrix+-- representation.+main2 :: IO ()+main2 = do+  print_simple Preview (exact_synthesis1 op)+  where+    op :: Matrix Two Two DOmega+    op = roothalf^4 * matrix2x2 ( 1 - 2*roottwo,    2 + roottwo - i )+                                ( -2 - roottwo - i, 1 - 2*roottwo   )++-- | Exact synthesis of a multi-qubit Clifford+/T/ circuit from an+-- exact matrix representation.+main3 :: IO ()+main3 = do+  print_generic Preview (exact_synthesis_alt op) [qubit, qubit]+  where+    op :: Matrix Four Four DOmega+    op = matrix4x4 ( 1,  0,  0, 0 )+                   ( 0, -s,  s, 0 )+                   ( 0,  0,  0, 1 )+                   ( 0,  s,  s, 0 ) +    s = roothalf+    +-- | Exact synthesis of a multi-qubit Clifford+/T/ circuit from an+-- exact matrix representation.+main3a :: IO ()+main3a = do+  print_generic Preview (exact_synthesis_alt op) [qubit, qubit, qubit]+  where+    op :: Matrix Eight Eight DOmega+    op = matrix [[ 1, 0,  0, 0, 0, 0, 0, 0 ],+                 [ 0, s, -s, 0, 0, 0, 0, 0 ],+                 [ 0, 0,  0, 1, 0, 0, 0, 0 ],+                 [ 0, s,  s, 0, 0, 0, 0, 0 ],+                 [ 0, 0,  0, 0, 1, 0, 0, 0 ],+                 [ 0, 0,  0, 0, 0, 1, 0, 0 ],+                 [ 0, 0,  0, 0, 0, 0, 0, 1 ],+                 [ 0, 0,  0, 0, 0, 0, 1, 0 ]] +    s = roothalf+    +-- | Approximate synthesis of a /z/-rotation as a Clifford+/T/ circuit.+-- Angle θ = π\/128, precision ε = 10[sup −30].+main4 :: IO ()+main4 = do+  g <- newStdGen  -- a source of randomness+  print_simple Preview (approximate_synthesis_zrot prec (pi/128) g)+  where+    prec = 30 * digits++-- | Approximate synthesis of a global phase. +-- Angle α = π\/128, precision ε = 10[sup −30].+main5 :: IO ()+main5 = do+  g <- newStdGen  -- a source of randomness+  print_simple Preview (approximate_synthesis_phase True prec (pi/128) g)+  where  +    prec = 30 * digits++-- | Approximate synthesis of an arbitrary single-qubit operator,+-- given by Euler angles. Precision ε = 2[sup −50].+main6 :: IO ()+main6 = do+  g <- newStdGen  -- a source of randomness+  let circ = approximate_synthesis_euler True prec (alpha, beta, gamma, delta) g+  print_simple Preview circ+  where+    prec = 50 * bits+    alpha = 0.1 * pi+    beta = 0.2 * pi+    gamma = 0.5 * pi+    delta = -0.6 * pi+    +-- | Approximate synthesis of an arbitrary single-qubit operator,+-- given as a matrix. The matrix is given in an exact notation.+-- Precision ε = 10[sup −10].+main7 :: IO ()+main7 = do+  g <- newStdGen  -- a source of randomness+  let circ = approximate_synthesis_u2 True prec op g+  print_simple Preview circ+  where+    prec = 10 * digits+    op = matrix2x2 ( 0.6, 0.8*i )+                   (-0.8, 0.6*i )++-- | Run any of the above main functions:+main = main3a
+ dist/build/Teleport/Teleport-tmp/Quipper/Demos/Teleport.hs view
@@ -0,0 +1,59 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}+{-# LINE 1 "Quipper/Demos/Teleport.hs" #-}+import Quipper++plus_minus :: Bool -> Circ Qubit+plus_minus b = do+    q <- qinit b+    q <- hadamard q+    return q++share :: Qubit -> Circ (Qubit, Qubit)+share a = do+    b <- qinit False+    b <- qnot b `controlled` a+    return (a,b)++bell00 :: Circ (Qubit, Qubit)+bell00 = do+    a <- plus_minus False+    (a,b) <- share a+    return (a,b)++alice :: Qubit -> Qubit -> Circ (Bit,Bit)+alice q a = do+    a <- qnot a `controlled` q+    q <- hadamard q+    (x,y) <- measure (q,a)+    return (x,y)++bob :: Qubit -> (Bit,Bit) -> Circ Qubit+bob b (x,y) = do+    b <- gate_X b `controlled` y+    b <- gate_Z b `controlled` x+    cdiscard (x,y)+    return b++teleport :: Qubit -> Circ Qubit+teleport q = do+    (a,b) <- bell00+    (x,y) <- alice q a+    b <- bob b (x,y)+    return b++-- ----------------------------------------------------------------------+-- main functions++main_alice =+  print_simple Preview alice++main_bob =+  print_simple Preview bob++main_teleport =+  print_simple Preview teleport++main = main_teleport+
+ dist/build/TeleportGeneric/TeleportGeneric-tmp/Quipper/Demos/TeleportGeneric.hs view
@@ -0,0 +1,174 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}+{-# LINE 1 "Quipper/Demos/TeleportGeneric.hs" #-}+import Quipper+import Quipper.Libraries.Simulation++import System.Random+import System.Environment+import System.CPUTime++plus_minus :: (QShape a qa ca) => a -> Circ qa+plus_minus a = do +    qs <- qinit a+    qs <- mapUnary hadamard qs+    return qs++share :: (QShape a qa ca) => qa -> Circ (qa, qa)+share qa = do +    qb <- qinit (qc_false qa)+    (qb, qa) <- mapBinary controlled_not qb qa+    return (qa, qb)++bell00 :: (QShape a qa ca) => a -> Circ (qa, qa)+bell00 shape = do +    qa <- plus_minus shape+    (qa, qb) <- share qa+    return (qa, qb)++alice :: (QShape a qa ca) => qa -> qa -> Circ (ca,ca)+alice q a = do +    (a, q) <- mapBinary controlled_not a q+    q <- mapUnary hadamard q+    (x,y) <- measure (q,a)+    return (x,y)++bob :: (QShape a qa ca) => qa -> (ca,ca) -> Circ qa+bob b (x,y) = do+     (b, y) <- mapBinary_c controlled_X b y+     (b, x) <- mapBinary_c controlled_Z b x+     cdiscard (x,y)+     return b+  where+    controlled_X b x = do+      gate_X b `controlled` x+      return (b,x)+    +    controlled_Z b x = do+      gate_Z b `controlled` x+      return (b,x)+    +teleport :: (QData qa) => qa -> Circ qa+teleport q = do+    (a,b) <- bell00 (qc_false q)+    (x,y) <- alice q a+    b <- bob b (x,y)+    return b++teleport_labeled :: (QData qa) => qa -> Circ qa+teleport_labeled q = do+    comment_with_label "ENTER: teleport_labeled" q "q"+    comment "ENTER: bell00"+    (a,b) <- bell00 (qc_false q)+    comment_with_label "EXIT: bell00" (a,b) ("a","b")+    comment "ENTER: alice"+    (x,y) <- alice q a+    comment_with_label "EXIT: alice" (x,y) ("x","y")+    comment "ENTER: bob"+    b <- bob b (x,y)+    comment_with_label "EXIT: bob" b "b"+    comment "EXIT: teleport_labeled"+    return b++-- | A test that should help see how many qubits we can simulate+test_teleport :: [Bool] -> IO [Bool]+test_teleport = run_clifford_generic teleport++data What = Sim | Circ | Usage deriving Eq++-- | The main method deals with command line arguments, and timing of the simulation+main :: IO ()+main = do+  args <- getArgs+  if (length args /= 2) then usage else do+  let arg1 = head args+  let flag = case arg1 of+              "--sim" -> Sim+              "--circ" -> Circ +              _ -> Usage+  if (flag == Usage) then usage else do +   let arg = head (tail args)+   case reads arg of+    [(n,_)] -> do+     if (n < 0) then usage else do+     if (flag == Circ) then print_generic Preview teleport_labeled (replicate n qubit) else do+     input <- randomBools n+     putStrLn ("Input: " ++ show input)+     start <- getCPUTime+     output <- test_teleport input+     end <- getCPUTime+     putStrLn ("Output: " ++ show output)+     let time = end - start+     putStrLn ("Time: (" ++ show time ++ ")")+     show_time time+    _ -> usage++-- | Produce the given number of random boolean values+randomBools :: Int -> IO [Bool]+randomBools 0 = return []+randomBools n = do+  b <- randomIO+  bs <- randomBools (n-1)+  return (b:bs)++-- | Give a usage message if not being run from GHCI+usage :: IO ()+usage = do+  name <- getProgName+  if name == "<interactive>" then prompt else do+  putStrLn ("usage: " ++ name ++ " flag num_qubits")+  putStrLn ("  where flag = --sim or --circ") ++-- | If we're in GHCI then we can prompt for the number of qubits to teleport+prompt :: IO ()+prompt = do+  putStrLn "Enter flag (--sim or --circ): "+  f <- getLine+  putStrLn "Enter number of qubits: "+  n <- getLine+  withArgs [f,n] main      ++-- | Display an integer representing pico-seconds in a more readable format+show_time :: Integer -> IO ()+show_time t = case range t of+  Pico -> putStrLn (show t ++ " " ++ show Pico ++ ".")+  r -> do+   putStr (show (div t (ps' r)) ++ " " ++ show r ++ ", ")+   show_time (rem t (ps' r))++-- | Helper data-type for show_time function+data Range = Pico | Nano | Micro | Milli | Seconds | Minutes | Hours | Days+ deriving Eq++instance Show Range where+ show Pico = "picoseconds"+ show Nano = "nanoseconds"+ show Micro = "microseconds"+ show Milli = "milliseconds"+ show Seconds = "seconds"+ show Minutes = "minutes"+ show Hours = "hours"+ show Days = "days"++-- | Helper function for show_time function+ps' :: Range -> Integer+ps' Pico = 1+ps' Nano = 10^3 * ps' Pico+ps' Micro = 10^3 * ps' Nano+ps' Milli = 10^3 * ps' Micro+ps' Seconds = 10^3 * ps' Milli +ps' Minutes = 60 * ps' Seconds+ps' Hours = 60 * ps' Minutes+ps' Days = 24 * ps' Hours++-- | Helper function for show_time function+range :: Integer -> Range+range t = +  if (t < 10^3) then Pico else+  if (t < 10^6) then Nano else+  if (t < 10^9) then Micro else+  if (t < 10^12) then Milli else+  if (t < 60*(10^12)) then Seconds else+  if (t < 60*60*(10^12)) then Minutes else+  if (t < 24*60*60*(10^12)) then Hours else Days
+ dist/build/TemplateTest/TemplateTest-tmp/Quipper/Demos/TemplateTest.hs view
@@ -0,0 +1,95 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}+{-# LINE 1 "Quipper/Demos/TemplateTest.hs" #-}+-- | This file illustrates the most basic use of Template Haskell.++import Quipper++-- | A classical implementation of some boolean function.++example1 :: Bool -> Bool -> Bool+example1 a b = (a && b) || not a+++{-# LINE 9 "Quipper/Demos/TemplateTest.hs" #-}+$( decToCircMonad [d| example1 :: Bool -> Bool -> Bool+                      example1 a b = (a && b) || not a+                      +                      + |] ) +{-# LINE 10 "Quipper/Demos/TemplateTest.hs" #-}+-- $ The keyword \"build_circuit\" causes an equivalent quantum function+-- to be built automatically. It will have the following name and+-- type:+-- +-- > template_example1 :: Circ (Qubit -> Circ (Qubit -> Circ Qubit))+-- +-- The various nested 'Circ' applications are an artifact, and can and+-- should be removed using the 'unpack' operator:+-- +-- > (unpack template_example1) :: Qubit -> Qubit -> Circ Qubit++-- | This main function prints the circuit generated from 'example1'.+main1 :: IO ()+main1 =+  print_simple Preview (unpack template_example1)++-- | Here is some other boolean function. We do not use the+-- \"build_circuit\" keyword.+fake :: Bool -> Bool+fake b = not b++-- $ Suppose we want to use the function 'fake' as a subroutine+-- elsewhere:+{-++example2 :: Bool -> Bool -> Bool+example2 a b = fake (a && b) || not a++{-# LINE 36 "Quipper/Demos/TemplateTest.hs" #-}+$( decToCircMonad [d| example2 :: Bool -> Bool -> Bool+                      example2 a b = fake (a && b) || not a+                      + |] ) +{-# LINE 37 "Quipper/Demos/TemplateTest.hs" #-}+-}++-- | This will fail, because build_circuit does not know how to+-- translate the 'fake' function. +-- +-- We can fix this by manually providing a template. This is useful in+-- two situations:+-- +-- 1. To provide a template for a Haskell built-in function;+-- +-- 2. To provide a more efficient template for some function than the+-- one build_circuit can build automatically.+template_fake :: Circ (Qubit -> Circ Qubit)+template_fake = return f where+  f q = do+    qnot_at q+    return q++-- | Now that a template for 'fake' has been defined, the definition+-- of 'example2' works:++example2 :: Bool -> Bool -> Bool+example2 a b = fake (a && b) || not a++++{-# LINE 61 "Quipper/Demos/TemplateTest.hs" #-}+$( decToCircMonad [d| example2 :: Bool -> Bool -> Bool+                      example2 a b = fake (a && b) || not a+                      +                      +                      + |] ) +{-# LINE 62 "Quipper/Demos/TemplateTest.hs" #-}+-- | This main function prints the circuit generated from 'example2'. +main2 :: IO ()+main2 =+  print_simple Preview (unpack template_example2)++main = main2
+ dist/build/Test/Test-tmp/Quipper/Demos/Test.hs view
@@ -0,0 +1,35 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}+{-# LINE 1 "Quipper/Demos/Test.hs" #-}+import Quipper++circuit :: (Qubit, Qubit, Qubit) -> Circ (Qubit, Qubit, Qubit)+circuit (a, b, c) = do+  qnot_at a `controlled` [b]+  qnot_at b `controlled` [c]+  hadamard c `controlled` [a,b]+  return (a, b, c)++hadamard2 :: (Qubit, Qubit, Qubit) -> Circ (Qubit, Qubit, Qubit)+hadamard2 (h, a, b) = do+  with_ancilla $ \c -> do+    qnot_at c `controlled` [a, b]+    hadamard h `controlled` [c]+    qnot_at c `controlled` [a, b]+  return (h, a, b)++example :: (Qubit, Qubit, Qubit, Qubit, Qubit) -> Circ (Qubit, Qubit, Qubit, Qubit, Qubit)+example (a, b, c, d, e) = do+  circuit (a, b, c)+  circuit (b, c, a)+  with_controls (d .==. 1 .&&. e .==. 0) $ do {+    circuit (a, b, c);+    circuit (b, c, a);+  }+  circuit (a, b, c)+  circuit (b, c, a)+  return (a, b, c, d, e)++main =+  print_simple Preview example
+ dist/build/Testing/Testing-tmp/Quipper/Demos/Testing.hs view
@@ -0,0 +1,83 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}+{-# LINE 1 "Quipper/Demos/Testing.hs" #-}+{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}++-- $+-- Generate some circuits for the slides in the PI presentation.++import Quipper++example_H3 :: Qubit -> Qubit -> Qubit -> Qubit -> Circ ()+example_H3 h a b c = do+  with_ancilla $ \d -> do+    with_ancilla $ \e -> do+      qnot_at d `controlled` a .==. 1 .&&. b .==. 1+      qnot_at e `controlled` c .==. 1 .&&. d .==. 1+      hadamard_at h `controlled` e .==. 1+      qnot_at e `controlled` c .==. 1 .&&. d .==. 1+      qnot_at d `controlled` a .==. 1 .&&. b .==. 1++example_H3' :: Qubit -> Qubit -> Qubit -> Qubit -> Qubit -> Qubit -> Circ ()+example_H3' h a b c d e = do+      qnot_at d `controlled` a .==. 1 .&&. b .==. 1+      qnot_at e `controlled` c .==. 1 .&&. d .==. 1+      hadamard_at h `controlled` e .==. 1+      qnot_at e `controlled` c .==. 1 .&&. d .==. 1+      qnot_at d `controlled` a .==. 1 .&&. b .==. 1++example :: Qubit -> Qubit -> Qubit -> Qubit -> Circ ()+example a b c d = do+  example_H3 a b c d+  qnot_at a `controlled` b .==. 1+  qnot_at b `controlled` c .==. 1+  qnot_at c `controlled` d .==. 1 .&&. a .==. 1+  qnot_at b `controlled` c .==. 1+  qnot_at a `controlled` b .==. 1+  example_H3 b c d a++example' :: Qubit -> Qubit -> Qubit -> Qubit -> Qubit -> Qubit -> Circ ()+example' a b c d anc1 anc2 = do+  example_H3' a b c d anc1 anc2+  qnot_at a `controlled` b .==. 1+  qnot_at b `controlled` c .==. 1+  qnot_at c `controlled` d .==. 1 .&&. a .==. 1+  qnot_at b `controlled` c .==. 1+  qnot_at a `controlled` b .==. 1+  example_H3' b c d a anc1 anc2+++main3 =+  print_generic Preview example qubit qubit qubit qubit++main =+  print_simple Preview example'++ec1 :: Qubit -> Circ [Qubit]+ec1 a = do+  b <- qinit False+  c <- qinit False+  qmultinot_at (b,c) `controlled` a .==. 1+  return [a,b,c]++corr :: [Qubit] -> Circ Qubit+corr [a,b,c] = do+  qmultinot_at (a,c) `controlled` b .==. 1+  (a',c') <- measure (a,c)+  qnot_at b `controlled` a' .==. 1 .&&. c' .==. 1+  cdiscard (a',c')+  return b++ec2 :: [Qubit] -> Circ [Qubit]+ec2 [a,b,c] = do+  [a1,a2,a3] <- ec1 a+  [b1,b2,b3] <- ec1 b+  [c1,c2,c3] <- ec1 c+  x1 <- corr [a1,b1,c1]+  x2 <- corr [a2,b2,c2]+  x3 <- corr [a3,b3,c3]+  return [x1,x2,x3]+++main4 = print_generic Preview ec2 [qubit, qubit, qubit]
+ dist/build/TimeStep-binary/TimeStep-binary-tmp/Quipper/Algorithms/BWT/Definitions.hs view
@@ -0,0 +1,39 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}+{-# LINE 1 "Quipper/Algorithms/BWT/Definitions.hs" #-}+-- | This module provides some convenient definitions for the Binary+-- Welded Tree algorithm implementation.++module Quipper.Algorithms.BWT.Definitions where++import Quipper++-- ======================================================================+-- * Some convenient gates++-- | Apply the binary /W/-gate to a pair of qubits. The W-gate+-- diagonalizes the SWAP operation.+wGate :: (Qubit, Qubit) -> Circ ()+wGate (a,b) = do+  gate_W a b+  return ()++-- | Apply the /inverse/ of the /W/-gate. Note: since the /W/-gate is+-- self-inverse, this is really the same as 'wGate'. However, we+-- define this as a separate function for clarity. +wGateInverse :: (Qubit, Qubit) -> Circ ()+wGateInverse = wGate++-- | Apply a doubly-controlled not gate to a triple of qubits (/a/,+-- /b/, /c/). Here the qubit /c/ is negated if /a/=1 and /b/=0.+toffoliGate :: (Qubit, Qubit, Qubit) -> Circ ()+toffoliGate (a, b, c) =+  qnot_at c `controlled` (a .==. 1 .&&. b .==. 0)++-- | @controlledExpGate(t, r, h):@+-- Apply the [exp −/iZt/] gate to the qubit /h/, provided that /r/=0. +controlledExpGate :: (Timestep, Qubit, Qubit) -> Circ ()+controlledExpGate (t, r, h) = do+  expZt t h `controlled` (r .==. 0)+  return ()
+ dist/build/TimeStep-binary/TimeStep-binary-tmp/Quipper/Demos/TimeStep-binary.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}+{-# LINE 1 "Quipper/Demos/TimeStep-binary.hs" #-}+import Quipper+import Quipper.Libraries.Qureg+import Quipper.Libraries.Decompose++import Quipper.Algorithms.BWT.Definitions++-- | Algorithm 3. @timestep (a, b, r, dt, m)@: Apply the+-- time step /dt/ to (/a/,/b/,/r/). Here /a/ and /b/ are /m/-qubit+-- registers while /r/ is a single qubit.+timestep :: (Qureg, Qureg, Qubit, Timestep, Int) -> Circ ()+timestep (a, b, r, dt, m) = do+  comment_with_label "ENTER: timestep" (a,b,r) ("a","b","r")+  with_ancilla $ \h -> do+    for 0 (m-1) 1 $ \i -> do+      wGate (a.!(i), b.!(i))+    endfor+    for 0 (m-1) 1 $ \i -> do+      toffoliGate (a.!(i), b.!(i), h)+    endfor+    controlledExpGate (dt, r, h)+    for (m-1) 0 (-1) $ \i -> do+      toffoliGate (a.!(i), b.!(i), h)+    endfor+    for (m-1) 0 (-1) $ \i -> do+      wGateInverse (a.!(i), b.!(i))+    endfor+  comment_with_label "EXIT: timestep" (a,b,r) ("a","b","r")+  return ()++main = print_generic Preview (decompose_generic Binary circuit) (nodeshape, nodeshape, qubit)+  where+    circuit (a, b, r) = timestep (a, b, r, dt, m)+    n = 4+    m = n+2+    dt = pi/180+    nodeshape = qureg_shape m
+ dist/build/TimeStep/TimeStep-tmp/Quipper/Algorithms/BWT/Definitions.hs view
@@ -0,0 +1,39 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}+{-# LINE 1 "Quipper/Algorithms/BWT/Definitions.hs" #-}+-- | This module provides some convenient definitions for the Binary+-- Welded Tree algorithm implementation.++module Quipper.Algorithms.BWT.Definitions where++import Quipper++-- ======================================================================+-- * Some convenient gates++-- | Apply the binary /W/-gate to a pair of qubits. The W-gate+-- diagonalizes the SWAP operation.+wGate :: (Qubit, Qubit) -> Circ ()+wGate (a,b) = do+  gate_W a b+  return ()++-- | Apply the /inverse/ of the /W/-gate. Note: since the /W/-gate is+-- self-inverse, this is really the same as 'wGate'. However, we+-- define this as a separate function for clarity. +wGateInverse :: (Qubit, Qubit) -> Circ ()+wGateInverse = wGate++-- | Apply a doubly-controlled not gate to a triple of qubits (/a/,+-- /b/, /c/). Here the qubit /c/ is negated if /a/=1 and /b/=0.+toffoliGate :: (Qubit, Qubit, Qubit) -> Circ ()+toffoliGate (a, b, c) =+  qnot_at c `controlled` (a .==. 1 .&&. b .==. 0)++-- | @controlledExpGate(t, r, h):@+-- Apply the [exp −/iZt/] gate to the qubit /h/, provided that /r/=0. +controlledExpGate :: (Timestep, Qubit, Qubit) -> Circ ()+controlledExpGate (t, r, h) = do+  expZt t h `controlled` (r .==. 0)+  return ()
+ dist/build/TimeStep/TimeStep-tmp/Quipper/Demos/TimeStep.hs view
@@ -0,0 +1,38 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}+{-# LINE 1 "Quipper/Demos/TimeStep.hs" #-}+import Quipper+import Quipper.Libraries.Qureg+import Quipper.Algorithms.BWT.Definitions++-- | Algorithm 3. @timestep (a, b, r, dt, m)@: Apply the+-- time step /dt/ to (/a/,/b/,/r/). Here /a/ and /b/ are /m/-qubit+-- registers while /r/ is a single qubit.+timestep :: (Qureg, Qureg, Qubit, Timestep, Int) -> Circ ()+timestep (a, b, r, dt, m) = do+  comment_with_label "ENTER: timestep" (a,b,r) ("a","b","r")+  with_ancilla $ \h -> do+    for 0 (m-1) 1 $ \i -> do+      wGate (a.!(i), b.!(i))+    endfor+    for 0 (m-1) 1 $ \i -> do+      toffoliGate (a.!(i), b.!(i), h)+    endfor+    controlledExpGate (dt, r, h)+    for (m-1) 0 (-1) $ \i -> do+      toffoliGate (a.!(i), b.!(i), h)+    endfor+    for (m-1) 0 (-1) $ \i -> do+      wGateInverse (a.!(i), b.!(i))+    endfor+  comment_with_label "EXIT: timestep" (a,b,r) ("a","b","r")+  return ()++main = print_generic Preview circuit (nodeshape, nodeshape, qubit)+  where+    circuit (a, b, r) = timestep (a, b, r, dt, m)+    n = 4+    m = n+2+    dt = pi/180+    nodeshape = qureg_shape m
+ dist/build/TransformerExample/TransformerExample-tmp/Quipper/Demos/TransformerExample.hs view
@@ -0,0 +1,27 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}+{-# LINE 1 "Quipper/Demos/TransformerExample.hs" #-}+import Quipper+  +mytransformer :: Transformer Circ Qubit Bit+mytransformer (T_QGate "swap" 2 0 _ ncf f) = f $+  \[q0, q1] [] ctrls -> do+    without_controls_if ncf $ do+      with_controls ctrls $ do+        qnot_at q0 `controlled` q1+        qnot_at q1 `controlled` q0+        qnot_at q0 `controlled` q1+        return ([q0, q1], [], ctrls)+mytransformer g = identity_transformer g++mycirc a b c d = do+  swap_at a b+  hadamard_at b+  swap_at b c `controlled` [a, d]+  hadamard_at c+  swap_at c d++mycirc2 = transform_generic mytransformer mycirc++main = print_simple Preview mycirc2
+ dist/build/WithComputed/WithComputed-tmp/Quipper/Demos/WithComputed.hs view
@@ -0,0 +1,44 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}+{-# LINE 1 "Quipper/Demos/WithComputed.hs" #-}+import Quipper++crazy :: (QData a, QCData b) => (a -> Circ b) -> (a -> Circ (a,b))+crazy f a = do+  mapUnary hadamard a+  y <- with_computed (f a) $ \b -> do+    b' <- qc_copy b+    return (a,b')+  return y++circuit :: [Qubit] -> Circ ([Qubit], [Qubit])+circuit qs = do+  y <- with_computed values $ \values -> do+    qc_copy values+  return (qs, y)+  +    where+      values = do+        mapUnary hadamard qs+        a <- qinit True+        b <- qinit False+        qnot_at a `controlled` qs+        qnot_at b `controlled` qs .==. [0,0..]+        c <- qinit False+        qnot_at c `controlled` [a,b]+        qnot_at b `controlled` qs .==. [0,0..]+        qnot_at a `controlled` qs+        qterm False b  +        qterm True a+        return (c:qs)++circuit2 :: [Qubit] -> Circ ([Qubit], ([Qubit], [Qubit]))+circuit2 = crazy circuit++circuit3 :: [Qubit] -> Circ ([Qubit], ([Qubit], ([Qubit], [Qubit])))+circuit3 = crazy circuit2++circuit4 = crazy circuit3++main = print_generic Preview circuit4 (replicate 5 qubit)
+ images/CosetState.png view

binary file changed (absent → 3311 bytes)

+ images/E.png view

binary file changed (absent → 1496 bytes)

+ images/ERot_phase.png view

binary file changed (absent → 1572 bytes)

+ images/ERot_zx.png view

binary file changed (absent → 3957 bytes)

+ images/G.png view

binary file changed (absent → 1738 bytes)

+ images/GateR.png view

binary file changed (absent → 3363 bytes)

+ images/Rz.png view

binary file changed (absent → 1963 bytes)

+ images/T.png view

binary file changed (absent → 1561 bytes)

+ images/V.png view

binary file changed (absent → 1804 bytes)

+ images/W.png view

binary file changed (absent → 2532 bytes)

+ images/Y.png view

binary file changed (absent → 1360 bytes)

+ images/adder-optimized.png view

binary file changed (absent → 4858 bytes)

+ images/adder-unoptimized.png view

binary file changed (absent → 8371 bytes)

+ images/b0-template.png view

binary file changed (absent → 887 bytes)

+ images/b1-template.png view

binary file changed (absent → 5013 bytes)

+ images/b2-orthodox.png view

binary file changed (absent → 5628 bytes)

+ images/b2-template.png view

binary file changed (absent → 1304 bytes)

+ images/b3-template.png view

binary file changed (absent → 7265 bytes)

+ images/b4-template.png view

binary file changed (absent → 13792 bytes)

+ images/cH_AMMR.png view

binary file changed (absent → 1544 bytes)

+ images/ccZ_AMMR.png view

binary file changed (absent → 2929 bytes)

+ images/ccZ_S.png view

binary file changed (absent → 7580 bytes)

+ images/cc_iX.png view

binary file changed (absent → 3038 bytes)

+ images/cc_iX_S.png view

binary file changed (absent → 3642 bytes)

+ images/cc_iX_simple.png view

binary file changed (absent → 2484 bytes)

+ images/contfrac.png view

binary file changed (absent → 1151 bytes)

+ images/controlled-phase-decomp.png view

binary file changed (absent → 1433 bytes)

+ images/controlled-zrot.png view

binary file changed (absent → 1940 bytes)

+ images/controlled_E.png view

binary file changed (absent → 2085 bytes)

+ images/controlled_S.png view

binary file changed (absent → 1308 bytes)

+ images/controlled_T.png view

binary file changed (absent → 4450 bytes)

+ images/controlled_V.png view

binary file changed (absent → 1716 bytes)

+ images/controlled_W.png view

binary file changed (absent → 4991 bytes)

+ images/controlled_YY.png view

binary file changed (absent → 1878 bytes)

+ images/controlled_iX.png view

binary file changed (absent → 963 bytes)

+ images/controlled_phase.png view

binary file changed (absent → 1551 bytes)

+ images/coord.png view

binary file changed (absent → 14953 bytes)

+ images/dashed-cnot-bwd.png view

binary file changed (absent → 2436 bytes)

+ images/dashed-cnot-fwd.png view

binary file changed (absent → 2433 bytes)

+ images/decompose2Controls.png view

binary file changed (absent → 3058 bytes)

+ images/decomposeControls.png view

binary file changed (absent → 4290 bytes)

+ images/def_f.png view

binary file changed (absent → 4864 bytes)

+ images/def_g.png view

binary file changed (absent → 3545 bytes)

+ images/def_g1.png view

binary file changed (absent → 1268 bytes)

+ images/def_h.png view

binary file changed (absent → 2669 bytes)

+ images/expDA.png view

binary file changed (absent → 2247 bytes)

+ images/floor.png view

binary file changed (absent → 1738 bytes)

+ images/floor2.png view

binary file changed (absent → 1002 bytes)

+ images/fredkin.png view

binary file changed (absent → 3523 bytes)

+ images/gate_W_CliffordT.png view

binary file changed (absent → 2403 bytes)

+ images/hex-coord.png view

binary file changed (absent → 12639 bytes)

+ images/hex1.png view

binary file changed (absent → 19618 bytes)

+ images/hex2.png view

binary file changed (absent → 6734 bytes)

+ images/iX.png view

binary file changed (absent → 1318 bytes)

+ images/multi_ciX_noancilla.png view

binary file changed (absent → 4358 bytes)

+ images/multi_cnot_barenco.png view

binary file changed (absent → 5276 bytes)

+ images/phase.png view

binary file changed (absent → 1167 bytes)

+ images/quantum_and.png view

binary file changed (absent → 1152 bytes)

+ images/quantum_and_iX.png view

binary file changed (absent → 913 bytes)

+ images/rGate.png view

binary file changed (absent → 1664 bytes)

+ images/spin1.png view

binary file changed (absent → 2436 bytes)

+ images/spin2.png view

binary file changed (absent → 3399 bytes)

+ images/toffoli_AMMR.png view

binary file changed (absent → 3310 bytes)

+ images/toffoli_NC.png view

binary file changed (absent → 3209 bytes)

+ images/toffoli_S.png view

binary file changed (absent → 7982 bytes)

+ images/toffoli_V.png view

binary file changed (absent → 1768 bytes)

+ images/weldedtree.png view

binary file changed (absent → 8963 bytes)

+ images/with_combined_controls1.png view

binary file changed (absent → 4107 bytes)

+ images/with_combined_controls2.png view

binary file changed (absent → 3598 bytes)

+ images/with_computed.png view

binary file changed (absent → 5029 bytes)

+ images/with_signed_qubit.png view

binary file changed (absent → 1052 bytes)

+ quipper-demos.cabal view
@@ -0,0 +1,438 @@+-- The name of the package.+name:                quipper-demos++-- The package version.  See the Haskell package versioning policy (PVP) +-- for standards guiding when and how versions should be incremented.+-- http://www.haskell.org/haskellwiki/Package_versioning_policy+-- PVP summary:      +-+------- breaking API changes+--                   | | +----- non-breaking API additions+--                   | | | +--- code changes with no API change+version:             0.9.0.0++-- A short (one-line) description of the package.+synopsis:            Miscellaneous code snippets that illustrate various Quipper features.++-- A longer description of the package.+description:         ++ This package provides some code snippets that illustrate various+ Quipper features.+                     +-- URL for the project homepage or repository.+homepage:            http://www.mathstat.dal.ca/~selinger/quipper/++-- The license under which the package is released.+license:             BSD3++-- The file containing the license text.+license-file:        COPYRIGHT++-- The package author(s).+author:              Alexander S. Green, Peter LeFanu Lumsdaine,+                     Neil J. Ross, Peter Selinger, Benoit Valiron++-- An email address to which users can send suggestions, bug reports, and +-- patches.+maintainer:          selinger@mathstat.dal.ca++-- A copyright notice.+copyright:           Copyright (c) 2011-2019. All rights reserved.++-- A classification category for future use by the package catalogue+-- Hackage. These categories have not yet been specified, but the+-- upper levels of the module hierarchy make a good start.+category:            Quipper++-- The type of build used by this package.+build-type:          Custom++-- Constraint on the version of Cabal needed to build this package.+cabal-version:       >= 1.8++-- A list of additional files to be included in source distributions+-- built with setup sdist.+extra-source-files:  images/*.png ChangeLog++-- We must export a library, even if it is empty, or else+-- meta-packages (such as quipper-all) that depend on this package+-- will fail.+library+  exposed-modules:+                     +executable And_gate+           main-is: Quipper/Demos/And_gate.hs+           build-depends:+                         base >= 4.5 && < 5,+                         quipper-utils,+                         quipper-language,+                         quipper-libraries+                         +executable And_list+           main-is: Quipper/Demos/And_list.hs+           build-depends:+                         base >= 4.5 && < 5,+                         quipper-utils,+                         quipper-language,+                         quipper-libraries+                         +executable And_rev+           main-is: Quipper/Demos/And_rev.hs+           build-depends:+                         base >= 4.5 && < 5,+                         quipper-utils,+                         quipper-language,+                         quipper-libraries+                         +executable Arith+           main-is: Quipper/Demos/Arith.hs+           build-depends:+                         base >= 4.5 && < 5,+                         quipper-utils,+                         quipper-language,+                         quipper-libraries+                         +executable BoxExample+           main-is: Quipper/Demos/BoxExample.hs+           build-depends:+                         base >= 4.5 && < 5,+                         quipper-utils,+                         quipper-language,+                         quipper-libraries+                         +executable Box+           main-is: Quipper/Demos/Box.hs+           build-depends:+                         base >= 4.5 && < 5,+                         quipper-utils,+                         quipper-language,+                         quipper-libraries+                         +executable Classical+           main-is: Quipper/Demos/Classical.hs+           build-depends:+                         base >= 4.5 && < 5,+                         quipper-utils,+                         quipper-language,+                         quipper-libraries+                         +executable Comments+           main-is: Quipper/Demos/Comments.hs+           build-depends:+                         base >= 4.5 && < 5,+                         quipper-utils,+                         quipper-language,+                         quipper-libraries+                         +executable CountAccess+           main-is: Quipper/Demos/CountAccess.hs+           build-depends:+                         base >= 4.5 && < 5,+                         quipper-utils,+                         quipper-language,+                         quipper-libraries+                         +executable Decompose_test+           main-is: Quipper/Demos/Decompose_test.hs+           build-depends:+                         base >= 4.5 && < 5,+                         quipper-utils,+                         quipper-language,+                         quipper-libraries+                         +executable DynamicLifting+           main-is: Quipper/Demos/DynamicLifting.hs+           build-depends:+                         base >= 4.5 && < 5,+                         quipper-utils,+                         quipper-language,+                         quipper-libraries+                         +executable ErrorCircuit+           main-is: Quipper/Demos/ErrorCircuit.hs+           build-depends:+                         base >= 4.5 && < 5,+                         quipper-utils,+                         quipper-language,+                         quipper-libraries+                         +executable Example1+           main-is: Quipper/Demos/Example1.hs+           build-depends:+                         base >= 4.5 && < 5,+                         quipper-utils,+                         quipper-language,+                         quipper-libraries+                         +executable Example2+           main-is: Quipper/Demos/Example2.hs+           build-depends:+                         base >= 4.5 && < 5,+                         quipper-utils,+                         quipper-language,+                         quipper-libraries+                         +executable Example3+           main-is: Quipper/Demos/Example3.hs+           build-depends:+                         base >= 4.5 && < 5,+                         quipper-utils,+                         quipper-language,+                         quipper-libraries+                         +executable Example4+           main-is: Quipper/Demos/Example4.hs+           build-depends:+                         base >= 4.5 && < 5,+                         quipper-utils,+                         quipper-language,+                         quipper-libraries+                         +executable Example+           main-is: Quipper/Demos/Example.hs+           build-depends:+                         base >= 4.5 && < 5,+                         quipper-utils,+                         quipper-language,+                         quipper-libraries+                         +executable GPhase+           main-is: Quipper/Demos/GPhase.hs+           build-depends:+                         base >= 4.5 && < 5,+                         quipper-utils,+                         quipper-language,+                         quipper-libraries+                         +executable HelloWorld+           main-is: Quipper/Demos/HelloWorld.hs+           build-depends:+                         base >= 4.5 && < 5,+                         quipper-utils,+                         quipper-language,+                         quipper-libraries+                         +executable Infinite+           main-is: Quipper/Demos/Infinite.hs+           build-depends:+                         base >= 4.5 && < 5,+                         quipper-utils,+                         quipper-language,+                         quipper-libraries++executable MultiControlledNot+           main-is: Quipper/Demos/MultiControlledNot.hs+           build-depends:+                         base >= 4.5 && < 5,+                         quipper-utils,+                         quipper-language,+                         quipper-libraries+                                                  +executable NamedGate+           main-is: Quipper/Demos/NamedGate.hs+           build-depends:+                         base >= 4.5 && < 5,+                         quipper-utils,+                         quipper-language,+                         quipper-libraries+                         +executable NBox+           main-is: Quipper/Demos/NBox.hs+           build-depends:+                         base >= 4.5 && < 5,+                         quipper-utils,+                         quipper-language,+                         quipper-libraries+                         +executable NoControl+           main-is: Quipper/Demos/NoControl.hs+           build-depends:+                         base >= 4.5 && < 5,+                         quipper-utils,+                         quipper-language,+                         quipper-libraries+                         +executable OptimTest+           main-is: Quipper/Demos/OptimTest.hs+           build-depends:+                         base >= 4.5 && < 5,+                         quipper-utils,+                         quipper-language,+                         quipper-libraries+                         +executable ParseNodeRoot+           main-is: Quipper/Demos/ParseNodeRoot.hs+           build-depends:+                         base >= 4.5 && < 5,+                         quipper-utils,+                         quipper-language,+                         quipper-libraries+                         +executable PhaseTest+           main-is: Quipper/Demos/PhaseTest.hs+           build-depends:+                         base >= 4.5 && < 5,+                         quipper-utils,+                         quipper-language,+                         quipper-libraries+                         +executable QEC+           main-is: Quipper/Demos/QEC.hs+           build-depends:+                         base >= 4.5 && < 5,+                         quipper-utils,+                         quipper-language,+                         quipper-libraries+                         +executable QFTAdder+           main-is: Quipper/Demos/QFTAdder.hs+           build-depends:+                         base >= 4.5 && < 5,+                         quipper-utils,+                         quipper-language,+                         quipper-libraries+                         +executable QFT+           main-is: Quipper/Demos/QFT.hs+           build-depends:+                         base >= 4.5 && < 5,+                         quipper-utils,+                         quipper-language,+                         quipper-libraries+                         +executable QRAM+           main-is: Quipper/Demos/QRAM.hs+           build-depends:+                         base >= 4.5 && < 5,+                         quipper-utils,+                         quipper-language,+                         quipper-libraries+                         +executable QuantumIfTest+           main-is: Quipper/Demos/QuantumIfTest.hs+           build-depends:+                         base >= 4.5 && < 5,+                         quipper-utils,+                         quipper-language,+                         quipper-libraries+                         +executable Reverse+           main-is: Quipper/Demos/Reverse.hs+           build-depends:+                         base >= 4.5 && < 5,+                         quipper-utils,+                         quipper-language,+                         quipper-libraries+                         +executable SimpleOracleSimulation+           main-is: Quipper/Demos/SimpleOracleSimulation.hs+           build-depends:+                         base >= 4.5 && < 5,+                         containers >= 0.5.2.1,+                         quipper-utils,+                         quipper-language,+                         quipper-libraries+           other-modules:+                         Quipper.Algorithms.BWT.Definitions+                         Quipper.Algorithms.BWT.BWT+                         Quipper.Algorithms.BWT.Alternative+                         +executable SimulationTest+           main-is: Quipper/Demos/SimulationTest.hs+           build-depends:+                         base >= 4.5 && < 5,+                         random >= 1.0.1.1,+                         quipper-utils,+                         quipper-language,+                         quipper-libraries+                         +executable SynthesisTest+           main-is: Quipper/Demos/SynthesisTest.hs+           build-depends:+                         base >= 4.5 && < 5,+                         random >= 1.0.1.1,+                         newsynth >= 0.3.0.1,+                         quipper-utils,+                         quipper-language,+                         quipper-libraries+                         +executable TeleportGeneric+           main-is: Quipper/Demos/TeleportGeneric.hs+           build-depends:+                         base >= 4.5 && < 5,+                         random >= 1.0.1.1,+                         quipper-utils,+                         quipper-language,+                         quipper-libraries+                         +executable Teleport+           main-is: Quipper/Demos/Teleport.hs+           build-depends:+                         base >= 4.5 && < 5,+                         quipper-utils,+                         quipper-language,+                         quipper-libraries+                         +executable TemplateTest+           main-is: Quipper/Demos/TemplateTest.hs+           build-depends:+                         base >= 4.5 && < 5,+                         quipper-utils,+                         quipper-language,+                         quipper-libraries+                         +executable Test+           main-is: Quipper/Demos/Test.hs+           build-depends:+                         base >= 4.5 && < 5,+                         quipper-utils,+                         quipper-language,+                         quipper-libraries+                         +executable Testing+           main-is: Quipper/Demos/Testing.hs+           build-depends:+                         base >= 4.5 && < 5,+                         quipper-utils,+                         quipper-language,+                         quipper-libraries+                         +executable TimeStep-binary+           main-is: Quipper/Demos/TimeStep-binary.hs+           build-depends:+                         base >= 4.5 && < 5,+                         quipper-utils,+                         quipper-language,+                         quipper-libraries+           other-modules:+                         Quipper.Algorithms.BWT.Definitions+                         +executable TimeStep+           main-is: Quipper/Demos/TimeStep.hs+           build-depends:+                         base >= 4.5 && < 5,+                         quipper-utils,+                         quipper-language,+                         quipper-libraries+           other-modules:+                         Quipper.Algorithms.BWT.Definitions+                         +executable TransformerExample+           main-is: Quipper/Demos/TransformerExample.hs+           build-depends:+                         base >= 4.5 && < 5,+                         quipper-utils,+                         quipper-language,+                         quipper-libraries+                         +executable WithComputed+           main-is: Quipper/Demos/WithComputed.hs+           build-depends:+                         base >= 4.5 && < 5,+                         quipper-utils,+                         quipper-language,+                         quipper-libraries++custom-setup+  setup-depends:  base >= 4.5,+                  Cabal >= 1.24,+                  quipper-cabal >= 0.9.0.0