1(*
2    Title:      Standard Basis Library: Bool Structure
3    Author:     David Matthews
4    Copyright   David Matthews 1999, 2005, 2016
5
6    This library is free software; you can redistribute it and/or
7    modify it under the terms of the GNU Lesser General Public
8    License version 2.1 as published by the Free Software Foundation.
9    
10    This library is distributed in the hope that it will be useful,
11    but WITHOUT ANY WARRANTY; without even the implied warranty of
12    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
13    Lesser General Public License for more details.
14    
15    You should have received a copy of the GNU Lesser General Public
16    License along with this library; if not, write to the Free Software
17    Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
18*)
19
20(* G&R status: Minor change to signature.  Done. *)
21signature BOOL =
22  sig
23    datatype bool = datatype bool
24    val not : bool -> bool
25    val fromString : string -> bool option
26    val scan : (char, 'a) StringCvt.reader -> (bool, 'a) StringCvt.reader
27    val toString : bool -> string
28  end;
29
30structure Bool : BOOL =
31struct
32    open Bool (* Defined in Initialise.  Contains bool datatype and "not". *)
33        
34    local
35        val explode_true = Text.String.explode "true"
36        and explode_false = Text.String.explode "false"
37    in
38    fun scan (getc: (char, 'a) StringCvt.reader) (str: 'a) : (bool * 'a) option =
39        let
40        (* Skip leading white space. *)
41        val strm = StringCvt.skipWS getc str
42        (* Test for a match between a reader and a list of lower case chars. *)
43        fun matchNC _    strm [] = (strm, true )(* Reached end of list - succeeded *)
44          | matchNC getc strm (ch::rest) =
45                case getc strm of
46                    NONE => (strm, false) (* Couldn't read it - fail. *)
47                  | SOME(ch', strm') =>
48                      if ch = Char.toLower ch' (* N.B. ch is already lower case. *)
49                      then matchNC getc strm' rest
50                      else (strm', false)
51        in
52            (* If it matches "true" or "false" we have a valid match,
53               otherwise return NONE. *)
54            case matchNC getc strm explode_true of
55                (strm', true) => SOME(true, strm')
56              | _ =>
57                (
58                case matchNC getc strm explode_false of
59                    (strm', true) => SOME(false, strm')
60                  | _ => NONE
61                )
62        end
63    end
64    
65    (* Convert from a string. *)
66    (* TODO: More efficient conversion? *)
67    val fromString = StringCvt.scanString scan
68    
69    (* Convert to a string. *)
70    fun toString true = "true"
71      | toString false = "false"
72
73end;
74