44 lines
1.7 KiB
Plaintext
44 lines
1.7 KiB
Plaintext
!import "base" !Local
|
|
!import "list" !Local
|
|
!import "contracts" !Local
|
|
|
|
-- A custom 'and' combinator written directly against base.matchResult.
|
|
-- It succeeds only when *both* contracts succeed, threading the checked value
|
|
-- from the first into the second. This makes the Result pair structure explicit.
|
|
myAndC = (c1 c2 value rest :
|
|
matchResult
|
|
(msg _ : contractErr msg rest)
|
|
(v _ : c2 v rest)
|
|
(c1 value rest))
|
|
|
|
-- Plain predicates lifted into contracts with a diagnostic message.
|
|
natural? = guardC "natural" (n : gte? n 0)
|
|
nonZero? = guardC "non-zero" (n : not? (isZero? n))
|
|
|
|
-- Safe wrappers around partial base / list functions.
|
|
-- The frontend desugars @ and =@ into runtime withContract applications.
|
|
safeDiv a@natural? b@(myAndC natural? nonZero?) =@natural? div a b
|
|
|
|
safeHead xs@(nonEmptyListOf anyC) =@anyC head xs
|
|
safeTail xs@(nonEmptyListOf anyC) =@(listOf anyC) tail xs
|
|
|
|
-- A higher-order wrapper: the supplied function must satisfy a contract,
|
|
-- the input list must satisfy a contract, and the result list is guaranteed.
|
|
checkedMap f@(fnContract anyC natural?) xs@(listOf anyC) =@(listOf natural?) map f xs
|
|
|
|
-- Advertise the safe wrappers in the module manifest with their own contracts.
|
|
!export safeDiv : fn2 natural? nonZero? natural?
|
|
!export safeHead : fnContract (nonEmptyListOf anyC) anyC
|
|
!export checkedMap : fn2 (fnContract anyC natural?) (listOf anyC) (listOf natural?)
|
|
|
|
-- A small interaction-tree pipeline that uses contracts as recoverable effects.
|
|
pipeline = (input :
|
|
do bindM
|
|
scaled <- checkM natural? (mul input 2)
|
|
half <- handleM "contract"
|
|
(_ : pureM 1)
|
|
(checkM nonZero? (sub scaled 4))
|
|
pureM (div scaled half))
|
|
|
|
main = runM (pipeline 5)
|