├── .gitignore ├── README.md └── src ├── cl-stl-algo-base.lisp ├── cl-stl-algorithm.lisp ├── cl-stl-array.lisp ├── cl-stl-base.lisp ├── cl-stl-cl-conslist.lisp ├── cl-stl-cl-vector.lisp ├── cl-stl-deque.lisp ├── cl-stl-exceptions.lisp ├── cl-stl-forward-list.lisp ├── cl-stl-functional.lisp ├── cl-stl-initializer-list.lisp ├── cl-stl-iterator.lisp ├── cl-stl-list.lisp ├── cl-stl-map.lisp ├── cl-stl-move-iterator.lisp ├── cl-stl-multimap.lisp ├── cl-stl-multiset.lisp ├── cl-stl-numeric.lisp ├── cl-stl-priority-queue.lisp ├── cl-stl-queue.lisp ├── cl-stl-rbnode.lisp ├── cl-stl-rbtree.lisp ├── cl-stl-set.lisp ├── cl-stl-stack.lisp ├── cl-stl-tuple.lisp ├── cl-stl-user.asd ├── cl-stl-utility.lisp ├── cl-stl-vector.lisp ├── cl-stl.asd └── user-package.lisp /.gitignore: -------------------------------------------------------------------------------- 1 | *.FASL 2 | *.fasl 3 | *.lisp-temp 4 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # CL-STL 2 | Common Lisp library like C++ STL ( Standard Template Library ). 3 | 4 | #### This library depends on... 5 | 6 | * closer-mop 7 | * CL-OVERLOAD 8 | * CL-OPERATOR 9 | 10 | 11 | #### CL-STL provides... 12 | 13 | * Containers ( vector, deque, list, forward-list, map, set, etc. ) 14 | * Algorithms 15 | * Functors 16 | * Iterators 17 | * etc. 18 | 19 | #### Not provides... 20 | 21 | * Hash containers ( now writing... ) 22 | * Stream features 23 | * etc. 24 | 25 | 26 | #### Copyright 27 | 28 | Copyright (c) 2015-2018 Show MATSUOKA. 29 | 30 | 31 | #### License 32 | 33 | CL-STL is licensed under the LLGPL License. 34 | 35 | 36 | 37 | ...sorry, document is not yet ( writing ). 38 | 39 | -------------------------------------------------------------------------------- /src/cl-stl-algo-base.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-stl) 2 | 3 | (defmacro __algo-make-cns-iterator (base cell) 4 | (let ((g-itr (gensym))) 5 | `(let ((,g-itr (clone ,base))) 6 | (setf (__cons-itr-cons ,g-itr) ,cell) 7 | ,g-itr))) 8 | 9 | (defmacro __algo-make-vct-iterator (base index) 10 | (let ((g-itr (gensym))) 11 | `(let ((,g-itr (clone ,base))) 12 | (setf (opr::vec-ptr-index ,g-itr) ,index) 13 | ,g-itr))) 14 | 15 | -------------------------------------------------------------------------------- /src/cl-stl-array.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-stl) 2 | 3 | ;;-------------------------------------------------------------------- 4 | ;; 5 | ;; class difinition 6 | ;; 7 | ;;-------------------------------------------------------------------- 8 | #-cl-stl-0x98 9 | (eval-when (:compile-toplevel :load-toplevel :execute) 10 | (defclass stl:array (randomaccess_container) 11 | ((buffer :type :simple-vector 12 | :initform nil 13 | :initarg :buffer 14 | :accessor __inner-array)))) 15 | 16 | #-cl-stl-0x98 17 | (defclass array_const_iterator (const-vector-pointer randomaccess_iterator) ()) 18 | #-cl-stl-0x98 19 | (defclass array_iterator (vector-pointer array_const_iterator) ()) 20 | #-cl-stl-0x98 21 | (defclass array_const_reverse_iterator (const-reverse-vector-pointer randomaccess_iterator) ()) 22 | #-cl-stl-0x98 23 | (defclass array_reverse_iterator (reverse-vector-pointer array_const_reverse_iterator) ()) 24 | 25 | ;;-------------------------------------------------------------------- 26 | ;; 27 | ;; internal utilities 28 | ;; 29 | ;;-------------------------------------------------------------------- 30 | #-cl-stl-0x98 31 | (defmacro __array-error-when-empty (buf-sym op) 32 | (check-type buf-sym symbol) 33 | `(when (zerop (length ,buf-sym)) 34 | (error 'undefined-behavior :what ,(format nil "~A for empty array." op)))) 35 | 36 | #-cl-stl-0x98 37 | (defmacro __array-check-index (buf-sym idx-sym) 38 | (check-type buf-sym symbol) 39 | (check-type idx-sym symbol) 40 | (let ((g-size (gensym "SIZE"))) 41 | `(let ((,g-size (if (null ,buf-sym) 42 | 0 43 | (length ,buf-sym)))) 44 | (when (or (< ,idx-sym 0) (<= ,g-size ,idx-sym)) 45 | (error 'out_of_range :what ,(format nil "index ~A is out of range." idx-sym)))))) 46 | 47 | #-cl-stl-0x98 48 | (defun __create-array (size &optional (initial-element nil)) 49 | (make-instance 'stl:array 50 | :buffer (if (zerop size) 51 | (make-array 0) 52 | (make-array size :initial-element initial-element)))) 53 | 54 | 55 | 56 | ;;------------------------------------------------------------------------------ 57 | ;; 58 | ;; constructors 59 | ;; 60 | ;;------------------------------------------------------------------------------ 61 | #-cl-stl-0x98 62 | (declare-constructor array (1 2)) 63 | 64 | ; default constructor 65 | #-cl-stl-0x98 66 | (define-constructor array ((arg integer)) 67 | (__create-array arg)) 68 | 69 | ; copy constructor 70 | #-cl-stl-0x98 71 | (define-constructor array ((arg1 integer) (arg2 stl:array)) 72 | (let* ((src-buf (__inner-array arg2)) 73 | (size (length src-buf))) 74 | (if (/= arg1 size) 75 | (error 'type-mismatch :what (format nil "Can't convert array<~A> to array<~A>." size arg1)) 76 | (if (zerop size) 77 | (__create-array arg1) 78 | (let ((index 0) 79 | (dst-buf (make-array arg1 :initial-element nil))) 80 | (locally (declare (optimize speed)) 81 | (declare (type fixnum size index)) 82 | (declare (type simple-vector src-buf dst-buf)) 83 | (do () 84 | ((= index size) nil) 85 | (_= (svref dst-buf index) (svref src-buf index)) 86 | (incf index))) 87 | (make-instance 'stl:array :buffer dst-buf)))))) 88 | 89 | ; constructor with initializer list 90 | #-cl-stl-0x98 91 | (locally (declare (optimize speed)) 92 | (define-constructor array ((arg1 integer) (arg2 initializer_list)) 93 | (declare (type fixnum arg1)) 94 | (if (< arg1 (the fixnum (size arg2))) 95 | (error 'type-mismatch :what (format nil "Too many initializer for array<~A>." arg1)) 96 | (let* ((obj (__create-array arg1)) 97 | (cnt arg1) 98 | (dst (__inner-array obj)) 99 | (src (__initlist-data arg2))) 100 | (declare (type fixnum cnt)) 101 | (declare (type simple-vector dst src) ) 102 | (when (< (length src) cnt) 103 | (setf cnt (length src))) 104 | (do ((idx 0 (1+ idx))) 105 | ((<= cnt idx) obj) 106 | (declare (type fixnum idx)) 107 | (_= (svref dst idx) (svref src idx))))))) 108 | 109 | 110 | ; copy constructor 111 | #-cl-stl-0x98 112 | (defmethod operator_clone ((container stl:array)) 113 | (let ((src-buf (__inner-array container))) 114 | (if (null src-buf) 115 | (make-instance 'stl:array) 116 | (let* ((size (length src-buf)) 117 | (index 0) 118 | (dst-buf (make-array size :initial-element nil))) 119 | (locally (declare (optimize speed)) 120 | (declare (type fixnum size index)) 121 | (declare (type simple-vector src-buf dst-buf)) 122 | (do () 123 | ((= index size) nil) 124 | (_= (svref dst-buf index) (svref src-buf index)) 125 | (incf index))) 126 | (make-instance 'stl:array :buffer dst-buf))))) 127 | 128 | ;;------------------------------------------------------------------------------ 129 | ;; 130 | ;; methods 131 | ;; 132 | ;;------------------------------------------------------------------------------ 133 | 134 | ;----------------------------------------------------- 135 | ; assignment 136 | ;----------------------------------------------------- 137 | #-cl-stl-0x98 138 | (locally (declare (optimize speed)) 139 | (defmethod operator_= ((cont1 stl:array) (cont2 stl:array)) 140 | (if (eq cont1 cont2) 141 | cont1 142 | (let* ((buf1 (__inner-array cont1)) 143 | (buf2 (__inner-array cont2)) 144 | (cnt1 (if (null buf1) 0 (length buf1))) 145 | (cnt2 (if (null buf2) 0 (length buf2)))) 146 | (declare (type simple-vector buf1 buf2)) 147 | (declare (type fixnum cnt1 cnt2)) 148 | (if (/= cnt1 cnt2) 149 | (error 'type-mismatch :what "Type mismatch in assign of array.") 150 | (do ((idx 0 (1+ idx))) 151 | ((= idx cnt1) cont1) 152 | (declare (type fixnum idx)) 153 | (_= (svref buf1 idx) (svref buf2 idx)))))))) 154 | 155 | #-cl-stl-0x98 156 | (locally (declare (optimize speed)) 157 | (defmethod operator_= ((cont stl:array) (il initializer_list)) 158 | (let* ((dst (__inner-array cont)) 159 | (dst-cnt (length dst)) 160 | (src (__initlist-data il)) 161 | (cnt (length src))) 162 | (declare (type fixnum dst-cnt cnt)) 163 | (declare (type simple-vector dst src)) 164 | (if (< dst-cnt cnt) 165 | (error 'type-mismatch :what (format nil "Too many initializer for array<~A>." dst-cnt)) 166 | (let ((idx 0)) 167 | (declare (type fixnum idx)) 168 | (do () 169 | ((= idx cnt) nil) 170 | (_= (svref dst idx) (svref src idx)) 171 | (incf idx)) 172 | (do () 173 | ((= idx dst-cnt) cont) 174 | (setf (svref dst idx) nil) 175 | (incf idx))))))) 176 | 177 | #-cl-stl-0x98 178 | (locally (declare (optimize speed)) 179 | (defmethod operator_move ((cont1 stl:array) (cont2 stl:array)) 180 | (if (eq cont1 cont2) 181 | (values cont1 cont2) 182 | (if (/= (the fixnum (size cont1)) 183 | (the fixnum (size cont2))) 184 | (error 'type-mismatch :what "Type mismatch in move of array.") 185 | (let* ((tmp (__inner-array cont1)) 186 | (cnt (length tmp))) 187 | (declare (type simple-vector tmp)) 188 | (declare (type fixnum cnt)) 189 | (setf (__inner-array cont1) (__inner-array cont2)) 190 | (setf (__inner-array cont2) tmp) 191 | (do ((idx 0 (incf idx))) 192 | ((= cnt idx) (values cont1 cont2)) 193 | (setf (svref tmp idx) nil))))))) 194 | 195 | 196 | 197 | ;----------------------------------------------------- 198 | ; iterators 199 | ;----------------------------------------------------- 200 | #-cl-stl-0x98 201 | (defmethod begin ((cont stl:array)) 202 | (make-instance 'array_iterator :buffer (__inner-array cont) :index 0)) 203 | 204 | #-cl-stl-0x98 205 | (defmethod end ((cont stl:array)) 206 | (let ((buf (__inner-array cont))) 207 | (make-instance 'array_iterator :buffer buf 208 | :index (length buf)))) 209 | 210 | #-cl-stl-0x98 211 | (defmethod rbegin ((cont stl:array)) 212 | (let ((buf (__inner-array cont))) 213 | (make-instance 'array_reverse_iterator 214 | :buffer buf :index (1- (length buf))))) 215 | 216 | #-cl-stl-0x98 217 | (defmethod rend ((cont stl:array)) 218 | (let ((buf (__inner-array cont))) 219 | (make-instance 'array_reverse_iterator :buffer buf :index -1))) 220 | 221 | #-cl-stl-0x98 222 | (defmethod cbegin ((cont stl:array)) 223 | (make-instance 'array_const_iterator 224 | :buffer (__inner-array cont) :index 0)) 225 | 226 | #-cl-stl-0x98 227 | (defmethod cend ((cont stl:array)) 228 | (let ((buf (__inner-array cont))) 229 | (make-instance 'array_const_iterator 230 | :buffer buf :index (length buf)))) 231 | 232 | #-cl-stl-0x98 233 | (defmethod crbegin ((cont stl:array)) 234 | (let ((buf (__inner-array cont))) 235 | (make-instance 'array_const_reverse_iterator 236 | :buffer buf :index (1- (length buf))))) 237 | 238 | #-cl-stl-0x98 239 | (defmethod crend ((cont stl:array)) 240 | (let ((buf (__inner-array cont))) 241 | (make-instance 'array_const_reverse_iterator 242 | :buffer buf :index -1))) 243 | 244 | ;----------------------------------------------------- 245 | ; capacity 246 | ;----------------------------------------------------- 247 | #-cl-stl-0x98 248 | (defmethod empty ((cont stl:array)) 249 | (zerop (length (__inner-array cont)))) 250 | 251 | #-cl-stl-0x98 252 | (defmethod size ((cont stl:array)) 253 | (length (__inner-array cont))) 254 | 255 | #-cl-stl-0x98 256 | (defmethod max_size ((cont stl:array)) 257 | most-positive-fixnum) 258 | 259 | ;----------------------------------------------------- 260 | ; element access 261 | ;----------------------------------------------------- 262 | #-cl-stl-0x98 263 | (defmethod front ((cont stl:array)) 264 | (let ((buf (__inner-array cont))) 265 | (__array-error-when-empty buf "front") 266 | (svref buf 0))) 267 | 268 | #-cl-stl-0x98 269 | (defmethod (setf front) (val (cont stl:array)) 270 | (let ((buf (__inner-array cont))) 271 | (__array-error-when-empty buf "front") 272 | (_= (svref buf 0) val))) 273 | 274 | #-cl-stl-0x98 275 | (defmethod back ((cont stl:array)) 276 | (let ((buf (__inner-array cont))) 277 | (__array-error-when-empty buf "back") 278 | (svref buf (1- (length buf))))) 279 | 280 | #-cl-stl-0x98 281 | (defmethod (setf back) (val (cont stl:array)) 282 | (let ((buf (__inner-array cont))) 283 | (__array-error-when-empty buf "back") 284 | (_= (svref buf (1- (length buf))) val))) 285 | 286 | #-cl-stl-0x98 287 | (defmethod at ((cont stl:array) (idx integer)) 288 | (let ((buf (__inner-array cont))) 289 | (__array-check-index buf idx) 290 | (svref buf idx))) 291 | 292 | #-cl-stl-0x98 293 | (defmethod (setf at) (val (cont stl:array) (idx integer)) 294 | (let ((buf (__inner-array cont))) 295 | (__array-check-index buf idx) 296 | (_= (svref buf idx) val))) 297 | 298 | #-cl-stl-0x98 299 | (defmethod operator_[] ((cont stl:array) (idx integer)) 300 | (svref (__inner-array cont) idx)) 301 | 302 | #-cl-stl-0x98 303 | (defmethod (setf operator_[]) (val (cont stl:array) (idx integer)) 304 | (_= (svref (__inner-array cont) idx) val)) 305 | 306 | #-cl-stl-0x98 307 | (defmethod operator_& ((cont stl:array) (idx integer)) 308 | (let* ((buf (__inner-array cont)) 309 | (cnt (length buf))) 310 | (if (zerop cnt) 311 | (error 'undefined-behavior :what "operator_& for empty array.") 312 | (if (or (< idx 0) (< cnt idx)) 313 | (error 'out_of_range :what (format nil "index ~A is out of range." idx)) 314 | (make-instance 'vector-pointer :buffer buf :index idx))))) 315 | 316 | #-cl-stl-0x98 317 | (defmethod operator_const& ((cont stl:array) (idx integer)) 318 | (let* ((buf (__inner-array cont)) 319 | (cnt (length buf))) 320 | (if (zerop cnt) 321 | (error 'undefined-behavior :what "operator_& for empty array.") 322 | (if (or (< idx 0) (< cnt idx)) 323 | (error 'out_of_range :what (format nil "index ~A is out of range." idx)) 324 | (make-instance 'const-vector-pointer :buffer buf :index idx))))) 325 | 326 | #-cl-stl-0x98 327 | (defmethod data ((container stl:array)) 328 | (__inner-array container)) 329 | 330 | ;----------------------------------------------------- 331 | ; modifiers 332 | ;----------------------------------------------------- 333 | #-cl-stl-0x98 334 | (defmethod-overload swap ((cont1 stl:array) (cont2 stl:array)) 335 | (let ((buf1 (__inner-array cont1)) 336 | (buf2 (__inner-array cont2))) 337 | (unless (= (length buf1) (length buf2)) 338 | (error 'type-mismatch :what "Type mismatch in swap of array.")) 339 | (setf (__inner-array cont1) buf2) 340 | (setf (__inner-array cont2) buf1)) 341 | (values cont1 cont2)) 342 | 343 | ;----------------------------------------------------- 344 | ; specific operations 345 | ;----------------------------------------------------- 346 | #-cl-stl-0x98 347 | (locally (declare (optimize speed)) 348 | (defmethod-overload fill ((container stl:array) value) 349 | (let* ((buf (__inner-array container)) 350 | (idx 0) 351 | (cnt (length buf))) 352 | (declare (type fixnum idx cnt)) 353 | (declare (type simple-vector buf)) 354 | (do () 355 | ((= idx cnt) nil) 356 | (_= (svref buf idx) value) 357 | (incf idx))))) 358 | 359 | ;----------------------------------------------------- 360 | ; compare 361 | ;----------------------------------------------------- 362 | #-cl-stl-0x98 363 | (locally (declare (optimize speed)) 364 | (labels ((__container-equal (cont1 cont2) 365 | (if (eq cont1 cont2) 366 | t 367 | (let* ((buf1 (__inner-array cont1)) 368 | (buf2 (__inner-array cont2)) 369 | (cnt1 (if (null buf1) 0 (length buf1))) 370 | (cnt2 (if (null buf2) 0 (length buf2)))) 371 | (declare (type simple-vector buf1 buf2)) 372 | (declare (type fixnum cnt1 cnt2)) 373 | (if (/= cnt1 cnt2) 374 | (error 'type-mismatch :what "Type mismatch in compare of array.") 375 | (do ((idx 0)) 376 | ((= idx cnt1) t) 377 | (declare (type fixnum idx)) 378 | (unless (_== (svref buf1 idx) (svref buf2 idx)) 379 | (return-from __container-equal nil)) 380 | (incf idx))))))) 381 | 382 | (defmethod operator_== ((cont1 stl:array) (cont2 stl:array)) 383 | (__container-equal cont1 cont2)) 384 | 385 | (defmethod operator_/= ((cont1 stl:array) (cont2 stl:array)) 386 | (not (__container-equal cont1 cont2))))) 387 | 388 | 389 | 390 | #-cl-stl-0x98 391 | (locally (declare (optimize speed)) 392 | (labels ((__container-compare (cont1 cont2) 393 | (if (eq cont1 cont2) 394 | 0 395 | (let* ((buf1 (__inner-array cont1)) 396 | (buf2 (__inner-array cont2)) 397 | (cnt1 (if (null buf1) 0 (length buf1))) 398 | (cnt2 (if (null buf2) 0 (length buf2)))) 399 | (declare (type simple-vector buf1 buf2)) 400 | (declare (type fixnum cnt1 cnt2)) 401 | (if (/= cnt1 cnt2) 402 | (error 'type-mismatch :what "Type mismatch in compare of array.") 403 | (do ((idx 0 (incf idx))) 404 | ((= idx cnt1) 0) 405 | (declare (type fixnum idx)) 406 | (if (_< (svref buf1 idx) (svref buf2 idx)) 407 | (return-from __container-compare -1) 408 | (when (_< (svref buf2 idx) (svref buf1 idx)) 409 | (return-from __container-compare 1))))))))) 410 | 411 | (defmethod operator_< ((cont1 stl:array) (cont2 stl:array)) 412 | (< (__container-compare cont1 cont2) 0)) 413 | 414 | (defmethod operator_<= ((cont1 stl:array) (cont2 stl:array)) 415 | (<= (__container-compare cont1 cont2) 0)) 416 | 417 | (defmethod operator_> ((cont1 stl:array) (cont2 stl:array)) 418 | (< 0 (__container-compare cont1 cont2))) 419 | 420 | (defmethod operator_>= ((cont1 stl:array) (cont2 stl:array)) 421 | (<= 0 (__container-compare cont1 cont2))))) 422 | 423 | 424 | ;----------------------------------------------------- 425 | ; enumeration 426 | ;----------------------------------------------------- 427 | #-cl-stl-0x98 428 | (locally (declare (optimize speed)) 429 | (defmethod-overload for ((cont stl:array) func) 430 | ;MEMO : func is always lambda function ( see stl:for ). 431 | (declare (type cl:function func)) 432 | (let ((buf (__inner-array cont))) 433 | (when buf 434 | (locally (declare (type simple-vector buf)) 435 | (do ((idx 0 (incf idx)) 436 | (cnt (length buf))) 437 | ((= idx cnt) nil) 438 | (declare (type fixnum idx cnt)) 439 | (funcall func (svref buf idx)))))))) 440 | 441 | 442 | ;;------------------------------------------------------------------------------ 443 | ;; 444 | ;; methods for array_const_iterator 445 | ;; 446 | ;;------------------------------------------------------------------------------ 447 | #-cl-stl-0x98 448 | (defmethod operator_= ((itr1 array_const_iterator) (itr2 array_const_iterator)) 449 | (__error-when-const-removing-assign itr1 array_iterator 450 | itr2 array_const_iterator) 451 | (setf (opr::vec-ptr-buffer itr1) (opr::vec-ptr-buffer itr2)) 452 | (setf (opr::vec-ptr-index itr1) (opr::vec-ptr-index itr2)) 453 | itr1) 454 | 455 | #-cl-stl-0x98 456 | (defmethod operator_clone ((itr array_const_iterator)) 457 | (make-instance 'array_const_iterator 458 | :buffer (opr::vec-ptr-buffer itr) 459 | :index (opr::vec-ptr-index itr))) 460 | 461 | #-cl-stl-0x98 462 | (defmethod operator_+ ((itr array_const_iterator) (n integer)) 463 | (make-instance 'array_const_iterator 464 | :buffer (opr::vec-ptr-buffer itr) 465 | :index (+ n (opr::vec-ptr-index itr)))) 466 | 467 | #-cl-stl-0x98 468 | (defmethod operator_- ((itr array_const_iterator) (n integer)) 469 | (make-instance 'array_const_iterator 470 | :buffer (opr::vec-ptr-buffer itr) 471 | :index (- (opr::vec-ptr-index itr) n))) 472 | 473 | ;; creating reverse iterator. 474 | #-cl-stl-0x98 475 | (define-constructor reverse_iterator ((itr array_const_iterator)) 476 | (make-instance 'array_const_reverse_iterator 477 | :buffer (opr::vec-ptr-buffer itr) 478 | :index (1- (opr::vec-ptr-index itr)))) 479 | 480 | 481 | 482 | ;;------------------------------------------------------------------------------ 483 | ;; 484 | ;; methods for array_iterator 485 | ;; 486 | ;;------------------------------------------------------------------------------ 487 | #-cl-stl-0x98 488 | (defmethod operator_clone ((itr array_iterator)) 489 | (make-instance 'array_iterator 490 | :buffer (opr::vec-ptr-buffer itr) 491 | :index (opr::vec-ptr-index itr))) 492 | 493 | #-cl-stl-0x98 494 | (defmethod operator_cast ((itr array_iterator) 495 | (typename (eql 'array_const_iterator))) 496 | (__check-exact-type-of-cast itr 'array_iterator 'array_const_iterator) 497 | (make-instance 'array_const_iterator 498 | :buffer (opr::vec-ptr-buffer itr) 499 | :index (opr::vec-ptr-index itr))) 500 | 501 | #-cl-stl-0x98 502 | (defmethod operator_+ ((itr array_iterator) (n integer)) 503 | (make-instance 'array_iterator 504 | :buffer (opr::vec-ptr-buffer itr) 505 | :index (+ n (opr::vec-ptr-index itr)))) 506 | 507 | #-cl-stl-0x98 508 | (defmethod operator_- ((itr array_iterator) (n integer)) 509 | (make-instance 'array_iterator 510 | :buffer (opr::vec-ptr-buffer itr) 511 | :index (- (opr::vec-ptr-index itr) n))) 512 | 513 | ;; creating reverse iterator. 514 | #-cl-stl-0x98 515 | (define-constructor reverse_iterator ((itr array_iterator)) 516 | (make-instance 'array_reverse_iterator 517 | :buffer (opr::vec-ptr-buffer itr) 518 | :index (1- (opr::vec-ptr-index itr)))) 519 | 520 | 521 | ;;------------------------------------------------------------------------------ 522 | ;; 523 | ;; methods for array_const_reverse_iterator 524 | ;; 525 | ;;------------------------------------------------------------------------------ 526 | #-cl-stl-0x98 527 | (defmethod operator_= ((itr1 array_const_reverse_iterator) 528 | (itr2 array_const_reverse_iterator)) 529 | (__error-when-const-removing-assign itr1 array_reverse_iterator 530 | itr2 array_const_reverse_iterator) 531 | (setf (opr::rev-vec-ptr-buffer itr1) (opr::rev-vec-ptr-buffer itr2)) 532 | (setf (opr::rev-vec-ptr-index itr1) (opr::rev-vec-ptr-index itr2)) 533 | itr1) 534 | 535 | #-cl-stl-0x98 536 | (defmethod operator_clone ((itr array_const_reverse_iterator)) 537 | (make-instance 'array_const_reverse_iterator 538 | :buffer (opr::rev-vec-ptr-buffer itr) 539 | :index (opr::rev-vec-ptr-index itr))) 540 | 541 | #-cl-stl-0x98 542 | (defmethod operator_+ ((itr array_const_reverse_iterator) (n integer)) 543 | (make-instance 'array_const_reverse_iterator 544 | :buffer (opr::rev-vec-ptr-buffer itr) 545 | :index (- (opr::rev-vec-ptr-index itr) n))) 546 | 547 | #-cl-stl-0x98 548 | (defmethod operator_- ((itr array_const_reverse_iterator) (n integer)) 549 | (make-instance 'array_const_reverse_iterator 550 | :buffer (opr::rev-vec-ptr-buffer itr) 551 | :index (+ (opr::rev-vec-ptr-index itr) n))) 552 | 553 | #-cl-stl-0x98 554 | (defmethod base ((rev-itr array_const_reverse_iterator)) 555 | (make-instance 'array_const_iterator 556 | :buffer (opr::rev-vec-ptr-buffer rev-itr) 557 | :index (1+ (opr::rev-vec-ptr-index rev-itr)))) 558 | 559 | ;; creating reverse iterator. 560 | #-cl-stl-0x98 561 | (define-constructor reverse_iterator ((itr array_const_reverse_iterator)) 562 | (make-instance 'array_const_iterator 563 | :buffer (opr::rev-vec-ptr-buffer itr) 564 | :index (1+ (opr::rev-vec-ptr-index itr)))) 565 | 566 | 567 | ;;------------------------------------------------------------------------------ 568 | ;; 569 | ;; methods for array_reverse_iterator 570 | ;; 571 | ;;------------------------------------------------------------------------------ 572 | #-cl-stl-0x98 573 | (defmethod operator_clone ((itr array_reverse_iterator)) 574 | (make-instance 'array_reverse_iterator 575 | :buffer (opr::rev-vec-ptr-buffer itr) 576 | :index (opr::rev-vec-ptr-index itr))) 577 | 578 | #-cl-stl-0x98 579 | (defmethod operator_cast ((itr array_reverse_iterator) 580 | (typename (eql 'array_const_reverse_iterator))) 581 | (__check-exact-type-of-cast itr 'array_reverse_iterator 582 | 'array_const_reverse_iterator) 583 | (make-instance 'array_const_reverse_iterator 584 | :buffer (opr::rev-vec-ptr-buffer itr) 585 | :index (opr::rev-vec-ptr-index itr))) 586 | 587 | #-cl-stl-0x98 588 | (defmethod operator_+ ((itr array_reverse_iterator) (n integer)) 589 | (make-instance 'array_reverse_iterator 590 | :buffer (opr::rev-vec-ptr-buffer itr) 591 | :index (+ n (opr::rev-vec-ptr-index itr)))) 592 | 593 | #-cl-stl-0x98 594 | (defmethod operator_- ((itr array_reverse_iterator) (n integer)) 595 | (make-instance 'array_reverse_iterator 596 | :buffer (opr::rev-vec-ptr-buffer itr) 597 | :index (- (opr::rev-vec-ptr-index itr) n))) 598 | 599 | #-cl-stl-0x98 600 | (defmethod base ((rev-itr array_reverse_iterator)) 601 | (make-instance 'array_iterator 602 | :buffer (opr::rev-vec-ptr-buffer rev-itr) 603 | :index (1+ (opr::rev-vec-ptr-index rev-itr)))) 604 | 605 | ;; creating reverse iterator. 606 | #-cl-stl-0x98 607 | (define-constructor reverse_iterator ((itr array_reverse_iterator)) 608 | (make-instance 'array_iterator 609 | :buffer (opr::rev-vec-ptr-buffer itr) 610 | :index (1+ (opr::rev-vec-ptr-index itr)))) 611 | 612 | 613 | 614 | 615 | 616 | ;;------------------------------------------------------------------------------ 617 | ;; 618 | ;; debug methods for stl:array 619 | ;; 620 | ;;------------------------------------------------------------------------------ 621 | #+cl-stl-debug 622 | (progn 623 | #-cl-stl-0x98 624 | (defmethod dump ((container stl:array) &optional (stream t) (print-item-fnc nil)) 625 | (format stream "begin dump ---------------------~%") 626 | (let ((buf (__inner-array container))) 627 | (when buf 628 | (setf print-item-fnc (if print-item-fnc 629 | (functor_function (clone print-item-fnc)) 630 | (lambda (s x) (format s "~A" x)))) 631 | (do ((idx 0) 632 | (cnt (size container))) 633 | ((= idx cnt) nil) 634 | (format stream "~A : " idx) 635 | (funcall print-item-fnc stream (svref buf idx)) 636 | (format stream "~%") 637 | (incf idx)))) 638 | (format stream "end dump -----------------------~%") 639 | nil)) 640 | 641 | #+cl-stl-debug 642 | (progn 643 | #-cl-stl-0x98 644 | (defmethod check_integrity ((container stl:array) &optional (stream t)) 645 | (declare (ignorable container stream)) 646 | ;; intentionally do nothing... 647 | t)) 648 | -------------------------------------------------------------------------------- /src/cl-stl-cl-conslist.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-stl) 2 | 3 | 4 | ;;-------------------------------------------------------------------- 5 | ;; 6 | ;; class difinition 7 | ;; 8 | ;;-------------------------------------------------------------------- 9 | #-(and cl-stl-noextra cl-stl-0x98) 10 | (defclass cons_const_iterator (forward_iterator) 11 | ((node :type :cons 12 | :initform nil 13 | :initarg :node 14 | :accessor __cons-itr-cons))) 15 | 16 | #-(and cl-stl-noextra cl-stl-0x98) 17 | (defclass cons_iterator (cons_const_iterator) ()) 18 | 19 | 20 | ;;-------------------------------------------------------------------- 21 | ;; 22 | ;; internal utilities 23 | ;; 24 | ;;-------------------------------------------------------------------- 25 | #-(and cl-stl-noextra cl-stl-0x98) 26 | (locally (declare (optimize speed)) 27 | (defun __conslist-count-nodes (node1 node2) 28 | (let ((cnt 0)) 29 | (declare (type fixnum cnt)) 30 | (for (nil (not (eq node1 node2)) (incf cnt) :returns cnt) 31 | (setf node1 (cdr node1)))))) 32 | 33 | #-(and cl-stl-noextra cl-stl-0x98) 34 | (locally (declare (optimize speed)) 35 | (defun __conslist-equal (lst1 lst2) 36 | (if (and (null lst1) (null lst2)) 37 | t 38 | (if (or (null lst1) (null lst2)) 39 | nil 40 | (if (eq lst1 lst2) 41 | t 42 | (if (not (_== (car lst1) (car lst2))) 43 | nil 44 | (__conslist-equal (cdr lst1) (cdr lst2)))))))) 45 | 46 | #-(and cl-stl-noextra cl-stl-0x98) 47 | (locally (declare (optimize speed)) 48 | (defun __conslist-compare (lst1 lst2) 49 | (if (and (null lst1) (null lst2)) 50 | 0 51 | (if (null lst1) 52 | -1 53 | (if (null lst2) 54 | 1 55 | (if (eq lst1 lst2) 56 | 0 57 | (let ((v1 (car lst1)) 58 | (v2 (car lst2))) 59 | (if (_< v1 v2) 60 | -1 61 | (if (_< v2 v1) 62 | 1 63 | (__conslist-compare (cdr lst1) (cdr lst2))))))))))) 64 | 65 | 66 | ;;------------------------------------------------------------------------------ 67 | ;; 68 | ;; methods for cons_const_iterator 69 | ;; 70 | ;;------------------------------------------------------------------------------ 71 | #-(and cl-stl-noextra cl-stl-0x98) 72 | (defmethod operator_= ((itr1 cons_const_iterator) (itr2 cons_const_iterator)) 73 | (__error-when-const-removing-assign itr1 cons_iterator 74 | itr2 cons_const_iterator) 75 | (setf (__cons-itr-cons itr1) (__cons-itr-cons itr2)) 76 | itr1) 77 | 78 | #-(and cl-stl-noextra cl-stl-0x98) 79 | (defmethod operator_clone ((itr cons_const_iterator)) 80 | (make-instance 'cons_const_iterator :node (__cons-itr-cons itr))) 81 | 82 | #-(and cl-stl-noextra cl-stl-0x98) 83 | (defmethod operator_== ((itr1 cons_const_iterator) (itr2 cons_const_iterator)) 84 | (eq (__cons-itr-cons itr1) (__cons-itr-cons itr2))) 85 | 86 | #-(and cl-stl-noextra cl-stl-0x98) 87 | (defmethod operator_/= ((itr1 cons_const_iterator) (itr2 cons_const_iterator)) 88 | (not (eq (__cons-itr-cons itr1) (__cons-itr-cons itr2)))) 89 | 90 | #-(and cl-stl-noextra cl-stl-0x98) 91 | (defmethod operator_* ((itr cons_const_iterator)) 92 | (car (__cons-itr-cons itr))) 93 | 94 | #-(and cl-stl-noextra cl-stl-0x98) 95 | (defmethod (setf operator_*) (new-val (itr cons_const_iterator)) 96 | (error 'setf-to-const :what "setf to (_* cons_const_iterator).")) 97 | 98 | #-(and cl-stl-noextra cl-stl-0x98) 99 | (defmethod operator_++ ((itr cons_const_iterator)) 100 | (setf (__cons-itr-cons itr) (cdr (__cons-itr-cons itr))) 101 | itr) 102 | 103 | #-(and cl-stl-noextra cl-stl-0x98) 104 | (locally (declare (optimize speed)) 105 | (defmethod advance ((itr cons_const_iterator) (n integer)) 106 | (declare (type fixnum n)) 107 | (unless (>= n 0) 108 | (error 'undefined-behavior :what "advance : Negative value for forward_iterator.")) 109 | (let ((i 0) 110 | (node (__cons-itr-cons itr))) 111 | (declare (type fixnum i)) 112 | (for (nil (< i n) (incf i)) 113 | (setf node (cdr node))) 114 | (setf (__cons-itr-cons itr) node)) 115 | nil)) 116 | 117 | #-(and cl-stl-noextra cl-stl-0x98) 118 | (defmethod distance ((itr1 cons_const_iterator) (itr2 cons_const_iterator)) 119 | (__conslist-count-nodes (__cons-itr-cons itr1) (__cons-itr-cons itr2))) 120 | 121 | 122 | ;;------------------------------------------------------------------------------ 123 | ;; 124 | ;; methods for cons_iterator 125 | ;; 126 | ;;------------------------------------------------------------------------------ 127 | #-(and cl-stl-noextra cl-stl-0x98) 128 | (defmethod operator_clone ((itr cons_iterator)) 129 | (make-instance 'cons_iterator :node (__cons-itr-cons itr))) 130 | 131 | #-(and cl-stl-noextra cl-stl-0x98) 132 | (defmethod operator_cast ((itr cons_iterator) 133 | (typename (eql 'cons_const_iterator))) 134 | (__check-exact-type-of-cast itr 'cons_iterator 135 | 'cons_const_iterator) 136 | (make-instance 'cons_iterator :node (__cons-itr-cons itr))) 137 | 138 | #-(and cl-stl-noextra cl-stl-0x98) 139 | (defmethod (setf operator_*) (new-val (itr cons_iterator)) 140 | (setf (car (__cons-itr-cons itr)) new-val) 141 | new-val) 142 | 143 | 144 | 145 | ;----------------------------------------------------- 146 | ; begin, end, size ... etc. 147 | ;----------------------------------------------------- 148 | #-cl-stl-noextra ; cl:list's begin, end & for. 149 | (progn 150 | 151 | #-cl-stl-0x98 (defmethod data ((lst cl:list)) lst) 152 | (defmethod size ((lst cl:list)) (length lst)) 153 | 154 | (defmethod begin ((cont cl:list)) (make-instance 'cons_iterator :node cont)) 155 | (defmethod end ((cont cl:list)) (make-instance 'cons_iterator :node nil)) 156 | 157 | #-cl-stl-0x98 (defmethod cbegin ((cont cl:list)) (make-instance 'cons_const_iterator :node cont)) 158 | #-cl-stl-0x98 (defmethod cend ((cont cl:list)) (make-instance 'cons_const_iterator :node nil))) 159 | 160 | 161 | ;----------------------------------------------------- 162 | ; compare 163 | ;----------------------------------------------------- 164 | #-cl-stl-noextra 165 | (locally (declare (optimize speed)) 166 | (defmethod operator_== ((lst1 cl:list) (lst2 cl:list)) (__conslist-equal lst1 lst2)) 167 | (defmethod operator_/= ((lst1 cl:list) (lst2 cl:list)) (not (__conslist-equal lst1 lst2))) 168 | (defmethod operator_< ((lst1 cl:list) (lst2 cl:list)) (< (__conslist-compare lst1 lst2) 0)) 169 | (defmethod operator_<= ((lst1 cl:list) (lst2 cl:list)) (<= (__conslist-compare lst1 lst2) 0)) 170 | (defmethod operator_> ((lst1 cl:list) (lst2 cl:list)) (< 0 (__conslist-compare lst1 lst2))) 171 | (defmethod operator_>= ((lst1 cl:list) (lst2 cl:list)) (<= 0 (__conslist-compare lst1 lst2)))) 172 | 173 | 174 | ;----------------------------------------------------- 175 | ; enumeration 176 | ;----------------------------------------------------- 177 | #-cl-stl-noextra 178 | (progn 179 | #-cl-stl-0x98 180 | (locally (declare (optimize speed)) 181 | (defmethod-overload for ((cont cl:list) func) 182 | ;;MEMO : func is always lambda function ( see stl:for ). 183 | (declare (type cl:list cont)) 184 | (declare (type cl:function func)) 185 | (dolist (v cont) 186 | (funcall func v))))) 187 | 188 | -------------------------------------------------------------------------------- /src/cl-stl-cl-vector.lisp: -------------------------------------------------------------------------------- 1 | 2 | (in-package :cl-stl) 3 | 4 | (defmacro __vector-pointer-check-index (buf-sym idx-sym) 5 | (check-type buf-sym symbol) 6 | (check-type idx-sym symbol) 7 | `(unless (and (<= 0 ,idx-sym) 8 | (< ,idx-sym (if (null ,buf-sym) 9 | 0 10 | (length ,buf-sym)))) 11 | (error 'out_of_range :what ,(format nil "index ~A is out of range." idx-sym)))) 12 | 13 | (defmacro __pointer-check-iterator-range (itr1 itr2) 14 | (declare (ignorable itr1 itr2)) 15 | #-cl-stl-debug nil 16 | #+cl-stl-debug (check-type itr1 symbol) 17 | #+cl-stl-debug (check-type itr2 symbol) 18 | #+cl-stl-debug 19 | `(unless (and (eq (opr::vec-ptr-buffer ,itr1) (opr::vec-ptr-buffer ,itr2)) 20 | (<= (the fixnum (opr::vec-ptr-index ,itr1)) 21 | (the fixnum (opr::vec-ptr-index ,itr2)))) 22 | (error 'undefined-behavior :what ,(format nil "[~A ~A) isn't legal sequence." itr1 itr2)))) 23 | 24 | 25 | 26 | ;;------------------------------------------------------------------------------ 27 | ;; 28 | ;; implementation of const-vector-pointer 29 | ;; 30 | ;;------------------------------------------------------------------------------ 31 | (defmethod advance ((itr const-vector-pointer) (n integer)) 32 | (incf (opr::vec-ptr-index itr) n) 33 | nil) 34 | 35 | (defmethod distance ((itr1 const-vector-pointer) (itr2 const-vector-pointer)) 36 | (- (opr::vec-ptr-index itr2) (opr::vec-ptr-index itr1))) 37 | 38 | ;; creating reverse iterator. 39 | (define-constructor reverse_iterator ((itr const-vector-pointer)) 40 | (make-instance 'const-reverse-vector-pointer 41 | :buffer (opr::vec-ptr-buffer itr) 42 | :index (1- (opr::vec-ptr-index itr)))) 43 | 44 | 45 | ;;------------------------------------------------------------------------------ 46 | ;; 47 | ;; implementation of vector-pointer 48 | ;; 49 | ;;------------------------------------------------------------------------------ 50 | ;; creating reverse iterator. 51 | (define-constructor reverse_iterator ((itr vector-pointer)) 52 | (make-instance 'reverse-vector-pointer 53 | :buffer (opr::vec-ptr-buffer itr) 54 | :index (1- (opr::vec-ptr-index itr)))) 55 | 56 | 57 | ;;------------------------------------------------------------------------------ 58 | ;; 59 | ;; implementation for const-reverse-vector-pointer 60 | ;; 61 | ;;------------------------------------------------------------------------------ 62 | (defmethod advance ((itr const-reverse-vector-pointer) (n integer)) 63 | (decf (opr::rev-vec-ptr-index itr) n) 64 | nil) 65 | 66 | (defmethod distance ((itr1 const-reverse-vector-pointer) 67 | (itr2 const-reverse-vector-pointer)) 68 | (* -1 (- (opr::rev-vec-ptr-index itr2) (opr::rev-vec-ptr-index itr1)))) 69 | 70 | (defmethod base ((rev-itr const-reverse-vector-pointer)) 71 | (make-instance 'const-vector-pointer 72 | :buffer (opr::rev-vec-ptr-buffer rev-itr) 73 | :index (1+ (opr::rev-vec-ptr-index rev-itr)))) 74 | 75 | ;; creating reverse iterator. 76 | (define-constructor reverse_iterator ((itr const-reverse-vector-pointer)) 77 | (make-instance 'const-vector-pointer 78 | :buffer (opr::rev-vec-ptr-buffer itr) 79 | :index (1+ (opr::rev-vec-ptr-index itr)))) 80 | 81 | 82 | ;;------------------------------------------------------------------------------ 83 | ;; 84 | ;; implementation for reverse-vector-pointer 85 | ;; 86 | ;;------------------------------------------------------------------------------ 87 | (defmethod base ((rev-itr reverse-vector-pointer)) 88 | (make-instance 'vector-pointer 89 | :buffer (opr::rev-vec-ptr-buffer rev-itr) 90 | :index (1+ (opr::rev-vec-ptr-index rev-itr)))) 91 | 92 | ;; creating reverse iterator. 93 | (define-constructor reverse_iterator ((itr reverse-vector-pointer)) 94 | (make-instance 'vector-pointer 95 | :buffer (opr::rev-vec-ptr-buffer itr) 96 | :index (1+ (opr::rev-vec-ptr-index itr)))) 97 | 98 | 99 | 100 | #-cl-stl-0x98 ; cl:vector's begin, end & for. 101 | (progn 102 | 103 | #-cl-stl-noextra (defmethod data ((arr cl:vector)) arr) 104 | #-cl-stl-noextra (defmethod size ((arr cl:vector)) (length arr)) 105 | 106 | (defmethod begin ((arr cl:vector)) (_& arr 0)) 107 | (defmethod end ((arr cl:vector)) (_& arr (length arr))) 108 | 109 | #-cl-stl-noextra (defmethod cbegin ((arr cl:vector)) (const_& arr 0)) 110 | #-cl-stl-noextra (defmethod cend ((arr cl:vector)) (const_& arr (length arr))) 111 | 112 | #-cl-stl-noextra 113 | (defmethod rbegin ((arr cl:vector)) 114 | (make-instance 'reverse-vector-pointer :buffer arr :index (1- (length arr)))) 115 | 116 | #-cl-stl-noextra 117 | (defmethod rend ((arr cl:vector)) 118 | (make-instance 'reverse-vector-pointer :buffer arr :index -1)) 119 | 120 | #-cl-stl-noextra 121 | (defmethod crbegin ((arr cl:vector)) 122 | (make-instance 'const-reverse-vector-pointer :buffer arr :index (1- (length arr)))) 123 | 124 | #-cl-stl-noextra 125 | (defmethod crend ((arr cl:vector)) 126 | (make-instance 'const-reverse-vector-pointer :buffer arr :index -1)) 127 | 128 | (locally (declare (optimize speed)) 129 | (defmethod-overload for ((cont cl:vector) func) 130 | (declare (type cl:vector cont)) 131 | (declare (type cl:function func)) 132 | ;;MEMO : func is always lambda function ( see stl:for ). 133 | (let ((idx 0) 134 | (cnt (length cont))) 135 | (declare (type fixnum idx cnt)) 136 | (for (nil (< idx cnt) (incf idx)) 137 | (funcall func (aref cont idx))))))) 138 | -------------------------------------------------------------------------------- /src/cl-stl-exceptions.lisp: -------------------------------------------------------------------------------- 1 | 2 | (in-package :cl-stl) 3 | 4 | 5 | ;;---------------------------------------------------- 6 | (define-condition logic_error (exception) ()) 7 | (define-condition runtime_error (exception) ()) 8 | 9 | 10 | ;;---------------------------------------------------- 11 | (define-condition domain_error (logic_error) ()) 12 | (define-condition invalid_argument (logic_error) ()) 13 | (define-condition length_error (logic_error) ()) 14 | (define-condition out_of_range (logic_error) ()) 15 | 16 | ;;---------------------------------------------------- 17 | (define-condition range_error (runtime_error) ()) 18 | (define-condition overflow_error (runtime_error) ()) 19 | (define-condition underflow_error (runtime_error) ()) 20 | 21 | 22 | ;;---------------------------------------------------- 23 | ;; 0x11 24 | ;;---------------------------------------------------- 25 | #-cl-stl-0x98 26 | (define-condition bad_function_call (exception) ()) 27 | 28 | 29 | -------------------------------------------------------------------------------- /src/cl-stl-initializer-list.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-stl) 2 | 3 | 4 | ;;-------------------------------------------------------------------------------- 5 | ;; 6 | ;; class initializer_list 7 | ;; 8 | ;;-------------------------------------------------------------------------------- 9 | #-cl-stl-0x98 10 | (eval-when (:compile-toplevel :load-toplevel :execute) 11 | (defclass initializer_list () 12 | ((data :type cl:vector 13 | :initarg :data 14 | :reader __initlist-data)))) 15 | 16 | 17 | ;;-------------------------------------------------------------------------------- 18 | ;; 19 | ;; method for initializer_list 20 | ;; 21 | ;;-------------------------------------------------------------------------------- 22 | #-cl-stl-0x98 23 | (locally (declare (optimize speed)) 24 | 25 | (defmethod size ((obj initializer_list)) 26 | (length (the simple-vector (__initlist-data obj)))) 27 | 28 | (defmethod begin ((obj initializer_list)) 29 | (const_& (__initlist-data obj) 0)) 30 | 31 | (defmethod end ((obj initializer_list)) 32 | (let ((arr (__initlist-data obj))) 33 | (declare (type simple-vector arr)) 34 | (const_& arr (length arr)))) 35 | 36 | (defmethod-overload for ((cont initializer_list) func) 37 | ;;MEMO : func is always lambda function ( see stl:for ). 38 | (declare (type cl:function func)) 39 | (let ((arr (__initlist-data cont))) 40 | (declare (type simple-vector arr)) 41 | (let ((idx 0) 42 | (cnt (length arr))) 43 | (declare (type fixnum idx cnt)) 44 | (for (nil (< idx cnt) (incf idx)) 45 | (funcall func (aref arr idx))))))) 46 | 47 | 48 | ;;-------------------------------------------------------------------------------- 49 | ;; 50 | ;; read macro for initializer_list #{...} 51 | ;; 52 | ;;-------------------------------------------------------------------------------- 53 | #-cl-stl-0x98 54 | (onlisp/defdelim #\{ #\} (&rest items) 55 | `(make-instance 'initializer_list 56 | :data (make-array ,(length items) 57 | :initial-contents (cl:list ,@items)))) 58 | -------------------------------------------------------------------------------- /src/cl-stl-iterator.lisp: -------------------------------------------------------------------------------- 1 | 2 | (in-package :cl-stl) 3 | 4 | (declaim (inline prev 5 | next 6 | back_inserter 7 | front_inserter 8 | inserter 9 | #-cl-stl-noextra stream_writer 10 | #-cl-stl-noextra stream_reader)) 11 | 12 | 13 | ;;------------------------------------------------------------------------------ 14 | ;; 15 | ;; utility implementation 16 | ;; 17 | ;;------------------------------------------------------------------------------ 18 | ; input_iterator or forward_iterator 19 | (locally (declare (optimize speed)) 20 | (defmethod advance ((itr input_iterator) (n integer)) 21 | (declare (type fixnum n)) 22 | (__error-unless-non-negative-fixnum advance n) 23 | (with-operators 24 | (let ((i 0)) 25 | (declare (type fixnum i)) 26 | (for (nil (< i n) (incf i)) 27 | ++itr))))) 28 | 29 | ; bidirectional_iterator 30 | (locally (declare (optimize speed)) 31 | (defmethod advance ((itr bidirectional_iterator) (n integer)) 32 | (declare (type fixnum n)) 33 | (let ((i 0)) 34 | (declare (type fixnum i)) 35 | (with-operators 36 | (if (<= 0 n) 37 | (for (nil (< i n) (incf i)) 38 | ++itr) 39 | (for (nil (< n i) (decf i)) 40 | --itr)))))) 41 | 42 | ; randomaccess_iterator 43 | (locally (declare (optimize speed)) 44 | (defmethod advance ((itr randomaccess_iterator) (n integer)) 45 | (declare (type fixnum n)) 46 | (_+= itr n) 47 | nil)) 48 | 49 | ; input_iterator or forward_iterator or bidirectional_iterator 50 | (locally (declare (optimize speed)) 51 | (defmethod distance ((itr1 input_iterator) (itr2 input_iterator)) 52 | (let ((cnt 0)) 53 | (declare (type fixnum cnt)) 54 | (with-operators 55 | (for (((itr @~itr1)) (_/= itr itr2) ++itr :returns cnt) 56 | (incf cnt)))))) 57 | 58 | ; randomaccess_iterator 59 | (locally (declare (optimize speed)) 60 | (defmethod distance ((itr1 randomaccess_iterator) (itr2 randomaccess_iterator)) 61 | (_- itr2 itr1))) 62 | 63 | 64 | 65 | ;; MEMO : prev is exported only 0x11 or later... 66 | (defun prev (itr &optional (n 1)) 67 | ;; MEMO : itr needs support for operator_clone & advance. 68 | "Not yet documented." ;; ToDo : document it... 69 | (let ((cpy (clone itr))) 70 | (advance cpy (- n)) 71 | cpy)) 72 | 73 | ;; MEMO : next is exported only 0x11 or later... 74 | (defun next (itr &optional (n 1)) 75 | ;; MEMO : itr needs support for operator_clone & advance. 76 | "Not yet documented." ;; ToDo : document it... 77 | (let ((cpy (clone itr))) 78 | (advance cpy n) 79 | cpy)) 80 | 81 | 82 | ;;------------------------------------------------------------------------------ 83 | ;; 84 | ;; back-insert-iterator 85 | ;; 86 | ;;------------------------------------------------------------------------------ 87 | (defclass back-insert-iterator (output_iterator) 88 | ((target :type :pushable_back_container 89 | :initform nil 90 | :initarg :target 91 | :accessor __back-ins-itr-target))) 92 | 93 | (defmethod operator_= ((itr1 back-insert-iterator) (itr2 back-insert-iterator)) 94 | (setf (__back-ins-itr-target itr1) (__back-ins-itr-target itr2)) 95 | itr1) 96 | 97 | (defmethod operator_clone ((itr back-insert-iterator)) 98 | (make-instance 'back-insert-iterator 99 | :target (__back-ins-itr-target itr))) 100 | 101 | (defmethod (setf operator_*) (new-val (itr back-insert-iterator)) 102 | (push_back (__back-ins-itr-target itr) new-val) 103 | new-val) 104 | 105 | (defmethod operator_++ ((itr back-insert-iterator)) 106 | itr) 107 | 108 | (defun back_inserter (cont) 109 | (make-instance 'back-insert-iterator :target cont)) 110 | 111 | 112 | ;;------------------------------------------------------------------------------ 113 | ;; 114 | ;; front-insert-iterator 115 | ;; 116 | ;;------------------------------------------------------------------------------ 117 | (defclass front-insert-iterator (output_iterator) 118 | ((target :type :pushable_front_container 119 | :initform nil 120 | :initarg :target 121 | :accessor __front-ins-itr-target))) 122 | 123 | (defmethod operator_= ((itr1 front-insert-iterator) (itr2 front-insert-iterator)) 124 | (setf (__front-ins-itr-target itr1) (__front-ins-itr-target itr2)) 125 | itr1) 126 | 127 | (defmethod operator_clone ((itr front-insert-iterator)) 128 | (make-instance 'front-insert-iterator 129 | :target (__front-ins-itr-target itr))) 130 | 131 | (defmethod (setf operator_*) (new-val (itr front-insert-iterator)) 132 | (push_front (__front-ins-itr-target itr) new-val) 133 | new-val) 134 | 135 | (defmethod operator_++ ((itr front-insert-iterator)) 136 | itr) 137 | 138 | (defun front_inserter (cont) 139 | (make-instance 'front-insert-iterator :target cont)) 140 | 141 | 142 | 143 | ;;------------------------------------------------------------------------------ 144 | ;; 145 | ;; insert-iterator 146 | ;; 147 | ;;------------------------------------------------------------------------------ 148 | (defclass insert-iterator (output_iterator) 149 | ((target :initform nil 150 | :initarg :target 151 | :accessor __insert-itr-target) 152 | (iterator :initform nil 153 | :initarg :iterator 154 | :accessor __insert-itr-iterator))) 155 | 156 | (defmethod operator_= ((itr1 insert-iterator) (itr2 insert-iterator)) 157 | (setf (__insert-itr-target itr1) (__insert-itr-target itr2)) 158 | (setf (__insert-itr-iterator itr1) (__insert-itr-iterator itr2)) 159 | itr1) 160 | 161 | (defmethod operator_clone ((itr insert-iterator)) 162 | (make-instance 'insert-iterator 163 | :target (__insert-itr-target itr) 164 | :iterator (__insert-itr-iterator itr))) 165 | 166 | (defmethod (setf operator_*) (new-val (itr insert-iterator)) 167 | (let ((ret (insert (__insert-itr-target itr) 168 | (__insert-itr-iterator itr) new-val))) 169 | (_++ ret) 170 | (setf (__insert-itr-iterator itr) ret) 171 | new-val)) 172 | 173 | (defmethod operator_++ ((itr insert-iterator)) 174 | itr) 175 | 176 | (defun inserter (cont itr) 177 | (make-instance 'insert-iterator :target cont :iterator itr)) 178 | 179 | 180 | 181 | ;;------------------------------------------------------------------------------ 182 | ;; 183 | ;; reverse-bidirectional_iterator 184 | ;; 185 | ;;------------------------------------------------------------------------------ 186 | (defclass reverse-bidirectional_iterator (bidirectional_iterator) 187 | ((current :initform nil 188 | :initarg :current 189 | :accessor rev-bid-itr-current))) 190 | 191 | (define-constructor reverse_iterator ((itr bidirectional_iterator)) 192 | (make-instance 'reverse-bidirectional_iterator :current (clone itr))) 193 | 194 | (define-constructor reverse_iterator ((itr reverse-bidirectional_iterator)) 195 | (clone (rev-bid-itr-current itr))) 196 | 197 | ;;------------------------------------------------------------------------------ 198 | ;; methods 199 | ;;------------------------------------------------------------------------------ 200 | (defmethod operator_= ((itr1 reverse-bidirectional_iterator) 201 | (itr2 reverse-bidirectional_iterator)) 202 | (_= (rev-bid-itr-current itr1) (rev-bid-itr-current itr2)) 203 | itr1) 204 | 205 | (defmethod operator_clone ((itr reverse-bidirectional_iterator)) 206 | (make-instance 'reverse-bidirectional_iterator 207 | :current (clone (rev-bid-itr-current itr)))) 208 | 209 | (defmethod operator_== ((itr1 reverse-bidirectional_iterator) 210 | (itr2 reverse-bidirectional_iterator)) 211 | (_== (rev-bid-itr-current itr1) (rev-bid-itr-current itr2))) 212 | 213 | (defmethod operator_/= ((itr1 reverse-bidirectional_iterator) 214 | (itr2 reverse-bidirectional_iterator)) 215 | (_/= (rev-bid-itr-current itr1) (rev-bid-itr-current itr2))) 216 | 217 | (defmethod operator_* ((itr reverse-bidirectional_iterator)) 218 | (let ((tmp (clone (rev-bid-itr-current itr)))) 219 | (_-- tmp) 220 | (_* tmp))) 221 | 222 | (defmethod (setf operator_*) (new-val (itr reverse-bidirectional_iterator)) 223 | (let ((tmp (clone (rev-bid-itr-current itr)))) 224 | (_-- tmp) 225 | (setf (_* tmp) new-val) 226 | new-val)) 227 | 228 | (defmethod operator_++ ((itr reverse-bidirectional_iterator)) 229 | (setf (rev-bid-itr-current itr) 230 | (operator_-- (rev-bid-itr-current itr))) 231 | itr) 232 | 233 | (defmethod operator_-- ((itr reverse-bidirectional_iterator)) 234 | (setf (rev-bid-itr-current itr) 235 | (operator_++ (rev-bid-itr-current itr))) 236 | itr) 237 | 238 | (defmethod advance ((itr reverse-bidirectional_iterator) (n integer)) 239 | (advance (rev-bid-itr-current itr) (* n -1)) 240 | nil) 241 | 242 | (defmethod distance ((itr1 reverse-bidirectional_iterator) 243 | (itr2 reverse-bidirectional_iterator)) 244 | (distance (rev-bid-itr-current itr2) (rev-bid-itr-current itr1))) 245 | 246 | (defmethod base ((rev-itr reverse-bidirectional_iterator)) 247 | (clone (rev-bid-itr-current rev-itr))) 248 | 249 | 250 | 251 | 252 | ;;------------------------------------------------------------------------------ 253 | ;; 254 | ;; reverse-randomaccess_iterator 255 | ;; 256 | ;;------------------------------------------------------------------------------ 257 | (defclass reverse-randomaccess_iterator (randomaccess_iterator) 258 | ((current :initform nil 259 | :initarg :current 260 | :accessor rev-ra-itr-current))) 261 | 262 | (define-constructor reverse_iterator ((itr randomaccess_iterator)) 263 | (make-instance 'reverse-randomaccess_iterator :current (clone itr))) 264 | 265 | (define-constructor reverse_iterator ((itr reverse-randomaccess_iterator)) 266 | (clone (rev-ra-itr-current itr))) 267 | 268 | 269 | ;;------------------------------------------------------------------------------ 270 | ;; methods 271 | ;;------------------------------------------------------------------------------ 272 | (defmethod operator_= ((itr1 reverse-randomaccess_iterator) 273 | (itr2 reverse-randomaccess_iterator)) 274 | (_= (rev-ra-itr-current itr1) (rev-ra-itr-current itr2)) 275 | itr1) 276 | 277 | (defmethod operator_clone ((itr reverse-randomaccess_iterator)) 278 | (make-instance 'reverse-randomaccess_iterator 279 | :current (clone (rev-ra-itr-current itr)))) 280 | 281 | (defmethod operator_== ((itr1 reverse-randomaccess_iterator) 282 | (itr2 reverse-randomaccess_iterator)) 283 | (_== (rev-ra-itr-current itr1) (rev-ra-itr-current itr2))) 284 | 285 | (defmethod operator_/= ((itr1 reverse-randomaccess_iterator) 286 | (itr2 reverse-randomaccess_iterator)) 287 | (_/= (rev-ra-itr-current itr1) (rev-ra-itr-current itr2))) 288 | 289 | (defmethod operator_* ((itr reverse-randomaccess_iterator)) 290 | (_[] (rev-ra-itr-current itr) -1)) 291 | 292 | (defmethod (setf operator_*) (new-val (itr reverse-randomaccess_iterator)) 293 | (setf (_[] (rev-ra-itr-current itr) -1) new-val) 294 | new-val) 295 | 296 | (defmethod operator_++ ((itr reverse-randomaccess_iterator)) 297 | (setf (rev-ra-itr-current itr) 298 | (operator_-- (rev-ra-itr-current itr))) 299 | itr) 300 | 301 | (defmethod operator_-- ((itr reverse-randomaccess_iterator)) 302 | (setf (rev-ra-itr-current itr) 303 | (operator_++ (rev-ra-itr-current itr))) 304 | itr) 305 | 306 | (defmethod operator_< ((itr1 reverse-randomaccess_iterator) 307 | (itr2 reverse-randomaccess_iterator)) 308 | (_< (rev-ra-itr-current itr2) (rev-ra-itr-current itr1))) 309 | 310 | (defmethod operator_<= ((itr1 reverse-randomaccess_iterator) 311 | (itr2 reverse-randomaccess_iterator)) 312 | (_<= (rev-ra-itr-current itr2) (rev-ra-itr-current itr1))) 313 | 314 | (defmethod operator_> ((itr1 reverse-randomaccess_iterator) 315 | (itr2 reverse-randomaccess_iterator)) 316 | (_> (rev-ra-itr-current itr2) (rev-ra-itr-current itr1))) 317 | 318 | (defmethod operator_>= ((itr1 reverse-randomaccess_iterator) 319 | (itr2 reverse-randomaccess_iterator)) 320 | (_>= (rev-ra-itr-current itr2) (rev-ra-itr-current itr1))) 321 | 322 | (defmethod operator_+ ((itr reverse-randomaccess_iterator) (n integer)) 323 | (let ((tmp (clone itr))) 324 | (_+= tmp n) 325 | tmp)) 326 | 327 | (defmethod operator_+= ((itr reverse-randomaccess_iterator) (n integer)) 328 | (_-= (rev-ra-itr-current itr) n) 329 | itr) 330 | 331 | (defmethod operator_- ((itr reverse-randomaccess_iterator) (n integer)) 332 | (let ((tmp (clone itr))) 333 | (_-= tmp n) 334 | tmp)) 335 | 336 | (defmethod operator_- ((itr1 reverse-randomaccess_iterator) 337 | (itr2 reverse-randomaccess_iterator)) 338 | (_- (rev-ra-itr-current itr2) (rev-ra-itr-current itr1))) 339 | 340 | (defmethod operator_-= ((itr reverse-randomaccess_iterator) (n integer)) 341 | (_+= (rev-ra-itr-current itr) n) 342 | itr) 343 | 344 | (defmethod operator_[] ((itr reverse-randomaccess_iterator) (idx integer)) 345 | (_[] (rev-ra-itr-current itr) (1- (* -1 idx)))) 346 | 347 | (defmethod (setf operator_[]) (new-val (itr reverse-randomaccess_iterator) (idx integer)) 348 | (setf (_[] (rev-ra-itr-current itr) (1- (* -1 idx))) new-val) 349 | new-val) 350 | 351 | (defmethod advance ((itr reverse-randomaccess_iterator) (n integer)) 352 | (advance (rev-ra-itr-current itr) (* n -1)) 353 | nil) 354 | 355 | (defmethod distance ((itr1 reverse-randomaccess_iterator) 356 | (itr2 reverse-randomaccess_iterator)) 357 | (distance (rev-ra-itr-current itr2) (rev-ra-itr-current itr1))) 358 | 359 | (defmethod base ((rev-itr reverse-randomaccess_iterator)) 360 | (clone (rev-ra-itr-current rev-itr))) 361 | 362 | 363 | 364 | 365 | ;;------------------------------------------------------------------------------ 366 | ;; 367 | ;; stream-write-iterator 368 | ;; 369 | ;;------------------------------------------------------------------------------ 370 | #-cl-stl-noextra 371 | (defclass stream-write-iterator (output_iterator) 372 | ((stream :initform nil 373 | :initarg :stream 374 | :accessor __stream-wrt-itr-stream))) 375 | 376 | #-cl-stl-noextra 377 | (defmethod operator_= ((itr1 stream-write-iterator) (itr2 stream-write-iterator)) 378 | (setf (__stream-wrt-itr-stream itr1) (__stream-wrt-itr-stream itr2)) 379 | itr1) 380 | 381 | #-cl-stl-noextra 382 | (defmethod operator_clone ((itr stream-write-iterator)) 383 | (make-instance 'stream-write-iterator 384 | :stream (__stream-wrt-itr-stream itr))) 385 | 386 | #-cl-stl-noextra 387 | (defmethod (setf operator_*) (new-val (itr stream-write-iterator)) 388 | (format (__stream-wrt-itr-stream itr) "~A" new-val) 389 | new-val) 390 | 391 | #-cl-stl-noextra 392 | (defmethod operator_++ ((itr stream-write-iterator)) 393 | (format (slot-value itr 'stream) "~%") 394 | itr) 395 | 396 | #-cl-stl-noextra 397 | (defun stream_writer (stream) 398 | (make-instance 'stream-write-iterator :stream stream)) 399 | 400 | ;;------------------------------------------------------------------------------ 401 | ;; 402 | ;; stream-read-iterator 403 | ;; 404 | ;;------------------------------------------------------------------------------ 405 | #-cl-stl-noextra 406 | (defclass stream-read-iterator (input_iterator) 407 | (m-stream 408 | m-linenum 409 | m-linebuf)) 410 | 411 | #-cl-stl-noextra 412 | (defmethod operator_= ((itr1 stream-read-iterator) (itr2 stream-read-iterator)) 413 | (setf (slot-value itr1 'm-stream) (slot-value itr2 'm-stream)) 414 | (setf (slot-value itr1 'm-linenum) (slot-value itr2 'm-linenum)) 415 | (setf (slot-value itr1 'm-linebuf) (slot-value itr2 'm-linebuf)) 416 | itr1) 417 | 418 | #-cl-stl-noextra 419 | (defmethod operator_clone ((itr stream-read-iterator)) 420 | (let ((oitr (make-instance 'stream-read-iterator))) 421 | (_= oitr itr) 422 | oitr)) 423 | 424 | #-cl-stl-noextra 425 | (defmethod operator_== ((itr1 stream-read-iterator) (itr2 stream-read-iterator)) 426 | (if (and (eq (slot-value itr1 'm-linebuf) :eof) 427 | (eq (slot-value itr2 'm-linebuf) :eof)) 428 | t 429 | (if (= (slot-value itr1 'm-linenum) 430 | (slot-value itr2 'm-linenum)) 431 | t 432 | nil))) 433 | 434 | #-cl-stl-noextra 435 | (defmethod operator_/= ((itr1 stream-read-iterator) (itr2 stream-read-iterator)) 436 | (not (_== itr1 itr2))) 437 | 438 | #-cl-stl-noextra 439 | (defmethod operator_* ((itr stream-read-iterator)) 440 | (slot-value itr 'm-linebuf)) 441 | 442 | #-cl-stl-noextra 443 | (defmethod operator_++ ((itr stream-read-iterator)) 444 | (with-slots (m-stream m-linenum m-linebuf) itr 445 | (unless (eq m-linebuf :eof) 446 | (setf m-linebuf (read-line m-stream nil :eof)) 447 | (cl:incf m-linenum))) 448 | itr) 449 | 450 | #-cl-stl-noextra 451 | (defun stream_reader (&optional (stream nil)) 452 | (let ((linenum -1) 453 | (linebuf :eof) 454 | (itr (make-instance 'stream-read-iterator))) 455 | (when stream 456 | (setf linebuf (read-line stream nil :eof)) 457 | (cl:incf linenum)) 458 | (setf (slot-value itr 'm-stream) stream) 459 | (setf (slot-value itr 'm-linenum) linenum) 460 | (setf (slot-value itr 'm-linebuf) linebuf) 461 | itr)) 462 | 463 | ;;------------------------------------------------------------------------------ 464 | ;; 465 | ;; with-* macros 466 | ;; 467 | ;;------------------------------------------------------------------------------ 468 | #-cl-stl-noextra 469 | (defmacro with_sequence ((itr1 itr2) container &rest body) 470 | (let ((g-cont (gensym))) 471 | `(let* ((,g-cont ,container) 472 | (,itr1 (begin ,g-cont)) 473 | (,itr2 (end ,g-cont))) 474 | ,@body))) 475 | 476 | #-cl-stl-noextra 477 | (defmacro with_stream_reader ((itr1 itr2) stream &rest body) 478 | `(let ((,itr1 (stream_reader ,stream)) 479 | (,itr2 (stream_reader nil))) 480 | ,@body)) 481 | 482 | #-cl-stl-noextra 483 | (defmacro with_stream_writer (itr stream &rest body) 484 | `(let ((,itr (stream_writer ,stream))) 485 | ,@body)) 486 | 487 | #-cl-stl-noextra 488 | (defmacro with_file_reader ((itr1 itr2) file-name &rest body) 489 | (let ((stream (gensym))) 490 | `(with-open-file (,stream ,file-name :direction :input) 491 | (let ((,itr1 (stream_reader ,stream)) 492 | (,itr2 (stream_reader nil))) 493 | ,@body)))) 494 | 495 | #-cl-stl-noextra 496 | (defmacro with_file_writer (itr file-name &rest body) 497 | (let ((stream (gensym))) 498 | `(with-open-file (,stream ,file-name :direction :output :if-exists :supersede) 499 | (let ((,itr (stream_writer ,stream))) 500 | ,@body)))) 501 | 502 | #-cl-stl-noextra 503 | (defmacro with_buffer_reader ((itr1 itr2) buffer &rest body) 504 | (let ((stream (gensym))) 505 | `(with-input-from-string (,stream ,buffer) 506 | (let ((,itr1 (stream_reader ,stream)) 507 | (,itr2 (stream_reader nil))) 508 | ,@body)))) 509 | 510 | #-cl-stl-noextra 511 | (defmacro with_buffer_writer (itr &rest body) 512 | (let ((stream (gensym))) 513 | `(with-output-to-string (,stream) 514 | (let ((,itr (stream_writer ,stream))) 515 | ,@body)))) 516 | 517 | 518 | 519 | -------------------------------------------------------------------------------- /src/cl-stl-move-iterator.lisp: -------------------------------------------------------------------------------- 1 | 2 | (in-package :cl-stl) 3 | 4 | #-cl-stl-0x98 5 | (declaim (inline make_move_iterator)) 6 | 7 | 8 | ;;------------------------------------------------------------------------------ 9 | ;; 10 | ;; move iterator classes 11 | ;; 12 | ;;------------------------------------------------------------------------------ 13 | #-cl-stl-0x98 14 | (progn 15 | (defclass move-iterator_in (input_iterator) 16 | ((itr :initform nil 17 | :initarg :iterator 18 | :accessor __moveitr-iterator) 19 | (rm :type :remove-reference 20 | :initarg :rm-ref 21 | :accessor __moveitr-rm-ref))) 22 | (defclass move-iterator_fwd ( forward_iterator move-iterator_in ) ()) 23 | (defclass move-iterator_bid (bidirectional_iterator move-iterator_fwd) ()) 24 | (defclass move-iterator_rdm ( randomaccess_iterator move-iterator_bid) ())) 25 | 26 | 27 | #-cl-stl-0x98 28 | (macrolet ((movitr-ctor (param-type itr-type) 29 | `(define-constructor move-iterator ((itr ,param-type)) 30 | (let* ((itr (clone itr)) 31 | (rm (opr:move (_* itr)))) 32 | (make-instance ',itr-type :iterator itr :rm-ref rm))))) 33 | (movitr-ctor input_iterator move-iterator_in) 34 | (movitr-ctor forward_iterator move-iterator_fwd) 35 | (movitr-ctor bidirectional_iterator move-iterator_bid) 36 | (movitr-ctor randomaccess_iterator move-iterator_rdm)) 37 | 38 | #-cl-stl-0x98 39 | (defun make_move_iterator (itr) 40 | (new stl::move-iterator itr)) 41 | 42 | 43 | ;;------------------------------------------------------------------------------ 44 | ;; implementation of move-iterator_in 45 | ;;------------------------------------------------------------------------------ 46 | #-cl-stl-0x98 47 | (defmethod operator_= ((itr1 move-iterator_in) (itr2 move-iterator_in)) 48 | (_= (__moveitr-iterator itr1) (__moveitr-iterator itr2)) 49 | itr1) 50 | 51 | #-cl-stl-0x98 52 | (defmethod operator_clone ((itr move-iterator_in)) 53 | (let* ((tmp (clone (__moveitr-iterator itr))) 54 | (rm (opr:move (_* tmp)))) 55 | (make-instance (type-of itr) :iterator tmp :rm-ref rm))) 56 | 57 | #-cl-stl-0x98 58 | (defmethod operator_* ((itr move-iterator_in)) 59 | (__moveitr-rm-ref itr)) 60 | 61 | #-cl-stl-0x98 62 | (defmethod operator_++ ((itr move-iterator_in)) 63 | (setf (__moveitr-iterator itr) 64 | (operator_++ (__moveitr-iterator itr))) 65 | itr) 66 | 67 | #-cl-stl-0x98 68 | (defmethod operator_== ((itr1 move-iterator_in) (itr2 move-iterator_in)) 69 | (_== (__moveitr-iterator itr1) (__moveitr-iterator itr2))) 70 | 71 | #-cl-stl-0x98 72 | (defmethod operator_/= ((itr1 move-iterator_in) (itr2 move-iterator_in)) 73 | (_/= (__moveitr-iterator itr1) (__moveitr-iterator itr2))) 74 | 75 | #-cl-stl-0x98 76 | (defmethod base ((itr move-iterator_in)) 77 | (clone (__moveitr-iterator itr))) 78 | 79 | 80 | 81 | ;;------------------------------------------------------------------------------ 82 | ;; implementation of move-iterator_fwd 83 | ;;------------------------------------------------------------------------------ 84 | #-cl-stl-0x98 85 | (defmethod (setf operator_*) (new-val (itr move-iterator_fwd)) 86 | (setf (_* (__moveitr-iterator itr)) new-val) 87 | new-val) 88 | 89 | #-cl-stl-0x98 90 | (defmethod advance ((itr move-iterator_fwd) (n integer)) 91 | (advance (__moveitr-iterator itr) n) 92 | nil) 93 | 94 | #-cl-stl-0x98 95 | (defmethod distance ((itr1 move-iterator_fwd) (itr2 move-iterator_fwd)) 96 | (distance (__moveitr-iterator itr1) (__moveitr-iterator itr2))) 97 | 98 | 99 | ;;------------------------------------------------------------------------------ 100 | ;; implementation of move-iterator_bid 101 | ;;------------------------------------------------------------------------------ 102 | #-cl-stl-0x98 103 | (defmethod operator_-- ((itr move-iterator_bid)) 104 | (setf (__moveitr-iterator itr) 105 | (operator_-- (__moveitr-iterator itr))) 106 | itr) 107 | 108 | ;; CAN'T creating reverse iterator. 109 | #-cl-stl-0x98 110 | (define-constructor reverse_iterator ((itr move-iterator_bid)) 111 | (error 'type-mismatch :what "reverse_iterator can't create from move-iterator")) 112 | 113 | ;;------------------------------------------------------------------------------ 114 | ;; implementation of move-iterator_rdm 115 | ;;------------------------------------------------------------------------------ 116 | #-cl-stl-0x98 117 | (defmethod operator_< ((itr1 move-iterator_rdm) (itr2 move-iterator_rdm)) 118 | (_< (__moveitr-iterator itr1) (__moveitr-iterator itr2))) 119 | 120 | #-cl-stl-0x98 121 | (defmethod operator_<= ((itr1 move-iterator_rdm) (itr2 move-iterator_rdm)) 122 | (_<= (__moveitr-iterator itr1) (__moveitr-iterator itr2))) 123 | 124 | #-cl-stl-0x98 125 | (defmethod operator_> ((itr1 move-iterator_rdm) (itr2 move-iterator_rdm)) 126 | (_> (__moveitr-iterator itr1) (__moveitr-iterator itr2))) 127 | 128 | #-cl-stl-0x98 129 | (defmethod operator_>= ((itr1 move-iterator_rdm) (itr2 move-iterator_rdm)) 130 | (_>= (__moveitr-iterator itr1) (__moveitr-iterator itr2))) 131 | 132 | #-cl-stl-0x98 133 | (defmethod operator_+ ((itr move-iterator_rdm) (n integer)) 134 | (let ((r (clone itr))) 135 | (advance r n) 136 | r)) 137 | 138 | #-cl-stl-0x98 139 | (defmethod operator_+= ((itr move-iterator_rdm) (n integer)) 140 | (advance itr n) 141 | itr) 142 | 143 | #-cl-stl-0x98 144 | (defmethod operator_- ((itr move-iterator_rdm) (n integer)) 145 | (let ((r (clone itr))) 146 | (advance r (* -1 n)) 147 | r)) 148 | 149 | #-cl-stl-0x98 150 | (defmethod operator_- ((itr1 move-iterator_rdm) (itr2 move-iterator_rdm)) 151 | (_- (__moveitr-iterator itr1) (__moveitr-iterator itr2))) 152 | 153 | #-cl-stl-0x98 154 | (defmethod operator_-= ((itr move-iterator_rdm) (n integer)) 155 | (advance itr (* -1 n)) 156 | itr) 157 | 158 | #-cl-stl-0x98 159 | (defmethod operator_[] ((itr move-iterator_rdm) (idx integer)) 160 | (opr:move (_[] (__moveitr-iterator itr) idx))) 161 | 162 | #-cl-stl-0x98 163 | (defmethod (setf operator_[]) (new-val (itr move-iterator_rdm) (idx integer)) 164 | (_= (_[] (__moveitr-iterator itr) idx) new-val) 165 | new-val) 166 | 167 | ;; CAN'T creating reverse iterator. 168 | #-cl-stl-0x98 169 | (define-constructor reverse_iterator ((itr move-iterator_rdm)) 170 | (error 'type-mismatch :what "reverse_iterator can't create from move-iterator")) 171 | 172 | -------------------------------------------------------------------------------- /src/cl-stl-multimap.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-stl) 2 | 3 | ;;------------------------------------------------------------------------------ 4 | ;; 5 | ;; class difinition 6 | ;; 7 | ;;------------------------------------------------------------------------------ 8 | (locally (declare (optimize speed)) 9 | 10 | (defclass multimap (bidirectional_container) 11 | ((rbtree :type :rbtree 12 | :initform nil 13 | :initarg :core 14 | :accessor __assoc-tree) 15 | ;TMP; #+cl-stl-debug 16 | ;TMP; (id :type :symbol 17 | ;TMP; :initform (gensym "MULTIMAP-") 18 | ;TMP; :initarg :id 19 | ;TMP; :accessor __instance-id) 20 | )) 21 | 22 | (defclass multimap_const_iterator (bidirectional_iterator) 23 | ((node :type :rbnode 24 | :initform nil 25 | :initarg :node 26 | :accessor __assoc-itr-node))) 27 | 28 | (defclass multimap_const_reverse_iterator (bidirectional_iterator) 29 | ((node :type :rbnode 30 | :initform nil 31 | :initarg :node 32 | :accessor __assoc-rev-itr-node))) 33 | 34 | (defclass multimap_iterator (multimap_const_iterator) ()) 35 | (defclass multimap_reverse_iterator (multimap_const_reverse_iterator) ())) 36 | 37 | 38 | ;;-------------------------------------------------------------------- 39 | ;; 40 | ;; internal utilities 41 | ;; 42 | ;;-------------------------------------------------------------------- 43 | #+cl-stl-debug 44 | (labels ((__multimap-check-iterator-belong-imp (itr cont) 45 | (let* ((tree (__assoc-tree cont)) 46 | (node (__assoc-itr-node itr))) 47 | (if (eq node (__rbtree-end tree)) 48 | t 49 | (let ((val (__rbnode-value node))) 50 | (if (not (typep val 'pair)) 51 | nil 52 | (let ((key (stl:first val))) 53 | (handler-case 54 | (do ((node1 (__rbtree-lower_bound tree key) (__rbnode-increment node1)) 55 | (node2 (__rbtree-upper_bound tree key))) 56 | ((eq node1 node2) nil) 57 | (when (eq node node1) 58 | (return t))) 59 | (error () nil))))))))) 60 | 61 | (defun __multimap-check-iterator-belong (itr cont) 62 | (unless (__multimap-check-iterator-belong-imp itr cont) 63 | (error 'undefined-behavior :what "Not a iterator of container."))) 64 | 65 | (defun __multimap-check-iterator-range (cont itr1 itr2) 66 | (let* ((tree (__assoc-tree cont)) 67 | (nodeZ (__rbtree-end tree)) 68 | (node1 (__assoc-itr-node itr1)) 69 | (node2 (__assoc-itr-node itr2))) 70 | (if (eq node2 nodeZ) 71 | (if (or (eq node1 nodeZ) 72 | (__multimap-check-iterator-belong-imp itr1 cont)) 73 | t 74 | (error 'undefined-behavior :what "Invalid iterator range.")) 75 | (if (eq node1 nodeZ) 76 | (error 'undefined-behavior :what "Invalid iterator range.") 77 | (if (handler-case 78 | (let ((key1 (stl:first (__rbnode-value node1))) 79 | (key2 (stl:first (__rbnode-value node2))) 80 | (comp (functor_function (key_comp cont)))) 81 | (if (funcall comp key2 key1) 82 | nil 83 | (do ((nodeA (__rbtree-lower_bound tree key1) (__rbnode-increment nodeA)) 84 | (nodeB (__rbtree-upper_bound tree key2))) 85 | ((eq nodeA nodeB) nil) 86 | (if (eq node1 nodeA) 87 | (return (__multimap-check-iterator-belong-imp itr2 cont)) 88 | (when (eq node2 nodeA) 89 | (return nil)))))) 90 | (error () nil)) 91 | t 92 | (error 'undefined-behavior :what "Invalid iterator range."))))))) 93 | 94 | 95 | ;;-------------------------------------------------------------------- 96 | ;; 97 | ;; method implementation 98 | ;; 99 | ;;-------------------------------------------------------------------- 100 | (locally (declare (optimize speed)) 101 | 102 | (defun __create-multimap (key_comp) 103 | ;; MEMO : key_comp copy in __rbtree-ctor. 104 | (let ((tree (__rbtree-ctor key_comp #'stl:first))) 105 | #+cl-stl-debug (setf (__rbtree-checker tree) #'__map-item-checker) 106 | (make-instance 'multimap :core tree))) 107 | 108 | (defun __create-multimap-with-range (key_comp itr1 itr2) 109 | ;; MEMO : key_comp copy in __rbtree-ctor. 110 | ;; MEMO : [itr1, itr2) is 'input_iterator'... 111 | (let ((tree (__rbtree-ctor key_comp #'stl:first))) 112 | #+cl-stl-debug (setf (__rbtree-checker tree) #'__map-item-checker) 113 | (__rbtree-insert-range-equal tree itr1 itr2 t) 114 | (make-instance 'multimap :core tree))) 115 | 116 | (defun __create-multimap-with-array (key_comp arr idx1 idx2) 117 | (declare (type cl:vector arr)) 118 | (declare (type fixnum idx1 idx2)) 119 | ;; MEMO : key_comp copy in __rbtree-ctor. 120 | (let ((tree (__rbtree-ctor key_comp #'stl:first))) 121 | #+cl-stl-debug (setf (__rbtree-checker tree) #'__map-item-checker) 122 | (__rbtree-insert-array-equal tree arr idx1 idx2 t) 123 | (make-instance 'multimap :core tree)))) 124 | 125 | 126 | ;;------------------------------------------------------------------------------ 127 | ;; 128 | ;; constructors 129 | ;; 130 | ;;------------------------------------------------------------------------------ 131 | (declare-constructor multimap (0 1 2 3)) 132 | 133 | ; empty constructor 1 134 | (define-constructor multimap () 135 | (__create-multimap #'operator_<)) 136 | 137 | ; empty constructor 2 138 | (define-constructor multimap ((arg cl:function)) 139 | (__create-multimap arg)) 140 | 141 | ; empty constructor 3 142 | (define-constructor multimap ((arg #-cl-stl-0x98 functor 143 | #+cl-stl-0x98 binary_function)) 144 | (__create-multimap arg)) 145 | 146 | ; copy constructor 147 | (define-constructor multimap ((arg multimap)) 148 | (clone arg)) 149 | 150 | ; constructor with initializer list 1 151 | #-cl-stl-0x98 152 | (define-constructor multimap ((il initializer_list)) 153 | (declare (type initializer_list il)) 154 | (let ((arr (__initlist-data il))) 155 | (declare (type simple-vector arr)) 156 | (__create-multimap-with-array #'operator_< arr 0 (length arr)))) 157 | 158 | ; constructor with initializer list 2 159 | #-cl-stl-0x98 160 | (define-constructor multimap ((il initializer_list) (comp cl:function)) 161 | (declare (type initializer_list il)) 162 | (let ((arr (__initlist-data il))) 163 | (declare (type simple-vector arr)) 164 | (__create-multimap-with-array comp arr 0 (length arr)))) 165 | 166 | ; constructor with initializer list 3 167 | #-cl-stl-0x98 168 | (define-constructor multimap ((il initializer_list) 169 | (comp #-cl-stl-0x98 functor 170 | #+cl-stl-0x98 binary_function)) 171 | (declare (type initializer_list il)) 172 | (let ((arr (__initlist-data il))) 173 | (declare (type simple-vector arr)) 174 | (__create-multimap-with-array comp arr 0 (length arr)))) 175 | 176 | ; move constructor 177 | #-cl-stl-0x98 178 | (define-constructor multimap ((arg& remove-reference)) 179 | (with-reference (arg) 180 | (let ((cont arg)) 181 | (__check-type-of-move-constructor cont multimap) 182 | (let ((obj (__create-multimap (key_comp cont)))) 183 | (__rbtree-swap (__assoc-tree obj) (__assoc-tree cont)) 184 | obj)))) 185 | 186 | ; range constructor 187 | (define-constructor multimap ((itr1 input_iterator) (itr2 input_iterator)) 188 | (__create-multimap-with-range #'operator_< itr1 itr2)) 189 | 190 | (define-constructor multimap ((itr1 input_iterator) 191 | (itr2 input_iterator) (comp cl:function)) 192 | (__create-multimap-with-range comp itr1 itr2)) 193 | 194 | (define-constructor multimap ((itr1 input_iterator) 195 | (itr2 input_iterator) (comp #-cl-stl-0x98 functor 196 | #+cl-stl-0x98 binary_function)) 197 | (__create-multimap-with-range comp itr1 itr2)) 198 | 199 | ;; range constructor for const-vector-pointer. 200 | (define-constructor multimap ((ptr1 const-vector-pointer) (ptr2 const-vector-pointer)) 201 | (__pointer-check-iterator-range ptr1 ptr2) 202 | (__create-multimap-with-array #'operator_< 203 | (opr::vec-ptr-buffer ptr1) 204 | (opr::vec-ptr-index ptr1) 205 | (opr::vec-ptr-index ptr2))) 206 | 207 | (define-constructor multimap ((ptr1 const-vector-pointer) 208 | (ptr2 const-vector-pointer) (comp cl:function)) 209 | (__pointer-check-iterator-range ptr1 ptr2) 210 | (__create-multimap-with-array comp 211 | (opr::vec-ptr-buffer ptr1) 212 | (opr::vec-ptr-index ptr1) 213 | (opr::vec-ptr-index ptr2))) 214 | 215 | (define-constructor multimap ((ptr1 const-vector-pointer) 216 | (ptr2 const-vector-pointer) (comp #-cl-stl-0x98 functor 217 | #+cl-stl-0x98 binary_function)) 218 | (__pointer-check-iterator-range ptr1 ptr2) 219 | (__create-multimap-with-array comp 220 | (opr::vec-ptr-buffer ptr1) 221 | (opr::vec-ptr-index ptr1) 222 | (opr::vec-ptr-index ptr2))) 223 | 224 | 225 | (defmethod operator_clone ((container stl::multimap)) 226 | (make-instance 'stl::multimap 227 | :core (__rbtree-copy-ctor (__assoc-tree container)))) 228 | 229 | 230 | ;;------------------------------------------------------------------------------ 231 | ;; 232 | ;; methods 233 | ;; 234 | ;;------------------------------------------------------------------------------ 235 | 236 | ;;---------------------------------------------------------- 237 | ;; assignment 238 | ;;---------------------------------------------------------- 239 | (locally (declare (optimize speed)) 240 | 241 | (defmethod operator_= ((cont1 multimap) (cont2 multimap)) 242 | (__rbtree-assign (__assoc-tree cont1) (__assoc-tree cont2)) 243 | cont1) 244 | 245 | #-cl-stl-0x98 246 | (defmethod operator_move ((cont1 multimap) (cont2 multimap)) 247 | (unless (eq cont1 cont2) 248 | (let ((tree1 (__assoc-tree cont1)) 249 | (tree2 (__assoc-tree cont2))) 250 | (__rbtree-clear tree1) 251 | (__rbtree-swap tree1 tree2) 252 | (setf (__rbtree-key_comp tree2) (clone (__rbtree-key_comp tree1))))) 253 | (values cont1 cont2)) 254 | 255 | #-cl-stl-0x98 256 | (defmethod operator_= ((cont multimap) (il initializer_list)) 257 | (declare (type initializer_list il)) 258 | (let ((tree (__assoc-tree cont)) 259 | (arr (__initlist-data il))) 260 | (declare (type rbtree tree)) 261 | (declare (type simple-vector arr)) 262 | (__rbtree-clear tree) 263 | (__rbtree-insert-array-equal tree arr 0 (length arr) t)) 264 | cont)) 265 | 266 | 267 | ;;---------------------------------------------------------- 268 | ;; iterators 269 | ;;---------------------------------------------------------- 270 | (locally (declare (optimize speed)) 271 | 272 | (defmethod begin ((container multimap)) 273 | (make-instance 'multimap_iterator 274 | :node (__rbtree-begin (__assoc-tree container)))) 275 | 276 | (defmethod end ((container multimap)) 277 | (make-instance 'multimap_iterator 278 | :node (__rbtree-end (__assoc-tree container)))) 279 | 280 | (defmethod rbegin ((container multimap)) 281 | (make-instance 'multimap_reverse_iterator 282 | :node (__rbtree-rbegin (__assoc-tree container)))) 283 | 284 | (defmethod rend ((container multimap)) 285 | (make-instance 'multimap_reverse_iterator 286 | :node (__rbtree-rend (__assoc-tree container)))) 287 | 288 | #-cl-stl-0x98 289 | (defmethod cbegin ((container multimap)) 290 | (make-instance 'multimap_const_iterator 291 | :node (__rbtree-begin (__assoc-tree container)))) 292 | 293 | #-cl-stl-0x98 294 | (defmethod cend ((container multimap)) 295 | (make-instance 'multimap_const_iterator 296 | :node (__rbtree-end (__assoc-tree container)))) 297 | 298 | #-cl-stl-0x98 299 | (defmethod crbegin ((container multimap)) 300 | (make-instance 'multimap_const_reverse_iterator 301 | :node (__rbtree-rbegin (__assoc-tree container)))) 302 | 303 | #-cl-stl-0x98 304 | (defmethod crend ((container multimap)) 305 | (make-instance 'multimap_const_reverse_iterator 306 | :node (__rbtree-rend (__assoc-tree container))))) 307 | 308 | 309 | ;;---------------------------------------------------------- 310 | ;; capacity 311 | ;;---------------------------------------------------------- 312 | (locally (declare (optimize speed)) 313 | 314 | (defmethod empty ((container multimap)) 315 | (zerop (__rbtree-size (__assoc-tree container)))) 316 | 317 | (defmethod size ((container multimap)) 318 | (__rbtree-size (__assoc-tree container))) 319 | 320 | (defmethod max_size ((container multimap)) 321 | (__rbtree-max_size (__assoc-tree container)))) 322 | 323 | 324 | ;;---------------------------------------------------------- 325 | ;; element access 326 | ;;---------------------------------------------------------- 327 | ; NONE. 328 | 329 | ;;---------------------------------------------------------- 330 | ;; modifiers 331 | ;;---------------------------------------------------------- 332 | (locally (declare (optimize speed)) 333 | 334 | ;; insert ( single element ) - returns iterator. 335 | (defmethod-overload insert ((container multimap) value) 336 | (make-instance 'multimap_iterator 337 | :node (__rbtree-insert-equal (__assoc-tree container) value t))) 338 | 339 | ;; insert ( single element by remove reference ) - returns iterator. 340 | #-cl-stl-0x98 341 | (defmethod-overload insert ((container multimap) (rm& remove-reference)) 342 | (with-reference (rm) 343 | (let ((val rm)) 344 | (setf rm nil) 345 | (make-instance 'multimap_iterator 346 | :node (__rbtree-insert-equal (__assoc-tree container) val nil))))) 347 | 348 | ;; insert ( single element with hint ) - returns iterator. 349 | (defmethod-overload insert ((container multimap) 350 | (itr #+cl-stl-0x98 multimap_iterator 351 | #-cl-stl-0x98 multimap_const_iterator) value) 352 | #+cl-stl-0x98 ;; HACK 353 | (when (and (typep itr 'multimap_const_iterator) 354 | (typep value 'multimap_const_iterator)) 355 | (__rbtree-insert-range-equal (__assoc-tree container) itr value t) 356 | (return-from __insert-3 nil)) 357 | 358 | #+cl-stl-debug (__multimap-check-iterator-belong itr container) 359 | (make-instance 'multimap_iterator 360 | :node (__rbtree-insert-hint-equal (__assoc-tree container) 361 | (__assoc-itr-node itr) value t))) 362 | 363 | ;; insert ( single element with hint by remove reference ) - returns iterator. 364 | #-cl-stl-0x98 365 | (defmethod-overload insert ((container multimap) 366 | (itr multimap_const_iterator) (rm& remove-reference)) 367 | #+cl-stl-debug (__multimap-check-iterator-belong itr container) 368 | (with-reference (rm) 369 | (let ((val rm)) 370 | (setf rm nil) 371 | (make-instance 'multimap_iterator 372 | :node (__rbtree-insert-hint-equal (__assoc-tree container) 373 | (__assoc-itr-node itr) val nil))))) 374 | 375 | ;; insert ( initializer list ) - returns nil. 376 | #-cl-stl-0x98 377 | (defmethod-overload insert ((container multimap) (il initializer_list)) 378 | (declare (type initializer_list il)) 379 | (let* ((arr (__initlist-data il)) 380 | (cnt (length arr))) 381 | (declare (type simple-vector arr)) 382 | (declare (type fixnum cnt)) 383 | (__rbtree-insert-array-equal (__assoc-tree container) arr 0 cnt t) 384 | nil))) 385 | 386 | ;; range insert - returns nil. 387 | (locally (declare (optimize speed)) 388 | 389 | (defmethod-overload insert ((container multimap) (itr1 input_iterator) (itr2 input_iterator)) 390 | (__rbtree-insert-range-equal (__assoc-tree container) itr1 itr2 t) 391 | nil) 392 | 393 | (defmethod-overload insert ((container multimap) 394 | (itr1 multimap_const_iterator) (itr2 multimap_const_iterator)) 395 | (__rbtree-insert-range-equal (__assoc-tree container) itr1 itr2 t) 396 | nil) 397 | 398 | (defmethod-overload insert ((container multimap) (ptr1 const-vector-pointer) (ptr2 const-vector-pointer)) 399 | (__pointer-check-iterator-range ptr1 ptr2) 400 | (__rbtree-insert-array-equal (__assoc-tree container) 401 | (opr::vec-ptr-buffer ptr1) 402 | (opr::vec-ptr-index ptr1) 403 | (opr::vec-ptr-index ptr2) t) 404 | nil)) 405 | 406 | 407 | ;; emplace 408 | #-cl-stl-0x98 409 | (locally (declare (optimize speed)) 410 | 411 | ;;returns iterator. 412 | (defmethod-overload emplace ((container multimap) new-val) 413 | (make-instance 'multimap_iterator 414 | :node (__rbtree-emplace-equal (__assoc-tree container) new-val))) 415 | 416 | ;;returns iterator. 417 | (defmethod-overload emplace_hint ((container multimap) 418 | (itr multimap_const_iterator) new-val) 419 | #+cl-stl-debug (__multimap-check-iterator-belong itr container) 420 | (make-instance 'multimap_iterator 421 | :node (__rbtree-emplace_hint-equal (__assoc-tree container) 422 | (__assoc-itr-node itr) new-val)))) 423 | 424 | ;;erase 425 | (locally (declare (optimize speed)) 426 | 427 | ;; In 0x98, returns nil. In 0x11 returns iterator. 428 | (defmethod-overload erase ((container multimap) 429 | (itr #+cl-stl-0x98 multimap_iterator 430 | #-cl-stl-0x98 multimap_const_iterator)) 431 | #+cl-stl-debug (__multimap-check-iterator-belong itr container) 432 | (let ((node (__rbtree-erase-node (__assoc-tree container) (__assoc-itr-node itr)))) 433 | (declare (ignorable node)) 434 | #+cl-stl-0x98 nil 435 | #-cl-stl-0x98 (make-instance 'multimap_iterator :node node))) 436 | 437 | ;; In 0x98, returns nil. In 0x11 returns iterator. 438 | (defmethod-overload erase ((container multimap) 439 | (first #+cl-stl-0x98 multimap_iterator #-cl-stl-0x98 multimap_const_iterator) 440 | (last #+cl-stl-0x98 multimap_iterator #-cl-stl-0x98 multimap_const_iterator)) 441 | #+cl-stl-debug (__multimap-check-iterator-range container first last) 442 | (let ((node (__rbtree-erase-range (__assoc-tree container) 443 | (__assoc-itr-node first) (__assoc-itr-node last)))) 444 | (declare (ignorable node)) 445 | #+cl-stl-0x98 nil 446 | #-cl-stl-0x98 (make-instance 'multimap_iterator :node node))) 447 | 448 | ;; returns deleted node count. 449 | (defmethod-overload erase ((container multimap) key) 450 | (__rbtree-erase-key (__assoc-tree container) key))) 451 | 452 | 453 | 454 | (defmethod-overload swap ((cont1 multimap) (cont2 multimap)) 455 | (__rbtree-swap (__assoc-tree cont1) (__assoc-tree cont2)) 456 | (values cont1 cont2)) 457 | 458 | (defmethod clear ((container multimap)) 459 | (__rbtree-clear (__assoc-tree container)) 460 | nil) 461 | 462 | ;;---------------------------------------------------------- 463 | ;; specific operations 464 | ;;---------------------------------------------------------- 465 | (locally (declare (optimize speed)) 466 | 467 | ;; returns iterator. 468 | (defmethod-overload find ((container multimap) key) 469 | (make-instance 'multimap_iterator 470 | :node (__rbtree-find (__assoc-tree container) key))) 471 | 472 | ;; returns fixnum. 473 | (defmethod-overload count ((container multimap) key) 474 | (__rbtree-count (__assoc-tree container) key)) 475 | 476 | ;; returns iterator. 477 | (defmethod-overload lower_bound ((container multimap) key) 478 | (make-instance 'multimap_iterator 479 | :node (__rbtree-lower_bound (__assoc-tree container) key))) 480 | 481 | ;; returns iterator. 482 | (defmethod-overload upper_bound ((container multimap) key) 483 | (make-instance 'multimap_iterator 484 | :node (__rbtree-upper_bound (__assoc-tree container) key))) 485 | 486 | ;; returns pair(itr,itr). 487 | (defmethod-overload equal_range ((container multimap) key) 488 | (let ((tree (__assoc-tree container))) 489 | (make_pair (make-instance 'multimap_iterator 490 | :node (__rbtree-lower_bound tree key)) 491 | (make-instance 'multimap_iterator 492 | :node (__rbtree-upper_bound tree key)))))) 493 | 494 | 495 | ;;---------------------------------------------------------- 496 | ;; observers 497 | ;;---------------------------------------------------------- 498 | (locally (declare (optimize speed)) 499 | 500 | (defmethod key_comp ((container multimap)) 501 | (clone (__rbtree-key_comp (__assoc-tree container)))) 502 | 503 | (defmethod value_comp ((container multimap)) 504 | (let ((fnc (functor_function (clone (__rbtree-key_comp (__assoc-tree container)))))) 505 | (declare (type cl:function fnc)) 506 | (lambda (pr1 pr2) 507 | (funcall fnc (stl:first pr1) (stl:first pr2)))))) 508 | 509 | 510 | ;;---------------------------------------------------------- 511 | ;; compare 512 | ;;---------------------------------------------------------- 513 | (locally (declare (optimize speed)) 514 | 515 | (defmethod operator_== ((cont1 multimap) (cont2 multimap)) 516 | (__rbtree-equal (__assoc-tree cont1) (__assoc-tree cont2) #'operator_==)) 517 | 518 | (defmethod operator_/= ((cont1 multimap) (cont2 multimap)) 519 | (not (__rbtree-equal (__assoc-tree cont1) (__assoc-tree cont2) #'operator_==))) 520 | 521 | (defmethod operator_< ((cont1 multimap) (cont2 multimap)) 522 | (__rbtree-less (__assoc-tree cont1) (__assoc-tree cont2) #'operator_<)) 523 | 524 | (defmethod operator_<= ((cont1 multimap) (cont2 multimap)) 525 | (not (__rbtree-less (__assoc-tree cont2) (__assoc-tree cont1) #'operator_<))) 526 | 527 | (defmethod operator_> ((cont1 multimap) (cont2 multimap)) 528 | (__rbtree-less (__assoc-tree cont2) (__assoc-tree cont1) #'operator_<)) 529 | 530 | (defmethod operator_>= ((cont1 multimap) (cont2 multimap)) 531 | (not (__rbtree-less (__assoc-tree cont1) (__assoc-tree cont2) #'operator_<)))) 532 | 533 | 534 | 535 | ;;---------------------------------------------------------- 536 | ;; enumeration 537 | ;;---------------------------------------------------------- 538 | #-cl-stl-0x98 539 | (defmethod-overload for ((cont multimap) func) 540 | ;MEMO : func is always lambda function ( see stl:for ). 541 | (__rbtree-enumerate (__assoc-tree cont) func)) 542 | 543 | 544 | ;;------------------------------------------------------------------------------ 545 | ;; 546 | ;; methods for multimap_const_iterator 547 | ;; 548 | ;;------------------------------------------------------------------------------ 549 | (defmethod operator_= ((itr1 multimap_const_iterator) (itr2 multimap_const_iterator)) 550 | (__error-when-const-removing-assign itr1 multimap_iterator 551 | itr2 multimap_const_iterator) 552 | (setf (__assoc-itr-node itr1) (__assoc-itr-node itr2)) 553 | itr1) 554 | 555 | (defmethod operator_clone ((itr multimap_const_iterator)) 556 | (make-instance 'multimap_const_iterator :node (__assoc-itr-node itr))) 557 | 558 | (defmethod operator_== ((itr1 multimap_const_iterator) (itr2 multimap_const_iterator)) 559 | (eq (__assoc-itr-node itr1) (__assoc-itr-node itr2))) 560 | 561 | (defmethod operator_/= ((itr1 multimap_const_iterator) (itr2 multimap_const_iterator)) 562 | (not (eq (__assoc-itr-node itr1) (__assoc-itr-node itr2)))) 563 | 564 | (defmethod operator_* ((itr multimap_const_iterator)) 565 | (__rbnode-value (__assoc-itr-node itr))) 566 | 567 | (defmethod (setf operator_*) (new-val (itr multimap_const_iterator)) 568 | (error 'setf-to-const :what "setf to (_* multimap_const_iterator).")) 569 | 570 | (defmethod operator_++ ((itr multimap_const_iterator)) 571 | (setf (__assoc-itr-node itr) (__rbnode-increment (__assoc-itr-node itr))) 572 | itr) 573 | 574 | (defmethod operator_-- ((itr multimap_const_iterator)) 575 | (setf (__assoc-itr-node itr) (__rbnode-decrement (__assoc-itr-node itr))) 576 | itr) 577 | 578 | (locally (declare (optimize speed)) 579 | (defmethod advance ((itr multimap_const_iterator) (n integer)) 580 | (declare (type fixnum n)) 581 | (let ((node (__assoc-itr-node itr))) 582 | (if (>= n 0) 583 | (do ((i 0)) 584 | ((= i n) nil) 585 | (declare (type fixnum i)) 586 | (setf node (__rbnode-increment node)) 587 | (incf i)) 588 | (do ((i 0)) 589 | ((= i n) nil) 590 | (declare (type fixnum i)) 591 | (setf node (__rbnode-decrement node)) 592 | (decf i))) 593 | (setf (__assoc-itr-node itr) node)) 594 | nil)) 595 | 596 | (locally (declare (optimize speed)) 597 | (defmethod distance ((itr1 multimap_const_iterator) (itr2 multimap_const_iterator)) 598 | (let ((cnt 0)) 599 | (declare (type fixnum cnt)) 600 | (do ((node1 (__assoc-itr-node itr1)) 601 | (node2 (__assoc-itr-node itr2))) 602 | ((eq node1 node2) cnt) 603 | (incf cnt) 604 | (setf node1 (__rbnode-increment node1)))))) 605 | 606 | ;; creating reverse iterator. 607 | (define-constructor reverse_iterator ((itr multimap_const_iterator)) 608 | (make-instance 'multimap_const_reverse_iterator 609 | :node (__rbnode-decrement (__assoc-itr-node itr)))) 610 | 611 | 612 | ;;------------------------------------------------------------------------------ 613 | ;; 614 | ;; methods for multimap_iterator 615 | ;; 616 | ;;------------------------------------------------------------------------------ 617 | (defmethod operator_clone ((itr multimap_iterator)) 618 | (make-instance 'multimap_iterator :node (__assoc-itr-node itr))) 619 | 620 | (defmethod operator_cast ((itr multimap_iterator) 621 | (typename (eql 'multimap_const_iterator))) 622 | (__check-exact-type-of-cast itr 'multimap_iterator 'multimap_const_iterator) 623 | (make-instance 'multimap_const_iterator :node (__assoc-itr-node itr))) 624 | 625 | (defmethod (setf operator_*) (new-val (itr multimap_iterator)) 626 | (_= (__rbnode-value (__assoc-itr-node itr)) new-val)) 627 | 628 | ;; creating reverse iterator. 629 | (define-constructor reverse_iterator ((itr multimap_iterator)) 630 | (make-instance 'multimap_reverse_iterator 631 | :node (__rbnode-decrement (__assoc-itr-node itr)))) 632 | 633 | 634 | 635 | ;;------------------------------------------------------------------------------ 636 | ;; 637 | ;; methods for multimap_const_reverse_iterator 638 | ;; 639 | ;;------------------------------------------------------------------------------ 640 | (defmethod operator_= ((itr1 multimap_const_reverse_iterator) 641 | (itr2 multimap_const_reverse_iterator)) 642 | (__error-when-const-removing-assign itr1 multimap_reverse_iterator 643 | itr2 multimap_const_reverse_iterator) 644 | (setf (__assoc-rev-itr-node itr1) (__assoc-rev-itr-node itr2)) 645 | itr1) 646 | 647 | (defmethod operator_clone ((itr multimap_const_reverse_iterator)) 648 | (make-instance 'multimap_const_reverse_iterator :node (__assoc-rev-itr-node itr))) 649 | 650 | (defmethod operator_== ((itr1 multimap_const_reverse_iterator) 651 | (itr2 multimap_const_reverse_iterator)) 652 | (eq (__assoc-rev-itr-node itr1) (__assoc-rev-itr-node itr2))) 653 | 654 | (defmethod operator_/= ((itr1 multimap_const_reverse_iterator) 655 | (itr2 multimap_const_reverse_iterator)) 656 | (not (eq (__assoc-rev-itr-node itr1) (__assoc-rev-itr-node itr2)))) 657 | 658 | (defmethod operator_* ((itr multimap_const_reverse_iterator)) 659 | (__rbnode-value (__assoc-rev-itr-node itr))) 660 | 661 | (defmethod (setf operator_*) (new-val (itr multimap_const_reverse_iterator)) 662 | (error 'setf-to-const :what "setf to (_* multimap_const_reverse_iterator).")) 663 | 664 | (defmethod operator_++ ((itr multimap_const_reverse_iterator)) 665 | (setf (__assoc-rev-itr-node itr) (__rbnode-decrement (__assoc-rev-itr-node itr))) 666 | itr) 667 | 668 | (defmethod operator_-- ((itr multimap_const_reverse_iterator)) 669 | (setf (__assoc-rev-itr-node itr) (__rbnode-increment (__assoc-rev-itr-node itr))) 670 | itr) 671 | 672 | (locally (declare (optimize speed)) 673 | (defmethod advance ((itr multimap_const_reverse_iterator) (n integer)) 674 | (declare (type fixnum n)) 675 | (let ((node (__assoc-rev-itr-node itr))) 676 | (if (>= n 0) 677 | (do ((i 0)) 678 | ((= i n) nil) 679 | (declare (type fixnum i)) 680 | (setf node (__rbnode-decrement node)) 681 | (incf i)) 682 | (do ((i 0)) 683 | ((= i n) nil) 684 | (declare (type fixnum i)) 685 | (setf node (__rbnode-increment node)) 686 | (decf i))) 687 | (setf (__assoc-rev-itr-node itr) node)) 688 | nil)) 689 | 690 | (locally (declare (optimize speed)) 691 | (defmethod distance ((itr1 multimap_const_reverse_iterator) 692 | (itr2 multimap_const_reverse_iterator)) 693 | (let ((cnt 0)) 694 | (declare (type fixnum cnt)) 695 | (do ((node1 (__assoc-rev-itr-node itr1)) 696 | (node2 (__assoc-rev-itr-node itr2))) 697 | ((eq node1 node2) cnt) 698 | (incf cnt) 699 | (setf node1 (__rbnode-decrement node1)))))) 700 | 701 | (defmethod base ((rev-itr multimap_const_reverse_iterator)) 702 | (make-instance 'multimap_const_iterator 703 | :node (__rbnode-increment (__assoc-rev-itr-node rev-itr)))) 704 | 705 | ;; creating reverse iterator. 706 | (define-constructor reverse_iterator ((itr multimap_const_reverse_iterator)) 707 | (make-instance 'multimap_const_iterator 708 | :node (__rbnode-increment (__assoc-rev-itr-node itr)))) 709 | 710 | 711 | ;;------------------------------------------------------------------------------ 712 | ;; 713 | ;; methods for multimap_reverse_iterator 714 | ;; 715 | ;;------------------------------------------------------------------------------ 716 | (defmethod operator_clone ((itr multimap_reverse_iterator)) 717 | (make-instance 'multimap_reverse_iterator :node (__assoc-rev-itr-node itr))) 718 | 719 | (defmethod operator_cast ((itr multimap_reverse_iterator) 720 | (typename (eql 'multimap_const_reverse_iterator))) 721 | (__check-exact-type-of-cast itr 'multimap_reverse_iterator 'multimap_const_reverse_iterator) 722 | (make-instance 'multimap_const_reverse_iterator :node (__assoc-rev-itr-node itr))) 723 | 724 | (defmethod (setf operator_*) (new-val (itr multimap_reverse_iterator)) 725 | (_= (__rbnode-value (__assoc-rev-itr-node itr)) new-val)) 726 | 727 | (defmethod base ((rev-itr multimap_reverse_iterator)) 728 | (make-instance 'multimap_iterator 729 | :node (__rbnode-increment (__assoc-rev-itr-node rev-itr)))) 730 | 731 | ;; creating reverse iterator. 732 | (define-constructor reverse_iterator ((itr multimap_reverse_iterator)) 733 | (make-instance 'multimap_iterator 734 | :node (__rbnode-increment (__assoc-rev-itr-node itr)))) 735 | 736 | 737 | ;;------------------------------------------------------------------------------ 738 | ;; 739 | ;; debug methods for multimap 740 | ;; 741 | ;;------------------------------------------------------------------------------ 742 | #+cl-stl-debug 743 | (defmethod dump ((container multimap) &optional (stream t) (value-printer nil)) 744 | (format stream "begin dump ---------------------~%") 745 | (__rbtree-dump (__assoc-tree container) stream value-printer) 746 | (format stream "end dump -----------------------~%") 747 | nil) 748 | 749 | #+cl-stl-debug 750 | (defmethod check_integrity ((container multimap) &optional (stream t)) 751 | (declare (ignorable stream)) 752 | (__rbtree-verify (__assoc-tree container))) 753 | 754 | -------------------------------------------------------------------------------- /src/cl-stl-multiset.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-stl) 2 | 3 | ;;------------------------------------------------------------------------------ 4 | ;; 5 | ;; class difinition 6 | ;; 7 | ;;------------------------------------------------------------------------------ 8 | (locally (declare (optimize speed)) 9 | 10 | (defclass multiset (bidirectional_container) 11 | ((rbtree :type :rbtree 12 | :initform nil 13 | :initarg :core 14 | :accessor __assoc-tree) 15 | ;TMP; #+cl-stl-debug 16 | ;TMP; (id :type :symbol 17 | ;TMP; :initform (gensym "MULTISET-") 18 | ;TMP; :initarg :id 19 | ;TMP; :accessor __instance-id) 20 | )) 21 | 22 | (defclass multiset_const_iterator (bidirectional_iterator) 23 | ((node :type :rbnode 24 | :initform nil 25 | :initarg :node 26 | :accessor __assoc-itr-node))) 27 | 28 | (defclass multiset_const_reverse_iterator (bidirectional_iterator) 29 | ((node :type :rbnode 30 | :initform nil 31 | :initarg :node 32 | :accessor __assoc-rev-itr-node))) 33 | 34 | (defclass multiset_iterator (multiset_const_iterator) ()) 35 | (defclass multiset_reverse_iterator (multiset_const_reverse_iterator) ())) 36 | 37 | 38 | ;;-------------------------------------------------------------------- 39 | ;; 40 | ;; internal utilities 41 | ;; 42 | ;;-------------------------------------------------------------------- 43 | #+cl-stl-debug 44 | (labels ((__multiset-check-iterator-belong-imp (itr cont) 45 | (let* ((tree (__assoc-tree cont)) 46 | (node (__assoc-itr-node itr))) 47 | (if (eq node (__rbtree-end tree)) 48 | t 49 | (let ((val (__rbnode-value node))) 50 | (handler-case 51 | (do ((node1 (__rbtree-lower_bound tree val) (__rbnode-increment node1)) 52 | (node2 (__rbtree-upper_bound tree val))) 53 | ((eq node1 node2) nil) 54 | (when (eq node node1) 55 | (return t))) 56 | (error () nil))))))) 57 | 58 | (defun __multiset-check-iterator-belong (itr cont) 59 | (unless (__multiset-check-iterator-belong-imp itr cont) 60 | (error 'undefined-behavior :what "Not a iterator of container."))) 61 | 62 | (defun __multiset-check-iterator-range (cont itr1 itr2) 63 | (let* ((tree (__assoc-tree cont)) 64 | (nodeZ (__rbtree-end tree)) 65 | (node1 (__assoc-itr-node itr1)) 66 | (node2 (__assoc-itr-node itr2))) 67 | (if (eq node2 nodeZ) 68 | (if (or (eq node1 nodeZ) 69 | (__multiset-check-iterator-belong-imp itr1 cont)) 70 | t 71 | (error 'undefined-behavior :what "Invalid iterator range.")) 72 | (if (eq node1 nodeZ) 73 | (error 'undefined-behavior :what "Invalid iterator range.") 74 | (if (handler-case 75 | (let ((val1 (__rbnode-value node1)) 76 | (val2 (__rbnode-value node2)) 77 | (comp (functor_function (value_comp cont)))) 78 | (if (funcall comp val2 val1) 79 | nil 80 | (do ((nodeA (__rbtree-lower_bound tree val1) (__rbnode-increment nodeA)) 81 | (nodeB (__rbtree-upper_bound tree val2))) 82 | ((eq nodeA nodeB) nil) 83 | (if (eq node1 nodeA) 84 | (return (__multiset-check-iterator-belong-imp itr2 cont)) 85 | (when (eq node2 nodeA) 86 | (return nil)))))) 87 | (error () nil)) 88 | t 89 | (error 'undefined-behavior :what "Invalid iterator range."))))))) 90 | 91 | ;;-------------------------------------------------------------------- 92 | ;; 93 | ;; method implementation 94 | ;; 95 | ;;-------------------------------------------------------------------- 96 | (locally (declare (optimize speed)) 97 | 98 | (defun __create-multiset (comp) 99 | ;; MEMO : comp copy in __rbtree-ctor. 100 | (let ((tree (__rbtree-ctor comp #'identity))) 101 | (make-instance 'multiset :core tree))) 102 | 103 | (defun __create-multiset-with-range (comp itr1 itr2) 104 | ;; MEMO : comp copy in __rbtree-ctor. 105 | (let ((tree (__rbtree-ctor comp #'identity))) 106 | (__rbtree-insert-range-equal tree itr1 itr2 t) 107 | (make-instance 'multiset :core tree))) 108 | 109 | (defun __create-multiset-with-array (comp arr idx1 idx2) 110 | ;; MEMO : comp copy in __rbtree-ctor. 111 | (let ((tree (__rbtree-ctor comp #'identity))) 112 | (__rbtree-insert-array-equal tree arr idx1 idx2 t) 113 | (make-instance 'multiset :core tree)))) 114 | 115 | 116 | ;;------------------------------------------------------------------------------ 117 | ;; 118 | ;; constructors 119 | ;; 120 | ;;------------------------------------------------------------------------------ 121 | (declare-constructor multiset (0 1 2 3)) 122 | 123 | ; empty constructor 1 124 | (define-constructor multiset () 125 | (__create-multiset #'operator_<)) 126 | 127 | ; empty constructor 2 128 | (define-constructor multiset ((comp cl:function)) 129 | (__create-multiset comp)) 130 | 131 | ; empty constructor 3 132 | (define-constructor multiset ((comp #-cl-stl-0x98 functor 133 | #+cl-stl-0x98 binary_function)) 134 | (__create-multiset comp)) 135 | 136 | ; copy constructor 137 | (define-constructor multiset ((obj multiset)) 138 | (clone obj)) 139 | 140 | ; constructor with initializer list 1 141 | #-cl-stl-0x98 142 | (define-constructor multiset ((il initializer_list)) 143 | (declare (type initializer_list il)) 144 | (let ((arr (__initlist-data il))) 145 | (declare (type simple-vector arr)) 146 | (__create-multiset-with-array #'operator_< arr 0 (length arr)))) 147 | 148 | ; constructor with initializer list 2 149 | #-cl-stl-0x98 150 | (define-constructor multiset ((il initializer_list) (comp cl:function)) 151 | (declare (type initializer_list il)) 152 | (let ((arr (__initlist-data il))) 153 | (declare (type simple-vector arr)) 154 | (__create-multiset-with-array comp arr 0 (length arr)))) 155 | 156 | ; constructor with initializer list 3 157 | #-cl-stl-0x98 158 | (define-constructor multiset ((il initializer_list) 159 | (comp #-cl-stl-0x98 functor 160 | #+cl-stl-0x98 binary_function)) 161 | (declare (type initializer_list il)) 162 | (let ((arr (__initlist-data il))) 163 | (declare (type simple-vector arr)) 164 | (__create-multiset-with-array comp arr 0 (length arr)))) 165 | 166 | ; move constructor 167 | #-cl-stl-0x98 168 | (define-constructor multiset ((arg& remove-reference)) 169 | (with-reference (arg) 170 | (let ((cont arg)) 171 | (__check-type-of-move-constructor cont multiset) 172 | (let ((obj (__create-multiset (key_comp cont)))) 173 | (__rbtree-swap (__assoc-tree obj) (__assoc-tree cont)) 174 | obj)))) 175 | 176 | ; range constructor 177 | (define-constructor multiset ((itr1 input_iterator) (itr2 input_iterator)) 178 | (__create-multiset-with-range #'operator_< itr1 itr2)) 179 | 180 | (define-constructor multiset ((itr1 input_iterator) 181 | (itr2 input_iterator) (comp cl:function)) 182 | (__create-multiset-with-range comp itr1 itr2)) 183 | 184 | (define-constructor multiset ((itr1 input_iterator) 185 | (itr2 input_iterator) (comp #-cl-stl-0x98 functor 186 | #+cl-stl-0x98 binary_function)) 187 | (__create-multiset-with-range comp itr1 itr2)) 188 | 189 | ; range constructor for const-vector-pointer. 190 | (define-constructor multiset ((ptr1 const-vector-pointer) (ptr2 const-vector-pointer)) 191 | (__pointer-check-iterator-range ptr1 ptr2) 192 | (__create-multiset-with-array #'operator_< 193 | (opr::vec-ptr-buffer ptr1) 194 | (opr::vec-ptr-index ptr1) 195 | (opr::vec-ptr-index ptr2))) 196 | 197 | (define-constructor multiset ((ptr1 const-vector-pointer) 198 | (ptr2 const-vector-pointer) (comp cl:function)) 199 | (__pointer-check-iterator-range ptr1 ptr2) 200 | (__create-multiset-with-array comp 201 | (opr::vec-ptr-buffer ptr1) 202 | (opr::vec-ptr-index ptr1) 203 | (opr::vec-ptr-index ptr2))) 204 | 205 | (define-constructor multiset ((ptr1 const-vector-pointer) 206 | (ptr2 const-vector-pointer) (comp #-cl-stl-0x98 functor 207 | #+cl-stl-0x98 binary_function)) 208 | (__pointer-check-iterator-range ptr1 ptr2) 209 | (__create-multiset-with-array comp 210 | (opr::vec-ptr-buffer ptr1) 211 | (opr::vec-ptr-index ptr1) 212 | (opr::vec-ptr-index ptr2))) 213 | 214 | 215 | (defmethod operator_clone ((container multiset)) 216 | (make-instance 'multiset 217 | :core (__rbtree-copy-ctor (__assoc-tree container)))) 218 | 219 | 220 | ;;------------------------------------------------------------------------------ 221 | ;; 222 | ;; methods 223 | ;; 224 | ;;------------------------------------------------------------------------------ 225 | 226 | ;;---------------------------------------------------------- 227 | ;; assignment 228 | ;;---------------------------------------------------------- 229 | (locally (declare (optimize speed)) 230 | 231 | (defmethod operator_= ((cont1 multiset) (cont2 multiset)) 232 | (__rbtree-assign (__assoc-tree cont1) (__assoc-tree cont2)) 233 | cont1) 234 | 235 | #-cl-stl-0x98 236 | (defmethod operator_move ((cont1 multiset) (cont2 multiset)) 237 | (unless (eq cont1 cont2) 238 | (let ((tree1 (__assoc-tree cont1)) 239 | (tree2 (__assoc-tree cont2))) 240 | (__rbtree-clear tree1) 241 | (__rbtree-swap tree1 tree2) 242 | (setf (__rbtree-key_comp tree2) (clone (__rbtree-key_comp tree1))))) 243 | (values cont1 cont2)) 244 | 245 | #-cl-stl-0x98 246 | (defmethod operator_= ((cont multiset) (il initializer_list)) 247 | (declare (type initializer_list il)) 248 | (let ((tree (__assoc-tree cont)) 249 | (arr (__initlist-data il))) 250 | (declare (type rbtree tree)) 251 | (declare (type simple-vector arr)) 252 | (__rbtree-clear tree) 253 | (__rbtree-insert-array-equal tree arr 0 (length arr) t)) 254 | cont)) 255 | 256 | ;;---------------------------------------------------------- 257 | ;; iterators 258 | ;;---------------------------------------------------------- 259 | (locally (declare (optimize speed)) 260 | 261 | (defmethod begin ((container multiset)) 262 | (make-instance 'multiset_iterator 263 | :node (__rbtree-begin (__assoc-tree container)))) 264 | 265 | (defmethod end ((container multiset)) 266 | (make-instance 'multiset_iterator 267 | :node (__rbtree-end (__assoc-tree container)))) 268 | 269 | (defmethod rbegin ((container multiset)) 270 | (make-instance 'multiset_reverse_iterator 271 | :node (__rbtree-rbegin (__assoc-tree container)))) 272 | 273 | (defmethod rend ((container multiset)) 274 | (make-instance 'multiset_reverse_iterator 275 | :node (__rbtree-rend (__assoc-tree container)))) 276 | 277 | #-cl-stl-0x98 278 | (defmethod cbegin ((container multiset)) 279 | (make-instance 'multiset_const_iterator 280 | :node (__rbtree-begin (__assoc-tree container)))) 281 | 282 | #-cl-stl-0x98 283 | (defmethod cend ((container multiset)) 284 | (make-instance 'multiset_const_iterator 285 | :node (__rbtree-end (__assoc-tree container)))) 286 | 287 | #-cl-stl-0x98 288 | (defmethod crbegin ((container multiset)) 289 | (make-instance 'multiset_const_reverse_iterator 290 | :node (__rbtree-rbegin (__assoc-tree container)))) 291 | 292 | #-cl-stl-0x98 293 | (defmethod crend ((container multiset)) 294 | (make-instance 'multiset_const_reverse_iterator 295 | :node (__rbtree-rend (__assoc-tree container))))) 296 | 297 | 298 | ;;---------------------------------------------------------- 299 | ;; capacity 300 | ;;---------------------------------------------------------- 301 | (locally (declare (optimize speed)) 302 | 303 | (defmethod empty ((container multiset)) 304 | (zerop (__rbtree-size (__assoc-tree container)))) 305 | 306 | (defmethod size ((container multiset)) 307 | (__rbtree-size (__assoc-tree container))) 308 | 309 | (defmethod max_size ((container multiset)) 310 | (__rbtree-max_size (__assoc-tree container)))) 311 | 312 | 313 | ;;---------------------------------------------------------- 314 | ;; element access 315 | ;;---------------------------------------------------------- 316 | ; NONE. 317 | 318 | ;;---------------------------------------------------------- 319 | ;; modifiers 320 | ;;---------------------------------------------------------- 321 | (locally (declare (optimize speed)) 322 | 323 | ;; insert ( single element ) - returns iterator. 324 | (defmethod-overload insert ((container multiset) value) 325 | (make-instance 'multiset_iterator 326 | :node (__rbtree-insert-equal (__assoc-tree container) value t))) 327 | 328 | ;; insert ( single element by remove reference ) - returns iterator. 329 | #-cl-stl-0x98 330 | (defmethod-overload insert ((container multiset) (rm& remove-reference)) 331 | (with-reference (rm) 332 | (let ((val rm)) 333 | (setf rm nil) 334 | (make-instance 'multiset_iterator 335 | :node (__rbtree-insert-equal (__assoc-tree container) val nil))))) 336 | 337 | ;; insert ( single element with hint ) - returns iterator. 338 | (defmethod-overload insert ((container multiset) 339 | (itr #+cl-stl-0x98 multiset_iterator 340 | #-cl-stl-0x98 multiset_const_iterator) value) 341 | #+cl-stl-0x98 ;; HACK 342 | (when (and (typep itr 'multiset_const_iterator) 343 | (typep value 'multiset_const_iterator)) 344 | (__rbtree-insert-range-equal (__assoc-tree container) itr value t) 345 | (return-from __insert-3 nil)) 346 | 347 | #+cl-stl-debug (__multiset-check-iterator-belong itr container) 348 | (make-instance 'multiset_iterator 349 | :node (__rbtree-insert-hint-equal (__assoc-tree container) 350 | (__assoc-itr-node itr) value t))) 351 | 352 | ;; insert ( single element with hint by remove reference ) - returns iterator. 353 | #-cl-stl-0x98 354 | (defmethod-overload insert ((container multiset) 355 | (itr multiset_const_iterator) (rm& remove-reference)) 356 | #+cl-stl-debug (__multiset-check-iterator-belong itr container) 357 | (with-reference (rm) 358 | (let ((val rm)) 359 | (setf rm nil) 360 | (make-instance 'multiset_iterator 361 | :node (__rbtree-insert-hint-equal (__assoc-tree container) 362 | (__assoc-itr-node itr) val nil))))) 363 | 364 | ;; insert ( initializer list ) - returns nil. 365 | #-cl-stl-0x98 366 | (defmethod-overload insert ((container multiset) (il initializer_list)) 367 | (declare (type initializer_list il)) 368 | (let ((arr (__initlist-data il))) 369 | (declare (type simple-vector arr)) 370 | (__rbtree-insert-array-equal (__assoc-tree container) arr 0 (length arr) t) 371 | nil))) 372 | 373 | ;; range insert - returns nil. 374 | (locally (declare (optimize speed)) 375 | 376 | (defmethod-overload insert ((container multiset) (itr1 input_iterator) (itr2 input_iterator)) 377 | (__rbtree-insert-range-equal (__assoc-tree container) itr1 itr2 t) 378 | nil) 379 | 380 | (defmethod-overload insert ((container multiset) 381 | (itr1 multiset_const_iterator) (itr2 multiset_const_iterator)) 382 | (__rbtree-insert-range-equal (__assoc-tree container) itr1 itr2 t) 383 | nil) 384 | 385 | (defmethod-overload insert ((container multiset) 386 | (ptr1 const-vector-pointer) (ptr2 const-vector-pointer)) 387 | (__pointer-check-iterator-range ptr1 ptr2) 388 | (__rbtree-insert-array-equal (__assoc-tree container) 389 | (opr::vec-ptr-buffer ptr1) 390 | (opr::vec-ptr-index ptr1) 391 | (opr::vec-ptr-index ptr2) t) 392 | nil)) 393 | 394 | ;; emplace 395 | #-cl-stl-0x98 396 | (locally (declare (optimize speed)) 397 | 398 | ;;returns iterator. 399 | (defmethod-overload emplace ((container multiset) new-val) 400 | (make-instance 'multiset_iterator 401 | :node (__rbtree-emplace-equal (__assoc-tree container) new-val))) 402 | 403 | ;;returns iterator. 404 | (defmethod-overload emplace_hint ((container multiset) 405 | (itr multiset_const_iterator) new-val) 406 | #+cl-stl-debug (__multiset-check-iterator-belong itr container) 407 | (make-instance 'multiset_iterator 408 | :node (__rbtree-emplace_hint-equal (__assoc-tree container) 409 | (__assoc-itr-node itr) new-val)))) 410 | 411 | 412 | ;;erase 413 | (locally (declare (optimize speed)) 414 | 415 | ;; In 0x98, returns nil. In 0x11 returns iterator. 416 | (defmethod-overload erase ((container multiset) 417 | (itr #+cl-stl-0x98 multiset_iterator 418 | #-cl-stl-0x98 multiset_const_iterator)) 419 | #+cl-stl-debug (__multiset-check-iterator-belong itr container) 420 | (let ((node (__rbtree-erase-node (__assoc-tree container) (__assoc-itr-node itr)))) 421 | (declare (ignorable node)) 422 | #+cl-stl-0x98 nil 423 | #-cl-stl-0x98 (make-instance 'multiset_iterator :node node))) 424 | 425 | ;; In 0x98, returns nil. In 0x11 returns iterator. 426 | (defmethod-overload erase ((container multiset) 427 | (first #+cl-stl-0x98 multiset_iterator #-cl-stl-0x98 multiset_const_iterator) 428 | (last #+cl-stl-0x98 multiset_iterator #-cl-stl-0x98 multiset_const_iterator)) 429 | #+cl-stl-debug (__multiset-check-iterator-range container first last) 430 | (let ((node (__rbtree-erase-range (__assoc-tree container) 431 | (__assoc-itr-node first) (__assoc-itr-node last)))) 432 | (declare (ignorable node)) 433 | #+cl-stl-0x98 nil 434 | #-cl-stl-0x98 (make-instance 'multiset_iterator :node node))) 435 | 436 | ;; returns deleted node count. 437 | (defmethod-overload erase ((container multiset) key) 438 | (__rbtree-erase-key (__assoc-tree container) key))) 439 | 440 | 441 | 442 | (defmethod-overload swap ((cont1 multiset) (cont2 multiset)) 443 | (__rbtree-swap (__assoc-tree cont1) (__assoc-tree cont2)) 444 | (values cont1 cont2)) 445 | 446 | (defmethod clear ((container multiset)) 447 | (__rbtree-clear (__assoc-tree container)) 448 | nil) 449 | 450 | ;;---------------------------------------------------------- 451 | ;; specific operations 452 | ;;---------------------------------------------------------- 453 | (locally (declare (optimize speed)) 454 | 455 | ;; returns iterator. 456 | (defmethod-overload find ((container multiset) key) 457 | (make-instance 'multiset_iterator 458 | :node (__rbtree-find (__assoc-tree container) key))) 459 | 460 | ;; returns fixnum. 461 | (defmethod-overload count ((container multiset) key) 462 | (__rbtree-count (__assoc-tree container) key)) 463 | 464 | ;; returns iterator. 465 | (defmethod-overload lower_bound ((container multiset) key) 466 | (make-instance 'multiset_iterator 467 | :node (__rbtree-lower_bound (__assoc-tree container) key))) 468 | 469 | ;; returns iterator. 470 | (defmethod-overload upper_bound ((container multiset) key) 471 | (make-instance 'multiset_iterator 472 | :node (__rbtree-upper_bound (__assoc-tree container) key))) 473 | 474 | ;; returns pair(itr,itr). 475 | (defmethod-overload equal_range ((container multiset) key) 476 | (let ((tree (__assoc-tree container))) 477 | (make_pair (make-instance 'multiset_iterator 478 | :node (__rbtree-lower_bound tree key)) 479 | (make-instance 'multiset_iterator 480 | :node (__rbtree-upper_bound tree key)))))) 481 | 482 | 483 | ;;---------------------------------------------------------- 484 | ;; observers 485 | ;;---------------------------------------------------------- 486 | (locally (declare (optimize speed)) 487 | 488 | (defmethod key_comp ((container multiset)) 489 | (clone (__rbtree-key_comp (__assoc-tree container)))) 490 | 491 | (defmethod value_comp ((container multiset)) 492 | (clone (__rbtree-key_comp (__assoc-tree container))))) 493 | 494 | 495 | ;;---------------------------------------------------------- 496 | ;; compare 497 | ;;---------------------------------------------------------- 498 | (locally (declare (optimize speed)) 499 | 500 | (defmethod operator_== ((cont1 multiset) (cont2 multiset)) 501 | (__rbtree-equal (__assoc-tree cont1) (__assoc-tree cont2) #'operator_==)) 502 | 503 | (defmethod operator_/= ((cont1 multiset) (cont2 multiset)) 504 | (not (__rbtree-equal (__assoc-tree cont1) (__assoc-tree cont2) #'operator_==))) 505 | 506 | (defmethod operator_< ((cont1 multiset) (cont2 multiset)) 507 | (__rbtree-less (__assoc-tree cont1) (__assoc-tree cont2) #'operator_<)) 508 | 509 | (defmethod operator_<= ((cont1 multiset) (cont2 multiset)) 510 | (not (__rbtree-less (__assoc-tree cont2) (__assoc-tree cont1) #'operator_<))) 511 | 512 | (defmethod operator_> ((cont1 multiset) (cont2 multiset)) 513 | (__rbtree-less (__assoc-tree cont2) (__assoc-tree cont1) #'operator_<)) 514 | 515 | (defmethod operator_>= ((cont1 multiset) (cont2 multiset)) 516 | (not (__rbtree-less (__assoc-tree cont1) (__assoc-tree cont2) #'operator_<)))) 517 | 518 | 519 | 520 | ;;---------------------------------------------------------- 521 | ;; enumeration 522 | ;;---------------------------------------------------------- 523 | #-cl-stl-0x98 524 | (defmethod-overload for ((cont multiset) func) 525 | ;MEMO : func is always lambda function ( see stl:for ). 526 | (__rbtree-enumerate (__assoc-tree cont) func)) 527 | 528 | 529 | ;;------------------------------------------------------------------------------ 530 | ;; 531 | ;; methods for multiset_const_iterator 532 | ;; 533 | ;;------------------------------------------------------------------------------ 534 | (defmethod operator_= ((itr1 multiset_const_iterator) (itr2 multiset_const_iterator)) 535 | (__error-when-const-removing-assign itr1 multiset_iterator 536 | itr2 multiset_const_iterator) 537 | (setf (__assoc-itr-node itr1) (__assoc-itr-node itr2)) 538 | itr1) 539 | 540 | (defmethod operator_clone ((itr multiset_const_iterator)) 541 | (make-instance 'multiset_const_iterator :node (__assoc-itr-node itr))) 542 | 543 | (defmethod operator_== ((itr1 multiset_const_iterator) (itr2 multiset_const_iterator)) 544 | (eq (__assoc-itr-node itr1) (__assoc-itr-node itr2))) 545 | 546 | (defmethod operator_/= ((itr1 multiset_const_iterator) (itr2 multiset_const_iterator)) 547 | (not (eq (__assoc-itr-node itr1) (__assoc-itr-node itr2)))) 548 | 549 | (defmethod operator_* ((itr multiset_const_iterator)) 550 | (__rbnode-value (__assoc-itr-node itr))) 551 | 552 | (defmethod (setf operator_*) (new-val (itr multiset_const_iterator)) 553 | (error 'setf-to-const :what "setf to (_* multiset_const_iterator).")) 554 | 555 | (defmethod operator_++ ((itr multiset_const_iterator)) 556 | (setf (__assoc-itr-node itr) (__rbnode-increment (__assoc-itr-node itr))) 557 | itr) 558 | 559 | (defmethod operator_-- ((itr multiset_const_iterator)) 560 | (setf (__assoc-itr-node itr) (__rbnode-decrement (__assoc-itr-node itr))) 561 | itr) 562 | 563 | (locally (declare (optimize speed)) 564 | (defmethod advance ((itr multiset_const_iterator) (n integer)) 565 | (declare (type fixnum n)) 566 | (let ((node (__assoc-itr-node itr))) 567 | (if (>= n 0) 568 | (do ((i 0)) 569 | ((= i n) nil) 570 | (declare (type fixnum i)) 571 | (setf node (__rbnode-increment node)) 572 | (incf i)) 573 | (do ((i 0)) 574 | ((= i n) nil) 575 | (declare (type fixnum i)) 576 | (setf node (__rbnode-decrement node)) 577 | (decf i))) 578 | (setf (__assoc-itr-node itr) node)) 579 | nil)) 580 | 581 | (locally (declare (optimize speed)) 582 | (defmethod distance ((itr1 multiset_const_iterator) (itr2 multiset_const_iterator)) 583 | (let ((cnt 0)) 584 | (declare (type fixnum cnt)) 585 | (do ((node1 (__assoc-itr-node itr1)) 586 | (node2 (__assoc-itr-node itr2))) 587 | ((eq node1 node2) cnt) 588 | (incf cnt) 589 | (setf node1 (__rbnode-increment node1)))))) 590 | 591 | ;; creating reverse iterator. 592 | (define-constructor reverse_iterator ((itr multiset_const_iterator)) 593 | (make-instance 'multiset_const_reverse_iterator 594 | :node (__rbnode-decrement (__assoc-itr-node itr)))) 595 | 596 | 597 | ;;------------------------------------------------------------------------------ 598 | ;; 599 | ;; methods for multiset_iterator 600 | ;; 601 | ;;------------------------------------------------------------------------------ 602 | (defmethod operator_clone ((itr multiset_iterator)) 603 | (make-instance 'multiset_iterator :node (__assoc-itr-node itr))) 604 | 605 | (defmethod operator_cast ((itr multiset_iterator) 606 | (typename (eql 'multiset_const_iterator))) 607 | (__check-exact-type-of-cast itr 'multiset_iterator 'multiset_const_iterator) 608 | (make-instance 'multiset_const_iterator :node (__assoc-itr-node itr))) 609 | 610 | (defmethod (setf operator_*) (new-val (itr multiset_iterator)) 611 | (_= (__rbnode-value (__assoc-itr-node itr)) new-val)) 612 | 613 | ;; creating reverse iterator. 614 | (define-constructor reverse_iterator ((itr multiset_iterator)) 615 | (make-instance 'multiset_reverse_iterator 616 | :node (__rbnode-decrement (__assoc-itr-node itr)))) 617 | 618 | 619 | 620 | ;;------------------------------------------------------------------------------ 621 | ;; 622 | ;; methods for multiset_const_reverse_iterator 623 | ;; 624 | ;;------------------------------------------------------------------------------ 625 | (defmethod operator_= ((itr1 multiset_const_reverse_iterator) 626 | (itr2 multiset_const_reverse_iterator)) 627 | (__error-when-const-removing-assign itr1 multiset_reverse_iterator 628 | itr2 multiset_const_reverse_iterator) 629 | (setf (__assoc-rev-itr-node itr1) (__assoc-rev-itr-node itr2)) 630 | itr1) 631 | 632 | (defmethod operator_clone ((itr multiset_const_reverse_iterator)) 633 | (make-instance 'multiset_const_reverse_iterator :node (__assoc-rev-itr-node itr))) 634 | 635 | (defmethod operator_== ((itr1 multiset_const_reverse_iterator) 636 | (itr2 multiset_const_reverse_iterator)) 637 | (eq (__assoc-rev-itr-node itr1) (__assoc-rev-itr-node itr2))) 638 | 639 | (defmethod operator_/= ((itr1 multiset_const_reverse_iterator) 640 | (itr2 multiset_const_reverse_iterator)) 641 | (not (eq (__assoc-rev-itr-node itr1) (__assoc-rev-itr-node itr2)))) 642 | 643 | (defmethod operator_* ((itr multiset_const_reverse_iterator)) 644 | (__rbnode-value (__assoc-rev-itr-node itr))) 645 | 646 | (defmethod (setf operator_*) (new-val (itr multiset_const_reverse_iterator)) 647 | (error 'setf-to-const :what "setf to (_* multiset_const_reverse_iterator).")) 648 | 649 | (defmethod operator_++ ((itr multiset_const_reverse_iterator)) 650 | (setf (__assoc-rev-itr-node itr) (__rbnode-decrement (__assoc-rev-itr-node itr))) 651 | itr) 652 | 653 | (defmethod operator_-- ((itr multiset_const_reverse_iterator)) 654 | (setf (__assoc-rev-itr-node itr) (__rbnode-increment (__assoc-rev-itr-node itr))) 655 | itr) 656 | 657 | (locally (declare (optimize speed)) 658 | (defmethod advance ((itr multiset_const_reverse_iterator) (n integer)) 659 | (declare (type fixnum n)) 660 | (let ((node (__assoc-rev-itr-node itr))) 661 | (if (>= n 0) 662 | (do ((i 0)) 663 | ((= i n) nil) 664 | (declare (type fixnum i)) 665 | (setf node (__rbnode-decrement node)) 666 | (incf i)) 667 | (do ((i 0)) 668 | ((= i n) nil) 669 | (declare (type fixnum i)) 670 | (setf node (__rbnode-increment node)) 671 | (decf i))) 672 | (setf (__assoc-rev-itr-node itr) node)) 673 | nil)) 674 | 675 | (locally (declare (optimize speed)) 676 | (defmethod distance ((itr1 multiset_const_reverse_iterator) 677 | (itr2 multiset_const_reverse_iterator)) 678 | (let ((cnt 0)) 679 | (declare (type fixnum cnt)) 680 | (do ((node1 (__assoc-rev-itr-node itr1)) 681 | (node2 (__assoc-rev-itr-node itr2))) 682 | ((eq node1 node2) cnt) 683 | (incf cnt) 684 | (setf node1 (__rbnode-decrement node1)))))) 685 | 686 | (defmethod base ((rev-itr multiset_const_reverse_iterator)) 687 | (make-instance 'multiset_const_iterator 688 | :node (__rbnode-increment (__assoc-rev-itr-node rev-itr)))) 689 | 690 | ;; creating reverse iterator. 691 | (define-constructor reverse_iterator ((itr multiset_const_reverse_iterator)) 692 | (make-instance 'multiset_const_iterator 693 | :node (__rbnode-increment (__assoc-rev-itr-node itr)))) 694 | 695 | 696 | ;;------------------------------------------------------------------------------ 697 | ;; 698 | ;; methods for multiset_reverse_iterator 699 | ;; 700 | ;;------------------------------------------------------------------------------ 701 | (defmethod operator_clone ((itr multiset_reverse_iterator)) 702 | (make-instance 'multiset_reverse_iterator :node (__assoc-rev-itr-node itr))) 703 | 704 | (defmethod operator_cast ((itr multiset_reverse_iterator) 705 | (typename (eql 'multiset_const_reverse_iterator))) 706 | (__check-exact-type-of-cast itr 'multiset_reverse_iterator 'multiset_const_reverse_iterator) 707 | (make-instance 'multiset_const_reverse_iterator :node (__assoc-rev-itr-node itr))) 708 | 709 | (defmethod (setf operator_*) (new-val (itr multiset_reverse_iterator)) 710 | (_= (__rbnode-value (__assoc-rev-itr-node itr)) new-val)) 711 | 712 | (defmethod base ((rev-itr multiset_reverse_iterator)) 713 | (make-instance 'multiset_iterator 714 | :node (__rbnode-increment (__assoc-rev-itr-node rev-itr)))) 715 | 716 | ;; creating reverse iterator. 717 | (define-constructor reverse_iterator ((itr multiset_reverse_iterator)) 718 | (make-instance 'multiset_iterator 719 | :node (__rbnode-increment (__assoc-rev-itr-node itr)))) 720 | 721 | 722 | ;;------------------------------------------------------------------------------ 723 | ;; 724 | ;; debug methods for multiset 725 | ;; 726 | ;;------------------------------------------------------------------------------ 727 | #+cl-stl-debug 728 | (defmethod dump ((container multiset) &optional (stream t) (value-printer nil)) 729 | (format stream "begin dump ---------------------~%") 730 | (__rbtree-dump (__assoc-tree container) stream value-printer) 731 | (format stream "end dump -----------------------~%") 732 | nil) 733 | 734 | #+cl-stl-debug 735 | (defmethod check_integrity ((container multiset) &optional (stream t)) 736 | (declare (ignorable stream)) 737 | (__rbtree-verify (__assoc-tree container))) 738 | 739 | -------------------------------------------------------------------------------- /src/cl-stl-priority-queue.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-stl) 2 | 3 | ;;------------------------------------------------------------------------------ 4 | ;; 5 | ;; class difinition 6 | ;; 7 | ;;------------------------------------------------------------------------------ 8 | (defclass priority_queue (clonable) 9 | ((pred :initform #'operator_< 10 | :initarg :pred 11 | :accessor __prique-pred) 12 | (container :type :randomaccess_container 13 | :initform (new stl:vector) 14 | :initarg :container 15 | :accessor __prique-container))) 16 | 17 | 18 | ;;------------------------------------------------------------------------------ 19 | ;; 20 | ;; internal utilities 21 | ;; 22 | ;;------------------------------------------------------------------------------ 23 | (defmacro check-underlying-container-of-prique (cont) 24 | (check-type cont symbol) 25 | `(unless (and (typep ,cont 'randomaccess_container) 26 | (typep ,cont 'pushable_back_container)) 27 | (error 'type-mismatch :what "Underlying container of priority_queue must be randomaccess_container and be pushable_back_container."))) 28 | 29 | 30 | ;;------------------------------------------------------------------------------ 31 | ;; 32 | ;; constructors 33 | ;; 34 | ;;------------------------------------------------------------------------------ 35 | (declare-constructor priority_queue (0 1 2 3 4)) 36 | 37 | ; empty 38 | (define-constructor priority_queue () 39 | (make-instance 'priority_queue 40 | :pred #'operator_< :container (new stl:vector))) 41 | 42 | ; initialize - 1 43 | (define-constructor priority_queue ((comp cl:function)) 44 | (make-instance 'priority_queue 45 | :pred comp :container (new stl:vector))) 46 | 47 | ; initialize - 2 48 | (define-constructor priority_queue ((comp #-cl-stl-0x98 functor 49 | #+cl-stl-0x98 binary_function)) 50 | (make-instance 'priority_queue 51 | :pred (clone comp) :container (new stl:vector))) 52 | 53 | ; initialize - 3 54 | (define-constructor priority_queue ((comp cl:function) 55 | (ctnr randomaccess_container)) 56 | (let ((tmp (clone ctnr))) 57 | (make_heap (begin tmp) (end tmp) comp) 58 | (make-instance 'priority_queue :pred comp :container tmp))) 59 | 60 | ; initialize - 4 61 | (define-constructor priority_queue ((comp #-cl-stl-0x98 functor 62 | #+cl-stl-0x98 binary_function) 63 | (ctnr randomaccess_container)) 64 | (let ((tmp (clone ctnr))) 65 | (make_heap (begin tmp) (end tmp) comp) 66 | (make-instance 'priority_queue 67 | :pred (clone comp) :container tmp))) 68 | 69 | ; range - 1 70 | (define-constructor priority_queue ((itr1 input_iterator) (itr2 input_iterator)) 71 | (let ((tmp (new stl:vector itr1 itr2))) 72 | (make_heap (begin tmp) (end tmp) #'operator_<) 73 | (make-instance 'priority_queue :pred #'operator_< :container tmp))) 74 | 75 | (define-constructor priority_queue ((itr1 const-vector-pointer) (itr2 const-vector-pointer)) 76 | (__pointer-check-iterator-range itr1 itr2) 77 | (let ((tmp (new stl:vector itr1 itr2))) 78 | (make_heap (begin tmp) (end tmp) #'operator_<) 79 | (make-instance 'priority_queue :pred #'operator_< :container tmp))) 80 | 81 | ; range - 2 82 | (define-constructor priority_queue ((itr1 input_iterator) (itr2 input_iterator) (comp cl:function)) 83 | (let ((tmp (new stl:vector itr1 itr2))) 84 | (make_heap (begin tmp) (end tmp) comp) 85 | (make-instance 'priority_queue :pred comp :container tmp))) 86 | 87 | (define-constructor priority_queue ((itr1 const-vector-pointer) (itr2 const-vector-pointer) (comp cl:function)) 88 | (__pointer-check-iterator-range itr1 itr2) 89 | (let ((tmp (new stl:vector itr1 itr2))) 90 | (make_heap (begin tmp) (end tmp) comp) 91 | (make-instance 'priority_queue :pred comp :container tmp))) 92 | 93 | ; range - 3 94 | (define-constructor priority_queue ((itr1 input_iterator) (itr2 input_iterator) 95 | (comp #-cl-stl-0x98 functor 96 | #+cl-stl-0x98 binary_function)) 97 | (let ((tmp (new stl:vector itr1 itr2))) 98 | (make_heap (begin tmp) (end tmp) comp) 99 | (make-instance 'priority_queue :pred (clone comp) :container tmp))) 100 | 101 | (define-constructor priority_queue ((itr1 const-vector-pointer) (itr2 const-vector-pointer) 102 | (comp #-cl-stl-0x98 functor 103 | #+cl-stl-0x98 binary_function)) 104 | (__pointer-check-iterator-range itr1 itr2) 105 | (let ((tmp (new stl:vector itr1 itr2))) 106 | (make_heap (begin tmp) (end tmp) comp) 107 | (make-instance 'priority_queue :pred (clone comp) :container tmp))) 108 | 109 | ; range - 4 110 | (define-constructor priority_queue ((itr1 input_iterator) (itr2 input_iterator) 111 | (comp cl:function) (ctnr randomaccess_container)) 112 | (let ((tmp (clone ctnr))) 113 | (insert tmp (end tmp) itr1 itr2) 114 | (make_heap (begin tmp) (end tmp) comp) 115 | (make-instance 'priority_queue :pred comp :container tmp))) 116 | 117 | (define-constructor priority_queue ((itr1 const-vector-pointer) (itr2 const-vector-pointer) 118 | (comp cl:function) (ctnr randomaccess_container)) 119 | (__pointer-check-iterator-range itr1 itr2) 120 | (let ((tmp (clone ctnr))) 121 | (insert tmp (end tmp) itr1 itr2) 122 | (make_heap (begin tmp) (end tmp) comp) 123 | (make-instance 'priority_queue :pred comp :container tmp))) 124 | 125 | ; range - 5 126 | (define-constructor priority_queue ((itr1 input_iterator) (itr2 input_iterator) 127 | (comp #-cl-stl-0x98 functor 128 | #+cl-stl-0x98 binary_function) (ctnr randomaccess_container)) 129 | (let ((tmp (clone ctnr))) 130 | (insert tmp (end tmp) itr1 itr2) 131 | (make_heap (begin tmp) (end tmp) comp) 132 | (make-instance 'priority_queue :pred (clone comp) :container tmp))) 133 | 134 | (define-constructor priority_queue ((itr1 const-vector-pointer) (itr2 const-vector-pointer) 135 | (comp #-cl-stl-0x98 functor 136 | #+cl-stl-0x98 binary_function) (ctnr randomaccess_container)) 137 | (__pointer-check-iterator-range itr1 itr2) 138 | (let ((tmp (clone ctnr))) 139 | (insert tmp (end tmp) itr1 itr2) 140 | (make_heap (begin tmp) (end tmp) comp) 141 | (make-instance 'priority_queue :pred (clone comp) :container tmp))) 142 | 143 | ; copy constructor 144 | (define-constructor priority_queue ((cont priority_queue)) 145 | (make-instance 'priority_queue 146 | :pred (clone (__prique-pred cont)) 147 | :container (clone (__prique-container cont)))) 148 | 149 | ; move-initialize - 1 150 | #-cl-stl-0x98 151 | (define-constructor priority_queue ((comp cl:function) 152 | (rm& remove-reference)) 153 | (with-reference (rm) 154 | (let ((cont rm)) 155 | (check-underlying-container-of-prique cont) 156 | (let ((tmp (dynamic-new (type-of cont)))) 157 | (swap tmp cont) 158 | (make_heap (begin tmp) (end tmp) comp) 159 | (make-instance 'priority_queue :pred comp :container tmp))))) 160 | 161 | ; move-initialize - 2 162 | #-cl-stl-0x98 163 | (define-constructor priority_queue ((comp #-cl-stl-0x98 functor 164 | #+cl-stl-0x98 binary_function) 165 | (rm& remove-reference)) 166 | (with-reference (rm) 167 | (let ((cont rm)) 168 | (check-underlying-container-of-prique cont) 169 | (let ((tmp (dynamic-new (type-of cont)))) 170 | (swap tmp cont) 171 | (make_heap (begin tmp) (end tmp) comp) 172 | (make-instance 'priority_queue :pred (clone comp) :container tmp))))) 173 | 174 | #-cl-stl-0x98 175 | (labels ((__ctor-imp (itr1 itr2 comp rm&) 176 | (with-reference (rm) 177 | (let ((cont rm)) 178 | (check-underlying-container-of-prique cont) 179 | (let ((tmp (dynamic-new (type-of cont)))) 180 | ;;(setf rm nil) 181 | (swap tmp cont) 182 | (insert tmp (end tmp) itr1 itr2) 183 | (make_heap (begin tmp) (end tmp) comp) 184 | (make-instance 'priority_queue :pred comp :container tmp)))))) 185 | 186 | ;; move-range - 1 187 | (define-constructor priority_queue ((itr1 input_iterator) (itr2 input_iterator) 188 | (comp cl:function) (rm remove-reference)) 189 | (__ctor-imp itr1 itr2 comp rm)) 190 | 191 | (define-constructor priority_queue ((itr1 const-vector-pointer) (itr2 const-vector-pointer) 192 | (comp cl:function) (rm remove-reference)) 193 | (__pointer-check-iterator-range itr1 itr2) 194 | (__ctor-imp itr1 itr2 comp rm)) 195 | 196 | ;; move-range - 2 197 | (define-constructor priority_queue ((itr1 input_iterator) (itr2 input_iterator) 198 | (comp #-cl-stl-0x98 functor 199 | #+cl-stl-0x98 binary_function) (rm remove-reference)) 200 | (__ctor-imp itr1 itr2 comp rm)) 201 | 202 | (define-constructor priority_queue ((itr1 const-vector-pointer) (itr2 const-vector-pointer) 203 | (comp #-cl-stl-0x98 functor 204 | #+cl-stl-0x98 binary_function) (rm remove-reference)) 205 | (__pointer-check-iterator-range itr1 itr2) 206 | (__ctor-imp itr1 itr2 comp rm))) 207 | 208 | ; move constructor. 209 | #-cl-stl-0x98 210 | (define-constructor priority_queue ((rm& remove-reference)) 211 | (with-reference (rm) 212 | (let ((cont rm)) 213 | (__check-type-of-move-constructor cont priority_queue) 214 | (let* ((src-pred (__prique-pred cont)) 215 | (src-cont (__prique-container cont)) 216 | (new-pred (clone src-pred)) 217 | (new-cont (dynamic-new (type-of src-cont)))) 218 | (swap new-cont src-cont) 219 | (make-instance 'priority_queue 220 | :pred new-pred :container new-cont))))) 221 | 222 | 223 | 224 | (defmethod operator_clone ((arg priority_queue)) 225 | (make-instance 'priority_queue 226 | :pred (clone (__prique-pred arg)) 227 | :container (clone (__prique-container arg)))) 228 | 229 | 230 | ;;------------------------------------------------------------------------------ 231 | ;; 232 | ;; methods 233 | ;; 234 | ;;------------------------------------------------------------------------------ 235 | 236 | ;----------------------------------------------------- 237 | ; capacity 238 | ;----------------------------------------------------- 239 | (defmethod empty ((cont priority_queue)) 240 | (zerop (size cont))) 241 | 242 | (defmethod size ((cont priority_queue)) 243 | (size (__prique-container cont))) 244 | 245 | ;----------------------------------------------------- 246 | ; element access 247 | ;----------------------------------------------------- 248 | (defmethod top ((cont priority_queue)) 249 | (front (__prique-container cont))) 250 | 251 | ;----------------------------------------------------- 252 | ; modifiers 253 | ;----------------------------------------------------- 254 | (defmethod push ((cont priority_queue) val) 255 | (let ((pred (__prique-pred cont)) 256 | (cont (__prique-container cont))) 257 | (push_back cont val) 258 | (push_heap (begin cont) (end cont) pred)) 259 | nil) 260 | 261 | (defmethod pop ((cont priority_queue)) 262 | (let ((pred (__prique-pred cont)) 263 | (cont (__prique-container cont))) 264 | (pop_heap (begin cont) (end cont) pred) 265 | (pop_back cont)) 266 | nil) 267 | 268 | 269 | #-cl-stl-0x98 ; emplace 270 | (defmethod-overload emplace ((container priority_queue) new-val) 271 | (let ((pred (__prique-pred container)) 272 | (cont (__prique-container container))) 273 | (__emplace_back-2 cont new-val) 274 | (push_heap (begin cont) (end cont) pred)) 275 | nil) 276 | 277 | #-cl-stl-0x98 278 | (defmethod-overload swap ((cont1 priority_queue) 279 | (cont2 priority_queue)) 280 | (swap (__que-container cont1) (__que-container cont2)) 281 | (values cont1 cont2)) 282 | 283 | -------------------------------------------------------------------------------- /src/cl-stl-queue.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-stl) 2 | 3 | ;;------------------------------------------------------------------------------ 4 | ;; 5 | ;; class difinition 6 | ;; 7 | ;;------------------------------------------------------------------------------ 8 | (defclass queue (clonable) 9 | ((container :type :pushable_front_container 10 | :initform (new stl:deque) 11 | :initarg :container 12 | :accessor __que-container))) 13 | 14 | 15 | ;;------------------------------------------------------------------------------ 16 | ;; 17 | ;; internal utilities 18 | ;; 19 | ;;------------------------------------------------------------------------------ 20 | (defmacro check-underlying-container-of-queue (cont) 21 | (check-type cont symbol) 22 | `(unless (and (typep ,cont 'pushable_back_container) 23 | (typep ,cont 'pushable_front_container)) 24 | (error 'type-mismatch :what "Underlying container of queue must be pushable_back_container and be pushable_front_container."))) 25 | 26 | 27 | ;;------------------------------------------------------------------------------ 28 | ;; 29 | ;; constructors 30 | ;; 31 | ;;------------------------------------------------------------------------------ 32 | (declare-constructor queue (0 1)) 33 | 34 | ; empty 35 | (define-constructor queue () 36 | (make-instance 'queue :container (new stl:deque))) 37 | 38 | ; initialize 39 | ; MEMO : container arg is copied. 40 | (define-constructor queue ((arg pushable_front_container)) 41 | (check-type arg pushable_back_container) 42 | (make-instance 'queue :container (clone arg))) 43 | 44 | ; copy constructor 45 | (define-constructor queue ((arg queue)) 46 | (let ((cont (__que-container arg))) 47 | (make-instance 'queue :container (clone cont)))) 48 | 49 | ; move constructor & move init constructor 50 | #-cl-stl-0x98 51 | (define-constructor queue ((arg& remove-reference)) 52 | (with-reference (arg) 53 | (let ((cont arg)) 54 | (if (eq (type-of cont) 'queue) 55 | (let* ((src-cont (__que-container cont)) 56 | (new-cont (dynamic-new (type-of src-cont)))) 57 | (swap new-cont src-cont) 58 | (make-instance 'queue :container new-cont)) 59 | (progn 60 | (check-underlying-container-of-queue cont) 61 | (let ((new-cont (dynamic-new (type-of cont)))) 62 | (swap new-cont cont) 63 | (make-instance 'queue :container new-cont))))))) 64 | 65 | ;; take internal container type 66 | ; example : (new stl:queue foo:cont) 67 | (define-constructor queue ((arg symbol)) 68 | (let ((cont (dynamic-new arg))) 69 | (check-underlying-container-of-queue cont) 70 | (make-instance 'queue :container cont))) 71 | 72 | (defmethod operator_clone ((arg queue)) 73 | (make-instance 'queue 74 | :container (clone (__que-container arg)))) 75 | 76 | 77 | ;;------------------------------------------------------------------------------ 78 | ;; 79 | ;; methods 80 | ;; 81 | ;;------------------------------------------------------------------------------ 82 | 83 | ;----------------------------------------------------- 84 | ; capacity 85 | ;----------------------------------------------------- 86 | (defmethod empty ((cont queue)) 87 | (zerop (size cont))) 88 | 89 | (defmethod size ((cont queue)) 90 | (size (__que-container cont))) 91 | 92 | ;----------------------------------------------------- 93 | ; element access 94 | ;----------------------------------------------------- 95 | (defmethod front ((cont queue)) 96 | (front (__que-container cont))) 97 | 98 | (defmethod (setf front) (val (cont queue)) 99 | (_= (front (__que-container cont)) val)) 100 | 101 | (defmethod back ((cont queue)) 102 | (back (__que-container cont))) 103 | 104 | (defmethod (setf back) (val (cont queue)) 105 | (_= (back (__que-container cont)) val)) 106 | 107 | ;----------------------------------------------------- 108 | ; modifiers 109 | ;----------------------------------------------------- 110 | (defmethod push ((cont queue) val) 111 | (push_back (__que-container cont) val) 112 | nil) 113 | 114 | (defmethod pop ((cont queue)) 115 | (pop_front (__que-container cont)) 116 | nil) 117 | 118 | 119 | #-cl-stl-0x98 ; emplace 120 | (defmethod-overload emplace ((container queue) new-val) 121 | (__emplace_back-2 (__que-container container) new-val) 122 | #+(or cl-stl-0x11 cl-stl-0x14) nil 123 | #-(or cl-stl-0x11 cl-stl-0x14) new-val) 124 | 125 | #-cl-stl-0x98 126 | (defmethod-overload swap ((cont1 queue) (cont2 queue)) 127 | (swap (__que-container cont1) (__que-container cont2)) 128 | (values cont1 cont2)) 129 | 130 | 131 | ;----------------------------------------------------- 132 | ; compare 133 | ;----------------------------------------------------- 134 | (locally (declare (optimize speed)) 135 | (labels ((__container-equal (cont1 cont2) 136 | (if (/= (the fixnum (size cont1)) 137 | (the fixnum (size cont2))) 138 | nil 139 | (if (zerop (the fixnum (size cont1))) 140 | t 141 | (let ((cont1 (__que-container cont1)) 142 | (cont2 (__que-container cont2))) 143 | (with-operators 144 | (for (((itr1 (begin cont1)) 145 | (itr2 (begin cont2)) 146 | (end2 (end cont2))) (_/= itr2 end2) (progn ++itr1 ++itr2) :returns t) 147 | (unless (_== *itr1 *itr2) 148 | (return-from __container-equal nil))))))))) 149 | 150 | (defmethod operator_== ((cont1 queue) (cont2 queue)) 151 | (__container-equal cont1 cont2)) 152 | 153 | (defmethod operator_/= ((cont1 queue) (cont2 queue)) 154 | (not (__container-equal cont1 cont2))))) 155 | 156 | 157 | 158 | (locally (declare (optimize speed)) 159 | (labels ((__container-compare (cont1 cont2) 160 | (with-operators 161 | (for (((itr1 (begin cont1)) 162 | (itr1-end (end cont1)) 163 | (itr2 (begin cont2)) 164 | (itr2-end (end cont2))) t (progn ++itr1 ++itr2)) 165 | (let ((end1 (_== itr1 itr1-end)) 166 | (end2 (_== itr2 itr2-end))) 167 | (if (and end1 end2) 168 | (return-from __container-compare 0) 169 | (if end1 170 | (return-from __container-compare -1) 171 | (if end2 172 | (return-from __container-compare 1) 173 | (let ((val1 *itr1) 174 | (val2 *itr2)) 175 | (if (_< val1 val2) 176 | (return-from __container-compare -1) 177 | (if (_< val2 val1) 178 | (return-from __container-compare 1)))))))))))) 179 | 180 | (defmethod operator_< ((cont1 queue) (cont2 queue)) 181 | (< (__container-compare (__que-container cont1) (__que-container cont2)) 0)) 182 | 183 | (defmethod operator_<= ((cont1 queue) (cont2 queue)) 184 | (<= (__container-compare (__que-container cont1) (__que-container cont2)) 0)) 185 | 186 | (defmethod operator_> ((cont1 queue) (cont2 queue)) 187 | (< 0 (__container-compare (__que-container cont1) (__que-container cont2)))) 188 | 189 | (defmethod operator_>= ((cont1 queue) (cont2 queue)) 190 | (<= 0 (__container-compare (__que-container cont1) (__que-container cont2)))))) 191 | 192 | 193 | -------------------------------------------------------------------------------- /src/cl-stl-rbnode.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-stl) 2 | 3 | (declaim (inline __rbnode-color 4 | __rbnode-parent 5 | __rbnode-left 6 | __rbnode-right 7 | __rbnode-value 8 | (setf __rbnode-color) 9 | (setf __rbnode-parent) 10 | (setf __rbnode-left) 11 | (setf __rbnode-right) 12 | (setf __rbnode-value) 13 | __rbnode-is-red 14 | __rbnode-is-black 15 | __rbnode-is-left-child 16 | __rbnode-is-right-child)) 17 | 18 | 19 | 20 | ;;------------------------------------------------------------------------------ 21 | ;; 22 | ;; class difinition 23 | ;; 24 | ;;------------------------------------------------------------------------------ 25 | (locally (declare (optimize speed)) 26 | (defstruct (rbnode (:conc-name __rbnode-)) 27 | (color :red :type symbol) 28 | (parent nil) 29 | (left nil) 30 | (right nil) 31 | (value nil))) 32 | 33 | 34 | ;;------------------------------------------------------------------------------ 35 | ;; 36 | ;; rbnode utilities 37 | ;; 38 | ;;------------------------------------------------------------------------------ 39 | (locally (declare (optimize speed)) 40 | 41 | (defun __rbnode-is-red (node) 42 | (declare (type rbnode node)) 43 | (eq :red (__rbnode-color node))) 44 | 45 | (defun __rbnode-is-black (node) 46 | (declare (type rbnode node)) 47 | (eq :black (__rbnode-color node))) 48 | 49 | (defun __rbnode-is-left-child (node) 50 | (declare (type rbnode node)) 51 | (eq node (__rbnode-left (__rbnode-parent node)))) 52 | 53 | (defun __rbnode-is-right-child (node) 54 | (declare (type rbnode node)) 55 | (eq node (__rbnode-right (__rbnode-parent node))))) 56 | 57 | 58 | 59 | (locally (declare (optimize speed)) 60 | 61 | (defun __rbnode-minimum (node) 62 | (declare (type rbnode node)) 63 | (let ((left (__rbnode-left node))) 64 | (if (null left) 65 | node 66 | (__rbnode-minimum left)))) 67 | 68 | (defun __rbnode-maximum (node) 69 | (declare (type rbnode node)) 70 | (let ((right (__rbnode-right node))) 71 | (if (null right) 72 | node 73 | (__rbnode-maximum right))))) 74 | 75 | 76 | 77 | (locally (declare (optimize speed)) 78 | (defun __rbnode-increment (node) 79 | (declare (type rbnode node)) 80 | (if (__rbnode-right node) 81 | (progn 82 | (setf node (__rbnode-right node)) 83 | (do () 84 | ((null (__rbnode-left node)) node) 85 | (setf node (__rbnode-left node)))) 86 | (let ((node2 (__rbnode-parent node))) 87 | (declare (type rbnode node2)) 88 | (do () 89 | ((not (eq node (__rbnode-right node2)))) 90 | (setf node node2) 91 | (setf node2 (__rbnode-parent node2))) 92 | (unless (eq (__rbnode-right node) node2) 93 | (setf node node2)) 94 | node)))) 95 | 96 | (locally (declare (optimize speed)) 97 | (defun __rbnode-decrement (node) 98 | (declare (type rbnode node)) 99 | (if (and (__rbnode-is-red node) 100 | (eq node (__rbnode-parent (__rbnode-parent node)))) 101 | (__rbnode-right node) 102 | (if (__rbnode-left node) 103 | (let ((node2 (__rbnode-left node))) 104 | (declare (type rbnode node2)) 105 | (do () 106 | ((null (__rbnode-right node2)) node2) 107 | (setf node2 (__rbnode-right node2)))) 108 | (let ((node2 (__rbnode-parent node))) 109 | (declare (type rbnode node2)) 110 | (do () 111 | ((not (eq node (__rbnode-left node2))) node2) 112 | (setf node node2) 113 | (setf node2 (__rbnode-parent node2)))))))) 114 | 115 | 116 | (locally (declare (optimize speed)) 117 | (defun __rbnode-rotate-left (node root) 118 | (declare (type rbnode node root)) 119 | (let ((right (__rbnode-right node))) 120 | (declare (type rbnode right)) 121 | (setf (__rbnode-right node) (__rbnode-left right)) 122 | (when (__rbnode-left right) 123 | (setf (__rbnode-parent (__rbnode-left right)) node)) 124 | (setf (__rbnode-parent right) (__rbnode-parent node)) 125 | (if (eq node root) 126 | (setf root right) 127 | (if (eq node (__rbnode-left (__rbnode-parent node))) 128 | (setf (__rbnode-left (__rbnode-parent node)) right) 129 | (setf (__rbnode-right (__rbnode-parent node)) right))) 130 | (setf (__rbnode-left right) node) 131 | (setf (__rbnode-parent node) right) 132 | root))) 133 | 134 | 135 | (locally (declare (optimize speed)) 136 | (defun __rbnode-rotate-right (node root) 137 | (declare (type rbnode node root)) 138 | (let ((left (__rbnode-left node))) 139 | (declare (type rbnode left)) 140 | (setf (__rbnode-left node) (__rbnode-right left)) 141 | (when (__rbnode-right left) 142 | (setf (__rbnode-parent (__rbnode-right left)) node)) 143 | (setf (__rbnode-parent left) (__rbnode-parent node)) 144 | (if (eq node root) 145 | (setf root left) 146 | (if (eq node (__rbnode-right (__rbnode-parent node))) 147 | (setf (__rbnode-right (__rbnode-parent node)) left) 148 | (setf (__rbnode-left (__rbnode-parent node)) left))) 149 | (setf (__rbnode-right left) node) 150 | (setf (__rbnode-parent node) left) 151 | root))) 152 | 153 | -------------------------------------------------------------------------------- /src/cl-stl-set.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-stl) 2 | 3 | ;;------------------------------------------------------------------------------ 4 | ;; 5 | ;; class difinition 6 | ;; 7 | ;;------------------------------------------------------------------------------ 8 | (locally (declare (optimize speed)) 9 | 10 | (defclass set (bidirectional_container) 11 | ((rbtree :type :rbtree 12 | :initform nil 13 | :initarg :core 14 | :accessor __assoc-tree) 15 | ;TMP; #+cl-stl-debug 16 | ;TMP; (id :type :symbol 17 | ;TMP; :initform (gensym "SET-") 18 | ;TMP; :initarg :id 19 | ;TMP; :accessor __instance-id) 20 | )) 21 | 22 | (defclass set_const_iterator (bidirectional_iterator) 23 | ((node :type :rbnode 24 | :initform nil 25 | :initarg :node 26 | :accessor __assoc-itr-node))) 27 | 28 | (defclass set_const_reverse_iterator (bidirectional_iterator) 29 | ((node :type :rbnode 30 | :initform nil 31 | :initarg :node 32 | :accessor __assoc-rev-itr-node))) 33 | 34 | (defclass set_iterator (set_const_iterator) ()) 35 | (defclass set_reverse_iterator (set_const_reverse_iterator) ())) 36 | 37 | 38 | ;;-------------------------------------------------------------------- 39 | ;; 40 | ;; internal utilities 41 | ;; 42 | ;;-------------------------------------------------------------------- 43 | #+cl-stl-debug 44 | (labels ((__set-check-iterator-belong-imp (itr cont) 45 | (let* ((tree (__assoc-tree cont)) 46 | (node (__assoc-itr-node itr))) 47 | (if (eq node (__rbtree-end tree)) 48 | t 49 | (handler-case 50 | (eq node (__rbtree-lower_bound tree (__rbnode-value node))) 51 | (error () nil)))))) 52 | 53 | (defun __set-check-iterator-belong (itr cont) 54 | (unless (__set-check-iterator-belong-imp itr cont) 55 | (error 'undefined-behavior :what "Not a iterator of container."))) 56 | 57 | (defun __set-check-iterator-range (cont itr1 itr2) 58 | (let* ((tree (__assoc-tree cont)) 59 | (nodeZ (__rbtree-end tree)) 60 | (node1 (__assoc-itr-node itr1)) 61 | (node2 (__assoc-itr-node itr2))) 62 | (if (eq node2 nodeZ) 63 | (if (or (eq node1 nodeZ) 64 | (__set-check-iterator-belong-imp itr1 cont)) 65 | t 66 | (error 'undefined-behavior :what "Invalid iterator range.")) 67 | (if (eq node1 nodeZ) 68 | (error 'undefined-behavior :what "Invalid iterator range.") 69 | (if (handler-case 70 | (let ((val1 (__rbnode-value node1)) 71 | (val2 (__rbnode-value node2))) 72 | (and (eq node1 (__rbtree-lower_bound tree val1)) 73 | (eq node2 (__rbtree-lower_bound tree val2)) 74 | (not (funcall (value_comp cont) val2 val1)))) 75 | (error () nil)) 76 | t 77 | (error 'undefined-behavior :what "Invalid iterator range."))))))) 78 | 79 | 80 | ;;-------------------------------------------------------------------- 81 | ;; 82 | ;; method implementation 83 | ;; 84 | ;;-------------------------------------------------------------------- 85 | (locally (declare (optimize speed)) 86 | 87 | (defun __create-set (comp) 88 | ;; MEMO : comp copy in __rbtree-ctor. 89 | (let ((tree (__rbtree-ctor comp #'identity))) 90 | (make-instance 'stl::set :core tree))) 91 | 92 | (defun __create-set-with-range (comp itr1 itr2) 93 | ;; MEMO : comp copy in __rbtree-ctor. 94 | (let ((tree (__rbtree-ctor comp #'identity))) 95 | (__rbtree-insert-range-unique tree itr1 itr2 t) 96 | (make-instance 'stl::set :core tree))) 97 | 98 | (defun __create-set-with-array (comp arr idx1 idx2) 99 | ;; MEMO : comp copy in __rbtree-ctor. 100 | (let ((tree (__rbtree-ctor comp #'identity))) 101 | (__rbtree-insert-array-unique tree arr idx1 idx2 t) 102 | (make-instance 'stl::set :core tree)))) 103 | 104 | 105 | ;;------------------------------------------------------------------------------ 106 | ;; 107 | ;; constructors 108 | ;; 109 | ;;------------------------------------------------------------------------------ 110 | (declare-constructor set (0 1 2 3)) 111 | 112 | ; empty constructor 1 113 | (define-constructor set () 114 | (__create-set #'operator_<)) 115 | 116 | ; empty constructor 2 117 | (define-constructor set ((comp cl:function)) 118 | (__create-set comp)) 119 | 120 | ; empty constructor 3 121 | (define-constructor set ((comp #-cl-stl-0x98 functor 122 | #+cl-stl-0x98 binary_function)) 123 | (__create-set comp)) 124 | 125 | ; copy constructor 126 | (define-constructor set ((obj stl::set)) 127 | (clone obj)) 128 | 129 | ; constructor with initializer list 1 130 | #-cl-stl-0x98 131 | (define-constructor set ((il initializer_list)) 132 | (declare (type initializer_list il)) 133 | (let ((arr (__initlist-data il))) 134 | (declare (type simple-vector arr)) 135 | (__create-set-with-array #'operator_< arr 0 (length arr)))) 136 | 137 | ; constructor with initializer list 2 138 | #-cl-stl-0x98 139 | (define-constructor set ((il initializer_list) (comp cl:function)) 140 | (declare (type initializer_list il)) 141 | (let ((arr (__initlist-data il))) 142 | (declare (type simple-vector arr)) 143 | (__create-set-with-array comp arr 0 (length arr)))) 144 | 145 | ; constructor with initializer list 3 146 | #-cl-stl-0x98 147 | (define-constructor set ((il initializer_list) 148 | (comp #-cl-stl-0x98 functor 149 | #+cl-stl-0x98 binary_function)) 150 | (declare (type initializer_list il)) 151 | (let ((arr (__initlist-data il))) 152 | (declare (type simple-vector arr)) 153 | (__create-set-with-array comp arr 0 (length arr)))) 154 | 155 | ; move constructor 156 | #-cl-stl-0x98 157 | (define-constructor set ((arg& remove-reference)) 158 | (with-reference (arg) 159 | (let ((cont arg)) 160 | (__check-type-of-move-constructor cont stl::set) 161 | (let ((obj (__create-set (key_comp cont)))) 162 | (__rbtree-swap (__assoc-tree obj) (__assoc-tree cont)) 163 | obj)))) 164 | 165 | ; range constructor 166 | (define-constructor set ((itr1 input_iterator) (itr2 input_iterator)) 167 | (__create-set-with-range #'operator_< itr1 itr2)) 168 | 169 | (define-constructor set ((itr1 input_iterator) 170 | (itr2 input_iterator) (comp cl:function)) 171 | (__create-set-with-range comp itr1 itr2)) 172 | 173 | (define-constructor set ((itr1 input_iterator) 174 | (itr2 input_iterator) (comp #-cl-stl-0x98 functor 175 | #+cl-stl-0x98 binary_function)) 176 | (__create-set-with-range comp itr1 itr2)) 177 | 178 | ; range constructor for const-vector-pointer. 179 | (define-constructor set ((ptr1 const-vector-pointer) (ptr2 const-vector-pointer)) 180 | (__pointer-check-iterator-range ptr1 ptr2) 181 | (__create-set-with-array #'operator_< 182 | (opr::vec-ptr-buffer ptr1) 183 | (opr::vec-ptr-index ptr1) 184 | (opr::vec-ptr-index ptr2))) 185 | 186 | (define-constructor set ((ptr1 const-vector-pointer) 187 | (ptr2 const-vector-pointer) (comp cl:function)) 188 | (__pointer-check-iterator-range ptr1 ptr2) 189 | (__create-set-with-array comp 190 | (opr::vec-ptr-buffer ptr1) 191 | (opr::vec-ptr-index ptr1) 192 | (opr::vec-ptr-index ptr2))) 193 | 194 | (define-constructor set ((ptr1 const-vector-pointer) 195 | (ptr2 const-vector-pointer) (comp #-cl-stl-0x98 functor 196 | #+cl-stl-0x98 binary_function)) 197 | (__pointer-check-iterator-range ptr1 ptr2) 198 | (__create-set-with-array comp 199 | (opr::vec-ptr-buffer ptr1) 200 | (opr::vec-ptr-index ptr1) 201 | (opr::vec-ptr-index ptr2))) 202 | 203 | 204 | 205 | (defmethod operator_clone ((container stl::set)) 206 | (make-instance 'stl::set 207 | :core (__rbtree-copy-ctor (__assoc-tree container)))) 208 | 209 | 210 | ;;------------------------------------------------------------------------------ 211 | ;; 212 | ;; methods 213 | ;; 214 | ;;------------------------------------------------------------------------------ 215 | 216 | ;;---------------------------------------------------------- 217 | ;; assignment 218 | ;;---------------------------------------------------------- 219 | (locally (declare (optimize speed)) 220 | 221 | (defmethod operator_= ((cont1 stl::set) (cont2 stl::set)) 222 | (__rbtree-assign (__assoc-tree cont1) (__assoc-tree cont2)) 223 | cont1) 224 | 225 | #-cl-stl-0x98 226 | (defmethod operator_move ((cont1 stl::set) (cont2 stl::set)) 227 | (unless (eq cont1 cont2) 228 | (let ((tree1 (__assoc-tree cont1)) 229 | (tree2 (__assoc-tree cont2))) 230 | (__rbtree-clear tree1) 231 | (__rbtree-swap tree1 tree2) 232 | (setf (__rbtree-key_comp tree2) (clone (__rbtree-key_comp tree1))))) 233 | (values cont1 cont2)) 234 | 235 | #-cl-stl-0x98 236 | (defmethod operator_= ((cont stl::set) (il initializer_list)) 237 | (declare (type initializer_list il)) 238 | (let ((tree (__assoc-tree cont)) 239 | (arr (__initlist-data il))) 240 | (declare (type rbtree tree)) 241 | (declare (type simple-vector arr)) 242 | (__rbtree-clear tree) 243 | (__rbtree-insert-array-unique tree arr 0 (length arr) t)) 244 | cont)) 245 | 246 | 247 | ;;---------------------------------------------------------- 248 | ;; iterators 249 | ;;---------------------------------------------------------- 250 | (locally (declare (optimize speed)) 251 | 252 | (defmethod begin ((container stl::set)) 253 | (make-instance 'set_iterator 254 | :node (__rbtree-begin (__assoc-tree container)))) 255 | 256 | (defmethod end ((container stl::set)) 257 | (make-instance 'set_iterator 258 | :node (__rbtree-end (__assoc-tree container)))) 259 | 260 | (defmethod rbegin ((container stl::set)) 261 | (make-instance 'set_reverse_iterator 262 | :node (__rbtree-rbegin (__assoc-tree container)))) 263 | 264 | (defmethod rend ((container stl::set)) 265 | (make-instance 'set_reverse_iterator 266 | :node (__rbtree-rend (__assoc-tree container)))) 267 | 268 | #-cl-stl-0x98 269 | (defmethod cbegin ((container stl::set)) 270 | (make-instance 'set_const_iterator 271 | :node (__rbtree-begin (__assoc-tree container)))) 272 | 273 | #-cl-stl-0x98 274 | (defmethod cend ((container stl::set)) 275 | (make-instance 'set_const_iterator 276 | :node (__rbtree-end (__assoc-tree container)))) 277 | 278 | #-cl-stl-0x98 279 | (defmethod crbegin ((container stl::set)) 280 | (make-instance 'set_const_reverse_iterator 281 | :node (__rbtree-rbegin (__assoc-tree container)))) 282 | 283 | #-cl-stl-0x98 284 | (defmethod crend ((container stl::set)) 285 | (make-instance 'set_const_reverse_iterator 286 | :node (__rbtree-rend (__assoc-tree container))))) 287 | 288 | 289 | ;;---------------------------------------------------------- 290 | ;; capacity 291 | ;;---------------------------------------------------------- 292 | (locally (declare (optimize speed)) 293 | 294 | (defmethod empty ((container stl::set)) 295 | (zerop (__rbtree-size (__assoc-tree container)))) 296 | 297 | (defmethod size ((container stl::set)) 298 | (__rbtree-size (__assoc-tree container))) 299 | 300 | (defmethod max_size ((container stl::set)) 301 | (__rbtree-max_size (__assoc-tree container)))) 302 | 303 | 304 | ;;---------------------------------------------------------- 305 | ;; element access 306 | ;;---------------------------------------------------------- 307 | ; NONE. 308 | 309 | ;;---------------------------------------------------------- 310 | ;; modifiers 311 | ;;---------------------------------------------------------- 312 | (locally (declare (optimize speed)) 313 | 314 | ;; insert ( single element ) - returns pair. 315 | (defmethod-overload insert ((container stl::set) value) 316 | (multiple-value-bind (node success) 317 | (__rbtree-insert-unique (__assoc-tree container) value t) 318 | (make_pair (make-instance 'set_iterator :node node) success))) 319 | 320 | ;; insert ( single element by remove reference ) - returns pair. 321 | #-cl-stl-0x98 322 | (defmethod-overload insert ((container stl::set) (rm& remove-reference)) 323 | (with-reference (rm) 324 | (let ((val rm)) 325 | (setf rm nil) 326 | (multiple-value-bind (node success) 327 | (__rbtree-insert-unique (__assoc-tree container) val nil) 328 | (make_pair (make-instance 'set_iterator :node node) success))))) 329 | 330 | ;; insert ( single element with hint ) - returns iterator. 331 | (defmethod-overload insert ((container stl::set) 332 | (itr #+cl-stl-0x98 set_iterator 333 | #-cl-stl-0x98 set_const_iterator) value) 334 | #+cl-stl-0x98 ;; HACK 335 | (when (and (typep itr 'set_const_iterator) 336 | (typep value 'set_const_iterator)) 337 | (__rbtree-insert-range-unique (__assoc-tree container) itr value t) 338 | (return-from __insert-3 nil)) 339 | 340 | #+cl-stl-debug (__set-check-iterator-belong itr container) 341 | (make-instance 'set_iterator 342 | :node (__rbtree-insert-hint-unique (__assoc-tree container) 343 | (__assoc-itr-node itr) value t))) 344 | 345 | ;; insert ( single element with hint by remove reference ) - returns iterator. 346 | #-cl-stl-0x98 347 | (defmethod-overload insert ((container stl::set) 348 | (itr set_const_iterator) (rm& remove-reference)) 349 | #+cl-stl-debug (__set-check-iterator-belong itr container) 350 | (with-reference (rm) 351 | (let ((val rm)) 352 | (setf rm nil) 353 | (make-instance 'set_iterator 354 | :node (__rbtree-insert-hint-unique (__assoc-tree container) 355 | (__assoc-itr-node itr) val nil))))) 356 | 357 | ;; insert ( initializer list ) - returns nil. 358 | #-cl-stl-0x98 359 | (defmethod-overload insert ((container stl::set) (il initializer_list)) 360 | (declare (type initializer_list il)) 361 | (let ((arr (__initlist-data il))) 362 | (declare (type simple-vector arr)) 363 | (__rbtree-insert-array-unique (__assoc-tree container) arr 0 (length arr) t) 364 | nil))) 365 | 366 | 367 | ;; range insert - returns nil. 368 | (locally (declare (optimize speed)) 369 | 370 | (defmethod-overload insert ((container stl::set) (itr1 input_iterator) (itr2 input_iterator)) 371 | (__rbtree-insert-range-unique (__assoc-tree container) itr1 itr2 t) 372 | nil) 373 | 374 | (defmethod-overload insert ((container stl::set) (itr1 set_const_iterator) (itr2 set_const_iterator)) 375 | (__rbtree-insert-range-unique (__assoc-tree container) itr1 itr2 t) 376 | nil) 377 | 378 | (defmethod-overload insert ((container stl::set) (ptr1 const-vector-pointer) (ptr2 const-vector-pointer)) 379 | (__pointer-check-iterator-range ptr1 ptr2) 380 | (__rbtree-insert-array-unique (__assoc-tree container) 381 | (opr::vec-ptr-buffer ptr1) 382 | (opr::vec-ptr-index ptr1) 383 | (opr::vec-ptr-index ptr2) t) 384 | nil)) 385 | 386 | ;; emplace 387 | #-cl-stl-0x98 388 | (locally (declare (optimize speed)) 389 | 390 | ;;returns pair. 391 | (defmethod-overload emplace ((container stl::set) new-val) 392 | (multiple-value-bind (node success) 393 | (__rbtree-emplace-unique (__assoc-tree container) new-val) 394 | (make_pair (make-instance 'set_iterator :node node) success))) 395 | 396 | ;;returns iterator. 397 | (defmethod-overload emplace_hint ((container stl::set) 398 | (itr set_const_iterator) new-val) 399 | #+cl-stl-debug (__set-check-iterator-belong itr container) 400 | (make-instance 'set_iterator 401 | :node (__rbtree-emplace_hint-unique (__assoc-tree container) 402 | (__assoc-itr-node itr) new-val)))) 403 | 404 | ;;erase 405 | (locally (declare (optimize speed)) 406 | 407 | ;; In 0x98, returns nil. In 0x11 returns iterator. 408 | (defmethod-overload erase ((container stl::set) 409 | (itr #+cl-stl-0x98 set_iterator 410 | #-cl-stl-0x98 set_const_iterator)) 411 | #+cl-stl-debug (__set-check-iterator-belong itr container) 412 | (let ((node (__rbtree-erase-node (__assoc-tree container) (__assoc-itr-node itr)))) 413 | (declare (ignorable node)) 414 | #+cl-stl-0x98 nil 415 | #-cl-stl-0x98 (make-instance 'set_iterator :node node))) 416 | 417 | ;; In 0x98, returns nil. In 0x11 returns iterator. 418 | (defmethod-overload erase ((container stl::set) 419 | (first #+cl-stl-0x98 set_iterator #-cl-stl-0x98 set_const_iterator) 420 | (last #+cl-stl-0x98 set_iterator #-cl-stl-0x98 set_const_iterator)) 421 | #+cl-stl-debug (__set-check-iterator-range container first last) 422 | (let ((node (__rbtree-erase-range (__assoc-tree container) 423 | (__assoc-itr-node first) (__assoc-itr-node last)))) 424 | (declare (ignorable node)) 425 | #+cl-stl-0x98 nil 426 | #-cl-stl-0x98 (make-instance 'set_iterator :node node))) 427 | 428 | ;; returns deleted node count. 429 | (defmethod-overload erase ((container stl::set) key) 430 | (__rbtree-erase-key (__assoc-tree container) key))) 431 | 432 | 433 | (defmethod-overload swap ((cont1 stl::set) (cont2 stl::set)) 434 | (__rbtree-swap (__assoc-tree cont1) (__assoc-tree cont2)) 435 | (values cont1 cont2)) 436 | 437 | (defmethod clear ((container stl::set)) 438 | (__rbtree-clear (__assoc-tree container)) 439 | nil) 440 | 441 | ;;---------------------------------------------------------- 442 | ;; specific operations 443 | ;;---------------------------------------------------------- 444 | (locally (declare (optimize speed)) 445 | 446 | ;; returns iterator. 447 | (defmethod-overload find ((container stl::set) key) 448 | (make-instance 'set_iterator 449 | :node (__rbtree-find (__assoc-tree container) key))) 450 | 451 | ;; returns integer. 452 | (defmethod-overload count ((container stl::set) key) 453 | (__rbtree-count (__assoc-tree container) key)) 454 | 455 | ;; returns iterator. 456 | (defmethod-overload lower_bound ((container stl::set) key) 457 | (make-instance 'set_iterator 458 | :node (__rbtree-lower_bound (__assoc-tree container) key))) 459 | 460 | ;; returns iterator. 461 | (defmethod-overload upper_bound ((container stl::set) key) 462 | (make-instance 'set_iterator 463 | :node (__rbtree-upper_bound (__assoc-tree container) key))) 464 | 465 | ;; returns pair(itr,itr). 466 | (defmethod-overload equal_range ((container stl::set) key) 467 | (let ((tree (__assoc-tree container))) 468 | (make_pair (make-instance 'set_iterator 469 | :node (__rbtree-lower_bound tree key)) 470 | (make-instance 'set_iterator 471 | :node (__rbtree-upper_bound tree key)))))) 472 | 473 | 474 | ;;---------------------------------------------------------- 475 | ;; observers 476 | ;;---------------------------------------------------------- 477 | (locally (declare (optimize speed)) 478 | 479 | (defmethod key_comp ((container stl::set)) 480 | (clone (__rbtree-key_comp (__assoc-tree container)))) 481 | 482 | (defmethod value_comp ((container stl::set)) 483 | (clone (__rbtree-key_comp (__assoc-tree container))))) 484 | 485 | 486 | ;;---------------------------------------------------------- 487 | ;; compare 488 | ;;---------------------------------------------------------- 489 | (locally (declare (optimize speed)) 490 | 491 | (defmethod operator_== ((cont1 stl::set) (cont2 stl::set)) 492 | (__rbtree-equal (__assoc-tree cont1) (__assoc-tree cont2) #'operator_==)) 493 | 494 | (defmethod operator_/= ((cont1 stl::set) (cont2 stl::set)) 495 | (not (__rbtree-equal (__assoc-tree cont1) (__assoc-tree cont2) #'operator_==))) 496 | 497 | (defmethod operator_< ((cont1 stl::set) (cont2 stl::set)) 498 | (__rbtree-less (__assoc-tree cont1) (__assoc-tree cont2) #'operator_<)) 499 | 500 | (defmethod operator_<= ((cont1 stl::set) (cont2 stl::set)) 501 | (not (__rbtree-less (__assoc-tree cont2) (__assoc-tree cont1) #'operator_<))) 502 | 503 | (defmethod operator_> ((cont1 stl::set) (cont2 stl::set)) 504 | (__rbtree-less (__assoc-tree cont2) (__assoc-tree cont1) #'operator_<)) 505 | 506 | (defmethod operator_>= ((cont1 stl::set) (cont2 stl::set)) 507 | (not (__rbtree-less (__assoc-tree cont1) (__assoc-tree cont2) #'operator_<)))) 508 | 509 | 510 | 511 | ;;---------------------------------------------------------- 512 | ;; enumeration 513 | ;;---------------------------------------------------------- 514 | #-cl-stl-0x98 515 | (defmethod-overload for ((cont stl::set) func) 516 | ;MEMO : func is always lambda function ( see stl:for ). 517 | (__rbtree-enumerate (__assoc-tree cont) func)) 518 | 519 | 520 | ;;------------------------------------------------------------------------------ 521 | ;; 522 | ;; methods for set_const_iterator 523 | ;; 524 | ;;------------------------------------------------------------------------------ 525 | (defmethod operator_= ((itr1 set_const_iterator) (itr2 set_const_iterator)) 526 | (__error-when-const-removing-assign itr1 set_iterator 527 | itr2 set_const_iterator) 528 | (setf (__assoc-itr-node itr1) (__assoc-itr-node itr2)) 529 | itr1) 530 | 531 | (defmethod operator_clone ((itr set_const_iterator)) 532 | (make-instance 'set_const_iterator :node (__assoc-itr-node itr))) 533 | 534 | (defmethod operator_== ((itr1 set_const_iterator) (itr2 set_const_iterator)) 535 | (eq (__assoc-itr-node itr1) (__assoc-itr-node itr2))) 536 | 537 | (defmethod operator_/= ((itr1 set_const_iterator) (itr2 set_const_iterator)) 538 | (not (eq (__assoc-itr-node itr1) (__assoc-itr-node itr2)))) 539 | 540 | (defmethod operator_* ((itr set_const_iterator)) 541 | (__rbnode-value (__assoc-itr-node itr))) 542 | 543 | (defmethod (setf operator_*) (new-val (itr set_const_iterator)) 544 | (error 'setf-to-const :what "setf to (_* set_const_iterator).")) 545 | 546 | (defmethod operator_++ ((itr set_const_iterator)) 547 | (setf (__assoc-itr-node itr) (__rbnode-increment (__assoc-itr-node itr))) 548 | itr) 549 | 550 | (defmethod operator_-- ((itr set_const_iterator)) 551 | (setf (__assoc-itr-node itr) (__rbnode-decrement (__assoc-itr-node itr))) 552 | itr) 553 | 554 | (locally (declare (optimize speed)) 555 | (defmethod advance ((itr set_const_iterator) (n integer)) 556 | (declare (type fixnum n)) 557 | (let ((node (__assoc-itr-node itr))) 558 | (if (>= n 0) 559 | (do ((i 0)) 560 | ((= i n) nil) 561 | (declare (type fixnum i)) 562 | (setf node (__rbnode-increment node)) 563 | (incf i)) 564 | (do ((i 0)) 565 | ((= i n) nil) 566 | (declare (type fixnum i)) 567 | (setf node (__rbnode-decrement node)) 568 | (decf i))) 569 | (setf (__assoc-itr-node itr) node)) 570 | nil)) 571 | 572 | (locally (declare (optimize speed)) 573 | (defmethod distance ((itr1 set_const_iterator) (itr2 set_const_iterator)) 574 | (let ((cnt 0)) 575 | (declare (type fixnum cnt)) 576 | (do ((node1 (__assoc-itr-node itr1)) 577 | (node2 (__assoc-itr-node itr2))) 578 | ((eq node1 node2) cnt) 579 | (incf cnt) 580 | (setf node1 (__rbnode-increment node1)))))) 581 | 582 | ;; creating reverse iterator. 583 | (define-constructor reverse_iterator ((itr set_const_iterator)) 584 | (make-instance 'set_const_reverse_iterator 585 | :node (__rbnode-decrement (__assoc-itr-node itr)))) 586 | 587 | 588 | ;;------------------------------------------------------------------------------ 589 | ;; 590 | ;; methods for set_iterator 591 | ;; 592 | ;;------------------------------------------------------------------------------ 593 | (defmethod operator_clone ((itr set_iterator)) 594 | (make-instance 'set_iterator :node (__assoc-itr-node itr))) 595 | 596 | (defmethod operator_cast ((itr set_iterator) 597 | (typename (eql 'set_const_iterator))) 598 | (__check-exact-type-of-cast itr 'set_iterator 'set_const_iterator) 599 | (make-instance 'set_const_iterator :node (__assoc-itr-node itr))) 600 | 601 | (defmethod (setf operator_*) (new-val (itr set_iterator)) 602 | (_= (__rbnode-value (__assoc-itr-node itr)) new-val)) 603 | 604 | ;; creating reverse iterator. 605 | (define-constructor reverse_iterator ((itr set_iterator)) 606 | (make-instance 'set_reverse_iterator 607 | :node (__rbnode-decrement (__assoc-itr-node itr)))) 608 | 609 | 610 | 611 | ;;------------------------------------------------------------------------------ 612 | ;; 613 | ;; methods for set_const_reverse_iterator 614 | ;; 615 | ;;------------------------------------------------------------------------------ 616 | (defmethod operator_= ((itr1 set_const_reverse_iterator) 617 | (itr2 set_const_reverse_iterator)) 618 | (__error-when-const-removing-assign itr1 set_reverse_iterator 619 | itr2 set_const_reverse_iterator) 620 | (setf (__assoc-rev-itr-node itr1) (__assoc-rev-itr-node itr2)) 621 | itr1) 622 | 623 | (defmethod operator_clone ((itr set_const_reverse_iterator)) 624 | (make-instance 'set_const_reverse_iterator :node (__assoc-rev-itr-node itr))) 625 | 626 | (defmethod operator_== ((itr1 set_const_reverse_iterator) 627 | (itr2 set_const_reverse_iterator)) 628 | (eq (__assoc-rev-itr-node itr1) (__assoc-rev-itr-node itr2))) 629 | 630 | (defmethod operator_/= ((itr1 set_const_reverse_iterator) 631 | (itr2 set_const_reverse_iterator)) 632 | (not (eq (__assoc-rev-itr-node itr1) (__assoc-rev-itr-node itr2)))) 633 | 634 | (defmethod operator_* ((itr set_const_reverse_iterator)) 635 | (__rbnode-value (__assoc-rev-itr-node itr))) 636 | 637 | (defmethod (setf operator_*) (new-val (itr set_const_reverse_iterator)) 638 | (error 'setf-to-const :what "setf to (_* set_const_reverse_iterator).")) 639 | 640 | (defmethod operator_++ ((itr set_const_reverse_iterator)) 641 | (setf (__assoc-rev-itr-node itr) (__rbnode-decrement (__assoc-rev-itr-node itr))) 642 | itr) 643 | 644 | (defmethod operator_-- ((itr set_const_reverse_iterator)) 645 | (setf (__assoc-rev-itr-node itr) (__rbnode-increment (__assoc-rev-itr-node itr))) 646 | itr) 647 | 648 | (locally (declare (optimize speed)) 649 | (defmethod advance ((itr set_const_reverse_iterator) (n integer)) 650 | (declare (type fixnum n)) 651 | (let ((node (__assoc-rev-itr-node itr))) 652 | (if (>= n 0) 653 | (do ((i 0)) 654 | ((= i n) nil) 655 | (declare (type fixnum i)) 656 | (setf node (__rbnode-decrement node)) 657 | (incf i)) 658 | (do ((i 0)) 659 | ((= i n) nil) 660 | (declare (type fixnum i)) 661 | (setf node (__rbnode-increment node)) 662 | (decf i))) 663 | (setf (__assoc-rev-itr-node itr) node)) 664 | nil)) 665 | 666 | (locally (declare (optimize speed)) 667 | (defmethod distance ((itr1 set_const_reverse_iterator) 668 | (itr2 set_const_reverse_iterator)) 669 | (let ((cnt 0)) 670 | (declare (type fixnum cnt)) 671 | (do ((node1 (__assoc-rev-itr-node itr1)) 672 | (node2 (__assoc-rev-itr-node itr2))) 673 | ((eq node1 node2) cnt) 674 | (incf cnt) 675 | (setf node1 (__rbnode-decrement node1)))))) 676 | 677 | (defmethod base ((rev-itr set_const_reverse_iterator)) 678 | (make-instance 'set_const_iterator 679 | :node (__rbnode-increment (__assoc-rev-itr-node rev-itr)))) 680 | 681 | ;; creating reverse iterator. 682 | (define-constructor reverse_iterator ((itr set_const_reverse_iterator)) 683 | (make-instance 'set_const_iterator 684 | :node (__rbnode-increment (__assoc-rev-itr-node itr)))) 685 | 686 | 687 | ;;------------------------------------------------------------------------------ 688 | ;; 689 | ;; methods for set_reverse_iterator 690 | ;; 691 | ;;------------------------------------------------------------------------------ 692 | (defmethod operator_clone ((itr set_reverse_iterator)) 693 | (make-instance 'set_reverse_iterator :node (__assoc-rev-itr-node itr))) 694 | 695 | (defmethod operator_cast ((itr set_reverse_iterator) 696 | (typename (eql 'set_const_reverse_iterator))) 697 | (__check-exact-type-of-cast itr 'set_reverse_iterator 'set_const_reverse_iterator) 698 | (make-instance 'set_const_reverse_iterator :node (__assoc-rev-itr-node itr))) 699 | 700 | (defmethod (setf operator_*) (new-val (itr set_reverse_iterator)) 701 | (_= (__rbnode-value (__assoc-rev-itr-node itr)) new-val)) 702 | 703 | (defmethod base ((rev-itr set_reverse_iterator)) 704 | (make-instance 'set_iterator 705 | :node (__rbnode-increment (__assoc-rev-itr-node rev-itr)))) 706 | 707 | ;; creating reverse iterator. 708 | (define-constructor reverse_iterator ((itr set_reverse_iterator)) 709 | (make-instance 'set_iterator 710 | :node (__rbnode-increment (__assoc-rev-itr-node itr)))) 711 | 712 | 713 | ;;------------------------------------------------------------------------------ 714 | ;; 715 | ;; debug methods for stl::set 716 | ;; 717 | ;;------------------------------------------------------------------------------ 718 | #+cl-stl-debug 719 | (defmethod dump ((container stl::set) &optional (stream t) (value-printer nil)) 720 | (format stream "begin dump ---------------------~%") 721 | (__rbtree-dump (__assoc-tree container) stream value-printer) 722 | (format stream "end dump -----------------------~%") 723 | nil) 724 | 725 | #+cl-stl-debug 726 | (defmethod check_integrity ((container stl::set) &optional (stream t)) 727 | (declare (ignorable stream)) 728 | (__rbtree-verify (__assoc-tree container))) 729 | 730 | -------------------------------------------------------------------------------- /src/cl-stl-stack.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-stl) 2 | 3 | ;;------------------------------------------------------------------------------ 4 | ;; 5 | ;; class difinition 6 | ;; 7 | ;;------------------------------------------------------------------------------ 8 | (defclass stack (clonable) 9 | ((container :type :pushable_back_container 10 | :initform (new stl:deque) 11 | :initarg :container 12 | :accessor __stck-container))) 13 | 14 | ;;------------------------------------------------------------------------------ 15 | ;; 16 | ;; internal utilities 17 | ;; 18 | ;;------------------------------------------------------------------------------ 19 | (defmacro check-underlying-container-of-stack (cont) 20 | (check-type cont symbol) 21 | `(unless (typep ,cont 'pushable_back_container) 22 | (error 'type-mismatch :what "Underlying container of stack must be pushable_back_container."))) 23 | 24 | 25 | ;;------------------------------------------------------------------------------ 26 | ;; 27 | ;; constructors 28 | ;; 29 | ;;------------------------------------------------------------------------------ 30 | (declare-constructor stack (0 1)) 31 | 32 | ; empty 33 | (define-constructor stack () 34 | (make-instance 'stack :container (new stl:deque))) 35 | 36 | ; initialize 37 | ; MEMO : container arg is copied. 38 | (define-constructor stack ((arg pushable_back_container)) 39 | (make-instance 'stack :container (clone arg))) 40 | 41 | ; copy constructor 42 | (define-constructor stack ((arg stack)) 43 | (let ((cont (__stck-container arg))) 44 | (make-instance 'stack :container (clone cont)))) 45 | 46 | ; move constructor & move init constructor 47 | #-cl-stl-0x98 48 | (define-constructor stack ((arg& remove-reference)) 49 | (with-reference (arg) 50 | (let ((cont arg)) 51 | (if (eq (type-of cont) 'stack) 52 | (let* ((src-cont (__stck-container cont)) 53 | (new-cont (dynamic-new (type-of src-cont)))) 54 | (swap new-cont src-cont) 55 | (make-instance 'stack :container new-cont)) 56 | (progn 57 | (check-underlying-container-of-stack cont) 58 | (let ((new-cont (dynamic-new (type-of cont)))) 59 | (swap new-cont cont) 60 | (make-instance 'stack :container new-cont))))))) 61 | 62 | ;; take internal container type 63 | ;; example : (new stl:stack foo:cont) 64 | (define-constructor stack ((arg symbol)) 65 | (let ((cont (dynamic-new arg))) 66 | (check-underlying-container-of-stack cont) 67 | (make-instance 'stack :container cont))) 68 | 69 | (defmethod operator_clone ((arg stack)) 70 | (make-instance 'stack 71 | :container (clone (__stck-container arg)))) 72 | 73 | 74 | ;;------------------------------------------------------------------------------ 75 | ;; 76 | ;; methods 77 | ;; 78 | ;;------------------------------------------------------------------------------ 79 | 80 | ;----------------------------------------------------- 81 | ; capacity 82 | ;----------------------------------------------------- 83 | (defmethod empty ((cont stack)) 84 | (zerop (size cont))) 85 | 86 | (defmethod size ((cont stack)) 87 | (size (__stck-container cont))) 88 | 89 | ;----------------------------------------------------- 90 | ; element access 91 | ;----------------------------------------------------- 92 | (defmethod top ((cont stack)) 93 | (back (__stck-container cont))) 94 | 95 | (defmethod (setf top) (val (cont stack)) 96 | (_= (back (__stck-container cont)) val)) 97 | 98 | ;----------------------------------------------------- 99 | ; modifiers 100 | ;----------------------------------------------------- 101 | (defmethod push ((cont stack) val) 102 | (push_back (__stck-container cont) val) 103 | nil) 104 | 105 | (defmethod pop ((cont stack)) 106 | (pop_back (__stck-container cont)) 107 | nil) 108 | 109 | 110 | #-cl-stl-0x98 ; emplace 111 | (defmethod-overload emplace ((container stack) new-val) 112 | (__emplace_back-2 (__stck-container container) new-val) 113 | #+(or cl-stl-0x11 cl-stl-0x14) nil 114 | #-(or cl-stl-0x11 cl-stl-0x14) new-val) 115 | 116 | #-cl-stl-0x98 117 | (defmethod-overload swap ((cont1 stack) (cont2 stack)) 118 | (swap (__stck-container cont1) (__stck-container cont2)) 119 | (values cont1 cont2)) 120 | 121 | 122 | ;----------------------------------------------------- 123 | ; compare 124 | ;----------------------------------------------------- 125 | (locally (declare (optimize speed)) 126 | (labels ((__container-equal (cont1 cont2) 127 | (if (/= (the fixnum (size cont1)) 128 | (the fixnum (size cont2))) 129 | nil 130 | (if (zerop (the fixnum (size cont1))) 131 | t 132 | (let ((cont1 (__stck-container cont1)) 133 | (cont2 (__stck-container cont2))) 134 | (with-operators 135 | (for (((itr1 (begin cont1)) 136 | (itr2 (begin cont2)) 137 | (itr2-end (end cont2))) (_/= itr2 itr2-end) 138 | (progn ++itr1 ++itr2) :returns t) 139 | (unless (_== *itr1 *itr2) 140 | (return-from __container-equal nil))))))))) 141 | 142 | (defmethod operator_== ((cont1 stack) (cont2 stack)) 143 | (__container-equal cont1 cont2)) 144 | 145 | (defmethod operator_/= ((cont1 stack) (cont2 stack)) 146 | (not (__container-equal cont1 cont2))))) 147 | 148 | 149 | 150 | 151 | (locally (declare (optimize speed)) 152 | (labels ((__container-compare (cont1 cont2) 153 | (with-operators 154 | (for (((itr1 (begin cont1)) 155 | (itr1-end (end cont1)) 156 | (itr2 (begin cont2)) 157 | (itr2-end (end cont2))) t (progn ++itr1 ++itr2)) 158 | (let ((end1 (_== itr1 itr1-end)) 159 | (end2 (_== itr2 itr2-end))) 160 | (if (and end1 end2) 161 | (return-from __container-compare 0) 162 | (if end1 163 | (return-from __container-compare -1) 164 | (if end2 165 | (return-from __container-compare 1) 166 | (let ((val1 *itr1) 167 | (val2 *itr2)) 168 | (if (_< val1 val2) 169 | (return-from __container-compare -1) 170 | (if (_< val2 val1) 171 | (return-from __container-compare 1)))))))))))) 172 | 173 | (defmethod operator_< ((cont1 stack) (cont2 stack)) 174 | (< (__container-compare (__stck-container cont1) (__stck-container cont2)) 0)) 175 | 176 | (defmethod operator_<= ((cont1 stack) (cont2 stack)) 177 | (<= (__container-compare (__stck-container cont1) (__stck-container cont2)) 0)) 178 | 179 | (defmethod operator_> ((cont1 stack) (cont2 stack)) 180 | (< 0 (__container-compare (__stck-container cont1) (__stck-container cont2)))) 181 | 182 | (defmethod operator_>= ((cont1 stack) (cont2 stack)) 183 | (<= 0 (__container-compare (__stck-container cont1) (__stck-container cont2)))))) 184 | 185 | -------------------------------------------------------------------------------- /src/cl-stl-tuple.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-stl) 2 | 3 | 4 | #-cl-stl-0x98 5 | (locally (declare (optimize speed)) 6 | (defun __make_tuple-from-list (lst) 7 | (declare (type cl::list lst)) 8 | (let* ((cnt (length lst)) 9 | (arr (make-array cnt :initial-element nil))) 10 | (declare (type fixnum cnt)) 11 | (declare (type simple-vector arr)) 12 | (let ((i 0)) 13 | (declare (type fixnum i)) 14 | (for (nil (< i cnt) (incf i) :returns (make-instance 'tuple :items arr)) 15 | (_= (aref arr i) (car lst)) 16 | (setf lst (cdr lst))))))) 17 | 18 | #-cl-stl-0x98 19 | (defmacro __make_tuple-from-args ((&rest args) &key (is-move nil)) 20 | (let* ((cnt (length args)) 21 | (g-arr (gensym "ARR")) 22 | (assigns (do ((acc nil) 23 | (idx 0 (1+ idx))) 24 | ((null args) (nreverse acc)) 25 | (if (not is-move) 26 | (cl:push `(_= (aref ,g-arr ,idx) ,(car args)) acc) 27 | (progn 28 | (cl:push `(setf (aref ,g-arr ,idx) ,(car args)) acc) 29 | (cl:push `(setf ,(car args) nil) acc))) 30 | (setf args (cdr args))))) 31 | `(locally (declare (optimize speed)) 32 | (let ((,g-arr (make-array ,cnt :initial-element nil))) 33 | (declare (type simple-vector ,g-arr)) 34 | ,@assigns 35 | (make-instance 'tuple :items ,g-arr))))) 36 | 37 | ;;------------------------------------------------------------------------------ 38 | ;; 39 | ;; tuple 40 | ;; 41 | ;;------------------------------------------------------------------------------ 42 | #-cl-stl-0x98 43 | (eval-when (:compile-toplevel :load-toplevel :execute) 44 | (defclass tuple (clonable) 45 | ((items :type cl:vector 46 | :initform nil 47 | :initarg :items 48 | :accessor __inner-array)))) 49 | 50 | 51 | #-cl-stl-0x98 52 | (defun make_tuple (&rest args) 53 | (__make_tuple-from-list args)) 54 | 55 | #-cl-stl-0x98 56 | (define-compiler-macro make_tuple (&rest args) 57 | (let ((g-arr (gensym "ARR"))) 58 | `(locally (declare (optimize speed)) 59 | (let ((,g-arr (make-array ,(length args) :initial-element nil))) 60 | (declare (type cl:vector ,g-arr)) 61 | ,@(let ((idx 0)) 62 | (mapcar (lambda (arg) 63 | (prog1 `(_= (aref ,g-arr ,idx) ,arg) 64 | (incf idx))) args)) 65 | (make-instance 'tuple :items ,g-arr))))) 66 | 67 | 68 | ;;---------------------------------------------------------- 69 | ;; constructors 70 | ;;---------------------------------------------------------- 71 | #-cl-stl-0x98 72 | (declare-constructor tuple (0 1 0+)) 73 | 74 | ;;default constructor 75 | #-cl-stl-0x98 76 | (define-constructor tuple () 77 | (make-instance 'tuple :items (make-array 0))) 78 | 79 | ;;copy constructor 80 | #-cl-stl-0x98 81 | (define-constructor tuple ((arg tuple)) 82 | (clone arg)) 83 | 84 | ;;conversion from pair 85 | #-cl-stl-0x98 86 | (define-constructor tuple ((arg pair)) 87 | (__make_tuple-from-args ((first arg) (second arg)))) 88 | 89 | ;; move constructor & move from pair 90 | #-cl-stl-0x98 91 | (define-constructor tuple ((arg& remove-reference)) 92 | (with-reference (arg) 93 | (let ((cont arg)) 94 | (typecase cont 95 | (stl:pair 96 | (__make_tuple-from-args ((first cont) (second cont)) :is-move t)) 97 | (stl:tuple 98 | (let ((arr (__inner-array cont))) 99 | (declare (type simple-vector arr)) 100 | (prog1 (make-instance 'tuple :items arr) 101 | (setf (__inner-array cont) 102 | (make-array (length arr) :initial-element nil))))) 103 | (t 104 | (error 'type-mismatch :what "Can't convert to tuple.")))))) 105 | 106 | ;;initialzation 107 | #-cl-stl-0x98 108 | (progn 109 | (define-constructor tuple (arg) 110 | (__make_tuple-from-args (arg))) 111 | 112 | (define-constructor tuple (&rest args) 113 | (__make_tuple-from-list args)) 114 | 115 | (define-constructor-macro tuple (&rest args) 116 | (let ((g-arr (gensym "ARR"))) 117 | `(locally (declare (optimize speed)) 118 | (let ((,g-arr (make-array ,(length args) :initial-element nil))) 119 | (declare (type cl:vector ,g-arr)) 120 | ,@(let ((idx 0)) 121 | (mapcar (lambda (arg) 122 | (prog1 `(_= (aref ,g-arr ,idx) ,arg) 123 | (incf idx))) args)) 124 | (make-instance 'tuple :items ,g-arr)))))) 125 | 126 | 127 | #-cl-stl-0x98 128 | (locally (declare (optimize speed)) 129 | (defmethod operator_clone ((obj tuple)) 130 | (let* ((src (__inner-array obj)) 131 | (cnt (length src)) 132 | (dst (make-array cnt :initial-element nil))) 133 | (declare (type fixnum cnt)) 134 | (declare (type simple-vector src dst)) 135 | (let ((idx 0)) 136 | (declare (type fixnum idx)) 137 | (for (nil (< idx cnt) (incf idx) :returns (make-instance 'tuple :items dst)) 138 | (_= (aref dst idx) (aref src idx))))))) 139 | 140 | 141 | ;;------------------------------------------------------------------------------ 142 | ;; 143 | ;; methods 144 | ;; 145 | ;;------------------------------------------------------------------------------ 146 | #-cl-stl-0x98 147 | (locally (declare (optimize speed)) 148 | (defmethod-overload swap ((tpl1 tuple) (tpl2 tuple)) 149 | (let ((arr1 (__inner-array tpl1)) 150 | (arr2 (__inner-array tpl2))) 151 | (declare (type simple-vector arr1 arr2)) 152 | (let ((len1 (length arr1)) 153 | (len2 (length arr2))) 154 | (declare (type fixnum len1 len2)) 155 | (unless (= len1 len2) 156 | (error 'type-mismatch :what "Type mismatch in swap of tuple.")) 157 | (setf (__inner-array tpl1) arr2) 158 | (setf (__inner-array tpl2) arr1)) 159 | (values tpl1 tpl2)))) 160 | 161 | 162 | #-cl-stl-0x98 163 | (locally (declare (optimize speed)) 164 | (defmethod operator_= ((tpl1 tuple) (tpl2 tuple)) 165 | (let ((arr1 (__inner-array tpl1)) 166 | (arr2 (__inner-array tpl2))) 167 | (declare (type simple-vector arr1 arr2)) 168 | (let ((len1 (length arr1)) 169 | (len2 (length arr2))) 170 | (declare (type fixnum len1 len2)) 171 | (when (/= len1 len2) 172 | (error 'type-mismatch :what "Type mismatch in assignment of tuple.")) 173 | (let ((idx 0)) 174 | (declare (type fixnum idx)) 175 | (for (nil (< idx len1) (incf idx) :returns tpl1) 176 | (_= (aref arr1 idx) (aref arr2 idx)))))))) 177 | 178 | ;; convertion from pair 179 | #-cl-stl-0x98 180 | (locally (declare (optimize speed)) 181 | (defmethod operator_= ((tpl tuple) (pr pair)) 182 | (let ((arr (__inner-array tpl))) 183 | (declare (type simple-vector arr)) 184 | (unless (= 2 (length arr)) 185 | (error 'type-mismatch :what "Type mismatch in assignment of tuple.")) 186 | (_= (aref arr 0) (stl:first pr)) 187 | (_= (aref arr 1) (stl:second pr)) 188 | tpl))) 189 | 190 | 191 | #-cl-stl-0x98 192 | (locally (declare (optimize speed)) 193 | (defmethod operator_move ((tpl1 tuple) (tpl2 tuple)) 194 | (if (eq tpl1 tpl2) 195 | (values tpl1 tpl2) 196 | (let ((arr1 (__inner-array tpl1)) 197 | (arr2 (__inner-array tpl2))) 198 | (declare (type simple-vector arr1 arr2)) 199 | (let ((len1 (length arr1)) 200 | (len2 (length arr2))) 201 | (declare (type fixnum len1 len2)) 202 | (when (/= len1 len2) 203 | (error 'type-mismatch :what "Type mismatch in move of tuple.")) 204 | (setf (__inner-array tpl1) arr2) 205 | (setf (__inner-array tpl2) arr1) 206 | (let ((idx 0)) 207 | (declare (type fixnum idx)) 208 | (for (nil (< idx len1) (incf idx) :returns (values tpl1 tpl2)) 209 | (setf (aref arr1 idx) nil)))))))) 210 | 211 | ;; convertion from pair 212 | #-cl-stl-0x98 213 | (locally (declare (optimize speed)) 214 | (defmethod operator_move ((tpl tuple) (pr pair)) 215 | (let ((arr (__inner-array tpl))) 216 | (declare (type simple-vector arr)) 217 | (unless (= 2 (length arr)) 218 | (error 'type-mismatch :what "Type mismatch in move pair to tuple.")) 219 | (multiple-value-bind (a b) 220 | (operator_move (aref arr 0) (stl:first pr)) 221 | (setf (aref arr 0) a) 222 | (setf (stl:first pr) b)) 223 | (multiple-value-bind (a b) 224 | (operator_move (aref arr 1) (stl:second pr)) 225 | (setf (aref arr 1) a) 226 | (setf (stl:second pr) b))) 227 | (values tpl pr))) 228 | 229 | 230 | #-cl-stl-0x98 231 | (locally (declare (optimize speed)) 232 | (defmethod size ((tpl tuple)) 233 | (length (the simple-vector (__inner-array tpl))))) 234 | 235 | 236 | 237 | 238 | ; concatenate tuples... 239 | #-cl-stl-0x98 240 | (locally (declare (optimize speed)) 241 | ;; MEMO : zero argument count is OK... 242 | (defun tuple_cat (&rest args) 243 | (labels ((count-imp (lst acc) 244 | (declare (type cl::list lst)) 245 | (declare (type fixnum acc)) 246 | (if (null lst) 247 | acc 248 | (count-imp (cdr lst) 249 | (+ acc (the fixnum (etypecase (car lst) 250 | (stl:pair 2) 251 | (stl:tuple (size (car lst))) 252 | (stl:array (size (car lst))))))))) 253 | (copy-imp (lst arr idx) 254 | (declare (type cl:list lst)) 255 | (declare (type simple-vector arr)) 256 | (declare (type fixnum idx)) 257 | (if (null lst) 258 | (make-instance 'tuple :items arr) 259 | (let ((obj (car lst))) 260 | (typecase obj 261 | (cons 262 | (_= (aref arr idx) (car obj)) (incf idx) 263 | (_= (aref arr idx) (cdr obj)) (incf idx)) 264 | (tuple 265 | (for (v (__inner-array obj)) 266 | (_= (aref arr idx) v) 267 | (incf idx))) 268 | (stl:array 269 | (for (v obj) 270 | (_= (aref arr idx) v) 271 | (incf idx)))) 272 | (copy-imp (cdr lst) arr idx))))) 273 | (copy-imp args (make-array (count-imp args 0) :initial-element nil) 0)))) 274 | 275 | 276 | ; :ignore keyword can use. 277 | #-cl-stl-0x98 278 | (defmacro tie ((&rest vars) tpl) 279 | (let ((g-arr (gensym "ARR"))) 280 | (labels ((imp (idx lst acc) 281 | (if (null lst) 282 | (values idx (nreverse acc)) 283 | (progn 284 | (unless (eq (car lst) :ignore) 285 | (cl:push `(_= ,(car lst) (svref ,g-arr ,idx)) acc )) 286 | (imp (1+ idx) (cdr lst) acc))))) 287 | (multiple-value-bind (max code) (imp 0 vars nil) 288 | `(let ((,g-arr (__inner-array ,tpl))) 289 | (declare (type cl:simple-vector ,g-arr)) 290 | (unless (<= ,max (length ,g-arr)) 291 | (error 'out_of_range :what "Variable count to tie is out of range.")) 292 | (locally (declare (type (cl:simple-vector ,max) ,g-arr)) 293 | ,@code) 294 | nil))))) 295 | 296 | ;; :ignore keyword can use. 297 | #-cl-stl-noextra 298 | (progn 299 | #-cl-stl-0x98 300 | (defmacro with_tie ((&rest vars) tpl &body body) 301 | (let ((g-arr (gensym "ARR"))) 302 | (labels ((imp (idx lst acc) 303 | (if (null lst) 304 | (values idx (nreverse acc)) 305 | (progn 306 | (unless (eq (car lst) :ignore) 307 | (cl:push `(,(car lst) (svref ,g-arr ,idx)) acc)) 308 | (imp (1+ idx) (cdr lst) acc))))) 309 | (multiple-value-bind (max code) (imp 0 vars nil) 310 | `(let ((,g-arr (__inner-array ,tpl))) 311 | (declare (type cl:simple-vector ,g-arr)) 312 | (unless (<= ,max (length ,g-arr)) 313 | (error 'out_of_range :what "Variable count to with_tie is out of range.")) 314 | (locally (declare (type (cl:simple-vector ,max) ,g-arr)) 315 | (symbol-macrolet ,code 316 | ,@body)))))))) 317 | 318 | 319 | ;;------------------------------------------------------------------------------ 320 | ;; 321 | ;; operators 322 | ;; 323 | ;;------------------------------------------------------------------------------ 324 | 325 | #-cl-stl-0x98 326 | (locally (declare (optimize speed)) 327 | (labels ((tuple-equal (arr1 arr2) 328 | (declare (type simple-vector arr1 arr2)) 329 | (let ((cnt (length arr1))) 330 | (declare (type fixnum cnt)) 331 | (unless (= cnt (length arr2)) 332 | (error 'type-mismatch :what "Type mismatch in compare of tuple.")) 333 | (let ((idx 0)) 334 | (declare (type fixnum idx)) 335 | (for (nil (< idx cnt) (incf idx) :returns t) 336 | (unless (_== (aref arr1 idx) (aref arr2 idx)) 337 | (return-from tuple-equal nil))))))) 338 | 339 | (defmethod operator_== ((tpl1 tuple) (tpl2 tuple)) 340 | (if (eq tpl1 tpl2) 341 | t 342 | (tuple-equal (__inner-array tpl1) (__inner-array tpl2)))) 343 | 344 | (defmethod operator_/= ((tpl1 tuple) (tpl2 tuple)) 345 | (if (eq tpl1 tpl2) 346 | nil 347 | (not (tuple-equal (__inner-array tpl1) (__inner-array tpl2))))))) 348 | 349 | 350 | 351 | #-cl-stl-0x98 352 | (locally (declare (optimize speed)) 353 | (labels ((tuple-compare (arr1 arr2) ; returns -1, 0, 1 354 | (declare (type simple-vector arr1 arr2)) 355 | (let ((cnt (length arr1))) 356 | (declare (type fixnum cnt)) 357 | (unless (= cnt (length arr2)) 358 | (error 'type-mismatch :what "Type mismatch in compare of tuple.")) 359 | (let ((idx 0)) 360 | (declare (type fixnum idx)) 361 | (for (nil (< idx cnt) (incf idx) :returns 0) 362 | (let ((val1 (aref arr1 idx)) 363 | (val2 (aref arr2 idx))) 364 | (when (_< val1 val2) (return-from tuple-compare -1)) 365 | (when (_< val2 val1) (return-from tuple-compare 1)))))))) 366 | 367 | (defmethod operator_< ((tpl1 tuple) (tpl2 tuple)) 368 | (if (eq tpl1 tpl2) 369 | nil 370 | (< (tuple-compare (__inner-array tpl1) (__inner-array tpl2)) 0))) 371 | 372 | (defmethod operator_<= ((tpl1 tuple) (tpl2 tuple)) 373 | (if (eq tpl1 tpl2) 374 | t 375 | (<= (tuple-compare (__inner-array tpl1) (__inner-array tpl2)) 0))) 376 | 377 | (defmethod operator_> ((tpl1 tuple) (tpl2 tuple)) 378 | (if (eq tpl1 tpl2) 379 | nil 380 | (< 0 (tuple-compare (__inner-array tpl1) (__inner-array tpl2))))) 381 | 382 | (defmethod operator_>= ((tpl1 tuple) (tpl2 tuple)) 383 | (if (eq tpl1 tpl2) 384 | t 385 | (<= 0 (tuple-compare (__inner-array tpl1) (__inner-array tpl2))))))) 386 | 387 | 388 | #-(or cl-stl-0x98 cl-stl-0x11 cl-stl-0x14) 389 | (locally (declare (optimize speed)) 390 | (defun __make_from_tuple-imp (ctor tpl) 391 | (let ((arr (__inner-array tpl))) 392 | (declare (type simple-vector arr)) 393 | (let ((cnt (length arr))) 394 | (declare (type fixnum cnt)) 395 | (case cnt 396 | (2 (locally (declare (type (simple-vector 2) arr)) 397 | (cl:funcall ctor (svref arr 0) (svref arr 1)))) 398 | (3 (locally (declare (type (simple-vector 3) arr)) 399 | (cl:funcall ctor (svref arr 0) 400 | (svref arr 1) (svref arr 2)))) 401 | (4 (locally (declare (type (simple-vector 4) arr)) 402 | (cl:funcall ctor (svref arr 0) (svref arr 1) 403 | (svref arr 2) (svref arr 3)))) 404 | (5 (locally (declare (type (simple-vector 5) arr)) 405 | (cl:funcall ctor (svref arr 0) (svref arr 1) 406 | (svref arr 2) (svref arr 3) (svref arr 4)))) 407 | (6 (locally (declare (type (simple-vector 6) arr)) 408 | (cl:funcall ctor (svref arr 0) (svref arr 1) 409 | (svref arr 2) (svref arr 3) 410 | (svref arr 4) (svref arr 5)))) 411 | (7 (locally (declare (type (simple-vector 7) arr)) 412 | (cl:funcall ctor (svref arr 0) (svref arr 1) 413 | (svref arr 2) (svref arr 3) 414 | (svref arr 4) (svref arr 5) (svref arr 6)))) 415 | (8 (locally (declare (type (simple-vector 8) arr)) 416 | (cl:funcall ctor (svref arr 0) (svref arr 1) 417 | (svref arr 2) (svref arr 3) 418 | (svref arr 4) (svref arr 5) 419 | (svref arr 6) (svref arr 7)))) 420 | (9 (locally (declare (type (simple-vector 9) arr)) 421 | (cl:funcall ctor (svref arr 0) (svref arr 1) 422 | (svref arr 2) (svref arr 3) 423 | (svref arr 4) (svref arr 5) 424 | (svref arr 6) (svref arr 7) (svref arr 8)))) 425 | (t (cl:apply ctor (coerce arr 'cl:list)))))))) 426 | 427 | #-(or cl-stl-0x98 cl-stl-0x11 cl-stl-0x14) 428 | (defmacro make_from_tuple (type tpl) 429 | (let ((ctor-name (cl-overload::make-constructor-name type))) 430 | `(__make_from_tuple-imp #',ctor-name ,tpl))) 431 | 432 | 433 | ;;------------------------------------------------------------------------------ 434 | ;; 435 | ;; 436 | ;; 437 | ;;------------------------------------------------------------------------------ 438 | #-cl-stl-0x98 439 | (defmethod print-object ((tpl tuple) stream) 440 | (print-unreadable-object (tpl stream :type t) 441 | (let ((arr (__inner-array tpl))) 442 | (if (< (length arr) 5) 443 | (format stream "~A" arr) 444 | (format stream "#(~A ~A ~A ~A ...)" 445 | (aref arr 0) (aref arr 1) (aref arr 2) (aref arr 3)))))) 446 | 447 | 448 | 449 | ;;------------------------------------------------------------------------------ 450 | ;; 451 | ;; debug methods for tuple 452 | ;; 453 | ;;------------------------------------------------------------------------------ 454 | 455 | #+cl-stl-debug 456 | (progn 457 | #-cl-stl-0x98 458 | (defmethod dump ((tpl tuple) &optional (stream t) (print-item-fnc nil)) 459 | (setf print-item-fnc (if print-item-fnc 460 | (functor_function (clone print-item-fnc)) 461 | (lambda (s x) (format s "~A" x)))) 462 | (format stream "begin dump ---------------------~%") 463 | (let ((arr (__inner-array tpl))) 464 | (declare (type simple-vector arr)) 465 | (do ((cnt (length arr)) 466 | (idx 0 (1+ idx))) 467 | ((= idx cnt) nil) 468 | (format stream "~A : " idx) 469 | (funcall print-item-fnc stream (aref arr idx)) 470 | (format stream "~%"))) 471 | (format stream "end dump -----------------------~%") 472 | nil)) 473 | 474 | 475 | -------------------------------------------------------------------------------- /src/cl-stl-user.asd: -------------------------------------------------------------------------------- 1 | (defsystem :CL-STL-USER 2 | :description "CL-STL-USER : user package for CL-STL." 3 | :version "0.8.5" 4 | :author "show-matz " 5 | :licence "LLGPL" 6 | :depends-on ("cl-stl") 7 | :components ((:file "user-package"))) 8 | -------------------------------------------------------------------------------- /src/cl-stl-utility.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-stl) 2 | 3 | (declaim (inline make_pair 4 | first 5 | second 6 | (setf first) 7 | (setf second))) 8 | 9 | ;;------------------------------------------------------------------------------ 10 | ;; 11 | ;; class definition 12 | ;; 13 | ;;------------------------------------------------------------------------------ 14 | (eval-when (:compile-toplevel :load-toplevel :execute) 15 | (defclass pair (clonable) 16 | ((items :type cl:simple-vector 17 | :initform (make-array 2 :initial-element nil) 18 | :initarg :items 19 | :accessor __inner-array)))) 20 | 21 | 22 | ;;------------------------------------------------------------------------------ 23 | ;; 24 | ;; utilities 25 | ;; 26 | ;;------------------------------------------------------------------------------ 27 | (locally (declare (optimize speed)) 28 | (defun make_pair (first second) 29 | (let ((arr (make-array 2 :initial-element nil))) 30 | (declare (type (cl:simple-vector 2) arr)) 31 | (_= (svref arr 0) first) 32 | (_= (svref arr 1) second) 33 | (make-instance 'pair :items arr)))) 34 | 35 | 36 | ;;------------------------------------------------------------------------------ 37 | ;; 38 | ;; constructor 39 | ;; 40 | ;;------------------------------------------------------------------------------ 41 | (declare-constructor pair (0 1 2)) 42 | 43 | ;; default constructor 44 | (define-constructor pair () 45 | (make-instance 'pair)) 46 | 47 | ;; copy constructor 48 | (locally (declare (optimize speed)) 49 | (define-constructor pair ((arg pair)) 50 | (let ((arr (__inner-array arg))) 51 | (declare (type (cl:simple-vector 2) arr)) 52 | (make_pair (svref arr 0) (svref arr 1))))) 53 | 54 | ;; normal constructor 55 | (define-constructor pair (first second) 56 | (make_pair first second)) 57 | 58 | ;; move constructor 59 | #-cl-stl-0x98 60 | (locally (declare (optimize speed)) 61 | (define-constructor pair ((rm& remove-reference)) 62 | (with-reference (rm) 63 | (let ((pr rm)) 64 | (__check-type-of-move-constructor pr pair) 65 | (let ((arr1 (__inner-array pr)) 66 | (arr2 (make-array 2 :initial-element nil))) 67 | (declare (type (cl:simple-vector 2) arr1 arr2)) 68 | (rotatef (svref arr1 0) (svref arr2 0)) 69 | (rotatef (svref arr1 1) (svref arr2 1)) 70 | (make-instance 'pair :items arr2)))))) 71 | 72 | (locally (declare (optimize speed)) 73 | (defmethod operator_clone ((obj pair)) 74 | (let ((arr (__inner-array obj))) 75 | (declare (type (cl:simple-vector 2) arr)) 76 | (make_pair (svref arr 0) (svref arr 1))))) 77 | 78 | 79 | ;;------------------------------------------------------------------------------ 80 | ;; 81 | ;; accessor 82 | ;; 83 | ;;------------------------------------------------------------------------------ 84 | (locally (declare (optimize speed)) 85 | 86 | (defun first (pr) 87 | (svref (the (cl:simple-vector 2) (__inner-array pr)) 0)) 88 | 89 | (defun (setf first) (new-val pr) 90 | (setf (svref (the (cl:simple-vector 2) (__inner-array pr)) 0) new-val)) 91 | 92 | (defun second (pr) 93 | (svref (the (cl:simple-vector 2) (__inner-array pr)) 1)) 94 | 95 | (defun (setf second) (new-val pr) 96 | (setf (svref (the (cl:simple-vector 2) (__inner-array pr)) 1) new-val))) 97 | 98 | 99 | ;;------------------------------------------------------------------------------ 100 | ;; 101 | ;; assignment 102 | ;; 103 | ;;------------------------------------------------------------------------------ 104 | (locally (declare (optimize speed)) 105 | (defmethod operator_= ((lhs pair) (rhs pair)) 106 | (let ((arr1 (__inner-array lhs)) 107 | (arr2 (__inner-array rhs))) 108 | (declare (type (cl:simple-vector 2) arr1 arr2)) 109 | (_= (svref arr1 0) (svref arr2 0)) 110 | (_= (svref arr1 1) (svref arr2 1))) 111 | lhs)) 112 | 113 | #-cl-stl-0x98 114 | (locally (declare (optimize speed)) 115 | (defmethod operator_move ((lhs pair) (rhs pair)) 116 | (unless (eq lhs rhs) 117 | (let ((arr1 (__inner-array lhs)) 118 | (arr2 (__inner-array rhs))) 119 | (declare (type (cl:simple-vector 2) arr1 arr2)) 120 | (multiple-value-bind (a b) (operator_move (svref arr1 0) 121 | (svref arr2 0)) 122 | (setf (svref arr1 0) a) 123 | (setf (svref arr2 0) b)) 124 | (multiple-value-bind (a b) (operator_move (svref arr1 1) 125 | (svref arr2 1)) 126 | (setf (svref arr1 1) a) 127 | (setf (svref arr2 1) b)))) 128 | (values lhs rhs))) 129 | 130 | 131 | ;;------------------------------------------------------------------------------ 132 | ;; 133 | ;; modifiers 134 | ;; 135 | ;;------------------------------------------------------------------------------ 136 | (locally (declare (optimize speed)) 137 | (defmethod-overload swap ((p1 pair) (p2 pair)) 138 | (unless (eq p1 p2) 139 | (let ((arr1 (__inner-array p1)) 140 | (arr2 (__inner-array p2))) 141 | (declare (type (cl:simple-vector 2) arr1 arr2)) 142 | (multiple-value-bind (v1 v2) (opr::__swap-2 (svref arr1 0) (svref arr2 0)) 143 | (setf (svref arr1 0) v1) 144 | (setf (svref arr2 0) v2)) 145 | (multiple-value-bind (v1 v2) (opr::__swap-2 (svref arr1 1) (svref arr2 1)) 146 | (setf (svref arr1 1) v1) 147 | (setf (svref arr2 1) v2)))) 148 | (values p1 p2))) 149 | 150 | 151 | ;;------------------------------------------------------------------------------ 152 | ;; 153 | ;; operators 154 | ;; 155 | ;;------------------------------------------------------------------------------ 156 | (locally (declare (optimize speed)) 157 | (defmethod operator_== ((a pair) (b pair)) 158 | (let ((arr1 (__inner-array a)) 159 | (arr2 (__inner-array b))) 160 | (declare (type (cl:simple-vector 2) arr1 arr2)) 161 | (and (_== (svref arr1 0) (svref arr2 0)) 162 | (_== (svref arr1 1) (svref arr2 1)))))) 163 | 164 | (locally (declare (optimize speed)) 165 | (defmethod operator_/= ((a pair) (b pair)) 166 | (let ((arr1 (__inner-array a)) 167 | (arr2 (__inner-array b))) 168 | (declare (type (cl:simple-vector 2) arr1 arr2)) 169 | (or (_/= (svref arr1 0) (svref arr2 0)) 170 | (_/= (svref arr1 1) (svref arr2 1)))))) 171 | 172 | (locally (declare (optimize speed)) 173 | (labels ((pair< (a b) 174 | (let ((arr1 (__inner-array a)) 175 | (arr2 (__inner-array b))) 176 | (declare (type (cl:simple-vector 2) arr1 arr2)) 177 | (if (_< (svref arr1 0) (svref arr2 0)) 178 | t 179 | (if (_< (svref arr2 0) (svref arr1 0)) 180 | nil 181 | (if (_< (svref arr1 1) (svref arr2 1)) 182 | t 183 | nil)))))) 184 | (defmethod operator_< ((a pair) (b pair)) (pair< a b)) 185 | (defmethod operator_<= ((a pair) (b pair)) (not (pair< b a))) 186 | (defmethod operator_> ((a pair) (b pair)) (pair< b a)) 187 | (defmethod operator_>= ((a pair) (b pair)) (not (pair< a b))))) 188 | 189 | 190 | ;;------------------------------------------------------------------------------ 191 | ;; 192 | ;; 193 | ;; 194 | ;;------------------------------------------------------------------------------ 195 | (defmethod print-object ((pr pair) stream) 196 | (print-unreadable-object (pr stream :type t) 197 | (format stream "~A" (__inner-array pr)))) 198 | 199 | -------------------------------------------------------------------------------- /src/cl-stl.asd: -------------------------------------------------------------------------------- 1 | (defsystem :CL-STL 2 | :description "CL-STL : a port of C++ standard template library for Common Lisp." 3 | :version "0.8.9" 4 | :author "show-matz " 5 | :licence "LLGPL" 6 | :depends-on ("closer-mop" 7 | "cl-overload" 8 | "cl-operator") 9 | :components ((:file "cl-stl-base") 10 | (:file "cl-stl-utility" :depends-on ("cl-stl-base")) 11 | (:file "cl-stl-exceptions" :depends-on ("cl-stl-base")) 12 | (:file "cl-stl-iterator" :depends-on ("cl-stl-base")) 13 | (:file "cl-stl-move-iterator" :depends-on ("cl-stl-iterator")) 14 | (:file "cl-stl-cl-conslist" :depends-on ("cl-stl-iterator")) 15 | (:file "cl-stl-cl-vector" :depends-on ("cl-stl-iterator")) 16 | (:file "cl-stl-functional" :depends-on ("cl-stl-utility")) 17 | (:file "cl-stl-initializer-list" :depends-on ("cl-stl-cl-vector")) 18 | (:file "cl-stl-algo-base" :depends-on ("cl-stl-cl-vector")) 19 | (:file "cl-stl-array" :depends-on ("cl-stl-cl-vector")) 20 | (:file "cl-stl-tuple" :depends-on ("cl-stl-array" "cl-stl-utility")) 21 | (:file "cl-stl-vector" :depends-on ("cl-stl-iterator")) 22 | (:file "cl-stl-deque" :depends-on ("cl-stl-iterator")) 23 | (:file "cl-stl-list" :depends-on ("cl-stl-iterator")) 24 | (:file "cl-stl-forward-list" :depends-on ("cl-stl-cl-conslist")) 25 | (:file "cl-stl-numeric" :depends-on ("cl-stl-iterator" "cl-stl-algo-base" "cl-stl-vector" "cl-stl-array")) 26 | (:file "cl-stl-algorithm" :depends-on ("cl-stl-base" "cl-stl-algo-base" "cl-stl-vector" "cl-stl-array")) 27 | (:file "cl-stl-rbnode" :depends-on ("cl-stl-base")) 28 | (:file "cl-stl-rbtree" :depends-on ("cl-stl-rbnode")) 29 | (:file "cl-stl-set" :depends-on ("cl-stl-iterator" "cl-stl-rbtree")) 30 | (:file "cl-stl-multiset" :depends-on ("cl-stl-iterator" "cl-stl-rbtree")) 31 | (:file "cl-stl-map" :depends-on ("cl-stl-iterator" "cl-stl-rbtree" "cl-stl-utility")) 32 | (:file "cl-stl-multimap" :depends-on ("cl-stl-map")) 33 | (:file "cl-stl-stack" :depends-on ("cl-stl-deque")) 34 | (:file "cl-stl-queue" :depends-on ("cl-stl-deque")) 35 | (:file "cl-stl-priority-queue" :depends-on ("cl-stl-vector" "cl-stl-algorithm")))) 36 | -------------------------------------------------------------------------------- /src/user-package.lisp: -------------------------------------------------------------------------------- 1 | (provide :cl-stl-user) 2 | 3 | (defpackage :cl-stl-user 4 | (:use :cl-stl) 5 | (:export :stl_version 6 | ;-------------------------------------------------------------------- 7 | ; exceptions 8 | ;-------------------------------------------------------------------- 9 | :logic_error 10 | :domain_error 11 | :length_error 12 | :invalid_argument 13 | :out_of_range 14 | :runtime_error 15 | :range_error 16 | :overflow_error 17 | :underflow_error 18 | #-cl-stl-0x98 :bad_function_call ; [0x11] 19 | ;-------------------------------------------------------------------- 20 | ; support for operators 21 | ;-------------------------------------------------------------------- 22 | #-cl-stl-noextra :cons_iterator 23 | #-cl-stl-noextra :cons_const_iterator 24 | ;-------------------------------------------------------------------- 25 | ; container 26 | ;-------------------------------------------------------------------- 27 | ; base types 28 | ;-------------------------- 29 | :pushable_back_container 30 | :pushable_front_container 31 | :forward_container 32 | :bidirectional_container 33 | :randomaccess_container 34 | ;-------------------------- 35 | ; container types 36 | ;-------------------------- 37 | ; #-cl-stl-0x98 :array ; shadowed 38 | #-cl-stl-0x98 :array_iterator 39 | #-cl-stl-0x98 :array_const_iterator 40 | #-cl-stl-0x98 :array_reverse_iterator 41 | #-cl-stl-0x98 :array_const_reverse_iterator 42 | ;---- 43 | ; :vector ; shadowed 44 | :vector_iterator 45 | :vector_const_iterator 46 | :vector_reverse_iterator 47 | :vector_const_reverse_iterator 48 | ;---- 49 | :deque 50 | :deque_iterator 51 | :deque_const_iterator 52 | :deque_reverse_iterator 53 | :deque_const_reverse_iterator 54 | ;---- 55 | ; :list ; shadowed 56 | :list_iterator 57 | :list_const_iterator 58 | :list_reverse_iterator 59 | :list_const_reverse_iterator 60 | ;---- 61 | #-cl-stl-0x98 :forward_list 62 | #-cl-stl-0x98 :forward_list_iterator 63 | #-cl-stl-0x98 :forward_list_const_iterator 64 | ;---- 65 | ; :set ; shadowed 66 | :set_iterator 67 | :set_const_iterator 68 | :set_reverse_iterator 69 | :set_const_reverse_iterator 70 | ;---- 71 | :multiset 72 | :multiset_iterator 73 | :multiset_const_iterator 74 | :multiset_reverse_iterator 75 | :multiset_const_reverse_iterator 76 | ;---- 77 | ; :map ; shadowed 78 | :map_iterator 79 | :map_const_iterator 80 | :map_reverse_iterator 81 | :map_const_reverse_iterator 82 | ;---- 83 | :multimap 84 | :multimap_iterator 85 | :multimap_const_iterator 86 | :multimap_reverse_iterator 87 | :multimap_const_reverse_iterator 88 | ;---- 89 | :stack 90 | :queue 91 | :priority_queue 92 | ;-------------------------- 93 | ; container methods 94 | ;-------------------------- 95 | ; assignment 96 | :assign 97 | ; iterators 98 | :begin 99 | :end 100 | :rbegin 101 | :rend 102 | #-cl-stl-0x98 :cbegin 103 | #-cl-stl-0x98 :cend 104 | #-cl-stl-0x98 :crbegin 105 | #-cl-stl-0x98 :crend 106 | #-cl-stl-0x98 :before_begin 107 | #-cl-stl-0x98 :cbefore_begin 108 | ; capacity 109 | :empty 110 | :size 111 | :max_size 112 | :resize 113 | :capacity 114 | :reserve 115 | ; element access 116 | :front 117 | :back 118 | :at 119 | #-cl-stl-0x98 :data 120 | ; modifiers 121 | :push_back 122 | :push_front 123 | :pop_back 124 | :pop_front 125 | #-cl-stl-0x98 :emplace_back 126 | #-cl-stl-0x98 :emplace_front 127 | #-cl-stl-0x98 :shrink_to_fit 128 | :insert 129 | #-cl-stl-0x98 :insert_after 130 | #-cl-stl-0x98 :emplace 131 | #-cl-stl-0x98 :emplace_hint 132 | #-cl-stl-0x98 :emplace_after 133 | :erase 134 | #-cl-stl-0x98 :erase_after 135 | ; :swap ; ( moved to CL-OPERATOR ) 136 | :clear 137 | :top 138 | ; :push ; shadowed 139 | ; :pop ; shadowed 140 | ; specific operations 141 | :splice ; list 142 | #-cl-stl-0x98 :splice_after 143 | ; :remove ; list ( exported in algorithm ) 144 | ; :remove_if ; list ( exported in algorithm ) 145 | ; :unique ; list ( exported in algorithm ) 146 | ; :merge ; list ( exported in algorithm ) 147 | ; :sort ; list ( exported in algorithm ) 148 | ; :reverse ; list ( exported in algorithm ) 149 | ; #-cl-stl-0x98 :fill ; array ( exported in algorithm ) 150 | ; :find ; associative container ( exported in algorithm ) 151 | ; :count ; associative container ( exported in algorithm ) 152 | ; :lower_bound ; associative container ( exported in algorithm ) 153 | ; :upper_bound ; associative container ( exported in algorithm ) 154 | ; :equal_range ; associative container ( exported in algorithm ) 155 | ; observers 156 | :key_comp 157 | :value_comp 158 | ; debug 159 | #+cl-stl-debug :dump 160 | #+cl-stl-debug :check_integrity 161 | ;---------------------------------- 162 | ;iterator base types 163 | :input_iterator 164 | :output_iterator 165 | :forward_iterator 166 | :bidirectional_iterator 167 | :randomaccess_iterator 168 | :reverse_iterator 169 | ;---------------------------------- 170 | ;iterator methods 171 | :advance 172 | :distance 173 | :base 174 | #-cl-stl-0x98 :prev 175 | #-cl-stl-0x98 :next 176 | ;iterator utilities 177 | #-cl-stl-0x98 :make_move_iterator 178 | :back_inserter 179 | :front_inserter 180 | :inserter 181 | :stream_writer 182 | :stream_reader 183 | :with_sequence 184 | :with_stream_reader 185 | :with_stream_writer 186 | :with_file_reader 187 | :with_file_writer 188 | :with_buffer_reader 189 | :with_buffer_writer 190 | ;---------------------------------- 191 | ;tuple 192 | #-cl-stl-0x98 :tuple 193 | #-cl-stl-0x98 :make_tuple 194 | ; #-cl-stl-0x98 :get ; shadowed 195 | #-cl-stl-0x98 :tuple_cat 196 | #-cl-stl-0x98 :tie 197 | #-(or cl-stl-noextra cl-stl-0x98) :with_tie 198 | #-(or 199 | cl-stl-0x98 200 | cl-stl-0x11 201 | cl-stl-0x14) :make_from_tuple 202 | ;---------------------------------- 203 | ;utility 204 | :pair 205 | :make_pair 206 | ; :first ; shadowed 207 | ; :second ; shadowed 208 | ;---------------------------------- 209 | ;functional 210 | :functor 211 | :functor_function 212 | :functor_call ; deprecated in version 0.8.3 or later 213 | :unary_function ; deprecated in 0x11 or later 214 | :binary_function ; deprecated in 0x11 or later 215 | :define-functor 216 | ;#-(or 217 | ; cl-stl-0x98 218 | ; cl-stl-0x11 219 | ; cl-stl-0x14) :apply ; shadowed 220 | ;classes 221 | :plus 222 | :minus 223 | :multiplies 224 | :divides 225 | :modulus 226 | :negate 227 | :equal_to 228 | :not_equal_to 229 | :greater 230 | :less 231 | :greater_equal 232 | :less_equal 233 | :logical_and 234 | :logical_or 235 | :logical_not 236 | :unary_negate ;; deprecated in c++17 237 | :binary_negate ;; deprecated in c++17 238 | #+(or cl-stl-0x98 cl-stl-0x11 cl-stl-0x14) :binder1st 239 | #+(or cl-stl-0x98 cl-stl-0x11 cl-stl-0x14) :binder2nd 240 | #-cl-stl-0x98 :bit_and 241 | #-cl-stl-0x98 :bit_or 242 | #-cl-stl-0x98 :bit_xor 243 | #+(or cl-stl-0x98 cl-stl-0x11 cl-stl-0x14) :pointer_to_unary_function 244 | #+(or cl-stl-0x98 cl-stl-0x11 cl-stl-0x14) :pointer_to_binary_function 245 | #+(or cl-stl-0x98 cl-stl-0x11 cl-stl-0x14) :mem_fun_t 246 | #+(or cl-stl-0x98 cl-stl-0x11 cl-stl-0x14) :mem_fun1_t 247 | ; #-cl-stl-0x98 :function ; shadowed 248 | #-cl-stl-0x98 :target 249 | ;utility functions 250 | :not1 ;; deprecated in c++17 251 | :not2 ;; deprecated in c++17 252 | #-cl-stl-0x98 :is_placeholder 253 | #-cl-stl-0x98 :is_bind_expression 254 | #-cl-stl-0x98 :bind 255 | #+(or cl-stl-0x98 cl-stl-0x11 cl-stl-0x14) :bind1st 256 | #+(or cl-stl-0x98 cl-stl-0x11 cl-stl-0x14) :bind2nd 257 | #+(or cl-stl-0x98 cl-stl-0x11 cl-stl-0x14) :ptr_fun1 258 | #+(or cl-stl-0x98 cl-stl-0x11 cl-stl-0x14) :ptr_fun2 259 | #+(or cl-stl-0x98 cl-stl-0x11 cl-stl-0x14) :mem_fun 260 | #+(or cl-stl-0x98 cl-stl-0x11 cl-stl-0x14) :mem_fun1 261 | #+(or cl-stl-0x98 cl-stl-0x11 cl-stl-0x14) :mem_fun_ref 262 | #+(or cl-stl-0x98 cl-stl-0x11 cl-stl-0x14) :mem_fun1_ref 263 | #-cl-stl-0x98 :mem_fn 264 | #-(or 265 | cl-stl-0x98 266 | cl-stl-0x11 267 | cl-stl-0x14) :not_fn 268 | ;+-----------------------------------------+ 269 | ;| numeric | 270 | ;+-----------------------------------------+ 271 | :numeric_limits 272 | :accumulate 273 | :adjacent_difference 274 | :inner_product 275 | #-cl-stl-0x98 :iota 276 | :partial_sum 277 | ;#-(or 278 | ; cl-stl-0x98 279 | ; cl-stl-0x11 280 | ; cl-stl-0x14) :reduce ; shadowed 281 | #-(or 282 | cl-stl-0x98 283 | cl-stl-0x11 284 | cl-stl-0x14) :transform_reduce 285 | #-(or 286 | cl-stl-0x98 287 | cl-stl-0x11 288 | cl-stl-0x14) :inclusive_scan 289 | #-(or 290 | cl-stl-0x98 291 | cl-stl-0x11 292 | cl-stl-0x14) :exclusive_scan 293 | #-(or 294 | cl-stl-0x98 295 | cl-stl-0x11 296 | cl-stl-0x14) :transform_inclusive_scan 297 | #-(or 298 | cl-stl-0x98 299 | cl-stl-0x11 300 | cl-stl-0x14) :transform_exclusive_scan 301 | ;+-----------------------------------------+ 302 | ;| algorithm | 303 | ;+-----------------------------------------+ 304 | #-(or 305 | cl-stl-0x98 306 | cl-stl-0x11 307 | cl-stl-0x14) :clamp 308 | ; 25.1, non-modifying sequence operations: 309 | #-cl-stl-0x98 :all_of 310 | #-cl-stl-0x98 :any_of 311 | #-cl-stl-0x98 :none_of 312 | :for_each 313 | #-(or 314 | cl-stl-0x98 315 | cl-stl-0x11 316 | cl-stl-0x14) :for_each_n 317 | ; :find ; shadowed 318 | :find_if 319 | #-cl-stl-0x98 :find_if_not 320 | :find_end 321 | :find_first_of 322 | :adjacent_find 323 | ; :count ; shadowed 324 | :count_if 325 | ; :mismatch ; shadowed 326 | ; :equal ; shadowed 327 | #-cl-stl-0x98 :is_permutation 328 | ; :search ; shadowed 329 | :search_n 330 | ; 25.2, modifying sequence operations: 331 | ; 25.2.1, copy: 332 | :copy 333 | #-cl-stl-0x98 :copy_n 334 | #-cl-stl-0x98 :copy_if 335 | :copy_backward 336 | ; #-cl-stl-0x98 :move ; shadowed 337 | #-cl-stl-0x98 :move_backward 338 | ; 25.2.2, swap: 339 | ; :swap ( moved to CL-OPERATOR ) 340 | :swap_ranges 341 | :iter_swap 342 | :transform 343 | ; :replace ; shadowed 344 | :replace_if 345 | :replace_copy 346 | :replace_copy_if 347 | ; :fill ; shadowed 348 | :fill_n 349 | :generate 350 | :generate_n 351 | ; :remove ; shadowed 352 | :remove_if 353 | :remove_copy 354 | :remove_copy_if 355 | :unique 356 | :unique_copy 357 | ; :reverse ; shadowed 358 | :reverse_copy 359 | :rotate 360 | :rotate_copy 361 | #+(or cl-stl-0x98 cl-stl-0x11 cl-stl-0x14) :random_shuffle 362 | #-cl-stl-0x98 :shuffle 363 | ; 25.2.12, partitions: 364 | #-cl-stl-0x98 :is_partitioned 365 | :partition 366 | :stable_partition 367 | #-cl-stl-0x98 :partition_copy 368 | #-cl-stl-0x98 :partition_point 369 | ; 25.3, sorting and related operations: 370 | ; 25.3.1, sorting: 371 | ; :sort ; shadowed 372 | :stable_sort 373 | :partial_sort 374 | :partial_sort_copy 375 | #-cl-stl-0x98 :is_sorted 376 | #-cl-stl-0x98 :is_sorted_until 377 | :nth_element 378 | ; 25.3.3, binary search: 379 | :lower_bound 380 | :upper_bound 381 | :equal_range 382 | :binary_search 383 | ; 25.3.4, merge: 384 | ; :merge ; shadowed 385 | :inplace_merge 386 | ; 25.3.5, set operations: 387 | :includes 388 | :set_union 389 | :set_intersection 390 | :set_difference 391 | :set_symmetric_difference 392 | ; 25.3.6, heap operations: 393 | :push_heap 394 | :pop_heap 395 | :make_heap 396 | :sort_heap 397 | #-cl-stl-0x98 :is_heap 398 | #-cl-stl-0x98 :is_heap_until 399 | ; 25.3.7, minimum and maximum: 400 | ; :min ; shadowed 401 | ; :max ; shadowed 402 | #-cl-stl-0x98 :minmax 403 | :min_element 404 | :max_element 405 | #-cl-stl-0x98 :minmax_element 406 | :lexicographical_compare 407 | ; 25.3.9, permutations 408 | :next_permutation 409 | :prev_permutation 410 | ;+-----------------------------------------+ 411 | ;| misc | 412 | ;+-----------------------------------------+ 413 | :for 414 | #-cl-stl-0x98 :initializer_list)) 415 | 416 | 417 | (in-package :cl-stl-user) 418 | 419 | --------------------------------------------------------------------------------