Home My Page Projects Code Snippets Project Openings SML/NJ
 Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

# SCM Repository

[smlnj] Diff of /sml/trunk/src/smlnj-lib/Util/int-inf.sml
 [smlnj] / sml / trunk / src / smlnj-lib / Util / int-inf.sml

# Diff of /sml/trunk/src/smlnj-lib/Util/int-inf.sml

revision 754, Mon Dec 11 17:38:33 2000 UTC revision 755, Thu Dec 14 07:57:55 2000 UTC
# Line 630  Line 630
630
631        end (* structure BigNat *)        end (* structure BigNat *)
632
633
634      structure BN = BigNat      structure BN = BigNat
635
636      datatype sign = POS | NEG      datatype sign = POS | NEG
# Line 854  Line 855
855      fun log2 (BI{sign=POS,digits}) = BN.log2 digits      fun log2 (BI{sign=POS,digits}) = BN.log2 digits
856        | log2 _ = raise Domain        | log2 _ = raise Domain
857
858        (*-------------------------------------------------------------------
859         * Bit level operators are implemented here.
860         * Allen Leung
861         * Last Updated: 12/13/2000
862         *
863         * Note:
864         *  o  The base is 30 so there is no way that the sign bit is 1 after
865         *     andb, orb, or xorb.  But notb require a hack.
866         *  o  I use Word.word as the intermediate type for
867         *     computing results because the conversion back to int does not
868         *     require a range check.
869         *  o  Negative values are assumed to have an infinite number of
870         *     leading ones.
871         *-------------------------------------------------------------------*)
872        structure BitOps =
873        struct
874           structure W = Word
875           val i2w = W.fromInt
876           val w2i = W.toIntX
877           val op - = W.-
878
879           val base   = W.<<(0w1, i2w BN.lgBase)
880           val maxVal = W.-(base, 0w1)
881           fun stripSignBit w = W.andb(w, maxVal)
882
883           fun notb x = ~(x + one)
884
885           (* Internally we are store things in one's complement+sign form.
886            * But we have to simulate 2's complement arithmetic.
887            *)
888           fun binary (f,g) (BI{sign=sx,digits=xs}, BI{sign=sy,digits=ys}) =
889           let val sign = g(sx,sy)  (* sign of result, if non-zero *)
890
891                (* convert to two's complement;
892                 * Compute (- x - borrow)
893                 *)
894               fun twos(POS, x, borrow) = (x, 0w0)
895                 | twos(NEG, 0w0, 0w0) = (0w0, 0w0) (* no borrow *)
896                 | twos(NEG, x, borrow) =(base - x - borrow, 0w1) (* borrow *)
897
898               (* convert to ones's complement *)
899               val ones = twos
900
901               fun loop([], [], _, _, _) = []
902                 | loop([], y::ys, bx, by, bz)  =
903                        loop1(0w0, [], i2w y, ys, bx, by, bz)
904                 | loop(x::xs, [], bx, by, bz) =
905                        loop1(i2w x, xs, 0w0, [], bx, by, bz)
906                 | loop(x::xs, y::ys, bx, by, bz) =
907                        loop1(i2w x, xs, i2w y, ys, bx, by, bz)
908               and loop1(x, xs, y, ys, bx, by, bz) =
909                   let (* convert from ones complement *)
910                       val (x, bx) = twos(sx, x, bx)
911                       val (y, by) = twos(sy, y, by)
912                       val z  = f(x,y)
913                        (* convert back to ones complement *)
914                       val (z, bz) = ones(sign, z, bz)
915                       val z  = w2i z
916                       val zs = loop(xs, ys, bx, by, bz)
917                   in  case (z, zs) of  (* strip leading zero *)
918                         (0, []) => []
919                       | (z, zs) => z::zs
920                   end
921
922           in  case loop(xs, ys, 0w0, 0w0, 0w0) of
923                 []     => zero
924               | digits => BI{sign=sign, digits=digits}
925           end
926
927
928           val andb = binary (W.andb, fn (NEG,NEG) => NEG | _ => POS)
929           (* negative if any are negative *)
930           val orb  = binary (W.orb,  fn (POS,POS) => POS | _ => NEG)
931           (* negative if only one is negative *)
932           val xorb = binary (fn (x,y) => stripSignBit(W.xorb(x,y)),
933                              fn (NEG,POS) => NEG
934                               | (POS,NEG) => NEG
935                               | _         => POS)
936
937           fun shiftAmount(w) = {bytes=W.div(w, i2w BN.lgBase),
938                                 bits=W.mod(w, i2w BN.lgBase)}
939
940           (* left shift; just shift the digits, no special treatment for
941            * signed versus unsigned.
942            *)
943           fun <<(i as BI{digits=[],sign}, w) = i (* 0 << n = 0 *)
944             | <<(i as BI{digits,sign}, w) =
945           let val {bytes, bits} = shiftAmount w
946               fun pad(0w0, digits) = digits
947                 | pad(n, digits) = pad(n-0w1, 0::digits)
948           in  if bits = 0w0 then BI{sign=sign,digits=pad(bytes, digits)}
949               else
950                  let val shift = i2w BN.lgBase - bits
951                      fun shiftAll([], 0w0)   = []
952                        | shiftAll([], carry) = [w2i carry]
953                        | shiftAll(x::xs, carry) =
954                          let val x = i2w x
955                              val digit  =
956                                   stripSignBit(W.orb(carry, W.<<(x, bits)))
957                              val carry' = W.>>(x, shift)
958                          in  w2i digit::shiftAll(xs, carry')
959                          end
960                  in  BI{sign=sign,digits=shiftAll(pad(bytes, digits), 0w0)}
961                  end
962           end
963
964           (*
965            * Right shift
966            *)
967           fun ~>>(i as BI{digits=[],sign}, w) = i (* 0 ~>> n = n *)
968             | ~>>(i as BI{digits,sign}, w) =
969           let val {bytes, bits} = shiftAmount w
970               fun drop(0w0, i) = i
971                 | drop(n, []) = []
972                 | drop(n, x::xs) = drop(n-0w1, xs)
973               val digits =
974                  if bits = 0w0 then drop(bytes, digits)
975                  else
976                  let val shift = i2w BN.lgBase - bits
977                      fun shiftAll [] = ([], 0w0)
978                        | shiftAll(x::xs) =
979                          let val (zs, borrow) = shiftAll xs
980                              val x       = i2w x
981                              val z       = w2i(W.orb(borrow, W.>>(x, bits)))
982                              val borrow' = stripSignBit(W.<<(x, shift))
983                          in  case (z,zs) of
984                                (0, []) => ([], borrow') (* strip leading zero *)
985                              |  _ => (z::zs, borrow')
986                          end
987                      val (zs, _) = shiftAll(drop(bytes, digits))
988                  in  zs
989                  end
990           in  case digits of
991                 [] => zero
992               | _  => BI{digits=digits, sign=sign}
993           end
994
995        end
996
997
998        val notb   = BitOps.notb
999        val andb   = BitOps.andb
1000        val orb    = BitOps.orb
1001        val xorb   = BitOps.xorb
1002        val <<     = BitOps.<<
1003        val ~>>    = BitOps.~>>
1004
1005    end (* structure IntInf *)    end (* structure IntInf *)
1006

Legend:
 Removed from v.754 changed lines Added in v.755

 root@smlnj-gforge.cs.uchicago.edu ViewVC Help Powered by ViewVC 1.0.0