Skip to content
Permalink
Browse files

c++17 add reduce function

	modified:   src/cl-stl-base.lisp
	modified:   src/cl-stl-numeric.lisp
	modified:   src/user-package.lisp
  • Loading branch information...
show-matz committed Feb 26, 2019
1 parent 162c51b commit e8d94480e40e4f9682287028099fe91f0aa24857
Showing with 118 additions and 1 deletion.
  1. +28 −1 src/cl-stl-base.lisp
  2. +86 −0 src/cl-stl-numeric.lisp
  3. +4 −0 src/user-package.lisp
@@ -277,6 +277,10 @@
:inner_product
#-cl-stl-0x98 :iota
:partial_sum
#-(or
cl-stl-0x98
cl-stl-0x11
cl-stl-0x14) :reduce
;+-----------------------------------------+
;| algorithm |
;+-----------------------------------------+
@@ -410,6 +414,11 @@
cl-stl-0x98
cl-stl-0x11
cl-stl-0x14) :apply
;numeric
#-(or
cl-stl-0x98
cl-stl-0x11
cl-stl-0x14) :reduce
;algorithm
:count
:equal
@@ -1058,12 +1067,30 @@
first : forward_iterator.
last : forward_iterator.
init : initial value.
unary-op : binary functor ( use #'1+ default ).
unary-op : unary functor ( use #'1+ default ).
<<return value>>
nil.
")

#-(or cl-stl-0x98 cl-stl-0x11 cl-stl-0x14)
(declare-method-overload reduce (2 3 4)
:documentation "
<<signature>>
(cl-stl:reduce first last) [0x17]
(cl-stl:reduce first last init) [0x17]
(cl-stl:reduce first last init binary-op) [0x17]
<<parameters>>
first : input_iterator.
last : input_iterator.
init : initial value ( use 0 default ).
binary-op : binary functor ( use #'+ default ).
<<return value>>
reduced value.
")



;;------------------------------------------------------------------------------
@@ -1062,3 +1062,89 @@
(opr::vec-ptr-index last)
(opr::vec-ptr-buffer first) init (functor_function (clone unary-op))))))


;;--------------------------------------------------------------------
;; ??.?.? reduce
;; first : input_iterator
;; last : input_iterator
;; init : initial value ( 0 by default )
;; binary-op : binary function ( #'+ by default )
;; returns : reduced value.
#-(or cl-stl-0x98 cl-stl-0x11 cl-stl-0x14)
(locally (declare (optimize speed))

;;PTN; reduce : 0 - i
(labels ((__reduce-imp-0 (first last init plus-bf)
(declare (type cl:function plus-bf))
(with-operators
(let ((acc nil))
(_= acc init)
(if (_== first last)
acc
(for (((itr @~first)) (_/= itr last) ++itr :returns acc)
(_= acc (funcall plus-bf acc *itr))))))))

(defmethod-overload reduce ((first input_iterator) (last input_iterator))
(__reduce-imp-0 first last 0 #'+))

(defmethod-overload reduce ((first input_iterator) (last input_iterator) init)
(__reduce-imp-0 first last init #'+))

(defmethod-overload reduce ((first input_iterator) (last input_iterator) init binary-op)
(__reduce-imp-0 first last init (functor_function (clone binary-op)))))

;;PTN; reduce : 1 - cci
(labels ((__reduce-imp-1 (cons1 cons2 init plus-bf)
(declare (type cl:function plus-bf))
(let ((acc nil))
(_= acc init)
(for (nil (not (eq cons1 cons2)) (setf cons1 (cdr cons1)) :returns acc)
(_= acc (funcall plus-bf acc (car cons1)))))))

(defmethod-overload reduce ((first cons_const_iterator) (last cons_const_iterator))
;;(format t "specialized reduce for cons_const_iterator is invoked.~%")
(__reduce-imp-1 (__cons-itr-cons first)
(__cons-itr-cons last) 0 #'+))

(defmethod-overload reduce ((first cons_const_iterator) (last cons_const_iterator) init)
;;(format t "specialized reduce for cons_const_iterator is invoked.~%")
(__reduce-imp-1 (__cons-itr-cons first)
(__cons-itr-cons last) init #'+))

(defmethod-overload reduce ((first cons_const_iterator) (last cons_const_iterator) init binary-op)
;;(format t "specialized reduce for cons_const_iterator is invoked.~%")
(__reduce-imp-1 (__cons-itr-cons first)
(__cons-itr-cons last) init (functor_function (clone binary-op)))))

;;PTN; reduce : 2 - cvp
(labels ((__reduce-imp-2 (idx1 idx2 buffer init plus-bf)
(declare (type fixnum idx1 idx2))
(declare (type cl:vector buffer))
(declare (type cl:function plus-bf))
(let ((acc nil))
(_= acc init)
(for (nil (< idx1 idx2) (incf idx1) :returns acc)
(_= acc (funcall plus-bf acc (aref buffer idx1)))))))

(defmethod-overload reduce ((first const-vector-pointer) (last const-vector-pointer))
;;(format t "specialized reduce for const-vector-pointer is invoked.~%")
(__pointer-check-iterator-range first last)
(__reduce-imp-2 (opr::vec-ptr-index first)
(opr::vec-ptr-index last)
(opr::vec-ptr-buffer first) 0 #'+))

(defmethod-overload reduce ((first const-vector-pointer) (last const-vector-pointer) init)
;;(format t "specialized reduce for const-vector-pointer is invoked.~%")
(__pointer-check-iterator-range first last)
(__reduce-imp-2 (opr::vec-ptr-index first)
(opr::vec-ptr-index last)
(opr::vec-ptr-buffer first) init #'+))

(defmethod-overload reduce ((first const-vector-pointer) (last const-vector-pointer) init binary-op)
;;(format t "specialized reduce for const-vector-pointer is invoked.~%")
(__pointer-check-iterator-range first last)
(__reduce-imp-2 (opr::vec-ptr-index first)
(opr::vec-ptr-index last)
(opr::vec-ptr-buffer first)
init (functor_function (clone binary-op))))))

@@ -274,6 +274,10 @@
:inner_product
#-cl-stl-0x98 :iota
:partial_sum
;#-(or
; cl-stl-0x98
; cl-stl-0x11
; cl-stl-0x14) :reduce ; shadowed
;+-----------------------------------------+
;| algorithm |
;+-----------------------------------------+

0 comments on commit e8d9448

Please sign in to comment.
You can’t perform that action at this time.