require "big"

def is_prime(n)                           # P3 Prime Generator primality test
  return n | 1 == 3 if n < 5              # n: 0,1,4|false, 2,3|true
  return false if n.gcd(6) != 1           # for n a P3 prime candidate (pc)
  pc1, pc2 = -1, 1                        # use P3's prime candidates sequence
  until (pc1 += 6) > Math.sqrt(n).to_i    # pcs are only 1/3 of all integers
    return false if n % pc1 == 0 || n % (pc2 += 6) == 0  # if n is composite
  end
  true
end

def is_mersenne_prime(p)
  return true  if p == 2
  m_p = (1.to_big_i << p) - 1
  s = 4
  (p - 2).times { s = (s**2 - 2) % m_p }
  s == 0
end

precision = 20000   # maximum requested number of decimal places of 2 ** MP-1 #
long_bits_width = precision / Math.log(2) * Math.log(10)
upb_prime = (long_bits_width - 1).to_i // 2    # no unsigned #
upb_count = 45      # find 45 mprimes if int was given enough bits #

puts "Finding Mersenne primes in M[2..%d]:" % upb_prime

count = 0
(2..upb_prime).each do |p|
  if is_prime(p) && is_mersenne_prime(p)
    print "M%d " % p
    count += 1
  end
  break  if count >= upb_count
end
puts


import std.stdio, std.math, std.bigint;

bool isPrime(in uint p) pure nothrow @safe @nogc {
    if (p < 2 || p % 2 == 0)
        return p == 2;
    foreach (immutable i; 3 .. cast(uint)real(p).sqrt + 1)
        if (p % i == 0)
            return false;
    return true;
}

bool isMersennePrime(in uint p) pure nothrow /*@safe*/ {
    if (!p.isPrime)
        return false;
    if (p == 2)
        return true;
    immutable mp = (1.BigInt << p) - 1;
    auto s = 4.BigInt;
    foreach (immutable _; 3 .. p + 1)
        s = (s ^^ 2 - 2) % mp;
    return s == 0;
}

void main() {
    foreach (immutable p; 2 .. 2_300)
        if (p.isMersennePrime) {
            write('M', p, ' ');
            stdout.flush;
        }
}


function IsMersennePrime(p : Integer) : Boolean;
var
   i, s, m_p : Integer;
begin
   if p=2 then
      Result:=True
   else begin
      m_p := (1 shl p)-1;
      s := 4;
      for i:=3 to p do
         s:=(s*s-2) mod m_p;
      Result:=(s=0);
   end;
end;

const upperBound = Round(Log2(High(Integer))/2);

PrintLn('Finding Mersenne primes in M[2..' + IntToStr(upperBound) + ']: ');
Print('M2');

var p : Integer;
for p:=3 to upperBound step 2 do begin
   if IsMersennePrime(p) then
      Print(' M'+IntToStr(p));
end;
PrintLn('');


