1signature OUT_HIGH = 2sig 3 val outChar : char -> unit 4 val outStr : string -> unit (* the naked string *) 5 val outString : string -> unit (* the string preceded by its length *) 6 val outNat1 : int -> unit 7 val outNat2 : int -> unit 8 val outInt4 : int -> unit 9 val outZero : int -> unit 10 val outInstrV : int -> int -> unit 11end 12(*----------*) 13 14structure OutHigh: OUT_HIGH = 15struct 16 open Powers2 17 open Out 18 19 val byteSmall = Word8.fromInt 20 val byteChar = byteSmall o Char.ord 21 22 val outNat1 = outByte o byteSmall 23 val outChar = outByte o byteChar 24 25 val outStr = List.app outChar o String.explode 26 fun outString s = (outNat1 (String.size s); outStr s) 27 28 fun outZero 0 = () 29 | outZero n = (outNat1 0; outZero (n-1)) 30 31 fun outNat2 n = ( outNat1 (n div two8 ); outNat1 (n mod two8 ) ) 32 fun outNat3 n = ( outNat1 (n div two16); outNat2 (n mod two16) ) 33 34 (* The following differs from Knuth's method since SML's integers 35 have 31 Bits only *) 36 fun splitInt4 n = 37 if n >= 0 then (n div two24, n mod two24) 38 else let val n' = n + two29 39 val n'' = n' + two29 40 in ((n'' div two24) + two7 + two6, n'' mod two24) end 41 42 fun outInt4 n = 43 let val (n1, nr) = splitInt4 n 44 in outNat1 n1; outNat3 nr end 45 46 fun makeNat twoI n = if n>= 0 then n else n + twoI 47 48 fun outInstrV code n = 49 let fun Code l = outNat1 (code + l) in 50 if abs n >= two23 then ( Code 4; outInt4 n ) else 51 if abs n >= two15 then ( Code 3; outNat3 (makeNat two24 n) ) else 52 if abs n >= two7 then ( Code 2; outNat2 (makeNat two16 n) ) else 53 if n <> 0 then ( Code 1; outNat1 (makeNat two8 n) ) else () 54 end 55 56end 57