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
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
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)})
|
