home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Moscow ML 1.42 / src / mosmllib / Int.mlp < prev    next >
Encoding:
Text File  |  1997-08-18  |  3.9 KB  |  126 lines  |  [TEXT/R*ch]
  1. (* Int -- new basis 1995-03-19, 1996-04-01 *)
  2.  
  3. type int = int
  4.  
  5. #include "../config/m.h"
  6. #ifdef SIXTYFOUR
  7. (* 64-bit architecture: *)
  8. val precision = SOME 63;
  9. val minInt    = SOME ~4611686018427387904;
  10. val maxInt    = SOME  4611686018427387903;
  11. #else
  12. (* 32-bit architecture: *)
  13. val precision = SOME 31;    
  14. val minInt    = SOME ~1073741824;
  15. val maxInt    = SOME  1073741823;
  16. #endif
  17.  
  18. local 
  19.     open StringCvt
  20.     (* Below, 48 = Char.ord #"0" and 55 = Char.ord #"A" - 10. *)
  21.     fun decval c = Char.ord c - 48;
  22.     fun hexval c = 
  23.     if #"0" <= c andalso c <= #"9" then Char.ord c - 48
  24.     else (Char.ord c - 55) mod 32;
  25.     fun prhex i = if i < 10 then Char.chr(i + 48) else Char.chr(i + 55)
  26.     fun skipWSget getc source = getc (dropl Char.isSpace getc source)
  27.  
  28.     fun conv radix i = 
  29.     let fun h 0 res = res
  30.           | h n res = h (n div radix) (prhex (n mod radix) :: res)
  31.         fun tostr n = h (n div radix) [prhex (n mod radix)]
  32.     in String.implode (if i < 0 then #"~" :: tostr (~i) else tostr i) end
  33. in
  34.     fun scan radix getc source =
  35.     let open StringCvt
  36.         val (isDigit, factor) = 
  37.         case radix of
  38.             BIN => (fn c => (#"0" <= c andalso c <= #"1"),  2)
  39.           | OCT => (fn c => (#"0" <= c andalso c <= #"7"),  8)
  40.           | DEC => (Char.isDigit,                          10)
  41.           | HEX => (Char.isHexDigit,                       16)
  42.         fun dig1 sgn NONE             = NONE
  43.           | dig1 sgn (SOME (c, rest)) = 
  44.         let fun digr res src = 
  45.             case getc src of
  46.             NONE           => SOME (sgn * res, src)
  47.               | SOME (c, rest) => 
  48.                 if isDigit c then 
  49.                 digr (factor * res + hexval c) rest
  50.                 else 
  51.                 SOME (sgn * res, src)
  52.         in if isDigit c then digr (hexval c) rest else NONE end        
  53.         fun getdigs sgn after0 inp = 
  54.         case dig1 sgn inp of
  55.             NONE => SOME(0, after0)
  56.           | res  => res
  57.         fun hexopt sgn NONE                 = NONE
  58.           | hexopt sgn (SOME(#"0", after0)) =
  59.         if radix <> HEX then getdigs sgn after0 (getc after0)
  60.         else
  61.             (case getc after0 of
  62.              NONE             => SOME(0, after0)
  63.                | SOME(#"x", rest) => getdigs sgn after0 (getc rest)
  64.                | SOME(#"X", rest) => getdigs sgn after0 (getc rest)
  65.                | inp              => getdigs sgn after0 inp)
  66.           | hexopt sgn inp = dig1 sgn inp
  67.         fun sign NONE                = NONE
  68.           | sign (SOME (#"~", rest)) = hexopt ~1 (getc rest)
  69.           | sign (SOME (#"-", rest)) = hexopt ~1 (getc rest)
  70.           | sign (SOME (#"+", rest)) = hexopt  1 (getc rest)
  71.           | sign inp                 = hexopt  1 inp
  72.     in sign (skipWSget getc source) end;
  73.         
  74.     fun fmt BIN = conv 2
  75.       | fmt OCT = conv 8
  76.       | fmt DEC = conv 10
  77.       | fmt HEX = conv 16
  78.  
  79.     (* It should hold that: toString = fmt DEC = conv 10 *)    
  80.     prim_val toString : int -> string = 1 "sml_string_of_int";
  81.  
  82.     val fromString = scanString (scan DEC)
  83. end
  84.  
  85. fun pow (x, n) = 
  86.     let fun h 0 res = res
  87.       | h i res = if i mod 2 = 0 then h (i div 2) (res * res)
  88.               else h (i-1) (x * res)
  89.     in 
  90.     if n < 0 then 
  91.         if x = 0 then raise Domain else 1 div (h (~n) 1)
  92.     else h n 1
  93.     end
  94.  
  95. val ~       : int -> int        = ~;
  96. val op *    : int * int -> int  = op *;
  97. val op div  : int * int -> int  = op div;
  98. val op mod  : int * int -> int  = op mod;
  99.  
  100. local 
  101.     prim_val quot_ : int -> int -> int = 2 "quot";
  102.     prim_val rem_  : int -> int -> int = 2 "rem"
  103. in
  104.     fun quot(x, y) = quot_ x y
  105.     fun rem(x, y)  = rem_ x y
  106. end
  107.  
  108. val op +    : int * int -> int  = op +;
  109. val op -    : int * int -> int  = op -;
  110. val op >    : int * int -> bool = op >;
  111. val op >=   : int * int -> bool = op >=;
  112. val op <    : int * int -> bool = op <;
  113. val op <=   : int * int -> bool = op <=;
  114. val abs     : int -> int = abs;
  115. fun min (x, y) = if x < y then x else y : int;
  116. fun max (x, y) = if x < y then y else x : int;
  117. fun sign i = if i > 0 then 1 else if i < 0 then ~1 else 0;
  118. fun compare (x, y: int) = if x<y then LESS else if x>y then GREATER else EQUAL;
  119.  
  120. fun sameSign (i, j) = sign i = sign j;
  121.  
  122. fun toInt   i   = i;
  123. fun fromInt i   = i;
  124. fun toLarge   i = i;
  125. fun fromLarge i = i;
  126.