#!/usr/bin/env gosh
;; simple cat(1) script
;; gauche either runs main when defined or loads the entire script

(define (main args)
  (if (null? (cdr args))
      (copy-port (current-input-port) (current-output-port))
      (for-each (lambda (file)
                  (call-with-input-file file
                    (lambda (in)
                      (copy-port in (current-output-port)))))
                (cdr args)))
  0)

;; reading an entire file
(define content (call-with-input-file "gauche.scm"
                  (lambda (p)
                    (port->string p))))

(define content (call-with-input-file "gauche.scm"
                  (lambda (p)
                    (port->string-list p))))

(map string-length content)
(apply min&max (map string-length content))

(define content (with-input-from-file "gauche.scm"
                  (lambda ()
                    (port-map
                     (lambda (line)
                       (string-length line))
                     read-line))))

;; basic IO loop
(let loop ((c (read-char)))
  (unless (eof-object? c)
    (display c)
    (loop (read-char))))

;; with string input
(with-string-io
 "aap, noot, mies"
 (lambda ()
   (let loop ((c (read-char)))
     (unless (eof-object? c)
       (display c)
       (loop (read-char))))))

;; only use R5RS bindings
(define-module foo
  (extend scheme))                      ; default is (extend gauche)

(select-module foo)

(define (r5rs-only bar)
  'lalala)

;; or just
(select-module scheme)

;; uvectors
(use gauche.uvector)
(call-with-input-file "/home/michelv/src/lisp/gauche.scm"
  (lambda (p)
    (let ((block (make-u8vector 32)))
      (until (eof-object? (read-block! block p))
             (print block)))))

;; non-empty, contiguous list segments (squiggol)
;; (list-segments '(a b c)) => '((a) (a b) (b) (b c) (c) (a b c))
(use srfi-1)

(define (list-segments-of-length n ls)
  (cond ((null? ls) '())
        ((< (length ls) n) '())
        (else (cons (take ls n)
                    (list-segments-of-length n (cdr ls))))))

(define (list-segments ls)
  (let1 result '()
    (dotimes (i (length ls))
      (set! result (append result (list-segments-of-length (+ i 1) ls))))
    result))

;; dbm interface
(use dbm)
(use dbm.gdbm)

(let ((db (dbm-open <gdbm> :path "/tmp/gauche.db" :rw-mode :create)))
  (do ((n 0 (+ n 1)))
      ((= n 10))
    (dbm-put! db
              (string-append "key-" (number->string n))
              (string-append "value-" (number->string n))))
  (print (dbm-map db (lambda (k v) (cons k v))))
  (dbm-close db))

;; remove. and unique.
(define (remove. item ls)
  "remove all occurences of ITEM from LS"
  (cond ((null? ls) '())
        ((equal? item (car ls)) (remove. item (cdr ls)))
        (else (cons (car ls) (remove. item (cdr ls))))))

(define (filter. predicate sequence)
  (cond ((null? sequence) '())
        ((predicate (car sequence))
         (cons (car sequence)
               (filter. predicate (cdr sequence))))
        (else (filter. predicate (cdr sequence)))))

(define (remove.2 item ls)
  (filter. (lambda (x) (not (equal? item x))) ls))

(define (unique. ls)
  "remove all duplicate occurences from LS"
  (cond ((null? ls) '())
        ((member (car ls) (cdr ls)) (unique. (cdr ls)))
        (else (cons (car ls) (unique. (cdr ls))))))

;; classes, see $gauche/test/object.scm
(define-class <person> ()
  ((name :accessor name-of)))

(define p (make <person>))

(slot-set! p 'name "Sjaak")
(slot-ref p 'name)
(name-of p)

;; ----------------------------------------------------------------------
;; Local Variables:
;; mode: gauche
;; End: