[REBOL] Design by contract
From: dankelg8:cs:man:ac at: 7-Feb-2001 14:13
Here's a Design By Contract script that I hacked together yesterday.
For those who don't know, Design By Contract is a software pattern used to
enforce preconditions and postconditions of a function.
For example, in Rebol there's no way currently to define your own types.
A function that does vector multiplication can look like this:
vector-mul: func [v1 [block!] v2 [block!]] [...]
The problem here is that a block can contain anything.
DBC offers a solution to this:
vector-mul: cfunc [v1 [block!] v2 [block!]] [
<preconditions>
][
<function body>
][
<postconditions>
]
Here's what it could look like:
vector-mul: cfunc [a [block!] b [block!]] [
(length? a) = (length? b)
fold func [x y] [(number? x) and y] true a
fold func [x y] [(number? x) and y] true b
][
<function body>
][
(length? cres) = (length? a)
]
fold checks if all the elements of the block are numbers.
cres is the result of evaluating the function body.
If either the pre- or postcondition fails, an error will be thrown.
>> vector-mul [1 2 none 4] [3 4 5 6]
** User Error: Precondition violated!
** Near: vector-mul [1 2 none 4] [3 4 5 6]
Fold above is defined like:
fold: func [
combine [any-function!]
init [any-type!]
series [series!]
/local res
][
res: init
foreach element series [res: combine element res]
res
]
Preconditions and postconditions can be turned off such that cfunc will
return a normal func.
So if speed is critical, the tests can be done while debugging.
Anyway, here's the code.
Hopefully someone of you have got a better version or have ideas of how to
make it better.
There are a few problems with this one, e.g. cres is in the global context
Usage:
contract/enforce
my-func: cfunc .... as above
REBOL [
Title: "Design by contract"
Date: 6-feb-2001
Example: [
my-squareroot: cfunc [
x [number!]
][
x >= 0
][
square-root x
][
(cres * cres) = x
]
]
]
contract: make object! [
pre-check: post-check: false
enforce: does [pre-check: post-check: true]
set 'cfunc func [
arguments [block!]
pre-conditions [block!]
body [block!]
post-conditions [block!]
/local new-body new-args
][
if pre-check [
insert body compose/deep [if not all
[(pre-conditions)] [throw make error! "Precondition violated!"]]
]
if post-check [
body: compose/deep [cres: do [(body)]]
append body compose/deep [
if not all [(post-conditions)] [throw make
error! "Postcondition violated!"]
return cres
]
]
if all [any [pre-check post-check] not find/only arguments
[catch]] [insert/only arguments [catch]]
func arguments body
]
]
