Changeset 37489 in project
 Timestamp:
 03/29/19 18:10:29 (14 months ago)
 File:

 1 edited
Legend:
 Unmodified
 Added
 Removed

wiki/eggref/5/simplecontracts
r37485 r37489 125 125 after and before the state change. 126 126 127 ==== %%128 129 <procedure>(%% proc)</procedure>130 131 multi argument version of flip, which can be used in pipe132 133 ==== pipe134 135 <macro>(pipe combination ...)</macro>136 137 sequencing curried combinations from left to right138 139 127 === Requirements 140 128 141 checks , simpleexceptions129 checks 142 130 143 131 === Examples … … 145 133 <enscript highlight=scheme> 146 134 147 (import simplecontracts simpleexceptions)135 (import simplecontracts checks) 148 136 149 137 (definevalues (counter! counter) 150 138 (let ((state 0)) 151 139 (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)))) 155 142 (old integer?) 156 <) ; no arguments143 <) 157 144 (let ((old state)) 158 145 (set! state (add1 state)) 159 146 (values state old))) 160 (xlambda ((result ( pipe (= state)))161 <) ; no arguments147 (xlambda ((result (cut = <> state)) 148 <) 162 149 state)))) 150 163 151 (counter) ; > 0 164 152 (counter!) … … 170 158 (let ((stk '())) 171 159 (let ( 172 (push173 (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 (pop181 (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 (top188 (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 ) 191 179 (values push pop top) 192 180 ))) 181 193 182 ;(top) ; precondition violated 194 183 ;(pop) ; precondition violated … … 201 190 202 191 (definevalues (add addpre addpost) 203 (xlambda ((result integer? odd? ( pipe (= (apply + x y ys))))192 (xlambda ((result integer? odd? (cut = <> (apply + x y ys))) 204 193 < 205 194 (x integer? odd?) (y integer? even?) ys integer? even?) 206 195 (apply + x y ys))) 207 (add 1 2 4 6) ; > 13208 (conditioncase (add 1 2 3) ((exn arguments) #f)) ; > #f209 addpre ; > '((x (conjoin integer? odd?))210 (y (conjoin integer? even?))211 ys (conjoin integer? even?))212 addpost213 ; > '(result (conjoin integer? odd? (pipe (= (apply + x y ys)))))214 215 (define wrongadd216 (xlambda ((result integer? even?)217 <218 (x integer? odd?) xs integer? even?)219 (apply + x xs)))220 (conditioncase (wrongadd 1 2 4) ((exn results) #f)) ; > #f221 196 222 197 (definevalues (divide dividepre dividepost) 223 198 (xlambda ((q integer?) 224 (r (pipe (+ (* n q)) 225 (= m))) 199 (r (lambda (x) (= (+ x (* n q)) m))) 226 200 < 227 (m integer? ( pipe (>= 0)))201 (m integer? (cut >= <> 0)) 228 202 (n integer? positive?)) 229 203 (let loop ((q 0) (r m)) … … 231 205 (values q r) 232 206 (loop (+ q 1) ( r n)))))) 233 (callwithvalues 234 (lambda () (divide 385 25)) 235 list) ;> '(15 10) 236 dividepre ; > '((m (conjoin integer? (pipe (>= 0)))) 237 (n (conjoin integer? positive?))) 238 dividepost ; > '((q integer?) 239 (r (pipe (+ (* n q)) (= m)))) 240 241 242 (xdefine ((result integer?) #(sumpost sum sumpre) (a integer?) as integer?) 207 208 (xdefine ((result integer?) 209 #(sumpost sum sumpre) 210 (a integer?) as integer?) 243 211 (apply + a as)) 244 (sum 1 2 3) ; > 6245 (conditioncase (sum 1 2 #f) ((exn arguments) #f)) ; > #f246 247 (xdefine ((result list?) wrongsum (a integer?) as integer?)248 (apply + a as))249 (conditioncase (wrongsum 1 2 3) ((exn results) #f)) ; > #f250 212 251 213 </enscript>
Note: See TracChangeset
for help on using the changeset viewer.