├── .gitattributes ├── .github └── workflows │ └── test.yml ├── .gitignore ├── .gitlab-ci.yml ├── .travis.yml ├── ACKNOWLEDGEMENTS.md ├── CODEOWNERS ├── CONTRIBUTING.md ├── Dockerfile ├── LICENSE.txt ├── Makefile ├── README.md ├── VERSION.txt ├── app ├── LICENSE.txt ├── emacs │ └── gud-qvm-debugger.el ├── src │ ├── api │ │ ├── README.md │ │ ├── common.lisp │ │ ├── expectation.lisp │ │ ├── info.lisp │ │ ├── multishot-measure.lisp │ │ ├── multishot.lisp │ │ ├── ping.lisp │ │ ├── probabilities.lisp │ │ ├── run-for-effect.lisp │ │ ├── version.lisp │ │ └── wavefunction.lisp │ ├── benchmark-programs.lisp │ ├── build-configuration.lisp │ ├── configure-qvm.lisp │ ├── debugger.lisp │ ├── entry-point.lisp │ ├── globals.lisp │ ├── handle-request.lisp │ ├── impl │ │ ├── clozure.lisp │ │ └── sbcl.lisp │ ├── mangle-shared-objects.lisp │ ├── package.lisp │ ├── qvm-app-version.lisp │ ├── server-abstraction.lisp │ ├── shm-info-server.lisp │ └── utilities.lisp └── tests │ ├── package.lisp │ ├── suite.lisp │ └── utils.lisp ├── bench ├── 20H.quil ├── 25H.quil ├── 5x4x25.quil ├── H4.quil ├── H6.quil ├── bench.lisp ├── entangle-25.quil ├── package.lisp ├── qaoa_8q.quil ├── quil-files.lisp └── suite.lisp ├── build-app.lisp ├── coverage-report └── coverage-report.lisp ├── doc ├── editing-and-running.md ├── lisp-setup.md └── man │ └── qvm.1 ├── docker └── test.sh ├── dqvm ├── README.md ├── dqvm2-tests.asd ├── dqvm2.asd ├── scripts │ ├── build-dqvm2-sbcl │ └── run-dqvm2 ├── src │ ├── addresses.lisp │ ├── apply-distributed-gate.lisp │ ├── distributed-qvm.lisp │ ├── entry-point.lisp │ ├── global-addresses.lisp │ ├── linear-algebra.lisp │ ├── logging.lisp │ ├── measurement.lisp │ ├── mpi.lisp │ ├── offset-arrays.lisp │ ├── package.lisp │ ├── permutation.lisp │ ├── sendrecv.lisp │ ├── transition.lisp │ └── utilities.lisp └── tests │ ├── addresses-tests.lisp │ ├── distributed-qvm-tests.lisp │ ├── offset-arrays-tests.lisp │ ├── package.lisp │ ├── permutation-tests.lisp │ ├── program-tests.lisp │ └── suite.lisp ├── examples ├── bell.quil ├── package.lisp ├── qaoa.lisp ├── qft.lisp └── vqe.lisp ├── quil ├── circs.quil ├── other.quil ├── stdgates.quil └── vqe.quil ├── qvm-app-tests.asd ├── qvm-app.asd ├── qvm-benchmarks.asd ├── qvm-examples.asd ├── qvm-tests.asd ├── qvm.asd ├── scripts ├── prof.lisp └── shared_qvm.py ├── src ├── allocator.lisp ├── apply-gate.lisp ├── basic-noise-qvm.lisp ├── channel-qvm.lisp ├── classical-memory-mixin.lisp ├── classical-memory.lisp ├── compile-gate.lisp ├── config.lisp ├── density-qvm.lisp ├── depolarizing-noise.lisp ├── error │ ├── README.md │ ├── error-qvm.lisp │ ├── fowler-noise.lisp │ └── package.lisp ├── execution.lisp ├── floats.lisp ├── grovel-shared-memory.lisp ├── grovel-system-constants.lisp ├── impl │ ├── allegro.lisp │ ├── clozure.lisp │ ├── linear-algebra-intrinsics.lisp │ ├── lispworks.lisp │ ├── prefetch-intrinsics.lisp │ ├── sbcl-avx-vops.lisp │ ├── sbcl-intrinsics.lisp │ ├── sbcl-x86-vops.lisp │ └── sbcl.lisp ├── linear-algebra.lisp ├── measurement.lisp ├── misc.lisp ├── mixed-state-qvm.lisp ├── noise-models.lisp ├── noisy-qvm.lisp ├── package.lisp ├── path-simulate.lisp ├── qam.lisp ├── qvm.lisp ├── serial-kernels.lisp ├── shm.lisp ├── stabilizer-qvm.lisp ├── state-representation.lisp ├── subsystem.lisp ├── transition-classical-instructions.lisp ├── transition.lisp ├── unitary-qvm.lisp ├── utilities.lisp └── wavefunction.lisp └── tests ├── basic-noise-qvm-tests.lisp ├── channel-qvm-tests.lisp ├── classical-memory-tests.lisp ├── density-qvm-tests.lisp ├── error-qvm-tests.lisp ├── gate-tests.lisp ├── instruction-tests.lisp ├── linear-algebra-tests.lisp ├── measurement-tests.lisp ├── modifier-tests.lisp ├── noise-model-tests.lisp ├── noisy-qvm-tests.lisp ├── package.lisp ├── parallel-tests.lisp ├── path-simulate-tests.lisp ├── qvm-avx-intrinsics.lisp ├── qvm-tests.lisp ├── stabilizer-qvm-tests.lisp ├── state-representation-tests.lisp ├── stress-tests.lisp ├── subsystem-tests.lisp ├── suite.lisp ├── unitary-tests.lisp ├── utilities-tests.lisp ├── utilities.lisp └── wavefunction-tests.lisp /.gitattributes: -------------------------------------------------------------------------------- 1 | *.lisp text eol=lf 2 | -------------------------------------------------------------------------------- /.github/workflows/test.yml: -------------------------------------------------------------------------------- 1 | name: Tests 2 | 3 | on: 4 | push: 5 | branches: [ master ] 6 | pull_request: 7 | branches: [ master ] 8 | 9 | workflow_dispatch: 10 | 11 | jobs: 12 | test-qvm-lib: 13 | name: Test QVM library 14 | runs-on: ubuntu-latest 15 | steps: 16 | - uses: actions/checkout@v2 17 | 18 | - name: Run QVM library tests 19 | run: | 20 | sudo apt install sbcl 21 | make quicklisp 22 | sudo make install-test-deps 23 | make test-lib 24 | 25 | 26 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *~ 2 | *.fasl 3 | build-output.log 4 | docker_qvm.tar 5 | qvm 6 | qvm-ng 7 | quilbasic 8 | system-index.txt 9 | .idea/ 10 | -------------------------------------------------------------------------------- /.gitlab-ci.yml: -------------------------------------------------------------------------------- 1 | include: 2 | - project: rigetti/ci 3 | file: pipelines/docker.gitlab-ci.yml 4 | 5 | variables: 6 | IMAGE: rigetti/qvm 7 | 8 | .test: 9 | stage: test 10 | tags: 11 | - github 12 | - dockerd 13 | only: 14 | - branches 15 | image: 16 | name: docker:stable 17 | 18 | test-qvm-lib: 19 | extends: .test 20 | script: 21 | - docker build -t rigetti/qvm:${CI_COMMIT_SHORT_SHA} . 22 | - docker run --rm --entrypoint=make rigetti/qvm:${CI_COMMIT_SHORT_SHA} 23 | test-lib DISABLE_SHARED_MEMORY_QVM_TESTS=1 RIGETTI_LISP_LIBRARY_HOME=/src 24 | - docker rmi rigetti/qvm:${CI_COMMIT_SHORT_SHA} 25 | 26 | test-qvm-app: 27 | extends: .test 28 | script: 29 | - docker build -t rigetti/qvm:${CI_COMMIT_SHORT_SHA} . 30 | - docker run --rm --entrypoint=make rigetti/qvm:${CI_COMMIT_SHORT_SHA} 31 | test-app RIGETTI_LISP_LIBRARY_HOME=/src 32 | - docker rmi rigetti/qvm:${CI_COMMIT_SHORT_SHA} 33 | 34 | # same as test-qvm-lib but builds off of quilc master, and we allow failure 35 | test-qvm-lib-edge: 36 | extends: .test 37 | allow_failure: true 38 | script: 39 | - docker build -t rigetti/qvm:${CI_COMMIT_SHORT_SHA} --build-arg quilc_version=edge . 40 | - docker run --rm --entrypoint=make rigetti/qvm:${CI_COMMIT_SHORT_SHA} 41 | test-lib DISABLE_SHARED_MEMORY_QVM_TESTS=1 RIGETTI_LISP_LIBRARY_HOME=/src 42 | - docker rmi rigetti/qvm:${CI_COMMIT_SHORT_SHA} 43 | 44 | # same as test-qvm-app but builds off of quilc master, and we allow failure 45 | test-qvm-app-edge: 46 | extends: .test 47 | allow_failure: true 48 | script: 49 | - docker build -t rigetti/qvm:${CI_COMMIT_SHORT_SHA} --build-arg quilc_version=edge . 50 | - docker run --rm --entrypoint=make rigetti/qvm:${CI_COMMIT_SHORT_SHA} 51 | test-app RIGETTI_LISP_LIBRARY_HOME=/src 52 | - docker rmi rigetti/qvm:${CI_COMMIT_SHORT_SHA} 53 | 54 | test-qvm-app-ng-edge: 55 | extends: .test 56 | allow_failure: true 57 | script: 58 | - docker build -t rigetti/qvm:${CI_COMMIT_SHORT_SHA} --build-arg quilc_version=edge . 59 | - docker run --rm --entrypoint=make rigetti/qvm:${CI_COMMIT_SHORT_SHA} 60 | test-app-ng RIGETTI_LISP_LIBRARY_HOME=/src 61 | - docker rmi rigetti/qvm:${CI_COMMIT_SHORT_SHA} 62 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | env: 2 | - TARGET=lib 3 | - TARGET=app 4 | 5 | services: 6 | - docker 7 | 8 | script: 9 | - docker build -t rigetti/qvm:${TRAVIS_COMMIT} . 10 | - docker run --rm --entrypoint=make rigetti/qvm:${TRAVIS_COMMIT} test-${TARGET} DISABLE_SHARED_MEMORY_QVM_TESTS=1 RIGETTI_LISP_LIBRARY_HOME=/src 11 | - docker rmi rigetti/qvm:${TRAVIS_COMMIT} 12 | -------------------------------------------------------------------------------- /ACKNOWLEDGEMENTS.md: -------------------------------------------------------------------------------- 1 | # Acknowledgements 2 | 3 | ## Pre-Release History 4 | 5 | Starting in 2016, Robert Smith started the Rigetti QVM (née `qsim`) 6 | as a substrate to study syntax and semantics for quantum programming 7 | languages. At the time, the predominant syntax for quantum programs 8 | was the graphical circuit notation, along with its accompanying LaTeX 9 | syntax [qasm](https://www.media.mit.edu/quanta/qasm2circ/). It also 10 | served as a foundation for understanding "computational quantum 11 | computation". 12 | 13 | The first Rigetti QVM implemented something akin to the "many worlds" 14 | interpretation of quantum mechanics. Quantum programs were written 15 | directly as Lisp programs, and each measurement split the "state of 16 | the universe", and simulation tracked across each universe. This 17 | proved neither efficient nor useful in the study and execution of 18 | near-term algorithms, so it was changed to operate in the usual mode 19 | with stochastic collapse of the wavefunction. 20 | 21 | With Will Zeng's motivation, the QVM moved in a direction of being 22 | more accessible. In order to make quantum programs easier to write, a 23 | text-based S-expression syntax was used, until the development of 24 | CL-QUIL and `quilc`, which included a parser for a quantum programming 25 | language—an assembly-like language called Quil. The QVM ended up being 26 | an implementation of Quil's quantum abstract machine. 27 | 28 | The Rigetti QVM eventually implemented the full Quil language, and was 29 | deployed as the primary backend to the Forest 1.0 service by the end 30 | of 2016. 31 | 32 | The QVM implemented a relatively efficient form of pure-state 33 | evolution, though it didn't go through a handful of microarchitecture 34 | optimizations until later. With Nick Rubin constantly challenging the 35 | speed of the QVM, the QVM saw improvements over the course of a year, 36 | bringing it to a level that was relatively competitive with other 37 | simulators. Later, full multithreading was implemented. 38 | 39 | Additional modes of execution for noisy simulations were added by 40 | Nikolas Tezak and Erik Davis in 2017 and 2018 respectively. In 2017, 41 | Robert Smith implemented the JIT compiler for Quil, causing it to 42 | outperform OpenMP-optimized C programs, sometimes by a factor between 43 | 2 and 10. 44 | 45 | During the development of the QVM, many people have made a range of 46 | contributions. A summary of these can be found at the end of this 47 | document. 48 | 49 | The Rigetti QVM has benefited extensively from internal testers at 50 | Rigetti. We provide special acknowledgement to Johannes Otterbach, who 51 | found countless functional and performance issues. The QVM also 52 | benefited from the thousands of users of Quantum Cloud Services. 53 | 54 | ## Credits Roll 55 | 56 | For security and privacy, the git history has been removed. The 57 | contributors of the project, in approximately the order of their 58 | commit count according to `git shortlog --summary --numbered`, prior 59 | to open-sourcing were: 60 | 61 | * **Robert Smith** (main developer) 62 | * **Erik Davis** (density matrix simulation) 63 | * **Zach Beane** (porting to CCL & LispWorks) 64 | * **Nikolas Tezak** (stochastic simulation) 65 | * **Mark Skilbeck** (porting and testing on Windows) 66 | * **Peter Karalekas** (release management, automated testing, versioning, `nat-tuple` testing ☺️) 67 | * **Eric Peterson** (fixes and improvements to the app) 68 | * **Will Zeng** (installation, Dockerization, deployment, GHZ-on-a-grid in original QIL) 69 | * **Nick Rubin** (VQE improvements) 70 | * **Anthony Polloreno** (wavefunction sampling) 71 | * **Aaron Vontell** (runtime safety checks) 72 | * **Johannes Otterbach** (extensive testing and documentation improvements) 73 | 74 | ## Open Source 75 | 76 | The Rigetti QVM proudly depends on the work of the open source 77 | community, as well as [SBCL](http://www.sbcl.org/), 78 | [ASDF](https://common-lisp.net/project/asdf/), and Zach Beane's 79 | continued maintenance of the [Quicklisp](https://www.quicklisp.org/) 80 | project and repository. 81 | -------------------------------------------------------------------------------- /CODEOWNERS: -------------------------------------------------------------------------------- 1 | # default codeowners for all files 2 | * @rigetti/qvm 3 | -------------------------------------------------------------------------------- /CONTRIBUTING.md: -------------------------------------------------------------------------------- 1 | # Contributor Guidelines 2 | 3 | We value and encourage contribution from the community. To reduce 4 | friction in this process, we have collected some best-practices for 5 | contributors: 6 | 7 | * Testing. Before making a pull-request (PR), please make sure that 8 | you have added sufficient test coverage to your changes and that you 9 | have run the test suite. You can run tests by invoking `make test` in 10 | the project root. Code coverage statistics can be compiled by 11 | running `sbcl --load coverage-report.lisp` in the `coverage-report` 12 | directory. 13 | * Documentation. Provide concise but clear documentation for your 14 | changes. In general, all public functions (those exported in 15 | `package.lisp`) *must* have docstrings. Internal functions should 16 | usually be documented though it is less important. Documentation 17 | should also be provided as comments to your code. In particular, 18 | non-obvious code should be accompanied by detailed explanation of 19 | its working. 20 | * Pull Request. The typical workflow for contributing to an 21 | open-source project is 22 | 1. Create a fork of the project. 23 | 2. Create a branch for your work. This should be appropriately 24 | named, often with a descriptive prefix of `feature/` or `fix/`. 25 | 3. Create a PR to the original project. The PR should have a concise 26 | title stating the intent of the PR, followed by a more detailed 27 | description of the proposed changes including arguments for those 28 | changes. 29 | 4. Your code will be reviewed. You should participate in the review, 30 | making changes where suggested and pushing them to the PR branch. 31 | 5. If all goes well, your code will be merged and you will be 32 | attributed in the ACKNOWLEDGEMENTS file. 33 | * Style. In general, follow the [Google Common-Lisp style guide](https://google.github.io/styleguide/lispguide.xml). If 34 | there is an inconsistency between the style guide and neighboring 35 | code, follow the style of the neighboring code. Use code formatting 36 | (indentation) that is equivalent to that of GNU Emacs' 37 | `common-lisp-mode`. 38 | * Be polite. 39 | -------------------------------------------------------------------------------- /Dockerfile: -------------------------------------------------------------------------------- 1 | # specify the dependency versions (can be overriden with --build_arg) 2 | ARG quilc_version=1.17.0 3 | ARG quicklisp_version=2020-02-18 4 | 5 | # use multi-stage builds to independently pull dependency versions 6 | FROM rigetti/quilc:$quilc_version as quilc 7 | FROM rigetti/lisp:$quicklisp_version 8 | 9 | # copy over quilc source from the first build stage 10 | COPY --from=quilc /src/quilc /src/quilc 11 | 12 | ARG build_target 13 | 14 | # build the qvm app 15 | ADD . /src/qvm 16 | WORKDIR /src/qvm 17 | RUN git clean -fdx && make ${build_target} install 18 | 19 | EXPOSE 5000 20 | 21 | ENTRYPOINT ["./qvm"] 22 | -------------------------------------------------------------------------------- /VERSION.txt: -------------------------------------------------------------------------------- 1 | "1.18.0" 2 | -------------------------------------------------------------------------------- /app/emacs/gud-qvm-debugger.el: -------------------------------------------------------------------------------- 1 | ;;; gud-qvm-debugger.el --- GUD mode for the QVM debugger 2 | 3 | ;; Copyright (C) 2020 Rigetti Computing 4 | 5 | ;; Author: Juan Bello-Rivas 6 | ;; Keywords: gud, quil, qvm 7 | 8 | ;;; Commentary: 9 | 10 | ;;; Code: 11 | 12 | (require 'gud) 13 | 14 | (defcustom gud-qvm-debugger-command-name "qvm --debugger" 15 | "Default command to run the QVM debugger." 16 | :type 'string 17 | :group 'gud) 18 | 19 | (defun qvm-debugger (command-line) 20 | "Invoke the Quil debugger with COMMAND-LINE arguments." 21 | (interactive 22 | (list (gud-query-cmdline 'qvm-debugger))) 23 | 24 | (gud-common-init command-line 'gud-qvm-debugger-massage-args 'gud-qvm-debugger-marker-filter) 25 | (set (make-local-variable 'gud-minor-mode) 'qvm-debugger) 26 | 27 | (gud-def gud-step "step" "\C-s" "Step one line with display.") 28 | (gud-def gud-cont "continue" "\C-r" "Continue with display.") 29 | 30 | (setq comint-prompt-regexp "^(qvm-debugger) *") 31 | (setq paragraph-start comint-prompt-regexp)) 32 | 33 | (defun gud-qvm-debugger-massage-args (_file args) 34 | "Massage ARGS." 35 | args) 36 | 37 | (defun gud-qvm-debugger-marker-filter (string) 38 | "Filter the markers in STRING." 39 | string) 40 | 41 | (defvar gud-qvm-debugger-history nil) 42 | 43 | (provide 'gud-qvm-debugger) 44 | ;;; gud-qvm-debugger.el ends here 45 | -------------------------------------------------------------------------------- /app/src/api/README.md: -------------------------------------------------------------------------------- 1 | ## API Requests 2 | 3 | All API requests are tagged with a *type* (in JSON it is a string such as `"ping"`, in Lisp code it is most-commonly a keyword as in `:ping`), and handling of requests is controlled by `handle-post-request`. Among other things, this function extracts the type from a HTTP POST request, and dispatches to an appropriate *handler*, i.e. a Lisp function which is responsible for doing most of request-specific work. 4 | 5 | Roughly speaking, requests can be divided into two camps: 6 | 7 | 1. Some requests have a behavior which is agnostic to the QVM simulation method (e.g. `:ping`, `:version`). 8 | 2. Other requests have a behavior which depends on the simulation method (e.g. `:wavefunction`, `:multishot-measure`). 9 | 10 | Handlers for requests of the first type are ordinary Lisp functions. Handlers for requests of the second type are generic functions to be specialized on their first argument (a value of type `simulation-method`). 11 | 12 | ### Undefined API Methods 13 | 14 | In the event that a given request type is not implemented for a given simulation method, the handler method should signal an `api-method-not-implemented` condition. 15 | 16 | 17 | -------------------------------------------------------------------------------- /app/src/api/common.lisp: -------------------------------------------------------------------------------- 1 | ;;;; api/common.lisp 2 | ;;;; 3 | ;;;; Author: Erik Davis 4 | 5 | (in-package #:qvm-app) 6 | 7 | (define-condition api-method-not-implemented (error) 8 | ((method :initarg :method 9 | :reader api-method 10 | :documentation "The name of the API method.") 11 | (simulation-method :initarg :simulation-method 12 | :reader active-simulation-method 13 | :documentation "The active QVM simulation method.")) 14 | (:report (lambda (condition stream) 15 | (format stream "API method ~A not supported when QVM is using ~A simulation method." 16 | (api-method condition) 17 | (active-simulation-method condition)))) 18 | (:documentation "Indicates that the given API method is not implemented for a specific simulation method.")) 19 | 20 | (defun api-method-not-implemented-error (method) 21 | "Signal that the given API method named METHOD is not implemented." 22 | (error 'api-method-not-implemented 23 | :method method 24 | :simulation-method *simulation-method*)) 25 | -------------------------------------------------------------------------------- /app/src/api/expectation.lisp: -------------------------------------------------------------------------------- 1 | ;;;; api/expectation.lisp 2 | ;;;; 3 | ;;;; Author: Robert Smith 4 | 5 | (in-package #:qvm-app) 6 | 7 | (defgeneric perform-expectation (simulation-method state-prep operators num-qubits &key gate-noise measurement-noise) 8 | (:method (simulation-method state-prep operators num-qubits &key gate-noise measurement-noise) 9 | (declare (ignore gate-noise measurement-noise)) 10 | (api-method-not-implemented-error 'perform-expectation))) 11 | 12 | 13 | (defmethod perform-expectation ((simulation-method (eql 'full-density-matrix)) state-prep operators num-qubits &key gate-noise measurement-noise) 14 | "Let ρ be the density matrix resulting from STATE-PREP on the zero state. Then compute a list of real expectation values of the operators in OPERATORS, namely, 15 | 16 | tr(ρ O1), tr(ρ O2), ... for Oi in OPERATORS. 17 | " 18 | (%perform-expectation simulation-method #'mixed-state-expectation state-prep operators num-qubits gate-noise measurement-noise)) 19 | 20 | (defmethod perform-expectation ((simulation-method (eql 'pure-state)) state-prep operators num-qubits &key gate-noise measurement-noise) 21 | "Let F be the wavefunction resulting from STATE-PREP on the zero state. Then compute a list of real expectation values of the operators in OPERATORS, namely, 22 | 23 | , , ... for Oi in OPERATORS. 24 | " 25 | (%perform-expectation simulation-method #'pure-state-expectation state-prep operators num-qubits gate-noise measurement-noise)) 26 | 27 | (defun %perform-expectation (simulation-method expectation-op state-prep operators num-qubits gate-noise measurement-noise) 28 | (check-type state-prep quil:parsed-program) 29 | (dolist (o operators) (check-type o quil:parsed-program)) 30 | (check-type num-qubits (integer 0)) 31 | (check-type gate-noise (or null alexandria:proper-list)) 32 | (check-type measurement-noise (or null alexandria:proper-list)) 33 | (assert (and (or (null gate-noise) 34 | (= 3 (length gate-noise))) 35 | (every #'realp gate-noise))) 36 | (assert (and (or (null measurement-noise) 37 | (= 3 (length measurement-noise))) 38 | (every #'realp measurement-noise))) 39 | 40 | ;; If we have nothing to compute the expectation of, then return 41 | ;; nothing. 42 | (when (null operators) 43 | (format-log "No operators to compute expectation of. Returning NIL.") 44 | (return-from %perform-expectation '())) 45 | 46 | ;; Otherwise, go about business. 47 | (let ((qvm (make-appropriate-qvm simulation-method state-prep num-qubits gate-noise measurement-noise)) 48 | timing) 49 | ;; Make the initial state. 50 | (qvm:load-program qvm state-prep) 51 | (format-log "Computing initial state for expectation value ~ 52 | computation on ~A" 53 | (class-name (class-of qvm))) 54 | (with-timing (timing) 55 | (with-timeout 56 | (qvm:run qvm))) 57 | (format-log "Finished state prep in ~D ms." timing) 58 | (format-log "Copying prepared state.") 59 | (let ((prepared-wf 60 | (with-timing (timing) 61 | (qvm:copy-wavefunction (qvm::amplitudes qvm)))) 62 | (first-time t)) 63 | (format-log "Copied prepared state in ~D ms." timing) 64 | ;; Compute the expectations of the operators. 65 | (loop :for i :from 1 66 | :for op :in operators 67 | :collect (let (expectation) 68 | (format-log "Computing the expectation value of the ~:R operator." i) 69 | (with-timing (timing) 70 | (setf expectation (funcall expectation-op qvm prepared-wf op first-time)) 71 | (setf first-time nil)) 72 | (format-log "Computed ~:R expectation value in ~D ms." i timing) 73 | (assert (< (abs (imagpart expectation)) 1e-14)) 74 | (unless (zerop (imagpart expectation)) 75 | (warn "Non-zero but acceptable imaginary part of expectation value: ~A" expectation)) 76 | (realpart expectation)))))) 77 | 78 | (defun pure-state-expectation (qvm prepared-state op &optional first-time) 79 | (flet ((inner-product (a b) 80 | (declare (type qvm::quantum-state a b)) 81 | (loop :for ai :of-type qvm::cflonum :across a 82 | :for bi :of-type qvm::cflonum :across b 83 | :sum (* (conjugate ai) bi)))) 84 | (unless first-time 85 | (qvm:copy-wavefunction prepared-state (qvm::amplitudes qvm))) 86 | (qvm:load-program qvm op) 87 | (qvm:run qvm) 88 | (inner-product prepared-state 89 | (qvm::amplitudes qvm)))) 90 | 91 | (defun mixed-state-expectation (qvm prepared-state op &optional first-time) 92 | "Computes tr(Q ρ) where Q is the Hermitian matrix corresponding to 93 | the quil program OP, and ρ is the density matrix represented as the 94 | amplitudes in PREPARED-STATE." 95 | (declare (ignore first-time)) 96 | (destructuring-bind (rows cols) (array-dimensions (qvm::matrix-view (qvm::state qvm))) 97 | ;; MAGICL:MAKE-MATRIX constructs a column-major matrix, whereas 98 | ;; PREPARED-STATE is the row-major vectorization of ρ. We prefer 99 | ;; to apply the transpose to OP-MATRIX below, since it is 100 | ;; generally smaller. Thus we compute tr(Q^T ρ^T) = tr((ρ Q)^T) = tr(ρ Q) = tr(Q ρ). 101 | (let ((op-matrix (magicl:transpose 102 | (quil::parsed-program-to-logical-matrix op))) 103 | (density-matrix (magicl:from-array prepared-state 104 | (list rows cols) 105 | :type '(complex double-float)))) 106 | (reduce #'+ (magicl:diag 107 | (quil::matrix-rescale-and-multiply op-matrix density-matrix)))))) 108 | -------------------------------------------------------------------------------- /app/src/api/info.lisp: -------------------------------------------------------------------------------- 1 | ;;;; api/info.lisp 2 | ;;;; 3 | ;;;; Author: Erik Davis 4 | 5 | (in-package #:qvm-app) 6 | 7 | 8 | (defun handle-info () 9 | "Return a string representation of a JSON object whose key-value 10 | pairs correspond to QVM-APP variables and their values at the time of 11 | the INFO request." 12 | (let ((info 13 | (alexandria:plist-hash-table 14 | (list "simulation-method" (princ-to-string *simulation-method*) 15 | "shared-memory-object-name" (princ-to-string *shared-memory-object-name*) 16 | "qubit-limit" (princ-to-string *qubit-limit*)) 17 | :test 'equal))) 18 | (with-output-to-string (s) 19 | (yason:encode info s)))) 20 | -------------------------------------------------------------------------------- /app/src/api/multishot-measure.lisp: -------------------------------------------------------------------------------- 1 | ;;;; api/multishot-measure.lisp 2 | ;;;; 3 | ;;;; Author: Robert Smith 4 | 5 | (in-package #:qvm-app) 6 | 7 | (defun qubits-in-range-p (qam qubits) 8 | "Are all qubits in the list QUBITS in range of the QAM?" 9 | (loop :with maxq := (1- (number-of-qubits qam)) 10 | :for q :in (remove ':unused-qubit qubits) 11 | :always (<= 0 q maxq))) 12 | 13 | (defun parallel-measure (qvm &optional qubits) 14 | (cond 15 | ;; Fast path: measure all of the qubits. Note that we check for 16 | ;; "all" by checking that we have n distinct qubits. 17 | ((= (qvm:number-of-qubits qvm) 18 | (count-if-not (lambda (q) (eql q ':unused-qubit)) 19 | (remove-duplicates qubits))) 20 | (let ((bits (nth-value 1 (qvm:measure-all qvm)))) 21 | (loop :for q :in qubits 22 | :if (eql q ':unused-qubit) 23 | :collect 0 24 | :else 25 | :collect (nth q bits)))) 26 | ;; Slow path. Measure only some of the qubits. 27 | ;; 28 | ;; XXX: Debate whether we actually shouldn't just MEASURE-ALL 29 | ;; and take only some of the qubits. This would have 30 | ;; repercussions on a persistent QVM. 31 | (t 32 | (loop :for q :in qubits 33 | :if (eql q ':unused-qubit) 34 | :collect 0 35 | :else 36 | :collect (nth-value 1 (qvm:measure qvm q)))))) 37 | 38 | (defgeneric perform-multishot-measure (simulation-method quil num-qubits qubits num-trials relabeling) 39 | (:method (simulation-method quil num-qubits qubits num-trials relabeling) 40 | (api-method-not-implemented-error 'perform-multishot-measure))) 41 | 42 | (defmethod perform-multishot-measure ((simulation-method (eql 'pure-state)) quil num-qubits qubits num-trials relabeling) 43 | (%perform-multishot-measure simulation-method quil num-qubits qubits num-trials relabeling)) 44 | 45 | (defmethod perform-multishot-measure ((simulation-method (eql 'full-density-matrix)) quil num-qubits qubits num-trials relabeling) 46 | (%perform-multishot-measure simulation-method quil num-qubits qubits num-trials relabeling)) 47 | 48 | (defun %perform-multishot-measure (simulation-method quil num-qubits qubits num-trials relabeling) 49 | (check-type quil quil:parsed-program) 50 | (check-type num-qubits (integer 0)) 51 | (check-type num-trials (integer 0)) 52 | (check-type qubits alexandria:proper-list) 53 | (check-type relabeling (or null (vector unsigned-byte))) 54 | (assert (every (alexandria:conjoin #'integerp (complement #'minusp)) qubits)) 55 | 56 | (when (or (null qubits) (zerop num-trials)) 57 | (return-from %perform-multishot-measure nil)) 58 | 59 | ;; Relabel the qubits according to RELABELING. This is O(N^2), but N 60 | ;; will always be less than 40 or so. 61 | (when relabeling 62 | (setf qubits 63 | (loop :for qubit :in qubits 64 | :collect (or (position qubit relabeling) ':unused-qubit))) 65 | (setf num-qubits 66 | (max num-qubits 67 | (1+ (reduce #'max 68 | (remove ':unused-qubit qubits) 69 | 70 | ;; Specify initial value in case all qubits 71 | ;; are unused. An initial value -1 is 72 | ;; incremented to 0 by outer (1+ ...) call 73 | :initial-value -1))))) 74 | 75 | (let ((qvm (make-appropriate-qvm simulation-method quil num-qubits nil nil)) 76 | timing) 77 | ;; Check that we've asked for sensible qubits. 78 | (assert (qubits-in-range-p qvm qubits) () 79 | "The provided qubits ~S to a multishot measure are out ~ 80 | of range for the given QVM, which only has ~D qubit~:P." 81 | qubits 82 | (number-of-qubits qvm)) 83 | ;; Make the initial state. 84 | (qvm:load-program qvm quil) 85 | (format-log "Computing ~D-qubit state for multishot/measure on ~A." 86 | num-qubits 87 | (class-name (class-of qvm))) 88 | (with-timing (timing) 89 | (with-timeout 90 | (qvm:run qvm))) 91 | (format-log "Finished state computation in ~D ms." timing) 92 | (format-log "Copying state.") 93 | (let ((prepared-wf 94 | (with-timing (timing) 95 | (qvm:copy-wavefunction (qvm::amplitudes qvm)))) 96 | (first-time t)) 97 | (format-log "Copied prepared state in ~D ms." timing) 98 | (flet ((reload (qvm) 99 | (unless first-time 100 | (qvm:copy-wavefunction prepared-wf (qvm::amplitudes qvm))) 101 | (setf first-time nil))) 102 | ;; Do the parallel measurements 103 | (format-log "Doing ~D ~D-qubit measurements." num-trials (length qubits)) 104 | (prog1 105 | (with-timing (timing) 106 | (loop :repeat num-trials 107 | :collect (progn 108 | (reload qvm) 109 | (parallel-measure qvm qubits)))) 110 | (format-log "Done measuring in ~D ms." timing)))))) 111 | -------------------------------------------------------------------------------- /app/src/api/multishot.lisp: -------------------------------------------------------------------------------- 1 | ;;;; api/multishot.lisp 2 | ;;;; 3 | ;;;; Author: Robert Smith 4 | 5 | (in-package #:qvm-app) 6 | 7 | (defgeneric perform-multishot (simulation-method quil num-qubits addresses num-trials &key gate-noise measurement-noise) 8 | (:method (simulation-method quil num-qubits addresses num-trials &key gate-noise measurement-noise) 9 | (declare (ignore gate-noise measurement-noise)) 10 | (api-method-not-implemented-error 'perform-multishot))) 11 | 12 | (defmethod perform-multishot ((simulation-method (eql 'pure-state)) quil num-qubits addresses num-trials &key gate-noise measurement-noise) 13 | (%perform-multishot simulation-method quil num-qubits addresses num-trials gate-noise measurement-noise)) 14 | 15 | (defmethod perform-multishot ((simulation-method (eql 'full-density-matrix)) quil num-qubits addresses num-trials &key gate-noise measurement-noise) 16 | (%perform-multishot simulation-method quil num-qubits addresses num-trials gate-noise measurement-noise)) 17 | 18 | (defun valid-address-query-p (addresses) 19 | (cond 20 | ((not (hash-table-p addresses)) nil) 21 | (t 22 | (maphash (lambda (k v) 23 | (unless (and (stringp k) 24 | (or (eq t v) 25 | (and (alexandria:proper-list-p v) 26 | (every #'integerp v) 27 | (notany #'minusp v)))) 28 | (return-from valid-address-query-p nil))) 29 | addresses) 30 | t))) 31 | 32 | (defun collect-result-data (qvm addresses results) 33 | (maphash (lambda (name indexes) 34 | (cond 35 | ;; Give everything back. 36 | ((eq indexes t) 37 | (loop :with mv := (gethash name (qvm::classical-memories qvm)) 38 | :for idx :below (qvm::memory-view-length mv) 39 | :collect (qvm:memory-ref qvm name idx) :into mem 40 | :finally (push mem (gethash name results)))) 41 | ;; Give only some things back. 42 | ((alexandria:proper-list-p indexes) 43 | (loop :for idx :in indexes 44 | :collect (qvm:memory-ref qvm name idx) :into mem 45 | :finally (push mem (gethash name results)))) 46 | (t 47 | (error "Invalid multishot address query for memory named ~S." name)))) 48 | addresses) 49 | results) 50 | 51 | (defun %perform-multishot (simulation-method quil num-qubits addresses num-trials gate-noise measurement-noise) 52 | (check-type simulation-method simulation-method) 53 | (check-type quil quil:parsed-program) 54 | (check-type num-qubits (integer 0)) 55 | (check-type num-trials (integer 0)) 56 | (check-type addresses hash-table) 57 | (check-type gate-noise (or null alexandria:proper-list)) 58 | (check-type measurement-noise (or null alexandria:proper-list)) 59 | (assert (valid-address-query-p addresses) () 60 | "Detected invalid address query in multishot experiment. The ~ 61 | requested addresses should be a JSON object whose keys are ~ 62 | DECLAREd memory names, and whose values are either the true ~ 63 | value to request all memory, or a list of non-negative integer ~ 64 | indexes to request some memory.") 65 | (assert (and (or (null gate-noise) 66 | (= 3 (length gate-noise))) 67 | (every #'realp gate-noise))) 68 | (assert (and (or (null measurement-noise) 69 | (= 3 (length measurement-noise))) 70 | (every #'realp measurement-noise))) 71 | 72 | ;; Bail out early if there's no work to actually do. 73 | (when (or (zerop (hash-table-count addresses)) 74 | (zerop num-trials) 75 | (loop :for v :being :the :hash-values :of addresses 76 | :always (null v))) 77 | (return-from %perform-multishot (load-time-value (make-hash-table) t))) 78 | 79 | (let ((qvm (make-appropriate-qvm simulation-method quil num-qubits gate-noise measurement-noise)) 80 | (trial-results (make-hash-table :test 'equal 81 | :size (hash-table-count addresses))) 82 | timing) 83 | (qvm:load-program qvm quil :supersede-memory-subsystem t) 84 | (format-log "Running experiment with ~D trial~:P on ~A" 85 | num-trials 86 | (class-name (class-of qvm))) 87 | (with-timing (timing) 88 | (dotimes (trial num-trials) 89 | ;; Reset the program counter. 90 | (setf (qvm::pc qvm) 0) 91 | 92 | ;; Reset the amplitudes, but only if running more than one trial. 93 | (unless (= 1 num-trials) 94 | ;; Reset the amplitudes. 95 | (qvm::reset-quantum-state qvm)) 96 | 97 | ;; Run the program. 98 | (with-timeout (qvm:run qvm)) 99 | 100 | ;; Collect all of the memory that the user requests. 101 | (collect-result-data qvm addresses trial-results))) 102 | 103 | (format-log "Finished in ~D ms" timing) 104 | ;; We collected everything in reverse. So, reverse that. 105 | (maphash (lambda (k v) 106 | (setf (gethash k trial-results) (nreverse v))) 107 | trial-results) 108 | trial-results)) 109 | -------------------------------------------------------------------------------- /app/src/api/ping.lisp: -------------------------------------------------------------------------------- 1 | ;;;; api/ping.lisp 2 | ;;;; 3 | ;;;; Author: Robert Smith 4 | 5 | (in-package #:qvm-app) 6 | 7 | (defun handle-ping () 8 | (format nil "pong ~D" (get-universal-time))) 9 | -------------------------------------------------------------------------------- /app/src/api/probabilities.lisp: -------------------------------------------------------------------------------- 1 | ;;;; api/probabilities.lisp 2 | ;;;; 3 | ;;;; Author: Erik Davis 4 | 5 | (in-package #:qvm-app) 6 | 7 | (defgeneric perform-probabilities (simulation-method quil num-qubits &key gate-noise measurement-noise) 8 | (:method (simulation-method quil num-qubits &key gate-noise measurement-noise) 9 | (declare (ignore gate-noise measurement-noise)) 10 | (api-method-not-implemented-error 'perform-probabilities)) 11 | (:documentation "Executes a program and returns the resulting probability distribution over the computational basis.")) 12 | 13 | (defmethod perform-probabilities ((simulation-method (eql 'pure-state)) quil num-qubits &key gate-noise measurement-noise) 14 | (let* ((qvm (%execute-quil simulation-method quil num-qubits gate-noise measurement-noise)) 15 | (amplitudes (qvm::amplitudes qvm)) 16 | (probabilities (make-array (length amplitudes) :element-type 'qvm:flonum))) 17 | (map-into probabilities #'qvm::probability (qvm::amplitudes qvm)) 18 | (values qvm 19 | probabilities))) 20 | 21 | (defmethod perform-probabilities ((simulation-method (eql 'full-density-matrix)) quil num-qubits &key gate-noise measurement-noise) 22 | (let* ((qvm (%execute-quil simulation-method quil num-qubits gate-noise measurement-noise))) 23 | (values qvm 24 | (qvm::density-qvm-measurement-probabilities qvm)))) 25 | -------------------------------------------------------------------------------- /app/src/api/run-for-effect.lisp: -------------------------------------------------------------------------------- 1 | ;;;; api/effect-change.lisp 2 | ;;;; 3 | ;;;; Author: Erik Davis 4 | 5 | (in-package #:qvm-app) 6 | 7 | (defgeneric perform-run-for-effect (simulation-method quil num-qubits &key gate-noise measurement-noise) 8 | (:method (simulation-method quil num-qubits &key gate-noise measurement-noise) 9 | (declare (ignore gate-noise measurement-noise)) 10 | (api-method-not-implemented-error 'perform-run-for-effect)) 11 | (:documentation "Executes a quil program for the purpose of updating a shared or persistent wavefunction.")) 12 | 13 | (defmethod perform-run-for-effect ((simulation-method (eql 'pure-state)) quil num-qubits &key gate-noise measurement-noise) 14 | (unless **persistent-wavefunction** 15 | (warn "RUN-FOR-EFFECT called statelessly.")) 16 | (%execute-quil simulation-method quil num-qubits gate-noise measurement-noise)) 17 | 18 | (defmethod perform-run-for-effect ((simulation-method (eql 'full-density-matrix)) quil num-qubits &key gate-noise measurement-noise) 19 | (unless **persistent-wavefunction** 20 | (warn "RUN-FOR-EFFECT called statelessly.")) 21 | (%execute-quil simulation-method quil num-qubits gate-noise measurement-noise)) 22 | -------------------------------------------------------------------------------- /app/src/api/version.lisp: -------------------------------------------------------------------------------- 1 | ;;;; api/version.lisp 2 | ;;;; 3 | ;;;; Author: Robert Smith 4 | 5 | (in-package #:qvm-app) 6 | 7 | (defun handle-version () 8 | (string-right-trim 9 | '(#\Newline) 10 | (with-output-to-string (*standard-output*) 11 | (show-version)))) 12 | -------------------------------------------------------------------------------- /app/src/api/wavefunction.lisp: -------------------------------------------------------------------------------- 1 | ;;;; api/wavefunction.lisp 2 | ;;;; 3 | ;;;; Author: Robert Smith 4 | 5 | (in-package #:qvm-app) 6 | 7 | (defgeneric perform-wavefunction (simulation-method quil num-qubits &key gate-noise measurement-noise) 8 | (:method (simulation-method quil num-qubits &key gate-noise measurement-noise) 9 | (declare (ignore gate-noise measurement-noise)) 10 | (api-method-not-implemented-error 'perform-wavefunction))) 11 | 12 | (defmethod perform-wavefunction ((simulation-method (eql 'pure-state)) quil num-qubits &key gate-noise measurement-noise) 13 | (%execute-quil simulation-method quil num-qubits gate-noise measurement-noise)) 14 | 15 | (defmethod perform-wavefunction ((simulation-method (eql 'full-density-matrix)) quil num-qubits &key gate-noise measurement-noise) 16 | (%execute-quil simulation-method quil num-qubits gate-noise measurement-noise)) 17 | 18 | (defun %execute-quil (simulation-method quil num-qubits gate-noise measurement-noise) 19 | (check-type quil quil:parsed-program) 20 | (check-type num-qubits (integer 0)) 21 | (check-type gate-noise (or null alexandria:proper-list)) 22 | (check-type measurement-noise (or null alexandria:proper-list)) 23 | (assert (and (or (null gate-noise) 24 | (= 3 (length gate-noise))) 25 | (every #'realp gate-noise))) 26 | (assert (and (or (null measurement-noise) 27 | (= 3 (length measurement-noise))) 28 | (every #'realp measurement-noise))) 29 | 30 | (let ((qvm (make-appropriate-qvm simulation-method quil num-qubits gate-noise measurement-noise)) 31 | timing) 32 | (qvm:load-program qvm quil) 33 | (format-log "Running experiment on ~A" (class-name (class-of qvm))) 34 | (with-timing (timing) 35 | (with-timeout 36 | (qvm:run qvm))) 37 | (format-log "Finished in ~D ms" timing) 38 | qvm)) 39 | -------------------------------------------------------------------------------- /app/src/build-configuration.lisp: -------------------------------------------------------------------------------- 1 | ;;;; build-configuration.lisp 2 | ;;;; 3 | ;;;; Author: Robert Smith 4 | 5 | (in-package #:qvm) 6 | 7 | ;;; This file contains configuration of the QVM package for use with 8 | ;;; the executable. 9 | ;;; 10 | ;;; In general, one would see changes to 'config.lisp' constants here. 11 | 12 | (eval-when (:compile-toplevel :load-toplevel :execute) 13 | (format t "~&Warming the operator cache for ~D qubit~:P..." 14 | #1=*executable-time-operator-cache-limit*) 15 | (finish-output) 16 | (warm-apply-matrix-operator-cache :max-qubits #1#) 17 | (format t "done~%") 18 | (finish-output)) 19 | -------------------------------------------------------------------------------- /app/src/globals.lisp: -------------------------------------------------------------------------------- 1 | ;;;; src/globals.lisp 2 | ;;;; 3 | ;;;; Author: Nikolas Tezak 4 | ;;;; Robert Smith 5 | 6 | (in-package #:qvm-app) 7 | 8 | (defvar *qubit-limit* nil) ; Maximum no. of qubits. 9 | (defvar *num-workers* nil) 10 | (defvar *time-limit* nil) 11 | (defvar *app* nil) 12 | (defvar *debug* nil) 13 | 14 | (global-vars:define-global-var **persistent-wavefunction** nil) 15 | (global-vars:define-global-var **persistent-wavefunction-finalizer** (constantly nil)) 16 | 17 | (defparameter *allocation-descriptions* '(("native" . qvm:lisp-allocation) 18 | ("foreign" . qvm:c-allocation)) 19 | "Association list of allocation descriptions.") 20 | 21 | (defvar *allocation-description* 'qvm:lisp-allocation "Default allocation description.") 22 | 23 | (global-vars:define-global-var **default-allocation** 24 | (lambda (n) (make-instance *allocation-description* :length n))) 25 | 26 | (deftype simulation-method () 27 | "Available QVM simulation methods." 28 | `(member pure-state full-density-matrix)) 29 | 30 | (defvar *simulation-method* nil 31 | "The active QVM simulation method. 32 | 33 | This is set once upon initialization of the QVM and is controlled by the --similation-method option") 34 | 35 | (defvar *shared-memory-object-name* nil 36 | "The name of the POSIX shared memory object, or nil if none is present.") 37 | 38 | (defvar *logger* (make-instance 'cl-syslog:rfc5424-logger 39 | :app-name "qvm" 40 | :facility ':local0 41 | :log-writer (cl-syslog:null-log-writer)) 42 | "The CL-SYSLOG logger instance.") 43 | -------------------------------------------------------------------------------- /app/src/impl/clozure.lisp: -------------------------------------------------------------------------------- 1 | ;;;; clozure.lisp 2 | 3 | (in-package #:qvm-app) 4 | 5 | (defun start-shm-info-server (name length) 6 | "Start a thread with a socket listening on the local socket 7 | /tmp/. For any incoming connection, read a single octet, then 8 | respond with \",\" as decimal numbers in ASCII." 9 | (let* ((offset (qvm::shm-vector-header-size)) 10 | (client-buffer (make-array 1 :element-type '(unsigned-byte 8))) 11 | (response-buffer (babel:string-to-octets 12 | (format nil "~A,~A" length offset))) 13 | (path (merge-pathnames name "/tmp/"))) 14 | (let ((server-socket (ccl:make-socket :address-family ':file 15 | :local-filename (namestring path) 16 | :type ':stream 17 | :connect ':passive))) 18 | (setf **shm-info-server-thread** 19 | (bt:make-thread 20 | (lambda () 21 | (catch 'done 22 | (unwind-protect 23 | (loop 24 | (let ((client-socket (ccl:accept-connection server-socket))) 25 | (read-sequence client-buffer client-socket) 26 | (write-sequence response-buffer client-socket) 27 | (close client-socket))) 28 | (close server-socket) 29 | (delete-file path)))) 30 | :name (format nil "Socket server on ~A for Shared Memory QVM" path)))) 31 | (format-log "ATTENTION! Started shm info socket server on ~A" path) 32 | (values))) 33 | 34 | (defun disable-debugger () 35 | (setf ccl::*batch-flag* t)) 36 | 37 | (defun enable-debugger () 38 | (setf ccl::*batch-flag* nil)) 39 | -------------------------------------------------------------------------------- /app/src/impl/sbcl.lisp: -------------------------------------------------------------------------------- 1 | ;;;; sbcl.lisp 2 | 3 | (in-package #:qvm-app) 4 | 5 | #+windows 6 | (defun start-shm-info-server (name length) 7 | ;; TODO Better description? 8 | (error "Shared memory is not supported on Windows")) 9 | 10 | #+unix 11 | (defun start-shm-info-server (name length) 12 | "Start a thread with a socket listening on the local socket 13 | /tmp/. For any incoming connection, read a single octet, then 14 | respond with \",\" as decimal numbers in ASCII." 15 | (let* ((offset (qvm::shm-vector-header-size)) 16 | (client-buffer (make-array 1 :element-type '(unsigned-byte 8))) 17 | (response-buffer (babel:string-to-octets 18 | (format nil "~A,~A" length offset))) 19 | (path (merge-pathnames name "/tmp/"))) 20 | (let ((server-socket (make-instance 'sb-bsd-sockets:local-socket 21 | :type :stream))) 22 | (sb-bsd-sockets:socket-bind server-socket (namestring path)) 23 | ;; 8 is an arbitrary backlog value 24 | (sb-bsd-sockets:socket-listen server-socket 8) 25 | (setf **shm-info-server-thread** 26 | (bt:make-thread 27 | (lambda () 28 | (catch 'done 29 | (unwind-protect 30 | (loop 31 | (let ((client-socket (sb-bsd-sockets:socket-accept server-socket))) 32 | (sb-bsd-sockets:socket-receive client-socket client-buffer 33 | (length client-buffer)) 34 | (sb-bsd-sockets:socket-send client-socket response-buffer 35 | (length response-buffer)) 36 | (sb-bsd-sockets:socket-close client-socket))) 37 | (sb-bsd-sockets:socket-close server-socket) 38 | (delete-file path)))) 39 | :name (format nil "Socket server on ~A for Shared Memory QVM" path)))) 40 | (format-log "ATTENTION! Started shm info socket server on ~A" path) 41 | (values))) 42 | 43 | (defun disable-debugger () 44 | (sb-ext:disable-debugger)) 45 | 46 | (defun enable-debugger () 47 | (sb-ext:enable-debugger)) 48 | -------------------------------------------------------------------------------- /app/src/mangle-shared-objects.lisp: -------------------------------------------------------------------------------- 1 | ;;;; mangle-shared-objects.lisp 2 | ;;;; 3 | ;;;; This is loaded (as with CL:LOAD) before the final image is saved. 4 | ;;;; 5 | ;;;; Rewrites shared library references to libblas.dylib and 6 | ;;;; liblapack.dylib on Mac SDK targets to use the Rigetti package 7 | ;;;; path /usr/local/lib/rigetti. This is so the exact 8 | ;;;; Rigetti-provided versions of these libraries are found when the 9 | ;;;; SDK binary starts up. If these were not rewritten, the SDK binary 10 | ;;;; could try to load from non-existent Brew paths or inadequate 11 | ;;;; Accelerate-related system paths. 12 | ;;;; 13 | ;;;; Has no effect on non-Mac targets. 14 | 15 | (in-package #:cl-user) 16 | 17 | (dolist (shared-object sb-sys:*shared-objects*) 18 | (let ((dylibs-to-replace '("libblas.dylib" 19 | "liblapack.dylib")) 20 | (original-path (sb-alien::shared-object-pathname shared-object))) 21 | (let ((dylib (first (member (file-namestring original-path) 22 | dylibs-to-replace 23 | :test 'string-equal)))) 24 | (when dylib 25 | (let ((new-path 26 | (merge-pathnames dylib "/usr/local/lib/rigetti/"))) 27 | (format *trace-output* ";;; Rewriting ~A to ~A~%" 28 | original-path new-path) 29 | (setf (sb-alien::shared-object-pathname shared-object) 30 | new-path 31 | (sb-alien::shared-object-namestring shared-object) 32 | (sb-ext:native-namestring new-path))))))) 33 | 34 | 35 | -------------------------------------------------------------------------------- /app/src/package.lisp: -------------------------------------------------------------------------------- 1 | ;;;; app-src/entry-point.lisp 2 | ;;;; 3 | ;;;; Author: Robert Smith 4 | 5 | (defpackage #:qvm-app 6 | (:use #:cl #:qvm) 7 | (:local-nicknames (#:quil #:cl-quil))) 8 | -------------------------------------------------------------------------------- /app/src/qvm-app-version.lisp: -------------------------------------------------------------------------------- 1 | ;;;; qvm-app-version.lisp 2 | ;;;; 3 | ;;;; Author: Robert Smith 4 | 5 | (in-package #:qvm-app) 6 | 7 | (eval-when (:compile-toplevel :load-toplevel :execute) 8 | (defun system-version (system-designator) 9 | (let ((sys (asdf:find-system system-designator nil))) 10 | (if (and sys (slot-boundp sys 'asdf:version)) 11 | (asdf:component-version sys) 12 | "unknown"))) 13 | 14 | (defun git-hash (system) 15 | "Get the short git hash of the system SYSTEM." 16 | (let ((sys-path (namestring (asdf:system-source-directory system)))) 17 | (multiple-value-bind (output err-output status) 18 | (uiop:run-program `("git" "-C" ,sys-path "rev-parse" "--short" "HEAD") 19 | :output '(:string :stripped t) 20 | :ignore-error-status t) 21 | (declare (ignore err-output)) 22 | (if (not (zerop status)) 23 | "unknown" 24 | output))))) 25 | 26 | (eval-when (:compile-toplevel :load-toplevel) 27 | (alexandria:define-constant +QVM-VERSION+ 28 | (system-version '#:qvm) 29 | :test #'string= 30 | :documentation "The version of the QVM itself.") 31 | 32 | (alexandria:define-constant +GIT-HASH+ 33 | (git-hash '#:qvm-app) 34 | :test #'string= 35 | :documentation "The git hash of the QVM repo.") 36 | ) 37 | 38 | (declaim (special *logger*)) 39 | 40 | (defun query-latest-sdk-version (&key (proxy nil)) 41 | "Get the latest SDK qvm version, or NIL if unavailable." 42 | (handler-case 43 | (let* ((s (drakma:http-request 44 | (format nil "http://downloads.rigetti.com/qcs-sdk/versions?qvm=~A" 45 | +QVM-VERSION+) 46 | :want-stream t 47 | :proxy proxy)) 48 | (p (yason:parse s))) 49 | (multiple-value-bind (version success) 50 | (gethash "qvm" (gethash "latest" p)) 51 | (when success 52 | version))) 53 | (usocket:ns-error (condition) 54 | (cl-syslog:rfc-log (*logger* :warning "Encountered a name resolution error when fetching latest SDK version. (~A)" condition) 55 | (:msgid "LOG0000")) 56 | nil) 57 | (usocket:socket-error (condition) 58 | (cl-syslog:rfc-log (*logger* :warning "Encountered a socket error when fetching latest SDK version. (~A)" condition) 59 | (:msgid "LOG0000")) 60 | nil) 61 | (usocket:ns-try-again-condition (condition) 62 | (cl-syslog:rfc-log (*logger* :warning "Encountered EAGAIN when fetching latest SDK version. Not retrying; just ignoring. (~A)" condition) 63 | (:msgid "LOG0000")) 64 | nil) 65 | (usocket:ns-condition (condition) 66 | (cl-syslog:rfc-log (*logger* :warning "Encountered a presumably benign socket condition that prohibits fetching latest SDK version. Just ignoring. (~A)" condition) 67 | (:msgid "LOG0000")) 68 | nil) 69 | (error (condition) 70 | (cl-syslog:rfc-log (*logger* :warning "Encountered an error when fetching latest SDK version. (~A)" condition) 71 | (:msgid "LOG0000")) 72 | nil))) 73 | 74 | (defun sdk-update-available-p (current-version &key (proxy nil)) 75 | "Test whether the current SDK version is the latest SDK 76 | version. Second value returned indicates the latest version." 77 | (let ((latest (query-latest-sdk-version :proxy proxy))) 78 | (values (and latest (uiop:version< current-version latest)) 79 | latest))) 80 | 81 | (defun asynchronously-indicate-update-availability (current-version &key (proxy nil)) 82 | "Write to the logger the state of the software version (whether it's the latest, if there's an update, if an update couldn't be queried)." 83 | (bt:make-thread 84 | (lambda () 85 | (multiple-value-bind (available? latest) (sdk-update-available-p current-version :proxy proxy) 86 | (cond 87 | ((null latest) 88 | ;; There was some kind of issue getting the version and a warning was already emitted. 89 | ) 90 | ((not available?) 91 | (cl-syslog:rfc-log (*logger* :info "This is the latest version of the SDK.") 92 | (:msgid "LOG0001"))) 93 | (available? 94 | (cl-syslog:rfc-log (*logger* :notice "An update is available to the SDK. You have version ~A. ~ 95 | Version ~A is available from https://downloads.rigetti.com/~%" 96 | +QVM-VERSION+ latest) 97 | (:msgid "LOG0001")))))) 98 | :name "Version Check")) 99 | -------------------------------------------------------------------------------- /app/src/server-abstraction.lisp: -------------------------------------------------------------------------------- 1 | ;;;; server-abstraction.lisp 2 | ;;;; 3 | ;;;; Author: Robert Smith 4 | 5 | (in-package #:qvm-app) 6 | 7 | (defclass vhost (tbnl:acceptor) 8 | ((dispatch-table 9 | :initform '() 10 | :accessor dispatch-table 11 | :documentation "List of dispatch functions")) 12 | (:default-initargs 13 | :address (error "Host address must be specified.") 14 | :document-root nil 15 | :error-template-directory nil 16 | :persistent-connections-p t)) 17 | 18 | (defmethod tbnl:acceptor-status-message ((acceptor vhost) http-status-code &key error &allow-other-keys) 19 | (if (eql http-status-code tbnl:+http-internal-server-error+) 20 | (with-output-to-string (s) 21 | (setf (tbnl:content-type*) "application/json; charset=utf-8") 22 | (yason:encode 23 | (alexandria:plist-hash-table 24 | (list "error_type" "qvm_error" 25 | "status" error)) 26 | s)) 27 | (call-next-method))) 28 | 29 | (defmethod tbnl:acceptor-log-access ((acceptor vhost) &key return-code) 30 | (with-locked-log () 31 | (cl-syslog:format-log *logger* ':info 32 | "~:[-~@[ (~A)~]~;~:*~A~@[ (~A)~]~] ~:[-~;~:*~A~] [~A] \"~A ~A~@[?~A~] ~ 33 | ~A\" ~D ~:[-~;~:*~D~] \"~:[-~;~:*~A~]\" \"~:[-~;~:*~A~]\"~%" 34 | (tbnl::remote-addr*) 35 | (tbnl::header-in* :x-forwarded-for) 36 | (tbnl::authorization) 37 | (tbnl::iso-time) 38 | (tbnl::request-method*) 39 | (tbnl::script-name*) 40 | (tbnl::query-string*) 41 | (tbnl::server-protocol*) 42 | return-code 43 | (tbnl::content-length*) 44 | (tbnl::referer) 45 | (tbnl::user-agent)))) 46 | 47 | (defmethod tbnl:acceptor-log-message ((acceptor vhost) log-level format-string &rest format-arguments) 48 | (with-locked-log () 49 | (cl-syslog:format-log *logger* ':err 50 | "[~A~@[ [~A]~]] ~?~%" 51 | (tbnl::iso-time) log-level 52 | format-string format-arguments))) 53 | 54 | (defun create-prefix/method-dispatcher (prefix method handler) 55 | "Creates a request dispatch function which will dispatch to the 56 | function denoted by HANDLER if the file name of the current request 57 | starts with the string PREFIX." 58 | (lambda (request) 59 | (and (eq method (tbnl:request-method request)) 60 | (let ((mismatch (mismatch (tbnl:script-name request) prefix 61 | :test #'char=))) 62 | (and (or (null mismatch) 63 | (>= mismatch (length prefix))) 64 | handler))))) 65 | 66 | 67 | (defmethod tbnl:acceptor-dispatch-request ((vhost vhost) request) 68 | ;; try REQUEST on each dispatcher in turn 69 | (mapc (lambda (dispatcher) 70 | (let ((handler (funcall dispatcher request))) 71 | (when handler ; Handler found. FUNCALL it and return result 72 | (return-from tbnl:acceptor-dispatch-request (funcall handler request))))) 73 | (dispatch-table vhost)) 74 | (call-next-method)) 75 | -------------------------------------------------------------------------------- /app/src/shm-info-server.lisp: -------------------------------------------------------------------------------- 1 | ;;;; shm-info-server.lisp 2 | ;;;; 3 | ;;;; Author: Robert Smith 4 | 5 | (in-package #:qvm-app) 6 | 7 | (global-vars:define-global-var **shm-info-server-thread** nil 8 | "Thread running the SHM info server.") 9 | 10 | (defun stop-shm-info-server () 11 | (when (and **shm-info-server-thread** 12 | (bt:thread-alive-p **shm-info-server-thread**)) 13 | (bt:interrupt-thread **shm-info-server-thread** 14 | (lambda () 15 | (throw 'done t))))) 16 | 17 | ;;; The rest of the logic is in the `impl` directory. 18 | -------------------------------------------------------------------------------- /app/src/utilities.lisp: -------------------------------------------------------------------------------- 1 | ;;;; utilities.lisp 2 | ;;;; 3 | ;;;; Author: Robert Smith 4 | 5 | (in-package #:qvm-app) 6 | 7 | (defun slurp-lines (&optional (stream *standard-input*)) 8 | (flet ((line () (read-line stream nil nil nil))) 9 | (with-output-to-string (s) 10 | (loop :for line := (line) :then (line) 11 | :while line 12 | :do (write-line line s))))) 13 | 14 | (defmacro with-timeout (&body body) 15 | (let ((f (gensym "TIME-LIMITED-BODY-"))) 16 | `(flet ((,f () ,@body)) 17 | (declare (dynamic-extent (function ,f))) 18 | (if (null *time-limit*) 19 | (,f) 20 | (bt:with-timeout (*time-limit*) 21 | (,f)))))) 22 | 23 | (defmacro with-timing ((var) &body body) 24 | (let ((start (gensym "START-"))) 25 | `(let ((,start (get-internal-real-time))) 26 | (multiple-value-prog1 (progn ,@body) 27 | (setf ,var (round (* 1000 (- (get-internal-real-time) ,start)) 28 | internal-time-units-per-second)))))) 29 | 30 | (defun slurp-stream (stream) 31 | (with-output-to-string (s) 32 | (loop :for byte := (read-byte stream nil nil) :then (read-byte stream nil nil) 33 | :until (null byte) 34 | :do (write-char (code-char byte) s)))) 35 | 36 | (defun keywordify (str) 37 | (intern (string-upcase str) :keyword)) 38 | 39 | (declaim (inline write-64-be)) 40 | (defun write-64-be (byte stream) 41 | "Write the 64-bit unsigned-byte BYTE to the binary stream STREAM." 42 | (declare (optimize speed (safety 0) (debug 0)) 43 | (type (unsigned-byte 64) byte)) 44 | (let ((a (ldb (byte 8 0) byte)) 45 | (b (ldb (byte 8 8) byte)) 46 | (c (ldb (byte 8 16) byte)) 47 | (d (ldb (byte 8 24) byte)) 48 | (e (ldb (byte 8 32) byte)) 49 | (f (ldb (byte 8 40) byte)) 50 | (g (ldb (byte 8 48) byte)) 51 | (h (ldb (byte 8 56) byte))) 52 | (declare (type (unsigned-byte 8) a b c d e f g h)) 53 | (write-byte h stream) 54 | (write-byte g stream) 55 | (write-byte f stream) 56 | (write-byte e stream) 57 | (write-byte d stream) 58 | (write-byte c stream) 59 | (write-byte b stream) 60 | (write-byte a stream) 61 | nil)) 62 | 63 | (declaim (inline write-complex-double-float-as-binary)) 64 | (defun write-complex-double-float-as-binary (z stream) 65 | "Take a complex double-float and write to STREAM its binary representation in big endian (total 16 octets)." 66 | (declare #.qvm::*optimize-dangerously-fast* 67 | (type (complex double-float) z)) 68 | (let ((re (realpart z)) 69 | (im (imagpart z))) 70 | (declare (type double-float re im) 71 | (dynamic-extent re im)) 72 | (let ((encoded-re (ieee-floats:encode-float64 re)) 73 | (encoded-im (ieee-floats:encode-float64 im))) 74 | (declare (type (unsigned-byte 64) encoded-re encoded-im) 75 | (dynamic-extent encoded-re encoded-im)) 76 | (write-64-be encoded-re stream) 77 | (write-64-be encoded-im stream)))) 78 | 79 | (declaim (inline write-double-float-as-binary)) 80 | (defun write-double-float-as-binary (x stream) 81 | "Take a double-float and write to STREAM its binary representation in big endian (total 8 octets)." 82 | (declare #.qvm::*optimize-dangerously-fast* 83 | (type double-float x)) 84 | (let ((encoded (ieee-floats:encode-float64 x))) 85 | (declare (type (unsigned-byte 64) encoded) 86 | (dynamic-extent encoded)) 87 | (write-64-be encoded stream))) 88 | 89 | (defun encode-list-as-json-list (list stream) 90 | (if (endp list) 91 | (format stream "[]") 92 | (yason:encode list stream))) 93 | 94 | ;;; Functions depending on the server state 95 | 96 | (defun session-info () 97 | (if (or (not (boundp 'tbnl:*session*)) 98 | (null tbnl:*session*)) 99 | "" 100 | (format nil 101 | "[~A Session:~D] " 102 | (tbnl:session-remote-addr tbnl:*session*) 103 | (tbnl:session-id tbnl:*session*)))) 104 | 105 | (global-vars:define-global-var **log-lock** (bt:make-lock "Log Lock")) 106 | (defmacro with-locked-log (() &body body) 107 | `(bt:with-lock-held (**log-lock**) 108 | ,@body)) 109 | 110 | (defmacro format-log (level-or-fmt-string &rest fmt-string-or-args) 111 | "Send a message to syslog. If the first argument LEVEL-OR-FMT-STRING is a 112 | keyword it is assumed to be a non-default log level (:debug), otherwise it is a control 113 | string followed by optional args (as in FORMAT)." 114 | (when (keywordp level-or-fmt-string) 115 | ;; Sanity check that it's a valid log level at macroexpansion 116 | ;; time. 117 | (cl-syslog:get-priority level-or-fmt-string)) 118 | (if (keywordp level-or-fmt-string) 119 | `(with-locked-log () 120 | (cl-syslog:format-log 121 | *logger* 122 | ',level-or-fmt-string 123 | "~A~@?" 124 | (session-info) 125 | ,@fmt-string-or-args)) 126 | `(with-locked-log () 127 | (cl-syslog:format-log 128 | *logger* 129 | ':debug 130 | "~A~@?" 131 | (session-info) 132 | ,level-or-fmt-string 133 | ,@fmt-string-or-args)))) 134 | -------------------------------------------------------------------------------- /app/tests/package.lisp: -------------------------------------------------------------------------------- 1 | ;;;; src-tests/package.lisp 2 | ;;;; 3 | ;;;; Author: Nik Tezak 4 | 5 | (fiasco:define-test-package #:qvm-app-tests 6 | (:use #:qvm-app) 7 | (:local-nicknames (#:quil #:cl-quil)) 8 | 9 | ;; suite.lisp 10 | (:export 11 | #:run-qvm-app-tests)) 12 | -------------------------------------------------------------------------------- /app/tests/utils.lisp: -------------------------------------------------------------------------------- 1 | (in-package :qvm-app-tests) 2 | 3 | (defmacro with-mocked-function-definitions (defs &body body) 4 | "Dynamically re-define global functions named in DEFS within BODY. 5 | 6 | DEFS are LET-like bindings (not FLET) whose binding keys are symbols 7 | that name global functions, and whose binding values are evaluated and 8 | return functions. These functions should have conforming lambda lists, 9 | types, and return values, though this is not enforced by the macro. 10 | 11 | e.g. 12 | (defun testfunc (a b) (+ a b)) 13 | (with-mocked-function-definitions 14 | ((testfunc (lambda (a b) (* a b)))) 15 | (testfunc 3 4)) ;; => 12 16 | " 17 | (let* ((names (mapcar #'first defs)) 18 | (gnames (mapcar (alexandria:compose #'gensym #'symbol-name) names))) 19 | `(let (,@(loop :for name :in names 20 | :for gname :in gnames 21 | :collect `(,gname (fdefinition ',name)))) 22 | (unwind-protect 23 | (progn 24 | (setf ,@(loop :for (name value) :in defs 25 | :collect `(fdefinition ',name) 26 | :collect `,value)) 27 | ,@body) 28 | (setf ,@(loop :for name :in names 29 | :for gname :in gnames 30 | :collect `(fdefinition ',name) 31 | :collect `,gname)))))) 32 | -------------------------------------------------------------------------------- /bench/20H.quil: -------------------------------------------------------------------------------- 1 | H 0 2 | H 1 3 | H 2 4 | H 3 5 | H 4 6 | H 5 7 | H 6 8 | H 7 9 | H 8 10 | H 9 11 | H 10 12 | H 11 13 | H 12 14 | H 13 15 | H 14 16 | H 15 17 | H 16 18 | H 17 19 | H 18 20 | H 19 21 | -------------------------------------------------------------------------------- /bench/25H.quil: -------------------------------------------------------------------------------- 1 | H 0 2 | H 1 3 | H 2 4 | H 3 5 | H 4 6 | H 5 7 | H 6 8 | H 7 9 | H 8 10 | H 9 11 | H 10 12 | H 11 13 | H 12 14 | H 13 15 | H 14 16 | H 15 17 | H 16 18 | H 17 19 | H 18 20 | H 19 21 | H 20 22 | H 21 23 | H 22 24 | H 23 25 | H 24 26 | -------------------------------------------------------------------------------- /bench/bench.lisp: -------------------------------------------------------------------------------- 1 | #!/usr/local/bin/sbcl --script 2 | (require :asdf) 3 | (defparameter *quil-file* (first (uiop:command-line-arguments))) 4 | (format t "Benchmarking quil file ~S~%" *quil-file*) 5 | (load "~/.sbclrc") 6 | 7 | (require :sb-sprof) 8 | (ql:quickload '(:qvm :cl-quil) :silent t) 9 | 10 | (defvar *quil* nil) 11 | 12 | 13 | (format t "PARSING========================================~%") 14 | (sb-sprof:with-profiling (:max-samples 1000 15 | :report :graph 16 | :loop t 17 | :reset t) 18 | (setq *quil* 19 | (let ((cl-quil::*allow-unresolved-applications* t)) 20 | (cl-quil:read-quil-file *quil-file*)))) 21 | 22 | (format t "RUNNING========================================~%") 23 | (let ((q (qvm:make-qvm (cl-quil:qubits-needed *quil*)))) 24 | (qvm:load-program q *quil* :supersede-memory-subsystem t) 25 | (sb-sprof:with-profiling (:max-samples 1000 26 | :report :graph 27 | :loop t 28 | :reset t) 29 | (qvm:run q) 30 | (setf (qvm::pc q) 0)) 31 | 32 | (qvm::reset-quantum-state q) 33 | (qvm::reset-classical-memory q) 34 | (setf (qvm::pc q) 0) 35 | #+ignore 36 | (sb-sprof:with-profiling (:max-samples 10000 37 | :report :graph 38 | :mode :alloc 39 | :loop t 40 | :reset t) 41 | (qvm:run q) 42 | (setf (qvm::pc q) 0))) 43 | -------------------------------------------------------------------------------- /bench/entangle-25.quil: -------------------------------------------------------------------------------- 1 | DECLARE ro BIT[2] 2 | H 0 3 | CNOT 0 1 4 | CNOT 1 2 5 | CNOT 2 3 6 | CNOT 3 4 7 | CNOT 4 5 8 | CNOT 5 6 9 | CNOT 6 7 10 | CNOT 7 8 11 | CNOT 8 9 12 | CNOT 9 10 13 | CNOT 10 11 14 | CNOT 11 12 15 | CNOT 12 13 16 | CNOT 13 14 17 | CNOT 14 15 18 | CNOT 15 16 19 | CNOT 16 17 20 | CNOT 17 18 21 | CNOT 18 19 22 | CNOT 19 20 23 | CNOT 20 21 24 | CNOT 21 22 25 | CNOT 22 23 26 | CNOT 23 24 27 | MEASURE 0 ro[0] 28 | MEASURE 23 ro[1] 29 | -------------------------------------------------------------------------------- /bench/package.lisp: -------------------------------------------------------------------------------- 1 | ;;;; bench/package.lisp 2 | ;;;; 3 | ;;;; Author: Robert Smith 4 | 5 | (benchmark:define-benchmark-package #:qvm-benchmarks 6 | (:use #:qvm) 7 | 8 | ;; suite.lisp 9 | (:export 10 | #:run-benchmarks 11 | #:results-as-json)) 12 | -------------------------------------------------------------------------------- /bench/quil-files.lisp: -------------------------------------------------------------------------------- 1 | ;;;; bench/quil-files.lisp 2 | ;;;; 3 | ;;;; Author: Robert Smith, Mark Skilbeck 4 | 5 | (in-package #:qvm-benchmarks) 6 | 7 | (defparameter *bench-files-directory* 8 | (asdf:system-relative-pathname ':qvm-benchmarks "bench/") 9 | "Directory containing Quil benchmark files.") 10 | 11 | (defun timed-run (file) 12 | "Load the Quil file designated by FILE and time its execution." 13 | (let ((cl-quil:*allow-unresolved-applications* t)) 14 | (let* ((program (cl-quil:read-quil-file 15 | (merge-pathnames file *bench-files-directory*))) 16 | (qvm (qvm:make-qvm (cl-quil:qubits-needed program)))) 17 | (benchmark:with-benchmark-sampling 18 | (qvm:load-program qvm program :supersede-memory-subsystem t) 19 | (qvm:run qvm))))) 20 | 21 | (benchmark:define-benchmark bench-25-hadamards () 22 | "Benchmark a sequence of 25 Hadamard gates." 23 | (timed-run "25H.quil")) 24 | 25 | (benchmark:define-benchmark bench-H4 () 26 | "Benchmark for sample VQE run from H4 computation." 27 | (timed-run "H4.quil")) 28 | 29 | (benchmark:define-benchmark bench-H6 () 30 | "Benchmark for sample VQE run from H6 computation." 31 | (timed-run "H6.quil")) 32 | 33 | (benchmark:define-benchmark bench-big-defgate () 34 | "Benchmark a very large DEFGATE and associated invocations." 35 | (timed-run "qaoa_8q.quil")) 36 | 37 | (benchmark:define-benchmark bench-supremacy () 38 | "Benchmark sample code from supremacy studies." 39 | (timed-run "5x4x25.quil")) 40 | 41 | (benchmark:define-benchmark bench-entangle-25 () 42 | "Benchmark an entanglement of 25 qubits" 43 | (timed-run "entangle-25.quil")) 44 | 45 | -------------------------------------------------------------------------------- /bench/suite.lisp: -------------------------------------------------------------------------------- 1 | ;;;; bench/suite.lisp 2 | ;;;; 3 | ;;;; Author: Robert Smith, Mark Skilbeck 4 | 5 | (in-package #:qvm-benchmarks) 6 | 7 | (defun serialize-alist (alist) 8 | (yason:with-object nil 9 | (loop :for (aspect value) :on alist :by #'cddr 10 | :for serialized-aspect := (prin1-to-string aspect) 11 | :for serialized-value := (if (integerp value) 12 | value 13 | (float value)) 14 | :do (yason:encode-object-element serialized-aspect 15 | serialized-value)))) 16 | 17 | (defun results-as-json (results) 18 | "Encode the results table RESULTS of the benchmark run." 19 | (yason:with-output-to-string* (:indent nil) 20 | (yason:with-object () 21 | (maphash (lambda (k v) 22 | (let ((benchmark-name (prin1-to-string k))) 23 | (yason:with-object-element (benchmark-name) 24 | (loop :for (aspect . statistics) :in v 25 | :for aspect-name := (prin1-to-string aspect) 26 | :do (yason:with-object nil 27 | (yason:with-object-element (aspect-name) 28 | (serialize-alist statistics))))))) 29 | results)))) 30 | 31 | (defun run-benchmarks (&key (headless nil) (verbose nil)) 32 | "Run all QVM benchmarks. If HEADLESS is T, quit on completion." 33 | (qvm:prepare-for-parallelization) 34 | (let ((results (run-package-benchmarks :package ':qvm-benchmarks 35 | :verbose nil))) 36 | (cond 37 | ((null headless) 38 | (when verbose (benchmark:report results)) 39 | results) 40 | (t 41 | (uiop:quit (if results 0 1)))))) 42 | 43 | -------------------------------------------------------------------------------- /build-app.lisp: -------------------------------------------------------------------------------- 1 | ;;;; build-app.lisp 2 | ;;;; 3 | ;;;; This file is loaded by the Makefile to produce a qvm[.exe] binary. 4 | ;;;; 5 | 6 | (unless *load-truename* 7 | (error "This file is meant to be loaded.")) 8 | 9 | (pushnew :hunchentoot-no-ssl *features*) 10 | #+forest-sdk (pushnew :drakma-no-ssl *features*) 11 | 12 | (require 'asdf) 13 | 14 | (let ((*default-pathname-defaults* (make-pathname :type nil 15 | :name nil 16 | :defaults *load-truename*)) 17 | (output-file (make-pathname :name "qvm" 18 | :type #+win32 "exe" #-win32 nil)) 19 | (system-table (make-hash-table :test 'equal)) 20 | (toplevel (lambda () 21 | (with-simple-restart (abort "Abort") 22 | (funcall (read-from-string "qvm-app::%main") 23 | sb-ext:*posix-argv*))))) 24 | (labels ((load-systems-table () 25 | (unless (probe-file "system-index.txt") 26 | (error "Generate system-index.txt with 'make system-index.txt' first.")) 27 | (setf (gethash "qvm-app" system-table) (merge-pathnames "qvm-app.asd")) 28 | (with-open-file (stream "system-index.txt") 29 | (loop 30 | :for system-file := (read-line stream nil) 31 | :while system-file 32 | :do (setf (gethash (pathname-name system-file) system-table) 33 | (merge-pathnames system-file))))) 34 | (local-system-search (name) 35 | (values (gethash name system-table)))) 36 | (load-systems-table) 37 | (push #'local-system-search asdf:*system-definition-search-functions*) 38 | (asdf:load-system "qvm-app") 39 | (load "app/src/build-configuration.lisp") 40 | (funcall (read-from-string "qvm-app::setup-debugger")) 41 | (when (find "--qvm-sdk" sb-ext:*posix-argv* :test 'string=) 42 | (load "app/src/mangle-shared-objects.lisp")) 43 | (sb-ext:save-lisp-and-die output-file 44 | :compression #+sb-core-compression t 45 | #-sb-core-compression nil 46 | :save-runtime-options t 47 | :executable t 48 | :toplevel toplevel))) 49 | -------------------------------------------------------------------------------- /coverage-report/coverage-report.lisp: -------------------------------------------------------------------------------- 1 | ;;;; coverage-report.lisp 2 | ;;;; 3 | ;;;; Author: Zach Beane 4 | 5 | (require :sb-cover) 6 | 7 | (defvar *system* "qvm") 8 | 9 | (defun system-lisp-files (system) 10 | (unless (typep system 'asdf:system) 11 | (setf system (asdf:find-system system))) 12 | (let ((result '())) 13 | (labels ((explore (thing) 14 | (typecase thing 15 | (asdf:parent-component 16 | (mapc #'explore (asdf:component-children thing))) 17 | (asdf:cl-source-file 18 | (push (namestring (asdf:component-pathname thing)) result))))) 19 | (explore system) 20 | result))) 21 | 22 | #-quicklisp 23 | (load "~/quicklisp/setup.lisp") 24 | 25 | (format *query-io* "Compiling and loading ~A..." *system*) 26 | (force-output *query-io*) 27 | 28 | ;; Compile system and prerequisites outside of coverage 29 | ql-dist::(ensure-installed (release "cffi")) 30 | ql-dist::(ensure-installed (release "fiasco")) 31 | (ql:quickload *system* :silent t) 32 | 33 | (declaim (optimize sb-cover:store-coverage-data)) 34 | (asdf:load-system *system* :force t) 35 | (format *query-io* "done~%") 36 | 37 | (let ((*compile-verbose* nil) 38 | (*load-verbose* nil)) 39 | (asdf:test-system *system*)) 40 | 41 | (handler-bind ((warning #'muffle-warning)) 42 | (let ((interesting-files (system-lisp-files *system*)) 43 | (base (asdf:system-relative-pathname *system* 44 | "coverage-report/html/"))) 45 | (sb-cover:report base :if-matches (lambda (file) (member file interesting-files :test 'string=))) 46 | (let* ((cover (merge-pathnames "cover-index.html" base)) 47 | (index (merge-pathnames "index.html" base))) 48 | (rename-file cover index) 49 | (format *query-io* "Coverage report written to ~A~%" 50 | index)))) 51 | 52 | -------------------------------------------------------------------------------- /docker/test.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | set -ex 3 | ############################################################################### 4 | # Script for running the dockerized qvm tests 5 | ############################################################################### 6 | 7 | # Trailing "/." is special docker cp syntax. See link for details. 8 | # https://docs.docker.com/engine/reference/commandline/cp/#extended-description 9 | INPUT="/src/qvm/coverage-report/html/." 10 | OUTPUT="../coverage-report/html/" 11 | CONTAINER=qvm-tests 12 | IMAGE=qvm-tests 13 | 14 | mkdir -p "$OUTPUT" 15 | docker run --ipc=host --name "$CONTAINER" -e "DISABLE_SHARED_MEMORY_QVM_TESTS=1" "$IMAGE" 16 | # docker cp "$CONTAINER":"$INPUT" "$OUTPUT" 17 | -------------------------------------------------------------------------------- /dqvm/README.md: -------------------------------------------------------------------------------- 1 | # The Distributed Quantum Virtual Machine 2 | 3 | *Note*: In this directory is an **experimental**, **unsupported**, and **incomplete** version of a pure state quantum virtual machine (QVM) that can be distributed on a compute cluster. 4 | 5 | ## Running 6 | 7 | Prerequisites: 8 | 9 | * SBCL, Quicklisp, and buildapp 10 | * Open MPI 11 | * The `qvm` library and dependencies 12 | 13 | To build, do: 14 | 15 | ``` 16 | make 17 | ``` 18 | 19 | This will make an MPI-compatible binary called `dqvm`. Unfortunately, the binary currently needs to be installed on machines which also have a compiled implementation of `cl-mpi`, which can be obtained simply by doing 20 | 21 | ``` 22 | (ql:quickload :cl-mpi) 23 | ``` 24 | 25 | once on the machine of interest. (This is because `cl-mpi` makes a stub dynamic library which is evidently required to be loaded upon application startup.) 26 | 27 | To run locally, with `` processes, do: 28 | 29 | ``` 30 | mpirun -np --oversubscribe ./dqvm -e 31 | ``` 32 | 33 | To run on a cluster of `` nodes, write out your hosts in a host file ``, and do: 34 | 35 | ``` 36 | mpirun -np --hostfile ./dqvm -e 37 | ``` 38 | 39 | ## History 40 | 41 | This project was started by Robert Smith and Lauren Capelluto in February 2018 at Rigetti Computing. It was initially created purely locally using threads with concurrent mailboxes. It was prototyped on a ten node cluster called "rackpup". Each node is a Raspberry Pi Model 3 Model B with a 1.2 GHz quad-core ARM Cortex-A53 and 1 GB of RAM, running on a 64-bit pre-release of Debian. -------------------------------------------------------------------------------- /dqvm/dqvm2-tests.asd: -------------------------------------------------------------------------------- 1 | ;;;; dqvm2-tests.asd 2 | ;;;; 3 | ;;;; Author: Juan M. Bello-Rivas 4 | 5 | (asdf:defsystem #:dqvm2-tests 6 | :description "Test suite for dqvm2." 7 | :author "Juan M. Bello-Rivas " 8 | :depends-on (#:dqvm2 9 | #:fiasco) 10 | :perform (asdf:test-op (o s) 11 | (uiop:symbol-call :dqvm2-tests 12 | '#:run-dqvm2-tests)) 13 | :pathname "tests/" 14 | :components ((:file "package") 15 | (:file "suite") 16 | (:file "permutation-tests") 17 | (:file "addresses-tests") 18 | (:file "offset-arrays-tests") 19 | (:file "distributed-qvm-tests") 20 | (:file "program-tests"))) 21 | -------------------------------------------------------------------------------- /dqvm/dqvm2.asd: -------------------------------------------------------------------------------- 1 | ;;;; dqvm2.asd 2 | ;;;; 3 | ;;;; Author: Juan M. Bello-Rivas 4 | 5 | (defsystem #:dqvm2 6 | :description "Rigetti Distributed Quantum Virtual Machine" 7 | :author "Juan M. Bello Rivas , Robert Smith , Lauren Capelluto " 8 | :licence "Apache License 2.0 (See LICENSE.txt)" 9 | :depends-on ( 10 | ;; General utilities 11 | #:alexandria 12 | ;; MPI bindings and extensions 13 | #:cl-mpi 14 | #:cl-mpi-extensions 15 | ;; Quil parsing 16 | (:version #:cl-quil "1.11.0") 17 | ;; Logging 18 | #:cl-syslog 19 | ;; Command line argument parsing 20 | #:command-line-arguments 21 | ;; Matrix algebra 22 | (:version #:magicl "0.7.0") 23 | ;; Quantum virtual machine 24 | #:qvm 25 | ;; Allocation of C vectors 26 | (:version #:static-vectors "1.8.3") 27 | ;; Finalizers and portable GC calls 28 | #:trivial-garbage 29 | #+sbcl 30 | #:sb-sprof 31 | ) 32 | :defsystem-depends-on (#:cl-mpi-asdf-integration) 33 | :class :mpi-program 34 | :build-operation :static-program-op 35 | :build-pathname "dqvm2" 36 | :entry-point "dqvm2::entry-point" 37 | :pathname "src/" 38 | :serial t 39 | :components ((:file "package") 40 | (:file "utilities") 41 | (:file "permutation") 42 | (:file "mpi") 43 | (:file "logging") 44 | (:file "global-addresses") 45 | (:file "addresses") 46 | (:file "distributed-qvm") 47 | (:file "linear-algebra") 48 | (:file "offset-arrays") 49 | (:file "sendrecv") 50 | (:file "measurement") 51 | (:file "apply-distributed-gate") 52 | (:file "transition") 53 | (:file "entry-point")) 54 | :in-order-to ((asdf:test-op (asdf:test-op #:dqvm2-tests)))) 55 | -------------------------------------------------------------------------------- /dqvm/scripts/build-dqvm2-sbcl: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | sbcl --eval "(ql:quickload '(:alexandria :cl-mpi :cl-mpi-extensions :cl-quil :cl-syslog :command-line-arguments :magicl :qvm :static-vectors :trivial-garbage))" \ 4 | --eval "(require :sb-sprof)" \ 5 | --eval "(save-lisp-and-die \"dqvm2-sbcl\" :executable t :compression t)" 6 | -------------------------------------------------------------------------------- /dqvm/scripts/run-dqvm2: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | if [ $# -lt 2 ]; then 4 | echo "Usage: `basename $0` NUM-PROCESSES QUIL-FILE" 5 | exit 1 6 | fi 7 | 8 | num_proc=$1 9 | quil_file=$2 10 | tmpfile1=`mktemp -t dqvm2.XXXXXXXX` || exit 1 11 | tmpfile2=`mktemp -t dqvm2.XXXXXXXX` || exit 1 12 | trap "rm -f -- $tmpfile1 $tmpfile2" EXIT 13 | trap "trap - EXIT; rm -f -- $tmpfile1 $tmpfile2" HUP INT QUIT TERM 14 | 15 | echo "Writing logs to ${tmpfile1} and error logs to ${tmpfile2}" 16 | 17 | bin/dqvm2-sbcl --eval '(asdf:load-system :dqvm2)' --eval '(quit)' 18 | if [ $? -ne 0 ]; then 19 | echo "Something went wrong while recompiling DQVM2." 20 | exit 1 21 | fi 22 | 23 | mpiexec --oversubscribe -n $num_proc \ 24 | bin/dqvm2-sbcl \ 25 | --eval '(ql:quickload :dqvm2)' \ 26 | --eval '(dqvm2::entry-point (list "dqvm2" "'${quil_file}'"))' >$tmpfile1 2>$tmpfile2 27 | status=$? 28 | if [ $status -ne 0 ]; then 29 | echo "ERROR: DQVM2 execution failed." 30 | else 31 | [ -x `which lnav` ] && lnav $tmpfile2 || less $tmpfile2 32 | fi 33 | [ -e $tmpfile2 ] && cat $tmpfile2 34 | [ -e $tmpfile1 ] && cat $tmpfile1 35 | 36 | echo "=====================================================" 37 | echo "Quil program: $quil_file" 38 | echo "-----------------------------------------------------" 39 | cat $quil_file 40 | echo "=====================================================" 41 | echo 42 | 43 | exit $status 44 | -------------------------------------------------------------------------------- /dqvm/src/apply-distributed-gate.lisp: -------------------------------------------------------------------------------- 1 | ;;;; src/apply-distributed-gate.lisp 2 | ;;;; 3 | ;;;; Author: Juan M. Bello-Rivas 4 | 5 | (in-package #:dqvm2) 6 | 7 | (defvar *default-blocks-per-chunk* (expt 2 16) 8 | "Number of blocks for the ranks to collectively work on during a single step within APPLY-DISTRIBUTED-GATE.") 9 | 10 | (defun apply-distributed-gate (qvm instr &key (blocks-per-chunk *default-blocks-per-chunk*)) 11 | (let* ((addresses (addresses qvm)) 12 | (amplitudes (amplitudes qvm)) 13 | (scratch (scratch qvm)) 14 | 15 | (global-addresses (global-addresses addresses)) 16 | (number-of-processes (number-of-processes global-addresses)) 17 | 18 | (next-permutation (qubit-permutation instr)) 19 | (block-size (block-size addresses)) 20 | (blocks-per-process (blocks-per-process addresses)) 21 | 22 | ;; XXX Allocate once and reuse across subsequent calls to 23 | ;; apply-distributed-gate. 24 | (requests (make-instance 'requests :total (* 2 number-of-processes))) 25 | (all-recv-offsets (make-offset-arrays global-addresses)) 26 | (all-send-offsets (make-offset-arrays global-addresses))) 27 | 28 | (loop :for block-index :from 0 :below (1+ blocks-per-process) :by blocks-per-chunk 29 | :for start-offset := (* block-index block-size) 30 | :for end-offset := (* (+ block-index blocks-per-chunk) block-size) :do 31 | 32 | (reset-offset-arrays all-recv-offsets) 33 | (reset-offset-arrays all-send-offsets) 34 | 35 | (non-blocking-receive qvm next-permutation start-offset end-offset all-recv-offsets requests) 36 | (non-blocking-send qvm next-permutation start-offset end-offset all-send-offsets requests) 37 | 38 | (wait-all requests)) 39 | 40 | (compute-matrix-vector-products (quil:gate-matrix instr) scratch amplitudes 0 (length scratch)) 41 | 42 | (update-permutation next-permutation addresses) 43 | 44 | qvm)) 45 | 46 | (defun non-blocking-receive (qvm next-permutation start-offset end-offset all-recv-offsets requests) 47 | "Iterate over the addresses that should be in the current chunk after applying the next instruction. Start requests to receive the required amplitudes from the ranks where they are currently stored. 48 | 49 | The arguments START-OFFSET and END-OFFSET specify the offsets within the local portion of the wavefunction that will be inspected during this call. 50 | The parameter ALL-RECV-OFFSETS is the instance of OFFSET-ARRAYS which will hold the relevant offsets where data should be received. 51 | Finally, REQUESTS is an instance of the REQUESTS class that keeps track of MPI_Request objects." 52 | (loop :with addresses := (addresses qvm) 53 | :with global-addresses := (global-addresses addresses) 54 | :with next-addresses := (make-addresses-like addresses :permutation next-permutation) 55 | :with effective-end-offset := (min end-offset (* (block-size addresses) (number-of-blocks addresses))) 56 | 57 | :for offset :from start-offset :below effective-end-offset 58 | :for next-address := (get-address-by-offset next-addresses offset) 59 | :for source-rank := (get-rank-by-address global-addresses next-address) :do 60 | (offset-arrays-push offset source-rank all-recv-offsets) 61 | 62 | :finally (post-mpi-irecv qvm all-recv-offsets requests))) 63 | 64 | (defun non-blocking-send (qvm next-permutation start-offset end-offset all-send-offsets requests) 65 | "Iterate over all ranks and find which addresses within the current rank are needed by another rank. Aggregate that information, then start sending amplitudes. 66 | 67 | The arguments START-OFFSET and END-OFFSET specify the offsets within the local portion of the wavefunction that will be inspected during this call. 68 | The parameter ALL-SEND-OFFSETS is the instance of OFFSET-ARRAYS which will hold the relevant offsets of data that should be sent elsewhere. 69 | Finally, REQUESTS is an instance of the REQUESTS class that keeps track of MPI_Request objects." 70 | (loop :with addresses := (addresses qvm) 71 | :with number-of-processes := (number-of-processes addresses) 72 | 73 | :for count :from 0 :below number-of-processes 74 | :for target-rank := (mod (+ count (rank qvm)) number-of-processes) 75 | :for target-addresses := (make-addresses-like addresses :rank target-rank :permutation next-permutation) :do 76 | 77 | (loop :for target-offset :from start-offset :below end-offset 78 | :for target-address := (get-address-by-offset target-addresses target-offset) 79 | :while target-address :do 80 | 81 | (alexandria:when-let ((source-offset (offset addresses target-address))) 82 | (offset-arrays-push source-offset target-rank all-send-offsets)) 83 | 84 | :finally (post-mpi-isend qvm all-send-offsets requests 85 | :start target-rank 86 | :end (1+ target-rank))))) 87 | -------------------------------------------------------------------------------- /dqvm/src/entry-point.lisp: -------------------------------------------------------------------------------- 1 | ;;;; src/entry-point.lisp 2 | ;;;; 3 | ;;;; Author: Juan M. Bello-Rivas 4 | 5 | (in-package #:dqvm2) 6 | 7 | (defun %main (argv) 8 | (when (zerop +rank+) 9 | (format-log :debug "Command line arguments: \"~{~A~^ ~}\"" argv) 10 | 11 | (unless (rest argv) 12 | (format uiop/stream:*stderr* "Usage: ~A QUIL-FILE~%" (first argv)) 13 | (uiop:quit -1))) 14 | 15 | (let (qvm) 16 | (labels ((make-parsed-program-from-code-vector (code-vector) 17 | "Create a parsed program from an array of gate applications." 18 | (make-instance 'quil:parsed-program :executable-code code-vector)) 19 | 20 | (make-dqvm (number-of-qubits code-vector) 21 | "Instantiate a DISTRIBUTED-QVM object, load the program given by CODE-VECTOR, and set up its thread pools." 22 | (let ((qvm (make-distributed-qvm :number-of-qubits number-of-qubits 23 | :block-size (expt 2 (get-maximum-arity code-vector))))) 24 | (qvm:load-program qvm (make-parsed-program-from-code-vector code-vector)) 25 | (qvm:prepare-for-parallelization) 26 | qvm))) 27 | 28 | (declare (inline make-parsed-program-from-code-vector make-dqvm)) 29 | 30 | (cond 31 | ((zerop +rank+) 32 | (let ((filename (second argv))) 33 | 34 | (format-log :info "Reading Quil file ~S" filename) 35 | 36 | (let* ((program (quil:read-quil-file filename)) 37 | (number-of-qubits (quil:qubits-needed program))) 38 | 39 | (format-log :info "Read program ~S using ~D total qubits. Code: ~{~A~^, ~}" 40 | filename number-of-qubits 41 | (map 'list #'instruction->string 42 | (quil:parsed-program-executable-code program))) 43 | 44 | (setf qvm (make-dqvm (bcast :value number-of-qubits) (bcast-instructions program)))))) 45 | 46 | (t 47 | (format-log :info "Waiting for instructions") 48 | (setf qvm (make-dqvm (bcast) (bcast-instructions)))))) 49 | 50 | ;; (reset-wavefunction-debug qvm) 51 | 52 | (qvm:with-random-state ((qvm:seeded-random-state (get-random-seed))) 53 | (qvm:run qvm)) 54 | 55 | (save-wavefunction qvm "wavefunction.dat") 56 | 57 | (format-log :info "Finished program execution."))) 58 | 59 | (defun entry-point (argv) 60 | (let (;; (*print-pretty* t) 61 | ;; (*print-case* :downcase) 62 | ;; (*print-addresses* t) 63 | (qvm:*transition-verbose* t)) ; XXX turn this on/off via command line args. 64 | 65 | (uiop/stream:setup-stderr) 66 | 67 | ;; (regex-trace:regex-trace "^%MPI-.?(SEND|RECV|WAIT)" :print (mpi-comm-rank)) 68 | 69 | (unless (mpi-initialized) 70 | (mpi-init :thread-support :mpi-thread-multiple)) 71 | 72 | (mpi::%mpi-comm-set-errhandler +mpi-comm-world+ +mpi-errors-are-fatal+) 73 | 74 | (setf +rank+ (mpi-comm-rank)) 75 | 76 | (setup-logger "Welcome to the Rigetti Distributed Quantum Virtual Machine") 77 | (unwind-protect 78 | (with-profiling-maybe ("DQVM2" "QVM" "QUIL" "MPI" "CFFI") 79 | (%main argv)) 80 | (mpi-finalize) 81 | (uiop:quit)))) 82 | -------------------------------------------------------------------------------- /dqvm/src/linear-algebra.lisp: -------------------------------------------------------------------------------- 1 | ;;;; src/linear-algebra.lisp 2 | ;;;; 3 | ;;;; Author: Juan M. Bello-Rivas 4 | 5 | (in-package #:dqvm2) 6 | 7 | (defconstant +foreign-flonum+ (ecase qvm::+octets-per-flonum+ 8 | (4 :float) 9 | (8 :double)) 10 | "Foreign type corresponding to a FLONUM.") 11 | 12 | (defconstant +gemm+ (ecase qvm::+octets-per-flonum+ 13 | (4 #'magicl.blas-cffi::%%cgemm) 14 | (8 #'magicl.blas-cffi::%%zgemm)) 15 | "Generalized matrix-matrix multiplication routine.") 16 | 17 | (defun compute-matrix-vector-products (matrix input-array output-array start-offset end-offset) 18 | (magicl.cffi-types:with-array-pointers ((ptr-a (magicl::storage matrix))) 19 | (let* ((m (magicl:ncols matrix)) 20 | (n (/ (- end-offset start-offset) m)) 21 | (pos (* start-offset qvm::+octets-per-cflonum+)) 22 | (ptr-x (static-vector-pointer input-array :offset pos)) 23 | (ptr-y (static-vector-pointer output-array :offset pos))) 24 | 25 | (cffi:with-foreign-objects ((ptr-m :int32) 26 | (ptr-n :int32) 27 | (inc :int32) 28 | (alpha +foreign-flonum+ 2) 29 | (beta +foreign-flonum+ 2)) 30 | (setf (cffi:mem-ref ptr-m :int32) m 31 | (cffi:mem-ref ptr-n :int32) n 32 | (cffi:mem-ref inc :int32) 1 33 | (cffi:mem-aref alpha +foreign-flonum+ 0) (qvm:flonum 1) 34 | (cffi:mem-aref alpha +foreign-flonum+ 1) (qvm:flonum 0) 35 | (cffi:mem-aref beta +foreign-flonum+ 0) (qvm:flonum 0) 36 | (cffi:mem-aref beta +foreign-flonum+ 1) (qvm:flonum 0)) 37 | 38 | (funcall +gemm+ "N" "N" ptr-m ptr-n ptr-m alpha ptr-a ptr-m ptr-x ptr-m beta ptr-y ptr-m))))) 39 | -------------------------------------------------------------------------------- /dqvm/src/logging.lisp: -------------------------------------------------------------------------------- 1 | ;;;; src/logging.lisp 2 | ;;;; 3 | ;;;; Author: Juan M. Bello-Rivas 4 | 5 | (in-package #:dqvm2) 6 | 7 | (defvar *logger* nil "Global logging facility (per MPI rank).") 8 | (defparameter *log-level* :debug "Default log level") 9 | 10 | (defun make-logger (name &key (maximum-priority *log-level*)) 11 | "Create a logger called NAME with priority specified by MAXIMUM-PRIORITY." 12 | (make-instance 'cl-syslog:rfc5424-logger 13 | :app-name name 14 | :facility ':local0 15 | :maximum-priority maximum-priority 16 | :log-writer (cl-syslog:stream-log-writer uiop/stream:*stderr*))) 17 | 18 | (defun format-log (level &rest rest) 19 | "Send a message to syslog." 20 | (apply #'cl-syslog:format-log *logger* level rest)) 21 | 22 | (defun setup-logger (&optional message) 23 | "Easy set up of logger dynamic variable." 24 | (setf *logger* (make-logger (format nil "dqvm-~D" (mpi-comm-rank)))) 25 | (when (and message (zerop (mpi-comm-rank))) 26 | (format-log :info message)) 27 | 28 | ;; The barrier below is there for aesthetic reasons only. It enforces that the welcome message is the first line in the log file. 29 | (barrier)) 30 | -------------------------------------------------------------------------------- /dqvm/src/measurement.lisp: -------------------------------------------------------------------------------- 1 | ;;;; src/measurement.lisp 2 | ;;;; 3 | ;;;; Author: Juan M. Bello-Rivas 4 | ;;;; Robert Smith 5 | 6 | (in-package #:dqvm2) 7 | 8 | (defmethod measure ((qvm distributed-qvm) q) 9 | (check-type q qvm::nat-tuple-element) 10 | (assert (< q (number-of-qubits qvm)) (qvm q) 11 | "Trying to measure qubit ~D on a QVM with only ~D qubit~:P." 12 | q 13 | (qvm:number-of-qubits qvm)) 14 | (let* ((r (mt19937:random 1.0d0)) 15 | (excited-probability (wavefunction-excited-state-probability (addresses qvm) (amplitudes qvm) q)) 16 | (cbit (mpi-broadcast-anything 0 :object (boolean-bit (<= r excited-probability))))) 17 | 18 | ;; Force the non-deterministic measurement. 19 | (force-measurement cbit q qvm excited-probability) 20 | 21 | ;; Return the qvm. 22 | (values qvm cbit))) 23 | 24 | (defun wavefunction-excited-state-probability (addresses amplitudes q) 25 | (flet ((parallel-reduction () 26 | "Aggregate probabilities in parallel." 27 | (qvm:psum-dotimes (offset (number-of-addresses addresses)) 28 | (if (logbitp q (get-address-by-offset addresses offset)) 29 | (qvm:probability (aref amplitudes offset)) 30 | (qvm:flonum 0))))) 31 | 32 | (cffi:with-foreign-objects ((value :double) 33 | (probability :double)) 34 | (setf (cffi:mem-ref value :double) (parallel-reduction)) 35 | (mpi::%mpi-allreduce value probability 1 mpi:+mpi-double+ mpi:+mpi-sum+ mpi:*standard-communicator*) 36 | (cffi:mem-ref probability :double)))) 37 | 38 | (defun force-measurement (measured-value qubit qvm excited-probability) 39 | (let* ((wavefunction (amplitudes qvm)) 40 | (annihilated-state (- 1 measured-value)) 41 | (inv-norm (if (zerop annihilated-state) 42 | (/ (sqrt excited-probability)) 43 | (/ (sqrt (- (qvm:flonum 1) excited-probability))))) 44 | (addresses (addresses qvm))) 45 | 46 | (qvm:pdotimes (offset (number-of-addresses addresses)) 47 | (let ((address (get-address-by-offset addresses offset))) 48 | (setf (aref wavefunction offset) 49 | (if (= annihilated-state (ldb (byte 1 qubit) address)) 50 | (qvm:cflonum 0) 51 | (* inv-norm (aref wavefunction offset))))))) 52 | 53 | qvm) 54 | -------------------------------------------------------------------------------- /dqvm/src/mpi.lisp: -------------------------------------------------------------------------------- 1 | ;;;; src/mpi.lisp 2 | ;;;; 3 | ;;;; Author: Juan M. Bello-Rivas 4 | 5 | (in-package #:dqvm2) 6 | 7 | (defvar +rank+ nil "MPI rank in the MPI_COMM_WORLD communicator.") 8 | 9 | (defconstant +mpi-cflonum+ (ecase qvm::+octets-per-cflonum+ 10 | (8 mpi::+mpi-complex+) 11 | (16 mpi::+mpi-double-complex+)) 12 | "Size (in octets) per amplitude.") 13 | 14 | (defun bcast (&key (value 0) (type '(unsigned-byte 64))) 15 | "Broadcast a single VALUE of type ELEMENT-TYPE from MPI rank zero to all ranks. Returns the broadcasted VALUE." 16 | (with-static-vector (array 1 :element-type type 17 | :initial-element value) 18 | (mpi-bcast array 0) 19 | (aref array 0))) 20 | 21 | (defun bcast-instructions (&optional (program nil)) 22 | "Broadcast instructions in PROGRAM and return vector of GATE-APPLICATION objects." 23 | (if program 24 | (let ((instructions (quil:parsed-program-executable-code program))) 25 | (map 'vector 'string->instruction ; XXX do we need so many MAPs? 26 | (mpi-broadcast-anything 0 :object (map 'vector 'instruction->string instructions)))) 27 | (map 'vector 'string->instruction (mpi-broadcast-anything 0)))) 28 | 29 | (defun barrier (&optional (control-string nil) &rest format-arguments) 30 | "Enforce an MPI barrier." 31 | (when control-string 32 | (apply #'format-log :debug control-string format-arguments)) 33 | (mpi-barrier)) 34 | 35 | (defmacro with-mpi-type-indexed-block ((new-type count blocklength displacements oldtype) &body body) 36 | "Create a new MPI data type within the given scope." 37 | `(mpi::with-foreign-results ((,new-type 'mpi:mpi-datatype)) 38 | (mpi::%mpi-type-create-indexed-block ,count ,blocklength ,displacements ,oldtype ,new-type) 39 | (mpi::%mpi-type-commit ,new-type) 40 | (unwind-protect 41 | (progn 42 | ,@body) 43 | (mpi::%mpi-type-free ,new-type)))) 44 | 45 | (defmacro with-mpi-type-indexed-blocks (bindings &body body) 46 | (if bindings 47 | `(with-mpi-type-indexed-block ,(first bindings) 48 | (with-mpi-type-indexed-blocks ,(rest bindings) 49 | ,@body)) 50 | `(progn 51 | ,@body))) 52 | 53 | (defun mpi-get-count (status datatype) 54 | "High level interface to MPI_Get_count." 55 | (mpi::with-foreign-results ((count :int)) 56 | (mpi::%mpi-get-count status datatype count))) 57 | 58 | (defclass requests () 59 | ((count 60 | :reader request-count 61 | :type alexandria:non-negative-fixnum 62 | :initform 0 63 | :documentation "Current number of MPI_Requests in use.") 64 | (total 65 | :reader total 66 | :type alexandria:non-negative-fixnum 67 | :initarg :total 68 | :initform (error-missing-initform :total) 69 | :documentation "Total number of MPI_Requests allocated.") 70 | (array-ptr 71 | :reader array-ptr 72 | :initform nil 73 | :documentation "Pointer to array of MPI_Requests in foreign memory.")) 74 | 75 | (:documentation "Container of MPI_Request types.")) 76 | 77 | (defmethod initialize-instance :after ((requests requests) &rest initargs) 78 | (declare (ignore initargs)) 79 | 80 | (let ((ptr (cffi:foreign-alloc 'mpi::mpi-request ; XXX use QVM's allocation? 81 | :count (total requests)))) 82 | (setf (slot-value requests 'array-ptr) ptr) 83 | (trivial-garbage:finalize requests (lambda () 84 | (cffi:foreign-free ptr))))) 85 | 86 | (defmethod reset-requests ((requests requests)) 87 | (setf (slot-value requests 'count) 0)) 88 | 89 | (defmethod get-next-request ((requests requests)) 90 | (let ((count (request-count requests))) 91 | 92 | (setf (slot-value requests 'count) (1+ count)) 93 | (if (< count (total requests)) 94 | (cffi:mem-aptr (array-ptr requests) 'mpi-request count) 95 | (error "Number of available MPI_Requests exceeded.")))) 96 | 97 | (defmethod wait-all ((requests requests)) 98 | (mpi::%mpi-waitall (request-count requests) (array-ptr requests) (cffi:null-pointer)) 99 | (reset-requests requests)) 100 | -------------------------------------------------------------------------------- /dqvm/src/package.lisp: -------------------------------------------------------------------------------- 1 | ;;;; src/package.lisp 2 | ;;;; 3 | ;;;; Author: Juan M. Bello-Rivas 4 | 5 | (defpackage #:dqvm2 6 | (:use #:common-lisp 7 | #:cl-mpi 8 | #:cl-mpi-extensions 9 | #:static-vectors) 10 | (:import-from #:qvm 11 | #:boolean-bit 12 | #:defun-inlinable 13 | #:number-of-qubits 14 | #:transition) 15 | (:export #:*default-block-size* 16 | #:*print-addresses* 17 | #:address-member 18 | #:addresses 19 | #:amplitudes 20 | #:apply-inverse-permutation 21 | #:apply-inverse-qubit-permutation 22 | #:apply-permutation 23 | #:apply-qubit-permutation 24 | #:block-member 25 | #:block-size 26 | #:blocks-per-process 27 | #:compose-permutations 28 | #:copy-global-addresses 29 | #:distributed-qvm 30 | #:do-addresses 31 | #:do-addresses-in-block 32 | #:get-address-by-offset 33 | #:get-block-by-address 34 | #:get-effective-permutation 35 | #:get-initial-address 36 | #:get-rank-by-address 37 | #:get-rank-by-block 38 | #:global-addresses 39 | #:global-addresses= 40 | #:inverse-permutation 41 | #:is-identity-permutation-p 42 | #:make-addresses 43 | #:make-addresses-like 44 | #:make-distributed-qvm 45 | #:make-permutation 46 | #:number-of-addresses 47 | #:number-of-blocks 48 | #:number-of-processes 49 | #:number-of-qubits 50 | #:offset 51 | #:permutation 52 | #:print-qubit-permutation 53 | #:qubit-permutation 54 | #:rank 55 | #:remainder-blocks 56 | #:reset-wavefunction 57 | #:save-wavefunction 58 | #:scratch 59 | #:transposition 60 | #:update-permutation 61 | )) 62 | 63 | (defpackage #:dqvm2-user 64 | (:use #:common-lisp 65 | #:cl-mpi 66 | #:cl-mpi-extensions 67 | #:dqvm2)) 68 | -------------------------------------------------------------------------------- /dqvm/src/sendrecv.lisp: -------------------------------------------------------------------------------- 1 | ;;;; src/sendrecv.lisp 2 | ;;;; 3 | ;;;; Author: Juan M. Bello-Rivas 4 | 5 | (in-package #:dqvm2) 6 | 7 | (defmethod post-mpi-request ((qvm distributed-qvm) all-offsets action requests &key (start 0) end) 8 | "Post non-blocking MPI_Isend/MPI_Irecv requests for the amplitudes specified in ALL-OFFSETS, to be stored in the scratch array of QVM. The associated MPI_Requests are handled by REQUESTS." 9 | (check-type all-offsets offset-arrays) 10 | (check-type action (member send recv)) 11 | (check-type requests requests) 12 | 13 | (let ((number-of-processes (number-of-processes qvm)) 14 | (ptr-data (static-vector-pointer (ecase action 15 | (send (amplitudes qvm)) 16 | (recv (scratch qvm))))) 17 | (tag (qvm::pc qvm))) 18 | 19 | (loop :with real-end := (or (and end (min end number-of-processes)) number-of-processes) 20 | :for target-rank :from start :below real-end 21 | :for offsets := (aref (slot-value all-offsets 'offsets) target-rank) 22 | :for count := (aref (slot-value all-offsets 'counts) target-rank) 23 | :when (plusp count) :do 24 | 25 | (with-mpi-type-indexed-block (type-indexed-block count 1 offsets +mpi-cflonum+) 26 | (funcall (ecase action 27 | (send #'mpi::%mpi-isend) 28 | (recv #'mpi::%mpi-irecv)) 29 | ptr-data 1 (cffi:mem-ref type-indexed-block 'mpi:mpi-datatype) 30 | target-rank tag +mpi-comm-world+ 31 | (get-next-request requests)))))) 32 | 33 | (defun post-mpi-irecv (qvm all-recv-offsets requests &key (start 0) end) 34 | "Post non-blocking MPI_Irecv requests for the amplitudes specified in ALL-RECV-OFFSETS, to be stored in the scratch array of QVM. The associated MPI_Requests are handled by REQUESTS." 35 | (post-mpi-request qvm all-recv-offsets 'recv requests :start start :end end)) 36 | 37 | (defun post-mpi-isend (qvm all-send-offsets requests &key (start 0) end) 38 | "Post non-blocking MPI_Isend requests for the amplitudes specified in ALL-SEND-OFFSETS, to be stored in the scratch array of QVM. The associated MPI_Requests are handled by REQUESTS." 39 | (post-mpi-request qvm all-send-offsets 'send requests :start start :end end)) 40 | -------------------------------------------------------------------------------- /dqvm/src/transition.lisp: -------------------------------------------------------------------------------- 1 | ;;;; src/transition.lisp 2 | ;;;; 3 | ;;;; Author: Juan M. Bello-Rivas 4 | ;;;; Robert Smith 5 | 6 | (in-package #:dqvm2) 7 | 8 | (defmethod transition :around (qvm instr) 9 | ;; Ideally, we should make *trace-output* be a gateway to cl-syslog instead of adapting QVM's code here. 10 | (cond 11 | ((not qvm:*transition-verbose*) (call-next-method)) 12 | (t 13 | (let ((start (get-internal-real-time)) 14 | gc-time bytes-alloc) 15 | (multiple-value-prog1 (qvm::measuring-gc (gc-time bytes-alloc) (call-next-method)) 16 | ;; (format-log :debug "~A" qvm) 17 | 18 | (format-log :debug "Transition ~/cl-quil:instruction-fmt/ took ~D ms (gc: ~D ms; alloc: ~D bytes)" 19 | instr 20 | (round (* (/ 1000 internal-time-units-per-second) 21 | (- (get-internal-real-time) start))) 22 | gc-time 23 | bytes-alloc)))))) 24 | 25 | (defmethod transition ((qvm distributed-qvm) (instr quil:gate-application)) 26 | (format-log :debug "Evaluating instruction ~A" (instruction->string instr)) 27 | 28 | (apply-distributed-gate qvm instr) 29 | 30 | (incf (qvm::pc qvm)) 31 | qvm) 32 | 33 | (defmethod transition ((qvm distributed-qvm) (instr quil:halt)) 34 | (declare (ignore instr)) 35 | (setf (qvm::pc qvm) nil) 36 | qvm) 37 | 38 | (defmethod transition ((qvm distributed-qvm) (instr quil:measure-discard)) 39 | (incf (qvm::pc qvm)) 40 | (multiple-value-bind (ret-qvm cbit) 41 | (measure qvm 42 | (quil:qubit-index (quil:measurement-qubit instr))) 43 | (when (zerop (mpi-comm-rank)) 44 | (format-log :info "~A -> ~D" instr cbit)) 45 | ret-qvm)) 46 | 47 | (defmethod transition ((qvm distributed-qvm) (instr quil:reset)) 48 | (declare (ignore instr)) 49 | (fill (amplitudes qvm) (qvm::cflonum 0)) 50 | (alexandria:when-let ((offset (offset (addresses qvm) 0))) 51 | (setf (aref (amplitudes qvm) offset) (qvm::cflonum 1))) 52 | (incf (qvm::pc qvm)) 53 | qvm) 54 | 55 | (defmethod transition ((qvm distributed-qvm) (instr quil:reset-qubit)) 56 | ;; See also: qvm/src/transition.lisp 57 | (let ((q (quil:qubit-index (quil:reset-qubit-target instr)))) 58 | (multiple-value-bind (measured-qvm measured-bit) 59 | (measure qvm q) 60 | (when (= 1 measured-bit) 61 | (let ((x-instr (aref (quil:parsed-program-executable-code 62 | (quil:parse-quil (format nil "X ~D" q))) 63 | 0) 64 | ;; XXX Do something more elegant here. 65 | )) 66 | (apply-distributed-gate qvm x-instr))) 67 | (setf (qvm::pc qvm) (1+ (qvm::pc measured-qvm))) 68 | qvm))) 69 | -------------------------------------------------------------------------------- /dqvm/src/utilities.lisp: -------------------------------------------------------------------------------- 1 | ;;;; src/utils.lisp 2 | ;;;; 3 | ;;;; Author: Juan M. Bello-Rivas 4 | ;;;; Robert Smith 5 | ;;;; Lauren Capelluto 6 | 7 | (in-package #:dqvm2) 8 | 9 | (defun error-missing-initform (symbol) 10 | (error "You must specify ~S." symbol)) 11 | 12 | (defun instruction->string (instruction) 13 | "Return string representation of INSTRUCTION." 14 | (format nil "~/cl-quil:instruction-fmt/" instruction)) 15 | 16 | (defun string->instruction (string) 17 | "Return instruction corresponding to STRING." 18 | (aref (quil:parsed-program-executable-code (quil:parse-quil string)) 0)) 19 | 20 | (defun get-maximum-arity (instructions) 21 | "Return the maximum arity of an array of INSTRUCTIONS." 22 | (loop :for instruction :across instructions 23 | :maximizing (length (quil::arguments instruction)))) 24 | 25 | (defun dqvm-error (datum &rest arguments) 26 | "Signal the condition formed by DATUM and ARGUMENTS." 27 | (apply #'format-log :err datum arguments) 28 | (apply #'error datum arguments)) 29 | 30 | (defmacro with-foreign-arrays (bindings &body body) 31 | (if bindings 32 | `(cffi:with-foreign-array ,(first bindings) 33 | (with-foreign-arrays ,(rest bindings) 34 | ,@body)) 35 | `(progn 36 | ,@body))) 37 | 38 | (defun get-random-seed () 39 | "Return a seed for the random number generator." 40 | ;; TODO use CFFI to call gettimeofday(2) on POSIX-compatible systems. 41 | #+sbcl 42 | (let ((random-seed (+ (nth-value 1 (sb-ext:get-time-of-day)) 43 | (mpi-comm-rank)))) 44 | (format-log :info "Using random seed: ~D." random-seed) 45 | random-seed) 46 | #-sbcl 47 | (let ((random-seed (+ (get-universal-time) 48 | (mpi-comm-rank)))) 49 | (format-log :warning "Using random seed: ~D. This seed is of low ~ 50 | quality, consider passing a suitable seed via the command line." 51 | random-seed) 52 | random-seed)) 53 | 54 | (defvar *default-number-of-profiling-samples* 10000 55 | "Default number of samples to draw during statistical profiling.") 56 | 57 | (defmacro with-profiling-maybe ((&rest package-names) &body body) 58 | "Run BODY under the statistical profiler if the environment variable DQVM_PROFILE has been set to a valid profiling mode (cpu, time, or alloc). Call counts to functions in PACKAGE-NAMES are explicitly reported." 59 | #+sbcl 60 | (let ((profile (gensym "PROFILE-")) 61 | (mode (gensym "MODE-"))) 62 | `(alexandria:if-let ((,profile (uiop:getenv "DQVM_PROFILE"))) 63 | (let ((,mode (alexandria:make-keyword (string-upcase ,profile)))) 64 | (with-open-file (stream (format nil "prof-~a-~2,'0d-~2,'0d.log" ,mode (mpi-comm-rank) (mpi-comm-size)) 65 | :direction :output :if-exists :supersede) 66 | (funcall #'sb-sprof:profile-call-counts ,@package-names) 67 | (sb-sprof:with-profiling (:max-samples ,*default-number-of-profiling-samples* :mode ,mode :threads :all) 68 | ,@body) 69 | (sb-sprof:report :type :graph :stream stream))) 70 | (progn ,@body))) 71 | #-sbcl 72 | `(progn ,@body)) 73 | -------------------------------------------------------------------------------- /dqvm/tests/addresses-tests.lisp: -------------------------------------------------------------------------------- 1 | ;;;; tests/addresses-tests.lisp 2 | ;;;; 3 | ;;;; Author: Juan M. Bello-Rivas 4 | 5 | (in-package #:dqvm2-tests) 6 | 7 | (deftest test-addresses () 8 | (signals error (make-instance 'addresses)) 9 | (signals error (make-addresses :rank -1 :number-of-qubits 1)) 10 | (signals error (make-addresses :rank 0 :number-of-processes -1 :number-of-qubits 1)) 11 | (signals error (make-addresses :rank 1 :number-of-processes 1 :number-of-qubits 1)) 12 | 13 | ;; Test basic facilities. 14 | (let* ((block-size 4) 15 | (a-0 (make-addresses :rank 0 :number-of-processes 3 :number-of-qubits 5 :block-size block-size)) 16 | (a-1 (make-addresses :rank 1 :number-of-processes 3 :number-of-qubits 5 :block-size block-size)) 17 | (a-2 (make-addresses :rank 2 :number-of-processes 3 :number-of-qubits 5 :block-size block-size)) 18 | (blocks-per-process (floor (dqvm2::number-of-blocks (global-addresses a-0)) 19 | (dqvm2::number-of-processes (global-addresses a-0))))) 20 | 21 | (is (= (dqvm2::number-of-addresses (global-addresses a-0))) 22 | (expt 2 (number-of-qubits a-0))) 23 | 24 | (is (<= (number-of-addresses a-0) (* (1+ blocks-per-process) block-size))) 25 | (is (<= (number-of-addresses a-1) (* (1+ blocks-per-process) block-size))) 26 | (is (<= (number-of-addresses a-2) (* blocks-per-process block-size))) 27 | 28 | (is (address-member 0 a-0)) 29 | (is (not (address-member 31 a-0))) 30 | (is (address-member 31 a-1)) 31 | 32 | (is (null (offset a-0 (1+ (* blocks-per-process block-size))))) 33 | (is (= (offset a-0 0) 0)) 34 | (is (= (offset a-0 24) 8)) 35 | (is (= (offset a-1 31) 11))) 36 | 37 | ;; Test get address by offset. 38 | (flet ((test-get-address-by-offset (addresses) 39 | (let ((offset 0)) 40 | (do-addresses (address addresses) 41 | (is (= (get-address-by-offset addresses offset) address)) 42 | (incf offset))))) 43 | 44 | (test-get-address-by-offset (make-addresses :rank 0 :number-of-processes 3 :number-of-qubits 6)) 45 | (test-get-address-by-offset (make-addresses :rank 1 :number-of-processes 3 :number-of-qubits 6)) 46 | (test-get-address-by-offset (make-addresses :rank 2 :number-of-processes 3 :number-of-qubits 6))) 47 | 48 | ;; Test consistency. 49 | (flet ((test-rank (p n) 50 | "Verify that the addresses in a table are consistent with its prescribed rank." 51 | (let ((addrs-list (loop :for r :from 0 :below p 52 | :collect (make-addresses :rank r :number-of-processes p :number-of-qubits n)))) 53 | (loop :with global-addrs := (global-addresses (first addrs-list)) 54 | :for addrs :in addrs-list :do 55 | (do-addresses (a addrs) 56 | (is (= (dqvm2::get-rank-by-address global-addrs a) (rank addrs)))))))) 57 | 58 | (test-rank 1 5) 59 | (test-rank 2 5) 60 | (test-rank 3 5) 61 | (test-rank 4 5) 62 | (test-rank 5 5))) 63 | 64 | (deftest test-do-addresses-in-block () 65 | (labels ((get-addresses-in-block (global-addresses block-index) 66 | (let (address-list) 67 | (do-addresses-in-block (address global-addresses block-index (nreverse address-list)) 68 | (push address address-list)))) 69 | 70 | (test-block (addresses block) 71 | (loop :with global-addresses := (global-addresses addresses) 72 | :for address :in block 73 | :for block-index := (get-block-by-address global-addresses address) :do 74 | (is (equalp (get-addresses-in-block global-addresses block-index) block))))) 75 | 76 | (let* ((permutation (dqvm2::make-permutation '((0 . 1)))) 77 | (global-addresses (make-instance 'global-addresses :number-of-processes 3 78 | :number-of-qubits 4 79 | :block-size 2 80 | :permutation permutation)) 81 | (a-0 (make-instance 'addresses :rank 0 :global-addresses global-addresses)) 82 | (a-1 (dqvm2::make-addresses-like a-0 :rank 1)) 83 | (a-2 (dqvm2::make-addresses-like a-0 :rank 2))) 84 | (test-block a-0 '(0 2)) 85 | (test-block a-0 '(1 3)) 86 | (test-block a-0 '(12 14)) 87 | (test-block a-1 '(4 6)) 88 | (test-block a-1 '(5 7)) 89 | (test-block a-1 '(13 15)) 90 | (test-block a-2 '(8 10)) 91 | (test-block a-2 '(9 11)) 92 | (is (null (get-addresses-in-block a-0 128)))) 93 | 94 | (let* ((permutation (dqvm2::make-permutation '((0 . 1)))) 95 | (global-addresses (make-instance 'global-addresses :number-of-processes 3 96 | :number-of-qubits 4 97 | :block-size 4 98 | :permutation permutation)) 99 | (a-0 (make-instance 'addresses :rank 0 :global-addresses global-addresses)) 100 | (a-1 (dqvm2::make-addresses-like a-0 :rank 1)) 101 | (a-2 (dqvm2::make-addresses-like a-0 :rank 2))) 102 | (test-block a-0 '(0 2 1 3)) 103 | (test-block a-0 '(12 14 13 15)) 104 | (test-block a-1 '(4 6 5 7)) 105 | (test-block a-2 '(8 10 9 11)) 106 | (is (null (get-addresses-in-block a-0 128)))))) 107 | -------------------------------------------------------------------------------- /dqvm/tests/distributed-qvm-tests.lisp: -------------------------------------------------------------------------------- 1 | ;;;; tests/distributed-qvm-tests.lisp 2 | ;;;; 3 | ;;;; Author: Juan M. Bello-Rivas 4 | 5 | (in-package #:dqvm2-tests) 6 | 7 | (deftest test-distributed-qvm-addresses () 8 | (let* ((num-qubits 8) 9 | (number-of-processes 4) 10 | (rank 1) 11 | (qvm (make-distributed-qvm :rank rank 12 | :number-of-processes number-of-processes 13 | :number-of-qubits num-qubits)) 14 | (block-length (/ (expt 2 num-qubits) 4)) 15 | (expected-addresses (loop :for i :from (* block-length rank) 16 | :below (* block-length (1+ rank)) 17 | :collect i)) 18 | (actual-addresses (let (x) 19 | (do-addresses (address (addresses qvm) (nreverse x)) 20 | (push address x))))) 21 | 22 | (is (equalp actual-addresses expected-addresses)))) 23 | 24 | (defun find-next-addresses (addresses next-permutation) 25 | "Find amplitude addresses to exchange when applying NEXT-PERMUTATION and the rank where the amplitudes are located. 26 | 27 | Returns four sequences: current addresses, new addresses, and the source and target addresses." 28 | (check-type next-permutation permutation) 29 | 30 | (let ((permutation (permutation addresses)) 31 | (effective-permutation 32 | (dqvm2::get-effective-permutation addresses next-permutation)) 33 | (orig-addresses nil) 34 | (next-addresses nil) 35 | (target-addresses nil) 36 | (source-addresses nil)) 37 | 38 | (do-addresses (address addresses (values (nreverse orig-addresses) 39 | (nreverse next-addresses) 40 | (nreverse target-addresses) 41 | (nreverse source-addresses))) 42 | ;; First, find the next address $y = π₂ ∘ π₁⁻¹(x)$, where $x$ is the current address. Next, compute $z = π₁^{-1}(y)$. 43 | (let* ((next-address (apply-qubit-permutation effective-permutation address)) 44 | (target-address (apply-inverse-qubit-permutation next-permutation address)) 45 | (source-address (apply-inverse-qubit-permutation permutation next-address))) 46 | 47 | (push address orig-addresses) 48 | (push next-address next-addresses) 49 | (push target-address target-addresses) 50 | (push source-address source-addresses))))) 51 | 52 | (deftest test-distributed-qvm-consistency () 53 | (labels ((make-qvm (r p n) 54 | (make-distributed-qvm :rank r :number-of-processes p :number-of-qubits n)) 55 | 56 | (get-addresses (qvm) 57 | "Get a list of addresses contained in the address table of DQVM." 58 | (let (addresses) 59 | (do-addresses (address (addresses qvm) (nreverse addresses)) 60 | (push address addresses)))) 61 | 62 | (test-consistency (rank number-of-processes number-of-qubits) 63 | "Check the consistency of the distributed QVM throughout applying permutations to its address table." 64 | (let* ((qvm-a (make-qvm rank number-of-processes number-of-qubits)) 65 | (qvm-b (make-qvm rank number-of-processes number-of-qubits)) 66 | (program (quil:parse-quil "X 1; Z 2; I 1; CNOT 1 2; Y 2")) 67 | (instructions (coerce (quil:parsed-program-executable-code program) 'list)) 68 | (permutations (mapcar #'qubit-permutation instructions))) 69 | 70 | ;; Simulate transitions one instruction at a time and check that the updated qvm is consistent with the applied permutations. 71 | (dolist (instruction instructions) 72 | (let* ((addresses (addresses qvm-a)) 73 | 74 | (next-permutation (qubit-permutation instruction)) 75 | (next-addresses (find-next-addresses addresses next-permutation))) 76 | 77 | (is (equalp (get-addresses qvm-a) next-addresses)) 78 | (update-permutation next-permutation addresses))) 79 | 80 | ;; Make sure the outcome from the previous step is the same as applying the permutations. 81 | (let ((addresses-b 82 | (loop :with xs := (coerce (get-addresses qvm-b) 'vector) 83 | :for pi-1 :in (cons nil permutations) 84 | :for pi-2 :in permutations 85 | :for next-permutation := (compose-permutations pi-2 (inverse-permutation pi-1)) 86 | :do (setf xs (map 'vector (lambda (x) (apply-qubit-permutation next-permutation x)) xs)) 87 | :finally (return (coerce xs 'list))))) 88 | (is (equalp (get-addresses qvm-a) addresses-b)))))) 89 | 90 | (test-consistency 0 4 8) 91 | (test-consistency 1 4 8) 92 | (test-consistency 2 4 8) 93 | (test-consistency 3 4 8) 94 | 95 | (test-consistency 0 5 8) 96 | (test-consistency 1 5 8) 97 | (test-consistency 2 5 8) 98 | (test-consistency 3 5 8))) 99 | -------------------------------------------------------------------------------- /dqvm/tests/offset-arrays-tests.lisp: -------------------------------------------------------------------------------- 1 | ;;;; tests/offset-arrays-tests.lisp 2 | ;;;; 3 | ;;;; Author: Juan M. Bello-Rivas 4 | 5 | (in-package #:dqvm2-tests) 6 | 7 | (deftest test-offset-arrays () 8 | (let* ((g (make-instance 'global-addresses :number-of-qubits 5 :number-of-processes 3)) 9 | (o (dqvm2::make-offset-arrays g))) 10 | 11 | ;; Fill the offset array for rank #0 12 | (dotimes (i (* (block-size g) 13 | (+ (blocks-per-process g) 14 | (remainder-blocks g)))) 15 | (dqvm2::offset-arrays-push (+ 10 i) 0 o)) 16 | 17 | ;; Check that the offsets were correctly stored. 18 | (let ((offsets (aref (slot-value o 'dqvm2::offsets) 0))) 19 | 20 | (dotimes (i (* (block-size g) 21 | (+ (blocks-per-process g) 22 | (remainder-blocks g)))) 23 | 24 | (is (= (cffi:mem-aref offsets :int32 i) 25 | (+ 10 i))))) 26 | 27 | ;; Ensure that overflows are correctly handled. 28 | (signals error (dqvm2::offset-arrays-push 1000 0 o)) 29 | 30 | ;; Reset, then test that the counters have been reinitialized. 31 | (dqvm2::reset-offset-arrays o) 32 | (loop :for count :across (slot-value o 'dqvm2::counts) :do (is (zerop count))))) 33 | -------------------------------------------------------------------------------- /dqvm/tests/package.lisp: -------------------------------------------------------------------------------- 1 | ;;;; tests/package.lisp 2 | ;;;; 3 | ;;;; Author: Juan M. Bello-Rivas 4 | 5 | (fiasco:define-test-package #:dqvm2-tests 6 | (:use #:dqvm2) 7 | 8 | (:export 9 | #:run-dqvm2-tests)) 10 | -------------------------------------------------------------------------------- /dqvm/tests/permutation-tests.lisp: -------------------------------------------------------------------------------- 1 | ;;;; tests/permutation-tests.lisp 2 | ;;;; 3 | ;;;; Author: Juan M. Bello-Rivas 4 | 5 | (in-package #:dqvm2-tests) 6 | 7 | (deftest test-permutation () 8 | (signals error (make-permutation '((1 . 0) (1 . 2)))) 9 | (signals error (make-permutation '((1 . 2) (3 . 2)))) 10 | 11 | (let ((permutation '())) 12 | (is (is-identity-permutation-p permutation)) 13 | 14 | (is (= (apply-permutation permutation 0) 0)) 15 | (is (= (apply-permutation permutation 1) 1)) 16 | (is (= (apply-permutation permutation 2) 2))) 17 | 18 | (let ((permutation (make-permutation))) 19 | (is (is-identity-permutation-p permutation)) 20 | 21 | (is (= (apply-permutation permutation 0) 0)) 22 | (is (= (apply-permutation permutation 1) 1)) 23 | (is (= (apply-permutation permutation 2) 2)) 24 | 25 | (is (= (apply-inverse-permutation permutation 0) 0)) 26 | (is (= (apply-inverse-permutation permutation 1) 1)) 27 | (is (= (apply-inverse-permutation permutation 2) 2))) 28 | 29 | (let ((permutation (make-permutation '((2 . 1) (1 . 0))))) 30 | (is (not (is-identity-permutation-p permutation))) 31 | 32 | (is (= (apply-permutation permutation 2) 1)) 33 | (is (= (apply-permutation permutation 1) 0)) 34 | (is (= (apply-permutation permutation 0) 2)) 35 | 36 | (is (= (apply-inverse-permutation permutation 0) 1)) 37 | (is (= (apply-inverse-permutation permutation 1) 2)) 38 | (is (= (apply-inverse-permutation permutation 2) 0)) 39 | 40 | (is (= (apply-qubit-permutation permutation #b000) #b000)) 41 | (is (= (apply-qubit-permutation permutation #b001) #b100)) 42 | (is (= (apply-qubit-permutation permutation #b010) #b001)) 43 | (is (= (apply-qubit-permutation permutation #b011) #b101)) 44 | (is (= (apply-qubit-permutation permutation #b100) #b010)) 45 | (is (= (apply-qubit-permutation permutation #b101) #b110)) 46 | (is (= (apply-qubit-permutation permutation #b110) #b011)) 47 | (is (= (apply-qubit-permutation permutation #b111) #b111)) 48 | 49 | (is (= (apply-inverse-qubit-permutation permutation #b000) #b000)) 50 | (is (= (apply-inverse-qubit-permutation permutation #b001) #b010)) 51 | (is (= (apply-inverse-qubit-permutation permutation #b010) #b100)) 52 | (is (= (apply-inverse-qubit-permutation permutation #b011) #b110)) 53 | (is (= (apply-inverse-qubit-permutation permutation #b100) #b001)) 54 | (is (= (apply-inverse-qubit-permutation permutation #b101) #b011)) 55 | (is (= (apply-inverse-qubit-permutation permutation #b110) #b101)) 56 | (is (= (apply-inverse-qubit-permutation permutation #b111) #b111))) 57 | 58 | (let* ((permutation1 (make-permutation '((2 . 1)))) 59 | (permutation2 (make-permutation '((0 . 1) (1 . 2)))) 60 | (composition (compose-permutations permutation1 permutation2))) 61 | (is (not (is-identity-permutation-p permutation1))) 62 | (is (not (is-identity-permutation-p permutation2))) 63 | 64 | (is (is-identity-permutation-p 65 | (compose-permutations permutation1 66 | (inverse-permutation permutation1)))) 67 | 68 | (is (is-identity-permutation-p 69 | (compose-permutations permutation2 70 | (inverse-permutation permutation2)))) 71 | 72 | (is (= (apply-permutation composition 0) 2)) 73 | (is (= (apply-permutation composition 1) 1)) 74 | (is (= (apply-permutation composition 2) 0)))) 75 | -------------------------------------------------------------------------------- /dqvm/tests/suite.lisp: -------------------------------------------------------------------------------- 1 | ;;;; tests/suite.lisp 2 | ;;;; 3 | ;;;; Author: Juan M. Bello-Rivas 4 | ;;;; Robert Smith 5 | 6 | (in-package #:dqvm2-tests) 7 | 8 | (defun run-dqvm2-tests (&key (headless nil)) 9 | "Run all QVM tests. If HEADLESS is T, disable interactive debugging and quit on completion." 10 | ;; Bug in Fiasco commit fe89c0e924c22c667cc11c6fc6e79419fc7c1a8b 11 | (setf fiasco::*test-run-standard-output* (make-broadcast-stream 12 | *standard-output*)) 13 | (qvm:prepare-for-parallelization) 14 | (cond 15 | ((null headless) 16 | (run-package-tests :package ':dqvm2-tests 17 | :verbose nil 18 | :describe-failures t 19 | :interactive t)) 20 | (t 21 | (let ((successp (run-package-tests :package ':dqvm2-tests 22 | :verbose t 23 | :describe-failures t 24 | :interactive nil))) 25 | (uiop:quit (qvm::boolean-bit (not successp))))))) 26 | -------------------------------------------------------------------------------- /examples/bell.quil: -------------------------------------------------------------------------------- 1 | H 0 2 | CNOT 0 1 3 | -------------------------------------------------------------------------------- /examples/package.lisp: -------------------------------------------------------------------------------- 1 | ;;;; examples/package.lisp 2 | ;;;; 3 | ;;;; Author: Robert Smith 4 | 5 | (defpackage #:qvm-examples 6 | (:use #:cl #:qvm) 7 | (:local-nicknames (#:quil #:cl-quil)) 8 | 9 | ;; qft.lisp 10 | (:export 11 | #:bit-reversal-circuit ; FUNCTION 12 | #:qft-circuit ; FUNCTION 13 | ) 14 | ) 15 | -------------------------------------------------------------------------------- /examples/qft.lisp: -------------------------------------------------------------------------------- 1 | ;;;; examples/qft.lisp 2 | ;;;; 3 | ;;;; Author: Robert Smith 4 | 5 | (in-package #:qvm-examples) 6 | 7 | ;;;; Circuit generators for the Quantum Fourier Transform. 8 | 9 | (defun bit-reversal-circuit (qubits) 10 | "Create a circuit which does a bit reversal on the amplitude indexes." 11 | (let ((n (length qubits))) 12 | (if (< n 2) 13 | nil 14 | (loop :for i :below (floor n 2) 15 | :for qs :in qubits 16 | :for qe :in (reverse qubits) 17 | :collect (make-instance 'quil:gate-application 18 | :operator #.(quil:named-operator "SWAP") 19 | :name-resolution (quil:lookup-standard-gate "SWAP") 20 | :arguments (list (quil:qubit qs) 21 | (quil:qubit qe))))))) 22 | 23 | (defun qft-circuit (qubits) 24 | "Generate the QFT circuit on the given qubits." 25 | (labels ((qft (qubits) 26 | (destructuring-bind (q . qs) qubits 27 | (if (null qs) 28 | (list (make-instance 'quil:gate-application 29 | :operator #. (quil:named-operator "H") 30 | :name-resolution (quil:lookup-standard-gate "H") 31 | :arguments (list (quil:qubit q)))) 32 | (let ((cR nil)) 33 | (loop :with n := (1+ (length qs)) 34 | :for i :from (1- n) :downto 1 35 | :for qi :in qs 36 | :for angle := (qvm:flonum (/ pi (expt 2 (- n i)))) 37 | :do (push (make-instance 38 | 'quil:gate-application 39 | :operator #.(quil:named-operator "CPHASE") 40 | :name-resolution (quil:lookup-standard-gate "CPHASE") 41 | :parameters (list (quil:constant angle)) 42 | :arguments (list (quil:qubit q) 43 | (quil:qubit qi))) 44 | cR)) 45 | (append 46 | (qft qs) 47 | cR 48 | (list (make-instance 'quil:gate-application 49 | :operator #. (quil:named-operator "H") 50 | :name-resolution (quil:lookup-standard-gate "H") 51 | :arguments (list (quil:qubit q)))))))))) 52 | (make-instance 'quil:parsed-program 53 | :gate-definitions nil 54 | :circuit-definitions nil 55 | :executable-code 56 | (concatenate 57 | 'vector 58 | ;; Core QFT with normalization. 59 | (qft qubits) 60 | 61 | ;; Re-ordering the output. 62 | (bit-reversal-circuit qubits))))) 63 | -------------------------------------------------------------------------------- /quil/circs.quil: -------------------------------------------------------------------------------- 1 | ### Some useful circuits 2 | 3 | DEFCIRCUIT BELL p q: 4 | # Control p 5 | # Target q 6 | H p 7 | CNOT p q 8 | 9 | DEFCIRCUIT ZERO-STATE q c: 10 | # Put q into the |0> state. 11 | # c is a scratch bit, which will 12 | # contain its measurement. 13 | MEASURE q c 14 | JUMP-UNLESS @end c 15 | X q 16 | LABEL @end 17 | 18 | DEFCIRCUIT ONE-STATE q c: 19 | # Put q into the |1> state. 20 | # c is a scratch bit, which will 21 | # contain its measurement. 22 | ZERO-STATE q c 23 | X q 24 | 25 | -------------------------------------------------------------------------------- /quil/other.quil: -------------------------------------------------------------------------------- 1 | ### Other gates, like useful ion trap gates 2 | 3 | # 4 qubit variant 4 | DEFGATE MOLMER-SORENSEN: 5 | 1/sqrt(2), 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, i/sqrt(2) 6 | 0, 1/sqrt(2), 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, i/sqrt(2), 0 7 | 0, 0, 1/sqrt(2), 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, i/sqrt(2), 0, 0 8 | 0, 0, 0, 1/sqrt(2), 0, 0, 0, 0, 0, 0, 0, 0, i/sqrt(2), 0, 0, 0 9 | 0, 0, 0, 0, 1/sqrt(2), 0, 0, 0, 0, 0, 0, i/sqrt(2), 0, 0, 0, 0 10 | 0, 0, 0, 0, 0, 1/sqrt(2), 0, 0, 0, 0, i/sqrt(2), 0, 0, 0, 0, 0 11 | 0, 0, 0, 0, 0, 0, 1/sqrt(2), 0, 0, i/sqrt(2), 0, 0, 0, 0, 0, 0 12 | 0, 0, 0, 0, 0, 0, 0, 1/sqrt(2), i/sqrt(2), 0, 0, 0, 0, 0, 0, 0 13 | 0, 0, 0, 0, 0, 0, 0, i/sqrt(2), 1/sqrt(2), 0, 0, 0, 0, 0, 0, 0 14 | 0, 0, 0, 0, 0, 0, i/sqrt(2), 0, 0, 1/sqrt(2), 0, 0, 0, 0, 0, 0 15 | 0, 0, 0, 0, 0, i/sqrt(2), 0, 0, 0, 0, 1/sqrt(2), 0, 0, 0, 0, 0 16 | 0, 0, 0, 0, i/sqrt(2), 0, 0, 0, 0, 0, 0, 1/sqrt(2), 0, 0, 0, 0 17 | 0, 0, 0, i/sqrt(2), 0, 0, 0, 0, 0, 0, 0, 0, 1/sqrt(2), 0, 0, 0 18 | 0, 0, i/sqrt(2), 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1/sqrt(2), 0, 0 19 | 0, i/sqrt(2), 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1/sqrt(2), 0 20 | i/sqrt(2), 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1/sqrt(2) 21 | 22 | DEFGATE BARENCO(%alpha, %theta, %phi): 23 | 1, 0, 0, 0 24 | 0, 1, 0, 0 25 | 0, 0, cis(%alpha) * cos(%theta), -i * cis(%alpha - %phi) * sin(%theta) 26 | 0, 0, -i * cis(%alpha + %phi) * sin(%theta), cis(%alpha) * cos(%theta) 27 | -------------------------------------------------------------------------------- /quil/stdgates.quil: -------------------------------------------------------------------------------- 1 | ### Quil standard gate defintions. 2 | 3 | ## Pauli Gates 4 | 5 | DEFGATE I: 6 | 1, 0 7 | 0, 1 8 | 9 | DEFGATE X: 10 | 0, 1 11 | 1, 0 12 | 13 | DEFGATE Y: 14 | 0, -i 15 | i, 0 16 | 17 | DEFGATE Z: 18 | 1, 0 19 | 0, -1 20 | 21 | 22 | ## Hadamard Gate 23 | 24 | DEFGATE H: 25 | 1/sqrt(2), 1/sqrt(2) 26 | 1/sqrt(2), -1/sqrt(2) 27 | 28 | 29 | ## Cartesian Rotation Gates 30 | 31 | DEFGATE RX(%theta): 32 | cos(%theta/2), -i*sin(%theta/2) 33 | -i*sin(%theta/2), cos(%theta/2) 34 | 35 | DEFGATE RY(%theta): 36 | cos(%theta/2), -sin(%theta/2) 37 | sin(%theta/2), cos(%theta/2) 38 | 39 | DEFGATE RZ(%theta): 40 | cis(-%theta/2), 0 41 | 0, cis(%theta/2) 42 | 43 | 44 | ## Controlled-NOT Variants 45 | 46 | DEFGATE CNOT: 47 | 1, 0, 0, 0 48 | 0, 1, 0, 0 49 | 0, 0, 0, 1 50 | 0, 0, 1, 0 51 | 52 | # Also known as the Toffoli gate. 53 | DEFGATE CCNOT: 54 | 1, 0, 0, 0, 0, 0, 0, 0 55 | 0, 1, 0, 0, 0, 0, 0, 0 56 | 0, 0, 1, 0, 0, 0, 0, 0 57 | 0, 0, 0, 1, 0, 0, 0, 0 58 | 0, 0, 0, 0, 1, 0, 0, 0 59 | 0, 0, 0, 0, 0, 1, 0, 0 60 | 0, 0, 0, 0, 0, 0, 0, 1 61 | 0, 0, 0, 0, 0, 0, 1, 0 62 | 63 | 64 | ## Phase Gates 65 | 66 | DEFGATE S: 67 | 1, 0 68 | 0, i 69 | 70 | DEFGATE T: 71 | 1, 0 72 | 0, cis(pi/4) 73 | 74 | DEFGATE PHASE(%alpha): 75 | 1, 0 76 | 0, cis(%alpha) 77 | 78 | DEFGATE CPHASE00(%alpha): 79 | cis(%alpha), 0, 0, 0 80 | 0, 1, 0, 0 81 | 0, 0, 1, 0 82 | 0, 0, 0, 1 83 | 84 | DEFGATE CPHASE01(%alpha): 85 | 1, 0, 0, 0 86 | 0, cis(%alpha), 0, 0 87 | 0, 0, 1, 0 88 | 0, 0, 0, 1 89 | 90 | DEFGATE CPHASE10(%alpha): 91 | 1, 0, 0, 0 92 | 0, 1, 0, 0 93 | 0, 0, cis(%alpha), 0 94 | 0, 0, 0, 1 95 | 96 | DEFGATE CPHASE(%alpha): 97 | 1, 0, 0, 0 98 | 0, 1, 0, 0 99 | 0, 0, 1, 0 100 | 0, 0, 0, cis(%alpha) 101 | 102 | DEFGATE CZ: 103 | 1, 0, 0, 0 104 | 0, 1, 0, 0 105 | 0, 0, 1, 0 106 | 0, 0, 0, -1 107 | 108 | ## Swap Gates 109 | 110 | DEFGATE SWAP: 111 | 1, 0, 0, 0 112 | 0, 0, 1, 0 113 | 0, 1, 0, 0 114 | 0, 0, 0, 1 115 | 116 | # Also known as the Fredkin gate. 117 | DEFGATE CSWAP: 118 | 1, 0, 0, 0, 0, 0, 0, 0 119 | 0, 1, 0, 0, 0, 0, 0, 0 120 | 0, 0, 1, 0, 0, 0, 0, 0 121 | 0, 0, 0, 1, 0, 0, 0, 0 122 | 0, 0, 0, 0, 1, 0, 0, 0 123 | 0, 0, 0, 0, 0, 0, 1, 0 124 | 0, 0, 0, 0, 0, 1, 0, 0 125 | 0, 0, 0, 0, 0, 0, 0, 1 126 | 127 | DEFGATE ISWAP: 128 | 1, 0, 0, 0 129 | 0, 0, i, 0 130 | 0, i, 0, 0 131 | 0, 0, 0, 1 132 | 133 | DEFGATE PSWAP(%theta): 134 | 1, 0, 0, 0 135 | 0, 0, cis(%theta), 0 136 | 0, cis(%theta), 0, 0 137 | 0, 0, 0, 1 138 | -------------------------------------------------------------------------------- /quil/vqe.quil: -------------------------------------------------------------------------------- 1 | # Some gates useful for QVE. 2 | 3 | DEFGATE Yb: 4 | 1/sqrt(2), -i/sqrt(2) 5 | -i/sqrt(2), 1/sqrt(2) 6 | 7 | DEFGATE Ybd: 8 | 1/sqrt(2), i/sqrt(2) 9 | i/sqrt(2), 1/sqrt(2) 10 | -------------------------------------------------------------------------------- /qvm-app-tests.asd: -------------------------------------------------------------------------------- 1 | ;;;; qvm-app-tests.asd 2 | ;;;; 3 | ;;;; Author: Nik T 4 | 5 | (asdf:defsystem #:qvm-app-tests 6 | :description "Test Suite for Application server for the QVM." 7 | :author "Nikolas Tezak " 8 | :license "GNU Affero General Public License v3.0 (See app/LICENSE.txt)" 9 | :version (:read-file-form "VERSION.txt") 10 | :depends-on ( 11 | #:qvm-app 12 | #:uiop 13 | #:fiasco 14 | ) 15 | :perform (asdf:test-op (o s) 16 | (uiop:symbol-call ':qvm-app-tests 17 | '#:run-qvm-app-tests)) 18 | :pathname "app/tests/" 19 | :serial t 20 | :components ((:file "package") 21 | (:file "utils") 22 | (:file "suite"))) 23 | -------------------------------------------------------------------------------- /qvm-app.asd: -------------------------------------------------------------------------------- 1 | ;;;; qvm-app.asd 2 | ;;;; 3 | ;;;; Author: Robert Smith 4 | 5 | (asdf:defsystem #:qvm-app 6 | :description "Application server for the QVM." 7 | :author "Robert Smith " 8 | :license "GNU Affero General Public License v3.0 (See app/LICENSE.txt)" 9 | :version (:read-file-form "VERSION.txt") 10 | :depends-on ( 11 | ;; Quil parsing 12 | (:version #:cl-quil/frontend "1.26.0") 13 | ;; Command line argument parsing 14 | #:command-line-arguments 15 | ;; ASDF-companion utility library 16 | #:uiop 17 | ;; JSON parsing 18 | #:yason 19 | ;; The QVM, of course. 20 | #:qvm 21 | #:qvm-benchmarks 22 | ;; Float encoding 23 | #:ieee-floats 24 | ;; HTTP web server 25 | #:hunchentoot 26 | ;; Utilities 27 | #:alexandria 28 | ;; CL-FAD 29 | #:cl-fad 30 | ;; Remote Lisp connection 31 | #:swank 32 | ;; Portable threading 33 | #:bordeaux-threads 34 | ;; Portable gc 35 | #:trivial-garbage 36 | ;; Portable globals 37 | #:global-vars 38 | ;; Logging 39 | #:cl-syslog 40 | ;; HTTP requests for version info 41 | #:drakma 42 | ;; Portable *features* 43 | #:trivial-features 44 | ;; Regular expressions 45 | #:cl-ppcre) 46 | :in-order-to ((asdf:test-op (asdf:test-op #:qvm-app-tests))) 47 | :pathname "app/src/" 48 | :serial t 49 | :entry-point "qvm-app::asdf-entry-point" 50 | :components ((:file "package") 51 | (:file "globals") 52 | (:file "utilities") 53 | (:file "qvm-app-version") 54 | (:file "shm-info-server") 55 | (:file "impl/sbcl" :if-feature :sbcl) 56 | (:file "impl/clozure" :if-feature :clozure) 57 | (:file "configure-qvm") 58 | (:module "api" 59 | :serial t 60 | :components ((:file "common") 61 | (:file "ping") 62 | (:file "version") 63 | (:file "info") 64 | (:file "multishot") 65 | (:file "multishot-measure") 66 | (:file "expectation") 67 | (:file "wavefunction") 68 | (:file "probabilities") 69 | (:file "run-for-effect"))) 70 | (:file "benchmark-programs") 71 | (:file "server-abstraction") 72 | (:file "handle-request") 73 | (:file "debugger") 74 | (:file "entry-point"))) 75 | -------------------------------------------------------------------------------- /qvm-benchmarks.asd: -------------------------------------------------------------------------------- 1 | ;;;; qvm-benchmarks.asd 2 | ;;;; 3 | ;;;; Author: Robert Smith 4 | 5 | (asdf:defsystem #:qvm-benchmarks 6 | :description "Performance tests for the QVM." 7 | :author "Robert Smith " 8 | :license "Apache License 2.0 (See LICENSE.txt)" 9 | :depends-on (#:cl-quil 10 | #:qvm 11 | #:trivial-benchmark 12 | #:yason) 13 | :perform (asdf:test-op (o s) 14 | (uiop:symbol-call :qvm-benchmarks 15 | '#:run-benchmarks)) 16 | :pathname "bench/" 17 | :serial t 18 | :components ((:file "package") 19 | (:file "suite") 20 | (:file "quil-files"))) 21 | -------------------------------------------------------------------------------- /qvm-examples.asd: -------------------------------------------------------------------------------- 1 | ;;;; qvm-examples.asd 2 | ;;;; 3 | ;;;; Author: Robert Smith 4 | 5 | (asdf:defsystem #:qvm-examples 6 | :description "Examples using the QVM." 7 | :author "Robert Smith , Juan M. Bello-Rivas " 8 | :license "Apache License 2.0 (See LICENSE.txt)" 9 | :depends-on ( 10 | (:version #:cl-quil "1.13.1") 11 | ;; Nelder-Mead 12 | #:cl-grnm 13 | ;; Quantum Virtual Machine 14 | #:qvm 15 | ;; Application server for the QVM 16 | #:qvm-app 17 | ) 18 | :pathname "examples/" 19 | :serial t 20 | :components ((:file "package") 21 | (:file "qft") 22 | (:file "vqe") 23 | (:file "qaoa"))) 24 | -------------------------------------------------------------------------------- /qvm-tests.asd: -------------------------------------------------------------------------------- 1 | ;;;; qvm-tests.asd 2 | ;;;; 3 | ;;;; Author: Robert Smith 4 | 5 | (asdf:defsystem #:qvm-tests 6 | :description "Regression tests for the QVM." 7 | :author "Robert Smith " 8 | :license "Apache License 2.0 (See LICENSE.txt)" 9 | :depends-on (#:cl-quil/frontend 10 | #:qvm 11 | #:qvm-examples 12 | #:alexandria 13 | #:fiasco 14 | #:trivial-garbage 15 | #:cffi) 16 | :perform (asdf:test-op (o s) 17 | (uiop:symbol-call :qvm-tests 18 | '#:run-qvm-tests)) 19 | :pathname "tests/" 20 | :serial t 21 | :components ((:file "package") 22 | (:file "suite") 23 | (:file "utilities") 24 | (:file "utilities-tests") 25 | (:file "linear-algebra-tests") 26 | (:file "classical-memory-tests") 27 | (:file "wavefunction-tests") 28 | (:file "subsystem-tests") 29 | (:file "qvm-tests") 30 | (:file "measurement-tests") 31 | (:file "gate-tests") 32 | (:file "instruction-tests") 33 | (:file "modifier-tests") 34 | (:file "noisy-qvm-tests") 35 | (:file "density-qvm-tests") 36 | (:file "stress-tests") 37 | (:file "path-simulate-tests") 38 | (:file "stabilizer-qvm-tests") 39 | (:file "state-representation-tests") 40 | (:file "noise-model-tests") 41 | (:file "channel-qvm-tests") 42 | (:file "basic-noise-qvm-tests") 43 | (:file "unitary-tests") 44 | (:file "parallel-tests") 45 | (:file "qvm-avx-intrinsics" :if-feature (:and :qvm-intrinsics :avx2)) 46 | (:file "error-qvm-tests"))) 47 | -------------------------------------------------------------------------------- /qvm.asd: -------------------------------------------------------------------------------- 1 | ;;;; qvm.asd 2 | ;;;; 3 | ;;;; Author: Robert Smith 4 | 5 | #+(and sbcl x86-64) 6 | #.(when (ignore-errors (sb-alien:extern-alien "avx2_supported" sb-alien:int)) 7 | (cl:push :qvm-avx2 cl:*features*) 8 | (values)) 9 | 10 | (asdf:defsystem #:qvm 11 | :description "An implementation of the Quantum Abstract Machine." 12 | :author "Robert Smith " 13 | :license "Apache License 2.0 (See LICENSE.txt)" 14 | :version (:read-file-form "VERSION.txt") 15 | :defsystem-depends-on (#:cffi-grovel) 16 | :depends-on ( 17 | ;; General utilities 18 | #:alexandria 19 | ;; Abstract classes 20 | #:clos-encounters 21 | ;; IEEE-754 float parsing 22 | #:ieee-floats 23 | ;; Parallelization utilities 24 | #:lparallel 25 | ;; Matrix algebra 26 | (:version #:magicl/core "0.9.0") 27 | #:magicl/ext-lapack 28 | ;; weak hash tables 29 | #:trivial-garbage 30 | ;; static globals 31 | #:global-vars 32 | ;; C foreign function interface 33 | #:cffi 34 | ;; Allocation of C vectors 35 | (:version #:static-vectors "1.8.3") 36 | ;; Finalizers and portable GC calls 37 | #:trivial-garbage 38 | ;; Quil parsing and analysis 39 | (:version #:cl-quil/frontend "1.26.0") 40 | ;; Portable random number generator 41 | #:mt19937 42 | ;; For allocation info. 43 | #+sbcl #:sb-introspect 44 | ;; Portable *features* 45 | #:trivial-features) 46 | :in-order-to ((asdf:test-op (asdf:test-op #:qvm-tests))) 47 | :around-compile (lambda (compile) 48 | (let (#+sbcl (sb-ext:*derive-function-types* t)) 49 | (funcall compile))) 50 | :pathname "src/" 51 | :serial t 52 | :components ((:file "package") 53 | (:cffi-grovel-file "grovel-system-constants" :if-feature :unix) 54 | (:cffi-grovel-file "grovel-shared-memory" :if-feature :unix) 55 | (:file "config") 56 | (:file "impl/allegro" :if-feature :allegro) 57 | (:file "impl/clozure" :if-feature :clozure) 58 | (:file "impl/sbcl" :if-feature :sbcl) 59 | (:file "impl/sbcl-intrinsics" :if-feature (:and :sbcl :qvm-intrinsics)) 60 | (:file "impl/sbcl-avx-vops" 61 | :if-feature (:and :sbcl :qvm-intrinsics :qvm-avx2)) 62 | (:file "impl/sbcl-x86-vops" :if-feature (:and :sbcl :qvm-intrinsics)) 63 | (:file "impl/linear-algebra-intrinsics" :if-feature :qvm-intrinsics) 64 | (:file "impl/prefetch-intrinsics" :if-feature :qvm-intrinsics) 65 | (:file "impl/lispworks" :if-feature :lispworks) 66 | (:file "utilities") 67 | (:file "floats") 68 | (:file "allocator") 69 | (:file "shm" :if-feature :unix) 70 | (:file "linear-algebra") 71 | (:file "qam") 72 | (:file "classical-memory") 73 | (:file "classical-memory-mixin") 74 | (:file "serial-kernels") 75 | (:file "wavefunction") 76 | (:file "subsystem") 77 | (:file "state-representation") 78 | (:file "qvm") 79 | (:file "compile-gate") 80 | (:file "mixed-state-qvm") 81 | (:file "apply-gate") 82 | (:file "measurement") 83 | (:file "transition") 84 | (:file "transition-classical-instructions") 85 | (:file "stabilizer-qvm") 86 | (:file "execution") 87 | (:file "path-simulate") 88 | (:file "misc") 89 | (:file "noise-models") 90 | (:file "channel-qvm") 91 | (:file "basic-noise-qvm") 92 | (:file "density-qvm") 93 | (:file "noisy-qvm") 94 | (:file "depolarizing-noise") 95 | (:file "unitary-qvm") 96 | (:module "error" 97 | :serial t 98 | :components ((:file "package") 99 | (:file "fowler-noise") 100 | (:file "error-qvm"))))) 101 | -------------------------------------------------------------------------------- /scripts/prof.lisp: -------------------------------------------------------------------------------- 1 | (require :sb-sprof) 2 | 3 | (ql:quickload :qvm) 4 | 5 | (in-package #:qvm) 6 | 7 | (defun hadamard-program (n) 8 | (quil:parse-quil 9 | (with-output-to-string (s) 10 | (format s "DECLARE ro BIT[~d]~%" n) 11 | (dotimes (q n) 12 | (format s "H ~d~%" q)) 13 | (dotimes (q n) 14 | (format s "MEASURE ~d ro[~d]~%" q q))))) 15 | 16 | (defun testme () 17 | (prepare-for-parallelization 1) 18 | (setf qvm::*qubits-required-for-parallelization* 49) 19 | 20 | (setf qvm:*transition-verbose* t) 21 | (let ((q (make-qvm 25)) 22 | (p (hadamard-program 25))) 23 | (load-program q p :supersede-memory-subsystem t) 24 | (sb-sprof:with-profiling (:max-samples 10000 25 | :report :flat 26 | :threads :all 27 | :mode :time) 28 | (run q))) 29 | nil) 30 | 31 | ;;; MAIN 32 | -------------------------------------------------------------------------------- /scripts/shared_qvm.py: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env python 2 | 3 | ### shared_qvm.py 4 | ### 5 | ### Author: Robert Smith 6 | ### 7 | ### Copyright (c) 2017 Rigetti Computing 8 | 9 | ### This file shows a minimal example of how to use the --shared 10 | ### option with QVM from Python. 11 | from __future__ import print_function 12 | import posix_ipc as pos 13 | import mmap 14 | import ctypes 15 | import numpy as np 16 | 17 | import socket 18 | import json 19 | import sys 20 | 21 | 22 | from pyquil.api import QVMConnection 23 | from pyquil.quil import Program 24 | from pyquil.gates import X 25 | 26 | def query_length_offset(name): 27 | s = socket.socket(socket.AF_UNIX, socket.SOCK_STREAM) 28 | s.connect('/tmp/' + name) 29 | s.sendall("?") 30 | message, peer = s.recvfrom(4096) 31 | length, offset = message.split(',') 32 | return int(length), int(offset) 33 | 34 | def retrieve_wavefunction(name): 35 | length, offset = query_length_offset(name) 36 | shm = pos.SharedMemory(name) 37 | m = mmap.mmap(shm.fd, shm.size) 38 | # get the pointer to what appear to be an array of bytes 39 | ptr = ctypes.POINTER(ctypes.c_ubyte)(ctypes.c_void_p.from_buffer(m, offset)) 40 | # cast to array of complex double floats 41 | ptr = ctypes.cast(ptr, np.ctypeslib.ndpointer(shape=(length,), dtype=np.complex128)) 42 | return np.ctypeslib.as_array(ptr) 43 | 44 | # Example use of this interface. 45 | if __name__ == '__main__': 46 | if len(sys.argv) != 2: 47 | print('Syntax: shared_qvm.py ') 48 | sys.exit(1) 49 | name = sys.argv[1] 50 | cxn = QVMConnection(sync_endpoint='http://127.0.0.1:5000') 51 | wf = retrieve_wavefunction(name) 52 | 53 | print("Initial wavefunction:") 54 | print(wf) 55 | print("Initializing to W state.") 56 | wf[0b0000] = 0j 57 | wf[0b0001] = (1+0j)/np.sqrt(4) 58 | wf[0b0010] = (1+0j)/np.sqrt(4) 59 | wf[0b0100] = (1+0j)/np.sqrt(4) 60 | wf[0b1000] = (1+0j)/np.sqrt(4) 61 | print(wf) 62 | print("Evolving with X3X2X1X0 via QVM. Quil program is:") 63 | p = Program().inst([X(q) for q in range(4)]) 64 | print(p) 65 | cxn.run(p, [0]) 66 | print("Printing evolved state.") 67 | for b in range(len(wf)): 68 | if not np.isclose(wf[b], 0j): 69 | print("{0:04b} => {1}".format(b, wf[b])) 70 | -------------------------------------------------------------------------------- /src/allocator.lisp: -------------------------------------------------------------------------------- 1 | ;;;; allocator.lisp 2 | ;;;; 3 | ;;;; Author: Robert Smith 4 | 5 | (in-package #:qvm) 6 | 7 | ;;; This file manages the allocation of CFLONUM vectors in different 8 | ;;; spaces. 9 | ;;; 10 | ;;; There are two components to this file: allocation descriptions, 11 | ;;; and the allocation method. 12 | ;;; 13 | ;;; Allocation descriptions describe how much memory to allocate and 14 | ;;; where. It's all specialized on CFLONUM-VECTORs right now, since 15 | ;;; that's mostly all the QVM uses. These are implemented as classes, 16 | ;;; that at least have some sort of ALLOCATION-LENGTH method to 17 | ;;; indicate how many CFLONUMs should be allocated. 18 | ;;; 19 | ;;; The allocation generic function is ALLOCATE-VECTOR. This function 20 | ;;; is specialized on the aforementioned types. Critically, this 21 | ;;; function provides both the allocated data, as well as some 22 | ;;; finalizing function to free the memory. Since data might be 23 | ;;; allocated somewhere else besides the managed Lisp heap, it's up to 24 | ;;; you, the programmer, to call the freeing function. (Save us the 25 | ;;; trouble and don't cheat! Even with LISP-ALLOCATION vectors! If you 26 | ;;; decide to change your mind later you'll regret it! If you don't 27 | ;;; want to use the allocation interface, use 28 | ;;; MAKE-LISP-CFLONUM-VECTOR.) 29 | ;;; 30 | ;;; Note that not all ALLOCATE-VECTOR specializations live in 31 | ;;; this file. 32 | 33 | (deftype finalizer () 34 | "A finalizer thunk. Used for the effect of freeing some memory." 35 | '(function () nil)) 36 | 37 | (defun dummy-finalizer () 38 | "A \"finalizer\" that does nothing. Used for objects managed by the GC." 39 | nil) 40 | 41 | ;;; If we made this declaration on the DEFGENERIC, the type would get 42 | ;;; clobbered. We put this type here anyway, albeit commented out, so 43 | ;;; you know what the *real* type of this function should be. 44 | #+#:ignore 45 | (declaim (ftype (function (t) (values cflonum-vector finalizer)) 46 | allocate-vector)) 47 | (defgeneric allocate-vector (description) 48 | (:documentation "Allocate a fresh zero-initialized CFLONUM-VECTOR described by DESCRIPTION. Return two values: 49 | 50 | 1. The allocated vector (a CFLONUM-VECTOR). 51 | 52 | 2. A finalizer thunk of type FINALIZER, which should be called when the memory is OK to be freed. 53 | 54 | NOTE: Note that the finalizer may close over the allocated vector.")) 55 | 56 | ;;; If we made this declaration on the DEFGENERIC, the type would get 57 | ;;; clobbered. We put this type here anyway, albeit commented out, so 58 | ;;; you know what the *real* type of this function should be. 59 | #+#:ignore 60 | (declaim (ftype (function (t) alexandria:non-negative-fixnum) allocation-length)) 61 | (defgeneric allocation-length (description) 62 | (:documentation "The length of memory to be allocated, measured in the element type of the vector.")) 63 | 64 | 65 | ;;;;;;;;;;;;;;;;;;;;;;;; Lisp Heap Allocation ;;;;;;;;;;;;;;;;;;;;;;;; 66 | 67 | (defclass lisp-allocation () 68 | ((length :initarg :length :reader allocation-length)) 69 | (:documentation "A description of an allocation on the Lisp heap.")) 70 | 71 | (declaim (inline make-lisp-cflonum-vector)) 72 | (defun make-lisp-cflonum-vector (length) 73 | (make-array length 74 | :element-type 'cflonum 75 | :initial-element (cflonum 0))) 76 | 77 | (defmethod allocate-vector ((descr lisp-allocation)) 78 | (values (make-lisp-cflonum-vector (allocation-length descr)) 79 | #'dummy-finalizer)) 80 | 81 | 82 | ;;;;;;;;;;;;;;;;;;;;; Foreign Memory Allocation ;;;;;;;;;;;;;;;;;;;;;; 83 | 84 | (defclass c-allocation () 85 | ((length :initarg :length :reader allocation-length)) 86 | (:documentation "A description of an allocation in foreign memory.")) 87 | 88 | (defmethod allocate-vector ((descr c-allocation)) 89 | (let ((vec (static-vectors:make-static-vector (allocation-length descr) 90 | :element-type 'cflonum 91 | :initial-element (cflonum 0)))) 92 | (values vec 93 | (lambda () 94 | (static-vectors:free-static-vector vec) 95 | nil)))) 96 | 97 | 98 | ;;;;;;;;;;;;;;;;;;; POSIX Shared Memory Allocation ;;;;;;;;;;;;;;;;;;; 99 | 100 | (defclass posix-shared-memory-allocation () 101 | ((length :initarg :length :reader allocation-length) 102 | (name :initarg :name :reader allocation-name)) 103 | (:documentation "A description of an allocation in POSIX shared memory.")) 104 | 105 | ;;; ALLOCATE-VECTOR for this class is defined in "shm.lisp", which is 106 | ;;; conditional on being a UNIX OS. 107 | -------------------------------------------------------------------------------- /src/config.lisp: -------------------------------------------------------------------------------- 1 | ;;;; src/config.lisp 2 | ;;;; 3 | ;;;; Author: Robert Smith 4 | 5 | (in-package #:qvm) 6 | 7 | ;;; Configuration for QVM compile-time and run-time behavior. 8 | 9 | (deftype parallelization-limit () 10 | "A limit on the number of qubits that can be parallelized across." 11 | `(integer 0 50)) 12 | 13 | (declaim (type parallelization-limit *qubits-required-for-parallelization*)) 14 | (defvar *qubits-required-for-parallelization* 19 15 | "The number of qubits required of a quantum state before it gets operated on in parallel. 16 | 17 | See also *QUBIT-LIMIT-FOR-USING-SERIAL-KERNELS*.") 18 | 19 | (declaim (type parallelization-limit *qubit-limit-for-using-serial-kernels*)) 20 | (defvar *qubit-limit-for-using-serial-kernels* 29 21 | "The maximum number of qubits allowed in order to use a specified serial kernel.") 22 | 23 | (defun qubit-limit-for-using-serial-kernels () 24 | "The maximum number of qubits allowed in order to use a specified serial kernel. The value of this function also takes into account *QUBITS-REQUIRED-FOR-PARALLELIZATION*." 25 | (max *qubit-limit-for-using-serial-kernels* 26 | *qubits-required-for-parallelization*)) 27 | 28 | (defvar *compile-time-operator-cache-limit* 8 29 | "At compile time, a cache of optimized \"matrix application\" operators are computed. Further ones will be cached at runtime. This configuration parameter controls how many qubits this cache is warmed for. 30 | 31 | This parameter should be optimized for developer convenience.") 32 | 33 | (defvar *executable-time-operator-cache-limit* 30 34 | "Like *COMPILE-TIME-OPERATOR-CACHE-LIMIT*, but the amount of cache to warm before an executable is created. (There is no guarantee executable creation software will respect this suggested parameter.) 35 | 36 | This parameter should be optimized for end-user convenience.") 37 | 38 | (defvar *transition-verbose* nil 39 | "Controls whether each transition is printed with a timing.") 40 | 41 | (defvar *compile-before-running* nil 42 | "Compile programs loaded into the QVM before running them.") 43 | 44 | (defvar *fuse-gates-during-compilation* nil 45 | "Should gates be fused during compilation?") 46 | 47 | (defvar *inline-static-gates-during-compilation* nil 48 | "Inline the actual gate matrices into the compiled instructions.") 49 | 50 | (defvar *compile-measure-chains* nil 51 | "Compile chains of measures into an efficient sampling.") 52 | 53 | (defun enable-all-qvm-optimizations () 54 | (setf *compile-before-running* t 55 | *fuse-gates-during-compilation* t 56 | *inline-static-gates-during-compilation* t 57 | *compile-measure-chains* t) 58 | nil) 59 | 60 | (defvar *optimize-dangerously-fast* 61 | '(optimize speed (safety 0) (debug 0) (space 0) (compilation-speed 0)) 62 | "Optimization qualities for when the code should go as fast as possible.") 63 | 64 | (defvar *optimize-briskly* 65 | '(optimize speed (safety 1) (debug 1) (space 0)) 66 | "Optimization qualities for when the code should go fast, but have safety.") 67 | 68 | (defvar *optimize-safely* 69 | '(optimize (speed 0) (safety 3) (debug 3) (space 3)) 70 | "Optimization qualities for when the code should emphasize safety and debugability.") 71 | 72 | ;;; 73 | ;;; ""64K ought to be enough for anybody." -Bill Gates" -Michael Scott 74 | ;;; 75 | (global-vars:define-global-parameter **classical-memory-size-limit** (* 64 1024) 76 | "The limit of the number of octets that can be allocated for classical memory. Default is 64KiB.") 77 | -------------------------------------------------------------------------------- /src/error/README.md: -------------------------------------------------------------------------------- 1 | # `qvm.error` 2 | 3 | This subpackage implements two classes: 4 | 5 | 1. `fowler-qvm`: An abstract class which decomposes depolarizing noise into five 6 | subchannels which are applied following (1) single-qubit identity gates, 7 | (2) non-identity single-qubit gates, (3) two-qubit gates, (4) reset 8 | operators, and (5) measurement operators. These can be selective enabled, 9 | permitting one to study the relative effects of these noise sources on 10 | measurement circuits commonly found in parity check measurement circuits, as 11 | proposed in Section VII.B of [Fowler et al](https://arxiv.org/abs/1208.0928). 12 | This class is extended by two subclasses, `fowler-pure-state-qvm` and 13 | `fowler-stabilizer-qvm`, which back this noise model by a `pure-state-qvm` 14 | and a `stabilizer-qvm` respectively. 15 | 2. `error-qvm`: A separate subclass of `fowler-qvm` backed by "Pauli 16 | propagation". Rather than tracking anything like the full state of a quantum 17 | circuit, a Pauli propagation model rather assumes that the circuit being 18 | executed is meant to measure stabilizer checks (so, in particular, would 19 | return a constant value of "no error" in the absence of noise), injects Pauli 20 | flip noise according to some noise model, and tracks how the flips propagate 21 | through the circuit to effect an eventual measurement. This limitation is 22 | severe, but it means that the measurement results can be computed in space 23 | and time which are _linear_ in the qubit count, a marked improvement over 24 | even the stabilizer-/tableau-based QVM. 25 | -------------------------------------------------------------------------------- /src/error/package.lisp: -------------------------------------------------------------------------------- 1 | ;;;; error/package.lisp 2 | ;;;; 3 | ;;;; This subpackage houses some QVM variants useful for tracing errors through 4 | ;;;; circuits which are expected to measure out 0s in the absence of noise. 5 | 6 | (defpackage #:qvm.error 7 | (:use #:cl 8 | #:clos-encounters 9 | #:qvm) 10 | (:import-from #:qvm #:multiprobabilistically) 11 | (:local-nicknames (#:quil #:cl-quil.frontend)) 12 | 13 | (:export 14 | #:fowler-pure-state-qvm ; CLASS 15 | #:fowler-stabilizer-qvm ; CLASS 16 | #:error-qvm ; CLASS 17 | #:make-error-qvm ; CONSTRUCTOR 18 | #:copy-fowler-qvm ; COPY-CONSTRUCTOR 19 | )) 20 | -------------------------------------------------------------------------------- /src/execution.lisp: -------------------------------------------------------------------------------- 1 | ;;;; execution.lisp 2 | ;;;; 3 | ;;;; Author: Robert Smith 4 | 5 | (in-package #:qvm) 6 | 7 | ;;; Execution of quantum programs on QVM instances. 8 | 9 | (defun nop-count (code) 10 | "Number of NOPs in a vector of instructions CODE." 11 | (count-if (lambda (x) (typep x 'quil:no-operation)) code)) 12 | 13 | (defmethod run :before ((qvm pure-state-qvm)) 14 | ;; Compile the program before running it. 15 | (when *compile-before-running* 16 | (when *transition-verbose* 17 | (format *trace-output* "~&; Compiling program loaded into QVM...~%")) 18 | (let ((start (get-internal-real-time)) 19 | (old-nop-count (nop-count (program qvm)))) 20 | (compile-loaded-program qvm) 21 | (when *transition-verbose* 22 | (format *trace-output* "~&; Compiled in ~D ms.~%" 23 | (round (* (/ 1000 internal-time-units-per-second) 24 | (- (get-internal-real-time) start)))) 25 | (let ((eliminated (- (nop-count (program qvm)) old-nop-count))) 26 | (format *trace-output* "~&; Optimization eliminated ~D instruction~:P (~5F%).~%" 27 | eliminated 28 | (float (* 100 (/ eliminated (max 1 (length (program qvm)))))))) 29 | (finish-output *trace-output*))))) 30 | 31 | (defmethod run ((qvm classical-memory-mixin)) 32 | ;; Actually start the execution. 33 | (setf (pc qvm) 0) 34 | (loop :until (or (null (pc qvm)) (>= (pc qvm) (loaded-program-length qvm))) :do 35 | (setf qvm 36 | (transition qvm (current-instruction qvm))) 37 | :finally (return qvm))) 38 | 39 | (defmethod run :after ((qvm base-qvm)) 40 | ;; Swap STATE-ELEMENTS pointers if necessary after a 41 | ;; computation. This is only relevant for a QVM with a PURE-STATE 42 | ;; state. 43 | (when (requires-swapping-amps-p (state qvm)) 44 | (swap-internal-amplitude-pointers (state qvm)))) 45 | 46 | (defun run-program (num-qubits program) 47 | "Run the program PROGRAM on a QVM of NUM-QUBITS qubits." 48 | (check-type num-qubits unsigned-byte) 49 | (check-type program quil:parsed-program) 50 | (assert (>= num-qubits (quil:qubits-needed program)) 51 | (num-qubits) 52 | "The program being run requires more qubits than the ~D specified." 53 | num-qubits) 54 | (let ((qvm (make-qvm num-qubits 55 | :classical-memory-model 56 | (memory-descriptors-to-qvm-memory-model 57 | (quil:parsed-program-memory-definitions program))))) 58 | (load-program qvm program) 59 | (run qvm))) 60 | -------------------------------------------------------------------------------- /src/floats.lisp: -------------------------------------------------------------------------------- 1 | ;;;; floats.lisp 2 | ;;;; 3 | ;;;; Author: Robert Smith 4 | 5 | (in-package #:qvm) 6 | 7 | ;;; This file deals with the different floating point representations 8 | ;;; made use of in the QVM. 9 | ;;; 10 | ;;; These are agreed upon *everywhere* in the QVM. These are allowed 11 | ;;; to change, but only here. 12 | 13 | (defconstant +octets-per-flonum+ 8) 14 | 15 | (deftype flonum (&optional min) 16 | "The float type used in computations." 17 | (cond 18 | ((numberp min) `(double-float ,(coerce min 'double-float))) 19 | ((eq '* min) `double-float) 20 | (t (error "Malformed type: (FLONUM ~S)" min)))) 21 | 22 | (defconstant +octets-per-cflonum+ (* 2 +octets-per-flonum+)) 23 | 24 | (deftype cflonum () 25 | "The complex float type used in computations. Typically these will represent wavefunction amplitudes." 26 | `(complex flonum)) 27 | 28 | (declaim (inline flonum)) 29 | (defun flonum (x) 30 | "Coerce X into a FLONUM." 31 | (coerce x 'flonum)) 32 | 33 | (define-compiler-macro flonum (&whole whole &environment env x) 34 | (if (and (constantp x env) 35 | (numberp x)) 36 | (coerce x 'flonum) 37 | whole)) 38 | 39 | (deftype flonum-vector (&optional length) 40 | `(simple-array flonum (,length))) 41 | 42 | (declaim (inline cflonum)) 43 | (defun cflonum (x) 44 | "Coerce X into a CFLONUM." 45 | (coerce x 'cflonum)) 46 | 47 | (define-compiler-macro cflonum (&whole whole &environment env x) 48 | (if (and (constantp x env) 49 | (numberp x)) 50 | (coerce x 'cflonum) 51 | whole)) 52 | 53 | (deftype cflonum-vector (&optional length) 54 | `(simple-array cflonum (,length))) 55 | -------------------------------------------------------------------------------- /src/grovel-shared-memory.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:qvm) 2 | 3 | #+unix 4 | (progn 5 | ;; Includes - POSIX 6 | (include "sys/mman.h") 7 | (include "sys/stat.h") 8 | (include "stddef.h") 9 | (include "fcntl.h") 10 | 11 | ;; Types 12 | (ctype size_t "size_t") 13 | (ctype mode_t "mode_t") 14 | (ctype off_t "off_t") 15 | 16 | ;; Constants/Enums 17 | (constant ($map-failed "MAP_FAILED") :optional nil) 18 | (constant ($map-shared "MAP_SHARED") :optional nil) 19 | 20 | (constant ($prot-read "PROT_READ") :optional nil) 21 | (constant ($prot-write "PROT_WRITE") :optional nil) 22 | 23 | (constant ($o-creat "O_CREAT") :optional nil) 24 | (constant ($o-excl "O_EXCL") :optional nil) 25 | (constant ($o-rdwr "O_RDWR") :optional nil) 26 | 27 | ;; Variables 28 | (cvar ("errno" %errno) :int)) 29 | -------------------------------------------------------------------------------- /src/grovel-system-constants.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:qvm) 2 | 3 | #+unix 4 | (progn 5 | (include "unistd.h") 6 | (constant ($sc-nprocessors-onln "_SC_NPROCESSORS_ONLN") :optional nil) 7 | (constant ($sc-page-size "_SC_PAGE_SIZE") :optional nil) 8 | ) 9 | -------------------------------------------------------------------------------- /src/impl/allegro.lisp: -------------------------------------------------------------------------------- 1 | ;;;; allegro.lisp 2 | 3 | (in-package #:qvm) 4 | 5 | (defvar *cleanup-thunks* nil) 6 | 7 | (defun %perform-cleanup () 8 | (dolist (thunk *cleanup-thunks*) 9 | (ignore-errors (funcall thunk)))) 10 | 11 | (defun call-at-exit (fun) 12 | (let ((cleanup-form '(%perform-cleanup))) 13 | (unless (member cleanup-form sys:*exit-cleanup-forms* :test #'equalp) 14 | (push cleanup-form sys:*exit-cleanup-forms*)) 15 | (pushnew fun *cleanup-thunks*) 16 | (values))) 17 | -------------------------------------------------------------------------------- /src/impl/clozure.lisp: -------------------------------------------------------------------------------- 1 | ;;;; clozure.lisp 2 | 3 | (in-package #:qvm) 4 | 5 | (defconstant +ivector-prefix-size+ 25 6 | "Taken from ccl::%make-heap-ivector") 7 | 8 | (defun shm-vector-header-size () 9 | #+32-bit-target (error "32-bit target not supported") 10 | ;; This is the point at which vector data appears for complex 11 | ;; double-floats - a combination of the +ivector-prefix-size+ and a 12 | ;; pad word that applies only to that element-type. 13 | 32) 14 | 15 | (defun shm-vector-allocation-size (num-elements element-type) 16 | "Return the size, in octets, needed to store a simple-array of 17 | NUM-ELEMENTS ELEMENT-TYPE objects." 18 | (let* ((subtag (ccl::element-type-subtype element-type)) 19 | (data-size (ccl::subtag-bytes subtag num-elements))) 20 | (+ +ivector-prefix-size+ data-size))) 21 | 22 | (defun free-shm-vector (v) 23 | (when (ccl::%heap-ivector-p v) 24 | (ccl:with-lock-grabbed (ccl::*heap-ivector-lock*) 25 | (setq ccl::*heap-ivectors* (ccl::delq v ccl::*heap-ivectors*))))) 26 | 27 | (defun shm-vector-cleanup-thunk (v) 28 | (lambda () 29 | (free-shm-vector v))) 30 | 31 | (defun shm-vector-from-pointer (pointer num-elements element-type) 32 | (let ((subtype (ccl::element-type-subtype element-type))) 33 | (ccl:with-macptrs ((ptr pointer)) 34 | (let ((vect (ccl::fudge-heap-pointer ptr subtype num-elements)) 35 | (p (ccl:%null-ptr))) 36 | (ccl::%vect-data-to-macptr vect p) 37 | (ccl::with-lock-grabbed (ccl::*heap-ivector-lock*) 38 | (push vect ccl::*heap-ivectors*)) 39 | (values vect 40 | (shm-vector-cleanup-thunk vect)))))) 41 | 42 | 43 | (defun call-at-exit (fun) 44 | (push fun ccl:*lisp-cleanup-functions*)) 45 | -------------------------------------------------------------------------------- /src/impl/lispworks.lisp: -------------------------------------------------------------------------------- 1 | ;;;; lispworks.lisp 2 | 3 | (in-package #:qvm) 4 | 5 | (defun call-at-exit (fun) 6 | (lw:define-action "When quitting image" "Deallocate shared memories" 7 | fun)) 8 | -------------------------------------------------------------------------------- /src/impl/prefetch-intrinsics.lisp: -------------------------------------------------------------------------------- 1 | ;;;; sbcl-prefetch-intrinsics.lisp 2 | ;;;; 3 | ;;;; Author: Cole Scott 4 | 5 | (in-package #:qvm-intrinsics) 6 | 7 | (defmacro define-prefetch (name num) 8 | (check-type name symbol) 9 | (check-type num unsigned-byte) 10 | `(progn (declaim (inline ,name)) 11 | (defun ,name (base index) 12 | (declare (type sb-sys:system-area-pointer base) 13 | (type fixnum index)) 14 | (%prefetch :t0 base 0 ,num index)) 15 | (declaim (notinline ,name)))) 16 | 17 | (define-prefetch prefetch2 2) 18 | (define-prefetch prefetch4 4) 19 | (define-prefetch prefetch8 8) 20 | (define-prefetch prefetch16 16) 21 | -------------------------------------------------------------------------------- /src/impl/sbcl-intrinsics.lisp: -------------------------------------------------------------------------------- 1 | ;;;; sbcl-intrinsics.lisp 2 | ;;;; 3 | ;;;; Author: Cole Scott 4 | 5 | (defpackage #:qvm-intrinsics 6 | (:use #:cl #:sb-ext #:sb-c)) 7 | -------------------------------------------------------------------------------- /src/impl/sbcl-x86-vops.lisp: -------------------------------------------------------------------------------- 1 | ;;;; sbcl-x86-vops.lisp 2 | ;;;; 3 | ;;;; Author: Cole Scott 4 | ;;;; 5 | ;;;; Collaborators: Robert Smith 6 | 7 | (in-package #:qvm-intrinsics) 8 | 9 | ;;; Function stub definitions 10 | ;;; This tells the compiler about the existance and properties of the VOPs as functions 11 | 12 | (defknown %prefetch ((member :nta :t0 :t1 :t2) 13 | sb-sys:system-area-pointer 14 | sb-vm:signed-word 15 | (member 2 4 8 16) 16 | fixnum) 17 | (values &optional) 18 | (any always-translatable) 19 | :overwrite-fndb-silently t) 20 | 21 | ;;; VOP definitions 22 | 23 | (in-package #:sb-vm) 24 | 25 | (define-vop (qvm-intrinsics::%prefetch) 26 | (:translate qvm-intrinsics::%prefetch) 27 | (:policy :fast-safe) 28 | (:args (base :scs (sap-reg)) 29 | (index :scs (any-reg))) 30 | (:arg-types (:constant (member :nta :t0 :t1 :t2)) 31 | system-area-pointer 32 | (:constant signed-word) 33 | (:constant (member . #.(loop :for i :below 4 34 | :collect (ash 1 (+ i n-fixnum-tag-bits))))) 35 | fixnum) 36 | (:results) 37 | (:info type disp stride) 38 | (:generator 1 39 | (inst prefetch type (ea disp base index (ash stride (- n-fixnum-tag-bits)))))) 40 | 41 | -------------------------------------------------------------------------------- /src/impl/sbcl.lisp: -------------------------------------------------------------------------------- 1 | ;;;; sbcl.lisp 2 | 3 | (in-package #:qvm) 4 | 5 | (defun call-at-exit (fun) 6 | "Ensure that FUN is called when the Lisp implementation stops." 7 | (pushnew fun sb-ext:*exit-hooks* :test 'eq)) 8 | 9 | (defun shm-vector-header-size () 10 | (* sb-vm:vector-data-offset sb-vm:n-word-bytes)) 11 | 12 | ;; +array-header-size+ and %allocation-size were originally in 13 | ;; static-vectors but commit c85d2826955c0a8b7ffce87b270687cb8d3ed254 14 | ;; removed them. Depending on not-exported functions is bad for this 15 | ;; reason. 16 | (defconstant +array-header-size+ 17 | (* sb-vm:vector-data-offset sb-vm:n-word-bytes)) 18 | 19 | (defun %allocation-size (length widetag n-bits) 20 | (flet ((string-widetag-p (widetag) 21 | (or (= widetag sb-vm:simple-base-string-widetag) 22 | #+sb-unicode 23 | (= widetag sb-vm:simple-character-string-widetag)))) 24 | (+ (* 2 sb-vm:n-word-bytes 25 | (ceiling 26 | (* (if (string-widetag-p widetag) 27 | (1+ length) ; for the final #\Null 28 | length) 29 | n-bits) 30 | (* 2 sb-vm:n-word-bits))) 31 | (shm-vector-header-size)))) 32 | 33 | (defun shm-vector-allocation-size (num-elements element-type) 34 | "Return the size, in octets, needed to store a simple-array of 35 | NUM-ELEMENTS ELEMENT-TYPE objects." 36 | (multiple-value-bind (widetag n-bits) 37 | (static-vectors::vector-widetag-and-n-bits element-type) 38 | (%allocation-size num-elements widetag n-bits))) 39 | 40 | (defun shm-vector-from-pointer (pointer num-elements element-type) 41 | "Return two values: a specialized vector of NUM-ELEMENTS for 42 | ELEMENT-TYPE created at POINTER, and a finalizer that is called to 43 | clean up that vector." 44 | (multiple-value-bind (widetag n-bits) 45 | (static-vectors::vector-widetag-and-n-bits element-type) 46 | (declare (ignore n-bits)) 47 | (setf (sb-sys:sap-ref-word pointer 0) widetag 48 | (sb-sys:sap-ref-word pointer sb-vm:n-word-bytes) (sb-vm:fixnumize num-elements)) 49 | (values 50 | (sb-kernel:%make-lisp-obj (logior (cffi:pointer-address pointer) 51 | sb-vm:other-pointer-lowtag)) 52 | ;; No finalizer is needed for the vector itself in SBCL.) 53 | (lambda () nil)))) 54 | -------------------------------------------------------------------------------- /src/misc.lisp: -------------------------------------------------------------------------------- 1 | ;;;; misc.lisp 2 | ;;;; 3 | ;;;; Author: Robert Smith 4 | 5 | (in-package #:qvm) 6 | 7 | ;;; Miscellaneous routines that don't have a home. 8 | 9 | (defun program-matrix (pp) 10 | "Compute the matrix of the parsed program PP by way of simulating it on every basis element." 11 | (let* ((n (quil:qubits-needed pp)) 12 | (dim (expt 2 n)) 13 | (m (magicl:zeros (list dim dim)))) 14 | (dotimes (basis-state dim m) 15 | (let ((q (make-qvm n))) 16 | (rotatef (aref (amplitudes q) 0) 17 | (aref (amplitudes q) basis-state)) 18 | (load-program q pp) 19 | (run q) 20 | ;; write out the amplitudes 21 | (dotimes (row dim) 22 | (setf (magicl:tref m row basis-state) 23 | (aref (amplitudes q) row))))))) 24 | -------------------------------------------------------------------------------- /src/mixed-state-qvm.lisp: -------------------------------------------------------------------------------- 1 | ;;;; src/mixed-state-qvm.lisp 2 | ;;;; 3 | ;;;; Authors: Robert Smith 4 | ;;;; Erik Davis 5 | ;;;; Sophia Ponte 6 | 7 | (in-package #:qvm) 8 | 9 | ;;; This file implements a qvm that evolves pure and mixed states by 10 | ;;; means of a DENSITY-MATRIX-STATE. 11 | 12 | ;;; General Overview 13 | 14 | ;;; The MIXED-STATE-QVM is an implementation of a QVM that can evolve 15 | ;;; either a pure or mixed state using a DENSITY-MATRIX-STATE. The 16 | ;;; MIXED-STATE-QVM inherits most of its core behavior from BASE-QVM, 17 | ;;; but provides more specialized functionality for methods like 18 | ;;; TRANSITION, MEASURE, and MEASURE-ALL. Since the MIXED-STATE-QVM 19 | ;;; uses a DENSITY-MATRIX-STATE, it converts quil gates to 20 | ;;; superoperators for gate application. Additional superoperators can 21 | ;;; be defined in the SUPEROPERATOR-DEFINITIONS slot of the 22 | ;;; MIXED-STATE-QVM. 23 | 24 | (defclass mixed-state-qvm (base-qvm) 25 | ((state :reader state 26 | :writer %set-state 27 | :initarg :state 28 | :type (or null density-matrix-state))) ; XXX: Should we nix 29 | ; the null option 30 | ; here? 31 | (:documentation "A qvm for simulating mixed-state quantum systems.")) 32 | 33 | (defmethod initialize-instance :after ((qvm mixed-state-qvm) &rest args) 34 | (declare (ignore args)) 35 | ;; PURE-STATE-QVM does its own allocation, which we don't want, so 36 | ;; here we make sure that the STATE slot has a vector of the 37 | ;; right size (e.g. it was constructed by MAKE-MIXED-STATE-QVM). 38 | (when (or (not (slot-boundp qvm 'state)) 39 | (null (slot-value qvm 'state))) 40 | (%set-state (make-instance 'density-matrix-state :num-qubits (number-of-qubits qvm)) 41 | qvm) 42 | (set-to-zero-state (state qvm)))) 43 | 44 | (defun make-mixed-state-qvm (num-qubits &key (allocation nil) &allow-other-keys) 45 | "Build a MIXED-STATE-QVM with a DENSITY-MATRIX-STATE representing NUM-QUBITS qubits." 46 | (check-type num-qubits unsigned-byte) 47 | (make-instance 'mixed-state-qvm :number-of-qubits num-qubits 48 | :state (make-density-matrix-state 49 | num-qubits 50 | :allocation allocation))) 51 | 52 | (defun full-density-number-of-qubits (vec-density) 53 | "Computes the number of qubits encoded by a vectorized density matrix." 54 | (1- (integer-length (isqrt (length vec-density))))) 55 | 56 | 57 | (defun mixed-state-qvm-measurement-probabilities (qvm) 58 | "Computes the probability distribution of measurement outcomes (a vector) 59 | associated with the STATE of the DENSITY-QVM." 60 | (density-matrix-state-measurement-probabilities (state qvm))) 61 | 62 | ;;; Don't compile things for the mixed-state-qvm. 63 | (defmethod compile-loaded-program ((qvm mixed-state-qvm)) 64 | qvm) 65 | 66 | ;;; TODO: FIXME: we should be able to compile density operator stuff 67 | ;;; just fine. 68 | (defmethod compile-instruction ((qvm mixed-state-qvm) isn) 69 | (declare (ignore qvm)) 70 | isn) 71 | -------------------------------------------------------------------------------- /src/path-simulate.lisp: -------------------------------------------------------------------------------- 1 | ;;;; path.lisp 2 | ;;;; 3 | ;;;; Author: Robert Smith 4 | 5 | (in-package #:qvm) 6 | 7 | ;;; In this file, we implement simulation of a straight-line Quil 8 | ;;; program without measurement. The technique used is (maybe 9 | ;;; informally) called the Multi-Amplitude Discrete Path Simulation 10 | ;;; (MADPI). 11 | ;;; 12 | ;;; Classical states are represented as objects of the Lisp type 13 | ;;; UNSIGNED-BYTE. 14 | 15 | (defun list-classical-states (classical-state qubits) 16 | "List all of the bitstring states in the order that QUBITS are specified, using CLASSICAL-STATE as the base state." 17 | (check-type classical-state unsigned-byte) 18 | (let ((states nil)) 19 | (map-reordered-amplitudes 20 | classical-state 21 | (lambda (combo index) 22 | (declare (ignore combo)) 23 | (push index states)) 24 | qubits) 25 | (nreverse states))) 26 | 27 | (defun map-classical-state (instruction classical-state) 28 | "Map the classical state CLASSICAL-STATE to its component amplitudes under the transformation dictated by the Quil instruction INSTRUCTION, which should be a gate application. 29 | 30 | Return two values: 31 | 32 | 1. A list of the classical states that this state maps to. 33 | 34 | 2. A list of complex amplitude factors associated with those states." 35 | (check-type instruction quil:gate-application) 36 | (let* ((m (apply #'quil:gate-matrix 37 | (pull-teeth-to-get-a-gate instruction) 38 | (mapcar #'quil:constant-value (quil:application-parameters instruction)))) 39 | (qubits (apply #'nat-tuple 40 | (mapcar #'quil:qubit-index 41 | (quil:application-arguments instruction)))) 42 | (column 0)) 43 | ;; Calculate the column. 44 | (do-nat-tuple (q (reverse qubits)) ; LSB -> MSB order 45 | (setf column (logior (ash column 1) 46 | (ldb (byte 1 q) classical-state)))) 47 | 48 | ;; Read off the entries. 49 | (loop :for row :below (expt 2 (nat-tuple-cardinality qubits)) 50 | :collect (magicl:tref m row column) :into amplitudes 51 | :finally (return (values (list-classical-states classical-state qubits) 52 | amplitudes))))) 53 | 54 | 55 | (defun path-simulate (parsed-prog initial-classical-state final-classical-states) 56 | "Simulate the parsed program PARSED-PROG starting with the initial classical state INITIAL-CLASSICAL-STATE and ending with the final classical states FINAL-CLASSICAL-STATES. FINAL-CLASSICAL-STATES should be a list of classical states. 57 | 58 | Return a list of amplitudes associated with the classical states. 59 | 60 | PARSED-PROG must be a program that only contains gate applications." 61 | (check-type parsed-prog quil:parsed-program) 62 | (check-type initial-classical-state unsigned-byte) 63 | (check-type final-classical-states sequence) 64 | (assert (every (lambda (isn) (typep isn 'quil:gate-application)) 65 | (quil:parsed-program-executable-code parsed-prog)) 66 | (parsed-prog) 67 | "Only gate applications are allowed for PATH-SIMULATE.") 68 | (let ((sums (make-array (length final-classical-states) 69 | :element-type 'cflonum 70 | :initial-element (cflonum 0)))) 71 | (declare (type (simple-array cflonum (*)) sums)) 72 | (labels ((accumulate-amplitude (classical-state amplitude) 73 | (declare (type cflonum amplitude)) 74 | (alexandria:when-let (p (position classical-state final-classical-states)) 75 | (incf (aref sums p) amplitude))) 76 | 77 | (descend (program amplitude classical-state) 78 | (declare (type cflonum amplitude)) 79 | (cond 80 | ;; Don't descend if we've reached a (multiplicative) 81 | ;; zero factor. 82 | ((zerop amplitude) 83 | nil) 84 | 85 | ;; At the end of the Quil program, accumulate the 86 | ;; amplitude. 87 | ((endp program) 88 | (accumulate-amplitude classical-state amplitude)) 89 | 90 | ;; "We need to go deeper." 91 | ;; 92 | ;; —Dom Cobb 93 | (t 94 | (destructuring-bind (isn . rest-program) program 95 | (flet ((visit-state (amplitude-factor mapped-classical-state) 96 | (descend rest-program (* amplitude amplitude-factor) mapped-classical-state))) 97 | (declare (dynamic-extent #'visit-state)) 98 | (multiple-value-bind (amplitude-factors mapped-classical-states) 99 | (map-classical-state isn classical-state) 100 | (mapc #'visit-state mapped-classical-states amplitude-factors)))))) 101 | nil)) 102 | ;; Simulate the program. 103 | (descend (coerce (quil:parsed-program-executable-code parsed-prog) 'list) 104 | (cflonum 1) 105 | initial-classical-state) 106 | ;; Return the sums. 107 | sums))) 108 | 109 | (defun wavefunction-from-path-simulation (parsed-prog) 110 | "Compute the wavefunction of the program PARSED-PROG using path simulation." 111 | (path-simulate parsed-prog 0 (alexandria:iota (expt 2 (quil:qubits-needed parsed-prog))))) 112 | 113 | 114 | -------------------------------------------------------------------------------- /src/qam.lisp: -------------------------------------------------------------------------------- 1 | ;;;; qam.lisp 2 | ;;;; 3 | ;;;; Author: Robert Smith 4 | 5 | (in-package #:qvm) 6 | 7 | (defgeneric run (qam) 8 | (:documentation "Simulate the quantum abstract machine QAM until completion. Return the QAM in its end state.")) 9 | 10 | (defgeneric reset-quantum-state (qam) 11 | (:documentation "Bring all qubits of the quantum abstract machine QAM to the zero state.")) 12 | 13 | (defgeneric measure (qam q) 14 | (:documentation "Non-deterministically perform a measurement on the qubit addressed by Q in the quantum abstract machine QAM. 15 | 16 | Return two values: 17 | 18 | 1. The resulting QAM. 19 | 2. The measured classical bit.")) 20 | 21 | (defun measure-and-store (qam q c) 22 | "Performs a measurement on the qubit addressed by Q in the quantum abstract machine QAM, and stores the measured 23 | bit in the classical bit addressed by C. 24 | 25 | Return two values: 26 | 27 | 1. The resulting QAM. 28 | 2. The measured classical bit." 29 | (check-type c quil:memory-ref) 30 | (multiple-value-bind (ret-qam cbit) 31 | (measure qam q) 32 | (setf (dereference-mref qam c) cbit) 33 | (values ret-qam cbit))) 34 | 35 | (defgeneric measure-all (qam) 36 | (:documentation "Non-deterministically perform a measurement on all qubits in the quantum abstract machine QAM. 37 | Return two values: 38 | 39 | 1. The resulting QAM. 40 | 2. A list of measured bits.") 41 | (:method ((qam t)) 42 | (let ((measured-bits nil)) 43 | (loop :for q :from (1- (number-of-qubits qam)) :downto 0 44 | :do (multiple-value-bind (ret-qam bit) 45 | (measure qam q) 46 | (push bit measured-bits) 47 | (setf qam ret-qam))) 48 | (values 49 | qam 50 | measured-bits)))) 51 | 52 | (defgeneric number-of-qubits (qam) 53 | (:documentation "Return the number of qubits configured on the quantum abstract machine QAM.")) 54 | 55 | (defgeneric compile-loaded-program (qam) 56 | (:documentation "Compile the program loaded into the qam QAM so as to optimize execution.")) 57 | -------------------------------------------------------------------------------- /src/unitary-qvm.lisp: -------------------------------------------------------------------------------- 1 | ;;; unitary-matrix-qvm.lisp 2 | ;;; 3 | ;;; Author: Erik Davis 4 | 5 | (in-package #:qvm) 6 | 7 | ;;; Calculate Unitary Matrices via a pure-state QVM 8 | ;;; 9 | ;;; For Quil programs consisting only of gate applications, the 10 | ;;; corresponding action on the computational basis is described by a 11 | ;;; unitary matrix. Here we allow for the fast computation of this 12 | ;;; matrix by having a k-qubit program act on a pure state of 2k 13 | ;;; qubits. For a unitary U, we consider the 'identity' 14 | ;;; 15 | ;;; 〈p0...pk| U |q0...qk〉= |q0...qk p0...pk〉 16 | ;;; 17 | ;;; so that the upper k qubits of the larger wavefunction encoding the 18 | ;;; starting basis vector, and the lower k encode the component of the 19 | ;;; result. In more traditional language, we represent a matrix 20 | ;;; M by its column-major vectorization. 21 | 22 | (deftype unitary-matrix-view () 23 | `(and (array cflonum (* *)) 24 | (not simple-array))) 25 | 26 | (defclass unitary-state (pure-state) 27 | ((matrix-view 28 | :reader matrix-view 29 | :documentation "2D array displaced to AMPLITUDES")) 30 | (:default-initargs 31 | :elements-vector nil 32 | :temporary-state nil) 33 | (:documentation "A UNITARY-STATE is a unitary matrix acting on N qubits. The entries of the matrix are represented by the length 2^(2*N) vector AMPLITUDES which is in column-major order. MATRIX-VIEW is a 2D array displaced to this. NOTE: this state may be denormalized.")) 34 | 35 | (defmethod initialize-instance :after ((state unitary-state) &key &allow-other-keys) 36 | ;; Ensure that MATRIX-VIEW is displaced to the ELEMENTS-VECTOR 37 | ;; density matrix of the UNITARY-STATE state. 38 | (%update-matrix-view state) 39 | (set-to-zero-state state)) 40 | 41 | (defmethod num-qubits ((state unitary-state)) 42 | ;; Returns the number of qubits represented by the UNITARY-STATE STATE. 43 | (/ (quil:ilog2 (length (amplitudes state))) 2)) 44 | 45 | (defun %update-matrix-view (state &optional (new-amplitudes (amplitudes state))) 46 | ;; Ensure that MATRIX-VIEW is updated when amplitudes is set. 47 | (let ((dim (expt 2 (num-qubits state)))) 48 | (setf (slot-value state 'matrix-view) 49 | (make-array (list dim dim) 50 | :element-type 'cflonum 51 | :displaced-to new-amplitudes)))) 52 | 53 | (defmethod (setf amplitudes) :after (new-value (state unitary-state)) 54 | (%update-matrix-view state new-value)) 55 | 56 | (defmethod set-to-zero-state ((state unitary-state)) 57 | ;; The zero state here is the vectorization of the identity matrix. 58 | (bring-to-zero-state (amplitudes state)) 59 | (dotimes (i (array-dimension (matrix-view state) 0)) 60 | (setf (aref (matrix-view state) i i) #C(1d0 0d0)))) 61 | 62 | (defun make-unitary-state (num-qubits &key (allocation nil)) 63 | "Construct a UNITARY-STATE associated with NUM-QUBITS. 64 | 65 | The result is initialized so that MATRIX-VIEW is the identity matrix." 66 | (let* ((pure (qvm:make-pure-state (* 2 num-qubits) :allocation allocation)) 67 | (unitary (change-class pure 'unitary-state))) 68 | (%update-matrix-view unitary) 69 | (set-to-zero-state unitary) 70 | unitary)) 71 | 72 | 73 | (defclass unitary-qvm (base-qvm) 74 | () 75 | (:documentation "A QVM for calculating unitary matrices. 76 | 77 | This method of simulation precludes the usage of measurement.")) 78 | 79 | (defmethod amplitudes ((qvm unitary-qvm)) 80 | (state-elements (state qvm))) 81 | 82 | (defmethod (setf amplitudes) (new-amplitudes (qvm unitary-qvm)) 83 | (setf (state-elements (state qvm)) new-amplitudes)) 84 | 85 | (defmethod initialize-instance :after ((qvm unitary-qvm) &rest args) 86 | (declare (ignore args)) 87 | ;; I'm not sure whether this is actually necessary, but better safe than sorry. 88 | (when (or (not (slot-boundp qvm 'state)) 89 | (null (slot-value qvm 'state))) 90 | (%set-state (make-unitary-state (number-of-qubits qvm)) qvm) 91 | (set-to-zero-state (state qvm)))) 92 | 93 | 94 | (defun make-unitary-qvm (num-qubits &rest kws &key (allocation nil) &allow-other-keys) 95 | "Construct a unitary QVM on NUM-QUBITS." 96 | (apply #'make-instance 97 | 'unitary-qvm 98 | :number-of-qubits num-qubits 99 | :state (make-unitary-state num-qubits :allocation allocation) 100 | kws)) 101 | 102 | (defun unitary-qvm-underlying-matrix (qvm) 103 | "Get the underlying matrix associated with the current state of the unitary qvm. 104 | 105 | NOTE: This is a magicl wrapper to the underlying QVM storage. Mutate with caution!" 106 | (check-type qvm unitary-qvm) 107 | (let ((n (expt 2 (number-of-qubits qvm)))) 108 | (magicl:make-tensor 'magicl:matrix/complex-double-float 109 | (list n n) 110 | :storage (amplitudes qvm) 111 | :layout :column-major))) 112 | 113 | 114 | (defmethod reset-quantum-state ((qvm unitary-qvm)) 115 | (set-to-zero-state (state qvm)) 116 | qvm) 117 | 118 | (defmethod measure ((qvm unitary-qvm) q) 119 | (error "MEASURE unsupported in unitary calculation.")) 120 | 121 | (defmethod measure-all ((qvm unitary-qvm)) 122 | (error "MEASURE unsupported in unitary calculation.")) 123 | 124 | (defmethod apply-gate-to-state ((gate superoperator) (qvm unitary-qvm) qubits &rest parameters) 125 | (declare (ignore gate qvm qubits parameters)) 126 | (error "UNITARY-QVM does not support superoperators.")) 127 | 128 | 129 | (defun parsed-program-unitary-matrix (pp &optional (num-qubits (quil:qubits-needed pp))) 130 | "Recover the unitary matrix associated with the action of a parsed program PP. 131 | 132 | The result is a unitary matrix with shape (NUM-QUBITS NUM-QUBITS)." 133 | (let ((qvm (make-unitary-qvm num-qubits))) 134 | (qvm:load-program qvm pp) 135 | (qvm:run qvm) 136 | (unitary-qvm-underlying-matrix qvm))) 137 | 138 | -------------------------------------------------------------------------------- /tests/linear-algebra-tests.lisp: -------------------------------------------------------------------------------- 1 | ;;;; tests/linear-algebra-tests.lisp 2 | ;;;; 3 | ;;;; Author: Robert Smith 4 | 5 | (in-package #:qvm-tests) 6 | 7 | (defun random-wavefunction (&optional (size 8)) 8 | (map-into (make-vector size) (lambda () 9 | (cflonum 10 | (complex (random 1.0d0) 11 | (random 1.0d0)))))) 12 | 13 | 14 | (defun naive-sum (f v) 15 | (reduce #'+ v :key f)) 16 | 17 | (deftest test-psum-dotimes () 18 | "Test that PSUM-DOTIMES works." 19 | (let* ((iterations 10000) 20 | (serial (let ((*qubits-required-for-parallelization* 50)) 21 | (qvm::psum-dotimes (i iterations) 22 | (flonum 1)))) 23 | (parallel (let ((*qubits-required-for-parallelization* 1)) 24 | (qvm::psum-dotimes (i iterations) 25 | (flonum 1))))) 26 | (is (double-float= iterations serial)) 27 | (is (double-float= iterations parallel)))) 28 | 29 | (deftest test-psum () 30 | "Test that PSUM works." 31 | (let* ((qubits-to-test 10) 32 | (vectors (loop :for i :below qubits-to-test 33 | :for size := (expt 2 (1+ i)) 34 | :collect (random-wavefunction size))) 35 | serial-a 36 | serial-b) 37 | (dolist (v vectors) 38 | ;; Serial case. 39 | (let* ((*qubits-required-for-parallelization* 50) 40 | (a (qvm::psum #'probability v)) 41 | (b (naive-sum #'probability v))) 42 | (setf serial-a a 43 | serial-b b) 44 | (is (double-float= a b))) 45 | 46 | ;; Parallel case. 47 | (let* ((*qubits-required-for-parallelization* 1) 48 | (a (qvm::psum #'probability v)) 49 | (b (naive-sum #'probability v))) 50 | (is (double-float= a b)) 51 | (is (double-float= a serial-a)) 52 | (is (double-float= b serial-b)))))) 53 | 54 | (defun naive-norm (v) 55 | (loop :for x :across v 56 | :sum (expt (abs x) 2) :into sq-norm 57 | :finally (return (sqrt sq-norm)))) 58 | 59 | (deftest test-normalization () 60 | "Test that wavefunction normalization produces a unit vector." 61 | (dotimes (i 11) 62 | (let ((v (random-wavefunction (expt 2 i)))) 63 | (normalize-wavefunction v) 64 | (is (double-float= 1 (naive-norm v)))))) 65 | 66 | (deftest test-cdf () 67 | "Test that CUMULATIVE-DISTRIBUTION-FUNCTION seems to work." 68 | (is (every #'double-float= #() (qvm::cumulative-distribution-function (make-vector 0)))) 69 | (is (every #'double-float= #(1.0d0 2.0d0 3.0d0) (qvm::cumulative-distribution-function 70 | (make-vector 3 1 1 1)))) 71 | (is (every #'double-float= #(0.5d0 1.0d0 1.5d0) (qvm::cumulative-distribution-function 72 | (make-vector 3 73 | (sqrt 1/2) 74 | (sqrt 1/2) 75 | (sqrt 1/2)))))) 76 | -------------------------------------------------------------------------------- /tests/modifier-tests.lisp: -------------------------------------------------------------------------------- 1 | ;;;; modifier-tests.lisp 2 | ;;;; 3 | ;;;; Author: Robert Smith 4 | 5 | (in-package #:qvm-tests) 6 | 7 | (deftest test-controlled-x () 8 | "Test that a CONTROLLED modifier seems to work in a common case." 9 | (with-execution-modes (:compile :interpret) 10 | (let* ((p-normal (with-output-to-quil 11 | "H 0" 12 | "CNOT 0 1")) 13 | (p-modified (with-output-to-quil 14 | "H 0" 15 | "CONTROLLED X 0 1")) 16 | (q-normal (run-program 2 p-normal)) 17 | (q-modified (run-program 2 p-modified))) 18 | (is (every #'cflonum= 19 | (qvm::amplitudes q-normal) 20 | (qvm::amplitudes q-modified)))))) 21 | 22 | (deftest test-controlled-controlled-x () 23 | "Test that a CONTROLLED modifier seems to work in a common case." 24 | (with-execution-modes (:compile :interpret) 25 | (let* ((p-normal (with-output-to-quil 26 | "H 0" 27 | "H 1" 28 | "H 2" 29 | "CCNOT 0 1 2")) 30 | (p-modified (with-output-to-quil 31 | "H 0" 32 | "H 1" 33 | "H 2" 34 | "CONTROLLED CONTROLLED X 0 1 2")) 35 | (q-normal (run-program 3 p-normal)) 36 | (q-modified (run-program 3 p-modified))) 37 | (is (every #'cflonum= 38 | (qvm::amplitudes q-normal) 39 | (qvm::amplitudes q-modified)))))) 40 | 41 | 42 | (deftest test-dagger-inversion () 43 | "Test that DAGGER modifiers seem to work in a case where we want to reverse a circuit." 44 | (with-execution-modes (:compile :interpret) 45 | (let* ((p (with-output-to-quil 46 | ;; Start 47 | "H 0" 48 | "CONTROLLED RY(2*pi/3) 0 1" 49 | "RX(pi/3) 0" 50 | "T 2" 51 | "CSWAP 0 1 2" 52 | ;; Invert 53 | "DAGGER CSWAP 0 1 2" 54 | "DAGGER T 2" 55 | "DAGGER RX(pi/3) 0" 56 | "DAGGER CONTROLLED RY(2*pi/3) 0 1" 57 | "DAGGER H 0")) 58 | (q (run-program 3 p))) 59 | (is (cflonum= 1 (qvm::nth-amplitude q 0))) 60 | (loop :for i :from 1 :below (expt 2 3) :do 61 | (is (cflonum= 0 (qvm::nth-amplitude q i))))))) 62 | 63 | (deftest test-forked-rx () 64 | (with-execution-modes (:compile :interpret) 65 | (let* ((p-first-branch 66 | (with-output-to-quil "FORKED RX(0, pi) 0 1")) 67 | (p-second-branch 68 | (with-output-to-quil 69 | "X 0" 70 | "FORKED RX(0, pi) 0 1"))) 71 | ;; Since q0 should be in the zero state, the FORKED should 72 | ;; produce RX(0) 1, hence leaving q1 in the zero state. 73 | (is (every #'cflonum= (map 'list #'qvm::probability (qvm::amplitudes (run-program 2 p-first-branch))) 74 | (list 1 0 0 0))) 75 | ;; q1 is now in the one state, forked should produce RX(pi) 1, 76 | ;; leaving q1 in the one state. 77 | (is (every #'cflonum= (map 'list #'qvm::probability (qvm::amplitudes (run-program 2 p-second-branch))) 78 | (list 0 0 0 1)))))) 79 | 80 | (deftest test-forked-rx-with-controlled-and-dagger () 81 | (with-execution-modes (:compile :interpret) 82 | (let* ((p-first-branch 83 | (with-output-to-quil "CONTROLLED DAGGER FORKED RX(0, pi) 0 1 2")) 84 | (p-second-branch 85 | (with-output-to-quil 86 | "X 0" 87 | "X 1" 88 | "CONTROLLED DAGGER FORKED RX(0, pi) 0 1 2"))) 89 | ;; Since q0, q1 should be in the zero state, the FORKED should 90 | ;; produce RX(0) 2, hence leaving q2 in the zero state. 91 | (is (cflonum= 0 (qvm:probability (qvm::nth-amplitude (run-program 3 p-first-branch) 7)))) 92 | ;; q0, q1 are now in the one state, forked should produce RX(pi) 2, 93 | ;; leaving q2 in the one state. 94 | (is (cflonum= 1 (qvm:probability (qvm::nth-amplitude (run-program 3 p-second-branch) 7))))))) 95 | 96 | (deftest test-multiply-forked-rx () 97 | ;; AKA the uniformly controlled rotation 98 | ;; TODO Cover all possibilities. 99 | (with-execution-modes (:compile :interpret) 100 | (let* ((p-first-branch 101 | (with-output-to-quil "FORKED FORKED RX(0, 0, 0, pi) 0 1 2")) 102 | (p-second-branch 103 | (with-output-to-quil 104 | "X 0" 105 | "X 1" 106 | "FORKED FORKED RX(0, 0, 0, pi) 0 1 2"))) 107 | ;; Since q0, q1 should be in the zero state, the FORKED should 108 | ;; produce RX(0) 2, hence leaving q2 in the zero state. 109 | (is (every #'cflonum= (map 'list #'qvm::probability (qvm::amplitudes (run-program 3 p-first-branch))) 110 | (list 1 0 0 0 0 0 0 0))) 111 | ;; q0, q1 are now in the one state, forked should produce RX(pi) 2, 112 | ;; leaving q2 in the one state. 113 | (is (every #'cflonum= (map 'list #'qvm::probability (qvm::amplitudes (run-program 3 p-second-branch))) 114 | (list 0 0 0 0 0 0 0 1)))) 115 | 116 | (let* ((p-first-branch 117 | (with-output-to-quil "FORKED FORKED RX(pi, 0, 0, pi) 0 1 2")) 118 | (p-second-branch 119 | (with-output-to-quil 120 | "X 0" 121 | "X 1" 122 | "FORKED FORKED RX(pi, 0, 0, pi) 0 1 2"))) 123 | ;; Since q0, q1 should be in the zero state, the FORKED should 124 | ;; produce RX(pi) 2, hence leaving q2 in the one state. 125 | (is (every #'cflonum= (map 'list #'qvm::probability (qvm::amplitudes (run-program 3 p-first-branch))) 126 | (list 0 0 0 0 1 0 0 0))) 127 | ;; q0, q1 are now in the one state, forked should produce RX(pi) 2, 128 | ;; leaving q2 in the one state. 129 | (is (every #'cflonum= (map 'list #'qvm::probability (qvm::amplitudes (run-program 3 p-second-branch))) 130 | (list 0 0 0 0 0 0 0 1)))))) 131 | -------------------------------------------------------------------------------- /tests/package.lisp: -------------------------------------------------------------------------------- 1 | ;;;; tests/package.lisp 2 | ;;;; 3 | ;;;; Author: Robert Smith 4 | 5 | (fiasco:define-test-package #:qvm-tests 6 | (:use #:qvm) 7 | #+(or sbcl ecl ccl) 8 | (:local-nicknames (:quil :cl-quil.frontend)) 9 | 10 | ;; suite.lisp 11 | (:export 12 | #:run-qvm-tests)) 13 | -------------------------------------------------------------------------------- /tests/parallel-tests.lisp: -------------------------------------------------------------------------------- 1 | ;;;; tests/parallel-tests.lisp 2 | ;;;; 3 | ;;;; Author: John Lapeyre 4 | 5 | (in-package #:qvm-tests) 6 | 7 | (deftest test-changing-number-of-workers () 8 | "Test that preparing for parallelization is idempotent only if the number of workers does not change. 9 | 10 | More precisely, idempotent in side-effects. The function PREPARE-FOR-PARALLELIZATION is called only for side effects." 11 | (qvm:prepare-for-parallelization 1) 12 | (if (< (count-logical-cores) 2) 13 | (is lparallel:*kernel*) ; For one core, we only check that the thread pool is created. 14 | (let* ((save-kernel-1 lparallel:*kernel*) 15 | (num-workers-1 (lparallel:kernel-worker-count)) 16 | (save-kernel-1-again (progn (qvm:prepare-for-parallelization 1) 17 | lparallel:*kernel*)) 18 | (save-kernel-2 (progn (qvm:prepare-for-parallelization 2) 19 | lparallel:*kernel*)) 20 | (num-workers-2 (lparallel:kernel-worker-count))) 21 | (is (= num-workers-1 1)) ; Was one worker actually created ? 22 | (is (= num-workers-2 2)) ; Were two workers actually created ? 23 | (is (eq save-kernel-1 save-kernel-1-again)) ; Was the second preparation a no-op ? 24 | (is (not (eq save-kernel-1 save-kernel-2)))))) ; Did the third preparation create a new worker pool ? 25 | -------------------------------------------------------------------------------- /tests/path-simulate-tests.lisp: -------------------------------------------------------------------------------- 1 | ;;;; path-simulate-tests.lisp 2 | ;;;; 3 | ;;;; Author: Robert Smith 4 | 5 | (in-package #:qvm-tests) 6 | 7 | ;;; This file contains tests of the MADPI simulation technique. 8 | 9 | (defun test-path-eval-instance (s) 10 | (let* ((p (quil:parse-quil (format nil s))) 11 | (n (quil:qubits-needed p)) 12 | (qvm (make-qvm n))) 13 | (load-program qvm p) 14 | (run qvm) 15 | (is (every #'cflonum= 16 | ;; Path simulate 17 | (wavefunction-from-path-simulation p) 18 | ;; QVM result 19 | (qvm::amplitudes qvm))) 20 | nil)) 21 | 22 | (deftest test-madpi () 23 | "Test the MADPI technique for program simulation." 24 | (mapc #'test-path-eval-instance 25 | '("X 0" 26 | "X 1" 27 | "X 0~%X 1" 28 | "H 0~%CNOT 0 1" 29 | "H 0~%H 1~%H 2~%CSWAP 0 1 2" 30 | "H 1~%CNOT 0 1~%X 0~%CCNOT 0 1 2~%CPHASE(0.5) 0 2")) 31 | nil) 32 | -------------------------------------------------------------------------------- /tests/qvm-avx-intrinsics.lisp: -------------------------------------------------------------------------------- 1 | ;;;; tests/sbcl-intrinsics.lisp 2 | ;;;; 3 | ;;;; Author: Cole Scott 4 | 5 | (in-package #:qvm-tests) 6 | 7 | (deftest test-avx2-simple-matrix-mult () 8 | "Test basic matrix multiplication using AVX2." 9 | (let* ((mat (make-array '(2 2) :initial-contents '((#C(1d0 2d0) #C(3d0 4d0)) (#C(5d0 6d0) #C(7d0 8d0))))) 10 | (a #C(1d0 2d0)) 11 | (b #C(3d0 4d0)) 12 | (expected-p #C(-10d0 28d0)) 13 | (expected-q #C(-18d0 68d0)) 14 | (v (aref mat 0 0)) 15 | (x (aref mat 0 1)) 16 | (y (aref mat 1 0)) 17 | (z (aref mat 1 1))) 18 | (multiple-value-bind (vyr vyi xzr xzi) 19 | (qvm-intrinsics::2x2matrix-to-simd v x y z) 20 | (multiple-value-bind (p q) 21 | (qvm-intrinsics::matmul2-simd vyr vyi xzr xzi a b) 22 | (is (cflonum= p expected-p)) 23 | (is (cflonum= q expected-q)))))) 24 | 25 | (deftest test-avx2-matmul2-vector-simd () 26 | "Test that matmul2-vector-simd multiplies vectors correctly" 27 | (let ((mat (make-array '(2 2) :element-type '(complex double-float) :initial-contents '((#C(1d0 2d0) #C(3d0 4d0)) (#C(5d0 6d0) #C(7d0 8d0))))) 28 | (vec (make-array '(2) :element-type '(complex double-float) :initial-contents '(#C(1d0 2d0) #C(3d0 4d0)))) 29 | (res (make-array '(2) :element-type '(complex double-float) :initial-contents '(#C(-10d0 28d0) #C(-18d0 68d0))))) 30 | (qvm-intrinsics::matmul2-vector-simd mat vec) 31 | (is (every #'cflonum= vec res)))) 32 | 33 | (deftest test-avx2-matmul2-random () 34 | "Test avx version of matmul4 by comparing to normal one 100 times" 35 | (let ((mat (make-array '(2 2) :element-type '(complex double-float))) 36 | (vec1 (make-array '(2) :element-type '(complex double-float))) 37 | (vec2 (make-array '(2) :element-type '(complex double-float)))) 38 | (loop :repeat 100 :do 39 | (dotimes (i 2) 40 | (let ((num (complex (random 1d0) (random 1d0)))) 41 | (setf (aref vec1 i) num 42 | (aref vec2 i) num))) 43 | (dotimes (i 2) 44 | (dotimes (j 2) 45 | (setf (aref mat i j) (complex (random 1d0) (random 1d0))))) 46 | (qvm::matmul2 mat vec1 vec2) 47 | (qvm-intrinsics::matmul2-vector-simd mat vec1) 48 | (is (every #'cflonum= vec1 vec2)))) 49 | nil) 50 | 51 | (deftest test-avx2-matmul4-random () 52 | "Test avx version of matmul4 by comparing to normal one 100 times" 53 | (let ((mat (make-array '(4 4) :element-type '(complex double-float))) 54 | (vec1 (make-array '(4) :element-type '(complex double-float))) 55 | (vec2 (make-array '(4) :element-type '(complex double-float)))) 56 | (loop :repeat 100 :do 57 | (dotimes (i 4) 58 | (let ((num (complex (random 1d0) (random 1d0)))) 59 | (setf (aref vec1 i) num 60 | (aref vec2 i) num))) 61 | (dotimes (i 4) 62 | (dotimes (j 4) 63 | (setf (aref mat i j) (complex (random 1d0) (random 1d0))))) 64 | (qvm::matmul4 mat vec1 vec2) 65 | (qvm-intrinsics::matmul4-vector-simd mat vec1) 66 | (is (every #'cflonum= vec1 vec2)))) 67 | nil) 68 | -------------------------------------------------------------------------------- /tests/qvm-tests.lisp: -------------------------------------------------------------------------------- 1 | ;;;; tests/qvm-tests.lisp 2 | ;;;; 3 | ;;;; Author: Robert Smith 4 | 5 | (in-package #:qvm-tests) 6 | 7 | (deftest test-complex-double-float-replace () 8 | "Test for bug #23 (github) in Clozure CL where REPLACE does not 9 | faithfully copy from arrays of complex double-floats." 10 | (let ((a (make-array 4 :element-type '(complex double-float))) 11 | (b (make-array 4 :element-type '(complex double-float)))) 12 | (dotimes (i 4) 13 | (setf (aref b i) (complex (* 1.0d0 i) (* 2.0d0 i)))) 14 | (replace a b) 15 | (is (equalp a b)))) 16 | 17 | (deftest test-defgate-persistence () 18 | (let ((q1 (qvm:make-qvm 1)) 19 | (q2 (qvm:make-qvm 1))) 20 | (qvm:load-program q1 (with-output-to-quil 21 | "DEFGATE A:" 22 | " 0, 1" 23 | " 1, 0")) 24 | (qvm:load-program q2 (with-output-to-quil 25 | "DEFGATE A:" 26 | " 1, 0" 27 | " 0, 1")) 28 | (is (not (eq (qvm::lookup-gate q1 "A") 29 | (qvm::lookup-gate q2 "A")))))) 30 | 31 | (deftest test-too-many-qubits-in-program-for-qvm () 32 | "Test that a program can't be loaded into a QVM with too many qubits." 33 | (signals error 34 | (run-program 1 (with-output-to-quil 35 | "X 0" 36 | "X 1"))) 37 | (signals error 38 | (let ((q (make-qvm 1))) 39 | (load-program q (with-output-to-quil 40 | "X 0" 41 | "X 1"))))) 42 | -------------------------------------------------------------------------------- /tests/subsystem-tests.lisp: -------------------------------------------------------------------------------- 1 | ;;;; subsystem-tests.lisp 2 | ;;;; 3 | ;;;; Author: Robert Smith 4 | 5 | (in-package #:qvm-tests) 6 | 7 | (deftest test-subsystem-sundries () 8 | (let ((ss0 (qvm::make-subsystem-on-qubits)) 9 | (ss1 (qvm::make-subsystem-on-qubits 0)) 10 | (ss2 (qvm::make-subsystem-on-qubits 0 2)) 11 | (ss3 (qvm::make-subsystem-on-qubits 0 2 4)) 12 | (ss3- (qvm::make-subsystem-on-qubits 0 1 1 2))) 13 | (is (and (= 0 (qvm::subsystem-num-qubits ss0)) 14 | (= 1 (qvm::subsystem-num-qubits ss1)) 15 | (= 2 (qvm::subsystem-num-qubits ss2)) 16 | (= 3 (qvm::subsystem-num-qubits ss3)) 17 | (= 3 (qvm::subsystem-num-qubits ss3-)))) 18 | (is (= 8 (length (qvm::subsystem-state ss3-)))) 19 | (is (and (qvm::subsystem-contains-qubit-p ss3 0) 20 | (qvm::subsystem-contains-qubit-p ss3 2) 21 | (qvm::subsystem-contains-qubit-p ss3 4))) 22 | (is (not (or (qvm::subsystem-contains-qubit-p ss3 1) 23 | (qvm::subsystem-contains-qubit-p ss3 3) 24 | (qvm::subsystem-contains-qubit-p ss3 5)))) 25 | (is (and (qvm::subsystem-contains-qubits-p ss3 (qvm::subsystem-qubits ss3)) 26 | (qvm::subsystem-contains-qubits-p ss3 (qvm::subsystem-qubits ss2)) 27 | (qvm::subsystem-contains-qubits-p ss3 (qvm::subsystem-qubits ss1)) 28 | (qvm::subsystem-contains-qubits-p ss3 (qvm::subsystem-qubits ss0)))) 29 | (is (not (qvm::subsystem-contains-qubits-p ss3 (qvm::subsystem-qubits ss3-)))) 30 | (is (and (= 0 (qvm::subsystem-physical-to-logical-qubit ss3 0)) 31 | (= 1 (qvm::subsystem-physical-to-logical-qubit ss3 2)) 32 | (= 2 (qvm::subsystem-physical-to-logical-qubit ss3 4)))))) 33 | 34 | (deftest test-join-subsystems () 35 | (let ((ss001 (qvm::make-subsystem-on-qubits 0)) 36 | (ss010 (qvm::make-subsystem-on-qubits 1)) 37 | (ss100 (qvm::make-subsystem-on-qubits 2))) 38 | (is (every #'cflonum= 39 | (qvm::subsystem-state (qvm::join-subsystems ss001 ss010)) 40 | (qvm::subsystem-state (qvm::join-subsystems ss010 ss100)))) 41 | (is (every #'cflonum= 42 | (qvm::subsystem-state (qvm::join-subsystems ss010 ss100)) 43 | (qvm::subsystem-state (qvm::join-subsystems ss100 ss001)))) 44 | (is (every #'cflonum= 45 | (qvm:wf 0 1 0 0) 46 | (qvm::subsystem-state 47 | (qvm::join-subsystems (qvm::make-subsystem :qubits #b01 48 | :state (qvm:wf 0 1)) 49 | (qvm::make-subsystem :qubits #b100 50 | :state (qvm:wf 1 0)))))) 51 | (let ((superposition (qvm:wf (/ (sqrt 2)) (/ (sqrt 2))))) 52 | (is (every #'cflonum= 53 | (qvm:wf 0.5 0.5 0.5 0.5) 54 | (qvm::subsystem-state 55 | (qvm::join-subsystems (qvm::make-subsystem :qubits #b01 56 | :state superposition) 57 | (qvm::make-subsystem :qubits #b10 58 | :state superposition))))) 59 | (is (every #'cflonum= 60 | (apply #'qvm:wf (make-list 16 :initial-element 0.25)) 61 | (qvm::subsystem-state 62 | (qvm::join-subsystems 63 | (qvm::join-subsystems (qvm::make-subsystem :qubits #b0001 64 | :state superposition) 65 | (qvm::make-subsystem :qubits #b0100 66 | :state superposition)) 67 | (qvm::join-subsystems (qvm::make-subsystem :qubits #b0010 68 | :state superposition) 69 | (qvm::make-subsystem :qubits #b1000 70 | :state superposition))))))))) 71 | 72 | (defun phase= (a b) 73 | (flet ((same-or-zero-p (items) 74 | (loop :with model-item := nil 75 | :for item :in items 76 | :if (and (null model-item) 77 | (not (zerop item))) 78 | :do (setf model-item item) 79 | :else 80 | :do (unless (double-float= item model-item) 81 | (return-from same-or-zero-p nil))) 82 | ;; If we got here, we win! 83 | t)) 84 | (same-or-zero-p (map 'list (lambda (x y) 85 | (if (cflonum= 0 y) 86 | 0.0d0 87 | (phase (/ x y)))) 88 | a b)))) 89 | 90 | (deftest test-eject-qubit-from-subsystem () 91 | (let* ((ss010 (qvm::make-subsystem :qubits #b010 92 | :state (qvm:wf (/ (sqrt 2)) (/ (sqrt 2))))) 93 | (ss101 (qvm::make-subsystem :qubits #b101 94 | :state (qvm::randomize-wavefunction (qvm:wf 1 0 0 0)))) 95 | (ss111 (qvm::join-subsystems ss010 ss101)) 96 | (ss-spook (qvm::make-subsystem :qubits #b11 97 | :state (qvm:wf (/ (sqrt 2)) 0 0 (/ (sqrt 2)))))) 98 | ;; Trivial ejections 99 | (multiple-value-bind (new-state ejected-state) (qvm::eject-qubit-from-subsystem ss010 31337) 100 | (is (eq new-state ss010)) 101 | (is (every #'cflonum= ejected-state (qvm:wf 1 0))) 102 | (is (= #b010 (qvm::subsystem-qubits new-state)))) 103 | (multiple-value-bind (new-state ejected-state) (qvm::eject-qubit-from-subsystem ss010 1) 104 | (is (zerop (qvm::subsystem-qubits new-state))) 105 | (is (every #'cflonum= ejected-state (qvm::subsystem-state ss010)))) 106 | 107 | ;; Bad ejection 108 | (signals error (qvm::eject-qubit-from-subsystem ss-spook 0)) 109 | 110 | ;; Non-trivial ejection 111 | (multiple-value-bind (new-state ejected-state) (qvm::eject-qubit-from-subsystem ss111 1) 112 | (is (phase= (qvm::subsystem-state ss101) 113 | (qvm::subsystem-state new-state))) 114 | (is (phase= ejected-state (qvm::subsystem-state ss010)))))) 115 | -------------------------------------------------------------------------------- /tests/suite.lisp: -------------------------------------------------------------------------------- 1 | ;;;; tests/suite.lisp 2 | ;;;; 3 | ;;;; Author: Robert Smith 4 | 5 | (in-package #:qvm-tests) 6 | 7 | (defun run-qvm-tests (&key (headless nil)) 8 | "Run all QVM tests. If HEADLESS is T, disable interactive debugging and quit on completion." 9 | ;; Bug in Fiasco commit fe89c0e924c22c667cc11c6fc6e79419fc7c1a8b 10 | (setf fiasco::*test-run-standard-output* (make-broadcast-stream 11 | *standard-output*)) 12 | (qvm:prepare-for-parallelization) 13 | (qvm::enable-all-qvm-optimizations) 14 | (cond 15 | ((null headless) 16 | (run-package-tests :package ':qvm-tests 17 | :verbose nil 18 | :describe-failures t 19 | :interactive t)) 20 | (t 21 | (let ((successp (run-package-tests :package ':qvm-tests 22 | :verbose t 23 | :describe-failures t 24 | :interactive nil))) 25 | (uiop:quit (if successp 0 1)))))) 26 | 27 | -------------------------------------------------------------------------------- /tests/unitary-tests.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:qvm-tests) 2 | 3 | (deftest test-unitary-matrix-swap-from-cnots () 4 | (let ((gate-prog 5 | (quil:parse-quil "CNOT 0 1; CNOT 1 0; CNOT 0 1")) 6 | (matrix 7 | (magicl:from-list '(1 0 0 0 8 | 0 0 1 0 9 | 0 1 0 0 10 | 0 0 0 1) '(4 4) :type '(complex double-float)))) 11 | (is (magicl:= matrix 12 | (qvm:parsed-program-unitary-matrix gate-prog))))) 13 | 14 | 15 | (deftest test-unitary-qvm-error-on-measure () 16 | (let ((pp 17 | (quil:parse-quil "CNOT 0 1; MEASURE 0")) 18 | (qvm (qvm:make-unitary-qvm 2))) 19 | (qvm:load-program qvm pp) 20 | (signals error 21 | (qvm:run qvm)))) 22 | -------------------------------------------------------------------------------- /tests/utilities-tests.lisp: -------------------------------------------------------------------------------- 1 | ;;;; utilities-tests.lisp 2 | ;;;; 3 | ;;;; Authors: Robert Smith 4 | ;;;; Peter Karalekas 5 | 6 | (in-package #:qvm-tests) 7 | 8 | (defun set-equal (list1 list2) 9 | (and (= (length list1) 10 | (length list2)) 11 | (loop :for item :in list2 12 | :always (member item list1)))) 13 | 14 | (defun nat-tuple-list (nt) 15 | (coerce nt 'list)) 16 | 17 | (deftest test-nat-tuple-cardinality () 18 | (let ((empty (qvm::nat-tuple)) 19 | (three (qvm::nat-tuple 2 3 4)) 20 | (two (qvm::nat-tuple 1 3))) 21 | (is (= 0 (qvm::nat-tuple-cardinality empty))) 22 | (is (= 3 (qvm::nat-tuple-cardinality three))) 23 | (is (= 2 (qvm::nat-tuple-cardinality two))))) 24 | 25 | (deftest test-nat-tuple () 26 | (let* ((vals (list 1 2 3)) 27 | (nt (apply #'qvm::nat-tuple vals))) 28 | (is (equal (reverse vals) (nat-tuple-list nt))))) 29 | 30 | (deftest test-nat-tuple-complement () 31 | (let* ((n 6) 32 | (nt (qvm::nat-tuple 0 2 4)) 33 | (ntcomp (qvm::nat-tuple-complement n nt)) 34 | (ntfull (qvm::nat-tuple-complement n (qvm::nat-tuple)))) 35 | (is (null (intersection (nat-tuple-list nt) 36 | (nat-tuple-list ntcomp)))) 37 | (is (set-equal (nat-tuple-list ntfull) 38 | (union (nat-tuple-list nt) 39 | (nat-tuple-list ntcomp)))))) 40 | 41 | (deftest test-transposition-decomposition () 42 | (labels ((random-perm (n) 43 | (loop :with taken := (1- (expt 2 n)) 44 | :until (zerop taken) 45 | :collect (loop :with r := (random n) 46 | :until (logbitp (setf r (random n)) taken) 47 | :finally (progn 48 | (setf taken (dpb 0 (byte 1 r) taken)) 49 | (return r))))) 50 | (verify-decomp (perm) 51 | (let ((transpositions (qvm::permutation-to-transpositions perm)) 52 | (identity (loop :for i :below (length perm) :collect i))) 53 | (loop :for (a . b) :in transpositions 54 | :do (rotatef (elt identity a) (elt identity b)) 55 | :finally (is (equalp identity perm)))))) 56 | (dotimes (i 1000) 57 | (verify-decomp (random-perm (expt 2 (1+ (random 5)))))))) 58 | 59 | (deftest test-subdivide () 60 | "Test that SUBDIVIDE works." 61 | (let ((workers 8)) 62 | ;; Degenerate case 63 | (dotimes (i workers) 64 | (is (equalp (qvm::subdivide i workers) `((0 . ,i))))) 65 | 66 | ;; Equal case 67 | (is (equalp (qvm::subdivide workers workers) 68 | (loop :for i :below workers 69 | :collect (cons i (1+ i))))) 70 | 71 | ;; Double equal case 72 | (is (equalp (qvm::subdivide (* 2 workers) workers) 73 | (loop :for i :below (* 2 workers) :by 2 74 | :collect (cons i (+ 2 i))))) 75 | 76 | ;; Slack case 77 | (is (equalp (qvm::subdivide (+ 3 workers) workers) 78 | (loop :for i :below (1- workers) 79 | :collect (cons i (1+ i)) :into ranges 80 | :finally (return (append ranges 81 | `((,(1- workers) . ,(+ 3 workers)))))))))) 82 | 83 | (deftest test-inject-bit () 84 | (let ((source #b1111)) 85 | (is (= #b11110 (qvm::inject-bit source 0))) 86 | (is (= #b11101 (qvm::inject-bit source 1))) 87 | (is (= #b11011 (qvm::inject-bit source 2))) 88 | (is (= #b10111 (qvm::inject-bit source 3))) 89 | (is (= #b01111 (qvm::inject-bit source 4))))) 90 | 91 | (deftest test-eject-bit () 92 | (let ((target #b1111)) 93 | (is (= target (qvm::eject-bit #b11110 0))) 94 | (is (= target (qvm::eject-bit #b11101 1))) 95 | (is (= target (qvm::eject-bit #b11011 2))) 96 | (is (= target (qvm::eject-bit #b10111 3))) 97 | (is (= target (qvm::eject-bit #b01111 4))))) 98 | -------------------------------------------------------------------------------- /tests/wavefunction-tests.lisp: -------------------------------------------------------------------------------- 1 | ;;;; wavefunction-tests.lisp 2 | ;;;; 3 | ;;;; Author: Robert Smith 4 | 5 | (in-package #:qvm-tests) 6 | 7 | (deftest test-map-complement-one-qubit () 8 | (flet ((invariant (n) 9 | (lambda (ig x) 10 | (declare (ignore ig)) 11 | (is (not (logbitp n x)))))) 12 | (loop :for i :below 8 :do 13 | (qvm::map-complement (invariant i) 8 (qvm::nat-tuple i))))) 14 | 15 | (deftest test-map-complement-two-qubits () 16 | (flet ((invariant (m n) 17 | (lambda (ig x) 18 | (declare (ignore ig)) 19 | (is (and (not (logbitp m x)) 20 | (not (logbitp n x))))))) 21 | (loop :for i :below 8 22 | :for m := i 23 | :for n := (mod (* 2 i) 8) :do 24 | (when (= m n) (incf m)) 25 | (qvm::map-complement (invariant m n) 8 (qvm::nat-tuple m n))))) 26 | 27 | (deftest test-wavefunction-qubits () 28 | "Test that WAVEFUNCTION-QUBITS works." 29 | (is (= 1 (qvm::wavefunction-qubits (make-vector 2)))) 30 | (is (= 2 (qvm::wavefunction-qubits (make-vector 4)))) 31 | (is (= 3 (qvm::wavefunction-qubits (make-vector 8)))) 32 | (is (= 4 (qvm::wavefunction-qubits (make-vector 16))))) 33 | 34 | (deftest test-copy-wavefunction () 35 | "Test that COPY-WAVEFUNCTION works." 36 | (let ((wf1 (make-vector 1 1)) 37 | (wf2 (make-vector 2 1 2)) 38 | (wf4 (make-vector 4 1 2 3 4)) 39 | (wf8 (make-vector 8 1 2 3 4 5 6 7 8)) 40 | (d1 (make-vector 1)) 41 | (d2 (make-vector 2)) 42 | (d4 (make-vector 4)) 43 | (d8 (make-vector 8))) 44 | (macrolet ((test-each-combo (sources destinations) 45 | `(progn 46 | ;; Try each src first. 47 | ,@(loop :with copy := (gensym "COPY") 48 | :for src :in sources 49 | :collect `(let ((,copy (qvm:copy-wavefunction ,src))) 50 | (is (every #'= ,src ,copy)))) 51 | 52 | ;; Now each src/dst combo. 53 | ,@(loop :with i := (gensym "I") 54 | :for src :in sources 55 | :append (loop :for dst :in destinations 56 | :collect `(progn 57 | (qvm:copy-wavefunction ,src ,dst) 58 | (is (loop :for ,i :below (min (length ,src) 59 | (length ,dst)) 60 | :always (= (aref ,src ,i) 61 | (aref ,dst ,i)))))))))) 62 | ;; No parallelization. 63 | (let ((qvm:*qubits-required-for-parallelization* 10)) 64 | (test-each-combo (wf1 wf2 wf4 wf8) (d1 d2 d4 d8))) 65 | 66 | ;; A lot of parallelization 67 | (let ((qvm:*qubits-required-for-parallelization* 0)) 68 | (test-each-combo (wf1 wf2 wf4 wf8) (d1 d2 d4 d8)))))) 69 | --------------------------------------------------------------------------------