Gauche で、call/cc によるコンテキストスイッチのサンプル

callcc.bat

gosh callcc.scm
pause

callcc.scm

(cond-expand
 [gauche.os.windows
  (add-load-path "." :relative)
  (use char-ready-win)]
 [else])

(define (input)
  (while #t
    (when (char-ready?)
      (let ((cmd (read-line)))
        (cond ((equal? cmd "change") (set! k2 world))
              ((equal? cmd "revert") (set! k2 hello))
              ((equal? cmd "end")    (exit)))))
    (sys-sleep 1)
    (call/cc (lambda (k) (set! k1 k) (k2)))))

(define (hello)
  (while #t
    (print "Hello, ")
    (sys-sleep 1)
    (call/cc (lambda (k) (set! k2 k) (k1)))))

(define (world)
  (while #t
    (print "world!")
    (sys-sleep 1)
    (call/cc (lambda (k) (set! k2 k) (k1)))))

(define k1 input)
(define k2 hello)

(k1)

char-ready-win.scm

;;
;; char-ready? for windows
;;
(define-module char-ready-win
  (use os.windows)
  (export char-ready?))
(select-module char-ready-win)

(define (char-ready? :optional (port (current-input-port)))
  (cond
   ((and (input-port? port)
         (or (sys-isatty port)
             (port-attribute-ref port 'windows-console-conversion #f)))
    (let ((hdl (sys-get-std-handle STD_INPUT_HANDLE)))
      (let loop ((irlist (sys-peek-console-input hdl)))
        (if (null? irlist)
          #f
          (let ((ir (car irlist)))
            ;(print (slot-ref ir 'event-type))
            ;(print (slot-ref ir 'key.down))
            ;(print (slot-ref ir 'key.unicode-char))
            ;(print (slot-ref ir 'key.virtual-key-code))
            ;(print (slot-ref ir 'key.control-key-state))
            (cond
             ((and (= (slot-ref ir 'event-type) 1) ; key event
                   (slot-ref ir 'key.down))
              #t)
             (else                                 ; other event (focus, etc.)
              (sys-read-console-input hdl)
              (loop (sys-peek-console-input hdl)))))))))
   (else
    ((with-module scheme char-ready?) port))))