shirok

;; f(z) = z^3 + 2z^2 + 1
(define (f z) (+ (expt z 3) (* 2 (square z)) 1))

;; f'(z) = 3z^2 + 4z
(define (df z) (+ (* 3 (square z)) (* 4 z)))

;; ニュートン法。初期値zから出発。変化が充分少なくなったらその時のzがf(z)=0の解。
;; 微分が0に近くなった場合はエラーとする。
;; 循環してしまうケースは検出しない (止まらなくなる)
(define (newton z)

shirok

(define threes '#0=(#f #f #t . #0#))
(define fives  '#1=(#f #f #f #f #t . #1#))
(define digits '#2=(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9 . #2#))
(define one (list (cdr digits)))

(define (inc num)
  (if (eqv? (caar num) #\9)
    (if (null? (cdr num))
      (cons digits one)
      (cons digits (inc (cdr num))))

shirok

;; -*- coding:utf-8 -*-

(use gauche.sequence)
(use util.match)
(use util.combinations)
(use srfi-197)                          ;chain

(define (num-fingers hands)
  (define (f hand) (case hand
                     [(グー) 0]

shirok

gosh> (define-method object-+ ((f <procedure>) (g <procedure>)) (lambda (x) (+ (f x) (g x))))
#<generic object-+ (1)>
gosh> (define (f x) (* x 2))
f
gosh> (define (g x) (* x 3))
g
gosh> ((+ f g) 4)
20

shirok

(defn- start-server []
  (-> (duct/resource "my_project/config.edn")
      (duct/read-config)
      (duct/prep-config [:duct.profile/test])
      (ig/init [:duct.router/ataraxy :duct.migrator/ragtime])))

(def #^:dynamic the-system
  "During the test, this var holds the initialized system map."
  nil)

shirok

(use util.match)
(use data.sparse)

(define-macro (make-dumper . labels)
  `(lambda (memory)
     (list ,@(map (^l `(list ',l (~ memory ,l))) labels))))

(define (run program memory dumper)
  (define (DJN pc)
    (match-let1 (dest ptr) (~ program pc)

shirok

(define (filter pred xs)
  (define (skip xs)
    (cond [(null? xs) xs]
          [(pred (car xs)) xs]
          [else (skip (cdr xs))]))
  (unfold null?
          (^[xs] (car xs))
          (^[xs] (skip (cdr xs)))
          (skip xs)))

shirok

(define (filter pred xs)
  (define (skip xs)
    (cond [(null? xs) xs]
          [(pred (car xs)) xs]
          [else (skip (cdr xs))]))
  (unfold (^[xs] (null? (skip xs)))
          (^[xs] (car (skip xs)))
          (^[xs] (cdr (skip xs)))
          xs))

shirok

gosh> (define (double-y)
  (let ((+y #f))
    (set! +y (lambda (x) (+ x y)))
    (let-syntax ((macro (er-macro-transformer
                          (lambda (form rename compare)
                            `(,(rename '+) ,(cadr form) ,(+y 0))))))
      (display (macro y))
      (newline))))

*** ERROR: [internal error] stray local variable: #(lvar +y #(5 #f) 2 1)

shirok

diff --git a/sanmai.scm b/sanmai.scm
index 5fcc936..773fbaf 100644
--- a/sanmai.scm
+++ b/sanmai.scm
@@ -58,7 +58,7 @@
 
 (de FRAME-RATE 44100)
 (de FADE-MS 3)
-(de FRAME/MS (/ FRAME-RATE 1000))
+(de FRAME/MS (/. FRAME-RATE 1000))