PageRenderTime 87ms CodeModel.GetById 22ms app.highlight 62ms RepoModel.GetById 0ms app.codeStats 0ms

/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