diff options
Diffstat (limited to 'lib')
| -rw-r--r-- | lib/cList.ml | 40 | ||||
| -rw-r--r-- | lib/cWarnings.ml | 2 | ||||
| -rw-r--r-- | lib/pp.ml | 2 |
3 files changed, 30 insertions, 14 deletions
diff --git a/lib/cList.ml b/lib/cList.ml index 602bba6a5c..c8283e3c71 100644 --- a/lib/cList.ml +++ b/lib/cList.ml @@ -601,19 +601,35 @@ let filter2 f l1 l2 = filter2_loop f c1 c2 l1 l2; (c1.tail, c2.tail) -let rec map_filter f = function - | [] -> [] - | x::l -> - let l' = map_filter f l in - match f x with None -> l' | Some y -> y::l' +let rec map_filter_loop f p = function + | [] -> () + | x :: l -> + match f x with + | None -> map_filter_loop f p l + | Some y -> + let c = { head = y; tail = [] } in + p.tail <- cast c; + map_filter_loop f c l + +let map_filter f l = + let c = { head = Obj.magic 0; tail = [] } in + map_filter_loop f c l; + c.tail -let map_filter_i f = - let rec aux i = function - | [] -> [] - | x::l -> - let l' = aux (succ i) l in - match f i x with None -> l' | Some y -> y::l' - in aux 0 +let rec map_filter_i_loop f i p = function + | [] -> () + | x :: l -> + match f i x with + | None -> map_filter_i_loop f (succ i) p l + | Some y -> + let c = { head = y; tail = [] } in + p.tail <- cast c; + map_filter_i_loop f (succ i) c l + +let map_filter_i f l = + let c = { head = Obj.magic 0; tail = [] } in + map_filter_i_loop f 0 c l; + c.tail let rec filter_with filter l = match filter, l with | [], [] -> [] diff --git a/lib/cWarnings.ml b/lib/cWarnings.ml index 7b8dc2b9b5..78fa84f333 100644 --- a/lib/cWarnings.ml +++ b/lib/cWarnings.ml @@ -48,7 +48,7 @@ let create ~name ~category ?(default=Enabled) pp = CErrors.user_err_loc (loc,"_",pp x) | Enabled -> let msg = - pp x ++ str " [" ++ str name ++ str "," ++ + pp x ++ spc () ++ str "[" ++ str name ++ str "," ++ str category ++ str "]" in let loc = Option.default !current_loc loc in @@ -204,7 +204,7 @@ let pr_loc_pos loc = int (fst loc) ++ str"-" ++ int (snd loc) let pr_loc loc = - if Loc.is_ghost loc then str"<unknown>" + if Loc.is_ghost loc then str"<unknown>" ++ fnl () else let fname = loc.Loc.fname in if CString.equal fname "" then |