1230479Snetchild(* ------------------------------------------------------------------------- 2230479Snetchild Bitstring 3230479Snetchild ------------------------------------------------------------------------- *) 4230479Snetchild 5230479Snetchildstructure Bitstring :> Bitstring = 6230479Snetchildstruct 7230479Snetchild 8230479Snetchild infix 8 >>+ 9230479Snetchild 10230479Snetchild type bitstring = bool list 11230479Snetchild 12230479Snetchild val boolCompare = 13230479Snetchild fn (false, true) => General.LESS 14230479Snetchild | (true, false) => General.GREATER 15230479Snetchild | _ => General.EQUAL 16230479Snetchild 17230479Snetchild val compare = L3.listCompare boolCompare 18230479Snetchild 19230479Snetchild fun zero n = List.tabulate (Nat.toNativeInt n, fn _ => false) 20230479Snetchild fun one n = if n < 1 then [] else zero (n - 1) @ [true] 21230479Snetchild 22 val size: bitstring -> Nat.nat = Nat.fromNativeInt o List.length 23 24 local 25 fun iter a i = 26 if i <= 0 then a 27 else let 28 val (q, r) = IntInf.quotRem (i, 2) 29 in 30 iter ((r = 1) :: a) q 31 end 32 in 33 fun fromInt i = 34 if i < 0 35 then raise Domain 36 else if i = 0 37 then [false] 38 else iter [] i 39 end 40 41 val fromNativeInt = fromInt o IntInf.fromInt 42 43 val fromNat = fromInt o Nat.toInt 44 45 val toInt = List.foldl (fn (true, v) => 2 * v + 1 | (false, v) => 2 * v) 0 46 47 val toNat = Nat.fromInt o toInt 48 val toNativeInt = IntInf.toInt o toInt 49 50 val fromBool = fn x => [x] 51 52 fun fromBinString s = 53 (SOME o List.map (fn #"0" => false | #"1" => true | _ => raise Domain) o 54 String.explode) s 55 handle Domain => NONE 56 57 fun fromDecString s = 58 Option.map fromNat (Nat.fromString s) handle Domain => NONE 59 60 val hexBits = 61 fn #"0" => [false, false, false, false] 62 | #"1" => [false, false, false, true] 63 | #"2" => [false, false, true, false] 64 | #"3" => [false, false, true, true] 65 | #"4" => [false, true, false, false] 66 | #"5" => [false, true, false, true] 67 | #"6" => [false, true, true, false] 68 | #"7" => [false, true, true, true] 69 | #"8" => [true, false, false, false] 70 | #"9" => [true, false, false, true] 71 | #"a" => [true, false, true, false] 72 | #"b" => [true, false, true, true] 73 | #"c" => [true, true, false, false] 74 | #"d" => [true, true, false, true] 75 | #"e" => [true, true, true, false] 76 | #"f" => [true, true, true, true] 77 | _ => raise Domain 78 79 fun fromHexString s = 80 (SOME o List.concat o List.map (hexBits o Char.toLower) o 81 String.explode) s 82 handle Domain => NONE 83 84 fun fromLit s = 85 let 86 val v = String.extract (s, 1, NONE) 87 in 88 case String.sub (s, 0) of 89 #"d" => fromDecString v 90 | #"b" => fromBinString v 91 | #"x" => fromHexString v 92 | _ => NONE 93 end 94 95 val toBinString = String.implode o List.map (fn false => #"0" | true => #"1") 96 97 val toDecString = Nat.toString o toNat 98 99 val hexBits = 100 fn [false, false, false, false] => #"0" 101 | [false, false, false, true] => #"1" 102 | [false, false, true, false] => #"2" 103 | [false, false, true, true] => #"3" 104 | [false, true, false, false] => #"4" 105 | [false, true, false, true] => #"5" 106 | [false, true, true, false] => #"6" 107 | [false, true, true, true] => #"7" 108 | [true, false, false, false] => #"8" 109 | [true, false, false, true] => #"9" 110 | [true, false, true, false] => #"a" 111 | [true, false, true, true] => #"b" 112 | [true, true, false, false] => #"c" 113 | [true, true, false, true] => #"d" 114 | [true, true, true, false] => #"e" 115 | [true, true, true, true] => #"f" 116 | _ => raise Domain 117 118 val toHexString = 119 let 120 fun iter a = 121 fn [] => String.implode (List.rev a) 122 | l => iter (hexBits (List.take (l, 4)) :: a) (List.drop (l, 4)) 123 in 124 fn l => 125 let 126 val n = 4 - List.length l mod 4 127 val p = if n = 4 then [] else List.tabulate (n, fn _ => false) 128 in 129 iter [] (p @ l) 130 end 131 end 132 133 fun toList l = l 134 fun fromList l = l 135 136 fun op << (l, s) = l @ zero s 137 138 fun op >>+ (l, s) = List.take (l, List.length l - Nat.toNativeInt s) 139 handle General.Subscript => [] 140 141 fun op #>> (l, s) = 142 let 143 val n = List.length l 144 val x = n - (IntInf.toInt s) mod n 145 in 146 List.drop (l, x) @ List.take (l, x) 147 end 148 149 fun setSize s l = 150 let 151 val n = List.length l 152 in 153 if n < s 154 then zero (Nat.fromNativeInt (s - n)) @ l 155 else List.drop (l, n - s) 156 end 157 158 fun bits (h, l) = 159 let 160 val s = Nat.- (Nat.suc h, l) 161 in 162 fn b => 163 if s = Nat.zero then [false] 164 else setSize (Nat.toNativeInt s) (b >>+ l) 165 end 166 167 fun bit (a, n) = bits (n, n) a = [true] 168 169 fun modify (f: Nat.nat * bool -> bool) a = 170 #1 (List.foldr (fn (b, (l, i)) => (f (i, b) :: l, i + 1)) ([], 0) a) 171 172 fun bitFieldInsert (h,l) (x, y) = 173 modify (fn (i, b) => if Nat.<= (l, i) andalso Nat.<= (i, h) 174 then bit (y, Nat.- (i, l)) 175 else b) x 176 177 fun maxLength (l1, l2) = Int.max (List.length l1, List.length l2) 178 179 fun log2plus1 i = if i = 0 then 1 else IntInf.log2 i + 1 180 181 fun op + (l1, l2) = 182 let 183 val r = IntInf.+ (toInt l1, toInt l2) 184 in 185 setSize (Int.max (log2plus1 r, maxLength (l1, l2))) (fromInt r) 186 end 187 188 fun bitwise f = 189 let 190 val mapf = List.map f 191 in 192 fn (l1, l2) => 193 let 194 val m = maxLength (l1, l2) 195 in 196 mapf (ListPair.zip (setSize m l1, setSize m l2)) 197 end 198 end 199 200 val op || = bitwise (fn (a, b) => a orelse b) 201 val op && = bitwise (fn (a, b) => a andalso b) 202 val op ?? = bitwise (fn (a, b) => a = b) 203 204 val op @@ = op @ 205 206 fun replicate (a, n) = 207 if n = Nat.zero 208 then zero n 209 else List.foldl (op @@) a 210 (List.tabulate (Nat.toNativeInt n - 1, fn _ => a)) 211 212end (* structure Bitstring *) 213