Gauche > Archives > 2025/02/06

(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

gosh> (subtype? <char> (</> <char> <char>))
#t
gosh> (subtype? (</> <char> <char>) <char>)
#f
gosh> (subtype? (</> <integer> <float>) <number>)
#f

gosh> (subtype? <number> <float>)
#<undef>
gosh> (subtype? (</> <integer> <real>) <number>)
#f

<float> のは
-    [(SCM_NATIVE_TYPE_P super) (return FALSE)]
+    [(SCM_NATIVE_TYPE_P super) (return SCM_FALSE)]
かしら

gosh> (slot-set! </> 'subtype? (^[type super] (if (or (is-a? super </>) (is-a? super <class>)) (every (cut subtype? <> super) (~ type'members)) 'super)))
#<undef>
gosh> (subtype? <char> (</> <char> <char>))
#t
gosh> (subtype? (</> <char> <char>) <char>)
#t
gosh> (subtype? (</> <integer> <real>) <number>)
#t
gosh> (subtype? (</> <integer>) <number>)
#t