/Jennisys/Jennisys/Utils.fs
F# | 368 lines | 181 code | 46 blank | 141 comment | 52 complexity | 35b205609e6e554f1cf188bc59e97a2f MD5 | raw file
1// ####################################################################
2/// Various utility functions
3///
4/// author: Aleksandar Milicevic (t-alekm@microsoft.com)
5// ####################################################################
6
7module Utils
8
9// -------------------------------------------
10// ----------- collection util funcs ---------
11// -------------------------------------------
12
13// =====================================
14/// ensures: ret = b ? Some(b) : None
15// =====================================
16let BoolToOption b =
17 if b then
18 Some(b)
19 else
20 None
21
22// =====================================
23/// ensures: ret = (opt == Some(_))
24// =====================================
25let OptionToBool opt =
26 match opt with
27 | Some(_) -> true
28 | None -> false
29
30// =====================================
31/// ensures: ret = (opt == Some(_))
32// =====================================
33let IsSomeOption opt =
34 match opt with
35 | Some(_) -> true
36 | None -> false
37
38// =====================================
39/// ensures: ret = (opt == None)
40// =====================================
41let IsNoneOption opt = IsSomeOption opt |> not
42
43// =====================================
44/// requres: x = Some(a) or failswith msg
45/// ensures: ret = a
46// =====================================
47let ExtractOptionMsg msg x =
48 match x with
49 | Some(a) -> a
50 | None -> failwith msg
51
52// ====================
53/// requres: x = Some(a)
54/// ensures: ret = a
55// ====================
56let ExtractOption x =
57 ExtractOptionMsg "can't extract anything from a None" x
58
59// ====================================
60/// ensures: res = Some(a) ==> ret = a
61/// ensures: res = None ==> ret = defVal
62// ====================================
63let ExtractOptionOr defVal opt =
64 match opt with
65 | Some(a) -> a
66 | None -> defVal
67
68// ==========================================================
69/// requres: List.length lst <= 1, otherwise fails with errMsg
70/// ensures: if |lst| = 0 then
71/// ret = None
72/// else
73/// ret = Some(lst[0])
74// ==========================================================
75let ListToOptionMsg lst errMsg =
76 if List.length lst > 1 then
77 failwith errMsg
78 if List.isEmpty lst then
79 None
80 else
81 Some(lst.[0])
82
83let ListToOption lst = ListToOptionMsg lst "given list contains more than one element"
84
85let ListDeduplicate lst =
86 let rec __Dedup lst (visitedSet: System.Collections.Generic.HashSet<_>) acc =
87 match lst with
88 | fs :: rest ->
89 let newAcc =
90 if visitedSet.Add(fs) then
91 acc @ [fs]
92 else
93 acc
94 __Dedup rest visitedSet newAcc
95 | _ -> acc
96 __Dedup lst (new System.Collections.Generic.HashSet<_>()) []
97
98let rec ListCombine combinerFunc lst1 lst2 =
99 match lst1 with
100 | e1 :: rest ->
101 let resLst1 = lst2 |> List.fold (fun acc e2 -> acc @ [combinerFunc e1 e2]) []
102 List.concat [resLst1; ListCombine combinerFunc rest lst2]
103 | [] -> []
104
105let rec ListCombineMult combinerFunc lst1 lst2 =
106 match lst1 with
107 | e1 :: rest ->
108 let resLst1 = lst2 |> List.fold (fun acc e2 -> acc @ combinerFunc e1 e2) []
109 List.concat [resLst1; ListCombineMult combinerFunc rest lst2]
110 | [] -> []
111
112// =============================================================
113/// ensures: forall i :: 0 <= i < |lst| ==> ret[i] = Some(lst[i])
114// =============================================================
115let rec ConvertToOptionList lst =
116 match lst with
117 | fs :: rest -> Some(fs) :: ConvertToOptionList rest
118 | [] -> []
119
120// =========================================================
121/// requres: Seq.length seq <= 1, otherwise fails with errMsg
122/// ensures: if |seq| = 0 then
123/// ret = None
124/// else
125/// ret = Some(seq[0])
126// =========================================================
127let SeqToOptionMsg seq errMsg =
128 if Seq.length seq > 1 then
129 failwith errMsg
130 if Seq.isEmpty seq then
131 None
132 else
133 Some(Seq.nth 0 seq)
134
135let SeqToOption seq = SeqToOptionMsg seq "given seq contains more than one element"
136
137// =========================================================
138/// requires: Set.count set <= 1, otherwise fails with errMsg
139/// ensures: if |set| = 0 then
140/// ret = None
141/// else
142/// ret = Some(set[0])
143// =========================================================
144let SetToOptionMsg set errMsg =
145 if Set.count set > 1 then
146 failwith errMsg
147 if (Set.isEmpty set) then
148 None
149 else
150 Some(set |> Set.toList |> List.head)
151
152let SetToOption set = SetToOptionMsg set "give set contains more than one value"
153
154// ============================================================
155/// requires: n >= 0
156/// ensures: |ret| = n && forall i :: 0 <= i < n ==> ret[i] = e
157// ============================================================
158let rec GenList n e =
159 if n < 0 then
160 failwith "n must be positive"
161 if n = 0 then
162 []
163 else
164 e :: (GenList (n-1) e)
165
166// =======================================
167/// ensures: forall i :: 0 <= i < |lst| ==>
168/// if lst[i] = oldElem then
169/// ret[i] = newElem
170/// else
171/// ret[i] = lst[i]
172// =======================================
173let ListReplace oldElem newElem lst =
174 lst |> List.map (fun e -> if e = oldElem then newElem else e)
175
176// =================================================
177/// if (exists (k,v) :: (k,v) in lst && k = key) then
178/// ret = Some(v)
179/// else
180/// ret = None
181// =================================================
182let ListMapTryFind key lst =
183 let filtered = lst |> List.filter (fun (k,v) -> k = key)
184 match filtered with
185 | fs :: rest -> Some(snd fs)
186 | [] -> None
187
188// ==================================================
189/// Replaces the first occurence of the given key in
190/// the given list with the given value, or appends
191/// (key,value) if key does not exist in the list
192// ==================================================
193let rec ListMapAdd key value lst =
194 match lst with
195 | (k,v) :: rest -> if k = key then (k, value) :: rest else (k,v) :: (ListMapAdd key value rest)
196 | [] -> [(key,value)]
197
198// ==========================
199/// ensures: ret = elem in lst
200// ==========================
201let ListContains elem lst =
202 lst |> List.exists (fun e -> e = elem)
203
204// ====================================================
205/// Removes all elements in lst that are equal to "elem"
206// ====================================================
207let ListRemove elem lst =
208 lst |> List.choose (fun e -> if e = elem then None else Some(e))
209
210let rec ListRemoveIdx idx lst =
211 if idx = 0 then
212 List.tail lst
213 else
214 List.head lst :: ListRemoveIdx (idx - 1) (List.tail lst)
215
216// ===============================================================
217/// ensures: |ret| = max(|lst| - cnt, 0)
218/// ensures: forall i :: cnt <= i < |lst| ==> ret[i] = lst[i-cnt]
219// ===============================================================
220let rec ListSkip cnt lst =
221 if cnt = 0 then
222 lst
223 else
224 match lst with
225 | fs :: rest -> ListSkip (cnt-1) rest
226 | [] -> []
227
228// ===============================================================
229/// ensures: forall i :: 0 <= i < max(|srcList|, |dstList|) ==>
230/// if i = idx then
231/// ret[i] = v
232/// elif i < |srcList| then
233/// ret[i] = srcList[i]
234/// else
235/// ret[i] = dstList[i]
236// ===============================================================
237let rec ListBuild srcList idx v dstList =
238 match srcList, dstList with
239 | fs1 :: rest1, fs2 :: rest2 -> if idx = 0 then
240 v :: List.concat [rest1 ; ListSkip (List.length rest1) rest2]
241 else
242 fs1 :: ListBuild rest1 (idx-1) v rest2
243 | [], fs2 :: rest2 -> if idx = 0 then
244 v :: rest2
245 else
246 fs2 :: ListBuild [] (idx-1) v rest2
247 | _, [] -> failwith "index out of range"
248
249// =======================================
250/// ensures: forall i :: 0 <= i < |lst| ==>
251/// if i = idx then
252/// ret[i] = v
253/// else
254/// ret[i] = lst[i]
255// =======================================
256let rec ListSet idx v lst =
257 match lst with
258 | fs :: rest -> if idx = 0 then
259 v :: rest
260 else
261 fs :: ListSet (idx-1) v rest
262 | [] -> failwith "index out of range"
263
264exception KeyAlreadyExists
265
266// =======================================
267/// requires (key |--> value) !in map
268///
269/// ensures ret = map ++ (key |--> value)
270// =======================================
271let MapAddNew key value map =
272 match Map.tryFind key map with
273 | Some(existingValue) ->
274 if existingValue = value then
275 map
276 else
277 raise KeyAlreadyExists
278 | None ->
279 map |> Map.add key value
280
281// =======================================
282/// ensures: forall k,v ::
283/// if k,v in map2 then
284// k,v in ret
285/// elif k,v in map1 then
286/// k,v in ret
287/// else
288/// k,v !in ret
289// =======================================
290let rec MapAddAll map1 map2 =
291 map2 |> Map.fold (fun acc k v -> acc |> Map.add k v) map1
292
293// =======================================
294/// ensures: |ret| = 1
295/// ensures: (key -> value) in ret
296// =======================================
297let MapSingleton key value =
298 Map.empty |> Map.add key value
299
300let MapKeys map =
301 map |> Map.toList |> List.map (fun (k,v) -> k)
302
303let MapReplaceKey oldKey newKey newVal map =
304 map |> Map.toList |> List.fold (fun acc (k,v) -> if k = oldKey then acc |> Map.add newKey newVal else acc |> Map.add k v) Map.empty
305
306// -------------------------------------------
307// ------------ algorithms -------------------
308// -------------------------------------------
309
310// =======================================================================
311/// Topologically sorts a given list
312///
313/// ensures: |ret| = |lst|
314/// ensures: forall e in lst :: e in ret
315/// ensures: forall i,j :: 0 <= i < j < ==> not (followsFunc ret[j] ret[i])
316// =======================================================================
317let rec TopSort followsFunc lst =
318 match lst with
319 | [] -> []
320 | fs :: [] -> [fs]
321 | fs :: rest ->
322 let min = rest |> List.fold (fun acc elem -> if followsFunc acc elem then elem else acc) fs
323 min :: TopSort followsFunc (ListRemove min lst)
324
325// -------------------------------------------
326// ------ string active patterns -------------
327// -------------------------------------------
328
329let (|Prefix|_|) (p:string) (s:string) =
330 if s.StartsWith(p) then
331 Some(s.Substring(p.Length))
332 else
333 None
334
335// -------------------------------------------
336// --------------- workflow ------------------
337// -------------------------------------------
338
339let IfDo1 cond func1 a =
340 if cond then
341 func1 a
342 else
343 a
344
345let IfDo2 cond func2 (a1,a2) =
346 if cond then
347 func2 a1 a2
348 else
349 a1,a2
350
351let Ite cond f1 f2 =
352 if cond then
353 f1
354 else
355 f2
356
357type CascadingBuilder<'a>(failVal: 'a) =
358 member this.Bind(v, f) =
359 match v with
360 | Some(x) -> f x
361 | None -> failVal
362 member this.Return(v) = v
363
364// -------------------------------------------
365// --------------- random --------------------
366// -------------------------------------------
367
368let Iden x = x