HCoop / hcoop / debian / mlton.git / blame
| Commit | Line | Data |
|---|---|---|
| 7f918cf1 CE |
1 | functor F (S: sig |
| 2 | type word | |
| 3 | ||
| 4 | val trials: word list | |
| 5 | val ~ : word -> word | |
| 6 | val fromInt: int -> word | |
| 7 | val max: word | |
| 8 | val rol: word * Word.word -> word | |
| 9 | val ror: word * Word.word -> word | |
| 10 | val toString: word -> string | |
| 11 | val wordSize: int | |
| 12 | val zero: word | |
| 13 | end) = | |
| 14 | struct | |
| 15 | open S | |
| 16 | ||
| 17 | val rots = List.tabulate (wordSize + 1, Word.fromInt) | |
| 18 | ||
| 19 | fun p w = print (concat [toString w, "\n"]) | |
| 20 | ||
| 21 | (* Test ~ *) | |
| 22 | val _ = List.app (p o ~) trials | |
| 23 | ||
| 24 | (* Test Algebraic simplifications. *) | |
| 25 | val _ = List.app (fn w => p (rol (w, 0w0))) trials | |
| 26 | val _ = List.app (fn w => p (ror (w, 0w0))) trials | |
| 27 | val _ = List.app (fn w => p (rol (w, Word.fromInt wordSize))) trials | |
| 28 | val _ = List.app (fn w => p (ror (w, Word.fromInt wordSize))) trials | |
| 29 | val _ = List.app (fn w => p (rol (zero, w))) [0w1, 0w2, 0w3] | |
| 30 | val _ = List.app (fn w => p (ror (zero, w))) [0w1, 0w2, 0w3] | |
| 31 | val _ = List.app (fn w => p (rol (max, w))) [0w1, 0w2, 0w3] | |
| 32 | val _ = List.app (fn w => p (ror (max, w))) [0w1, 0w2, 0w3] | |
| 33 | ||
| 34 | val _ = | |
| 35 | List.app | |
| 36 | (fn oper => | |
| 37 | List.app | |
| 38 | (fn w => List.app (fn w' => p (oper (w, w'))) rots) | |
| 39 | trials) | |
| 40 | [rol, ror] | |
| 41 | end | |
| 42 | ||
| 43 | structure Z = F (open Word MLton.Word | |
| 44 | val zero: word = 0w0 | |
| 45 | val max: word = 0wxFFFFFFFF | |
| 46 | val trials: word list = | |
| 47 | [0w0, 0w1, 0wxF, 0wx7F7F7F7F, 0wxFFFFFFFF]) | |
| 48 | structure Z = F (open Word8 MLton.Word8 | |
| 49 | val zero: word = 0w0 | |
| 50 | val max: word = 0wxFF | |
| 51 | val trials: word list = | |
| 52 | [0w0, 0w1, 0wxF, 0wx7F, 0wxFF]) | |
| 53 | ||
| 54 | ||
| 55 | (* Test unsigned addition and multiplication with overflow checking. *) | |
| 56 | (* val _ = | |
| 57 | * (MLton.Word.addCheck (0wxFFFFFFFF, 0wx1) | |
| 58 | * ; print "BUG\n") | |
| 59 | * handle Overflow => print "OK\n" | |
| 60 | * | |
| 61 | * fun doit (name, f, all) = | |
| 62 | * List.app | |
| 63 | * (fn (w, w') => | |
| 64 | * let | |
| 65 | * val _ = print (concat ["0x", Word.toString w, " ", name, " ", | |
| 66 | * "0x", Word.toString w']) | |
| 67 | * val res = f (w, w') | |
| 68 | * val _ = print (concat [" = ", Word.toString res, "\n"]) | |
| 69 | * in | |
| 70 | * () | |
| 71 | * end handle Overflow => print " --> Overflow\n") | |
| 72 | * all | |
| 73 | * | |
| 74 | * val _ = doit ("+", MLton.Word.addCheck, | |
| 75 | * [(0wx7FFFFFFF, 0wx1), | |
| 76 | * (0wxFFFFFFFE, 0wx1), | |
| 77 | * (0wxFFFFFFFD, 0wx2), | |
| 78 | * (0wxFFFFFFFF, 0wx1)]) | |
| 79 | * | |
| 80 | * val _ = doit ("*", MLton.Word.mulCheck, | |
| 81 | * [(0wxFFFFFFFF, 0wx1), | |
| 82 | * (0wx7FFFFFFF, 0wx2), | |
| 83 | * (0wx80000000, 0wx2), | |
| 84 | * (0wxFFFFFFFF, 0wx2)]) | |
| 85 | *) |