;; -*-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 test168)


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


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


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


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


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


  (define main
    (lambda (() <integer> nonpure)
      (let ((my-vec10 (mutable-vector <real> 1.1 2.1 3.1 4.1 5.0))
	    (my-vec2 (vector <real> 1.2 2.2 3.2 4.2 5.1))
	    (my-vec30 (mutable-value-vector <integer> 10 9 8 7 6 5))
	    (my-vec4 (value-vector <integer> -1 -2 -3 -4)))
	(let* ((my-vec1 (cast-vector-metaclass my-vec10))
	       (my-vec3 (cast-value-vector-metaclass my-vec30))
	       (result-vec1
		(my-vector-map + my-vec1))
	       (result-vec2
		(my-vector-map + my-vec2))
	       (result-vec3
		(my-value-vector-map + my-vec3))
	       (result-vec4
		(my-value-vector-map + my-vec4)))
	  (display-vector result-vec1)
	  (display-vector result-vec2)
	  (display-value-vector result-vec3)
	  (display-value-vector result-vec4)))
      0)))

