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

SCM Repository

[smlnj] View of /archive/mlprof.1/bignums/bitops.sml
ViewVC logotype

View of /archive/mlprof.1/bignums/bitops.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 4054 - (download) (annotate)
Wed Feb 4 20:42:42 2015 UTC (4 years, 5 months ago) by dbm
File size: 927 byte(s)
Initial import of archive (of early versions of sml/nj)
structure BitOps = struct

infix 5 << >>
infix 4 bit_and
infix 3 bit_or

fun pow2 0 = 1 | pow2 1 = 2 | pow2 2 = 4 | pow2 3 = 8
  | pow2 4 = 16 | pow2 5 = 32 | pow2 6 = 64 | pow2 7 = 128
  | pow2 n = 2*pow2(n-1)

fun num >> bits = if bits < 0 then num << ~bits else num div (pow2 bits)
and num << bits = if bits < 0 then num >> ~bits else num * (pow2 bits)

(* This should go in assembly one day
fun num >> 0 = num
  | num >> bits = (num div 2) >> (bits-1)
fun num << 0 = num
  | num << bits = (2*num) << (bits-1)
*)

fun 0 bit_and _ = 0
  | _ bit_and 0 = 0
  | 1 bit_and a = a mod 2
  | a bit_and 1 = a mod 2
  | a bit_and b = (a mod 2)*(b mod 2) + 2*(a>>1 bit_and b>>1)

fun 0 bit_or a = a
  | a bit_or 0 = a
  | a bit_or b =
      let val rest = (a>>1 bit_or b>>1)<<1
      in
          case (a mod 2,b mod 2) of
	        (1,_) => 1 + rest
	      | (_,1) => 1 + rest
	      | _ => rest
       end

end (* structure BitOps *)

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