#!/usr/local/bin/guile-oops \ -e main -s !# ;;; $Id: strcat.guile,v 1.4 2001/06/29 23:12:37 doug Exp $ ;;; http://www.bagley.org/~doug/shootout/ ;;; from Benedikt Rosenau (use-modules (oop goops)) (define-class <buffer> () (siz #:getter buffer-size #:init-value 64) (len #:getter buffer-length #:init-value 0) (field #:init-value (make-string 64))) (define-method (buffer->string (b <buffer>)) (substring (slot-ref b 'field) 0 (buffer-length b))) (define-method (buffer-append! (b <buffer>) (s <string>)) (let* ((length-b (buffer-length b)) (size-b (buffer-size b)) (length-s (string-length s)) (new-length (+ length-b length-s))) (if (> new-length size-b) (let* ((new-size (+ size-b (max length-b length-s))) (new-field (make-string new-size))) (substring-move-left! (slot-ref b 'field) 0 length-b new-field 0) (slot-set! b 'field new-field) (slot-set! b 'siz new-size))) (substring-move-left! s 0 length-s (slot-ref b 'field) length-b) (slot-set! b 'len new-length) b)) (define-method (main (args <list>)) (let ((n (or (and (= (length args) 2) (string->number (cadr args))) 1)) (buf (make <buffer>))) (do ((i 0 (+ i 1))) ((= i n)) (buffer-append! buf "hello\n")) (display (buffer-length buf)) (newline)))