Changeset 35307 in project


Ignore:
Timestamp:
03/17/18 18:10:13 (9 months ago)
Author:
juergen
Message:

simple-cells 1.3 with cell-of

Location:
release/4/simple-cells
Files:
6 edited
1 copied

Legend:

Unmodified
Added
Removed
  • release/4/simple-cells/tags/1.3/simple-cells.scm

    r33851 r35307  
    4747(require-library simple-exceptions)
    4848
    49 (module simple-cells *
    50 (import scheme
    51         (only simple-exceptions <<< named-lambda)
    52         (only chicken define-values gensym case-lambda
    53               error print condition-case))
     49(module simple-cells (simple-cells cell cell? cell-of?)
     50  (import scheme
     51          (only simple-exceptions <<<)
     52          (only chicken define-values gensym case-lambda
     53                error print condition-case))
    5454
    5555;;; (cell var . tests)
     
    6565          (set! state (apply (<<< 'cell) var 'state checks))
    6666          (case-lambda
    67             (() (values state checks))
     67            (() state);(values state checks))
    6868            ((arg)
    6969             (let ((old state))
     
    8282               (xpr old) ; restore state
    8383               result?))))))
     84
     85;;; ((cell-of? ok?) xpr)
     86;;; --------------------
     87;;; evaluates xpr to a cell passing the ok? check?
     88(define ((cell-of? ok?) xpr)
     89  (and (cell? xpr)
     90       (ok? (xpr))))
    8491
    8592;;; (simple-cells sym ..)
     
    106113      (cell? xpr)
    107114      "type predicate.")
     115    (cell-of?
     116      procedure:
     117      (cell-of? ok?)
     118      "returns a predicate, which checks, if its argument"
     119      "is passed by the ok? check")
    108120    )))
    109121    (case-lambda
  • release/4/simple-cells/tags/1.3/simple-cells.setup

    r33860 r35307  
    77 'simple-cells
    88 '("simple-cells.so" "simple-cells.import.so")
    9  '((version "1.2.1")))
     9 '((version "1.3")))
    1010
    1111
  • release/4/simple-cells/tags/1.3/tests/run.scm

    r33851 r35307  
    22  (only data-structures list-of?))
    33
    4 (define-test (cells?)
     4(define-test (Cells?)
    55  (check
    6     (define o% (cell 5 number? odd?))
     6    (define o% (cell 5 integer? odd?))
    77    (cell? o%)
     8    ((cell-of? number?) o%)
     9    (not ((cell-of? even?) o%))
    810    (not (condition-case (o% 4) ((exn argument) #f)))
    911    (= (o%) 5)
    1012    (define n% (cell 4 (named-lambda 3<=? (x) (<= 3 x))))
    1113    (= (n%) 4)
    12     ((list-of? procedure?) (receive (val checks) (n%) checks))
     14    ;((list-of? procedure?)
     15    ; (call-with-values n% (lambda (state checks) checks)))
    1316    (= (n% 20) 4)
    1417    (= (n%) 20)
    1518    (= (o%) 5)
    16     ((list-of? procedure?) (receive (val checks) (o%) checks))
     19    ;((list-of? procedure?)
     20    ; (call-with-values o% (lambda (state checks) checks)))
    1721    (define lst (map cell '(0 1 2 3 4)))
    1822    (= ((list-ref lst 3)) 3)
     
    2327
    2428(compound-test (SIMPLE-CELLS)
    25   (cells?)
     29  (Cells?)
    2630  )
    2731
  • release/4/simple-cells/trunk/simple-cells.scm

    r33851 r35307  
    4747(require-library simple-exceptions)
    4848
    49 (module simple-cells *
    50 (import scheme
    51         (only simple-exceptions <<< named-lambda)
    52         (only chicken define-values gensym case-lambda
    53               error print condition-case))
     49(module simple-cells (simple-cells cell cell? cell-of?)
     50  (import scheme
     51          (only simple-exceptions <<<)
     52          (only chicken define-values gensym case-lambda
     53                error print condition-case))
    5454
    5555;;; (cell var . tests)
     
    6565          (set! state (apply (<<< 'cell) var 'state checks))
    6666          (case-lambda
    67             (() (values state checks))
     67            (() state);(values state checks))
    6868            ((arg)
    6969             (let ((old state))
     
    8282               (xpr old) ; restore state
    8383               result?))))))
     84
     85;;; ((cell-of? ok?) xpr)
     86;;; --------------------
     87;;; evaluates xpr to a cell passing the ok? check?
     88(define ((cell-of? ok?) xpr)
     89  (and (cell? xpr)
     90       (ok? (xpr))))
    8491
    8592;;; (simple-cells sym ..)
     
    106113      (cell? xpr)
    107114      "type predicate.")
     115    (cell-of?
     116      procedure:
     117      (cell-of? ok?)
     118      "returns a predicate, which checks, if its argument"
     119      "is passed by the ok? check")
    108120    )))
    109121    (case-lambda
  • release/4/simple-cells/trunk/simple-cells.setup

    r33860 r35307  
    77 'simple-cells
    88 '("simple-cells.so" "simple-cells.import.so")
    9  '((version "1.2.1")))
     9 '((version "1.3")))
    1010
    1111
  • release/4/simple-cells/trunk/tests/run.scm

    r33851 r35307  
    22  (only data-structures list-of?))
    33
    4 (define-test (cells?)
     4(define-test (Cells?)
    55  (check
    6     (define o% (cell 5 number? odd?))
     6    (define o% (cell 5 integer? odd?))
    77    (cell? o%)
     8    ((cell-of? number?) o%)
     9    (not ((cell-of? even?) o%))
    810    (not (condition-case (o% 4) ((exn argument) #f)))
    911    (= (o%) 5)
    1012    (define n% (cell 4 (named-lambda 3<=? (x) (<= 3 x))))
    1113    (= (n%) 4)
    12     ((list-of? procedure?) (receive (val checks) (n%) checks))
     14    ;((list-of? procedure?)
     15    ; (call-with-values n% (lambda (state checks) checks)))
    1316    (= (n% 20) 4)
    1417    (= (n%) 20)
    1518    (= (o%) 5)
    16     ((list-of? procedure?) (receive (val checks) (o%) checks))
     19    ;((list-of? procedure?)
     20    ; (call-with-values o% (lambda (state checks) checks)))
    1721    (define lst (map cell '(0 1 2 3 4)))
    1822    (= ((list-ref lst 3)) 3)
     
    2327
    2428(compound-test (SIMPLE-CELLS)
    25   (cells?)
     29  (Cells?)
    2630  )
    2731
Note: See TracChangeset for help on using the changeset viewer.