summaryrefslogtreecommitdiff
path: root/src/elf_model/error.lem
diff options
context:
space:
mode:
Diffstat (limited to 'src/elf_model/error.lem')
-rw-r--r--src/elf_model/error.lem86
1 files changed, 86 insertions, 0 deletions
diff --git a/src/elf_model/error.lem b/src/elf_model/error.lem
new file mode 100644
index 00000000..ca34a5d4
--- /dev/null
+++ b/src/elf_model/error.lem
@@ -0,0 +1,86 @@
+open import List
+open import Num
+open import String
+
+open import Show
+
+(** [error] is a type used to represent potentially failing computations. [Success]
+ * marks a successful completion of a computation, whilst [Fail err] marks a failure,
+ * with [err] as the reason.
+ *)
+type error 'a
+ = Success of 'a
+ | Fail of string
+
+(** [return] is the monadic lifting function for [error], representing a successful
+ * computation.
+ *)
+val return : forall 'a. 'a -> error 'a
+let return r = Success r
+
+(** [fail err] represents a failing computation, with error message [err].
+ *)
+val fail : forall 'a. string -> error 'a
+let fail err = Fail err
+
+(** [(>>=)] is the monadic binding function for [error].
+ *)
+val (>>=) : forall 'a 'b. error 'a -> ('a -> error 'b) -> error 'b
+let (>>=) x f =
+ match x with
+ | Success s -> f s
+ | Fail err -> Fail err
+ end
+
+(** [repeatM count action] fails if [action] is a failing computation, or
+ * successfully produces a list [count] elements long, where each element is
+ * the value successfully returned by [action].
+ *)
+val repeatM : forall 'a. nat -> error 'a -> error (list 'a)
+let rec repeatM count action =
+ match count with
+ | 0 -> return []
+ | m ->
+ action >>= fun head ->
+ repeatM (m - 1) action >>= fun tail ->
+ return (head::tail)
+ end
+
+(** [repeatM' count seed action] is a variant of [repeatM] that acts like [repeatM]
+ * apart from any successful result returns a tuple whose second component is [seed]
+ * and whose first component is the same as would be returned by [repeatM].
+ *)
+val repeatM' : forall 'a 'b. nat -> 'b -> ('b -> error ('a * 'b)) -> error ((list 'a) * 'b)
+let rec repeatM' count seed action =
+ match count with
+ | 0 -> return ([], seed)
+ | m ->
+ action seed >>= fun (head, seed) ->
+ repeatM' (m - 1) seed action >>= fun (tail, seed) ->
+ return (head::tail, seed)
+ end
+
+(** [mapM f xs] maps [f] across [xs], failing if [f] fails on any element of [xs].
+ *)
+val mapM : forall 'a 'b. ('a -> error 'b) -> list 'a -> error (list 'b)
+let rec mapM f xs =
+ match xs with
+ | [] -> return []
+ | x::xs ->
+ f x >>= fun hd ->
+ mapM f xs >>= fun tl ->
+ return (hd::tl)
+ end
+
+(** [string_of_error err] produces a string representation of [err].
+ *)
+val string_of_error : forall 'a. Show 'a => error 'a -> string
+let string_of_error e =
+ match e with
+ | Fail err -> "Fail: " ^ err
+ | Success s -> show s
+ end
+
+instance forall 'a. Show 'a => (Show (error 'a))
+ let show = string_of_error
+end \ No newline at end of file