( ARCHETYPICAL IMPLEMENTATION )
( OF THE SIEVE OF ERATOSTHENES )
( IN FORTH -- BIF, FIG --  )
( USING A LITTLE MORE )
( OF THE FORTH AND BIF IDIOMS. )
( COPYRIGHT 2015, 2019,
( JOEL MATTHEW REES )
( BY JOEL MATTHEW REES, )
( AMAGASAKI, JAPAN, 2015 )
( ALL RIGHTS RESERVED. )
( PERMISSION GRANTED BY THE )
( AUTHOR TO USE THIS CODE )
( FOR ANY PURPOSE,  )
( ON CONDITION THAT )
( SUBSTANTIAL USE  )
( SHALL RETAIN THIS COPYRIGHT )
( AND PERMISSION NOTICE. )

( PERL-ESQUE, TOO. )

VOCABULARY SIEVE-LOCAL 
( MAKE A LOCAL SYMBOL TABLE. )
SIEVE-LOCAL DEFINITIONS 
( SWITCH TO THE )
( LOCAL VOCABULARY. )


256 CONSTANT MAXSIEVE
MAXSIEVE 1 - 2 /
   CONSTANT FINALPASS
 -->


5 CONSTANT DISPWIDTH 
( ENOUGH DIGITS )
( TO DISPLAY MAXSIEVE )


0 VARIABLE SIEVE 
( OLD FORTHS DON'T PROVIDE A ) 
( DEFAULT BEHAVIOR FOR CREATE )
( NEW FORTHS WILL LEAVE )
( THE ZERO THERE. )
( OLD FORTHS NEED )
( AN INITIAL VALUE. )

( OLD FORTHS DON'T PROVIDE )
( A CELL WIDTH. )
  HERE SIEVE - DUP ( CELLWIDTH )

( ALLOCATE THE REST )
( OF THE BYTE ARRAY. )
  MAXSIEVE SWAP - ALLOT 

( NOW DEFINE THE CONSTANT: )
  CONSTANT CELLWIDTH 

: NOT-PRIME! ( ADR N -- )
+ 0 SWAP C! ;

: IS-PRIME? ( ADR N -- F )
+ C@ ;
  -->


: SIEVE-INIT ( ADR -- )
DUP 0 NOT-PRIME!      
DUP 1 NOT-PRIME!
( SET FLAGS TO TRUE )
( FOR 2 TO FINALPASS. )
2+ MAXSIEVE 2- -1 FILL    
 ;


: PRIME-PASS ( ADR PRIME -- )
(  DOUBLE IS FIRST MULTIPLE )
MAXSIEVE OVER DUP + DO    
   OVER I NOT-PRIME!    
   DUP +LOOP ( NEXT MULTIPLE )
DROP ;      

: FIND-PRIMES ( ADR -- )
FINALPASS 2 DO   
   DUP I IS-PRIME? IF 
      I PRIME-PASS
   ENDIF
LOOP ;           

-->








: COUNT-PRIMES ( ADR -- )
0 SWAP
MAXSIEVE 0 DO
   DUP I IS-PRIME? IF
      SWAP 1+ SWAP
   ENDIF
LOOP DROP
 ;


: PRINT-ALL ( ADR -- )
MAXSIEVE 0 DO
   I DISPWIDTH .R ." : IS "
   DUP I IS-PRIME? 0= IF
      ." NOT "
   ENDIF
   ." PRIME." CR
LOOP 
DROP ;


: PRINT-PRIMES ( ADR -- )
MAXSIEVE 0 DO
   DUP I IS-PRIME? 
   IF I . ENDIF
LOOP 
DROP CR ;
-->




BIF   DEFINITIONS

: SIEVEMAIN ( -- )
[ SIEVE-LOCAL ]
SIEVE SIEVE-INIT
SIEVE FIND-PRIMES
SIEVE PRINT-PRIMES CR
." COUNT: "
SIEVE COUNT-PRIMES . CR ;


SIEVEMAIN


( 8192: 8 SECONDS TO FIND )
( 3 TO COUNT )
( XROAR, NORMAL CLOCK )