1(*
2    Title:      Standard Basis Library: Word16 Structure
3    Author:     Domagoj Stolfa
4    Copyright   Domagoj Stolfa 2018
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 as published by the Free Software Foundation; either
9    version 2.1 of the License, or (at your option) any later version.
10    
11    This library is distributed in the hope that it will be useful,
12    but WITHOUT ANY WARRANTY; without even the implied warranty of
13    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
14    Lesser General Public License for more details.
15    
16    You should have received a copy of the GNU Lesser General Public
17    License along with this library; if not, write to the Free Software
18    Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
19*)
20
21(*
22 * This file is *heavily* based on David Matthews' work on Word8.
23 *)
24
25structure Word16 :> WORD =
26struct
27    open Word
28
29    (* 16-bit words have values that range from 0...65535 and like Word8.word
30       are implemented using tagged integers. *)
31    val wordSize = 16
32    val maxWord = 65535
33    val maxWordAsWord: word = RunCall.unsafeCast maxWord
34
35    infix 8 << >> ~>>
36
37    (* Comparison operations, min, max and compare, fmt, toString,
38       orb, andb, xorb can be inherited directly from Word.
39       Similarly div and mod since the results will always be no
40       larger than the arguments. *)
41
42    (* This only works for the bottom 16 bits *)
43    fun notb x = xorb(maxWordAsWord, x)
44
45    (* Internal function to convert from Word.word. *)
46    fun fromWord (w: Word.word) = andb(w, maxWordAsWord)
47
48    (* Converting from LargeWord.word.  First convert to Word.word and
49       then mask. *)
50    val fromLargeWord = fromWord o Word.fromLargeWord
51    and fromInt = fromWord o Word.fromInt
52    and fromLargeInt = fromWord o Word.fromLargeInt
53
54    val fromLarge = fromLargeWord
55
56    local
57        val toSignBit = Word.fromInt(Int.-(Word.wordSize,wordSize))
58    in
59        fun op ~>> (a: word, b: Word.word): word =
60            fromWord(Word.~>>(Word.<<(a, toSignBit), Word.+(b, toSignBit)))
61    end
62
63    fun op << (a: word, b: Word.word): word = andb(Word.<<(a,b), maxWordAsWord)
64
65    val toInt: word->int = RunCall.unsafeCast
66
67    (* As with Word8.toIntX, this could be implemented with a logical shift
68       followed by an arithmetic shift *)
69    fun toIntX (x: word) : int =
70        let
71            val intx = toInt x
72            open Int
73        in
74            if intx >= 32768
75            then intx-maxWord-1
76            else intx
77        end
78
79    val toLargeInt = LargeInt.fromInt o toInt
80    and toLargeIntX = LargeInt.fromInt o toIntX
81
82    fun toLargeWordX (w: word): LargeWord.word =
83        LargeWord.fromInt(toIntX w);
84    val toLargeX = toLargeWordX
85
86    val wordScan = scan;
87
88    fun scan radix getc src =
89        case wordScan radix getc src of
90            NONE => NONE
91         |  SOME(res, src') =>
92                if res > maxWordAsWord
93                then raise General.Overflow
94                else SOME(res, src')
95
96    val fromString = StringCvt.scanString (scan StringCvt.HEX)
97
98    fun op + (a, b) = fromWord(Word.+(a, b))
99    and op - (a, b) = fromWord(Word.-(a, b))
100    and op * (a, b) = fromWord(Word.*(a, b))
101
102    fun ~ x = 0w0 - x
103
104end;
105
106(* Because we are using opaque signature matching we have to install
107   type-dependent functions OUTSIDE the structure. *)
108local
109    fun convWord s : Word16.word =
110        let
111        val radix =
112            if String.sub(s, 2) = #"x" then StringCvt.HEX else StringCvt.DEC
113        in
114            case StringCvt.scanString (Word16.scan radix) s of
115                NONE => raise RunCall.Conversion "Invalid Word16 constant"
116              | SOME res => res
117        end
118
119    fun pretty _ _ x = PolyML.PrettyString("0wx" ^ Word16.toString x)
120in
121    val () = RunCall.addOverload convWord "convWord"
122    val () = PolyML.addPrettyPrinter pretty
123end;
124
125val () = RunCall.addOverload Word16.~ "~";
126val () = RunCall.addOverload Word16.+ "+";
127val () = RunCall.addOverload Word16.- "-";
128val () = RunCall.addOverload Word16.* "*";
129val () = RunCall.addOverload Word16.div "div";
130val () = RunCall.addOverload Word16.mod "mod";
131val () = RunCall.addOverload Word16.< "<";
132val () = RunCall.addOverload Word16.> ">";
133val () = RunCall.addOverload Word16.<= "<=";
134val () = RunCall.addOverload Word16.>= ">=";
135