prescheme-demo/vecfun.scm

;;; vecfun: an example Pre-Scheme program

;; FIXME: bodge to support static init from main
(define %static-init (external "vecfun_init" (=> () null)))

;; vec-a is computed at compile-time
(define %vec-a (vector-unfold (lambda (i)
                                (* i i))
                              5))

;; take vec-a's length at compile-time
(define %len-a (vector-length %vec-a))

(define (main)
  (define out (current-output-port))

  ;; XXX: We need to run static-init to initialize vec-a, otherwise the
  ;; following code will segfault.  The Scheme 48 VM gets around this by
  ;; using a hand-coded C main which runs the init routine before
  ;; calling the Pre-Scheme entrypoint.
  (%static-init)

  (write-string "Print vec-a with vector-for-each:\n" out)
  (vector-for-each (lambda (i val)
                     (write-string " vec-a[" out)
                     (write-integer i out)
                     (write-string "] = " out)
                     (write-integer val out)
                     (newline out))
                   %vec-a %len-a)

  (write-string "Print the last value of vec-a with vector-fold:\n" out)
  (let ((last (vector-fold (lambda (i res val)
                             val)
                           -1 %vec-a %len-a)))
    (write-string " vec-a[-1] = " out)
    (write-integer last out)
    (newline out))

  (write-string "Compute the sum of two vectors with vector-map:\n" out)
  (let ((sums (vector-map (lambda (i val1 val2)
                            (+ val1 val2))
                          %vec-a %len-a
                          %vec-a %len-a)))
    (vector-for-each (lambda (i val)
                       (write-string " sums[" out)
                       (write-integer i out)
                       (write-string "] = " out)
                       (write-integer val out)
                       (newline out))
                     sums %len-a)
    (deallocate sums))

  (write-string "Build a vector of strings with vector-map:\n" out)
  (let ((strs (vector-map (lambda (i val)
                            (string-repeat "x" val))
                          %vec-a %len-a)))
    (vector-for-each (lambda (i val)
                       (write-string " strs[" out)
                       (write-integer i out)
                       (write-string "] = \"" out)
                       (write-string val out)
                       (write-char #\" out)
                       (newline out))
                     strs %len-a)
    (vector-for-each (lambda (i val)
                       (deallocate val))
                     strs %len-a)
    (deallocate strs))

  0)