module U = NUri
-type ('a, 'b) item = Term of 'a * 'b
- | LEnv of 'a
+type ('b, 'c) item = Term of 'b * 'c
+ | LEnv of 'b
| Warn of string
| Uri of U.uri
- | Flush
-type ('a, 'b) message = ('a, 'b) item list
+type ('b, 'c) message = ('b, 'c) item list
-type ('a, 'b) specs = {
- pp_term: 'a -> out_channel -> 'b -> unit;
- pp_lenv: out_channel -> 'a -> unit
+type ('a, 'b, 'c) specs = {
+ pp_term: 'a -> 'b -> out_channel -> 'c -> unit;
+ pp_lenv: 'a -> out_channel -> 'b -> unit
}
(* Internal functions *******************************************************)
let err = stderr
-let pp_items och st l items =
+let pp_items och a st l items =
let indent = S.make (l+l) ' ' in
let pp_item och = function
- | Term (c, t) -> P.fprintf och "%s%a\n" indent (st.pp_term c) t
- | LEnv c -> P.fprintf och "%s%a" indent st.pp_lenv c
+ | Term (c, t) -> P.fprintf och "%s%a\n" indent (st.pp_term a c) t
+ | LEnv c -> P.fprintf och "%s%a" indent (st.pp_lenv a) c
| Warn s -> P.fprintf och "%s%s\n" indent s
| Uri u -> P.fprintf och "%s<%s>\n" indent (U.string_of_uri u)
- | Flush -> P.fprintf och "%!"
in
let iter map och l = List.iter (map och) l in
- P.fprintf och "%a" (iter pp_item) items
+ P.fprintf och "%a%!" (iter pp_item) items
(* Interface functions ******************************************************)
-let log st l items = pp_items std st l items
+let log a st l items = pp_items std a st l items
-let error st items = pp_items err st 0 items
+let error a st items = pp_items err a st 0 items
let items1 s = [Warn s]
et_items2 sc1 c1 st1 t1 ?sc2 ?c2 st2 t2 @ tl
let specs = {
- pp_term = (fun _ _ _ -> ());
- pp_lenv = (fun _ _ -> ());
+ pp_term = (fun _ _ _ _ -> ());
+ pp_lenv = (fun _ _ _ -> ());
}
-let warn level str = log specs level (items1 str)
+let warn level str = log () specs level (items1 str)