1 (* Copyright (C
) 2004-2006 Henry Cejtin
, Matthew Fluet
, Suresh
2 * Jagannathan
, and Stephen Weeks
.
4 * MLton is released under a BSD
-style license
.
5 * See the file MLton
-LICENSE for details
.
13 val fromBigUnsafe
: big
-> word
14 val sizeInBits
: Int32
.int
15 val toBig
: word -> big
18 functor EmbedWord (structure Big
: WORD
19 structure Small
: EMBED_WORD
where type big
= Big
.word): WORD
=
24 val wordSize
: Int.int = Int32
.toInt sizeInBits
27 val () = if Int.< (Small
.wordSize
, Big
.wordSize
) then ()
28 else raise Fail
"EmbedWord"
33 Big
.- (Big
.<< (Big
.fromLarge
0w1
, Word.fromInt size
),
36 val maxWord
= ones wordSize
38 fun fromBig (w
: Big
.word): word =
39 fromBigUnsafe (Big
.andb (w
, maxWord
))
41 fun fromBigOverflow (w
: Big
.word): word =
42 if Big
.<= (w
, maxWord
)
46 fun highBitIsSet (w
: Big
.word): bool =
47 Big
.> (w
, ones (Int.- (wordSize
, 1)))
49 fun toBigX (w
: word): Big
.word =
54 then Big
.orb (w
, Big
.notb maxWord
)
59 val make
: (Big
.word * Big
.word -> Big
.word) -> (word * word -> word) =
60 fn f
=> fn (x
, y
) => fromBig (f (toBig x
, toBig y
))
65 val andb
= make Big
.andb
66 val op div = make Big
.div
67 val op mod = make Big
.mod
68 val orb
= make Big
.orb
69 val xorb
= make Big
.xorb
73 val make
: ((Big
.word * Word.word -> Big
.word)
74 -> word * Word.word -> word) =
75 fn f
=> fn (w
, w
') => fromBig (f (toBig w
, w
'))
81 fun ~
>> (w
, w
') = fromBig (Big
.~
>> (toBigX w
, w
'))
84 val make
: (Big
.word * Big
.word -> 'a
) -> (word * word -> 'a
) =
85 fn f
=> fn (x
, y
) => f (toBig x
, toBig y
)
88 val op <= = make Big
.<=
90 val op >= = make Big
.>=
91 val compare
= make Big
.compare
95 val make
: (Big
.word -> Big
.word) -> word -> word =
96 fn f
=> fn w
=> fromBig (f (toBig w
))
98 val notb
= make Big
.notb
102 val make
: ('a
-> Big
.word) -> 'a
-> word =
103 fn f
=> fn a
=> fromBig (f a
)
105 val fromInt
= make Big
.fromInt
106 val fromLarge
= make Big
.fromLarge
107 val fromLargeInt
= make Big
.fromLargeInt
111 val make
: (Big
.word -> 'a
) -> word -> 'a
=
112 fn f
=> fn w
=> f (toBig w
)
114 val toInt
= make Big
.toInt
115 val toLarge
= make Big
.toLarge
116 val toLargeInt
= make Big
.toLargeInt
117 val toString
= make Big
.toString
121 val make
: (Big
.word -> 'a
) -> word -> 'a
=
122 fn f
=> fn w
=> f (toBigX w
)
124 val toIntX
= make Big
.toIntX
125 val toLargeIntX
= make Big
.toLargeIntX
126 val toLargeX
= make Big
.toLargeX
129 fun fmt r i
= Big
.fmt
r (toBig i
)
131 val fromLargeWord
= fromLarge
133 fun fromString s
= Option
.map
fromBigOverflow (Big
.fromString s
)
135 fun max (w
, w
') = if w
>= w
' then w
else w
'
137 fun min (w
, w
') = if w
<= w
' then w
else w
'
139 fun scan r reader state
=
141 (fn (w
, state
) => (fromBigOverflow w
, state
))
142 (Big
.scan r reader state
)
144 val toLargeWord
= toLarge
146 val toLargeWordX
= toLargeX
148 fun ~ w
= fromLarge
0w0
- w
151 functor EmbedWord8 (Small
: EMBED_WORD
where type big
= Word8.word): WORD
=
152 EmbedWord (structure Big
= Word8
153 structure Small
= Small
)
155 functor EmbedWord16 (Small
: EMBED_WORD
where type big
= Word16
.word): WORD
=
156 EmbedWord (structure Big
= Word16
157 structure Small
= Small
)
159 functor EmbedWord32 (Small
: EMBED_WORD
where type big
= Word32
.word): WORD
=
160 EmbedWord (structure Big
= Word32
161 structure Small
= Small
)
163 structure Word1
= EmbedWord8 (Primitive
.Word1
)
164 structure Word2
= EmbedWord8 (Primitive
.Word2
)
165 structure Word3
= EmbedWord8 (Primitive
.Word3
)
166 structure Word4
= EmbedWord8 (Primitive
.Word4
)
167 structure Word5
= EmbedWord8 (Primitive
.Word5
)
168 structure Word6
= EmbedWord8 (Primitive
.Word6
)
169 structure Word7
= EmbedWord8 (Primitive
.Word7
)
170 structure Word9
= EmbedWord16 (Primitive
.Word9
)
171 structure Word10
= EmbedWord16 (Primitive
.Word10
)
172 structure Word11
= EmbedWord16 (Primitive
.Word11
)
173 structure Word12
= EmbedWord16 (Primitive
.Word12
)
174 structure Word13
= EmbedWord16 (Primitive
.Word13
)
175 structure Word14
= EmbedWord16 (Primitive
.Word14
)
176 structure Word15
= EmbedWord16 (Primitive
.Word15
)
177 structure Word17
= EmbedWord32 (Primitive
.Word17
)
178 structure Word18
= EmbedWord32 (Primitive
.Word18
)
179 structure Word19
= EmbedWord32 (Primitive
.Word19
)
180 structure Word20
= EmbedWord32 (Primitive
.Word20
)
181 structure Word21
= EmbedWord32 (Primitive
.Word21
)
182 structure Word22
= EmbedWord32 (Primitive
.Word22
)
183 structure Word23
= EmbedWord32 (Primitive
.Word23
)
184 structure Word24
= EmbedWord32 (Primitive
.Word24
)
185 structure Word25
= EmbedWord32 (Primitive
.Word25
)
186 structure Word26
= EmbedWord32 (Primitive
.Word26
)
187 structure Word27
= EmbedWord32 (Primitive
.Word27
)
188 structure Word28
= EmbedWord32 (Primitive
.Word28
)
189 structure Word29
= EmbedWord32 (Primitive
.Word29
)
190 structure Word30
= EmbedWord32 (Primitive
.Word30
)
191 structure Word31
= EmbedWord32 (Primitive
.Word31
)