X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fhelena%2Fsrc%2Flib%2Flog.ml;h=42f7f214b34b31eae85d3019a8b77b89f749c015;hb=a77d0bd6a04e94f765d329d47b37d9e04d349b14;hp=aeef7f9ee3fb910724307fb3576283c05e99ffb9;hpb=f72311aa07e71090a24eef9e4fb97cc2e95e6b16;p=helm.git diff --git a/helm/software/helena/src/lib/log.ml b/helm/software/helena/src/lib/log.ml index aeef7f9ee..42f7f214b 100644 --- a/helm/software/helena/src/lib/log.ml +++ b/helm/software/helena/src/lib/log.ml @@ -9,22 +9,21 @@ \ / This software is distributed as is, NO WARRANTY. V_______________________________________________________________ *) -module S = String -module P = Printf +module KT = String +module KP = Printf 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 *******************************************************) @@ -33,23 +32,22 @@ let std = stdout let err = stderr -let pp_items och st l items = - let indent = S.make (l+l) ' ' in +let pp_items och a st l items = + let indent = KT.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 - | 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 "%!" + | Term (c, t) -> KP.fprintf och "%s%a\n" indent (st.pp_term a c) t + | LEnv c -> KP.fprintf och "%s%a\n" indent (st.pp_lenv a) c + | Warn s -> KP.fprintf och "%s%s\n" indent s + | Uri u -> KP.fprintf och "%s<%s>\n" indent (U.string_of_uri u) in let iter map och l = List.iter (map och) l in - P.fprintf och "%a" (iter pp_item) items + KP.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] @@ -76,8 +74,8 @@ let et_items3 sc1 c1 st1 t1 ?sc2 ?c2 st2 t2 ?sc3 ?c3 st3 t3 = 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)