diff options
| author | Alasdair Armstrong | 2017-09-07 16:54:20 +0100 |
|---|---|---|
| committer | Alasdair Armstrong | 2017-09-07 16:54:20 +0100 |
| commit | 842165c1171fde332bd42e7520338c59a797f76b (patch) | |
| tree | 75b61297b6d9b6e4810542390eb1371afc2f183f /lib/ocaml_rts/linksem/error.ml | |
| parent | 8124c487b576661dfa7a0833415d07d0978bc43e (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.ml | 112 |
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)}) |
