Commit | Line | Data |
---|---|---|
7f918cf1 CE |
1 | (* Copyright (C) 2009 Matthew Fluet. |
2 | * Copyright (C) 1999-2006 Henry Cejtin, Matthew Fluet, Suresh | |
3 | * Jagannathan, and Stephen Weeks. | |
4 | * Copyright (C) 1997-2000 NEC Research Institute. | |
5 | * | |
6 | * MLton is released under a BSD-style license. | |
7 | * See the file MLton-LICENSE for details. | |
8 | *) | |
9 | ||
10 | functor FixIntInf(PIntInf: sig include INT_INF end) : INT_INF = | |
11 | struct | |
12 | open PIntInf | |
13 | local | |
14 | structure FIntInf = FixInt(struct open PIntInf end) | |
15 | in | |
16 | open FIntInf | |
17 | end | |
18 | ||
19 | (* SML/NJ doesn't properly shift IntInf.int values. *) | |
20 | local | |
21 | fun pow2 w = | |
22 | if w = 0wx0 | |
23 | then 1 | |
24 | else | |
25 | let | |
26 | val p = pow2 (Pervasive.Word.>> (w, 0wx1)) | |
27 | val pp = p * p | |
28 | in | |
29 | if 0wx1 = Pervasive.Word.andb (0wx1, w) | |
30 | then 2 * pp | |
31 | else pp | |
32 | end | |
33 | in | |
34 | val ~>> = fn (a, b) => a div (pow2 b) | |
35 | end | |
36 | end | |
37 | ||
38 | structure IntInf = FixIntInf(struct open Pervasive.IntInf end) |