Gauche > Archives > 2024/12/26

MIT-Scheme で
(define (restrict-arity proc nargs)
    (hash-table-set! arity-table proc nargs)
    proc)
と定義されている、restrict-arity を Gauche で定義することを考えています。

(use gauche.generator)

(define (restrict-arity proc n)
  (let ((argument-list (generator->list gensym n)))
    ((eval
      `(lambda (p)
         (lambda ,argument-list
           (p ,@argument-list)))
      (find-module 'gauche))
   proc)))

(define (foo . p) "foo") ; 可変長の手続き
(define bar (restrict-arity foo 3)) ; アリティを制限
(bar 1 2 3) ; これは OK
(bar 1 2 3 4) ; これは NG

$ gosh
gosh$ (define-method initialize (self args) (next-method) (slot-ref self 'foo))
^C^C^C
^Z
[1]+  Stopped                 gosh

$ gosh
gosh$ (define-method initialize (self args) (error "foo"))
^C^C^C^C^C^C^C^CReceived too many signals before processing them.  Exitting for the emergency...

$ gosh
gosh$ (define-method initialize (self args) (slot-ref self 'foo))
^C^C^C^C^C^C^C^C^C^C^C^C^C^C^C^C^C^C^C^C^C^C^C^C^C^C^C^C^C^C^C^C^C^C
^Z
[1]+  Stopped                 gosh

Testing rfc.tls ...                                              gosh(1507,0x70000b52b000) malloc: *** error for object 0x102302080: pointer being freed was not allocated
gosh(1507,0x70000b52b000) malloc: *** set a breakpoint in malloc_error_break to debug