;;;; Parse back the states printed by pprint.lisp (defpackage :cl-quantum/parse (:documentation "Parse back the states printed by pprint.lisp.") (:use :cl :cl-quantum/math :cl-quantum/state) (:export #:parse-real #:parse-complex #:parse-state #:parse-bits-state)) (in-package :cl-quantum/parse) (define-constant +parse-real-regexp+ (ppcre:create-scanner "^(\\s*([-+]?[0-9]+)(?:/([0-9]+)|\\.?([0-9]*)(?:[eE]([-+]?[0-9]+))?)\\s*)" :extended-mode t) "The regexp scanner used in `parse-real'.") (defun parse-real (string &key (start 0) end junk-allowed) "Parse STRING into a real. Parsing starts at START and ends at END. If end is nil, the end of the string is used. If JUNK-ALLOWED is non-nil, don't signal an error if an unexpected character is encountered. Two values are returned, the first being the value parsed and the second being the index at which parsing stopped. That is, the index of the first un-parsed character." (values-list (or (ppcre:register-groups-bind (whole main denom decim exp) (+parse-real-regexp+ string :start start :end end :sharedp t) (unless (or junk-allowed (= (length whole) (- (or end (length string)) start))) (error "Malformed number: ~s" (subseq string start end))) (let ((num (cond (denom (/ (parse-integer main) (parse-integer denom))) ((/= (length decim) 0) (build-float (parse-integer main) (parse-integer decim))) (t (parse-integer main))))) (list (if exp (* num (expt 10 (parse-integer exp))) num) (length whole)))) (if junk-allowed (list 0 0) (error "Malformed number: ~s" (subseq string start end)))))) (define-constant +parse-complex-regexp+ (ppcre:create-scanner "^\\s*([-+])?\\s*([-+]?)([0-9/.]+(?:[eE][-+]?[0-9]+)?)?(i)?" :extended-mode t) "The regexp scanner used in `parse-complex'.") (defun parse-complex (string &key (start 0) end junk-allowed) "Parse STRING into a complex number. Parsing starts at START and ends at END. If end is nil, the end of the string is used. If JUNK-ALLOWED is non-nil, don't signal an error if an unexpected character is encountered. Two values are returned, the first being the value parsed and the second being the index at which parsing stopped. That is, the index of the first un-parsed character." (unless end (setq end (length string))) (loop for pos = start then (+ pos (length whole)) for (whole matches) = (multiple-value-list (ppcre:scan-to-strings +parse-complex-regexp+ string :start pos :end end)) for times below 2 while whole for coef = (cond ((aref matches 2) (parse-real (concatenate 'string (aref matches 1) (aref matches 2)))) ((aref matches 3) (if (equal (aref matches 1) "-") -1 1)) (t 0)) for sign = (if (equal (aref matches 0) "-") -1 1) when (aref matches 3) summing (complex 0 (* sign coef)) into num else summing (* sign coef) into num finally (if (and (not junk-allowed) (< pos end)) (error "Junk in string: ~s" (subseq string start end)) (return (values num pos))))) (define-constant +parse-state-regexp+ (ppcre:create-scanner "^\\s*([-+])?\\s*(\\()?\\s*([-+0-9ei./]*)\\s*(\\))?\\s*\\|([^>]*)>" :extended-mode t) "The regexp scanner used in `parse-state'.") (defun parse-bits-state (state) "A `parse-state' parser that parses its state as a binary string." (parse-integer state :radix 2)) (defun parse-state (str &key (parser 'parse-integer)) "Try to parse STR into a quantum state. PARSER should be a function of one argument that will take the string inside each ket and return the index of the state." (loop for start = 0 then (+ start (length whole)) for (whole matches) = (multiple-value-list (ppcre:scan-to-strings +parse-state-regexp+ str :sharedp t :start start)) while whole for coef = (if (zerop (length (aref matches 2))) 1 (parse-complex (aref matches 2))) for index = (funcall parser (aref matches 4)) unless (eq (not (aref matches 1)) (not (aref matches 3))) do (error "Mismatches parenthesis: ~s" whole) when (and (complexp coef) (not (aref matches 1))) do (error "Coefficient without matching state: ~s" whole) collect (if (equal (aref matches 0) "-") (* -1 coef) coef) into coefs collect index into indecies maximizing (1+ index) into state-size finally (return (let ((state (make-array state-size :initial-element 0))) (loop for index in indecies for coef in coefs do (incf (aref state index) coef)) state))))