<HTML><BODY>Thank you very much! This is it. Sun, 29 Jun 2014 20:39:33 -0500 от Robby Findler <robby@eecs.northwestern.edu>: <blockquote style="margin: 10px; padding: 0px 0px 0px 10px; border-left-color: rgb(8, 87, 166); border-left-width: 1px; border-left-style: solid;"> <div> <div class="js-helper js-readmsg-msg"> <style type="text/css"></style> <div> <base href="https://e.mail.ru/" target="_self"> <div id="style_14040923770000000974_BODY">Yes, I believe this is what you want: #lang racket (define (chaperone-f f) (chaperone-procedure f (λ (fst . more) (printf "fst arg: ~s\n" fst) (apply values fst more)))) ((chaperone-f (λ (x y) x)) 1 2) ((chaperone-f (λ (x y z) x)) 1 2 3) ((chaperone-f (λ (x y z w) x)) 1 2 3 4) On Sun, Jun 29, 2014 at 8:10 PM, Roman Klochkov <<a href="/compose?To=kalimehtar@mail.ru">kalimehtar@mail.ru</a>> wrote: > I reformulate my problem: > I need to make a chaperone, that checks only type of first arg. Is it > possible? > > If yes, I'll sumply make something like > (define (arity>=/c x) > (λ (proc) > (define arity (normalize-arity (procedure-arity proc))) > (define max-arity > (if (list? arity) (car (reverse arity)) arity)) > (or (arity-at-least? max-arity) > (>= max-arity x)))) > > (and/c (arity>=/c 2) > (check-first-arg input-port?)) > > > Sun, 29 Jun 2014 13:08:06 -0400 от "Alexander D. Knauth" > <<a href="/compose?To=alexander@knauth.org">alexander@knauth.org</a>>: > > You can use or/c to do this, as long as you guard them like this so that no > more than one contract matches at a time: > (or/c > (and/c (procedure-has-arity/c 2) (-> input-port? any/c any)) > (and/c (procedure-has-arity/c 3) (-> input-port? any/c any/c any)) > (and/c (procedure-has-arity/c 4) (-> input-port? any/c any/c any/c any)) > (->* (input-port? any/c) #:rest list? any) > ) > > Or, you could use if/c from unstable/contract, or define a cond/c macro like > this: > (require unstable/contract) > (define-syntax cond/c > (syntax-rules (else) > [(cond/c) none/c] > [(cond/c [else else-c]) > else-c] > [(cond/c [pred then-c] clause ...) > (if/c pred > then-c > (cond/c clause ...))])) > > (cond/c [(procedure-has-arity/c 2) (-> input-port? any/c any)] > [(procedure-has-arity/c 3) (-> input-port? any/c any/c any)] > [(procedure-has-arity/c 4) (-> input-port? any/c any/c any/c any)] > [else (->* (input-port? any/c) #:rest list? any)]) > > By the way it has to be procedure-has-arity/c, not > procedure-includes-arity/c: > (define (procedure-has-arity/c arity) > (define normalized-arity (normalize-arity arity)) > (flat-named-contract > `(procedure-has-arity/c ,normalized-arity) > (λ (f) > (and (procedure? f) > (arity=? (procedure-arity f) normalized-arity))))) > > On Jun 29, 2014, at 8:00 AM, Roman Klochkov <<a href="/compose?To=kalimehtar@mail.ru">kalimehtar@mail.ru</a>> wrote: > > How to make a contract, that accepts > (-> input-port? any/c any) > (-> input-port? any/c any/c any) > (-> input-port? any/c any/c any/c any) > ... > and > (->* (input-port? any/c) #:rest list? any) > > > So theare should be at least two args and first arg should be input-port. > > -- > Roman Klochkov > > ____________________ > Racket Users list: > <a href="http://lists.racket-lang.org/users" target="_blank">http://lists.racket-lang.org/users</a> > > > > > -- > Roman Klochkov > > ____________________ > Racket Users list: > <a href="http://lists.racket-lang.org/users" target="_blank">http://lists.racket-lang.org/users</a> > </div> <base href="https://e.mail.ru/" target="_self"> </div> </div> </div> </blockquote> -- Roman Klochkov </BODY></HTML>