;; -*-theme-d-*-

;; Copyright (C) 2014  Tommi Höynälänmaa
;; Distributed under GNU General Public License version 3,
;; see file doc/GPL-3.

;; Expected results: translation and running OK


(define-proper-program (tests test170)


  (import (standard-library core)
	  (standard-library console-io))

  
  (define-param-proc my-mutable-vector-map (%source %target)
		     (((proc (:procedure (%source) %target pure))
		       (v (:mutable-vector %source)))
		      (:mutable-vector %target) force-pure)
    (let* ((len (mutable-vector-length v))
	   (result (make-mutable-vector (:maybe %target) len null)))
      (do ((i <integer> 0 (+ i 1)))
	  ((>= i len)
	   (cast-mutable-vector %target result))
	(let ((element (mutable-vector-ref v i)))
	  (mutable-vector-set! result i
			       (proc element))))))


  (define-param-proc my-mutable-value-vector-map (%source %target)
		     (((proc (:procedure (%source) %target pure))
		       (v (:mutable-value-vector %source)))
		      (:mutable-value-vector %target) force-pure)
    (let* ((len (mutable-value-vector-length v))
	   (result (make-mutable-value-vector (:maybe %target) len null)))
      (do ((i <integer> 0 (+ i 1)))
	  ((>= i len)
	   (cast-mutable-value-vector %target result))
	(let ((element (mutable-value-vector-ref v i)))
	  (mutable-value-vector-set! result i
				     (proc element))))))


  (define-param-proc-alt display-mutable-vector (%type)
    (lambda (((v (:mutable-vector %type))) <none> nonpure)
      (let ((len (mutable-vector-length v)))
	(let-mutable ((j <integer> 0))
	  (until ((>= j len))
	    (console-display (mutable-vector-ref v j))
	    (console-newline)
	    (set! j (+ j 1)))))))


  (define-param-proc-alt display-mutable-value-vector (%type)
    (lambda (((v (:mutable-value-vector %type))) <none> nonpure)
      (let ((len (mutable-value-vector-length v)))
	(let-mutable ((j <integer> 0))
	  (until ((>= j len))
	    (console-display (mutable-value-vector-ref v j))
	    (console-newline)
	    (set! j (+ j 1)))))))


  (define-simple-proc add1-real (((r <real>)) <real> pure)
    (+ r 1.0))


  (define-simple-proc add1-integer (((n <integer>)) <integer> pure)
    (+ n 1))


  (define main
    (lambda (() <integer> nonpure)
      (let ((my-vec1 (mutable-vector <real> 1.1 2.1 3.1 4.1 5.0))
	    (my-vec2 (mutable-value-vector <integer> 10 9 8 7 6 5)))
	(let ((result-vec1
	       (my-mutable-vector-map add1-real my-vec1))
	      (result-vec2
	       (my-mutable-value-vector-map add1-integer my-vec2)))
	  (display-mutable-vector result-vec1)
	  (display-mutable-value-vector result-vec2)))
      0)))

