( 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 )
( GFORTH WILL LEAVE )
( THE ZERO THERE. )
( OLD FORTHS NEED )
( AN INITIAL VALUE. )

   HERE SIEVE -
( OLD FORTHS DON'T PROVIDE )
( A CELL WIDTH. )
   CONSTANT CELLWIDTH 
( TO SHOW HOW IT CAN BE DONE. )

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

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

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


: SIEVE-INIT ( ADR -- )
0 OVER C!      
( 0 IS NOT PRIME. )
0 OVER 1+ C!   
( 1 IS 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 -- )
." COUNT: " .
0 SWAP
MAXSIEVE 0 DO
   DUP I IS-PRIME? IF
      SWAP 1+ SWAP
   ENDIF
LOOP DROP CR
 ;


: 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 . ENDIF
LOOP 
DROP CR ;
-->




BIF   DEFINITIONS

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


SIEVEMAIN