diff options
author | 2017-07-12 11:16:09 -0400 | |
---|---|---|
committer | 2017-07-12 11:16:09 -0400 | |
commit | bcfcf891563bcbf1d39a60275cabd695be162eee (patch) | |
tree | b2fd44bcd8503ef39452e35deb3b730fb7183c45 /lib | |
parent | ba7129f547d1f06c7eb67412404445681d22b920 (diff) |
format pairs of items for pr_depth to get alternating separators
eval thunks once in prlist_sep_lastsep, make code clearer
add typeclass debug output test
Diffstat (limited to 'lib')
-rw-r--r-- | lib/pp.ml | 36 | ||||
-rw-r--r-- | lib/pp.mli | 5 |
2 files changed, 23 insertions, 18 deletions
@@ -220,23 +220,25 @@ let prlist pr l = Ppcmd_glue (List.map pr l) if a strict behavior is needed, use [prlist_strict] instead. evaluation is done from left to right. *) -let prlist_sep_lastsep no_empty sep lastsep elem = - let rec start = function - |[] -> mt () - |[e] -> elem e - |h::t -> let e = elem h in - if no_empty && ismt e then start t else - let rec aux = function - |[] -> mt () - |h::t -> - let e = elem h and r = aux t in - if no_empty && ismt e then r else - if ismt r - then let s = lastsep () in s ++ e - else let s = sep () in s ++ e ++ r - in let r = aux t in e ++ r - in start - +let prlist_sep_lastsep no_empty sep_thunk lastsep_thunk elem l = + let sep = sep_thunk () in + let lastsep = lastsep_thunk () in + let elems = List.map elem l in + let filtered_elems = + if no_empty then + List.filter (fun e -> not (ismt e)) elems + else + elems + in + let rec insert_seps es = + match es with + | [] -> mt () + | [e] -> e + | h::[e] -> h ++ lastsep ++ e + | h::t -> h ++ sep ++ insert_seps t + in + insert_seps filtered_elems + let prlist_strict pr l = prlist_sep_lastsep true mt mt pr l (* [prlist_with_sep sep pr [a ; ... ; c]] outputs [pr a ++ sep() ++ ... ++ sep() ++ pr c] *) diff --git a/lib/pp.mli b/lib/pp.mli index be255a74f..96656c8b6 100644 --- a/lib/pp.mli +++ b/lib/pp.mli @@ -145,7 +145,10 @@ val prlist_strict : ('a -> std_ppcmds) -> 'a list -> std_ppcmds val prlist_with_sep : (unit -> std_ppcmds) -> ('a -> std_ppcmds) -> 'a list -> std_ppcmds (** [prlist_with_sep sep pr [a ; ... ; c]] outputs - [pr a ++ sep() ++ ... ++ sep() ++ pr c]. *) + [pr a ++ sep () ++ ... ++ sep () ++ pr c]. + where the thunk sep is memoized, rather than being called each place + its result is used. +*) val prvect : ('a -> std_ppcmds) -> 'a array -> std_ppcmds (** As [prlist], but on arrays. *) |