home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Moscow ML 1.42 / src / mosmllib / Word8.sml < prev    next >
Encoding:
Text File  |  1997-08-18  |  5.4 KB  |  164 lines  |  [TEXT/R*ch]
  1. (* Word8 -- new basis 1994-11-01, 1995-04-12, 1996-09-30 *)
  2.  
  3. (* This unit relies on two's complement representation *)
  4.  
  5. type word = word8;
  6. val wordSize = 8;
  7.  
  8. (* Invariant for values w of type Word8.word: 0 <= toInt w < 256 *)
  9.  
  10. local
  11.     prim_val orb_       : word -> word -> word      = 2 "or";
  12.     prim_val andb_      : word -> word -> word      = 2 "and";
  13.     prim_val xorb_      : word -> word -> word      = 2 "xor";
  14.     prim_val lshift_    : word -> Word.word -> word = 2 "shift_left";
  15.     prim_val rshiftsig_ : word -> Word.word -> word = 2 "shift_right_signed";
  16.     prim_val rshiftuns_ : word -> Word.word -> word = 2 "shift_right_unsigned";
  17.     prim_val adduns_    : word -> word -> word      = 2 "+intunsig";
  18.     prim_val subuns_    : word -> word -> word      = 2 "-intunsig";
  19.     prim_val muluns_    : word -> word -> word      = 2 "*intunsig";
  20.  
  21.     prim_val fromInt_ : int -> word = 1 "identity";
  22.     prim_val largeWordToWord_ : Word.word -> word = 1 "identity";
  23.     fun norm w = andb_ w (fromInt_ 255);
  24.  
  25.     prim_val word2int   : Word.word -> int = 1 "identity";
  26. in
  27.     prim_val toInt : word -> int = 1 "identity";
  28.     fun toIntX w = if toInt w < 128 then (* msbit = 0 *)
  29.                    toInt w
  30.            else             (* msbit = 1 *)
  31.                toInt (orb_ w (fromInt_ ~256))
  32.     fun fromInt w  = norm (fromInt_ w);
  33.  
  34.     prim_val toLargeInt : word -> int = 1 "identity";
  35.     val toLargeIntX = toIntX
  36.     val fromLargeInt = fromInt
  37.  
  38.     prim_val toLargeWord   : word -> Word.word = 1 "identity";
  39.     fun toLargeWordX w = if toInt w < 128 then (* msbit = 0 *)
  40.                          toLargeWord w
  41.              else               (* msbit = 1 *)
  42.                  toLargeWord (orb_ w (fromInt_ ~256))
  43.     fun fromLargeWord w = norm(largeWordToWord_ w);
  44.  
  45.     fun orb (x, y)  = orb_ x y;
  46.     fun andb (x, y) = andb_ x y;
  47.     fun xorb (x, y) = xorb_ x y;
  48.     fun notb x      = norm (xorb_ x (fromInt_ ~1)); 
  49.  
  50.     fun << (w, k) = 
  51.     if word2int k >= 8 orelse word2int k < 0 then fromInt_ 0
  52.     else norm (lshift_ w k);
  53.  
  54.     fun >> (w, k) = 
  55.     if word2int k >= 8 orelse word2int k < 0 then fromInt_ 0
  56.     else rshiftuns_ w k;
  57.  
  58.     fun ~>> (w, k) = 
  59.     if toInt w < 128 then    (* msbit = 0: no sign to extend  *)
  60.         if word2int k >= 8 orelse word2int k < 0 then fromInt_ 0
  61.         else rshiftuns_ w k
  62.     else                (* msbit = 1: extend, then shift *)
  63.         if word2int k >= 8 orelse word2int k < 0 then 
  64.         norm (fromInt_ ~1)
  65.         else norm (rshiftsig_ (orb_ w (fromInt_ ~256)) k);
  66.  
  67.     local 
  68.       open StringCvt
  69.       fun skipWSget getc source = getc (skipWS getc source)
  70.  
  71.       (* Below, 48 = Char.ord #"0" and 55 = Char.ord #"A" - 10. *)
  72.       fun decval c = Char.ord c - 48;
  73.       fun hexval c = 
  74.       if #"0" <= c andalso c <= #"9" then 
  75.           Char.ord c - 48
  76.       else 
  77.           (Char.ord c - 55) mod 32;
  78.  
  79.       fun prhex i = 
  80.       if i < 10 then Char.chr(i + 48) else Char.chr(i + 55);
  81.  
  82.       fun conv radix w = 
  83.       let fun h n res = 
  84.           if n = 0 then res
  85.           else h (n div radix) (prhex (n mod radix) :: res)
  86.           fun tostr n = h (n div radix) [prhex (n mod radix)]
  87.       in String.implode (tostr (toInt w)) end
  88.  
  89.     in
  90.       fun scan radix getc source =
  91.       let open StringCvt
  92.           val source = skipWS getc source
  93.           val (isDigit, factor) = 
  94.           case radix of
  95.               BIN => (fn c => (#"0" <= c andalso c <= #"1"),  2)
  96.             | OCT => (fn c => (#"0" <= c andalso c <= #"7"),  8)
  97.             | DEC => (Char.isDigit,                          10)
  98.             | HEX => (Char.isHexDigit,                       16)
  99.           fun return res src = 
  100.           if res < 256 then SOME (fromInt_ res, src) 
  101.           else raise Overflow
  102.           fun dig1 NONE             = NONE
  103.         | dig1 (SOME (c, rest)) = 
  104.           let 
  105.               fun digr res src = 
  106.                   case getc src of
  107.                   NONE           => return res src
  108.                 | SOME (c, rest) => 
  109.                   if isDigit c then 
  110.                       digr(factor*res+hexval c) rest
  111.                   else 
  112.                       return res src
  113.           in 
  114.               if isDigit c then digr (hexval c) rest else NONE 
  115.           end
  116.           fun getdigs after0 src = 
  117.           case dig1 (getc src) of
  118.               NONE => return 0 after0
  119.             | res  => res
  120.           fun hexprefix after0 src =
  121.           if radix <> HEX then getdigs after0 src
  122.           else
  123.               case getc src of
  124.               SOME(#"x", rest) => getdigs after0 rest
  125.             | SOME(#"X", rest) => getdigs after0 rest
  126.             | SOME _           => getdigs after0 src
  127.             | NONE => return 0 after0
  128.       in 
  129.           case getc source of
  130.           SOME(#"0", after0) => 
  131.               (case getc after0 of 
  132.                SOME(#"w", src2) => hexprefix after0 src2 
  133.              | SOME _           => hexprefix after0 after0 
  134.              | NONE             => return 0 after0)
  135.         | SOME _ => dig1 (getc source)
  136.         | NONE   => NONE 
  137. end;
  138.  
  139.       fun fmt BIN = conv  2
  140.     | fmt OCT = conv  8
  141.     | fmt DEC = conv 10
  142.     | fmt HEX = conv 16
  143.       fun toString w   = conv 16 w
  144.       fun fromString s = scanString (scan HEX) s
  145.     end (* local for string functions *)
  146.  
  147.     (* Redefining +, -, *, div, and mod is a horrible idea ... *)
  148.  
  149.     fun w1  +  w2 = norm (adduns_ w1 w2);
  150.     fun w1  -  w2 = norm (subuns_ w1 w2);
  151.     fun w1  *  w2 = norm (muluns_ w1 w2);
  152.     val op div  : word * word -> word = op div;
  153.     val op mod  : word * word -> word = op mod;
  154.  
  155.     fun min(w1 : word, w2) = if w1 > w2 then w2 else w1;
  156.     fun max(w1 : word, w2) = if w1 > w2 then w1 else w2;
  157.     fun compare (x, y: word) = 
  158.     if x<y then LESS else if x>y then GREATER else EQUAL;
  159.     val op >    : word * word -> bool = op >;
  160.     val op >=   : word * word -> bool = op >=;
  161.     val op <    : word * word -> bool = op <;
  162.     val op <=   : word * word -> bool = op <=;
  163. end
  164.