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