komono-base.scm

; 小物モジュール(基本)
(define-module komono-base
  (use srfi-1)  ; list
  (use srfi-13) ; string
  (use util.stream)
  (use gauche.collection)
  ;
  (export
    nop             ; なにもしない。
    make-alist      ; 連想リストを生成する。
    ;
    ;返り値を拡張する
    if-*fn$
    if-stringfn$
    if-listfn$
    if-car-listfn$
    ;
    andfn$          ; ($ .. $ ..)のなかで使う。途中で#fが返ると#fをかえすように
    andfn-fn$
    andfn-map$
    andfn-filter$
    ;
    ; .$ の途中にはさんで中身をのぞくため
    peek$
    tee$
    tee-format-stderr$
    tee-format-stdout$
    tee-nanosleep$
    tee-sleep$
    ;
    ;多値
    values-car ; 多値の先頭
    values-cdr ; 多値の先頭をのぞいたもの
    values-ref$     ; values-refの部分適用版
    ;
    ; I/O
    write-line      ; 一行単位にS式を書く
    ;
    ;stream
    stream-unfold
    x->stream
  )
)
(select-module komono-base)


;なにもしない
(define nop values )

;返り値を拡張する
; ok?....これに失敗すると返り値は#f
(define (if-*fn$ f ok? :optional (trans identity) )
  (^ arg
    (let1 r (apply f arg)
      (and r (ok? r) (trans r) ) ) ) )

(define if-listfn$     (cut if-*fn$ <> pair? ) )
(define if-car-listfn$ (cut if-*fn$ <> pair? car    ) )
(define if-stringfn$   (cut if-*fn$ <> (complement string-null?) ) )

; ($ .. $ ..)のなかで使う。途中で#fが返ると#fをかえすように
;andfn$ ... f .... 元の関数、#fを渡すと identityを返す
(define (andfn$ f)
  (if f
    (^x (and x (f x) ) )
    identity ) )

;andfn-fn$ ... f .... 元の関数、#fを渡すと identityを返す
; mはfilterやmapのような関数
(define (andfn-fn$ m f)
  (if f
    (andfn$ ($ m f $) )
    identity ) )

;andfn-map$ ... f .... 元の関数、#fを渡すと identityを返す
(define andfn-map$ ($ andfn-fn$ map $))

;andfn-filter$ ... f .... 元の関数、#fを渡すと identityを返す
(define andfn-filter$ ($ andfn-fn$ filter $))

; .$ の途中にはさんで中身をのぞくため
(define (tee$ outfn)
  (^ arg
    (apply outfn arg)  ;; 分岐出力
    (apply values arg) ;; そのまま返す
  ))

(define peek$ tee$) ; 別名
(define (tee-format-stderr$ fmt)
  (tee$ ($ format (standard-error-port) fmt $*) ) )

(define (tee-format-stdout$ fmt)
  (tee$ ($ format #t fmt $*) ) )

(define (tee-nanosleep$ n)
  (tee$ (^ _ (sys-nanosleep n) ) ) )

(define (tee-sleep$ n)
  (tee$ (^ _ (sys-sleep n) ) ) )

;連想リストを生成する。
; (make-alist k1 v1 k2 v2 k3 v3) ----> ( (k1 . v1) (k2 . v2) (k3 . v3) )
(define (make-alist . kvlist)
  ;(print kvlist)
  (unfold null? (^x (cons (car x) (cadr x) ) ) cddr kvlist )
)


;多値の先頭
(define (values-car . arg) (car arg) )

;多値の先頭をのぞいたもの
(define (values-cdr . arg) (apply values (cdr arg)) )

; values-refの部分適用版
(define (values-ref$ i) (^ arg (list-ref arg i) ) )

; 一行単位にS式を書く
(define (write-line x :optional (port (current-output-port)) )
  (write x port)
  (newline port)
)

;unfold
;TODO tailgen未対応
(define (stream-unfold p f g seed)
  (stream-unfoldn
            (^s
              (if (p s)
                (values #f    '())
                (values (g s) `(,(f s) ))))
            seed 1) )

;; generic version
(define-method x->stream ((obj <list>))     (list->stream obj))
(define-method x->stream ((obj <string>))   (string->stream obj))
;(define-method x->stream ((obj <vector>))  (vector->stream obj))
;(define-method x->stream ((obj <integer>)) (bits->stream obj))

(define-method x->stream ((obj <collection>))
  (iterator->stream (^ (s-next s-end)
    (call-with-iterator obj (^[end? next]
      (let loop ()
        (unless (end?) (s-next (next)) (loop))
        (s-end)
      ) ) ) ) ) )

(provide "komono-base")