Changeset 37489 in project


Ignore:
Timestamp:
03/29/19 18:10:29 (12 months ago)
Author:
juergen
Message:
 
File:
1 edited

Legend:

Unmodified
Added
Removed
  • wiki/eggref/5/simple-contracts

    r37485 r37489  
    125125after and before the state change.
    126126
    127 ==== %%
    128 
    129 <procedure>(%% proc)</procedure>
    130 
    131 multi argument version of flip, which can be used in pipe
    132 
    133 ==== pipe
    134 
    135 <macro>(pipe combination ...)</macro>
    136 
    137 sequencing curried combinations from left to right
    138 
    139127=== Requirements
    140128
    141 checks, simple-exceptions
     129checks
    142130
    143131=== Examples
     
    145133<enscript highlight=scheme>
    146134
    147 (import simple-contracts simple-exceptions)
     135(import simple-contracts checks)
    148136
    149137(define-values (counter! counter)
    150138  (let ((state 0))
    151139    (values
    152       (xlambda ((new (pipe (= (add1 old))))
    153                      ;integer? (pipe (= (add1 old))))
    154                      ;integer? (lambda (x) (= x (add1 old))))
     140      (xlambda ((new (cut = <> (add1 old)))
     141                ;integer? (lambda (x) (= x (add1 old))))
    155142                (old integer?)
    156                 <-) ; no arguments
     143                <-)
    157144        (let ((old state))
    158145          (set! state (add1 state))
    159146          (values state old)))
    160       (xlambda ((result (pipe (= state)))
    161                 <-) ; no arguments
     147      (xlambda ((result (cut = <> state))
     148                <-)
    162149        state))))
     150
    163151(counter) ; -> 0
    164152(counter!)
     
    170158  (let ((stk '()))
    171159    (let (
    172       (push
    173         (xlambda ((new list? (pipe (equal? (cons arg old))))
    174                   (old list?)
    175                   <-
    176                   (arg))
    177           (let ((old stk))
    178             (set! stk (cons arg stk))
    179             (values stk old))))
    180       (pop
    181         (xlambda ((new list? (pipe (equal? (cdr old))))
    182                   (old list?)
    183                   <-)
    184           (let ((old (<< stk 'pop (pipe (null?) (not)))))
    185             (set! stk (cdr stk))
    186             (values stk old))))
    187       (top
    188         (xlambda ((result) <-)
    189           (car (<< stk 'top (pipe (null?) (not))))))
    190       )
     160          (push
     161            (xlambda ((new list? (cut equal? <> (cons arg old)))
     162                      (old list?)
     163                      <-
     164                      (arg))
     165              (let ((old stk))
     166                (set! stk (cons arg stk))
     167                (values stk old))))
     168          (pop
     169            (xlambda ((new list? (cut equal? <> (cdr old)))
     170                      (old list?)
     171                      <-)
     172              (let ((old (<<< 'pop stk (o not null?))))
     173                (set! stk (cdr stk))
     174                (values stk old))))
     175          (top
     176            (xlambda ((result) <-)
     177              (car (<<< 'top stk (o not null?)))))
     178          )
    191179      (values push pop top)
    192180      )))
     181
    193182;(top) ; precondition violated
    194183;(pop) ; precondition violated
     
    201190
    202191(define-values (add add-pre add-post)
    203   (xlambda ((result integer? odd? (pipe (= (apply + x y ys))))
     192  (xlambda ((result integer? odd? (cut = <> (apply + x y ys)))
    204193            <-
    205194            (x integer? odd?) (y integer? even?) ys integer? even?)
    206195    (apply + x y ys)))
    207 (add 1 2 4 6) ; -> 13
    208 (condition-case (add 1 2 3) ((exn arguments) #f)) ; -> #f
    209 add-pre ; -> '((x (conjoin integer? odd?))
    210                (y (conjoin integer? even?))
    211                ys (conjoin integer?  even?))
    212 add-post
    213  ; -> '(result (conjoin integer? odd? (pipe (= (apply + x y ys)))))
    214 
    215 (define wrong-add
    216   (xlambda ((result integer? even?)
    217             <-
    218             (x integer? odd?) xs integer?  even?)
    219     (apply + x xs)))
    220 (condition-case (wrong-add 1 2 4) ((exn results) #f)) ; -> #f
    221196
    222197(define-values (divide divide-pre divide-post)
    223198  (xlambda ((q integer?)
    224             (r (pipe (+ (* n q))
    225                      (= m)))
     199            (r (lambda (x) (= (+ x (* n q)) m)))
    226200            <-
    227             (m integer? (pipe (>= 0)))
     201            (m integer? (cut >= <> 0))
    228202            (n integer? positive?))
    229203    (let loop ((q 0) (r m))
     
    231205        (values q r)
    232206        (loop (+ q 1) (- r n))))))
    233   (call-with-values
    234     (lambda () (divide 385 25))
    235     list) ;-> '(15 10)
    236 divide-pre ; -> '((m (conjoin integer? (pipe (>= 0))))
    237                   (n (conjoin integer? positive?)))
    238 divide-post ; -> '((q integer?)
    239                    (r (pipe (+ (* n q)) (= m))))
    240  
    241 
    242 (xdefine ((result integer?) #(sum-post sum sum-pre) (a integer?) as integer?)
     207
     208(xdefine ((result integer?)
     209          #(sum-post sum sum-pre)
     210          (a integer?) as integer?)
    243211  (apply + a as))
    244 (sum 1 2 3) ; -> 6
    245 (condition-case (sum 1 2 #f) ((exn arguments) #f)) ; -> #f
    246 
    247 (xdefine ((result list?) wrong-sum (a integer?) as integer?)
    248   (apply + a as))
    249 (condition-case (wrong-sum 1 2 3) ((exn results) #f)) ; -> #f
    250212
    251213</enscript>
Note: See TracChangeset for help on using the changeset viewer.