summaryrefslogtreecommitdiff
path: root/lib/ocaml_rts/linksem/error.ml
diff options
context:
space:
mode:
authorAlasdair Armstrong2017-09-07 16:54:20 +0100
committerAlasdair Armstrong2017-09-07 16:54:20 +0100
commit842165c1171fde332bd42e7520338c59a797f76b (patch)
tree75b61297b6d9b6e4810542390eb1371afc2f183f /lib/ocaml_rts/linksem/error.ml
parent8124c487b576661dfa7a0833415d07d0978bc43e (diff)
Add ocaml run-time and updates to sail for ocaml backend
Diffstat (limited to 'lib/ocaml_rts/linksem/error.ml')
-rw-r--r--lib/ocaml_rts/linksem/error.ml112
1 files changed, 112 insertions, 0 deletions
diff --git a/lib/ocaml_rts/linksem/error.ml b/lib/ocaml_rts/linksem/error.ml
new file mode 100644
index 00000000..45f8a80b
--- /dev/null
+++ b/lib/ocaml_rts/linksem/error.ml
@@ -0,0 +1,112 @@
+(*Generated by Lem from error.lem.*)
+open Lem_basic_classes
+open Lem_list
+open Lem_maybe
+open Lem_num
+open Lem_string
+open 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 'a error
+ = 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)
+
+(*val with_success : forall 'a 'b. error 'a -> 'b -> ('a -> 'b) -> 'b*)
+let with_success err fl suc =
+((match err with
+ | Success s -> suc s
+ | Fail err -> fl
+ ))
+
+(** [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
+ ))
+
+(** [as_maybe e] drops an [error] value into a [maybe] value, throwing away
+ * error information.
+ *)
+
+(*val as_maybe : forall 'a. error 'a -> maybe 'a*)
+let as_maybe e =
+((match e with
+ | Fail err -> None
+ | Success s -> Some s
+ ))
+
+(** [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. natural -> error 'a -> error (list 'a)*)
+let rec repeatM count action =
+(if Nat_big_num.equal count(Nat_big_num.of_int 0) then
+ return []
+ else
+ action >>= (fun head ->
+ repeatM ( Nat_big_num.sub_nat count(Nat_big_num.of_int 1)) action >>= (fun tail ->
+ return (head::tail))))
+
+(** [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. natural -> 'b -> ('b -> error ('a * 'b)) -> error ((list 'a) * 'b)*)
+let rec repeatM' count seed action =
+(if Nat_big_num.equal count(Nat_big_num.of_int 0) then
+ return ([], seed)
+ else
+ action seed >>= (fun (head, seed) ->
+ repeatM' ( Nat_big_num.sub_nat count(Nat_big_num.of_int 1)) seed action >>= (fun (tail, seed) ->
+ return ((head::tail), seed))))
+
+(** [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)))
+ ))
+
+(*val foldM : forall 'a 'b. ('a -> 'b -> error 'a) -> 'a -> list 'b -> error 'a*)
+let rec foldM f e xs =
+((match xs with
+ | [] -> return e
+ | x::xs -> f e x >>= (fun res -> foldM f res xs)
+ ))
+
+(** [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 dict_Show_Show_a e =
+((match e with
+ | Fail err -> "Fail: " ^ err
+ | Success s -> dict_Show_Show_a.show_method s
+ ))
+
+let instance_Show_Show_Error_error_dict dict_Show_Show_a =({
+
+ show_method =
+ (string_of_error dict_Show_Show_a)})