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

SCM Repository

[smlnj] Annotation of /sml/trunk/src/compiler/MiscUtil/bignums/bigint.sml
ViewVC logotype

Annotation of /sml/trunk/src/compiler/MiscUtil/bignums/bigint.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 17 - (view) (download)
Original Path: sml/branches/SMLNJ/src/compiler/MiscUtil/bignums/bigint.sml

1 : monnier 16 (* Copyright 1989 by AT&T Bell Laboratories *)
2 :     structure Bigint :> BIGINT = struct
3 :    
4 :     type bigint = bool list
5 :    
6 :     fun bigint 0 = nil
7 :     | bigint i = let val x = i div 2
8 :     in (x+x<i)::bigint x
9 :     end
10 :    
11 :     fun adwc(false::ar, false::br, carry) = carry::adwc(ar,br,false)
12 :     | adwc(a::ar, false::br, false) = a::adwc(ar,br,false)
13 :     | adwc(false::ar, b::br, false) = b::adwc(ar,br,false)
14 :     | adwc(true::ar, true::br, carry) = carry::adwc(ar,br,true)
15 :     | adwc(a::ar, true::br, true) = a::adwc(ar,br,true)
16 :     | adwc(true::ar, b::br, true) = b::adwc(ar,br,true)
17 :     | adwc(nil, false::br, carry) = carry::adwc(nil,br,false)
18 :     | adwc(nil, b::br, false) = b::adwc(nil,br,false)
19 :     | adwc(nil, true::br, true) = false::adwc(nil,br,true)
20 :     | adwc(nil, nil, false) = nil
21 :     | adwc(nil, nil, true) = [true]
22 :     | adwc(a, nil, carry) = adwc(nil, a, carry)
23 :    
24 :     fun a + b = adwc(a,b,false)
25 :    
26 :     fun a * nil = nil
27 :     | (false::a) * b = a * (false::b)
28 :     | (true::a) * b = b + a * (false::b)
29 :     | nil * b = nil
30 :    
31 :     fun getbit(a::r, 0) = a
32 :     | getbit(_::r, i) = getbit(r,i-1)
33 :     | getbit(nil, i) = false
34 :    
35 :     fun >>(a,0) = a
36 :     | >>(a::r,i) = >>(r,i-1)
37 :     | >>(nil,i) = nil
38 :    
39 :     fun size x = length x
40 :    
41 :     end
42 :    
43 :     (*
44 :     * $Log: bigint.sml,v $
45 :     * Revision 1.2 1997/01/31 20:39:40 jhr
46 :     * Replaced uses of "abstraction" with opaque signature matching.
47 :     *
48 :     * Revision 1.1.1.1 1997/01/14 01:38:12 george
49 :     * Version 109.24
50 :     *
51 :     *)

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