cl-quantum/parse.lisp

(defpackage :cl-quantum/parse
  (:use :cl :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-constatnt +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))))