vecfun.scm 2.2 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263
  1. ;;; vecfun: an example Pre-Scheme program
  2. ;; vec-a is computed at compile-time
  3. (define %vec-a (vector-unfold (lambda (i)
  4. (* i i))
  5. 5))
  6. ;; take vec-a's length at compile-time
  7. (define %len-a (vector-length %vec-a))
  8. (define (main)
  9. (define out (current-output-port))
  10. (write-string "Print vec-a with vector-for-each:\n" out)
  11. (vector-for-each (lambda (i val)
  12. (write-string " vec-a[" out)
  13. (write-integer i out)
  14. (write-string "] = " out)
  15. (write-integer val out)
  16. (newline out))
  17. %vec-a %len-a)
  18. (write-string "Print the last value of vec-a with vector-fold:\n" out)
  19. (let ((last (vector-fold (lambda (i res val)
  20. val)
  21. -1 %vec-a %len-a)))
  22. (write-string " vec-a[-1] = " out)
  23. (write-integer last out)
  24. (newline out))
  25. (write-string "Compute the sum of two vectors with vector-map:\n" out)
  26. (let ((sums (vector-map (lambda (i val1 val2)
  27. (+ val1 val2))
  28. %vec-a %len-a
  29. %vec-a %len-a)))
  30. (vector-for-each (lambda (i val)
  31. (write-string " sums[" out)
  32. (write-integer i out)
  33. (write-string "] = " out)
  34. (write-integer val out)
  35. (newline out))
  36. sums %len-a)
  37. (deallocate sums))
  38. (write-string "Build a vector of strings with vector-map:\n" out)
  39. (let ((strs (vector-map (lambda (i val)
  40. (string-repeat "x" val))
  41. %vec-a %len-a)))
  42. (vector-for-each (lambda (i val)
  43. (write-string " strs[" out)
  44. (write-integer i out)
  45. (write-string "] = \"" out)
  46. (write-string val out)
  47. (write-char #\" out)
  48. (newline out))
  49. strs %len-a)
  50. (vector-for-each (lambda (i val)
  51. (deallocate val))
  52. strs %len-a)
  53. (deallocate strs))
  54. 0)