Changeset 36637 in project


Ignore:
Timestamp:
09/18/18 15:35:52 (4 weeks ago)
Author:
juergen
Message:

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

Location:
release/5/simple-exceptions
Files:
6 edited
1 copied

Legend:

Unmodified
Added
Removed
  • release/5/simple-exceptions/tags/1.1/simple-exceptions.egg

    r36313 r36637  
    44 (test-dependencies simple-tests)
    55 (author "Juergen Lorenz")
    6  (version "1.0")
     6 (version "1.1")
    77 (components (extension simple-exceptions)))
  • release/5/simple-exceptions/tags/1.1/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)
  • release/5/simple-exceptions/tags/1.1/tests/run.scm

    r36313 r36637  
    2525     120)
    2626  "CHECKS"
     27  (null? (<<))
    2728  (= (>> 5) 5)
    2829  (= (<< 5) 5)
  • release/5/simple-exceptions/trunk/simple-exceptions.egg

    r36313 r36637  
    44 (test-dependencies simple-tests)
    55 (author "Juergen Lorenz")
    6  (version "1.0")
     6 (version "1.1")
    77 (components (extension simple-exceptions)))
  • 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)
  • release/5/simple-exceptions/trunk/tests/run.scm

    r36313 r36637  
    2525     120)
    2626  "CHECKS"
     27  (null? (<<))
    2728  (= (>> 5) 5)
    2829  (= (<< 5) 5)
Note: See TracChangeset for help on using the changeset viewer.