Skip to content

Instantly share code, notes, and snippets.

View shirok's full-sized avatar

Shiro Kawai shirok

View GitHub Profile
@shirok
shirok / gist:732333
Created December 7, 2010 20:16
classmethod idea w/mop
(defpackage :clap-metas)
(defclass clap-metas::clap-base--meta (standard-class) ())
(defmethod clos:ensure-class-using-class :around ((class null) name
&rest options
&key metaclass
direct-superclasses
&allow-other-keys)
(when (not metaclass)
cl-user> (defun foo (a j)
(declare (optimize (safety 0) (speed 3))
(type (array (unsigned-byte 8)) a))
(let ((ptr (excl::ll :+ a #.(sys::mdparam 'comp::md-lvector-data0-norm)))
(off (excl::ll :fixnum-to-mi j)))
(declare (fixnum ptr off))
(excl::ll :aset-byte ptr off
(excl::ll :- (excl::ll :aref-ubyte ptr j) (excl::ll :fixnum-to-mi 1)))))
foo
cl-user> (compile 'foo)
(define (ack m n)
(cond ((zero? m) (+ n 1))
((zero? n) (ack (- m 1) 1))
(else (ack (- m 1) (ack m (- n 1))))))
#|
gosh> (time (ack 3 10))
;(time (ack 3 10))
; real 6.488
; user 6.480
;; ストリーミングの受け取り方
;; httpレスポンスに対して呼ばれる。
;; - code : httpステータスコード
;; - headers : レスポンスヘッダ ((name value) ...)
;; - total : レスポンス全体のサイズ。streamingの場合はわからないので#fになってるはず
;; - retrieve : レスポンスボディを受け取るための手続き。後述。
(define (stream-receiver code headers total retrieve)
;; codeをチェック。200以外なら適切な処置を。
(define (tak x y z)
(if (not (< y x))
z
(tak (tak (- x 1) y z)
(tak (- y 1) z x)
(tak (- z 1) x y))))
(define (main args)
(display (tak 24 18 6))
(newline)
(use gauche.sequence) ; for fold2
(define-macro (tagbody . body)
(let ([entry (gensym)] ;implicit label for the entry
[escape (gensym)])
(receive (segments rest)
(fold2 (^(f ss fs)
(if (symbol? f)
(values (cons (reverse `((,f ,escape) ,@fs)) ss) (list f))
(values ss (cons f fs))))
(define (count xs)
(if (or (null? xs)
(null? (cdr xs)))
0
(let ([minimum (apply min xs)])
(cond
[(= minimum (first xs)) (count (cdr xs))]
[(= minimum (last xs)) (+ 1 (count (cdr (reverse xs))))]
[else (let loop ([L '()] [R xs])
(if (= minimum (car R))
diff --git a/ext/net/test.scm b/ext/net/test.scm
index b41a607..478be42 100644
--- a/ext/net/test.scm
+++ b/ext/net/test.scm
@@ -288,29 +288,36 @@
(use gauche.process)
+;; sockargs is an expression that yields to a list of server sockets
(define (run-simple-server sockargs)
gosh> (define-syntax for
(syntax-rules (in do)
((for var in lis do expr ...)
(let loop ((xs lis))
(if (not (null? xs))
(begin (let ((var (car xs))) expr ...)
(loop (cdr xs))))))))
#<undef>
gosh> (for x in '(1 2 3 4 5) do (print (* x x)))
1
--- a/src/number.c
+++ b/src/number.c
@@ -37,6 +37,7 @@
#include "gauche/scmconst.h"
#include "gauche/bits.h"
#include "gauche/builtin-syms.h"
+#include "gauche/arith.h"
#include <limits.h>
#include <float.h>