2008-03-19 17:18:03 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								USING: kernel math sequences namespaces
							 | 
						
					
						
							
								
									
										
										
										
											2008-03-29 00:00:20 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								math.miller-rabin combinators.lib
							 | 
						
					
						
							
								
									
										
										
										
											2008-03-20 16:30:59 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								math.functions accessors random ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-03-19 17:18:03 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								IN: random.blum-blum-shub
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-04-07 20:28:54 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								! Blum Blum Shub, n = pq, x_i+1 = x_i ^ 2 mod n
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! return low bit of x+1
							 | 
						
					
						
							
								
									
										
										
										
											2008-03-19 17:18:03 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								TUPLE: blum-blum-shub x n ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-04-07 20:28:54 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								<PRIVATE
							 | 
						
					
						
							
								
									
										
										
										
											2008-03-19 17:18:03 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: generate-bbs-primes ( numbits -- p q )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    [ [ random-prime ] curry [ 4 mod 3 = ] generate ] dup bi ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-04-15 04:00:37 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: next-bbs-bit ( bbs -- bit )
							 | 
						
					
						
							
								
									
										
										
										
											2008-09-11 02:11:17 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    dup [ x>> 2 ] [ n>> ] bi ^mod [ >>x drop ] [ 1 bitand ] bi ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-04-15 04:00:37 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								PRIVATE>
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-03-19 17:18:03 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: <blum-blum-shub> ( numbits -- blum-blum-shub )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    generate-bbs-primes *
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    [ find-relative-prime ] keep
							 | 
						
					
						
							
								
									
										
										
										
											2008-04-13 16:06:27 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    blum-blum-shub boa ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-03-19 17:18:03 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-03-28 16:09:21 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								M: blum-blum-shub random-32* ( bbs -- r )
							 | 
						
					
						
							
								
									
										
										
										
											2008-04-07 20:28:54 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    0 32 rot
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    [ next-bbs-bit swap 1 shift bitor ] curry times ;
							 |