Ignore:
Timestamp:
09/18/18 15:35:52 (11 months ago)
Author:
juergen
Message:

simple-exceptions added zero args to << and (<<< loc)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • release/5/simple-exceptions/trunk/simple-exceptions.scm

    r36313 r36637  
    121121;;; at location loc
    122122(define (<<< loc)
    123   (lambda (arg . preds)
    124     (if (null? preds)
    125       arg
    126       (let ((arg-name (if (symbol? (car preds)) (car preds) #f))
    127             (preds (if (symbol? (car preds)) (cdr preds) preds)))
    128         (let loop ((preds preds))
    129           (cond
    130             ((null? preds)
    131              arg)
    132             (((car preds) arg)
    133              (loop (cdr preds)))
    134             (else
    135               (if arg-name
    136                 (raise (argument-exception loc arg-name arg (car preds)))
    137                 (raise (argument-exception loc arg (car preds)))))))))))
     123  (case-lambda
     124    (() '())
     125    ((arg . preds)
     126     (if (null? preds)
     127       arg
     128       (let ((arg-name (if (symbol? (car preds)) (car preds) #f))
     129             (preds (if (symbol? (car preds)) (cdr preds) preds)))
     130         (let loop ((preds preds))
     131           (cond
     132             ((null? preds)
     133              arg)
     134             (((car preds) arg)
     135              (loop (cdr preds)))
     136             (else
     137               (if arg-name
     138                 (raise (argument-exception loc arg-name arg (car preds)))
     139                 (raise (argument-exception loc arg (car
     140                                                      preds))))))))))))
    138141
    139142;;; (<< arg [arg-name] arg? ...)
    140143;;; ----------------------------
    141144;;; pass in a checked argument in an and fashion
    142 (define (<< arg . preds)
    143   (apply (<<< '<<) arg preds))
     145;(define (<< arg . preds)
     146;  (apply (<<< '<<) arg preds))
     147(define <<
     148  (case-lambda
     149    (() '())
     150    ((arg . preds)
     151     (apply (<<< '<<) arg preds))))
    144152
    145153;;; (>>> loc)
Note: See TracChangeset for help on using the changeset viewer.