-
Notifications
You must be signed in to change notification settings - Fork 9
/
failure.ss
37 lines (30 loc) · 1.04 KB
/
failure.ss
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
;;; Reified failures.
;; TODO: rename this file result? Split into failure and result ?
(export (rename: failure_ failure) failure? Failure Failure?
result? call/result with-result run-result)
(import
:std/error
:std/sugar
./source
./option)
(defclass (Failure Exception) (error) transparent: #t)
(def failure? Failure?)
(def (failure e) (Failure error: e))
(defsyntax-for-match failure_
(syntax-rules () ((_ e) (Failure error: e)) ((_) (Failure)) )
(syntax-rules () ((_ e) (Failure error: e))
((ctx . a) (syntax-error "failure takes one argument" (ctx . a)))
(_ failure)))
;; A Result is (some x) or (failure e)
;; (deftype (Result V E) (Or (Some V) (Failure E)))
;; : Bool <- Any
(def (result? x) (or (some? x) (failure? x)))
;; : (Result A Err) <- (A <- Unit)
(def (call/result thunk)
(with-catch failure (cut some (thunk))))
(defrule (with-result body ...) (call/result (lambda () body ...)))
(def (run-result r)
(match r
((some r) r)
((failure_ f) (raise f))
(#f (raise (failure #f)))))