1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
|
(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
* Jagannathan, and Stephen Weeks.
*
* MLton is released under a BSD-style license.
* See the file MLton-LICENSE for details.
*)
signature EMBED_WORD =
sig
eqtype word
type big
val fromBigUnsafe: big -> word
val toBig: word -> big
val wordSize: Int.int
end
functor EmbedWord (structure Big: WORD
structure Small: EMBED_WORD where type big = Big.word): WORD =
struct
val () = if Int.< (Small.wordSize, Big.wordSize) then ()
else raise Fail "EmbedWord"
open Small
fun ones size =
Big.- (Big.<< (Big.fromLarge 0w1, Word.fromInt size),
Big.fromLarge 0w1)
val maxWord = ones wordSize
fun fromBig (w: Big.word): word =
fromBigUnsafe (Big.andb (w, maxWord))
fun fromBigOverflow (w: Big.word): word =
if Big.<= (w, maxWord)
then fromBigUnsafe w
else raise Overflow
fun highBitIsSet (w: Big.word): bool =
Big.> (w, ones (Int.- (wordSize, 1)))
fun toBigX (w: word): Big.word =
let
val w = toBig w
in
if highBitIsSet w
then Big.orb (w, Big.notb maxWord)
else w
end
local
val make: (Big.word * Big.word -> Big.word) -> (word * word -> word) =
fn f => fn (x, y) => fromBig (f (toBig x, toBig y))
in
val op * = make Big.*
val op + = make Big.+
val op - = make Big.-
val andb = make Big.andb
val op div = make Big.div
val op mod = make Big.mod
val orb = make Big.orb
val xorb = make Big.xorb
end
local
val make: ((Big.word * Word.word -> Big.word)
-> word * Word.word -> word) =
fn f => fn (w, w') => fromBig (f (toBig w, w'))
in
val >> = make Big.>>
val << = make Big.<<
end
fun ~>> (w, w') = fromBig (Big.~>> (toBigX w, w'))
local
val make: (Big.word * Big.word -> 'a) -> (word * word -> 'a) =
fn f => fn (x, y) => f (toBig x, toBig y)
in
val op < = make Big.<
val op <= = make Big.<=
val op > = make Big.>
val op >= = make Big.>=
val compare = make Big.compare
end
local
val make: (Big.word -> Big.word) -> word -> word =
fn f => fn w => fromBig (f (toBig w))
in
val notb = make Big.notb
end
local
val make: ('a -> Big.word) -> 'a -> word =
fn f => fn a => fromBig (f a)
in
val fromInt = make Big.fromInt
val fromLarge = make Big.fromLarge
val fromLargeInt = make Big.fromLargeInt
end
local
val make: (Big.word -> 'a) -> word -> 'a =
fn f => fn w => f (toBig w)
in
val toInt = make Big.toInt
val toLarge = make Big.toLarge
val toLargeInt = make Big.toLargeInt
val toString = make Big.toString
end
local
val make: (Big.word -> 'a) -> word -> 'a =
fn f => fn w => f (toBigX w)
in
val toIntX = make Big.toIntX
val toLargeIntX = make Big.toLargeIntX
val toLargeX = make Big.toLargeX
end
fun fmt r i = Big.fmt r (toBig i)
val fromLargeWord = fromLarge
fun fromString s = Option.map fromBigOverflow (Big.fromString s)
fun max (w, w') = if w >= w' then w else w'
fun min (w, w') = if w <= w' then w else w'
fun scan r reader state =
Option.map
(fn (w, state) => (fromBigOverflow w, state))
(Big.scan r reader state)
val toLargeWord = toLarge
val toLargeWordX = toLargeX
fun ~ w = fromLarge 0w0 - w
end
functor EmbedWord8 (Small: EMBED_WORD where type big = Word8.word): WORD =
EmbedWord (structure Big = Word8
structure Small = Small)
functor EmbedWord16 (Small: EMBED_WORD where type big = Word16.word): WORD =
EmbedWord (structure Big = Word16
structure Small = Small)
functor EmbedWord32 (Small: EMBED_WORD where type big = Word32.word): WORD =
EmbedWord (structure Big = Word32
structure Small = Small)
structure Word1 = EmbedWord8 (Primitive.Word1)
structure Word2 = EmbedWord8 (Primitive.Word2)
structure Word3 = EmbedWord8 (Primitive.Word3)
structure Word4 = EmbedWord8 (Primitive.Word4)
structure Word5 = EmbedWord8 (Primitive.Word5)
structure Word6 = EmbedWord8 (Primitive.Word6)
structure Word7 = EmbedWord8 (Primitive.Word7)
structure Word9 = EmbedWord16 (Primitive.Word9)
structure Word10 = EmbedWord16 (Primitive.Word10)
structure Word11 = EmbedWord16 (Primitive.Word11)
structure Word12 = EmbedWord16 (Primitive.Word12)
structure Word13 = EmbedWord16 (Primitive.Word13)
structure Word14 = EmbedWord16 (Primitive.Word14)
structure Word15 = EmbedWord16 (Primitive.Word15)
structure Word17 = EmbedWord32 (Primitive.Word17)
structure Word18 = EmbedWord32 (Primitive.Word18)
structure Word19 = EmbedWord32 (Primitive.Word19)
structure Word20 = EmbedWord32 (Primitive.Word20)
structure Word21 = EmbedWord32 (Primitive.Word21)
structure Word22 = EmbedWord32 (Primitive.Word22)
structure Word23 = EmbedWord32 (Primitive.Word23)
structure Word24 = EmbedWord32 (Primitive.Word24)
structure Word25 = EmbedWord32 (Primitive.Word25)
structure Word26 = EmbedWord32 (Primitive.Word26)
structure Word27 = EmbedWord32 (Primitive.Word27)
structure Word28 = EmbedWord32 (Primitive.Word28)
structure Word29 = EmbedWord32 (Primitive.Word29)
structure Word30 = EmbedWord32 (Primitive.Word30)
structure Word31 = EmbedWord32 (Primitive.Word31)
|
