(in-package :cl-user)
(eval-when (:compile-toplevel :load-toplevel :execute)
  (sb-int:defconstant-eqx opt
    #+swank '(optimize (speed 3) (safety 2))
    #-swank '(optimize (speed 3) (safety 0) (debug 0))
    #'equal)
  #+swank (ql:quickload '(:cl-debug-print :fiveam) :silent t)
  #-swank (set-dispatch-macro-character
           #\# #\> (lambda (s c p) (declare (ignore c p)) `(values ,(read s nil nil t)))))
#+swank (set-dispatch-macro-character #\# #\> #'cl-debug-print:debug-print-reader)

(macrolet ((def-int (b)
             `(progn (deftype ,(intern (format nil "UINT~A" b)) () '(unsigned-byte ,b))
                     (deftype ,(intern (format nil "INT~A" b)) () '(signed-byte ,b))))
           (defs (&rest bits) `(progn ,@(mapcar (lambda (b) `(def-int ,b)) bits))))
  (defs 2 4 7 8 15 16 31 32 62 63 64))

(defconstant +mod+ 1000000007)

(defmacro dbg (&rest forms)
  #+swank (if (= (length forms) 1)
              `(format *error-output* "~A => ~A~%" ',(car forms) ,(car forms))
              `(format *error-output* "~A => ~A~%" ',forms `(,,@forms)))
  #-swank (declare (ignore forms)))

(declaim (inline println))
(defun println (obj &optional (stream *standard-output*))
  (let ((*read-default-float-format* 'double-float))
    (prog1 (princ obj stream) (terpri stream))))

;; BEGIN_INSERTED_CONTENTS
(defpackage :cp/read-fixnum
  (:use :cl)
  (:export #:read-fixnum))
(in-package :cp/read-fixnum)

(declaim (ftype (function * (values fixnum &optional)) read-fixnum))
(defun read-fixnum (&optional (in *standard-input*))
  "NOTE: cannot read -2^62"
  (declare #.cl-user::opt)
  (macrolet ((%read-byte ()
               `(the (unsigned-byte 8)
                     #+swank (char-code (read-char in nil #\Nul))
                     #-swank (sb-impl::ansi-stream-read-byte in nil #.(char-code #\Nul) nil))))
    (let* ((minus nil)
           (result (loop (let ((byte (%read-byte)))
                           (cond ((<= 48 byte 57)
                                  (return (- byte 48)))
                                 ((zerop byte) ; #\Nul
                                  (error "Read EOF or #\Nul."))
                                 ((= byte #.(char-code #\-))
                                  (setq minus t)))))))
      (declare ((integer 0 #.most-positive-fixnum) result))
      (loop
        (let* ((byte (%read-byte)))
          (if (<= 48 byte 57)
              (setq result (+ (- byte 48)
                              (* 10 (the (integer 0 #.(floor most-positive-fixnum 10))
                                         result))))
              (return (if minus (- result) result))))))))

;; DEFINE-INTEGER-PACK and DEFINE-CONS-PACK are so to say poor man's variants of
;; DEFSTRUCT. Both "structures" can only have slots of fixed unsigned
;; bytes. DEFINE-INTEGER-PACK handles the concatenated slots as UNSIGNED-BYTE
;; and DEFINE-CONS-PACK handles them as (CONS (UNSIGNED-BYTE 62) (UNSIGNED-BYTE
;; 62)).

;; Example:
;; The following form defines the type NODE as (UNSIGNED-BYTE 9):
;; (define-integer-pack node (slot1 3) (slot2 5) (slot3 1))
;; This macro in addition defines relevant utilities: NODE-SLOT1, NODE-SLOT2,
;; NODE-SLOT3, setters and getters, PACK-NODE, the constructor, and
;; WITH-UNPACKING-NODE, the destructuring-bind-style macro.
;; 
;; DEFINE-CONS-PACK is almost the same as DEFINE-INTEGER-PACK though it will be
;; suitable for the total bits in the range [63, 124].

(defpackage :cp/integer-pack
  (:use :cl)
  (:export #:define-integer-pack #:define-cons-pack))
(in-package :cp/integer-pack)

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defun %concat-name (&rest args)
    (if (cdr args)
        (format nil "~A-~A"
                (car args)
                (apply #'%concat-name (cdr args)))
        (car args)))

  (defun %concat+name+ (&rest args)
    (format nil "+~A+" (apply #'%concat-name args))))

(defmacro define-integer-pack (name &rest slot-descriptions)
  (assert slot-descriptions () "~A has no slots." name)
  (let* ((packer-name (intern (%concat-name "PACK" name)))
         (unpacker-macro-name (intern (%concat-name "WITH-UNPACKING" name)))
         (total-size 0)
         (slots (loop with position = 0
                      for (slot-name slot-size) in slot-descriptions
                      collect (progn (check-type slot-name symbol)
                                     (check-type slot-size (integer 1))
                                     (list slot-name slot-size position))
                      do (incf position slot-size)
                      finally (setq total-size position)))
         (revslots (reverse slots))
         (new-value (gensym "NEW-VALUE"))
         (tmp (gensym)))
    `(progn
       (deftype ,name () '(unsigned-byte ,total-size))
       ;; define most positive integer for every slot as constant
       ,@(loop for (slot-name slot-size _) in slots
               collect `(defconstant ,(intern (%concat+name+ "MAX" name slot-name))
                          (- (ash 1 ,slot-size) 1)))
       ;; setter and getter
       ,@(loop for (slot-name slot-size slot-position) in slots
               for accessor-name = (intern (%concat-name name slot-name))
               append `((declaim (inline ,accessor-name
                                         (setf ,accessor-name)))
                        (defun ,accessor-name (,name)
                          (declare (type ,name ,name))
                          (ldb (byte ,slot-size ,slot-position) ,name))
                        (defun (setf ,accessor-name) (,new-value ,name)
                          (declare (type ,name ,name))
                          (setf (ldb (byte ,slot-size ,slot-position) ,name) ,new-value))))
       ;; constructor
       (declaim (inline ,packer-name))
       (defun ,packer-name ,(loop for slot in slots collect (car slot))
         (declare ,@(loop for (slot-name slot-size _) in slots
                          collect `(type (unsigned-byte ,slot-size) ,slot-name )))
         (let ((,tmp ,(caar revslots)))
           (declare (type (unsigned-byte ,total-size) ,tmp))
           ,@(loop for (slot-name slot-size _) in (cdr revslots)
                   collect `(setq ,tmp (logxor ,slot-name
                                               (the (unsigned-byte ,total-size)
                                                    (ash ,tmp ,slot-size)))))
           ,tmp))
       ;; destructuring-bind-style macro
       (defmacro ,unpacker-macro-name (vars ,name &body body)
         (check-type vars list)
         (assert (= (length vars) ,(length slots)))
         `(let ((,',tmp ,,name))
            (declare (type (unsigned-byte ,,total-size) ,',tmp))
            (let* ,(loop for var in vars
                         for rest on ',slots
                         for (slot-name slot-size _) = (car rest)
                         collect `(,var
                                   (prog1 (the (unsigned-byte ,slot-size)
                                               (ldb (byte ,slot-size 0) ,',tmp))
                                     ,@(when (cdr rest)
                                         `((setq ,',tmp (ash ,',tmp ,(- slot-size))))))))
              ,@body))))))

(defmacro define-cons-pack (name &rest slot-descriptions)
  (assert slot-descriptions () "~A has no slots." name)
  (labels ((extract-62bit-slots (list)
             (let ((position 0))
               (loop for (slot-name slot-size) in list
                     while (<= (+ position slot-size) 62)
                     collect (list slot-name slot-size position)
                     do (incf position slot-size)))))
    (let* ((packer-name (intern (%concat-name "PACK" name)))
           (unpacker-macro-name (intern (%concat-name "WITH-UNPACKING" name)))
           (new-value (gensym "NEW-VALUE"))
           (tmp1 (gensym))
           (tmp2 (gensym))
           (tmp (gensym))
           (car-slots (extract-62bit-slots slot-descriptions))
           (car-revslots (reverse car-slots))
           (cdr-slots (extract-62bit-slots (nthcdr (length car-slots) slot-descriptions)))
           (cdr-revslots (reverse cdr-slots))
           (slots (append car-slots cdr-slots)))
      (assert (= (+ (length car-slots) (length cdr-slots))
                 (length slot-descriptions))
              () "Size restriction violated: each cell <= 62 bit, total size <= 124 bit")
      (unless (> (length cdr-slots) 0)
        (error "Whole size is too small. Use DEFINE-INTEGER-PACK instead."))
      (let ((car-width (+ (second (first car-revslots))
                          (third (first car-revslots))))
            (cdr-width (+ (second (first cdr-revslots))
                          (third (first cdr-revslots)))))
        `(progn
           (deftype ,name () '(cons (unsigned-byte ,car-width) (unsigned-byte ,cdr-width)))
           ;; define most positive integer for every slot as constant
           ,@(loop for (slot-name slot-size _) in slots
                   collect `(defconstant ,(intern (%concat+name+ "MAX" name slot-name))
                              (- (ash 1 ,slot-size) 1)))
           ;; setter and getter
           ,@(loop for slot in car-slots
                   for (slot-name slot-size slot-position) = slot
                   for accessor-name = (intern (%concat-name name slot-name))
                   append `((declaim (inline ,accessor-name (setf ,accessor-name)))
                            (defun ,accessor-name (,name)
                              (declare (type ,name ,name))
                              (ldb (byte ,slot-size ,slot-position)
                                   (the (unsigned-byte ,car-width) (car ,name))))
                            (defun (setf ,accessor-name) (,new-value ,name)
                              (declare (type ,name ,name))
                              (setf (ldb (byte ,slot-size ,slot-position)
                                         (the (unsigned-byte ,car-width) (car ,name)))
                                    ,new-value))))
           ,@(loop for slot in cdr-slots
                   for (slot-name slot-size slot-position) = slot
                   for accessor-name = (intern (%concat-name name slot-name))
                   append `((declaim (inline ,accessor-name (setf ,accessor-name)))
                            (defun ,accessor-name (,name)
                              (declare (type ,name ,name))
                              (ldb (byte ,slot-size ,slot-position)
                                   (the (unsigned-byte ,cdr-width) (cdr ,name))))
                            (defun (setf ,accessor-name) (,new-value ,name)
                              (declare (type ,name ,name))
                              (setf (ldb (byte ,slot-size ,slot-position)
                                         (the (unsigned-byte ,cdr-width) (cdr ,name)))
                                    ,new-value))))
           ;; constructor
           (declaim (inline ,packer-name))
           (defun ,packer-name ,(loop for slot in slots collect (car slot))
             (declare ,@(loop for (slot-name slot-size slot-position) in slots
                              collect `(type (unsigned-byte ,slot-size) ,slot-name)))
             (let ((,tmp1 ,(caar car-revslots))
                   (,tmp2 ,(caar cdr-revslots)))
               (declare (type (unsigned-byte ,car-width) ,tmp1)
                        (type (unsigned-byte ,cdr-width) ,tmp2))
               ,@(loop for (slot-name slot-size _) in (rest car-revslots)
                       collect `(setq ,tmp1 (logxor ,slot-name
                                                    (the (unsigned-byte ,car-width)
                                                         (ash ,tmp1 ,slot-size)))))
               ,@(loop for (slot-name slot-size _) in (rest cdr-revslots)
                       collect `(setq ,tmp2 (logxor ,slot-name
                                                    (the (unsigned-byte ,cdr-width)
                                                         (ash ,tmp2 ,slot-size)))))
               (cons ,tmp1 ,tmp2)))
           ;; destructuring-bind-style macro
           (defmacro ,unpacker-macro-name (vars ,name &body body)
             (check-type vars list)
             (assert (= (length vars) ,(length slots)))
             `(let* ((,',tmp ,,name)
                     (,',tmp1 (car ,',tmp))
                     (,',tmp2 (cdr ,',tmp)))
                (declare (type (unsigned-byte ,,car-width) ,',tmp1)
                         (type (unsigned-byte ,,cdr-width) ,',tmp2))
                (let* ,(loop for var in vars
                             for rest on ',car-slots
                             for (slot-name slot-size _) = (car rest)
                             collect `(,var
                                       (prog1 (the (unsigned-byte ,slot-size)
                                                   (ldb (byte ,slot-size 0) ,',tmp1))
                                         ,@(when (cdr rest)
                                             `((setq ,',tmp1 (ash ,',tmp1 ,(- slot-size))))))))
                  (let* ,(loop for var in (nthcdr ,(length car-slots) vars)
                               for rest on ',cdr-slots
                               for (slot-name slot-size _) = (car rest)
                               collect `(,var
                                         (prog1 (the (unsigned-byte ,slot-size)
                                                     (ldb (byte ,slot-size 0) ,',tmp2))
                                           ,@(when (cdr rest)
                                               `((setq ,',tmp2 (ash ,',tmp2 ,(- slot-size))))))))
                    ,@body)))))))))

;;;
;;; Implicit treap
;;; (treap with implicit key)
;;;

(defpackage :cp/implicit-treap
  (:use :cl :cp/integer-pack)
  (:export #:itreap #:itreap-p #:itreap-count #:itreap-accumulator
           #:make-itreap #:invalid-itreap-index-error #:itreap-ref
           #:itreap-split #:itreap-merge #:itreap-insert #:itreap-delete
           #:itreap-push #:itreap-pop #:itreap-map #:do-itreap
           #:itreap-fold #:itreap-fold-bisect-left #:itreap-update #:itreap-reverse
           #:itreap-bisect-left #:itreap-bisect-right #:itreap-insort
           #:pack-node #:node-x))
(in-package :cp/implicit-treap)

;; Note:
;; - An empty treap is NIL.

(define-cons-pack node (x 62) (y 20) (z 20))

(declaim (inline op))
(defun op (node1 node2)
  "Is a binary operator comprising a monoid."
  (with-unpacking-node (x1 y1 z1) node1
    (with-unpacking-node (x2 y2 z2) node2
      (pack-node (+ (the (unsigned-byte 60) (+ x1 x2))
                    (* z1 y2))
                 (+ y1 y2)
                 (+ z1 z2)))))

(sb-int:defconstant-eqx +op-identity+ (cons 0 0) #'equal
  "identity element w.r.t. OP")

(declaim (inline updater-op))
(defun updater-op (a b)
  "Is the operator to compute and update LAZY value. A is the current LAZY value
and B is operand."
  (declare (bit a b))
  (logxor a b))

(defconstant +updater-identity+ 0
  "identity element w.r.t. UPDATER-OP")

(declaim (inline modifier-op))
(defun modifier-op (acc delta size)
  "Is the operator to update ACCUMULATOR (and VALUE) based on LAZY value. ACC is
the current ACCUMULATOR value and X is the LAZY value. SIZE is the length of the
specified interval."
  (declare (ignorable size)
           (bit delta))
  (if (zerop delta)
      acc
      (with-unpacking-node (x y z) acc
        (let ((l (+ y z)))
          (pack-node (- (ash (* l (- l 1)) -1)
                        x
                        (ash (* y (- y 1)) -1)
                        (ash (* z (- z 1)) -1))
                     z
                     y)))))

(defstruct (itreap (:constructor %make-itreap (value priority &key left right (count 1) (accumulator value) (lazy +updater-identity+)))
                   (:copier nil)
                   (:conc-name %itreap-))
  (value +op-identity+ :type node)
  (accumulator +op-identity+ :type node)
  (lazy +updater-identity+ :type bit)
  (priority 0 :type (integer 0 #.most-positive-fixnum))
  (count 1 :type (integer 0 #.most-positive-fixnum)) ; size of (sub)treap
  (left nil :type (or null itreap))
  (right nil :type (or null itreap)))

(declaim (inline itreap-count))
(defun itreap-count (itreap)
  "Returns the number of the elements."
  (declare ((or null itreap) itreap))
  (if itreap
      (%itreap-count itreap)
      0))

(declaim (inline itreap-accumulator))
(defun itreap-accumulator (itreap)
  "Returns the sum (w.r.t. OP) of the whole ITREAP:
ITREAP[0]+ITREAP[1]+...+ITREAP[SIZE-1]."
  (declare ((or null itreap) itreap))
  (if itreap
      (%itreap-accumulator itreap)
      +op-identity+))

(declaim (inline update-count))
(defun update-count (itreap)
  (declare (itreap itreap))
  (setf (%itreap-count itreap)
        (+ 1
           (itreap-count (%itreap-left itreap))
           (itreap-count (%itreap-right itreap)))))

(declaim (inline update-accumulator))
(defun update-accumulator (itreap)
  (declare (itreap itreap))
  (setf (%itreap-accumulator itreap)
        (if (%itreap-left itreap)
            (if (%itreap-right itreap)
                (let ((mid (op (%itreap-accumulator (%itreap-left itreap))
                               (%itreap-value itreap))))
                  (declare (dynamic-extent mid))
                  (op mid (%itreap-accumulator (%itreap-right itreap))))
                (op (%itreap-accumulator (%itreap-left itreap))
                    (%itreap-value itreap)))
            (if (%itreap-right itreap)
                (op (%itreap-value itreap)
                    (%itreap-accumulator (%itreap-right itreap)))
                (%itreap-value itreap)))))

(declaim (inline force-up))
(defun force-up (itreap)
  "Propagates up the information from children."
  (declare (itreap itreap))
  (update-accumulator itreap))

(declaim (inline force-down))
(defun force-down (itreap)
  "Propagates down the information to children."
  (declare (itreap itreap))
  (unless (eql +updater-identity+ (%itreap-lazy itreap))
    (when (%itreap-left itreap)
      (setf (%itreap-lazy (%itreap-left itreap))
            (updater-op (%itreap-lazy (%itreap-left itreap))
                        (%itreap-lazy itreap)))
      (setf (%itreap-accumulator (%itreap-left itreap))
            (modifier-op (%itreap-accumulator (%itreap-left itreap))
                         (%itreap-lazy itreap)
                         (%itreap-count (%itreap-left itreap)))))
    (when (%itreap-right itreap)
      (setf (%itreap-lazy (%itreap-right itreap))
            (updater-op (%itreap-lazy (%itreap-right itreap))
                        (%itreap-lazy itreap)))
      (setf (%itreap-accumulator (%itreap-right itreap))
            (modifier-op (%itreap-accumulator (%itreap-right itreap))
                         (%itreap-lazy itreap)
                         (%itreap-count (%itreap-right itreap)))))
    (setf (%itreap-value itreap)
          (modifier-op (%itreap-value itreap)
                       (%itreap-lazy itreap)
                       1))
    (setf (%itreap-lazy itreap) +updater-identity+)))

(defun %heapify (top)
  "Properly swaps the priorities of the node and its two children."
  (declare (optimize (speed 3) (safety 0)))
  (when top
    (let ((high-priority-node top))
      (when (and (%itreap-left top)
                 (> (%itreap-priority (%itreap-left top))
                    (%itreap-priority high-priority-node)))
        (setq high-priority-node (%itreap-left top)))
      (when (and (%itreap-right top)
                 (> (%itreap-priority (%itreap-right top))
                    (%itreap-priority high-priority-node)))
        (setq high-priority-node (%itreap-right top)))
      (unless (eql high-priority-node top)
        (rotatef (%itreap-priority high-priority-node)
                 (%itreap-priority top))
        (%heapify high-priority-node)))))

(declaim (inline make-itreap))
(defun make-itreap (size &key initial-contents)
  "Makes a treap of SIZE in O(SIZE) time. Its values are filled with the
identity element unless INITIAL-CONTENTS are supplied."
  (declare ((or null vector) initial-contents))
  (labels ((build (l r)
             (declare ((integer 0 #.most-positive-fixnum) l r))
             (if (= l r)
                 nil
                 (let* ((mid (ash (+ l r) -1))
                        (node (%make-itreap (if initial-contents
                                                (aref initial-contents mid)
                                                +op-identity+)
                                            (random most-positive-fixnum))))
                   (setf (%itreap-left node) (build l mid))
                   (setf (%itreap-right node) (build (+ mid 1) r))
                   (%heapify node)
                   (update-accumulator node)
                   (update-count node)
                   node))))
    (build 0 size)))

(define-condition invalid-itreap-index-error (type-error)
  ((itreap :initarg :itreap :reader invalid-itreap-index-error-itreap)
   (index :initarg :index :reader invalid-itreap-index-error-index))
  (:report
   (lambda (condition stream)
     (let ((index (invalid-itreap-index-error-index condition)))
       (if (consp index)
           (format stream "Invalid range [~W, ~W) for itreap ~W."
                   (car index)
                   (cdr index)
                   (invalid-itreap-index-error-itreap condition))
           (format stream "Invalid index ~W for itreap ~W."
                   index
                   (invalid-itreap-index-error-itreap condition)))))))

(defun itreap-split (itreap index)
  "Destructively splits the ITREAP into two nodes [0, INDEX) and [INDEX, N),
where N is the number of the elements in ITREAP."
  (declare (optimize (speed 3))
           ((integer 0 #.most-positive-fixnum) index))
  (unless (<= index (itreap-count itreap))
    (error 'invalid-itreap-index-error :index index :itreap itreap))
  (labels ((recur (itreap ikey)
             (unless itreap
               (return-from itreap-split (values nil nil)))
             (force-down itreap)
             (let ((left-count (itreap-count (%itreap-left itreap))))
               (if (<= ikey left-count)
                   (multiple-value-bind (left right)
                       (itreap-split (%itreap-left itreap) ikey)
                     (setf (%itreap-left itreap) right)
                     (force-up itreap)
                     (values left itreap))
                   (multiple-value-bind (left right)
                       (itreap-split (%itreap-right itreap) (- ikey left-count 1))
                     (setf (%itreap-right itreap) left)
                     (force-up itreap)
                     (values itreap right))))))
    (recur itreap index)))

(defun itreap-merge (left right)
  "Destructively concatenates two ITREAPs."
  (declare (optimize (speed 3))
           ((or null itreap) left right))
  (cond ((null left) (when right (force-down right) (force-up right)) right)
        ((null right) (when left (force-down left) (force-up left)) left)
        (t (force-down left)
           (force-down right)
           (if (> (%itreap-priority left) (%itreap-priority right))
               (progn
                 (setf (%itreap-right left)
                       (itreap-merge (%itreap-right left) right))
                 (force-up left)
                 left)
               (progn
                 (setf (%itreap-left right)
                       (itreap-merge left (%itreap-left right)))
                 (force-up right)
                 right)))))

(defun itreap-insert (itreap index obj)
  "Destructively inserts OBJ into ITREAP and returns the resultant treap.

You cannot rely on the side effect. Use the returned value."
  (declare (optimize (speed 3))
           ((or null itreap) itreap)
           ((integer 0 #.most-positive-fixnum) index))
  (unless (<= index (itreap-count itreap))
    (error 'invalid-itreap-index-error :itreap itreap :index index))
  (let ((node (%make-itreap obj (random most-positive-fixnum))))
    (labels ((recur (itreap ikey)
               (declare ((integer 0 #.most-positive-fixnum) ikey))
               (unless itreap (return-from recur node))
               (force-down itreap)
               (if (> (%itreap-priority node) (%itreap-priority itreap))
                   (progn
                     (setf (values (%itreap-left node) (%itreap-right node))
                           (itreap-split itreap ikey))
                     (force-up node)
                     node)
                   (let ((left-count (itreap-count (%itreap-left itreap))))
                     (if (<= ikey left-count)
                         (setf (%itreap-left itreap)
                               (recur (%itreap-left itreap) ikey))
                         (setf (%itreap-right itreap)
                               (recur (%itreap-right itreap) (- ikey left-count 1))))
                     (force-up itreap)
                     itreap))))
      (recur itreap index))))

(defun itreap-delete (itreap index)
  "Destructively deletes the object at INDEX in ITREAP.

You cannot rely on the side effect. Use the returned value."
  (declare (optimize (speed 3))
           ((integer 0 #.most-positive-fixnum) index))
  (unless (< index (itreap-count itreap))
    (error 'invalid-itreap-index-error :itreap itreap :index index))
  (labels ((recur (itreap ikey)
             (declare ((integer 0 #.most-positive-fixnum) ikey))
             (force-down itreap)
             (let ((left-count (itreap-count (%itreap-left itreap))))
               (cond ((< ikey left-count)
                      (setf (%itreap-left itreap)
                            (recur (%itreap-left itreap) ikey))
                      (force-up itreap)
                      itreap)
                     ((> ikey left-count)
                      (setf (%itreap-right itreap)
                            (recur (%itreap-right itreap) (- ikey left-count 1)))
                      (force-up itreap)
                      itreap)
                     (t
                      (itreap-merge (%itreap-left itreap) (%itreap-right itreap)))))))
    (recur itreap index)))

(defmacro itreap-push (obj itreap pos)
  "Pushes OBJ to ITREAP at POS."
  `(setf ,itreap (itreap-insert ,itreap ,pos ,obj)))

(defmacro itreap-pop (itreap pos)
  "Returns the object at POS and deletes it."
  (let ((p (gensym)))
    `(let ((,p ,pos))
       (prog1 (itreap-ref ,itreap ,p)
         (setf ,itreap (itreap-delete ,itreap ,p))))))

(declaim (inline itreap-map))
(defun itreap-map (function itreap)
  "Successively applies FUNCTION to ITREAP[0], ..., ITREAP[SIZE-1]."
  (declare (function function))
  (labels ((recur (node)
             (when node
               (force-down node)
               (recur (%itreap-left node))
               (funcall function (%itreap-value node))
               (recur (%itreap-right node))
               (force-up node))))
    (recur itreap)))

(defmethod print-object ((object itreap) stream)
  (print-unreadable-object (object stream :type t)
    (let ((init t))
      (itreap-map (lambda (x)
                    (if init
                        (setq init nil)
                        (write-char #\  stream))
                    (write x :stream stream))
                  object))))

(defmacro do-itreap ((var itreap &optional result) &body body)
  "Successively binds ITREAP[0], ..., ITREAP[SIZE-1] to VAR and executes BODY
each time."
  `(block nil
     (itreap-map (lambda (,var) ,@body) ,itreap)
     ,result))

(defun itreap (&rest args)
  ;; NOTE: This function takes O(nlog(n)) time. Use MAKE-ITREAP for efficiency.
  (labels ((recur (list position itreap)
             (declare ((integer 0 #.most-positive-fixnum) position))
             (if (null list)
                 itreap
                 (recur (cdr list)
                        (1+ position)
                        (itreap-insert itreap position (car list))))))
    (recur args 0 nil)))

(declaim (inline itreap-ref))
(defun itreap-ref (itreap index)
  "Returns the element ITREAP[INDEX]."
  (declare ((integer 0 #.most-positive-fixnum) index))
  (unless (< index (itreap-count itreap))
    (error 'invalid-itreap-index-error :itreap itreap :index index))
  (labels ((%ref (itreap index)
             (declare ((integer 0 #.most-positive-fixnum) index))
             (force-down itreap)
             (prog1
                 (let ((left-count (itreap-count (%itreap-left itreap))))
                   (cond ((< index left-count)
                          (%ref (%itreap-left itreap) index))
                         ((> index left-count)
                          (%ref (%itreap-right itreap) (- index left-count 1)))
                         (t (%itreap-value itreap))))
               (force-up itreap))))
    (%ref itreap index)))

(declaim (inline (setf itreap-ref)))
(defun (setf itreap-ref) (new-value itreap index)
  "Sets ITREAP[INDEX] to the given value."
  (declare ((integer 0 #.most-positive-fixnum) index))
  (unless (< index (itreap-count itreap))
    (error 'invalid-itreap-index-error :itreap itreap :index index))
  (labels ((%set (itreap index)
             (declare ((integer 0 #.most-positive-fixnum) index))
             (force-down itreap)
             (prog1
                 (let ((left-count (itreap-count (%itreap-left itreap))))
                   (cond ((< index left-count)
                          (%set (%itreap-left itreap) index))
                         ((> index left-count)
                          (%set (%itreap-right itreap) (- index left-count 1)))
                         (t (setf (%itreap-value itreap) new-value))))
               (force-up itreap))))
    (%set itreap index)
    new-value))

;; (declaim (inline itreap-fold))
;; (defun itreap-fold (itreap l r)
;;   "Queries the `sum' (w.r.t. OP) of the interval [L, R)."
;;   (declare ((integer 0 #.most-positive-fixnum) l r))
;;   (unless (<= l r (itreap-count itreap))
;;     (error 'invalid-itreap-index-error :itreap itreap :index (cons l r)))
;;   (if (= l r)
;;       +op-identity+
;;       (multiple-value-bind (itreap-0-l itreap-l-n)
;;           (itreap-split itreap l)
;;         (multiple-value-bind (itreap-l-r itreap-r-n)
;;             (itreap-split itreap-l-n (- r l))
;;           (prog1 (%itreap-accumulator itreap-l-r)
;;             (itreap-merge itreap-0-l (itreap-merge itreap-l-r itreap-r-n)))))))

(declaim (inline itreap-fold))
(defun itreap-fold (itreap l r)
  "Queries the `sum' (w.r.t. OP) of the range ITREAP[L, R)."
  (declare ((integer 0 #.most-positive-fixnum) l r))
  (unless (<= l r (itreap-count itreap))
    (error 'invalid-itreap-index-error :itreap itreap :index (cons l r)))
  (labels
      ((recur (itreap l r)
         (declare ((integer 0 #.most-positive-fixnum) l r))
         (unless itreap
           (return-from recur +op-identity+))
         (force-down itreap)
         (prog1
             (if (and (zerop l) (= r (%itreap-count itreap)))
                 (itreap-accumulator itreap)
                 (let ((left-count (itreap-count (%itreap-left itreap))))
                   (if (<= l left-count)
                       (if (< left-count r)
                           ;; LEFT-COUNT is in [L, R)
                           (op (op (recur (%itreap-left itreap) l (min r left-count))
                                   (%itreap-value itreap))
                               (recur (%itreap-right itreap) 0 (- r left-count 1)))
                           ;; LEFT-COUNT is in [R, END)
                           (recur (%itreap-left itreap) l (min r left-count)))
                       ;; LEFT-COUNT is in [0, L)
                       (recur (%itreap-right itreap) (- l left-count 1) (- r left-count 1)))))
           (force-up itreap))))
    (recur itreap l r)))

;; FIXME: might be problematic when two priorities collide and START is not
;; zero. (It will be negligible from the viewpoint of probability, however.)
(declaim (inline itreap-fold-bisect-left))
(defun itreap-fold-bisect-left (itreap value order &optional (start 0))
  "Returns the smallest index that satisfies ITREAP[START]+ ITREAP[START+1] +
... + ITREAP[index] >= VALUE (if ORDER is #'<).

Note:
- This function deals with a **closed** interval.
- This function returns the length of ITREAP instead if ITREAP[START]+
... +ITREAP[length-1] < VALUE.
- The prefix sums of ITREAP, (ITREAP[START], ITREAP[START]+ITREAP[START+1], ...)
  must be monotone w.r.t. ORDER.
- ORDER must be a strict order"
  (declare ((integer 0 #.most-positive-fixnum) start))
  (multiple-value-bind (itreap-prefix itreap)
      (if (zerop start)
          (values nil itreap)
          (itreap-split itreap start))
    (labels
        ((recur (itreap offset prev-sum)
           (declare ((integer 0 #.most-positive-fixnum) offset)
                    #+sbcl (values (integer 0 #.most-positive-fixnum)))
           (unless itreap
             (return-from recur offset))
           (force-down itreap)
           (let ((sum prev-sum))
             (prog1
                 (cond ((not (funcall order
                                      (setq sum (op sum (itreap-accumulator (%itreap-left itreap))))
                                      value))
                        (recur (%itreap-left itreap) offset prev-sum))
                       ((not (funcall order
                                      (setq sum (op sum (%itreap-value itreap)))
                                      value))
                        (+ offset (itreap-count (%itreap-left itreap))))
                       (t
                        (recur (%itreap-right itreap)
                               (+ offset (itreap-count (%itreap-left itreap)) 1)
                               sum)))
               (force-up itreap)))))
      (prog1 (+ start (recur itreap 0 +op-identity+))
        (itreap-merge itreap-prefix itreap)))))

;; (declaim (inline itreap-update))
;; (defun itreap-update (itreap operand l r)
;;   "Updates ITREAP[i] := (OP ITREAP[i] OPERAND) for all i in [l, r)"
;;   (declare ((integer 0 #.most-positive-fixnum) l r))
;;   (unless (<= l r (itreap-count itreap))
;;     (error 'invalid-itreap-index-error :itreap itreap :index (cons l r)))
;;   (multiple-value-bind (itreap-0-l itreap-l-n)
;;       (itreap-split itreap l)
;;     (multiple-value-bind (itreap-l-r itreap-r-n)
;;         (itreap-split itreap-l-n (- r l))
;;       (when itreap-l-r
;;         (setf (%itreap-lazy itreap-l-r)
;;               (updater-op (%itreap-lazy itreap-l-r) operand)))
;;       (itreap-merge itreap-0-l (itreap-merge itreap-l-r itreap-r-n)))))

(declaim (inline itreap-update))
(defun itreap-update (itreap operand l r)
  "Updates ITREAP[i] := (OP ITREAP[i] OPERAND) for all i in [l, r)"
  (declare ((integer 0 #.most-positive-fixnum) l r))
  (unless (<= l r (itreap-count itreap))
    (error 'invalid-itreap-index-error :itreap itreap :index (cons l r)))
  (labels
      ((recur (itreap l r)
         (declare ((integer 0 #.most-positive-fixnum) l r))
         (when itreap
           (if (and (zerop l) (= r (%itreap-count itreap)))
               (progn
                 (setf (%itreap-lazy itreap)
                       (updater-op (%itreap-lazy itreap) operand))
                 (force-down itreap))
               (let ((left-count (itreap-count (%itreap-left itreap))))
                 (force-down itreap)
                 (if (<= l left-count)
                     (if (< left-count r)
                         ;; LEFT-COUNT is in [L, R)
                         (progn
                           (recur (%itreap-left itreap) l (min r left-count))
                           (setf (%itreap-value itreap)
                                 (modifier-op (%itreap-value itreap) operand 1))
                           (recur (%itreap-right itreap) 0 (- r left-count 1)))
                         ;; LEFT-COUNT is in [R, END)
                         (recur (%itreap-left itreap) l (min r left-count)))
                     ;; LEFT-COUNT is in [0, L)
                     (recur (%itreap-right itreap) (- l left-count 1) (- r left-count 1)))))
           (force-up itreap))))
    (recur itreap l r)
    itreap))

;;;
;;; Utilities for sorted treap
;;;

(declaim (inline itreap-bisect-left)
         (ftype (function * (values (integer 0 #.most-positive-fixnum) &optional)) itreap-bisect-left))
(defun itreap-bisect-left (itreap threshold order)
  "Takes a **sorted** treap and returns the smallest index that satisfies
ITREAP[index] >= THRESHOLD, where >= is the complement of ORDER. Returns the
size of ITREAP if ITREAP[length-1] < THRESHOLD. The time complexity is
O(log(n))."
  (labels ((recur (count itreap)
             (declare ((integer 0 #.most-positive-fixnum) count))
             (cond ((null itreap) nil)
                   ((funcall order (%itreap-value itreap) threshold)
                    (recur count (%itreap-right itreap)))
                   (t
                    (let ((left-count (- count (itreap-count (%itreap-right itreap)) 1)))
                      (or (recur left-count (%itreap-left itreap))
                          left-count))))))
    (or (recur (itreap-count itreap) itreap)
        (itreap-count itreap))))

(declaim (inline itreap-bisect-right)
         (ftype (function * (values (integer 0 #.most-positive-fixnum) &optional)) itreap-bisect-right))
(defun itreap-bisect-right (itreap threshold order)
  "Takes a **sorted** treap and returns the smallest index that satisfies
THRESHOLD < ITREAP[index], where < is ORDER. Returns the size of ITREAP if
ITREAP[length-1] <= THRESHOLD. The time complexity is O(log(n))."
  (labels ((recur (count itreap)
             (declare ((integer 0 #.most-positive-fixnum) count))
             (cond ((null itreap) nil)
                   ((funcall order threshold (%itreap-value itreap))
                    (let ((left-count (- count (itreap-count (%itreap-right itreap)) 1)))
                      (or (recur left-count (%itreap-left itreap))
                          left-count)))
                   (t
                    (recur count (%itreap-right itreap))))))
    (or (recur (itreap-count itreap) itreap)
        (itreap-count itreap))))

(declaim (inline itreap-insort))
(defun itreap-insort (itreap obj order)
  "Does insertion to the sorted treap."
  (let ((pos (itreap-bisect-left itreap obj order)))
    (itreap-insert itreap pos obj)))

;; BEGIN_USE_PACKAGE
(eval-when (:compile-toplevel :load-toplevel :execute)
  (use-package :cp/implicit-treap :cl-user))
(eval-when (:compile-toplevel :load-toplevel :execute)
  (use-package :cp/integer-pack :cl-user))
(eval-when (:compile-toplevel :load-toplevel :execute)
  (use-package :cp/read-fixnum :cl-user))
(in-package :cl-user)

;;;
;;; Body
;;;

(defun main ()
  (declare #.cl-user::opt)
  (let* ((n (read))
         (q (read))
         (inits (make-array n :element-type 'list)))
    (declare (uint31 n q))
    (dotimes (i n)
      (setf (aref inits i)
            (if (zerop (read-fixnum))
                (pack-node 0 1 0)
                (pack-node 0 0 1))))
    (let ((dp (make-itreap n :initial-contents inits)))
      (write-string
       (with-output-to-string (*standard-output* nil :element-type 'base-char)
         (dotimes (_ q)
           (let ((type (read-fixnum))
                 (l (- (read-fixnum) 1))
                 (r (read-fixnum)))
             (ecase type
               (1 (setq dp (itreap-update dp 1 l r)))
               (2 (println (node-x (itreap-fold dp l r))))))))))))

#-swank (main)

;;;
;;; Test and benchmark
;;;

#+swank
(defun get-clipbrd ()
  (with-output-to-string (out)
    #+os-windows (run-program "powershell.exe" '("-Command" "Get-Clipboard") :output out :search t)
    #+os-unix (run-program "xsel" '("-b" "-o") :output out :search t)))

#+swank (defparameter *this-pathname* (uiop:current-lisp-file-pathname))
#+swank (defparameter *dat-pathname* (uiop:merge-pathnames* "test.dat" *this-pathname*))

#+swank
(defun run (&optional thing (out *standard-output*) function)
  "THING := null | string | symbol | pathname

null: run #'MAIN using the text on clipboard as input.
string: run #'MAIN using the string as input.
symbol: alias of FIVEAM:RUN!.
pathname: run #'MAIN using the text file as input."
  (let* ((*standard-output* (or out (make-string-output-stream)))
         (res (etypecase thing
                (null
                 (with-input-from-string (*standard-input* (delete #\Return (get-clipbrd)))
                   (funcall (or function #'main))))
                (string
                 (with-input-from-string (*standard-input* (delete #\Return thing))
                   (funcall (or function #'main))))
                (symbol (5am:run! thing))
                (pathname
                 (with-open-file (*standard-input* thing)
                   (funcall (or function #'main)))))))
    (if out res (get-output-stream-string *standard-output*))))

#+swank
(defun gen-dat ()
  (uiop:with-output-file (out *dat-pathname* :if-exists :supersede)
    (format out "")))

(defun gen-str ()
  (with-output-to-string (out)
    (format out "100 100~%")
    (dotimes (_ 100)
      (println (random 2) out))
    (dotimes (_ 100)
      (let ((l (+ 1 (random 100)))
            (r (+ 1 (random 100))))
        (when (> l r)
          (rotatef l r))
        (format out "~D ~D ~D~%"
                (+ 1 (random 2))
                l r)))))

(defun compare ()
  (loop for i from 0
        for input = (gen-str)
        for out1 = (with-output-to-string (*standard-output*)
                     (with-input-from-string (*standard-input* input)
                       (main)))
        for out2 = (with-output-to-string (*standard-output*)
                     (with-input-from-string (*standard-input* input)
                       (main-small)))
        when (zerop (mod i 1000))
        do (print i)
        unless (equal out1 out2)
        do (return input)))
#+swank
(defun bench (&optional (out (make-broadcast-stream)))
  (time (run *dat-pathname* out)))

#-swank
(eval-when (:compile-toplevel)
  (when (and (boundp 'sb-c::*compiler-warning-count*)
             (> sb-c::*compiler-warning-count* 0))
    (sb-ext:quit :unix-status 1)))

;; To run: (5am:run! :sample)
#+swank
(it.bese.fiveam:test :sample
  (it.bese.fiveam:is
   (equal "2
0
1
"
          (run "5 5
0 1 0 0 1
2 1 5
1 3 4
2 2 5
1 1 3
2 1 2
" nil))))


Measured memory_bytes: 111092