1(*
2    Copyright (c) 2001, 2015
3        David C.J. Matthews
4
5    This library is free software; you can redistribute it and/or
6    modify it under the terms of the GNU Lesser General Public
7    License version 2.1 as published by the Free Software Foundation.
8    
9    This library is distributed in the hope that it will be useful,
10    but WITHOUT ANY WARRANTY; without even the implied warranty of
11    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
12    Lesser General Public License for more details.
13    
14    You should have received a copy of the GNU Lesser General Public
15    License along with this library; if not, write to the Free Software
16    Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
17*)
18functor FlagPrint(structure BITS: BIT_FLAGS) =
19struct
20    (* Auxiliary function to create a function to print out bit flags.
21       The function must actually be installed by the caller because
22       it has to be called with the type itself. *)
23    fun createFlagPrinter (flagTable: (BITS.flags * string) list) =
24    let
25        fun accumulateFlags _ [] = []
26         |  accumulateFlags f ((w, s)::t) =
27            if BITS.allSet(w, f) then s :: accumulateFlags(BITS.clear(w, f)) t
28            else accumulateFlags f t
29    
30        fun printFlags depth _ x =
31            (* This is just the code to print a list. *)
32            let
33                open PolyML
34              val stringFlags = accumulateFlags x flagTable
35              fun plist [] _ = []
36               |  plist _ 0 = [PrettyString "..."]
37               |  plist [h]    _ = [PrettyString h]
38               |  plist (h::t) depth =
39                        PrettyString(h ^ ",") ::
40                        PrettyBreak (1, 0) ::
41                        plist t (depth - 1)
42            in
43              PrettyBlock (3, false, [],
44                PrettyString "[" ::
45                    ((if depth <= 0 then [PrettyString "..."]
46                          else plist stringFlags depth) @
47                    [PrettyString "]"]
48                    )
49                )
50            end
51    in
52        printFlags
53    end;
54end;
55