Hi,
The Scieneer CL and ACL have non-standard versions or modes in which the standard symbols are lower case and this can be
accommodated with some minor changes.
Regards
Douglas Crosher
diff -rc iterate-20111001-darcs/iterate.lisp
../iterate-20111001-darcs/iterate.lisp
*** iterate-20111001-darcs/iterate.lisp 2011-10-02 01:17:06.000000000 +1000
--- ../iterate-20111001-darcs/iterate.lisp 2011-11-01 22:41:34.000000000
+1100
***************
*** 2324,2342 ****
(setf (cdr entry) doc-string))
symbol))
! ;;; (INITIALLY &rest)
(def-special-clause initially (&rest forms)
"Lisp forms to execute before loop starts"
(mapc #'local-binding-check forms)
(return-code :initial (copy-list forms)))
! ;;; (AFTER-EACH &rest)
(def-special-clause after-each (&rest forms)
"Lisp forms to execute after each iteration"
(mapc #'local-binding-check forms)
(return-code :step (walk-list forms)))
! ;;; (ELSE &rest)
(def-special-clause else (&rest forms)
"Lisp forms to execute if the loop is never entered"
(mapc #'local-binding-check forms)
--- 2324,2342 ----
(setf (cdr entry) doc-string))
symbol))
! ;;; (initially &rest)
(def-special-clause initially (&rest forms)
"Lisp forms to execute before loop starts"
(mapc #'local-binding-check forms)
(return-code :initial (copy-list forms)))
! ;;; (after-each &rest)
(def-special-clause after-each (&rest forms)
"Lisp forms to execute after each iteration"
(mapc #'local-binding-check forms)
(return-code :step (walk-list forms)))
! ;;; (else &rest)
(def-special-clause else (&rest forms)
"Lisp forms to execute if the loop is never entered"
(mapc #'local-binding-check forms)
***************
*** 2345,2376 ****
.,(walk-list forms)))
:body (list `(setq ,flag nil)))))
! ;;; (FINALLY &rest)
(def-special-clause finally (&rest forms)
"Lisp forms to execute after loop ends"
(mapc #'local-binding-check forms)
(return-code :final (copy-list forms)))
! ;;; (FINALLY-PROTECTED &rest)
(def-special-clause finally-protected (&rest forms)
! "Lisp forms in an UNWIND-PROTECT after loop ends"
(mapc #'local-binding-check forms)
(return-code :final-protected (copy-list forms)))
! ;;; (IF-FIRST-TIME then &optional else)
(def-special-clause if-first-time (then &optional else)
"Evaluate branch depending on whether this clause if met for the first time"
(return-code :body (list
(if-1st-time (list (walk-expr then))
(if else (list (walk-expr else)))))))
! ;;; (FIRST-TIME-P)
! (def-special-clause FIRST-TIME-P ()
"True when evaluated for the first time"
(return-code :body (list (if-1st-time '(t)))))
! ;;; (FIRST-ITERATION-P)
! (def-special-clause FIRST-ITERATION-P ()
"True within first iteration through the body"
;; Like (with ,var = t) (after-each (setq ,var nil))
;; except all these clauses shares a single binding.
--- 2345,2376 ----
.,(walk-list forms)))
:body (list `(setq ,flag nil)))))
! ;;; (finally &rest)
(def-special-clause finally (&rest forms)
"Lisp forms to execute after loop ends"
(mapc #'local-binding-check forms)
(return-code :final (copy-list forms)))
! ;;; (finally-protected &rest)
(def-special-clause finally-protected (&rest forms)
! "Lisp forms in an 'unwind-protect after loop ends"
(mapc #'local-binding-check forms)
(return-code :final-protected (copy-list forms)))
! ;;; (if-first-time then &optional else)
(def-special-clause if-first-time (then &optional else)
"Evaluate branch depending on whether this clause if met for the first time"
(return-code :body (list
(if-1st-time (list (walk-expr then))
(if else (list (walk-expr else)))))))
! ;;; (first-time-p)
! (def-special-clause first-time-p ()
"True when evaluated for the first time"
(return-code :body (list (if-1st-time '(t)))))
! ;;; (first-iteration-p)
! (def-special-clause first-iteration-p ()
"True within first iteration through the body"
;; Like (with ,var = t) (after-each (setq ,var nil))
;; except all these clauses shares a single binding.
***************
*** 2384,2390 ****
(return-code :body `(,var)
:step step-body)))
! ;;; (IN &body)
(def-special-clause in (block-name &rest forms)
"Process forms in a named Iterate block"
;; VALUE: depends on forms
--- 2384,2390 ----
(return-code :body `(,var)
:step step-body)))
! ;;; (in &body)
(def-special-clause in (block-name &rest forms)
"Process forms in a named Iterate block"
;; VALUE: depends on forms
***************
*** 2392,2398 ****
(walk-list forms)
`((in ,block-name ,.(copy-list forms)))))
! ;;; (NEXT var)
(def-special-clause next (var &optional (n 1))
"Explicitly step a driver variable"
;; VALUE: var, after stepping.
--- 2392,2398 ----
(walk-list forms)
`((in ,block-name ,.(copy-list forms)))))
! ;;; (next var)
(def-special-clause next (var &optional (n 1))
"Explicitly step a driver variable"
;; VALUE: var, after stepping.
***************
*** 2596,2609 ****
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Hash-table, Packages and Streams
! ;;; (FOR IN-HASHTABLE)
(defclause-driver (for key-val-vars in-hashtable table)
"Elements and keys of a hashtable"
(top-level-check)
(unless (consp key-val-vars)
(clause-error "~a should be a list of up to two variables: the first ~
for the keys, the second for the values." key-val-vars))
! (let* ((iterator (gensym "HASH-TABLE-ITERATOR-"))
(more? (gensym))
(var-spec `(values ,more? .,key-val-vars))
(setqs (do-dsetq var-spec `(,iterator)))
--- 2596,2609 ----
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Hash-table, Packages and Streams
! ;;; (for in-hashtable)
(defclause-driver (for key-val-vars in-hashtable table)
"Elements and keys of a hashtable"
(top-level-check)
(unless (consp key-val-vars)
(clause-error "~a should be a list of up to two variables: the first ~
for the keys, the second for the values." key-val-vars))
! (let* ((iterator (gensym (symbol-name '#:hash-table-iterator-)))
(more? (gensym))
(var-spec `(values ,more? .,key-val-vars))
(setqs (do-dsetq var-spec `(,iterator)))
***************
*** 2614,2620 ****
(return-driver-code :next (list setqs test)
:variable var-spec)))
! ;;; (FOR IN-PACKAGES &optional HAVING-ACCESS)
(defclause-driver (for sym-access-pkg-vars in-packages pkgs &optional
having-access (sym-types '(:external :internal :inherited)))
"Symbols and their access-types in packages"
;;defclause-driver has the benefit over defmacro-driver of less code walking
--- 2614,2620 ----
(return-driver-code :next (list setqs test)
:variable var-spec)))
! ;;; (for in-packages &optional having-access)
(defclause-driver (for sym-access-pkg-vars in-packages pkgs &optional
having-access (sym-types '(:external :internal :inherited)))
"Symbols and their access-types in packages"
;;defclause-driver has the benefit over defmacro-driver of less code walking
***************
*** 2626,2632 ****
(unless (consp sym-types)
(clause-error "~s should be a list of symbols indicating the symbols' ~
access types." sym-types))
! (let* ((iterator (gensym "PACKAGE-ITERATOR-"))
(more? (gensym))
(var-spec `(values ,more? .,sym-access-pkg-vars))
(setqs (do-dsetq var-spec `(,iterator)))
--- 2626,2632 ----
(unless (consp sym-types)
(clause-error "~s should be a list of symbols indicating the symbols' ~
access types." sym-types))
! (let* ((iterator (gensym (symbol-name '#:package-iterator-)))
(more? (gensym))
(var-spec `(values ,more? .,sym-access-pkg-vars))
(setqs (do-dsetq var-spec `(,iterator)))
***************
*** 2636,2654 ****
(return-driver-code :next (list setqs test)
:variable var-spec)))
! ;;; (FOR IN-PACKAGE &optional EXTERNAL-ONLY)
(defmacro-driver (for var in-package pkg &optional external-only (ext nil))
"Symbols accessible in a package"
`(,(if generate 'generate 'for) (,var) in-packages ,pkg having-access
,(if ext '(:external) '(:external :internal :inherited))))
! ;;; (FOR IN-FILE &optional USING)
(defclause-driver (for var in-file filename &optional using (reader '#'read))
"Forms in a file"
(top-level-check)
(return-stream-driver-code var filename reader :file generate))
! ;;; (FOR IN-STREAM &optional USING)
(defclause-driver (for var in-stream stream &optional using (reader '#'read))
"Forms in a stream (which will be closed at the end)"
(top-level-check)
--- 2636,2654 ----
(return-driver-code :next (list setqs test)
:variable var-spec)))
! ;;; (for in-package &optional external-only)
(defmacro-driver (for var in-package pkg &optional external-only (ext nil))
"Symbols accessible in a package"
`(,(if generate 'generate 'for) (,var) in-packages ,pkg having-access
,(if ext '(:external) '(:external :internal :inherited))))
! ;;; (for in-file &optional using)
(defclause-driver (for var in-file filename &optional using (reader '#'read))
"Forms in a file"
(top-level-check)
(return-stream-driver-code var filename reader :file generate))
! ;;; (for in-stream &optional using)
(defclause-driver (for var in-stream stream &optional using (reader '#'read))
"Forms in a stream (which will be closed at the end)"
(top-level-check)
***************
*** 2685,2697 ****
:variable var)))
! ;;; (FOR NEXT)
(defclause-driver (for var next next)
"General driver; VAR is set to value of NEXT"
(return-driver-code :variable var
:next (list (do-dsetq var (walk-expr next)))))
! ;;; (FOR DO-NEXT)
(defclause-driver (for var do-next next)
"General driver; VAR must be set in DO-NEXT"
(do-dsetq var '(list)) ; for effect only, to make var known
--- 2685,2697 ----
:variable var)))
! ;;; (for next)
(defclause-driver (for var next next)
"General driver; VAR is set to value of NEXT"
(return-driver-code :variable var
:next (list (do-dsetq var (walk-expr next)))))
! ;;; (for do-next)
(defclause-driver (for var do-next next)
"General driver; VAR must be set in DO-NEXT"
(do-dsetq var '(list)) ; for effect only, to make var known
***************
*** 2821,2827 ****
(defsynonym count counting)
! ;;; (COUNTING &optional INTO)
(defclause (counting expr &optional into var)
"Increment a variable if expression is non-nil"
(return-reduction-code :identity 0
--- 2821,2827 ----
(defsynonym count counting)
! ;;; (counting &optional into)
(defclause (counting expr &optional into var)
"Increment a variable if expression is non-nil"
(return-reduction-code :identity 0
***************
*** 2832,2838 ****
:type 'fixnum
:accum-kind :increment))
! ;;; (SUM &optional INTO)
(defclause (sum expr &optional into var)
"Sum into a variable"
(return-reduction-code :identity 0
--- 2832,2838 ----
:type 'fixnum
:accum-kind :increment))
! ;;; (sum &optional into)
(defclause (sum expr &optional into var)
"Sum into a variable"
(return-reduction-code :identity 0
***************
*** 2845,2851 ****
(defsynonym summing sum)
! ;;; (MULTIPLY &optional INTO)
(defclause (multiply expr &optional into var)
"Multiply into a variable"
(return-reduction-code :identity 1
--- 2845,2851 ----
(defsynonym summing sum)
! ;;; (multiply &optional into)
(defclause (multiply expr &optional into var)
"Multiply into a variable"
(return-reduction-code :identity 1
***************
*** 2859,2865 ****
(defsynonym multiplying multiply)
! ;;; (REDUCING BY &optional INITIAL-VALUE INTO)
(defclause (reducing expr by op &optional initial-value (init-val nil iv?)
into var-spec)
"Generalized reduction"
--- 2859,2865 ----
(defsynonym multiplying multiply)
! ;;; (reducing by &optional initial-value into)
(defclause (reducing expr by op &optional initial-value (init-val nil iv?)
into var-spec)
"Generalized reduction"
***************
*** 2899,2912 ****
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Extrema.
! ;;; (MAXIMIZE &optional INTO)
(defclause (maximize expr &optional into var)
"Maximize value of an expression"
(return-extremum-code expr var 'max))
(defsynonym maximizing maximize)
! ;;; (MINIMIZE &optional INTO)
(defclause (minimize expr &optional into var)
"Minimize value of an expression"
(return-extremum-code expr var 'min))
--- 2899,2912 ----
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Extrema.
! ;;; (maximize &optional into)
(defclause (maximize expr &optional into var)
"Maximize value of an expression"
(return-extremum-code expr var 'max))
(defsynonym maximizing maximize)
! ;;; (minimize &optional into)
(defclause (minimize expr &optional into var)
"Minimize value of an expression"
(return-extremum-code expr var 'min))
***************
*** 2945,2979 ****
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Control flow.
! ;;; (FIMISH)
(defmacro finish ()
"Leave the loop gracefully, executing the epilogue"
(setq *loop-end-used?* t)
`(go ,*loop-end*))
! ;;; (TERMINATE)
(defmacro terminate () ; recommended for use with FOR ... NEXT
"Use within FOR ... DO-/NEXT clause to end the iteration"
'(finish))
! ;;; (NEXT-ITERATION)
(defmacro next-iteration ()
"Begin the next iteration"
(setq *loop-step-used?* t)
`(go ,*loop-step*))
! ;;; (LEAVE &optional)
(defmacro leave (&optional value)
"Exit the loop without running the epilogue code"
`(return-from ,*block-name* ,value))
! ;;; (WHILE)
(defclause (while expr)
"Exit loop if test is nil"
(setq *loop-end-used?* t)
(return-code :body `((if (not ,(walk-expr expr)) (go ,*loop-end*)))))
! ;;; (UNTIL)
(defclause (until expr)
"Exit loop if test is non-nil"
(setq *loop-end-used?* t)
--- 2945,2979 ----
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Control flow.
! ;;; (fimish)
(defmacro finish ()
"Leave the loop gracefully, executing the epilogue"
(setq *loop-end-used?* t)
`(go ,*loop-end*))
! ;;; (terminate)
(defmacro terminate () ; recommended for use with FOR ... NEXT
"Use within FOR ... DO-/NEXT clause to end the iteration"
'(finish))
! ;;; (next-iteration)
(defmacro next-iteration ()
"Begin the next iteration"
(setq *loop-step-used?* t)
`(go ,*loop-step*))
! ;;; (leave &optional)
(defmacro leave (&optional value)
"Exit the loop without running the epilogue code"
`(return-from ,*block-name* ,value))
! ;;; (while)
(defclause (while expr)
"Exit loop if test is nil"
(setq *loop-end-used?* t)
(return-code :body `((if (not ,(walk-expr expr)) (go ,*loop-end*)))))
! ;;; (until)
(defclause (until expr)
"Exit loop if test is non-nil"
(setq *loop-end-used?* t)
***************
*** 2986,2992 ****
;; Use same :if-exists kind of accumulation as finding ... such-that
;; so the clauses can be used together.
! ;;; (ALWAYS)
(defclause (always expr)
"Return last value iff expression is always non-nil"
;; VALUE: primary value of expr
--- 2986,2992 ----
;; Use same :if-exists kind of accumulation as finding ... such-that
;; so the clauses can be used together.
! ;;; (always)
(defclause (always expr)
"Return last value iff expression is always non-nil"
;; VALUE: primary value of expr
***************
*** 2996,3002 ****
(return-code :body `((or (setq ,var ,expr)
(return-from ,*block-name* nil))))))
! ;;; (NEVER)
(defclause (never expr)
"Return T iff expression is never non-nil"
;; VALUE: always nil
--- 2996,3002 ----
(return-code :body `((or (setq ,var ,expr)
(return-from ,*block-name* nil))))))
! ;;; (never)
(defclause (never expr)
"Return T iff expression is never non-nil"
;; VALUE: always nil
***************
*** 3007,3013 ****
(return-code :body `((if ,expr (return-from ,*block-name* nil))))))
! ;;; (THEREIS)
(defclause (thereis expr)
"Return value of expression as soon as it is non-nil"
;; VALUE: always nil
--- 3007,3013 ----
(return-code :body `((if ,expr (return-from ,*block-name* nil))))))
! ;;; (thereis)
(defclause (thereis expr)
"Return value of expression as soon as it is non-nil"
;; VALUE: always nil
***************
*** 3020,3026 ****
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Finders.
! ;;; (FINDING SUCH-THAT &optional INTO ON-FAILURE)
(defclause (finding expr such-that test &optional into var-spec
on-failure fval)
"Return expression when test is non-nil"
--- 3020,3026 ----
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Finders.
! ;;; (finding such-that &optional into on-failure)
(defclause (finding expr such-that test &optional into var-spec
on-failure fval)
"Return expression when test is non-nil"
***************
*** 3037,3043 ****
(return-code :body `((when ,(make-funcall test expr)
(setq ,var ,expr)
(go ,*loop-end*))))
! (let ((temp-var (gensym "FINDING")))
(return-code :body `((let ((,temp-var ,expr))
(when ,(make-funcall test temp-var)
(setq ,var ,temp-var)
--- 3037,3043 ----
(return-code :body `((when ,(make-funcall test expr)
(setq ,var ,expr)
(go ,*loop-end*))))
! (let ((temp-var (gensym (symbol-name '#:finding))))
(return-code :body `((let ((,temp-var ,expr))
(when ,(make-funcall test temp-var)
(setq ,var ,temp-var)
***************
*** 3046,3057 ****
(setq ,var ,expr)
(go ,*loop-end*)))))))
! ;;; (FINDING MAXIMIZING &optional INTO)
(defclause (finding expr maximizing max-expr &optional into variable)
"Return value which maximizes expression"
(return-find-extremum-code expr max-expr variable :max))
! ;;; (FINDING MINIMIZING &optional INTO)
(defclause (finding expr minimizing min-expr &optional into variable)
"Return value which minimizes expression"
(return-find-extremum-code expr min-expr variable :min))
--- 3046,3057 ----
(setq ,var ,expr)
(go ,*loop-end*)))))))
! ;;; (finding maximizing &optional into)
(defclause (finding expr maximizing max-expr &optional into variable)
"Return value which maximizes expression"
(return-find-extremum-code expr max-expr variable :max))
! ;;; (finding minimizing &optional into)
(defclause (finding expr minimizing min-expr &optional into variable)
"Return value which minimizes expression"
(return-find-extremum-code expr min-expr variable :min))
***************
*** 3206,3212 ****
(coerce ,collect-var ',result-type)))))))))))
! ;;; (COLLECT &optional INTO AT RESULT-TYPE)
(defclause (collect expr &optional into var at (place 'end)
result-type (type 'list))
"Collect into a list"
--- 3206,3212 ----
(coerce ,collect-var ',result-type)))))))))))
! ;;; (collect &optional into at result-type)
(defclause (collect expr &optional into var at (place 'end)
result-type (type 'list))
"Collect into a list"
***************
*** 3221,3227 ****
(defsynonym collecting collect)
! ;;; (ADJOINING &optional INTO AT TEST RESULT-TYPE)
(defclause (adjoining expr &optional into var
at (place 'end)
test (test '#'eql)
--- 3221,3227 ----
(defsynonym collecting collect)
! ;;; (adjoining &optional into at test result-type)
(defclause (adjoining expr &optional into var
at (place 'end)
test (test '#'eql)
***************
*** 3255,3261 ****
! ;;; (NCONCING &optional INTO AT)
(defclause (nconcing expr &optional into var at (place 'end))
"Nconc into a list"
(return-collection-code
--- 3255,3261 ----
! ;;; (nconcing &optional into at)
(defclause (nconcing expr &optional into var at (place 'end))
"Nconc into a list"
(return-collection-code
***************
*** 3265,3271 ****
:place place
:one-element nil))
! ;;; (APPENDING &optional INTO AT)
(defclause (appending expr &optional into var at (place 'end))
"Append into a list"
(return-collection-code
--- 3265,3271 ----
:place place
:one-element nil))
! ;;; (appending &optional into at)
(defclause (appending expr &optional into var at (place 'end))
"Append into a list"
(return-collection-code
***************
*** 3276,3282 ****
:place place
:one-element nil))
! ;;; (UNIONING &optional INTO AT TEST)
(defclause (unioning expr &optional into var at (place 'end)
test (test '#'eql))
"Union into a list"
--- 3276,3282 ----
:place place
:one-element nil))
! ;;; (unioning &optional into at test)
(defclause (unioning expr &optional into var at (place 'end)
test (test '#'eql))
"Union into a list"
***************
*** 3294,3300 ****
:place place
:one-element nil))
! ;;; (NUNIONING &optional INTO AT TEST)
(defclause (nunioning expr &optional into var at (place 'end)
test (test '#'eql))
"Union into a list, destructively"
--- 3294,3300 ----
:place place
:one-element nil))
! ;;; (nunioning &optional into at test)
(defclause (nunioning expr &optional into var at (place 'end)
test (test '#'eql))
"Union into a list, destructively"
***************
*** 3313,3319 ****
:one-element nil))
! ;;; (ACCUMULATE BY &optional INITIAL-VALUE INTO)
(defclause (accumulate expr by op &optional initial-value init-val
into var-spec)
"Generalized accumulation"
--- 3313,3319 ----
:one-element nil))
! ;;; (accumulate by &optional initial-value into)
(defclause (accumulate expr by op &optional initial-value init-val
into var-spec)
"Generalized accumulation"
***************
*** 3344,3350 ****
;;; the save code can go in the step portion of the loop; but if there is a
;;; generator, the best we can do is use a flag for the first time.
! ;;; (FOR PREVIOUS &optional INITIALLY BACK)
(defclause (for pvar previous var &optional initially (default nil default?)
back (n-expr 1))
"Previous value of a variable"
--- 3344,3350 ----
;;; the save code can go in the step portion of the loop; but if there is a
;;; generator, the best we can do is use a flag for the first time.
! ;;; (for previous &optional initially back)
(defclause (for pvar previous var &optional initially (default nil default?)
back (n-expr 1))
"Previous value of a variable"
***************
*** 3401,3407 ****
(defun make-save-vars (var n)
(let ((list nil)
! (string (format nil "SAVE-~a-" var)))
(dotimes (i n)
(let ((svar (make-var-and-default-binding string :using-type-of var)))
(push svar list)))
--- 3401,3407 ----
(defun make-save-vars (var n)
(let ((list nil)
! (string (format nil "~a-~a-" '#:save var)))
(dotimes (i n)
(let ((svar (make-var-and-default-binding string :using-type-of var)))
(push svar list)))
***************
*** 3474,3480 ****
init-code))
(defun make-post-save-var (var)
! (make-var-and-default-binding (format nil "POST-SAVE-~a-" var)
:using-type-of var))
--- 3474,3480 ----
init-code))
(defun make-post-save-var (var)
! (make-var-and-default-binding (format nil "~a-~a-" '#:post-save var)
:using-type-of var))
***************
*** 3567,3573 ****
(defvar *genvar-counter* 0)
! (defun genvar (&optional (string "TEMP"))
(prog1 (make-symbol (format nil "~a~d" string *genvar-counter*))
(incf *genvar-counter*)))
--- 3567,3573 ----
(defvar *genvar-counter* 0)
! (defun genvar (&optional (string (symbol-name '#:temp)))
(prog1 (make-symbol (format nil "~a~d" string *genvar-counter*))
(incf *genvar-counter*)))
Only in ../iterate-20111001-darcs/: iterate.lisp~
diff -rc iterate-20111001-darcs/iterate-test.lisp
../iterate-20111001-darcs/iterate-test.lisp
*** iterate-20111001-darcs/iterate-test.lisp 2011-10-02 01:17:06.000000000
+1000
--- ../iterate-20111001-darcs/iterate-test.lisp 2011-11-01 22:48:16.000000000
+1100
***************
*** 346,357 ****
(()()))
(deftest in-packages.generator-access
! (let ((iter-syms (iterate (generate (sym access) in-packages (list
(find-package "COMMON-LISP")))
(repeat 1)
(next sym)
(collect (list sym access)))))
(equal (multiple-value-list
! (find-symbol (symbol-name (caar iter-syms)) "COMMON-LISP"))
(car iter-syms)))
t)
--- 346,357 ----
(()()))
(deftest in-packages.generator-access
! (let ((iter-syms (iterate (generate (sym access) in-packages (list
(find-package :common-lisp)))
(repeat 1)
(next sym)
(collect (list sym access)))))
(equal (multiple-value-list
! (find-symbol (symbol-name (caar iter-syms)) :common-lisp))
(car iter-syms)))
t)
***************
*** 1494,1505 ****
14)
(deftest defmacro-clause.1
! (defmacro-clause (multiply.clause expr &optional INTO var)
"from testsuite"
`(reducing ,expr by #'* into ,var initial-value 1))
;; A better return value would be the exact list usable with remove-clause
;; The next version shall do that
! (multiply.clause expr &optional INTO var))
(deftest multiply.clause
(iter (for el in '(1 2 3 4))
--- 1494,1505 ----
14)
(deftest defmacro-clause.1
! (defmacro-clause (multiply.clause expr &optional into var)
"from testsuite"
`(reducing ,expr by #'* into ,var initial-value 1))
;; A better return value would be the exact list usable with remove-clause
;; The next version shall do that
! (multiply.clause expr &optional into var))
(deftest multiply.clause
(iter (for el in '(1 2 3 4))
***************
*** 1507,1522 ****
24)
(deftest remove-clause.1
! (iter::remove-clause '(multiply.clause &optional INTO))
t)
(deftest remove-clause.2
(values
(ignore-errors
! (iter::remove-clause '(multiply.clause &optional INTO))))
nil)
! (iter:defmacro-clause (for var IN-WHOLE-VECTOR.clause v)
"All the elements of a vector (disregards fill-pointer)"
(let ((vect (gensym "VECTOR"))
(index (gensym "INDEX")))
--- 1507,1522 ----
24)
(deftest remove-clause.1
! (iter::remove-clause '(multiply.clause &optional into))
t)
(deftest remove-clause.2
(values
(ignore-errors
! (iter::remove-clause '(multiply.clause &optional into))))
nil)
! (iter:defmacro-clause (for var in-whole-vector.clause v)
"All the elements of a vector (disregards fill-pointer)"
(let ((vect (gensym "VECTOR"))
(index (gensym "INDEX")))
***************
*** 1526,1532 ****
(for ,var = (aref ,vect ,index)))))
(deftest in-whole-vector.clause
! (iter (for i IN-WHOLE-VECTOR.clause (make-array 3 :fill-pointer 2
:initial-contents '(1 2 3)))
(collect i))
(1 2 3))
--- 1526,1532 ----
(for ,var = (aref ,vect ,index)))))
(deftest in-whole-vector.clause
! (iter (for i in-whole-vector.clause (make-array 3 :fill-pointer 2
:initial-contents '(1 2 3)))
(collect i))
(1 2 3))
***************
*** 1537,1543 ****
(collect i))
(1 2))
! (iter:defmacro-driver (for var IN-WHOLE-VECTOR v)
"All the elements of a vector (disregards fill-pointer)"
(let ((vect (gensym "VECTOR"))
(end (gensym "END"))
--- 1537,1543 ----
(collect i))
(1 2))
! (iter:defmacro-driver (for var in-whole-vector v)
"All the elements of a vector (disregards fill-pointer)"
(let ((vect (gensym "VECTOR"))
(end (gensym "END"))
***************
*** 1552,1571 ****
(aref ,vect ,index))))))
(deftest in-whole-vector.driver
! (iter (for i IN-WHOLE-VECTOR (make-array '(3) :fill-pointer 2
:initial-contents '(1 2 3)))
(collect i))
(1 2 3))
(deftest in-whole-vector.generate
! (iter (generating i IN-WHOLE-VECTOR (make-array '(3) :fill-pointer 2
:initial-contents '(1 2 3)))
(collect (next i)))
(1 2 3))
(deftest defclause-sequence
(progn
! (iter:defclause-sequence IN-WHOLE-VECTOR.seq INDEX-OF-WHOLE-VECTOR
:access-fn 'aref
:size-fn '#'(lambda (v) (array-dimension v 0))
:sequence-type 'vector
--- 1552,1571 ----
(aref ,vect ,index))))))
(deftest in-whole-vector.driver
! (iter (for i in-whole-vector (make-array '(3) :fill-pointer 2
:initial-contents '(1 2 3)))
(collect i))
(1 2 3))
(deftest in-whole-vector.generate
! (iter (generating i in-whole-vector (make-array '(3) :fill-pointer 2
:initial-contents '(1 2 3)))
(collect (next i)))
(1 2 3))
(deftest defclause-sequence
(progn
! (iter:defclause-sequence in-whole-vector.seq index-of-whole-vector
:access-fn 'aref
:size-fn '#'(lambda (v) (array-dimension v 0))
:sequence-type 'vector
***************
*** 1578,1597 ****
t)
(deftest in-whole-vector.seq
! (iter (for i IN-WHOLE-VECTOR.seq (make-array '(3) :fill-pointer 2
:initial-contents '(1 2 3)))
(collect i))
(1 2 3))
(deftest in-whole-vector.seq.index
! (iter (for i INDEX-OF-WHOLE-VECTOR
(make-array 3 :fill-pointer 2 :initial-contents '(1 2 3)))
(for j previous i :initially 9)
(collect (list j i)))
((9 0)(0 1)(1 2)))
(deftest in-whole-vector.seq.with-index
! (iter (for e IN-WHOLE-VECTOR.seq
(make-array '(3) :fill-pointer 2 :initial-contents '(a b c))
:with-index i)
(for j previous i :initially 9)
--- 1578,1597 ----
t)
(deftest in-whole-vector.seq
! (iter (for i in-whole-vector.seq (make-array '(3) :fill-pointer 2
:initial-contents '(1 2 3)))
(collect i))
(1 2 3))
(deftest in-whole-vector.seq.index
! (iter (for i index-of-whole-vector
(make-array 3 :fill-pointer 2 :initial-contents '(1 2 3)))
(for j previous i :initially 9)
(collect (list j i)))
((9 0)(0 1)(1 2)))
(deftest in-whole-vector.seq.with-index
! (iter (for e in-whole-vector.seq
(make-array '(3) :fill-pointer 2 :initial-contents '(a b c))
:with-index i)
(for j previous i :initially 9)
***************
*** 1599,1605 ****
((9 0 a)(0 1 b)(1 2 c)))
(deftest in-whole-vector.seq.generate
! (iter (generate e IN-WHOLE-VECTOR.seq
(make-array 3 :fill-pointer 2 :initial-contents '(a b c))
:with-index i)
(collect (list (next e) e i)))
--- 1599,1605 ----
((9 0 a)(0 1 b)(1 2 c)))
(deftest in-whole-vector.seq.generate
! (iter (generate e in-whole-vector.seq
(make-array 3 :fill-pointer 2 :initial-contents '(a b c))
:with-index i)
(collect (list (next e) e i)))
***************
*** 1612,1618 ****
;; - Do not use (finally (RETURN ,winner)) either, as that would
;; always return accumulated value, even in case of ... INTO nil.
(deftest defmacro-clause.2
! (defmacro-clause (FINDING expr MAXING func &optional INTO var)
"Iterate paper demo example"
(let ((max-val (gensym "MAX-VAL"))
(temp1 (gensym "EL"))
--- 1612,1618 ----
;; - Do not use (finally (RETURN ,winner)) either, as that would
;; always return accumulated value, even in case of ... INTO nil.
(deftest defmacro-clause.2
! (defmacro-clause (finding expr maxing func &optional into var)
"Iterate paper demo example"
(let ((max-val (gensym "MAX-VAL"))
(temp1 (gensym "EL"))
***************
*** 1626,1632 ****
(when (or (null ,max-val) (> ,temp2 ,max-val))
(setq ,winner ,temp1 ,max-val ,temp2)))
#|(finally (return ,winner))|# )))
! (FINDING expr MAXING func &optional INTO var))
(deftest maxing.1
(iter (for i in-vector #(1 5 3))
--- 1626,1632 ----
(when (or (null ,max-val) (> ,temp2 ,max-val))
(setq ,winner ,temp1 ,max-val ,temp2)))
#|(finally (return ,winner))|# )))
! (finding expr maxing func &optional into var))
(deftest maxing.1
(iter (for i in-vector #(1 5 3))
Only in ../iterate-20111001-darcs/: iterate-test.lisp~
_______________________________________________
iterate-devel site list
iterate-devel@common-lisp.net
http://common-lisp.net/mailman/listinfo/iterate-devel
