Changeset 29501 in project


Ignore:
Timestamp:
08/04/13 16:27:39 (7 years ago)
Author:
juergen
Message:

bind/cc moved to list-bindings, bind? renamed bindable?

Location:
release/4/bindings
Files:
8 edited
1 copied

Legend:

Unmodified
Added
Removed
  • release/4/bindings/tags/2.2/bindings.meta

    r29277 r29501  
    44 (category lang-exts)
    55 (license "BSD")
    6  (test-depends tuples simple-tests)
     6 (test-depends tuples)
    77 (author "Juergen Lorenz")
    88 (files "bindings.setup" "bindings.release-info" "bindings.meta" "bindings.scm" "tests/run.scm"))
  • release/4/bindings/tags/2.2/bindings.scm

    r29277 r29501  
    3131; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
    3232; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
    33 ;
    34 ; Last update: Jun 28, 2013
    3533;
    3634;Binding pattern variables to subsequences
     
    10199(module bindings
    102100    (bindings (bind generic-car generic-cdr generic-null?)
    103               bind? bind-case bind/cc ;bind-matches?
     101              bindable? bind-case
    104102              bind-let bind-let* bind-letrec
    105103              bindrec bind-lambda bind-lambda* bind* bind-set!
     
    223221;considered part of the matching process. Example:
    224222;
    225 ;((bind? (a b) (where (even? a)) (a b)) '#(1 2)) -> #t
    226 ;
    227 ;;; (bind? pat (where . fenders) .. ....)
     223;((bindable? (a b) (where (even? a)) (a b)) '#(1 2)) -> #t
     224;
     225;;; (bindable? pat (where . fenders) .. ....)
    228226;;; -------------------------------------
    229 (define-syntax bind?
     227(define-syntax bindable?
    230228  (syntax-rules (where)
    231229    ((_)
     
    243241    ((_ pat (where . fenders) . clauses)
    244242     (lambda (form)
    245        (or ((bind? pat (where . fenders)) form)
    246            ((bind? . clauses) form))))
     243       (or ((bindable? pat (where . fenders)) form)
     244           ((bindable? . clauses) form))))
    247245    ((_ pat . clauses)
    248246     (lambda (form)
    249        (or ((bind? pat) form)
    250            ((bind? . clauses) form))))))
     247       (or ((bindable? pat) form)
     248           ((bindable? . clauses) form))))))
    251249
    252250;The following macro does more or less the same as the match macro from
     
    597595       (define sym1 'sym1)
    598596       ...))))
    599 
    600 ;;; (bind/cc k xpr . xprs)
    601 ;;; ----------------------
    602 (define-syntax bind/cc
    603   (syntax-rules ()
    604     ((_ k xpr . xprs)
    605      (call-with-current-continuation
    606        (lambda (k) xpr . xprs)))))
    607597
    608598;Now to the generic functions
     
    708698    "destructures seq according to pat and defines pattern variables
    709699with values corresponding to subexpressions of seq")
    710       (bind?
     700      (bindable?
    711701        "returns a predicate, which checks if its argument matches
    712 one of the pattern arguments of bind?"
    713         (bind? pat (where . fenders) .. ....))
     702one of the pattern arguments of bindable?"
     703        (bindable? pat (where . fenders) .. ....))
    714704      (bind-case
    715705        "a variant of matchable's match macro."
     
    760750        "recursive version of bind"
    761751        (bindrec pat seq . body)
    762       (bind/cc
    763         "package call/cc in a binding construct"
    764         (bind/cc k xpr . xprs)
    765         "captures current continuation as a unary escape procedure and
    766         evalute xpr . xprs in this context, possibly calling k")
    767752"like bind, but seq can contain references to pattern variables in pat")
    768753      (generic-null-car-cdr!
  • release/4/bindings/tags/2.2/bindings.setup

    r29277 r29501  
    77 'bindings
    88 '("bindings.so" "bindings.import.so")
    9  '((version "2.1")))
     9 '((version "2.2")))
    1010
  • release/4/bindings/tags/2.2/tests/run.scm

    r29277 r29501  
    88;;;;       Jun 28, 2013
    99
    10 (require-library bindings tuples simple-tests)
    11 
    12 (import bindings tuples simple-tests)
     10(require-library bindings tuples)
     11
     12(import bindings tuples)
     13
     14;;; (run-tests xpr0 xpr1 ...)
     15;;; -------------------------
     16;;; evaluates each expression xpr0 xpr1 ... and reports it as failed, if
     17;;; it evaluates to #f, and as passed otherwise
     18(define-syntax run-tests
     19  (syntax-rules ()
     20    ((_  xpr ...)
     21     (begin
     22         (display "\nTesting ...\n")
     23         (display "-----------\n")
     24         (let ((n (simple-tests-run (list 'xpr ...))))
     25           (display "-----------\n")
     26           (if (zero?  n)
     27             (display "All tests passed\n\n")
     28             (begin
     29               (display n)
     30               (display " test(s) failed!!!\n\n"))))))))
     31(define (simple-tests-run lst)
     32  (let loop ((lst lst) (n 0))
     33    (if (null? lst)
     34      n
     35      (if (eval (car lst))
     36        (begin
     37          (display "passed ... ")
     38          (write (car lst))
     39          (newline)
     40          (loop (cdr lst) n))
     41        (begin
     42          (display "FAILED !!! ")
     43          (write (car lst))
     44          (newline)
     45          (loop (cdr lst) (+ n 1)))))))
    1346
    1447(run-tests
     
    151184      (my-map add1 '(1 2 3)))
    152185    '(2 3 4))
    153   ((bind? (a b) (where (odd? a))) '(1 2))
    154   ((bind? (a b) (where (even? a)) (a b)) '#(1 2))
    155   ((bind? (a b)) '(1 2))
    156   (not ((bind? (x)) '(name 1)))
    157   (not ((bind? (x y) (where (number? x))) '(name 1)))
    158   ((bind? (_ x)) '(name 1))
    159   (not ((bind? (_ x)) '(name 1 2)))
    160   ((bind? (_) (_ x y) (where (boolean? x)) (_ x y)) '(name 1 2))
     186  ((bindable? (a b) (where (odd? a))) '(1 2))
     187  ((bindable? (a b) (where (even? a)) (a b)) '#(1 2))
     188  ((bindable? (a b)) '(1 2))
     189  (not ((bindable? (x)) '(name 1)))
     190  (not ((bindable? (x y) (where (number? x))) '(name 1)))
     191  ((bindable? (_ x)) '(name 1))
     192  (not ((bindable? (_ x)) '(name 1 2)))
     193  ((bindable? (_) (_ x y) (where (boolean? x)) (_ x y)) '(name 1 2))
    161194  (equal?
    162195    ((bind-lambda (a (b . C) . d)
  • release/4/bindings/trunk/bindings.meta

    r29277 r29501  
    44 (category lang-exts)
    55 (license "BSD")
    6  (test-depends tuples simple-tests)
     6 (test-depends tuples)
    77 (author "Juergen Lorenz")
    88 (files "bindings.setup" "bindings.release-info" "bindings.meta" "bindings.scm" "tests/run.scm"))
  • release/4/bindings/trunk/bindings.scm

    r29277 r29501  
    3131; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
    3232; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
    33 ;
    34 ; Last update: Jun 28, 2013
    3533;
    3634;Binding pattern variables to subsequences
     
    10199(module bindings
    102100    (bindings (bind generic-car generic-cdr generic-null?)
    103               bind? bind-case bind/cc ;bind-matches?
     101              bindable? bind-case
    104102              bind-let bind-let* bind-letrec
    105103              bindrec bind-lambda bind-lambda* bind* bind-set!
     
    223221;considered part of the matching process. Example:
    224222;
    225 ;((bind? (a b) (where (even? a)) (a b)) '#(1 2)) -> #t
    226 ;
    227 ;;; (bind? pat (where . fenders) .. ....)
     223;((bindable? (a b) (where (even? a)) (a b)) '#(1 2)) -> #t
     224;
     225;;; (bindable? pat (where . fenders) .. ....)
    228226;;; -------------------------------------
    229 (define-syntax bind?
     227(define-syntax bindable?
    230228  (syntax-rules (where)
    231229    ((_)
     
    243241    ((_ pat (where . fenders) . clauses)
    244242     (lambda (form)
    245        (or ((bind? pat (where . fenders)) form)
    246            ((bind? . clauses) form))))
     243       (or ((bindable? pat (where . fenders)) form)
     244           ((bindable? . clauses) form))))
    247245    ((_ pat . clauses)
    248246     (lambda (form)
    249        (or ((bind? pat) form)
    250            ((bind? . clauses) form))))))
     247       (or ((bindable? pat) form)
     248           ((bindable? . clauses) form))))))
    251249
    252250;The following macro does more or less the same as the match macro from
     
    597595       (define sym1 'sym1)
    598596       ...))))
    599 
    600 ;;; (bind/cc k xpr . xprs)
    601 ;;; ----------------------
    602 (define-syntax bind/cc
    603   (syntax-rules ()
    604     ((_ k xpr . xprs)
    605      (call-with-current-continuation
    606        (lambda (k) xpr . xprs)))))
    607597
    608598;Now to the generic functions
     
    708698    "destructures seq according to pat and defines pattern variables
    709699with values corresponding to subexpressions of seq")
    710       (bind?
     700      (bindable?
    711701        "returns a predicate, which checks if its argument matches
    712 one of the pattern arguments of bind?"
    713         (bind? pat (where . fenders) .. ....))
     702one of the pattern arguments of bindable?"
     703        (bindable? pat (where . fenders) .. ....))
    714704      (bind-case
    715705        "a variant of matchable's match macro."
     
    760750        "recursive version of bind"
    761751        (bindrec pat seq . body)
    762       (bind/cc
    763         "package call/cc in a binding construct"
    764         (bind/cc k xpr . xprs)
    765         "captures current continuation as a unary escape procedure and
    766         evalute xpr . xprs in this context, possibly calling k")
    767752"like bind, but seq can contain references to pattern variables in pat")
    768753      (generic-null-car-cdr!
  • release/4/bindings/trunk/bindings.setup

    r29277 r29501  
    77 'bindings
    88 '("bindings.so" "bindings.import.so")
    9  '((version "2.1")))
     9 '((version "2.2")))
    1010
  • release/4/bindings/trunk/tests/run.scm

    r29277 r29501  
    88;;;;       Jun 28, 2013
    99
    10 (require-library bindings tuples simple-tests)
    11 
    12 (import bindings tuples simple-tests)
     10(require-library bindings tuples)
     11
     12(import bindings tuples)
     13
     14;;; (run-tests xpr0 xpr1 ...)
     15;;; -------------------------
     16;;; evaluates each expression xpr0 xpr1 ... and reports it as failed, if
     17;;; it evaluates to #f, and as passed otherwise
     18(define-syntax run-tests
     19  (syntax-rules ()
     20    ((_  xpr ...)
     21     (begin
     22         (display "\nTesting ...\n")
     23         (display "-----------\n")
     24         (let ((n (simple-tests-run (list 'xpr ...))))
     25           (display "-----------\n")
     26           (if (zero?  n)
     27             (display "All tests passed\n\n")
     28             (begin
     29               (display n)
     30               (display " test(s) failed!!!\n\n"))))))))
     31(define (simple-tests-run lst)
     32  (let loop ((lst lst) (n 0))
     33    (if (null? lst)
     34      n
     35      (if (eval (car lst))
     36        (begin
     37          (display "passed ... ")
     38          (write (car lst))
     39          (newline)
     40          (loop (cdr lst) n))
     41        (begin
     42          (display "FAILED !!! ")
     43          (write (car lst))
     44          (newline)
     45          (loop (cdr lst) (+ n 1)))))))
    1346
    1447(run-tests
     
    151184      (my-map add1 '(1 2 3)))
    152185    '(2 3 4))
    153   ((bind? (a b) (where (odd? a))) '(1 2))
    154   ((bind? (a b) (where (even? a)) (a b)) '#(1 2))
    155   ((bind? (a b)) '(1 2))
    156   (not ((bind? (x)) '(name 1)))
    157   (not ((bind? (x y) (where (number? x))) '(name 1)))
    158   ((bind? (_ x)) '(name 1))
    159   (not ((bind? (_ x)) '(name 1 2)))
    160   ((bind? (_) (_ x y) (where (boolean? x)) (_ x y)) '(name 1 2))
     186  ((bindable? (a b) (where (odd? a))) '(1 2))
     187  ((bindable? (a b) (where (even? a)) (a b)) '#(1 2))
     188  ((bindable? (a b)) '(1 2))
     189  (not ((bindable? (x)) '(name 1)))
     190  (not ((bindable? (x y) (where (number? x))) '(name 1)))
     191  ((bindable? (_ x)) '(name 1))
     192  (not ((bindable? (_ x)) '(name 1 2)))
     193  ((bindable? (_) (_ x y) (where (boolean? x)) (_ x y)) '(name 1 2))
    161194  (equal?
    162195    ((bind-lambda (a (b . C) . d)
Note: See TracChangeset for help on using the changeset viewer.