(require 'bigint)
(define (mersenne-prime? odd-prime: p)
	(define mp (1- (expt 2 p)))
	(define s #4)
	(for [(i (in-range 3 (1+ p)))]
		(set! s (% (- (* s s) 2) mp)))
	(when (zero? s) (printf "M%d" p)))

;; run it in the background
(require 'tasks)
(define LP (primes 10000)) ; list of candidate primes

(define (mp-task LP)
	(mersenne-prime? (first LP))
	(rest LP)) ;; return next state

(task-run (make-task mp-task LP))

→  M3 M5 M7 M13 M17 M19 M31 M61 M89 M107 M127 M521 M607 M1279 M2203 M2281


defmodule LucasLehmer do
  use Bitwise
  def test do
    for p <- 2..1300, p==2 or s(bsl(1,p)-1, p-1)==0, do: IO.write "M#{p} "
  end

  defp s(mp, 1), do: rem(4, mp)
  defp s(mp, n) do
    x = s(mp, n-1)
    rem(x*x-2, mp)
  end
end

LucasLehmer.test


PROGRAM LL_TEST

!$DOUBLE

PROCEDURE LUCAS_LEHMER(P%->RES)
     LOCAL I%,MP,SN
     IF P%=2 THEN RES%=TRUE EXIT PROCEDURE END IF
     IF (P% AND 1)=0 THEN RES%=FALSE EXIT PROCEDURE END IF
     MP=2^P%-1
     SN=4
     FOR I%=3 TO P% DO
        SN=SN^2-2
        SN-=(MP*INT(SN/MP))
     END FOR
     RES%=(SN=0)
END PROCEDURE

BEGIN
     PRINT("Mersenne Primes:")
     FOR P%=2 TO 23 DO
        LUCAS_LEHMER(P%->RES%)
        IF RES% THEN PRINT("M";P%) END IF
     END FOR
END PROGRAM


let rec s mp n =
  if n = 1 then 4I % mp else ((s mp (n - 1)) ** 2 - 2I) % mp

[ for p in 2..47 do
    if p = 2 || s ((1I <<< p) - 1I) (p - 1) = 0I then
      yield p ]


USING: io math.primes.lucas-lehmer math.ranges prettyprint
sequences ;

47 [1,b] [ lucas-lehmer ] filter
"Mersenne primes:" print
[ "M" write pprint bl ] each nl


: lucas-lehmer
  1+ 2 do
    4 i 2 <> * abs swap 1+ dup + 1- swap
    i 1- 1 ?do dup * 2 - over mod loop 0= if ." M" i . then
  loop cr
;

1 15 lucas-lehmer


Alternate version to handle 64 and 128 bit integers.

18 constant π-64  \ count of primes < 64
31 constant π-128 \ count of primes < 128

create primes
      2 c,  3 c,  5 c,  7 c, 11 c,  13 c,  17 c,  19 c,  23 c,  29 c,
     31 c, 37 c, 41 c, 43 c, 47 c,  53 c,  59 c,  61 c,  67 c,  71 c,
     73 c, 79 c, 83 c, 89 c, 97 c, 101 c, 103 c, 107 c, 109 c, 113 c,
    127 c,

\ Lucas-Lehmer single precision test for 64 bit integers.
\
: *mod  >r um* r> ud/mod 2drop ;
: 3rd  s" 2 pick" evaluate ; immediate
: 2^  1 swap lshift ;

: lucas-lehmer?  ( n -- n )
    dup 3 <
    if 2 =
    else
        dup 2^ 1- 4
        rot 2 do  dup 3rd *mod 2 -  loop 0= nip
    then ;

: .mersenne64 ( -- )
    primes π-64 bounds do
        i [email protected] lucas-lehmer?
        if 'M emit i [email protected] .  then
    loop ;

\ Lucas-Lehmer double precision test for 128 bit integers.
\
: 4dup  2over 2over ;
: 2-3rd  5 pick 5 pick ;
: d2^ ( n -- d )
    dup 64 <
    if    2^ 0
    else  0 swap 64 - 2^
    then ;
: d+mod ( d1 d2 d3 -- d ) \ d1 + d2 (mod d3); d1, d2 < d3
    2-3rd 2over 2swap d- \ d1 d2 d3 -- d1 d2 d3 d3-d1
    2-3rd d> \ if d2 < d3-d1 then don't subtract the modulus.
    if 2drop 0.
    then d- d+ ;
: d-even?  ( d -- f )
    drop 1 and 0= ;
: d*mod ( d1 d2 d3 -- d )
    2>r 0. \ result
    begin 2over d0> while
        2over d-even? invert  if  2-3rd [email protected] d+mod  then
        2swap d2/ 2swap
        2rot 2dup [email protected] d+mod 2rot 2rot
    repeat 2rdrop 2nip 2nip ;

: d-lucas-lehmer?  ( n -- n )
    dup 3 <
    if 2 =
    else
        dup d2^ 1. d- 4.
        4 roll 2 do  2dup 2-3rd d*mod 2. d-  loop d0= nip nip
    then ;

: .mersenne128 ( -- )
    primes π-128 bounds do
        i [email protected] d-lucas-lehmer?
        if 'M emit i [email protected] .  then
    loop ;


PROGRAM LUCAS_LEHMER
  IMPLICIT NONE

  INTEGER, PARAMETER :: i64 = SELECTED_INT_KIND(18)
  INTEGER(i64) :: s, n
  INTEGER :: i, exponent

  DO exponent = 2, 31
     IF (exponent == 2) THEN
        s = 0
     ELSE
        s = 4
     END IF
     n = 2_i64**exponent - 1
     DO i = 1, exponent-2
        s = MOD(s*s - 2, n)
     END DO
     IF (s==0) WRITE(*,"(A,I0,A)") "M", exponent, " is PRIME"
  END DO

END PROGRAM LUCAS_LEHMER


' version 18-09-2015
' compile with: fbc -s console

#Ifndef TRUE        ' define true and false for older freebasic versions
    #Define FALSE 0
    #Define TRUE Not FALSE
#EndIf

Function mul_mod(a As ULongInt, b As ULongInt, modulus As ULongInt) As ULongInt
    ' returns a * b mod modulus

    Dim As ULongInt x , y = a ' a mod modulus, but a is already smaller then modulus

    While b > 0
        If (b And 1) = 1 Then
            x = (x + y) Mod modulus
        End If
        y = (y Shl 1) Mod modulus
        b = b Shr 1
    Wend
    Return x

End Function

Function LLT(p As UInteger) As Integer

    Dim As ULongInt s = 4, m = 1
    m = m Shl p : m = m - 1       ' m = 2 ^ p - 1

    For i As Integer = 2 To p - 1
        s = mul_mod(s, s, m) - 2
    Next

    If s = 0 Then Return TRUE Else Return FALSE

End Function

' ------=< MAIN >=------

Dim As UInteger p

Print
' M2 can not be tested, we start with 3
for p = 3 To 63
    If LLT(p) = TRUE Then Print " M";Str(p);
Next

Print
' empty keyboard buffer
While Inkey <> "" : Wend
Print : Print "hit any key to end program"
Sleep
End


for n = primes[]
   if isPrime[2^n-1]
      println[n]


def mersenne( p ) =
  if p == 2 then return true

  var s = 4
  var M = 2^p - 1

  repeat p - 2
    s = (s*s - 2) mod M

  s == 0

import integers.primes

for p <- primes().filter( mersenne ).take( 20 )
  println( 'M' + p )


LucasLehmer := function(n)
    local i, m, s;
    if n = 2 then
        return true;
    elif not IsPrime(n) then
        return false;
    else
        m := 2^n - 1;
        s := 4;
        for i in [3 .. n] do
            s := RemInt(s*s, m) - 2;
        od;
        return s = 0;
    fi;
end;

Filtered([1 .. 2000], LucasLehmer);
[2, 3, 5, 7, 13, 17, 19, 31, 61, 89, 107, 127, 521, 607, 1279]


module Main
  where

main = printMersennes $ take 45 $ filter lucasLehmer $ sieve [2..]

s mp 1 = 4 `mod` mp
s mp n = ((s mp $ n-1)^2-2) `mod` mp

lucasLehmer 2 = True
lucasLehmer p = s (2^p-1) (p-1) == 0

printMersennes = mapM_ (\x -> putStrLn $ "M" ++ show x)


s = 0
DO exponent = 2, 31
  IF(exponent > 2) s = 4
  n = 2^exponent - 1
  DO i = 1, exponent-2
    s = MOD(s*s - 2, n)
  ENDDO
  IF(s == 0) WRITE(Messagebox) 'M', exponent, ' is prime;', n
ENDDO

END


import java.math.BigInteger;
public class Mersenne
{

    public static boolean isPrime(int p) {
        if (p == 2)
            return true;
        else if (p <= 1 || p % 2 == 0)
            return false;
        else {
            int to = (int)Math.sqrt(p);
            for (int i = 3; i <= to; i += 2)
                if (p % i == 0)
                    return false;
            return true;
        }
    }

    public static boolean isMersennePrime(int p) {
        if (p == 2)
            return true;
        else {
            BigInteger m_p = BigInteger.ONE.shiftLeft(p).subtract(BigInteger.ONE);
            BigInteger s = BigInteger.valueOf(4);
            for (int i = 3; i <= p; i++)
                s = s.multiply(s).subtract(BigInteger.valueOf(2)).mod(m_p);
            return s.equals(BigInteger.ZERO);
        }
    }

    // an arbitrary upper bound can be given as an argument
    public static void main(String[] args) {
        int upb;
        if (args.length == 0)
            upb = 500;
        else
            upb = Integer.parseInt(args[0]);

        System.out.print(" Finding Mersenne primes in M[2.." + upb + "]:\nM2 ");
        for (int p = 3; p <= upb; p += 2)
            if (isPrime(p) && isMersennePrime(p))
                System.out.print(" M" + p);
        System.out.println();
    }
}


////////// In JavaScript we don't have sqrt for BigInt - so here is implementation
    function newtonIteration(n, x0) {
        const x1 = ((n / x0) + x0) >> 1n;
        if (x0 === x1 || x0 === (x1 - 1n)) {
            return x0;
        }
        return newtonIteration(n, x1);
    }

    function sqrt(value) {
        if (value < 0n) {
            throw 'square root of negative numbers is not supported'
        }

        if (value < 2n) {
            return value;
        }
        return newtonIteration(value, 1n);
    }
////////// End of sqrt implementation

    function isPrime(p) {
        if (p == 2n) {
            return true;
        } else if (p <= 1n || p % 2n === 0n) {
            return false;
        } else {
            var to = sqrt(p);
            for (var i = 3n; i <= to; i += 2n)
            if (p % i == 0n) {
                return false;
            }
            return true;
        }
    }

    function isMersennePrime(p) {
        if (p == 2n) {
            return true;
        } else {
            var m_p = (1n << p) - 1n;
            var s = 4n;
            for (var i = 3n; i <= p; i++) {
                s = (s * s - 2n) % m_p;
            }
            return s === 0n;
        }
    }

    var  upb = 5000;
    var tm = Date.now();
    console.log(`Finding Mersenne primes in M[2..${upb}]:`);
    console.log('M2');
    for (var p = 3n; p <= upb; p += 2n){
        if (isPrime(p) && isMersennePrime(p)) {
            console.log("M" + p);
        }
    }
    console.log(`... Took: ${Date.now()-tm} ms`);


# To take advantage of gojq's arbitrary-precision integer arithmetic:
def power($b): . as $in | reduce range(0;$b) as $i (1; . * $in);

def is_prime:
  . as $n
  | if ($n < 2)         then false
    elif ($n % 2 == 0)  then $n == 2
    elif ($n % 3 == 0)  then $n == 3
    elif ($n % 5 == 0)  then $n == 5
    elif ($n % 7 == 0)  then $n == 7
    elif ($n % 11 == 0) then $n == 11
    elif ($n % 13 == 0) then $n == 13
    elif ($n % 17 == 0) then $n == 17
    elif ($n % 19 == 0) then $n == 19
    else {i:23}
         | until( (.i * .i) > $n or ($n % .i == 0); .i += 2)
	 | .i * .i > $n
    end;

# using the Lucac-Lehmer test for p>2, emit a stream of the form
# Mp:l where p is a Mersenne_prime and l is (p|tostring|length).
# 2^1 - 1 = 2 so we begin with M2:1.
def mersenne_primes:
  "M2:1",
  (range(3;infinite;2)
   | . as $i
   | select(is_prime)
   | . as $p
   | ((2 | power($p)) - 1) as $mp
   | select(0 == (reduce range(3; $p + 1) as $_ (4; (power(2) -2) % $mp) ) )
   |  "M\($i):\($mp|tostring|length)" );

mersenne_primes


using Primes

function getmersenneprimes(n)
    t1 = time()
    count = 0
    i = 2
    while(n > count)
        if(isprime(i) && ismersenneprime(2^BigInt(i) - 1))
            println("M$i, cumulative time elapsed: $(time() - t1) seconds")
            count += 1
        end
        i += 1
    end
end

getmersenneprimes(50)


// version 1.0.6

import java.math.BigInteger

const val MAX = 19

val bigTwo  = BigInteger.valueOf(2L)
val bigFour = bigTwo * bigTwo

fun isPrime(n: Int): Boolean {
    if (n < 2) return false
    if (n % 2 == 0) return n == 2
    if (n % 3 == 0) return n == 3
    var d : Int = 5
    while (d * d <= n) {
        if (n % d == 0) return false
        d += 2
        if (n % d == 0) return false
        d += 4
    }
    return true
}

fun main(args: Array<String>) {
    var count = 0
    var p = 3   // first odd prime
    var s: BigInteger
    var m: BigInteger
    while (true) {
        m = bigTwo.shiftLeft(p - 1) - BigInteger.ONE
        s = bigFour
        for (i in 1 .. p - 2) s = (s * s - bigTwo) % m
        if (s == BigInteger.ZERO) {
            count +=1
            print("M$p ")
            if (count == MAX) {
                println()
                break
            }
        }
        // obtain next odd prime
        while(true) {
            p += 2
            if (isPrime(p)) break
        }
    }
}


val .isPrime = f .i == 2 or
    .i > 2 and not any f(.x) .i div .x, pseries 2 to .i ^/ 2

val .isMersennePrime = f(.p) {
    if .p == 2: return true
    if not .isPrime(.p): return false

    val .mp = 2 ^ .p - 1
    for[.s=4] of 3 to .p {
        .s = (.s ^ 2 - 2) rem .mp
    } == 0
}

writeln join " ", map f $"M\.x;", where .isMersennePrime, series 2300


function [mNumber,mersennesPrime] = mersennePrimes()

    function isPrime = lucasLehmerTest(thePrime)

        llResidue = 4;
        mersennesPrime = (2^thePrime)-1;

        for i = ( 1:thePrime-2 )
            llResidue = mod( ((llResidue^2) - 2),mersennesPrime );
        end

        isPrime = (llResidue == 0);

    end

    %Because IEEE764 Double is the highest precision number we can
    %represent in MATLAB, the highest Mersenne Number we can test is 2^52.
    %In addition, because we have this cap, we can only test up to the
    %number 30 for Mersenne Primeness. When we input 31 into the
    %Lucas-Lehmer test, during the computation of the residue, the
    %algorithm multiplies two numbers together the result of which is
    %greater than 2^53. Because we require every digit to be significant,
    %this leads to an error. The Lucas-Lehmer test should say that M31 is a
    %Mersenne Prime, but because of the rounding error in calculating the
    %residues caused by floating-point arithmetic, it does not. So M30 is
    %the largest number we test.

    mNumber = (3:30);

    [isPrime] = arrayfun(@lucasLehmerTest,mNumber);

    mNumber = [2 mNumber(isPrime)];
    mersennesPrime = (2.^mNumber) - 1;

end


lucas_lehmer(p) := block([s, n, i],
   if not primep(p) then false elseif p = 2 then true else
   (s: 4,
   n: 2^p - 1,
   for i: 2 thru p - 1 do s: mod(s*s - 2, n),
   is(s = 0))
)$

sublist(makelist(i, i, 1, 200), lucas_lehmer);
/* [2, 3, 5, 7, 13, 17, 19, 31, 61, 89, 107, 127] */


MODULE LucasLehmer EXPORTS Main;

IMPORT IO, Fmt, Long;

PROCEDURE Mersenne(p: CARDINAL): BOOLEAN =
  VAR
    s := 4L;
    m := Long.Shift(1L, p) - 1L; (* 2^p - 1 *)
  BEGIN
    IF p = 2 THEN
      RETURN TRUE;
    ELSE
      FOR i := 3 TO p DO
        s := (s * s - 2L) MOD m;
      END;
      RETURN s = 0L;
    END;
  END Mersenne;

BEGIN
  FOR i := 2 TO 63 DO
    IF Mersenne(i) THEN
      IO.Put("M" & Fmt.Int(i) & " ");
    END;
  END;
  IO.Put("\n");
END LucasLehmer.


import math

proc isPrime(a: int): bool =
  if a == 2: return true
  if a < 2 or a mod 2 == 0: return false
  for i in countup(3, int sqrt(float a), 2):
    if a mod i == 0:
      return false
  return true

proc isMersennePrime(p: int): bool =
  if p == 2: return true
  let mp = (1'i64 shl p) - 1
  var s = 4'i64
  for i in 3 .. p:
    s = (s * s - 2) mod mp
  result = s == 0

let upb = int((log2 float int64.high) / 2)
echo " Mersenne primes:"
for p in 2 .. upb:
  if isPrime(p) and isMersennePrime(p):
    stdout.write " M",p
echo ""


%% compile : ozc -x <file.oz>
functor
import
  Application
  System
define

  fun {Arg Idx Default}
    Cmd = {Application.getArgs plain}
    Len = {Length Cmd}
  in
    if Len < Idx then
      Default
    else
      {StringToInt {Nth Cmd Idx}}
    end
  end

  fun {LLtest N}
    Mp = {Pow 2 N} - 1
    fun {S K} X T
    in
      if K == 1 then 4
      else
        T = {S K-1}
        X = T * T - 2
        X mod Mp
      end
    end
  in
    if N == 2 then
      true
    else
      {S N-1} == 0
    end
  end

  proc {FindLL X}
    fun {Sieve Ls}
      case Ls of nil then nil
      [] X|Xs then
        fun {DIV M} M mod X \= 0  end
      in
        X|{Sieve {Filter Xs DIV}}
      end
    end
  in
    if {IsList X} then
      case X of nil then skip
      [] M|Ms then
        {System.printInfo "M"#M#" "}
        {FindLL Ms}
      end
    else
      {FindLL {Filter {Sieve 2|{List.number 3 X 2}} LLtest}}
    end
  end

  Num = {Arg 1 607}

  {FindLL Num}

  {Application.exit 0}
end


Program LucasLehmer(output);
var
  s, n: int64;
  i, exponent: integer;
begin
  n := 1;
  for exponent := 2 to 31 do
  begin
    if exponent = 2 then
      s := 0
    else
      s := 4;
    n := (n + 1)*2 - 1;  // This saves from needing the math unit for exponentiation
    for i := 1 to exponent-2 do
      s := (s*s - 2) mod n;
    if s = 0 then
      writeln('M', exponent, ' is PRIME!');
  end;
end.


use Math::GMP qw/:constant/;

sub is_prime { Math::GMP->new(shift)->probab_prime(12); }

sub is_mersenne_prime {
  my $p = shift;
  return 1 if $p == 2;
  my $mp = 2 ** $p - 1;
  my $s = 4;
  $s = ($s * $s - 2) % $mp  for 3..$p;
  $s == 0;
}

foreach my $p (2 .. 43_112_609) {
  print "M$p\n" if is_prime($p) && is_mersenne_prime($p);
}


with javascript_semantics
bool full = true -- (see extended output below)
constant limit = iff(full?20:23)

include mpfr.e

function mersenne(integer p)
    if p = 2 then return true end if
    if not is_prime(p) then return false end if
    mpz s := mpz_init(4),
        m := mpz_init(),
        r = mpz_init()
    mpz_ui_pow_ui(m, 2, p)
    mpz_sub_si(m,m,1)
    for i=3 to p do
        mpz_mul(s,s,s)
        mpz_sub_si(s,s,2)
--      mpz_mod(s,s,m)
        if mpz_sign(s) < 0 then
            mpz_add(s, s ,m)
        else
            mpz_tdiv_r_2exp(r, s, p)
            mpz_tdiv_q_2exp(s, s, p)
            mpz_add(s, s, r)
        end if
        if (mpz_cmp(s, m) >= 0) then mpz_sub(s, s, m) end if
    end for
    bool res = mpz_cmp_si(s,0)=0
    {s,m,r} = mpz_free({s,m,r})
    return res
end function

atom t0 = time(), t1 = t0
integer i=2, j = 1, count = 0
constant mersennes = {1279, 2203, 2281, 3217, 4253, 4423, 9689, 9941, 11213, 19937, 21701,
                      23209, 44497, 86243, 110503, 132049, 216091, 756839, 859433, 1257787,
                      1398269, 2976221, 3021377, 6972593, 13466917, 20996011, 24036583,
                      25964951, 30402457, 32582657, 37156667, 42643801, 43112609}

while count<limit do
    if mersenne(i) then
        count += 1
        string e = iff(time()-t1<0.1?"",", "&elapsed(time()-t1))
        printf(1,"M%d (%d%s)\n",{i,count,e})
        t1 = time()
    end if
    if full or i<1000 then
        i += 1
    else
        i = mersennes[j]
        j += 1
    end if
end while
printf(1,"completed in %s\n",{elapsed(time()-t0)})


define Lucas_Lehmer_Test(p);
   lvars mp = 2**p - 1, sn = 4, i;
   for i from 2 to p - 1 do
       (sn*sn - 2) rem mp -> sn;
   endfor;
   sn = 0;
enddefine;

lvars p = 3;
printf('M2', '%p\n');
while p < 1000 do
   if Lucas_Lehmer_Test(p) then
       printf('M', '%p');
       printf(p, '%p\n');
   endif;
   p + 2 -> p;
endwhile;


function Get-MersennePrime ([bigint]$Maximum = 4800)
{
    [bigint]$n = [bigint]::One

    for ($exp = 2; $exp -lt $Maximum; $exp++)
    {
        if ($exp -eq 2)
        {
            $s = 0
        }
        else
        {
            $s = 4
        }

        $n = ($n + 1) * 2 - 1

        for ($i = 1; $i -le $exp - 2; $i++)
        {
            $s = ($s * $s - 2) % $n
        }

        if ($s -eq 0)
        {
            $exp
        }
    }
}


show(Count) :-
    findall(N, limit(Count, (between(2, infinite, N), mersenne_prime(N))), S),
    forall(member(P, S), (write(P), write(" "))), nl.

lucas_lehmer_seq(M, L) :-
    lazy_list(ll_iter, 4-M, L).

ll_iter(S-M, T-M, T) :-
    T is ((S*S) - 2) mod M.

drop(N, Lz1, Lz2) :-
    append(Pfx, Lz2, Lz1), length(Pfx, N), !.

mersenne_prime(2).
mersenne_prime(P) :-
    P > 2,
    prime(P),
    M is (1 << P) - 1,
    lucas_lehmer_seq(M, Residues),
    Skip is P - 3, drop(Skip, Residues, [R|_]),
    R =:= 0.

% check if a number is prime
%
wheel235(L) :-
   W = [4, 2, 4, 2, 4, 6, 2, 6 | W],
   L = [1, 2, 2 | W].

prime(N) :-
   N >= 2,
   wheel235(W),
   prime(N, 2, W).

prime(N, D, _) :- D*D > N, !.
prime(N, D, [A|As]) :-
    N mod D =\= 0,
    D2 is D + A, prime(N, D2, As).


Procedure Lucas_Lehmer_Test(p)
  Protected mp.q = (1 << p) - 1, sn.q = 4, i
  For i = 3 To p
    sn = (sn * sn - 2) % mp
  Next
  If sn = 0
    ProcedureReturn #True
  EndIf
  ProcedureReturn #False
EndProcedure

#upperBound = SizeOf(Quad) * 8 - 1 ;equivalent to significant bits in a signed quad integer
If OpenConsole()
  Define p = 3
  PrintN("M2")
  While p <= #upperBound
    If Lucas_Lehmer_Test(p)
      PrintN("M" + Str(p))
    EndIf
    p + 2
  Wend

  Print(#CRLF$ + #CRLF$ + "Press ENTER to exit"): Input()
  CloseConsole()
EndIf


from sys import stdout
from math import sqrt, log

def is_prime ( p ):
  if p == 2: return True # Lucas-Lehmer test only works on odd primes
  elif p <= 1 or p % 2 == 0: return False
  else:
    for i in range(3, int(sqrt(p))+1, 2 ):
      if p % i == 0: return False
    return True

def is_mersenne_prime ( p ):
  if p == 2:
    return True
  else:
    m_p = ( 1 << p ) - 1
    s = 4
    for i in range(3, p+1):
      s = (s ** 2 - 2) % m_p
    return s == 0

precision = 20000   # maximum requested number of decimal places of 2 ** MP-1 #
long_bits_width = precision * log(10, 2)
upb_prime = int( long_bits_width - 1 ) / 2    # no unsigned #
upb_count = 45      # find 45 mprimes if int was given enough bits #

print (" Finding Mersenne primes in M[2..%d]:"%upb_prime)

count=0
for p in range(2, int(upb_prime+1)):
  if is_prime(p) and is_mersenne_prime(p):
    print("M%d"%p),
    stdout.flush()
    count += 1
  if count >= upb_count: break
print


# vectorized approach based on scalar code from primeSieve and mersenne in CRAN package `numbers`
require(gmp)
n <- 4423  # note that the sieve below assumes n > 9

# sieve the set of primes up to n
p <- seq(1, n, by = 2)
q <- length(p)
p[1] <- 2
for (k in seq(3, sqrt(n), by = 2))
  if (p[(k + 1)/2] != 0)
    p[seq((k * k + 1)/2, q, by = k)] <- 0
p <- p[p > 0]
cat(p[1]," special case M2 == 3\n")
p <- p[-1]

z2 <- gmp::as.bigz(2)
z4 <- z2 * z2
zp <- gmp::as.bigz(p)
zmp <- z2^zp - 1
S <- rep(z4, length(p))

for (i in 1:(p[length(p)] - 2)){
  S <- gmp::mod.bigz(S * S - z2, zmp)
  if( i+2 == p[1] ){
    if( S[1] == 0 ){
      cat( p[1], "\n")
      flush.console()
    }
    p <-  p[-1]
    zmp <- zmp[-1]
    S <-  S[-1]
  }
}


#lang racket
(require math)

(define (mersenne-prime? p)
  (divides? (- (expt 2 p) 1) (S (- p 1))))

(define (S n)
  (if (= n 1) 4 (- (sqr (S (- n 1))) 2)))

(define (loop p)
  (when (mersenne-prime? p)
    (displayln p))
  (loop (next-prime p)))

(loop 3)


multi is_mersenne_prime(2) { True }
multi is_mersenne_prime(Int $p) {
    my $m_p = 2 ** $p - 1;
    my $s = 4;
    $s = $s.expmod(2, $m_p) - 2 for 3 .. $p;
    !$s
}

.say for (2,3,5,7 … *).hyper(:8degree).grep( *.is-prime ).map: { next unless .&is_mersenne_prime; "M$_" };


/*REXX pgm uses the Lucas─Lehmer primality test for prime powers of 2  (Mersenne primes)*/
@.=0; @.2=1; @.3=1; @.5=1; @.7=1; @.11=1; @.13=1 /*a partial list of some low primes.   */
!.[email protected].;  !.0=1; !.2=1; !.4=1; !.5=1; !.6=1; !.8=1 /*#'s with these last digs aren't prime*/
parse arg limit .                                /*obtain optional arguments from the CL*/
if limit==''  then limit= 200                    /*Not specified?  Then use the default.*/
say center('Mersenne prime index list',70-3,"═") /*show a fancy─dancy header (or title).*/
say  right('M'2, 25)      " [1 decimal digit]"   /*left─justify them to align&look nice.*/
                                                 /* [►] note that J==1 is a special case*/
         do j=1  by 2  to limit                  /*there're only so many hours in a day.*/
         power= j + (j==1)                       /*POWER ≡ J    except   for when  J=1. */
         if \isPrime(power)  then iterate        /*if POWER isn't prime, then ignore it.*/
         $= LL2(power)                           /*perform the Lucas─Lehmer 2 (LL2) test*/
         if $==''            then iterate        /*Did it flunk LL2?   Then skip this #.*/
         say  right($, 25)   MPsize              /*left─justify them to align&look nice.*/
         end   /*j*/
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
isPrime: procedure expose !. @.                  /*allow 2 stemmed arrays to be accessed*/
         parse arg  x    ''  -1  z               /*obtain variable   X   and last digit.*/
         if @.x      then return 1               /*is  X  already found to be a prime?  */
         if !.z      then return 0               /*is last decimal digit even or a five?*/
         if x//3==0  then return 0               /*divisible by three?  Then not a prime*/
         if x//7==0  then return 0               /*divisible by seven?    "   "  "   "  */
                do j=11  by 6   until j*j > x    /*ensures that J isn't divisible by 3. */
                if x //  j   ==0  then return 0  /*Is X divisible by  J   ?             */
                if x // (j+2)==0  then return 0  /* " "     "      "  J+2 ?         ___ */
                end   /*j*/                      /* [↑]  perform  DO  loop through √ x  */
         @.x=1;                         return 1 /*indicate number  X  is a prime.      */
/*──────────────────────────────────────────────────────────────────────────────────────*/
LL2: procedure expose MPsize;    parse arg ?     /*Lucas─Lehmer test on    2**?  -  1   */
     if ?==2  then s=0                           /*handle special case for an even prime*/
              else s=4                           /* [↓]  same as NUMERIC FORM SCIENTIFIC*/
     numeric form;               q= 2**?         /*ensure correct form for REXX numbers.*/
           /*╔═══════════════════════════════════════════════════════════════════════════╗
           ╔═╝ Compute a power of 2 using only 9 decimal digits.  One million digits     ║
           ║ could be used, but that really slows up computations.  So, we start with the║
           ║ default of 9 digits, and then find the ten's exponent in the product (2**?),║
           ║ double it,  and then add 6.    {2  is all that's needed,  but  6  is a lot  ║
           ║ safer.}   The doubling is for the squaring of   S    (below, for  s*s).   ╔═╝
           ╚═══════════════════════════════════════════════════════════════════════════╝*/
     if pos('E', q)\==0  then do                 /*is number in exponential notation ?  */
                                  parse var q 'E' tenPow            /*get the exponent. */
                                  numeric digits  tenPow * 2 + 6    /*expand precision. */
                              end                                   /*REXX used dec FP. */
                         else numeric digits    digits() * 2 + 6    /*use 9*2 + 6 digits*/
     q=2**? - 1                                  /*compute a power of two,  minus one.  */
        r= q // 8                                /*obtain   Q   modulus  eight.         */
     if r==1 | r==7  then nop                    /*before crunching, do a simple test.  */
                     else return ''              /*modulus   Q   isn't one  or  seven.  */
                 do ?-2;       s= (s*s -2) // q  /*lather,  rinse,  repeat   ···        */
                 end                             /* [↑]   compute and test for a  MP.   */
     if s\==0  then return ''                    /*Not a Mersenne prime?  Return a null.*/
     sz= length(q)                               /*obtain number of decimal digs in MP. */
     MPsize=' ['sz      "decimal digit"s(sz)']'  /*define a literal to display after MP.*/
                    return 'M'?                  /*return "modified" # (Mersenne index).*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
s:   if arg(1)==1  then return arg(3);  return word(arg(2) 's', 1)   /*simple pluralizer*/


see "Mersenne Primes :" + nl
for p = 2 to 18
    if lucasLehmer(p) see "M"  + p + nl ok
next

func lucasLehmer p
     i = 0 mp = 0 sn = 0
     if p = 2 return true ok
     if (p and 1) = 0 return false ok
     mp = pow(2,p) - 1
     sn = 4
     for i = 3 to p
         sn = pow(sn,2) - 2
         sn -= (mp * floor(sn / mp))
     next
     return (sn=0)


%%HP: T(3)A(R)F(.);                                                          ; ASCII transfer header
\<< DUP LN DUP \pi * 4 SWAP / 1 + UNROT / * IP 2 { 2 } ROT 2 SWAP            ; input n; n := Int(n/ln(n)*(1 + 4/(pi*ln(n)))), p:=2; (n ~ number of primes less then n, pi used here only as a convenience),  2 is assumed to be the 1st elemente in the list
  START SWAP NEXTPRIME DUP UNROT DUP 2 SWAP ^ 1 - 4 PICK3 2 - 1 SWAP         ; for i := 2 to n,  p := nextprime;  s := 4; m := 2^p - 1;
    START SQ 2 - OVER MOD                                                    ;   for j := 1 to p - 2;  s := s^2 mod m;
    NEXT NIP NOT { + } { DROP } IFTE                                         ;   next j;  if s = 0 then add p to the list else discard p;
  NEXT NIP                                                                   ; next i;
\>>


def is_prime ( p )
  return true  if p == 2
  return false if p <= 1 || p.even?
  (3 .. Math.sqrt(p)).step(2) do |i|
    return false  if p % i == 0
  end
  true
end

def is_mersenne_prime ( p )
  return true  if p == 2
  m_p = ( 1 << p ) - 1
  s = 4
  (p-2).times { s = (s ** 2 - 2) % m_p }
  s == 0
end

precision = 20000   # maximum requested number of decimal places of 2 ** MP-1 #
long_bits_width = precision / Math.log(2) * Math.log(10)
upb_prime = (long_bits_width - 1).to_i / 2    # no unsigned #
upb_count = 45      # find 45 mprimes if int was given enough bits #

puts " Finding Mersenne primes in M[2..%d]:" % upb_prime

count = 0
for p in 2..upb_prime
  if is_prime(p) && is_mersenne_prime(p)
    print "M%d " % p
    count += 1
  end
  break  if count >= upb_count
end
puts


extern crate rug;
extern crate primal;

use rug::Integer;
use rug::ops::Pow;
use std::thread::spawn;

fn is_mersenne (p : usize) {
    let p = p as u32;
    let mut m = Integer::from(1);
    m = m << p;
    m = Integer::from(&m - 1);
    let mut flag1 = false;
    for k in 1..10_000 {
        let mut flag2 = false;
        let mut div : u32 = 2*k*p + 1;
        if &div >= &m {break; }
        for j in [3,5,7,11,13,17,19,23,29,31,37].iter() {
            if div % j == 0 {
                flag2 = true;
                break;
            }
        }
        if flag2 == true {continue;}
        if div % 8 != 1 && div % 8 != 7 { continue; }
        if m.is_divisible_u(div) {
            flag1 = true;
            break;
        }
    }
    if flag1 == true {return ()}
    let mut s = Integer::from(4);
    let two = Integer::from(2);
    for _i in 2..p {
		let mut sqr = s.pow(2);
		s = Integer::from(&Integer::from(&sqr & &m) + &Integer::from(&sqr >> p));
		if &s >= &m {s = s - &m}
		s = Integer::from(&s - &two);
    }
	if s == 0 {println!("Mersenne : {}",p);}
}

fn main () {
    println!("Mersenne : 2");
    let limit = 11_214;
    let mut thread_handles = vec![];
    for p in primal::Primes::all().take_while(|p| *p < limit) {
        thread_handles.push(spawn(move || is_mersenne(p)));
    }
    for handle in thread_handles {
        handle.join().unwrap();
    }
}


object LLT extends App {
  import Stream._

  def primeSieve(s: Stream[Int]): Stream[Int] =
    s.head #:: primeSieve(s.tail filter { _ % s.head != 0 })
  val primes = primeSieve(from(2))

  def mersenne(p: Int): BigInt = (BigInt(2) pow p) - 1

  def s(mp: BigInt, p: Int): BigInt = { if (p == 1) 4 else ((s(mp, p - 1) pow 2) - 2) % mp }

  val upbPrime = 9941
  println(s"Finding Mersenne primes in M[2..$upbPrime]")
  ((primes takeWhile (_ <= upbPrime)).par map { p => (p, mersenne(p)) }
    map { p => if (p._1 == 2) (p, 0) else (p, s(p._2, p._1 - 1)) } filter { _._2 == 0 })
    .foreach { p =>
      println(s"prime M${(p._1)._1}: " +
        { if ((p._1)._1 < 200) (p._1)._2 else s"(${(p._1)._2.toString.size} digits)" })
    }
  println("That's All Folks!")
}


;;;The heart of the algorithm
(define (S n)
  (let ((m (- (expt 2 n) 1)))
    (let loop ((c (- n 2)) (a 4))
      (if (zero? c)
          a
          (loop (- c 1) (remainder (- (* a a) 2) m))))))

(define (mersenne-prime? n)
  (if (= n 2)
    #t
    (zero? (S n))))

;;;Trivial unoptimized implementation for the base primes
(define (next-prime x)
  (if (prime? (+ x 1))
      (+ x 1)
      (next-prime (+ x 1))))

(define (prime? x)
  (let loop ((c 2))
    (cond ((>= c x) #t)
          ((zero? (remainder x c)) #f)
          (else (loop (+ c 1))))))

;;Main loop
(let loop ((i 45) (p 2))
  (if (not (zero? i))
      (if (mersenne-prime? p)
          (begin
            (display "M") (display p) (display " ")
            (loop (- i 1) (next-prime p)))
          (loop i (next-prime p)))))


  iexpmax=30
  n=1
  for iexp=2:iexpmax
      if iexp==2 then s=0; else s=4; end
      n=(n+1)*2-1
      for i=1:iexp-2
          s=modulo((s*s-2),n)
      end
      if s==0 then printf("M%d ",iexp); end
  end


$ include "seed7_05.s7i";
  include "bigint.s7i";

const func boolean: isPrime (in integer: number) is func
  result
    var boolean: prime is FALSE;
  local
    var integer: upTo is 0;
    var integer: testNum is 3;
  begin
    if number = 2 then
      prime := TRUE;
    elsif number rem 2 = 0 or number <= 1 then
      prime := FALSE;
    else
      upTo := sqrt(number);
      while number rem testNum <> 0 and testNum <= upTo do
        testNum +:= 2;
      end while;
      prime := testNum > upTo;
    end if;
  end func;

const func boolean: lucasLehmerTest (in integer: p) is func
  result
    var boolean: prime is TRUE;
  local
    var bigInteger: m_p is 0_;
    var bigInteger: s is 4_;
    var integer: i is 0;
  begin
    if p <> 2 then
      m_p := 2_ ** p - 1_;
      for i range 2 to pred(p) do
        s := (s ** 2 - 2_) rem m_p;
      end for;
      prime := s = 0_;
    end if;
  end func;

const proc: main is func
  local
    var integer: p is 2;
  begin
    writeln(" Mersenne primes:");
    while p <= 3217 do
      if isPrime(p) and lucasLehmerTest(p) then
        write(" M" <& p);
        flush(OUT);
      end if;
      incr(p);
    end while;
    writeln;
  end func;


func is_mersenne_prime(p) {
    return true if (p == 2)
    var s = 4
    var M = (2**p - 1)
    { s = powmod(s, 2, M)-2 } * (p-2)
    s == 0
}

Inf.times {|n|
    if (n.is_prime && is_mersenne_prime(n)) {
        say "M#{n}"
    }
}


func lucasLehmer(_ p: Int) -> Bool {
  let m = BigInt(2).power(p) - 1
  var s = BigInt(4)

  for _ in 0..<p-2 {
    s = ((s * s) - 2) % m
  }

  return s == 0
}

for prime in Eratosthenes(upTo: 70) where lucasLehmer(prime) {
  let m = Int(pow(2, Double(prime))) - 1

  print("2^\(prime) - 1 = \(m) is prime")
}


proc main argv {
    set n 0
    set t [clock seconds]
    show_mersenne 2 [incr n] t

    for {set p 3} {$p <= [lindex $argv 0]} {incr p 2} {
        if {![prime $p]} continue
        if {[LucasLehmer $p]} {
            show_mersenne $p [incr n] t
        }
    }
}
proc show_mersenne {p n timevar} {
    upvar 1 $timevar time
    set now [clock seconds]
    puts [format "%2d: %5ds  M%s" $n [expr {$now - $time}] $p]
    set time $now
}
proc prime i {
   if {$i in {2 3}} {return 1}
   prime0 $i [expr {int(sqrt($i))}]
}
proc prime0 {i div} {
    expr {!($i % $div)? 0: $div <= 2? 1: [prime0 $i [incr div -1]]}
}
proc LucasLehmer p {
    set mp [expr {2**$p-1}]
    set s  4
    for {set i 2} {$i < $p} {incr i} {
        set s [expr {($s**2 - 2) % $mp}]
    }
    expr {$s == 0}
}

main 33218


19→M
1→N
For(E,2,M)
If E=2
Then:0→S
Else:4→S
End
(N+1)*2-1→N
For(I,1,E-2)
Reminder(S*S-2,N)→S
End
If S=0
Then:Disp E
End
End


m = 15
n = 1
For j = 2 To m
    If j = 2 Then
        s = 0
    Else
        s = 4
    EndIf
    n = (n + 1) * 2 - 1
    For i = 1 To j - 2
        s = (s * s - 2) % n
    Next i
    If s = 0 Then Print "M";j
Next


iexpmax = 15
n=1
out=""
For iexp = 2 To iexpmax
	If iexp = 2 Then
		s = 0
	Else
		s = 4
	End If
	n = (n + 1) * 2 - 1
	For i = 1 To iexp - 2
		s = (s * s - 2) Mod n
	Next
	If s = 0 Then
		out=out & "M" & iexp & " "
	End If
Next
Wscript.echo out


Public Class LucasLehmer
    Private Sub btnGo_Click(sender As Object, e As EventArgs) Handles btnGo.Click
        Const iexpmax = 31
        Dim s, n As Long
        Dim i, iexp As Integer
        n = 1
        txtOut.Text = ""
        For iexp = 2 To iexpmax
            If iexp = 2 Then
                s = 0
            Else
                s = 4
            End If
            n = (n + 1) * 2 - 1
            For i = 1 To iexp - 2
                s = (s * s - 2) Mod n
            Next i
            If s = 0 Then
                txtOut.Text = txtOut.Text & "M" & iexp & " "
            End If
        Next iexp
    End Sub
End Class


import "/big" for BigInt
import "/math" for Int
import "io" for Stdout

var start = System.clock
var max = 19
var count = 0
var table = [521, 607, 1279, 2203, 2281, 3217, 4253, 4423]
var p  = 3 // first odd prime
var ix = 0 // index into table for larger primes
var one = BigInt.one
var two = BigInt.two
while (true) {
    var m = (BigInt.two << (p - 1)) - one
    var s = BigInt.four
    for (i in 1..p-2) s = (s.square - two) % m
    if (s.bitLength == 0) {
        count = count + 1
        System.write("M%(p) ")
        Stdout.flush()
        if (count == max) {
            System.print()
            break
        }
    }
    // obtain next odd prime or look up in table after 127
    if (p < 127) {
        while (true) {
            p = p + 2
            if (Int.isPrime(p)) break
        }
    } else {
        p = table[ix]
        ix = ix + 1
    }
}
System.print("\nTook %(System.clock - start) seconds.")


const std = @import("std");
const stdout = std.io.getStdOut().outStream();
const assert = std.debug.assert;

pub fn main() !void {
    const primes = [_]u7{
        2,   3,  5,  7,  11, 13,  17,  19,  23,  29,
        31,  37, 41, 43, 47, 53,  59,  61,  67,  71,
        73,  79, 83, 89, 97, 101, 103, 107, 109, 113,
        127,
    };
    try stdout.print("These Mersenne numbers are prime: ", .{});
    for (primes) |p|
        if (isMersennePrime(p))
            try stdout.print("M{} ", .{p});
    try stdout.print("\n", .{});
}

inline fn M(n: u7) u128 {
    return (@as(u128, 1) << n) - 1;
}

fn isMersennePrime(p: u7) bool {
    if (p < 3)
        return p == 2
    else {
        const n = M(p);
        var s: u128 = 4;
        var i: u7 = p - 2;
        while (i > 0) : (i -= 1) {
            s = modmul(s, s, n);
            s = if (s >= 2) s - 2 else n - 2 + s;
        }
        return s == 0;
    }
}

fn modmul(a0: u128, b0: u128, m: u128) u128 {
    var r: u128 = 0;
    var a = a0 % m;
    var b = b0 % m;
    while (b > 0) {
        if (b & 1 == 1)
            r = if ((m - r) > a) r + a else r + a - m;
        b >>= 1;
        if (b > 0)
            a = if ((m - a) > a) a + a else a + a - m;
    }
    return r;
}


var [const] BN=Import.lib("zklBigNum");	// lib GMP
primes:=Utils.Generator(Import("sieve").postponed_sieve);
fcn isMersennePrime(p){
   if(p==2) return(True);
   mp:=BN(1).shiftLeft(p) - 1; // 2^p - 1, a BIG number, like 1000s of digits
   s:=BN(4); do(p-2){ s.mul(s).sub(2).mod(mp) } // the % REALLY cuts down on mem usage
   return(s==0);
}


*        Luhn test of credit card numbers        22/05/2016
LUHNTEST CSECT
         USING  LUHNTEST,R13       base register
         B      72(R15)            skip savearea
         DC     17F'0'             savearea
         STM    R14,R12,12(R13)    prolog
         ST     R13,4(R15)         "
         ST     R15,8(R13)         "
         LR     R13,R15            "
         LA     R9,T               @t(k)
         LA     R8,N               for n
LOOPK    EQU    *                  for k=1 to n
         LR     R4,R9              @t(k),@s[1]
         LA     R6,1               from i=1
         LA     R7,M               to m
LOOPI1   CR     R6,R7              for i=1 to m
         BH     ELOOPI1            leave i
         CLI    0(R4),C' '           if mid(s,i,1)=" "
         BNE    ITERI1               then
         BCTR   R6,0                   i-1
         ST     R6,L                   l=i-1
         B      ELOOPI1                exit for
*                                    end if
ITERI1   LA     R4,1(R4)             next @s[i]
         LA     R6,1(R6)             i=i+1
         B      LOOPI1             next i
ELOOPI1  EQU    *                  out of loop i
         MVC    W,BLANK            w=" "
         LA     R4,W               [email protected]
         LR     R5,R9              [email protected]
         A      R5,L               [email protected]+l
         BCTR   R5,0               is=s+l-1
         L      R6,L               i=l
         LA     R7,1               to 1
LOOPI2   CR     R6,R7              for i=l to 1 by -1
         BL     ELOOPI2            leave i
         MVC    0(1,R4),0(R5)        mid(w,iw,1)=mid(s,is,1)
         LA     R4,1(R4)             iw=iw+1
         BCTR   R5,0                 is=is-1
         BCTR   R6,0                 i=i-1
         B      LOOPI2             next i
ELOOPI2  EQU    *                  out of loop i
         LA     R11,0              s1=0
         LA     R12,0              s2=0
         LA     R6,1               i=1
         L      R7,L               to l
LOOPI3   CR     R6,R7              for i=1 to l
         BH     ELOOPI3            leave i
         LA     R2,W-1             @w-1
         AR     R2,R6              w[i]
         MVC    CI,0(R2)           ci=mid(w,i,1)
         NI     CI,X'0F'           zap upper half byte
         LR     R4,R6              i
         SRDA   R4,32              >>32
         D      R4,=F'2'           i/2
         LTR    R4,R4              if mod(i,2)>0
         BNH    NOTMOD             then
         XR     R2,R2                clear
         IC     R2,CI                z=cint(mid(w,i,1))
         AR     R11,R2               s1=s1+cint(mid(w,i,1))
         B      EIFMOD             else
NOTMOD   XR     R2,R2                clear
         IC     R2,CI                cint(mid(w,i,1))
         SLA    R2,1                 *2
         ST     R2,Z                 z=cint(mid(w,i,1))*2
         C      R2,=F'10'            if z<10
         BNL    GE10                 then
         A      R12,Z                  s2=s2+z
         B      EIF10                else
GE10     L      R2,Z                   z
         CVD    R2,PL8                 binary to packed
         UNPK   CL16,PL8               packed to zoned
         OI     CL16+15,X'F0'          zoned to char (zap sign)
         MVC    X(1),CL16+15           x=right(cstr(z),1)
         NI     X,X'0F'                zap upper half byte
         XR     R2,R2                  r2=0
         IC     R2,X                   r2=cint(right(cstr(z),1))
         AR     R12,R2                 s2=s2+r2
         LA     R12,1(R12)             s2=s2+cint(right(cstr(z),1))+1
EIF10    EQU    *                    end if
EIFMOD   EQU    *                  end if
         LA     R6,1(R6)           i=i+1
         B      LOOPI3             next i
ELOOPI3  EQU    *                  out of loop i
         LR     R1,R11             s1
         AR     R1,R12             s1+s2
         CVD    R1,PL8             binary to packed
         UNPK   CL16,PL8           packed to zoned
         CLI    CL16+15,X'C0'      if right(cstr(s1+s2),1)="0"
         BNE    NOTZERO            then
         MVC    R,=CL8'Valid'        r="Valid"
         B      ECLI               else
NOTZERO  MVC    R,=CL8'Invalid'      r="Invalid"
ECLI     EQU    *                  end if
         MVC    PG(M),0(R9)        t(k)
         MVC    PG+M+1(L'R),R      r
         XPRNT  PG,L'PG            print buffer
         LA     R9,M(R9)           at=at+m
         BCT    R8,LOOPK           next k
         L      R13,4(0,R13)       epilog
         LM     R14,R12,12(R13)    "
         XR     R15,R15            "
         BR     R14                exit
N        EQU    (TEND-T)/L'T
M        EQU    20
T        DC     CL(M)'49927398716         '
         DC     CL(M)'49927398717         '
         DC     CL(M)'1234567812345678    '
         DC     CL(M)'1234567812345670    '
TEND     DS     0C
W        DS     CL(M)
BLANK    DC     CL(M)' '
L        DS     F
Z        DS     F
PL8      DS     PL8
CL16     DS     CL16
CI       DS     C
X        DS     C
R        DS     CL8
PG       DC     CL80' '            buffer
         YREGS
         END    LUHNTEST


	org	100h
	jmp 	demo
	;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	;;;	Check if the 0-terminated string at HL passes the Luhn test.
	;;;	Returns with carry clear if the string passes, carry set
	;;;	if the string fails.
luhn:	mvi	b,0	; Counter
	mov	d,b	; D = S1+S2 (we don't need to keep them separate)
lscan:	mov	a,m	; Get byte
	inx 	h	; Increment pointer
	inr	b	; Increment counter
	ana	a	; Is it 0?
	jnz	lscan	; If not, try next byte
	dcx	h	; Go to the byte before the 0
	dcx	h
	dcr	b	; Decrement counter
	rz		; If 0, the string was empty, return.
lloop:	mvi	c,'0'	; ASCII zero
	mov	a,d	; Add odd digit to the total
	add	m
	sub	c	; Subtract ASCII zero
	mov	d,a
	dcr	b	; If last digit, we're done
	jz	ldone
	dcx	h	; Go back one byte
	mov	a,m	; Get even digit
	sub	c	; Subtract ASCII zero
	add	a	; Multiply by two
	mvi	c,9	; 10-1, compensate for extra subtraction loop
ldiv:	inr	c	; Find two digits using trial subtraction
	sui	10
	jnc	ldiv
	add	c	; Add the possible second digit in
	add	d	; Add it to the total
	mov	d,a
	dcx	h	; Go back one byte
	dcr	b	; Done yet?
	jnz	lloop
ldone:	mov	a,d	; See if total is divisible by 10
	mvi	b,10
lchk:	sub	b	; Trial subtraction, subtract 10
	rz		; If zero, it is divisible, return (carry clear)
	rc		; If carry, it is not divisible, return (carry set)
	jmp	lchk
	;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	;;;	Run the routine on the argument given on the CP/M command line
demo:	lxi	h,80h	; Zero-terminate the command line argument
	mov	a,m
	add	l
	mov	l,a
	inr	l
	mvi	m,0
	mvi	l,82h	; Run the 'luhn' subroutine
	call 	luhn
	mvi	c,9
	lxi	d,pass	; Carry clear = print 'Pass'
	jnc	5
	lxi	d,fail	; Carry set = print 'Fail'
	jmp	5
pass:	db	'Pass$'
fail:	db	'Fail$'


	bits	16
	cpu	8086
	org	100h
section	.text
	jmp	demo
	;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	;;; 	Check whether the 0-terminated string at DS:SI passes the Luhn
	;;; 	test. Returns with carry clear if the string passes, carry
	;;;	set if the string fails.
luhn:	push	es	; Keep original ES, and set ES=DS so SCASB can be used.
	push	ds	; "REP DS:SCASB" is a bad idea, because the 286 has a
	pop	es	; bug where it "forgets" the 2nd prefix if interrupted!
	mov	di,si	; DI = pointer
	xor	ax,ax	; Zero to test against
	xor	bl,bl	; BL = S1+S2
	mov	dx,0A30h	; DH = 10 (divisor), DL = '0' (ASCII zero)
	xor	cx,cx	; Set counter to 65535
	dec	cx
	cld		; Seek forwards
	repnz	scasb	; Find zero
	dec	di	; SCASB goes one byte too far
	xchg	si,di	; SI = pointer, DI = end (or rather, beginning)
	mov	cx,si	; CX = counter
	sub	cx,di
	jcxz	.done	; Empty string = stop
	dec	si	; We don't need the zero itself
	std		; Seek backwards
.loop:	lodsb		; Get number in odd position
	sub	al,dl	; Subtract ASCII zero
	add	bl,al	; Add to total
	dec	cx	; One fewer character
	jz	.done	; No more characters = stop
	lodsb		; Get number in even position
	sub	al,dl	; Subtract ASCII zero
	add	al,al	; Multiply by two
	xor	ah,ah	; AX = AL
	div	dh	; Divide by 10; AL=quotient, AH=remainder
	add	al,ah	; Add the two "digits" together
	add	bl,al	; Add to total
	loop 	.loop	; Decrement CX and loop
.done:	xor	ah,ah	; Divide total by 10
	mov	al,bl
	div	dh
	and	ah,ah	; If remainder 0, then return with carry clear
	jz	.out
	stc		; Set carry (remainder wasn't 0, the test failed)
.out:	cld		; Clean up: clear direction flag,
	pop	es	; and restore ES.
	ret
	;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	;;;	Run the 'luhn' routine on the argument given on the MS-DOS
	;;;	command line.
demo:	mov	si,80h			; Zero-terminate the argument
	xor	bh,bh
	mov	bl,[si]
	mov	[si+bx+1],bh
	inc	si
	inc	si
	call 	luhn			; Call the routine
	mov	ah,9
	mov	dx,pass			; If carry is clear, print 'Pass'
	jnc	print
	mov	dx,fail			; Otherwise, print 'fail'
print:	int	21h
	ret
section	.data
pass:	db	'Pass$'
fail:	db	'Fail$'


\ Adapted from the C version:
: remap \ n1 -- n2
  [0,2,4,6,8,1,3,5,7,9]
  swap caseof ;

: luhn \ s -- f
  0 swap
  s:rev
  (
    '0 n:-
    swap 2 n:mod if remap then
    n:+
  ) s:each
  10 n:mod not ;

: test-luhn \ s --
  dup . space
  luhn if "OK" else "FAIL" then . cr ;

"49927398716" test-luhn
"49927398717" test-luhn
"1234567812345678" test-luhn
"1234567812345670" test-luhn

bye


METHOD luhn_check.

  DATA: sum(1) TYPE n VALUE 0. " Sum of checksum.
  DATA: current TYPE i. " Current digit.
  DATA: odd TYPE i VALUE 1. " Multiplier.
  DATA: len TYPE i. " String crowler.

  " Luhn algorithm.
  len = NUMOFCHAR( pi_string ) - 1.
  WHILE ( len >= 0 ).
    current = pi_string+len(1) * odd.
    IF ( current > 9 ).
      current = current - 9. " Digits sum.
    ENDIF.
    sum = sum + current.
    odd = 3 - odd. " 1 <--> 2 Swich
    len = len - 1. " Move to next charcter.
  ENDWHILE.

  " Validation check.
  IF ( sum = 0 ).
    pr_valid = abap_true.
  ELSE.
    pr_valid = abap_false.
  ENDIF.

ENDMETHOD.


(include-book "arithmetic-3/top" :dir :system)

(defun digits (n)
   (if (zp n)
       nil
       (cons (mod n 10)
             (digits (floor n 10)))))

(defun sum (xs)
   (if (endp xs)
       0
       (+ (first xs)
          (sum (rest xs)))))

(defun double-and-sum-digits (xs)
   (if (endp xs)
       nil
       (cons (sum (digits (* 2 (first xs))))
             (double-and-sum-digits (rest xs)))))

(defun dmx (xs)
   (if (endp (rest xs))
       (mv xs nil)
       (mv-let (odds evens)
               (dmx (rest (rest xs)))
          (mv (cons (first xs) odds)
              (cons (second xs) evens)))))

(defun luhn (n)
   (mv-let (odds evens)
           (dmx (digits n))
      (= (mod (+ (sum odds)
                 (sum (double-and-sum-digits evens)))
              10)
         0)))


PROC ReverseDigits(CHAR ARRAY n,rev)
  BYTE i,j

  i=n(0)
  WHILE i>0 AND n(i)='0
  DO
    i==-1
  OD

  j=1
  WHILE i>0
  DO
    rev(j)=n(i)
    j==+1 i==-1
  OD
  rev(0)=j-1
RETURN

BYTE FUNC SumOddDigits(CHAR ARRAY n)
  BYTE sum,i

  sum=0
  FOR i=1 TO n(0) STEP 2
  DO
    sum==+ValB(n(i))
  OD
RETURN(sum)

BYTE FUNC SumEvenDigitsMultiplied(CHAR ARRAY n)
  BYTE sum,i,v

  sum=0
  FOR i=2 TO n(0) STEP 2
  DO
    v=ValB(n(i))*2
    IF v>9 THEN v==-9 FI
    sum==+v
  OD
RETURN(sum)

BYTE FUNC Luhn(CHAR ARRAY n)
  CHAR ARRAY rev(20)
  BYTE s1,s2

  ReverseDigits(n,rev)
  s1=SumOddDigits(rev)
  s2=SumEvenDigitsMultiplied(rev)

  IF (s1+s2) MOD 10=0 THEN
    RETURN(1)
  FI
RETURN(0)

PROC Test(CHAR ARRAY n)
  PrintF("%S is ",n)
  IF Luhn(n) THEN
    PrintE("valid")
  ELSE
    PrintE("invalid")
  FI
RETURN

PROC Main()
  Test("49927398716")
  Test("49927398717")
  Test("1234567812345678")
  Test("1234567812345670")
RETURN


function isValid(numString:String):Boolean
{
	var isOdd:Boolean = true;
	var oddSum:uint = 0;
	var evenSum:uint = 0;
	for(var i:int = numString.length - 1; i >= 0; i--)
	{
		var digit:uint = uint(numString.charAt(i))
		if(isOdd) oddSum += digit;
		else evenSum += digit/5 + (2*digit) % 10;
		isOdd = !isOdd;
	}
	if((oddSum + evenSum) % 10 == 0) return true;
	return false;
}

trace(isValid("49927398716"));
trace(isValid("49927398717"));
trace(isValid("1234567812345678"));
trace(isValid("1234567812345670"));


with Ada.Text_IO;
use  Ada.Text_IO;

procedure Luhn is

  function Luhn_Test (Number: String) return Boolean is
    Sum  : Natural := 0;
    Odd  : Boolean := True;
    Digit: Natural range 0 .. 9;
  begin
    for p in reverse Number'Range loop
      Digit := Integer'Value (Number (p..p));
      if Odd then
        Sum := Sum + Digit;
      else
        Sum := Sum + (Digit*2 mod 10) + (Digit / 5);
      end if;
      Odd := not Odd;
    end loop;
    return (Sum mod 10) = 0;
  end Luhn_Test;

begin

  Put_Line (Boolean'Image (Luhn_Test ("49927398716")));
  Put_Line (Boolean'Image (Luhn_Test ("49927398717")));
  Put_Line (Boolean'Image (Luhn_Test ("1234567812345678")));
  Put_Line (Boolean'Image (Luhn_Test ("1234567812345670")));

end Luhn;


PROC to int = (CHAR c)INT:
    ABS c - ABS "0";

PROC confirm = (STRING id)BOOL:
(
    BOOL is odd digit := TRUE;
    INT s := 0;
    STRING cp;

    FOR cp key FROM UPB id BY -1 TO LWB id DO
        INT k := to int(id[cp key]);
        s +:=
            IF is odd digit THEN k
            ELIF k /= 9 THEN 2*k MOD 9
            ELSE 9
            FI;
        is odd digit := NOT is odd digit
    OD;
    0 = s MOD 10
);

main:
(
    []STRING t cases = (
        "49927398716",
        "49927398717",
        "1234567812345678",
        "1234567812345670"
    );
    FOR cp key TO UPB t cases DO
        STRING cp = t cases[cp key];
        print((cp, ": ", confirm(cp), new line))
    OD
)


% returns true if ccNumber passes the Luhn test, false otherwise %
% as Algol W has fixed length strings, the length of the number  %
% must be specified in ccLength                                  %
logical procedure LuhnTest ( string(32) value ccNumber
                           ; integer    value ccLength
                           ) ;
begin
    integer checkSum;
    logical oddDigit, isValid;
    checkSum := 0;
    isValid := oddDigit := true;
    for cPos := ccLength step -1 until 1 do begin
        integer digit;
        digit := decode( ccNumber( cPos - 1 // 1 ) ) - decode( "0" );
        if digit < 0 or digit > 9 then isValid := false
        else if oddDigit
        then checkSum := checkSum + digit
        else checkSum := checkSum + ( case digit + 1 of ( 0, 2, 4, 6, 8
                                                        , 1, 3, 5, 7, 9
                                                        )
                                    );
        oddDigit := not oddDigit
    end for_cPos ;
    isValid and ( ( checkSum rem 10 ) = 0 )
end LuhnTest


LuhnTest←{
     digits←⍎¨⍵                       ⍝ Characters to digits
     doubled←2∘×@(⌽⍤~1 0⍴⍨≢)⊢digits   ⍝ Double every other digit
     partial←-∘[email protected](9∘<)⊢doubled        ⍝ Subtract 9 is equivalent to sum of digits for the domain 10≤x≤19
     0=10|+/partial                   ⍝ Valid if sum is a multiple of 10
 }


-- luhn :: String -> Bool
on luhn(s)
    -- True if the digit string represents
    -- a valid Luhn credit card number.

    script divMod10Sum
        on |λ|(a, x)
            a + x div 10 + x mod 10
        end |λ|
    end script

    0 = foldl(divMod10Sum, 0, ¬
        zipWith(my mul, ¬
            map(my int, reverse of (characters of s)), ¬
            cycle({1, 2}))) mod 10
end luhn

--------------------------- TEST ---------------------------
on run
    map(luhn, ¬
        {"49927398716", "49927398717", ¬
            "1234567812345678", "1234567812345670"})

    --> {true, false, false, true}
end run

---------------- REUSABLE GENERIC FUNCTIONS ----------------

-- cycle :: [a] -> Generator [a]
on cycle(xs)
    script
        property lng : 1 + (length of xs)
        property i : missing value
        on |λ|()
            if missing value is i then
                set i to 1
            else
                set nxt to (1 + i) mod lng
                if 0 = ((1 + i) mod lng) then
                    set i to 1
                else
                    set i to nxt
                end if
            end if
            return item i of xs
        end |λ|
    end script
end cycle

-- foldl :: (a -> b -> a) -> a -> [b] -> a
on foldl(f, startValue, xs)
    tell mReturn(f)
        set v to startValue
        set lng to length of xs
        repeat with i from 1 to lng
            set v to |λ|(v, item i of xs, i, xs)
        end repeat
        return v
    end tell
end foldl

-- int :: String -> Int
on int(s)
    s as integer
end int

-- length :: [a] -> Int
on |length|(xs)
    set c to class of xs
    if list is c or string is c then
        length of xs
    else
        (2 ^ 29 - 1) -- (maxInt - simple proxy for non-finite)
    end if
end |length|

-- mReturn :: First-class m => (a -> b) -> m (a -> b)
on mReturn(f)
    -- 2nd class handler function lifted into 1st class script wrapper.
    if script is class of f then
        f
    else
        script
            property |λ| : f
        end script
    end if
end mReturn

-- map :: (a -> b) -> [a] -> [b]
on map(f, xs)
    -- The list obtained by applying f
    -- to each element of xs.
    tell mReturn(f)
        set lng to length of xs
        set lst to {}
        repeat with i from 1 to lng
            set end of lst to |λ|(item i of xs, i, xs)
        end repeat
        return lst
    end tell
end map

-- min :: Ord a => a -> a -> a
on min(x, y)
    if y < x then
        y
    else
        x
    end if
end min

-- mul (*) :: Num a => a -> a -> a
on mul(a, b)
    a * b
end mul

-- take :: Int -> [a] -> [a]
-- take :: Int -> String -> String
on take(n, xs)
    set c to class of xs
    if list is c then
        if 0 < n then
            items 1 thru min(n, length of xs) of xs
        else
            {}
        end if
    else if string is c then
        if 0 < n then
            text 1 thru min(n, length of xs) of xs
        else
            ""
        end if
    else if script is c then
        set ys to {}
        repeat with i from 1 to n
            set v to |λ|() of xs
            if missing value is v then
                return ys
            else
                set end of ys to v
            end if
        end repeat
        return ys
    else
        missing value
    end if
end take

-- zipWith :: (a -> b -> c) -> [a] -> [b] -> [c]
on zipWith(f, xs, ys)
    set lng to min(|length|(xs), |length|(ys))
    if 1 > lng then return {}
    set xs_ to take(lng, xs) -- Allow for non-finite
    set ys_ to take(lng, ys) -- generators like cycle etc
    set lst to {}
    tell mReturn(f)
        repeat with i from 1 to lng
            set end of lst to |λ|(item i of xs_, item i of ys_)
        end repeat
        return lst
    end tell
end zipWith


.text
.global _start
_start:
    ldr r0, =example_numbers
    bl test_number

    add r1, r0, #1
    bl length
    add r0, r1, r0
    bl test_number

    add r1, r0, #1
    bl length
    add r0, r1, r0
    bl test_number

    add r1, r0, #1
    bl length
    add r0, r1, r0
    bl test_number

    mov r0, #0
    mov r7, #1
    swi 0

test_number:
    push {r0, lr}
    bl print_string

    bl luhn_test
    cmp r0, #1
    ldreq r0, =valid_message
    ldrne r0, =invalid_message
    bl print_string
    pop {r0, lr}
    mov pc, lr

print_string:
    push {r0-r7, lr}
    mov r1, r0   @ string to print
    bl length
    mov r2, r0   @ length of string
    mov r0, #1   @ write to stdout
    mov r7, #4   @ SYS_WRITE
    swi 0        @ call system interupt
    pop {r0-r7, lr}
    mov pc, lr

@ r0 address of credit card number string
@ returns result in r0
luhn_test:
    push {r1-r7, lr}
    mov r1, r0
    bl isNumerical            @ check if string is a number
    cmp r0, #1
    bne .luhn_test_end        @ exit if not number
    mov r0, r1
    ldr r1, =reversed_string  @ address to store reversed string
    bl reverse                @ reverse string
    push {r0}
    bl length   @ get length of string
    mov r4, r0  @ store string length in r4
    pop {r0}
    mov r2, #0  @ string index
    mov r6, #0  @ sum of odd digits
    mov r7, #0  @ sum of even digits
    .loadNext:
        ldrb r3, [r1, r2]         @ load byte into r3
        sub r3, #'0'              @ convert letter to digit
        and r5, r2, #1            @ test if index is even or odd
        cmp r5, #0
        beq .odd_digit
        bne .even_digit
        .odd_digit:
            add r6, r3              @ add digit to sum if odd
            b .continue             @ skip next step
        .even_digit:
            lsl r3, #1              @ multiply digit by 2
            cmp r3, #10             @ sum digits
            subge r3, #10           @ get digit in 1s place
            addge r3, #1            @ add 1 for the 10s place
            add r7, r3              @ add digit sum to the total

        .continue:
        add r2, #1                @ increment digit index
        cmp r2, r4                @ check if at end of string
        blt .loadNext

    add r0, r6, r7                @ add even and odd sum
    mov r3, r0                    @ copy sum to r3
    ldr r1, =429496730            @ (2^32-1)/10
    sub r0, r0, r0, lsr #30       @ divide by 10
    umull r2, r0, r1, r0
    mov r1, #10
    mul r0, r1                    @ multiply the r0 by 10 to see if divisible
    cmp r0, r3                    @ compare with the original value in r3
    .luhn_test_end:
    movne r0, #0                  @ return false if invalid card number
    moveq r0, #1                  @ return true if valid card number
    pop {r1-r7, lr}
    mov pc, lr

length:
    push {r1-r2, lr}
    mov r2, r0              @ start of string address
    .loop:
        ldrb r1, [r2], #1   @ load byte from address r2 and increment
        cmp r1, #0          @ check for end of string
        bne .loop           @ load next byte if not 0
    sub r0, r2, r0          @ subtract end of string address from start
    sub r0, #1              @ end of line from count
    pop {r1-r2, lr}
    mov pc, lr

@ reverses a string
@ r0 address of string to reverse
@ r1 address to store reversed string
reverse:
    push {r0-r5, lr}
    push {r0, lr}
    bl length                @ get length of string to reverse
    mov r3, r0               @ backword index
    pop {r0, lr}
    mov r4, #0               @ fowrard index
    .reverse_next:
        sub r3, #1           @ decrement backword index
        ldrb r5, [r0, r3]    @ load byte from original string at index
        strb r5, [r1, r4]    @ copy byte to reversed string
        add r4, #1           @ increment fowrard index
        cmp r3, #0           @ check if any characters are left
        bge .reverse_next

    mov r5, #0
    strb r5, [r1, r4]  @ write null byte to terminate reversed string
    pop {r0-r5, lr}
    mov pc, lr

isNumerical:
    push {r1, lr}
    .isNumerical_checkNext:
        ldrb r1, [r0], #1
        cmp r1, #0
        beq .isNumerical_true
        cmp r1, #'0'
        blt .isNumerical_false
        cmp r1, #'9'
        bgt .isNumerical_false
        b .isNumerical_checkNext
    .isNumerical_false:
        mov r0, #0
        b .isNumerical_end
    .isNumerical_true:
        mov r0, #1
    .isNumerical_end:
    pop {r1, lr}
    mov pc, lr

.data
valid_message:
    .asciz " valid card number\n"
invalid_message:
    .asciz " invalid card number\n"

reversed_string:
    .space 32

example_numbers:
    .asciz "49927398716"
    .asciz "49927398717"
    .asciz "1234567812345678"
    .asciz "1234567812345670"


digits: function [n][
    res: new []
    while -> n > 0 [
        'res ++ n % 10
        n: n / 10
    ]
    res
]

luhn?: function [n][
    s1: new 0
    s2: new 0
    loop.with: 'i digits n 'd [
        if? even? i -> 's1 + d
        else [
            'd * 2
            if d > 9 -> 'd - 9
            's2 + d
        ]
    ]
    zero? (s1 + s2) % 10
]

print luhn? 49927398716
print luhn? 49927398717
print luhn? 1234567812345678
print luhn? 1234567812345670


; Originally submitted by Laszlo:
; http://www.autohotkey.com/forum/post-229412.html#229412

MsgBox % LuhnTest(49927398716)
MsgBox % LuhnTest(49927398717)
MsgBox % LuhnTest(1234567812345678)
MsgBox % LuhnTest(1234567812345670)

Return

;-----------------------------

LuhnTest(Number)
{
  MultFactor := 2 - ( StrLen(Number) & 1 )  ,  Sum := 0
  Loop, Parse, Number
    Sum += ( ( 9 < ( Temp := MultFactor * A_LoopField ) ) ? Temp - 9 : Temp )  ,  MultFactor := 3 - MultFactor
  Return !Mod(Sum,10)
}


Global $avarray[4] = [49927398716, 49927398717, 1234567812345678, 1234567812345670]
For $i = 0 To 3
	checkLuhn($avarray[$i])
Next

Func checkLuhn($number)
	$sum = 0
	$numDigits = StringSplit($number, "")
	For $i = $numDigits[0] - 1 To 1 Step -2
		$numDigits[$i] = $numDigits[$i] * 2
		If $numDigits[$i] >= 10 Then $numDigits[$i] -= 9
	Next
	For $i = 1 To $numDigits[0]
		$sum += $numDigits[$i]
	Next
	If StringRight($sum, 1) = "0" Then
		ConsoleWrite("Luhn-Check (" & $number & ") : True" & @CRLF)
		Return True
	Else
		ConsoleWrite("Luhn-Check (" & $number & ") : False" & @CRLF)
		Return False
	EndIf
EndFunc   ;==>checkLuhn


#!/bin/bash

function luhn_validate  # <numeric-string>
{
    num=$1
    shift 1

    len=${#num}
    is_odd=1
    sum=0
    for((t = len - 1; t >= 0; --t)) {
        digit=${num:$t:1}

        if [[ $is_odd -eq 1 ]]; then
            sum=$(( sum + $digit ))
        else
            sum=$(( $sum + ( $digit != 9 ? ( ( 2 * $digit ) % 9 ) : 9 ) ))
        fi

        is_odd=$(( ! $is_odd ))
    }

    # NOTE: returning exit status of 0 on success
    return $(( 0 != ( $sum % 10 ) ))
}

function print_result  # <numeric-string>
{
    if luhn_validate "$1"; then
        echo "$1 is valid"
    else
        echo "$1 is not valid"
    fi
}

print_result "49927398716"
print_result "49927398717"
print_result "1234567812345678"
print_result "1234567812345670"


dim card$(5)
card$[1]="49927398716"
card$[2]="49927398717"
card$[3]="1234567812345678"
card$[4]="1234567812345670"

for test = 1 to 4
    odd = True
    sum = 0
    for n = length(card$[test]) to 1 step -1
        num = int(mid(card$[test],n,1))
        if odd then
            sum += num
            odd = False
        else
            num *= 2
            if num <= 9 then
                sum += num
            else
                sum += int(left(string(num),1)) + int(right(string(num),1))
            end if
            odd = True
        end if
    next
    if sum mod 10 = 0 then
        print card$[test], "True"
    else
        print card$[test], "False"
    end if
next test


@echo off
setlocal enabledelayedexpansion

call :luhn 49927398716
call :luhn 49927398717
call :luhn 1234567812345678
call :luhn 1234567812345670
exit /b 0

:luhn
set "input=%1"
set "cnt=0"
set "s1=0"
set "s2=0"
:digit_loop
set /a "cnt-=1"
set /a "isOdd=(-%cnt%)%%2"

if !isodd! equ 1 (
	set /a "s1+=!input:~%cnt%,1!"
) else (
	set /a "twice=!input:~%cnt%,1!*2"
	if !twice! geq 10 (
		set /a "s2+=!twice:~0,1!+!twice:~1,1!"
	) else (
		set /a "s2+=!twice!"
	)
)
if "!input:~%cnt%!"=="!input!" (
	set /a "sum=(!s1!+!s2!)%%10"
	if !sum! equ 0 (echo !input! is valid.) else (echo !input! is not valid.)
	goto :EOF
)
goto digit_loop


      FOR card% = 1 TO 4
        READ cardnumber$
        IF FNluhn(cardnumber$) THEN
          PRINT "Card number " cardnumber$ " is valid"
        ELSE
          PRINT "Card number " cardnumber$ " is invalid"
        ENDIF
      NEXT card%
      END

      DATA 49927398716, 49927398717, 1234567812345678, 1234567812345670

      DEF FNluhn(card$)
      LOCAL I%, L%, N%, S%
      L% = LEN(card$)
      FOR I% = 1 TO L%
        N% = VAL(MID$(card$, L%-I%+1, 1))
        IF I% AND 1 THEN
          S% += N%
        ELSE
          N% *= 2
          S% += N% MOD 10 + N% DIV 10
        ENDIF
      NEXT
      = (S% MOD 10) = 0


get "libhdr"

let luhn(s) = valof
$(  let sum=0 and fac=1
    for i = s%0 to 1 by -1
    $(  unless '0' <= s%i <= '9' resultis false
        sum := sum + fac*(s%i - '0') rem 10 + fac*(s%i - '0')/10
        fac := 3 - fac
    $)
    resultis sum rem 10 = 0
$)

let show(s) be
    writef("%S: %S*N", s, luhn(s) -> "pass", "fail")

let start() be
$(  show("49927398716")
    show("49927398717")
    show("1234567812345678")
    show("1234567812345670")
$)


tt         "Remove whitespace"vv
pe         "Eval to number"vv
<-         "Reverse digits"vv
XX         "Split number into digits"vv

{
 { "Odd digits"vv
  2EN
 }

 { "Even digits"vv
  2en
  {
   2.*     "Double"vv
   ^^ 9.>  "<test>=Duplicate greater than 9"vv
   {
    XX++   "Sum digits"vv
   }if     "If <test>"vv
  }m[      "For each even digit"vv
 }
}M-       "Cool map. Create array of each branch applied to argument."vv

{++}m[    "Sum each block (odd & even)"vv
++        "Sum these"vv
[-        "Last digit"vv
0==       "Equal to zero"vv
Q         "Pretty print"vv


    public static class Luhn
    {
        public static bool LuhnCheck(this string cardNumber)
        {
            return LuhnCheck(cardNumber.Select(c => c - '0').ToArray());
        }

        private static bool LuhnCheck(this int[] digits)
        {
            return GetCheckValue(digits) == 0;
        }

        private static int GetCheckValue(int[] digits)
        {
            return digits.Select((d, i) => i % 2 == digits.Length % 2 ? ((2 * d) % 10) + d / 5 : d).Sum() % 10;
        }
    }

    public static class TestProgram
    {
        public static void Main()
        {
            long[] testNumbers = {49927398716, 49927398717, 1234567812345678, 1234567812345670};
            foreach (var testNumber in testNumbers)
                Console.WriteLine("{0} is {1}valid", testNumber, testNumber.ToString().LuhnCheck() ? "" : "not ");
        }
    }


#include <iostream>
using namespace std;

int toInt(const char c)
{
    return c-'0';
}

int confirm( const char *id)
{
    bool is_odd_dgt = true;
    int s = 0;
    const char *cp;

    for(cp=id; *cp; cp++);
    while(cp > id) {
        --cp;
        int k = toInt(*cp);
        if (is_odd_dgt) {
            s += k;
        }
        else {
            s += (k!=9)? (2*k)%9 : 9;
        }
	is_odd_dgt = !is_odd_dgt;
    }
    return 0 == s%10;
}

int main( )
{
    const char * t_cases[] = {
        "49927398716",
        "49927398717",
        "1234567812345678",
        "1234567812345670",
        NULL,
    };
    for ( const char **cp = t_cases; *cp; cp++) {
        cout << *cp << ": " << confirm(*cp) << endl;
    }
    return 0;
}


Class Utils.Check [ Abstract ]
{

ClassMethod Luhn(x As %String) As %Boolean
{
	// https://www.simple-talk.com/sql/t-sql-programming/calculating-and-verifying-check-digits-in-t-sql/
	SET x=$TRANSLATE(x," "), cd=$EXTRACT(x,*)
	SET x=$REVERSE($EXTRACT(x,1,*-1)), t=0
	FOR i=1:1:$LENGTH(x) {
		SET n=$EXTRACT(x,i)
		IF i#2 SET n=n*2 IF $LENGTH(n)>1 SET n=$EXTRACT(n,1)+$EXTRACT(n,2)
		SET t=t+n
	}
	QUIT cd=((t*9)#10)
}

}


shared void run() {
	value numbers = "49927398716
	                 49927398717
	                 1234567812345678
	                 1234567812345670";
	for(number in numbers.lines) {
		print("``number`` passes? ``luhn(number)``");
	}
}

shared Boolean luhn(String number) {
	value digits = number
			.reversed
			.map(Character.string)
			.map(Integer.parse)
			.narrow<Integer>();
	value s1 = sum { 0, *digits.by(2) };
	value s2 = sum {
		0,
		*digits
			.skip(1)
			.by(2)
			.map(curry(times<Integer>)(2))
			.map((Integer element) => element / 10 + element % 10)
	};
	return (s1 + s2) % 10 == 0;
}


luhn = proc (num: string) returns (bool) signals (bad_format)
    total: int := 0
    even: bool := true
    for i: int in int$from_to_by(string$size(num), 1, -1) do
        digit: int := int$parse(string$c2s(num[i])) resignal bad_format
        even := ~even
        if even then
            digit := 2 * digit
            if digit >= 10 then digit := digit//10 + 1 end
        end
        total := total + digit
    end
    return(total // 10 = 0)
end luhn

start_up = proc ()
    po: stream := stream$primary_output()
    tests: sequence[string] := sequence[string]$
        ["49927398716", "49927398717", "1234567812345678", "1234567812345670"]
    for test: string in sequence[string]$elements(tests) do
        stream$puts(po, test || ": ")
        if luhn(test)
            then stream$putl(po, "pass")
            else stream$putl(po, "fail")
        end
    end
end start_up


       IDENTIFICATION DIVISION.
       PROGRAM-ID.  LUHNTEST.
       ENVIRONMENT DIVISION.
       INPUT-OUTPUT SECTION.
       data division.
       WORKING-STORAGE SECTION.
       01  inp-card.
         03  inp-card-ch      pic x(01) occurs 20 times.
       01  ws-result          pic 9(01).
         88  pass-luhn-test             value 0.

       PROCEDURE DIVISION.
           move "49927398716"       to inp-card
           perform test-card
           move "49927398717"       to inp-card
           perform test-card
           move "1234567812345678"  to inp-card
           perform test-card
           move "1234567812345670"  to inp-card
           perform test-card
           stop run
           .
       test-card.
           call "LUHN" using inp-card, ws-result
           if pass-luhn-test
             display "input=" inp-card "pass"
           else
             display "input=" inp-card "fail"
           .

       END PROGRAM LUHNTEST.
       IDENTIFICATION DIVISION.
       PROGRAM-ID.  LUHN.
       ENVIRONMENT DIVISION.
       INPUT-OUTPUT SECTION.
       DATA DIVISION.
       WORKING-STORAGE SECTION.
       01  maxlen           pic 9(02) comp value 16.
       01  inplen           pic 9(02) comp value 0.
       01  i                pic 9(02) comp value 0.
       01  j                pic 9(02) comp value 0.
       01  l                pic 9(02) comp value 0.
       01  dw               pic 9(02) comp value 0.
       01  ws-total         pic 9(03) comp value 0.
       01  ws-prod          pic 99.
       01  filler redefines ws-prod.
         03  ws-prod-tens   pic 9.
         03  ws-prod-units  pic 9.
       01  ws-card.
         03  filler           occurs 16 times depending on maxlen.
           05  ws-card-ch     pic x(01).
           05  ws-card-digit redefines ws-card-ch  pic 9(01).
       LINKAGE SECTION.
       01  inp-card.
         03  inp-card-ch      pic x(01) occurs 20 times.
       01  ws-result          pic 9(01).
         88  pass-luhn-test             value 0.

       PROCEDURE DIVISION using inp-card, ws-result.
           perform varying i from 1 by +1
           until i > maxlen
           or    inp-card-ch (i) = space
           end-perform
           compute l = i - 1
           compute inplen = l
           perform varying j from 1 by +1
           until j > inplen
             if l < 1
               move "0"             to ws-card-ch (j)
             else
               move inp-card-ch (l) to ws-card-ch (j)
               compute l = l - 1
             end-if
           end-perform
           move 0 to ws-total
           perform varying i from 1 by +1
           until i > inplen
             compute dw = 2 - (i - 2 * function integer (i / 2))
             compute ws-prod = ws-card-digit (i) * dw
             compute ws-total = ws-total
                              + ws-prod-tens
                              + ws-prod-units
           end-perform
           compute ws-result = ws-total - 10 * function integer (ws-total / 10)
           goback
           .
       END PROGRAM LUHN.


(defun luhn (n)
  (labels ((sum-digits (n) (if (> n 9) (- n 9) n)))
    (let ((n* (reverse n)) (l (length n)))
      (let ((s1 (loop for i from 0 below l by 2
		   summing (digit-char-p (aref n* i))))
	    (s2 (loop for i from 1 below l by 2
		   summing (sum-digits (* 2 (digit-char-p (aref n* i)))))))
	(zerop (mod (+ s1 s2) 10))))))


include "cowgol.coh";

# Given a string containing the digits of a credit card number,
# see if it passes the Luhn test.
sub luhn(card: [uint8]): (ok: uint8) is
    # Scan ahead to last digit, counting digits
    var n: uint8 := 0;
    while [card] != 0 loop
        n := n + 1;
        card := @next card;
    end loop;

    var sum: uint8 := 0;
    while n > 0 loop
        # odd digit is simply added
        card := @prev card;
        n := n - 1;
        sum := sum + ([card] - '0');

        # if uneven amount of digits, stop
        if n == 0 then break; end if;

        # even digit
        card := @prev card;
        n := n - 1;
        var digit := [card] - '0';

        # it is good to avoid unnecessary multiplication/
        # division, since 8-bit processors and microcontrollers
        # don't tend to have that in hardware
        if digit < 5 then
            sum := sum + digit + digit;
        else
            digit := digit - 5;
            sum := sum + digit + digit + 1;
        end if;
    end loop;

    # there is no boolean type, comparisons only work
    # in conditionals; this is the only way to return
    # a status
    if sum % 10 == 0 then
        ok := 1;
    else
        ok := 0;
    end if;
end sub;

# Test and print
sub test(card: [uint8]) is
    var msg: [uint8][] := {"Fail", "Pass"};
    print(card);
    print(": ");
    print(msg[luhn(card)]);
    print_nl();
end sub;

test("49927398716");
test("49927398717");
test("1234567812345678");
test("1234567812345670");


import std.algorithm, std.range, std.string;

enum luhnTest = (in string n) pure /*nothrow*/ @safe /*@nogc*/ =>
    retro(n)
    .zip(only(1, 2).cycle)
    .map!(p => (p[0] - '0') * p[1])
    .map!(d => d / 10 + d % 10)
    .sum % 10 == 0;

void main() {
    assert("49927398716 49927398717 1234567812345678 1234567812345670"
           .split.map!luhnTest.equal([true, false, false, true]));
}


proc nonrec luhn(*char num) bool:
    [10] byte map = (0, 2, 4, 6, 8, 1, 3, 5, 7, 9);
    byte total, digit;
    *char start;
    bool even;

    start := num;
    total := 0;
    even := true;
    while num* /= '\e' do num := num + 1 od;
    while
        num := num - 1;
        num >= start
    do
        digit := num* - '0';
        even := not even;
        if even then digit := map[digit] fi;
        total := total + digit
    od;

    total % 10 = 0
corp

proc nonrec test(*char num) void:
    writeln(num, ": ", if luhn(num) then "pass" else "fail" fi)
corp

proc nonrec main() void:
    test("49927398716");
    test("49927398717");
    test("1234567812345678");
    test("1234567812345670")
corp


;; value for 'even' numbers
(define (even-val n) (if (> n 4) (+ n n -9) (+ n n)))

;;Luhn test
;; input : a string of decimal digits
;; output #t or #f
(define (valid nums (odd #f ))
    (let ((nums (map string->number (reverse (string->list nums)))))
    (= 0 (modulo
       (for/sum ((n nums)) (set! odd (not odd)) (if odd n (even-val n)))
       10))))

(valid "49927398716") → #t
(valid "1234567812345670") → #t
(valid "1234567812345678") → #f
(valid "49927398717") → #f


defmodule Luhn do
  def valid?(cc) when is_binary(cc), do: String.to_integer(cc) |> valid?
  def valid?(cc) when is_integer(cc) do
    0 == Integer.digits(cc)
         |> Enum.reverse
         |> Enum.chunk(2, 2, [0])
         |> Enum.reduce(0, fn([odd, even], sum) -> Enum.sum([sum, odd | Integer.digits(even*2)]) end)
         |> rem(10)
  end
end

numbers = ~w(49927398716 49927398717 1234567812345678 1234567812345670)
for n <- numbers, do: IO.puts "#{n}: #{Luhn.valid?(n)}"


(require 'seq)

(defun luhn (str)
  "Check if STR is a valid credit card number using the Luhn algorithm."
  (if (string-match-p "[^0-9]" str)
      (error "String contains invalid character")
    (let ((digit-list (reverse (mapcar #'(lambda (x) (- x 48))
                                         (string-to-list str)))))
        (zerop
         (mod (apply #'+ (seq-map-indexed
                          (lambda (elt idx)
                            (if (not (zerop (% idx 2)))
                                (if (> (* 2 elt) 9)
                                    (- (* 2 elt) 9)
                                  (* 2 elt))
                              elt))
                          digit-list))
              10)))))

(mapcar #'luhn '("49927398716" "49927398717" "1234567812345678" "1234567812345670"))


-module(luhn_test).

-export( [credit_card/1, task/0] ).

luhn_sum([Odd, Even |Rest]) when Even >= 5 ->
    Odd + 2 * Even - 10 + 1 + luhn_sum(Rest);
luhn_sum([Odd, Even |Rest]) ->
    Odd + 2 * Even + luhn_sum(Rest);
luhn_sum([Odd]) ->
    Odd;
luhn_sum([]) ->
    0.

check( Sum ) when (Sum rem 10) =:= 0 -> valid;
check( _Sum ) -> invalid.

credit_card(Digits) ->
    check(luhn_sum(lists:map(fun(D) -> D-$0 end, lists:reverse(Digits)))).

task() ->
    Numbers = ["49927398716", "49927398717", "1234567812345678", "1234567812345670"],
    [io:fwrite("~s: ~p~n", [X, credit_card(X)]) || X <- Numbers].


function luhn(sequence cc)
    integer isOdd, oddSum, evenSum, digit
    isOdd = 1
    oddSum = 0
    evenSum = 0
    for i = length(cc) to 1 by -1 do
        digit = cc[i] - '0'
        if isOdd then
            oddSum += digit
        else
            evenSum += floor(digit / 5) + remainder(2 * digit, 10)
        end if
        isOdd = not isOdd
    end for
    return not remainder(oddSum + evenSum, 10)
end function

constant cc_numbers = {
    "49927398716",
    "49927398717",
    "1234567812345678",
    "1234567812345670"
}

for i = 1 to length(cc_numbers) do
    printf(1,"%s = %d\n", {cc_numbers[i], luhn(cc_numbers[i])})
end for


luhnChecked
=LAMBDA(s,
    LET(
        ns, REVERSECOLS(VALUE(CHARSROW(s))),
        ixs, SEQUENCE(1, COLUMNS(ns), 1, 1),

        0 = MOD(SUM(
                FILTER(ns, 0 <> MOD(ixs, 2))
            ) + (
                LAMBDA(n,
                    DIGITSUM(
                        CONCAT(TEXT(2 * n, "0"))
                    )
                )(
                    FILTER(ns, 0 = MOD(ixs, 2))
                )
            ),
            10
        )
    )
)


let luhn (s:string) =
  let rec g r c = function
  | 0 -> r
  | i ->
      let d = ((int s.[i - 1]) - 48) <<< c
      g (r + if d < 10 then d else d - 9) (1 - c) (i - 1)
  (g 0 0 s.Length) % 10 = 0


USING: kernel math math.parser math.order math.ranges sequences ;
IN: luhn

: reversed-digits ( n -- list )
    { } swap
    [ dup 0 > ]
        [ 10 /mod  swapd suffix  swap ]
    while drop ;

: luhn-digit  ( n -- n )
    reversed-digits dup length <iota> [
        2dup swap nth
        swap odd? [ 2 *  10 /mod + ] when
    ] map sum 10 mod
    nip ;

: luhn? ( n -- ? )
    luhn-digit 0 = ;


: luhn ( addr len -- ? )
  0 >r over +             ( R: sum )
  begin  1- 2dup <=
  while                   \ odd
         dup [email protected] [char] 0 -
         r> + >r
         1- 2dup <=
  while                   \ even
         dup [email protected] [char] 0 -
         2* 10 /mod +     \ even digits doubled, split, and summed
         r> + >r
  repeat then
  2drop  r> 10 mod 0= ;

s" 49927398716"      luhn .   \ -1
s" 49927398717"      luhn .   \ 0
s" 1234567812345678" luhn .   \ 0
s" 1234567812345670" luhn .   \ -1


program luhn
  implicit none
  integer              :: nargs
  character(len=20)    :: arg
  integer              :: alen, i, dr
  integer, allocatable :: number(:)
  integer, parameter   :: drmap(0:9) = [0, 2, 4, 6, 8, 1, 3, 5, 7, 9]

  ! Get number
  nargs = command_argument_count()
  if (nargs /= 1) then
     stop
  end if
  call get_command_argument(1, arg, alen)
  allocate(number(alen))
  do i=1, alen
     number(alen-i+1) = iachar(arg(i:i)) - iachar('0')
  end do

  ! Calculate number
  dr = 0
  do i=1, alen
     dr = dr + merge(drmap(number(i)), number(i), mod(i,2) == 0)
  end do

  if (mod(dr,10) == 0) then
     write(*,'(a,i0)') arg(1:alen)//' is valid'
  else
     write(*,'(a,i0)') arg(1:alen)//' is not valid'
  end if
end program luhn

! Results:
! 49927398716 is valid
! 49927398717 is not valid
! 1234567812345678 is not valid
! 1234567812345670 is valid


' version 05-07-2015
' compile with: fbc -s console

#Ifndef TRUE        ' define true and false for older freebasic versions
    #Define FALSE 0
    #Define TRUE Not FALSE
#EndIf

Function luhntest(cardnr As String) As Integer

    cardnr = Trim(cardnr) ' we don't want spaces
    Dim As String reverse_nr = cardnr
    Dim As Integer i, j, s1, s2, l = Len(cardnr) - 1

    ' reverse string
    For i = 0 To l
        reverse_nr[i] = cardnr[l - i]
    Next
    ' sum odd numbers
    For i = 0 To l Step 2
        s1 = s1 + (reverse_nr[i] - Asc("0"))
    Next
    ' sum even numbers
    For i = 1 To l Step 2
        j = reverse_nr[i] - Asc("0")
        j = j * 2
        If j > 9 Then j = j Mod 10 + 1
        s2 = s2 + j
    Next

    If (s1 + s2) Mod 10 = 0 Then
        Return TRUE
    Else
        Return FALSE
    End If

End Function

' ------=< MAIN >=------

Dim As String input_nr(1 To ...) = {"49927398716", "49927398717",_
                          "1234567812345678", "1234567812345670"}
Dim As Integer a

Print  "Task test number 49927398716 should be TRUE, report back as ";
Print IIf(luhntest("49927398716" ) = TRUE, "TRUE", "FALSE")
Print : Print

Print "test card nr:"
For a = 1 To UBound(input_nr)
    Print input_nr(a); " = "; IIf(luhntest(input_nr(a)) = TRUE, "TRUE", "FALSE")
Next

' empty keyboard buffer
While InKey <> "" : Wend
Print : Print "hit any key to end program"
Sleep
End


V prod = 1
V s = 0

-V
   x = +5
   y = -5
   z = -2
   one = 1
   three = 3
   seven = 7

F body(j)
   :s += abs(j)
   I abs(:prod) < 2 ^ 27 & j != 0
      :prod *= j

L(j) (-three .. 3 ^ 3).step(three) {body(j)}
L(j) (-seven .. seven).step(x)     {body(j)}
L(j) 555 .. 550 - y                {body(j)}
L(j) (22 .. -28).step(-three)      {body(j)}
L(j) 1927 .. 1939                  {body(j)}
L(j) (x .. y).step(z)              {body(j)}
L(j) 11 ^ x .. 11 ^ x + one        {body(j)}

V ss = String(s)
V ps = String(prod)
V m = max(ss.len, ps.len)
print(‘ sum = ’ss.rjust(m))
print(‘prod = ’ps.rjust(m))


program luhn;

  function lunh(arg: string): boolean;
  var
    i, sum: integer;
    temp: byte;
  begin
    sum := 0;
    for i:= length(arg) downto 1 do begin  // Run the characters backwards
      temp := byte(arg[i])-48;             // Convert from ASCII to byte
      if (length(arg)-i) mod 2 = 0
        then sum := sum + temp             // Odd characters just add
        else if temp < 5
           then sum := sum + 2*temp        // Even characters add double
           else sum := sum + (2*temp)-9;   // or sum the digits of the doubling
    end;
    result := sum mod 10 = 0;              // Return true if sum ends in a 0
  end;

begin
  writeln('     49927398716: ', lunh('49927398716'));
  writeln('     49927398717: ', lunh('49927398717'));
  writeln('1234567812345678: ', lunh('1234567812345678'));
  writeln('1234567812345670: ', lunh('1234567812345670'));
end.


/* ARM assembly AARCH64 Raspberry PI 3B */
/*  program loopnrange64.s   */

/*******************************************/
/* Constantes file                         */
/*******************************************/
/* for this file see task include a file in language AArch64 assembly*/
.include "../includeConstantesARM64.inc"

/*********************************/
/* Initialized data              */
/*********************************/
.data
szMessResult:      .asciz "@ \n"                    // message result
szCarriageReturn:  .asciz "\n"
/*********************************/
/* UnInitialized data            */
/*********************************/
.bss
qSum:                      .skip 8         // this program store sum and product in memory
qProd:                     .skip 8         // it is possible to use registers x22 and x28
sZoneConv:                 .skip 24
/*********************************/
/*  code section                 */
/*********************************/
.text
.global main
main:                                       // entry of program
    ldr x0,qAdrqProd
    mov x1,1
    str x1,[x0]                             // init product
    ldr x0,qAdrqSum
    mov x1,0
    str x1,[x0]                             // init sum

    mov x25,5                               // x
    mov x24,-5                              // y
    mov x26,-2                              // z
    mov x21,1                               // one
    mov x23,3                               // three
    mov x27,7                               // seven

                                            // loop one
    mov x0,3
    mov x1,3
    bl computePow                           // compute 3 pow 3
    mov x20,x0                              // save result
    mvn x9,x23                              // x9 = - three
    add x9,x9,1
1:
    mov x0,x9
    bl computeSumProd
    add x9,x9,x23                           // increment with three
    cmp x9,x20
    ble 1b
                                            // loop two
    mvn x9,x27                              // x9 = - seven
    add x9,x9,1
2:
    mov x0,x9
    bl computeSumProd
    add x9,x9,x25                           // increment with x
    cmp x9,x27                              // compare to seven
    ble 2b

                                            // loop three
    mov x9,#550
    sub x20,x9,x24                          // x20 = 550 - y
    mov x9,#555
3:
    mov x0,x9
    bl computeSumProd
    add x9,x9,#1
    cmp x9,x20
    ble 3b
                                            // loop four
    mov x9,#22
4:
    mov x0,x9
    bl computeSumProd
    sub x9,x9,x23                           // decrement with three
    cmp x9,#-28
    bge 4b
                                            // loop five
    mov x9,1927
    mov x20,1939
5:
    mov x0,x9
    bl computeSumProd
    add x9,x9,1
    cmp x9,x20
    ble 5b
                                            // loop six
    mov x9,x25                              // x9 = x
    mvn x20,x26                             // x20 = - z
    add x20,x20,1
6:
    mov x0,x9
    bl computeSumProd
    sub x9,x9,x20
    cmp x9,x24
    bge 6b
                                            // loop seven
    mov x0,x25
    mov x1,11
    bl computePow                           // compute 11 pow x
    add x20,x0,x21                          // + one
    mov x9,x0
7:
    mov x0,x9
    bl computeSumProd
    add x9,x9,1
    cmp x9,x20
    ble 7b
                                            // display result
    ldr x0,qAdrqSum
    ldr x0,[x0]
    ldr x1,qAdrsZoneConv                    // signed conversion value
    bl conversion10S                        // decimal conversion
    ldr x0,qAdrszMessResult
    ldr x1,qAdrsZoneConv
    bl strInsertAtCharInc                   // insert result at @ character
    bl affichageMess                        // display message
    ldr x0,qAdrszCarriageReturn
    bl affichageMess                        // display return line
    ldr x0,qAdrqProd
    ldr x0,[x0]
    ldr x1,qAdrsZoneConv                    // conversion value
    bl conversion10S                        // signed decimal conversion
    ldr x0,qAdrszMessResult
    ldr x1,qAdrsZoneConv
    bl strInsertAtCharInc                   // insert result at  @ character
    bl affichageMess                        // display message
    ldr x0,qAdrszCarriageReturn
    bl affichageMess                        // display return line

100:                                        // standard end of the program
    mov x0,0                                // return code
    mov x8,EXIT                             // request to exit program
    svc 0                                   // perform the system call

qAdrsZoneConv:            .quad sZoneConv
qAdrszMessResult:         .quad szMessResult
qAdrszCarriageReturn:     .quad szCarriageReturn
/******************************************************************/
/*     compute the sum and prod                         */
/******************************************************************/
/* x0 contains the number  */
computeSumProd:
    stp x1,lr,[sp,-16]!          // save  registers
    asr x10,x0,#63
    eor x12,x10,x0
    sub x12,x12,x10             // compute absolue value
    ldr x13,qAdrqSum            // load sum
    ldr x11,[x13]
    add x11,x11,x12             // add sum
    str x11,[x13]               // store sum
    cmp x0,#0                   // j = 0 ?
    beq 100f                    // yes
    ldr x13,qAdrqProd
    ldr x11,[x13]
    asr x12,x11,#63             // compute absolute value of prod
    eor x14,x11,x12
    sub x12,x14,x12
    ldr x10,qVal2P27
    cmp x12,x10                 // compare 2 puissance 27
    bgt 100f
    mul x11,x0,x11
    str x11,[x13]               // store prod
100:
    ldp x1,lr,[sp],16           // restaur  2 registers
    ret                         // return to address lr x230
qAdrqSum:                .quad qSum
qAdrqProd:               .quad qProd
qVal2P27:                .quad 1<<27
/******************************************************************/
/*     compute pow                         */
/******************************************************************/
/* x0 contains pow  */
/* x1 contains number */
computePow:
    stp x1,lr,[sp,-16]!          // save  registers
    mov x12,x0
    mov x0,#1
1:
    cmp x12,#0
    ble 100f
    mul x0,x1,x0
    sub x12,x12,#1
    b 1b
100:
    ldp x1,lr,[sp],16           // restaur  2 registers
    ret                         // return to address lr x230
/********************************************************/
/*        File Include fonctions                        */
/********************************************************/
/* for this file see task include a file in language AArch64 assembly */
.include "../includeARM64.inc"


with Ada.Text_IO; use Ada.Text_IO;
with Ada.Containers.Vectors;

procedure Main is
   package int_vector is new Ada.Containers.Vectors
     (Index_Type => Natural, Element_Type => Integer);
   use int_vector;

   summing_values : Vector := Empty_Vector;

   prod : Integer := 1;
   sum  : Integer := 0;
   x    : Integer := 5;
   y    : Integer := -5;
   z    : Integer := -2;
   N    : Integer;
begin
   N := -3;
   while N <= 3**3 loop
      summing_values.Append (N);
      N := N + 3;
   end loop;

   N := -7;
   while N <= 7 loop
      summing_values.Append (N);
      N := N + x;
   end loop;

   for I in 555 .. 550 - y loop
      summing_values.Append (I);
   end loop;

   N := 22;
   while N >= -28 loop
      summing_values.Append (N);
      N := N - 3;
   end loop;

   for I in 1_927 .. 1_939 loop
      summing_values.Append (I);
   end loop;

   N := x;
   while N >= y loop
      summing_values.Append (N);
      N := N + z;
   end loop;

   for I in 11**x .. 11**x + 1 loop
      summing_values.Append (I);
   end loop;

   for value of summing_values loop
      sum := sum + abs (value);
      if abs (prod) < 2**27 and then value /= 0 then
         prod := prod * value;
      end if;
   end loop;

   Put_Line ("sum = " & sum'Image);
   Put_Line ("prod = " & prod'Image);

end Main;


begin
  integer prod, sum, x, y, z, one, three, seven;
  integer j;
  prod := 1;
  sum := 0;
  x := 5; y := -5; z := -2;
  one := 1;
  three := 3;
  seven := 7;

  for j := -three  step  three  until 3^3    ,
           -seven  step      x  until seven  ,
              555  step      1  until 550 - y,
               22  step -three  until -28    ,
             1927  step      1  until 1939   ,
                x  step      z  until y      ,
             11^x  step      1  until 11^x + one
  do begin
    sum := sum + iabs(j);
    if iabs(prod) < 2^27 & j != 0 then prod := prod*j
  end;

  outstring(1, " sum= "); outinteger(1, sum);  outstring(1, "\n");
  outstring(1, "prod= "); outinteger(1, prod); outstring(1, "\n")
end


def luhn_checksum( card_number ) =
  def digits_of( n ) = [int(d) | d <- n.toString()]

  digits = digits_of( card_number ).reverse()
  odd_digits = digits(0:digits.length():2)
  even_digits = digits(1:digits.length():2)
  (sum( odd_digits ) + sum( sum(digits_of(d*2)) | d <- even_digits )) mod 10

def is_luhn_valid( card_number ) = luhn_checksum( card_number ) == 0

for n <- [49927398716, 49927398717, 1234567812345678, 1234567812345670]
  println( n + ' is ' + (if is_luhn_valid(n) then 'valid' else 'invalid') )


Public Sub Main()
Dim sTrial As String[] = ["49927398716", "49927398717", "1234567812345678", "1234567812345670"]
Dim sRev As String
Dim siCount, siOdd, siEven, siHold, siQty As Short

For siQty = 0 To sTrial.Max

  siOdd = 0
  siEven = 0
  sRev = ""

  For siCount = Len(sTrial[siQty]) DownTo 1
    sRev &= Mid(sTrial[siQty], siCount, 1)
  Next

  For siCount = 1 To Len(sRev)
    If Odd(siCount) Then siOdd += Val(Mid(sRev, siCount, 1))
    If Even(siCount) Then
      siHold = Val(Mid(sRev, siCount, 1)) * 2
      If siHold > 9 Then
        siEven += Val(Mid(Str(siHold), 1, 1)) + Val(Mid(Str(siHold), 2, 1))
      Else
        siEven += Val(Mid(sRev, siCount, 1)) * 2
      End If
    End If
  Next

  sRev = Str(siOdd + siEven)
  If sRev Ends "0" Then
    Print sTrial[siQty] & " is a valid number"
  Else
    Print sTrial[siQty] & " is NOT a valid number"
  End If
Next

End