class Quaternion {
    has Real ( $.r, $.i, $.j, $.k );

    multi method new ( Real $r, Real $i, Real $j, Real $k ) {
        self.bless: :$r, :$i, :$j, :$k;
    }
    multi qu(*@r) is export { Quaternion.new: |@r }
    sub postfix:<j>(Real $x) is export { qu 0, 0, $x, 0 }
    sub postfix:<k>(Real $x) is export { qu 0, 0, 0, $x }

    method Str   () { "$.r + {$.i}i + {$.j}j + {$.k}k" }
    method reals () { $.r, $.i, $.j, $.k }
    method conj  () { qu $.r, -$.i, -$.j, -$.k }
    method norm  () { sqrt [+] self.reals X** 2 }

    multi infix:<eqv> ( Quaternion $a, Quaternion $b ) is export { $a.reals eqv $b.reals }

    multi infix:<+> ( Quaternion $a,       Real $b ) is export { qu $b+$a.r, $a.i, $a.j, $a.k }
    multi infix:<+> (       Real $a, Quaternion $b ) is export { qu $a+$b.r, $b.i, $b.j, $b.k }
    multi infix:<+> ( Quaternion $a,    Complex $b ) is export { qu $b.re + $a.r, $b.im + $a.i, $a.j, $a.k }
    multi infix:<+> (    Complex $a, Quaternion $b ) is export { qu $a.re + $b.r, $a.im + $b.i, $b.j, $b.k }
    multi infix:<+> ( Quaternion $a, Quaternion $b ) is export { qu $a.reals Z+ $b.reals }

    multi prefix:<-> ( Quaternion $a ) is export { qu $a.reals X* -1 }

    multi infix:<*> ( Quaternion $a,       Real $b ) is export { qu $a.reals X* $b }
    multi infix:<*> (       Real $a, Quaternion $b ) is export { qu $b.reals X* $a }
    multi infix:<*> ( Quaternion $a,    Complex $b ) is export { $a * qu $b.reals, 0, 0 }
    multi infix:<*> ( Complex $a,    Quaternion $b ) is export { $b R* qu $a.reals, 0, 0 }

    multi infix:<*> ( Quaternion $a, Quaternion $b ) is export {
	my @a_rijk            = $a.reals;
	my ( $r, $i, $j, $k ) = $b.reals;
	return qu [+]( @a_rijk Z* $r, -$i, -$j, -$k ), # real
		  [+]( @a_rijk Z* $i,  $r,  $k, -$j ), # i
		  [+]( @a_rijk Z* $j, -$k,  $r,  $i ), # j
		  [+]( @a_rijk Z* $k,  $j, -$i,  $r ); # k
    }
}
import Quaternion;

my $q  = 1 + 2i + 3j + 4k;
my $q1 = 2 + 3i + 4j + 5k;
my $q2 = 3 + 4i + 5j + 6k;
my $r  = 7;

say "1) q norm  = {$q.norm}";
say "2) -q      = {-$q}";
say "3) q conj  = {$q.conj}";
say "4) q  + r  = {$q + $r}";
say "5) q1 + q2 = {$q1 + $q2}";
say "6) q  * r  = {$q  * $r}";
say "7) q1 * q2 = {$q1 * $q2}";
say "8) q1q2 { $q1 * $q2 eqv $q2 * $q1 ?? '==' !! '!=' } q2q1";


quaternion: context [
   quaternion!: make typeset! [block! hash! vector!]
   multiply: function [q [integer! float! quaternion!] p [integer! float! quaternion!]][
      case [
         number? q [collect [forall p [keep p/1 * q]]]
         number? p [collect [forall q [keep q/1 * p]]]
         'else [
            reduce [
               (q/1 * p/1) - (q/2 * p/2) - (q/3 * p/3) - (q/4 * p/4)
               (q/1 * p/2) + (q/2 * p/1) + (q/3 * p/4) - (q/4 * p/3)
               (q/1 * p/3) + (q/3 * p/1) + (q/4 * p/2) - (q/2 * p/4)
               (q/1 * p/4) + (q/4 * p/1) + (q/2 * p/3) - (q/3 * p/2)
            ]
         ]
      ]
   ]
   add: func [q [integer! float! quaternion!] p [integer! float! quaternion!]][
      case [
         number? q [head change copy p p/1 + q]
         number? p [head change copy q q/1 + p]
         'else [collect [forall q [keep q/1 + p/(index? q)]]]
      ]
   ]
   negate: func [q [quaternion!]][collect [forall q [keep 0 - q/1]]]
   conjugate: func [q [quaternion!]][collect [keep q/1  q: next q  forall q [keep 0 - q/1]]]
   norm: func [q [quaternion!]][sqrt first multiply q conjugate copy q]
   normalize: function [q [quaternion!]][n: norm q   collect [forall q [keep q/1 / n]]]
   inverse: func [q [quaternion!]][(conjugate q) / ((norm q) ** 2)]
]

set [q q1 q2 r] [[1 2 3 4] [2 3 4 5] [3 4 5 6] 7]

print [{
1. The norm of a quaternion:
`quaternion/norm q` =>} quaternion/norm q {

2. The negative of a quaternion:
`quaternion/negate q` =>} mold quaternion/negate q {

3. The conjugate of a quaternion:
quaternion/conjugate q =>} mold quaternion/conjugate q {

4. Addition of a real number `r` and a quaternion `q`:
`quaternion/add r q` =>} mold quaternion/add r q {
`quaternion/add q r` =>} mold quaternion/add q r {

5. Addition of two quaternions:
`quaternion/add q1 q2` =>} mold quaternion/add q1 q2 {

6. Multiplication of a real number and a quaternion:
`quaternion/multiply q r` =>} mold quaternion/multiply q r {
`quaternion/multiply r q` =>} mold quaternion/multiply r q {

7. Multiplication of two quaternions `q1` and `q2` is given by:
`quaternion/multiply q1 q2` =>} mold quaternion/multiply q1 q2 {

8. Show that, for the two quaternions `q1` and `q2`:
`equal? quaternion/multiply q1 q2 mold quaternion/multiply q2 q1` =>}
equal? quaternion/multiply q1 q2 quaternion/multiply q2 q1]


/*REXX program performs some operations on  quaternion type numbers and displays results*/
                       q = 1 2 3 4    ;                     q1 = 2 3 4 5
                       r = 7          ;                     q2 = 3 4 5 6
call qShow  q                         ,     'q'
call qShow  q1                        ,     'q1'
call qShow  q2                        ,     'q2'
call qShow  r                         ,     'r'
call qShow  qNorm(q)                  ,     'norm q'                  ,        "task 1:"
call qShow  qNeg(q)                   ,     'negative q'              ,        "task 2:"
call qShow  qConj(q)                  ,     'conjugate q'             ,        "task 3:"
call qShow  qAdd( r, q  )             ,     'addition r+q'            ,        "task 4:"
call qShow  qAdd(q1, q2 )             ,     'addition q1+q2'          ,        "task 5:"
call qShow  qMul( q, r  )             ,     'multiplication q*r'      ,        "task 6:"
call qShow  qMul(q1, q2 )             ,     'multiplication q1*q2'    ,        "task 7:"
call qShow  qMul(q2, q1 )             ,     'multiplication q2*q1'    ,        "task 8:"
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
qConj: procedure; parse arg x;    call qXY;    return    x.1    (-x.2)    (-x.3)    (-x.4)
qNeg:  procedure; parse arg x;    call qXY;    return   -x.1    (-x.2)    (-x.3)    (-x.4)
qNorm: procedure; parse arg x;    call qXY;    return sqrt(x.1**2 +x.2**2 +x.3**2 +x.4**2)
qAdd:  procedure; parse arg x,y;  call qXY 2;  return x.1+y.1  x.2+y.2  x.3+y.3  x.4+y.4
/*──────────────────────────────────────────────────────────────────────────────────────*/
qMul:  procedure; parse arg x,y;  call qXY y
       return x.1*y.1 -x.2*y.2 -x.3*y.3 -x.4*y.4     x.1*y.2 +x.2*y.1 +x.3*y.4 -x.4*y.3 ,
              x.1*y.3 -x.2*y.4 +x.3*y.1 +x.4*y.2     x.1*y.4 +x.2*y.3 -x.3*y.2 +x.4*y.1
/*──────────────────────────────────────────────────────────────────────────────────────*/
qShow: procedure; parse arg x;          call qXY;                  $=
             do m=1  for 4;  _= x.m;    if _==0  then iterate;     if _>=0  then _= '+'_
             if m\==1  then _= _ || substr('∙ijk', m, 1);          $= strip($ || _, , "+")
             end   /*m*/
       say left(arg(3), 9)   right(arg(2), 20)       ' ──► '       $;           return $
/*──────────────────────────────────────────────────────────────────────────────────────*/
qXY:                     do n=1  for 4; x.n= word( word(x, n) 0, 1)/1;  end /*n*/
       if arg()==1  then do m=1  for 4; y.m= word( word(y, m) 0, 1)/1;  end /*m*/;  return
/*──────────────────────────────────────────────────────────────────────────────────────*/
sqrt:  procedure; parse arg x;  if x=0  then return 0;   d= digits();   i=;   m.=9;  h=d+6
       numeric digits; numeric form;    if x<0  then parse value  -x  'i'    with    x  i
       parse value format(x, 2, 1, , 0) 'E0'   with   g  "E"  _  .;       g= g *.5'e'_ % 2
          do j=0  while h>9;       m.j=h;                 h= h % 2   +  1;      end  /*j*/
          do k=j+5  to 0  by -1;   numeric digits m.k;    g= (g + x/g)* .5;     end  /*k*/
       numeric digits d;           return (g/1)i                 /*make complex if  X<0 */


class Quaternion
  def initialize(*parts)
    raise ArgumentError, "wrong number of arguments (#{parts.size} for 4)" unless parts.size == 4
    raise ArgumentError, "invalid value of quaternion parts #{parts}" unless parts.all? {|x| x.is_a?(Numeric)}
    @parts = parts
  end

  def to_a;          @parts;                                       end
  def to_s;          "Quaternion#{@parts.to_s}"                    end
  alias inspect to_s
  def complex_parts; [Complex(*to_a[0..1]), Complex(*to_a[2..3])]; end

  def real;          @parts.first;                                 end
  def imag;          @parts[1..3];                                 end
  def conj;          Quaternion.new(real, *imag.map(&:-@));        end
  def norm;          Math.sqrt(to_a.reduce(0){|sum,e| sum + e**2}) end # In Rails: Math.sqrt(to_a.sum { e**2 })

  def ==(other)
    case other
    when Quaternion; to_a == other.to_a
    when Numeric;    to_a == [other, 0, 0, 0]
    else             false
    end
  end
  def -@;            Quaternion.new(*to_a.map(&:-@));              end
  def -(other);      self + -other;                                end

  def +(other)
    case other
    when Numeric
      Quaternion.new(real + other, *imag)
    when Quaternion
      Quaternion.new(*to_a.zip(other.to_a).map { |x,y| x + y }) # In Rails: zip(other).map(&:sum)
    end
  end

  def *(other)
    case other
    when Numeric
      Quaternion.new(*to_a.map { |x| x * other })
    when Quaternion
      # Multiplication of quaternions in C x C space. See "Cayley-Dickson construction".
      a, b, c, d = *complex_parts, *other.complex_parts
      x, y = a*c - d.conj*b, a*d + b*c.conj
      Quaternion.new(x.real, x.imag, y.real, y.imag)
    end
  end

  # Coerce is called by Ruby to return a compatible type/receiver when the called method/operation does not accept a Quaternion
  def coerce(other)
    case other
    when Numeric then [Scalar.new(other), self]
    else raise TypeError, "#{other.class} can't be coerced into #{self.class}"
    end
  end

  class Scalar
    def initialize(val); @val = val;                            end
    def +(other);        other + @val;                          end
    def *(other);        other * @val;                          end
    def -(other);        Quaternion.new(@val, 0, 0, 0) - other; end
  end
end

if __FILE__ == $0
  q  = Quaternion.new(1,2,3,4)
  q1 = Quaternion.new(2,3,4,5)
  q2 = Quaternion.new(3,4,5,6)
  r  = 7
  expressions = ["q", "q1", "q2",
                 "q.norm", "-q", "q.conj", "q + r", "r + q","q1 + q2", "q2 + q1",
                 "q * r", "r * q", "q1 * q2", "q2 * q1", "(q1 * q2 != q2 * q1)",
                 "q - r", "r - q"]
  expressions.each do |exp|
    puts "%20s = %s" % [exp, eval(exp)]
  end
end


use std::fmt::{Display, Error, Formatter};
use std::ops::{Add, Mul, Neg};

#[derive(Clone,Copy,Debug)]
struct Quaternion {
    a: f64,
    b: f64,
    c: f64,
    d: f64
}

impl Quaternion {
    pub fn new(a: f64, b: f64, c: f64, d: f64) -> Quaternion {
        Quaternion {
            a: a,
            b: b,
            c: c,
            d: d
        }
    }

    pub fn norm(&self) -> f64 {
        (self.a.powi(2) + self.b.powi(2) + self.c.powi(2) + self.d.powi(2)).sqrt()
    }

    pub fn conjugate(&self) -> Quaternion {
        Quaternion {
            a: self.a,
            b: -self.b,
            c: -self.c,
            d: -self.d
        }
    }
}

impl Add for Quaternion {
    type Output = Quaternion;

    #[inline]
    fn add(self, other: Quaternion) -> Self::Output {
        Quaternion {
            a: self.a + other.a,
            b: self.b + other.b,
            c: self.c + other.c,
            d: self.d + other.d
        }
    }
}

impl Add<f64> for Quaternion {
    type Output = Quaternion;

    #[inline]
    fn add(self, other: f64) -> Self::Output {
        Quaternion {
            a: self.a + other,
            b: self.b,
            c: self.c,
            d: self.d
        }
    }
}

impl Add<Quaternion> for f64 {
    type Output = Quaternion;

    #[inline]
    fn add(self, other: Quaternion) -> Self::Output {
        Quaternion {
            a: other.a + self,
            b: other.b,
            c: other.c,
            d: other.d
        }
    }
}

impl Display for Quaternion {
    fn fmt(&self, f: &mut Formatter) -> Result<(), Error> {
        write!(f, "({} + {}i + {}j + {}k)", self.a, self.b, self.c, self.d)
    }
}

impl Mul for Quaternion {
    type Output = Quaternion;

    #[inline]
    fn mul(self, rhs: Quaternion) -> Self::Output {
        Quaternion {
            a: self.a * rhs.a - self.b * rhs.b - self.c * rhs.c - self.d * rhs.d,
            b: self.a * rhs.b + self.b * rhs.a + self.c * rhs.d - self.d * rhs.c,
            c: self.a * rhs.c - self.b * rhs.d + self.c * rhs.a + self.d * rhs.b,
            d: self.a * rhs.d + self.b * rhs.c - self.c * rhs.b + self.d * rhs.a,
        }
    }
}

impl Mul<f64> for Quaternion {
    type Output = Quaternion;

    #[inline]
    fn mul(self, other: f64) -> Self::Output {
        Quaternion {
            a: self.a * other,
            b: self.b * other,
            c: self.c * other,
            d: self.d * other
        }
    }
}

impl Mul<Quaternion> for f64 {
    type Output = Quaternion;

    #[inline]
    fn mul(self, other: Quaternion) -> Self::Output {
        Quaternion {
            a: other.a * self,
            b: other.b * self,
            c: other.c * self,
            d: other.d * self
        }
    }
}

impl Neg for Quaternion {
    type Output = Quaternion;

    #[inline]
    fn neg(self) -> Self::Output {
        Quaternion {
            a: -self.a,
            b: -self.b,
            c: -self.c,
            d: -self.d
        }
    }
}

fn main() {
    let q0 = Quaternion { a: 1., b: 2., c: 3., d: 4. };
    let q1 = Quaternion::new(2., 3., 4., 5.);
    let q2 = Quaternion::new(3., 4., 5., 6.);
    let r: f64 = 7.;

    println!("q0 = {}", q0);
    println!("q1 = {}", q1);
    println!("q2 = {}", q2);
    println!("r  = {}", r);
    println!();
    println!("-q0 = {}", -q0);
    println!("conjugate of q0 = {}", q0.conjugate());
    println!();
    println!("r + q0 = {}", r + q0);
    println!("q0 + r = {}", q0 + r);
    println!();
    println!("r * q0 = {}", r * q0);
    println!("q0 * r = {}", q0 * r);
    println!();
    println!("q0 + q1 = {}", q0 + q1);
    println!("q0 * q1 = {}", q0 * q1);
    println!();
    println!("q0 * (conjugate of q0) = {}", q0 * q0.conjugate());
    println!();
    println!(" q0 + q1  * q2 = {}", q0 + q1 * q2);
    println!("(q0 + q1) * q2 = {}", (q0 + q1) * q2);
    println!();
    println!(" q0 *  q1  * q2  = {}", q0 *q1 * q2);
    println!("(q0 *  q1) * q2  = {}", (q0 * q1) * q2);
    println!(" q0 * (q1  * q2) = {}", q0 * (q1 * q2));
    println!();
    println!("normal of q0 = {}", q0.norm());
}


case class Quaternion(re: Double = 0.0, i: Double = 0.0, j: Double = 0.0, k: Double = 0.0) {
  lazy val im = (i, j, k)
  private lazy val norm2 = re*re + i*i + j*j + k*k
  lazy val norm = math.sqrt(norm2)

  def negative = Quaternion(-re, -i, -j, -k)
  def conjugate = Quaternion(re, -i, -j, -k)
  def reciprocal = Quaternion(re/norm2, -i/norm2, -j/norm2, -k/norm2)

  def +(q: Quaternion) = Quaternion(re+q.re, i+q.i, j+q.j, k+q.k)
  def -(q: Quaternion) = Quaternion(re-q.re, i-q.i, j-q.j, k-q.k)
  def *(q: Quaternion) = Quaternion(
	 re*q.re - i*q.i - j*q.j - k*q.k,
	 re*q.i + i*q.re + j*q.k - k*q.j,
	 re*q.j - i*q.k + j*q.re + k*q.i,
	 re*q.k + i*q.j - j*q.i + k*q.re
  )
  def /(q: Quaternion) = this * q.reciprocal

  def unary_- = negative
  def unary_~ = conjugate

  override def toString = "Q(%.2f, %.2fi, %.2fj, %.2fk)".formatLocal(java.util.Locale.ENGLISH, re, i, j, k)
}

object Quaternion {
  import scala.language.implicitConversions
  import Numeric.Implicits._

  implicit def number2Quaternion[T:Numeric](n: T) = Quaternion(n.toDouble)
}


$ include "seed7_05.s7i";
  include "float.s7i";
  include "math.s7i";

# Define the quaternion number data type.
const type: quaternion is new object struct
    var float: a is 0.0;
    var float: b is 0.0;
    var float: c is 0.0;
    var float: d is 0.0;
  end struct;

# Create a quaternion number from its real and imaginary parts.
const func quaternion: quaternion
    (in float: a, in float: b, in float: c, in float: d) is func
  result
    var quaternion: aQuaternion is quaternion.value;
  begin
    aQuaternion.a := a;
    aQuaternion.b := b;
    aQuaternion.c := c;
    aQuaternion.d := d;
  end func;

# Helper function for str().
const func string: signed (in float: number, in string: part) is func
  result
    var string: stri is str(number) & part;
  begin
    if number > 0.0 then
      stri := "+" & stri;
    elsif number = 0.0 then
      stri := "";
    end if;
  end func;

# Convert a quaternion number to a string.
const func string: str (in quaternion: number) is func
  result
    var string: stri is "";
  begin
    if number.a <> 0.0 then
      stri &:= str(number.a);
    end if;
    stri &:= signed(number.b, "i");
    stri &:= signed(number.c, "j");
    stri &:= signed(number.d, "k");
  end func;

# Compute the norm of a quaternion number.
const func float: norm (in quaternion: number) is func
  result
    var float: qnorm is 0.0;
  begin
    qnorm := sqrt(
      number.a ** 2.0 + number.b ** 2.0 +
      number.c ** 2.0 + number.d ** 2.0
    );
  end func;

# Compute the negative of a quaternion number.
const func quaternion: - (in quaternion: number) is func
  result
    var quaternion: negatedNumber is quaternion.value;
  begin
    negatedNumber.a := -number.a;
    negatedNumber.b := -number.b;
    negatedNumber.c := -number.c;
    negatedNumber.d := -number.d;
  end func;

# Compute the conjugate of a quaternion number.
const func quaternion: conjugate (in quaternion: number) is func
  result
    var quaternion: conjugateNumber is quaternion.value;
  begin
    conjugateNumber.a :=  number.a;
    conjugateNumber.b := -number.b;
    conjugateNumber.c := -number.c;
    conjugateNumber.d := -number.d;
  end func;

# Add a float to a quaternion number.
const func quaternion: (in quaternion: number) + (in float: real) is func
  result
    var quaternion: sum is quaternion.value;
  begin
    sum.a := number.a + real;
    sum.b := number.b;
    sum.c := number.c;
    sum.d := number.d;
  end func;

# Add a quaternion number to a float.
const func quaternion: (in float: real) + (in quaternion: number) is
  return number + real;

# Add two quaternion numbers.
const func quaternion: (in quaternion: number1) + (in quaternion: number2) is func
  result
    var quaternion: sum is quaternion.value;
  begin
    sum.a := number1.a + number2.a;
    sum.b := number1.b + number2.b;
    sum.c := number1.c + number2.c;
    sum.d := number1.d + number2.d;
  end func;

# Multiply a float and a quaternion number.
const func quaternion: (in float: real) * (in quaternion: number) is func
  result
    var quaternion: product is quaternion.value;
  begin
    product.a := number.a * real;
    product.b := number.b * real;
    product.c := number.c * real;
    product.d := number.d * real;
  end func;

# Multiply a quaternion number and a float.
const func quaternion: (in quaternion: number) * (in float: real) is
  return real * number;

# Multiply two quaternion numbers.
const func quaternion: (in quaternion: x) * (in quaternion: y) is func
  result
    var quaternion: product is quaternion.value;
  begin
    product.a := x.a * y.a - x.b * y.b - x.c * y.c - x.d * y.d;
    product.b := x.a * y.b + x.b * y.a + x.c * y.d - x.d * y.c;
    product.c := x.a * y.c - x.b * y.d + x.c * y.a + x.d * y.b;
    product.d := x.a * y.d + x.b * y.c - x.c * y.b + x.d * y.a;
  end func;

# Allow quaternions to be written using write(), writeln() etc.
enable_output(quaternion);

# Demonstrate quaternion numbers.
const proc: main is func
  local
    const quaternion: q is quaternion(1.0, 2.0, 3.0, 4.0);
    const quaternion: q1 is quaternion(2.0, 3.0, 4.0, 5.0);
    const quaternion: q2 is quaternion(3.0, 4.0, 5.0, 6.0);
    const float: r is 7.0;
  begin
    writeln(" q = " <& q);
    writeln("q1 = " <& q1);
    writeln("q2 = " <& q2);
    writeln(" r = " <& r <& "\n");

    writeln("norm(q) = " <& norm(q));
    writeln("-q = " <& -q);
    writeln("conjugate(q) = " <& conjugate(q));
    writeln("q + r = " <& q + r);
    writeln("r + q = " <& r + q);
    writeln("q1 + q2 = " <& q1 + q2);
    writeln("q2 + q1 = " <& q2 + q1);
    writeln("q * r = " <& q * r);
    writeln("r * q = " <& r * q);
    writeln("q1 * q2 = " <& q1 * q2);
    writeln("q2 * q1 = " <& q2 * q1);
  end func;


class Quaternion(r, i, j, k) {

    func qu(*r) { Quaternion(r...) }

    method to_s  { "#{r} + #{i}i + #{j}j + #{k}k" }
    method reals { [r, i, j, k] }
    method conj  { qu(r, -i, -j, -k) }
    method norm  { self.reals.map { _*_ }.sum.sqrt }

    method ==(Quaternion b) { self.reals == b.reals }

    method +(Number     b) { qu(b+r, i, j, k) }
    method +(Quaternion b) { qu((self.reals ~Z+ b.reals)...) }

    method neg { qu(self.reals.map{ .neg }...) }

    method *(Number     b) { qu((self.reals»*»b)...) }
    method *(Quaternion b) {
        var (r,i,j,k) = b.reals...
        qu(sum(self.reals ~Z* [r, -i, -j, -k]),
           sum(self.reals ~Z* [i,  r,  k, -j]),
           sum(self.reals ~Z* [j, -k,  r,  i]),
           sum(self.reals ~Z* [k,  j, -i,  r]))
    }
}

var q  = Quaternion(1, 2, 3, 4)
var q1 = Quaternion(2, 3, 4, 5)
var q2 = Quaternion(3, 4, 5, 6)
var r  = 7

say "1) q norm  = #{q.norm}"
say "2) -q      = #{-q}"
say "3) q conj  = #{q.conj}"
say "4) q  + r  = #{q + r}"
say "5) q1 + q2 = #{q1 + q2}"
say "6) q  * r  = #{q  * r}"
say "7) q1 * q2 = #{q1 * q2}"
say "8) q1q2 #{ q1*q2 == q2*q1 ? '==' : '!=' } q2q1"


import Foundation

struct Quaternion {
  var a, b, c, d: Double

  static let i = Quaternion(a: 0, b: 1, c: 0, d: 0)
  static let j = Quaternion(a: 0, b: 0, c: 1, d: 0)
  static let k = Quaternion(a: 0, b: 0, c: 0, d: 1)
}
extension Quaternion: Equatable {
  static func ==(lhs: Quaternion, rhs: Quaternion) -> Bool {
    return (lhs.a, lhs.b, lhs.c, lhs.d) == (rhs.a, rhs.b, rhs.c, rhs.d)
  }
}
extension Quaternion: ExpressibleByIntegerLiteral {
  init(integerLiteral: Double) {
    a = integerLiteral
    b = 0
    c = 0
    d = 0
  }
}
extension Quaternion: Numeric {
  var magnitude: Double {
    return norm
  }
  init?<T>(exactly: T) { // stub to satisfy protocol requirements
    return nil
  }
  public static func + (lhs: Quaternion, rhs: Quaternion) -> Quaternion {
    return Quaternion(
      a: lhs.a + rhs.a,
      b: lhs.b + rhs.b,
      c: lhs.c + rhs.c,
      d: lhs.d + rhs.d
    )
  }
  public static func - (lhs: Quaternion, rhs: Quaternion) -> Quaternion {
    return Quaternion(
      a: lhs.a - rhs.a,
      b: lhs.b - rhs.b,
      c: lhs.c - rhs.c,
      d: lhs.d - rhs.d
    )
  }
  public static func * (lhs: Quaternion, rhs: Quaternion) -> Quaternion {
    return Quaternion(
      a: lhs.a*rhs.a - lhs.b*rhs.b - lhs.c*rhs.c - lhs.d*rhs.d,
      b: lhs.a*rhs.b + lhs.b*rhs.a + lhs.c*rhs.d - lhs.d*rhs.c,
      c: lhs.a*rhs.c - lhs.b*rhs.d + lhs.c*rhs.a + lhs.d*rhs.b,
      d: lhs.a*rhs.d + lhs.b*rhs.c - lhs.c*rhs.b + lhs.d*rhs.a
    )
  }
  public static func += (lhs: inout Quaternion, rhs: Quaternion) {
    lhs = Quaternion(
      a: lhs.a + rhs.a,
      b: lhs.b + rhs.b,
      c: lhs.c + rhs.c,
      d: lhs.d + rhs.d
    )
  }
  public static func -= (lhs: inout Quaternion, rhs: Quaternion) {
    lhs = Quaternion(
      a: lhs.a - rhs.a,
      b: lhs.b - rhs.b,
      c: lhs.c - rhs.c,
      d: lhs.d - rhs.d
    )
  }
  public static func *= (lhs: inout Quaternion, rhs: Quaternion) {
    lhs = Quaternion(
      a: lhs.a*rhs.a - lhs.b*rhs.b - lhs.c*rhs.c - lhs.d*rhs.d,
      b: lhs.a*rhs.b + lhs.b*rhs.a + lhs.c*rhs.d - lhs.d*rhs.c,
      c: lhs.a*rhs.c - lhs.b*rhs.d + lhs.c*rhs.a + lhs.d*rhs.b,
      d: lhs.a*rhs.d + lhs.b*rhs.c - lhs.c*rhs.b + lhs.d*rhs.a
    )
  }
}
extension Quaternion: CustomStringConvertible {
  var description: String {
    let formatter = NumberFormatter()
    formatter.positivePrefix = "+"
    let f: (Double) -> String = { formatter.string(from: $0 as NSNumber)! }
    return [f(a), f(b), "i", f(c), "j", f(d), "k"].joined()
  }
}
extension Quaternion {
  var norm: Double {
    return sqrt(a*a + b*b + c*c + d*d)
  }
  var conjugate: Quaternion {
    return Quaternion(a: a, b: -b, c: -c, d: -d)
  }
  public static func + (lhs: Double, rhs: Quaternion) -> Quaternion {
    var result = rhs
    result.a += lhs
    return result
  }
  public static func + (lhs: Quaternion, rhs: Double) -> Quaternion {
    var result = lhs
    result.a += rhs
    return result
  }
  public static func * (lhs: Double, rhs: Quaternion) -> Quaternion {
    return Quaternion(a: lhs*rhs.a, b: lhs*rhs.b, c: lhs*rhs.c, d: lhs*rhs.d)
  }
  public static func * (lhs: Quaternion, rhs: Double) -> Quaternion {
    return Quaternion(a: lhs.a*rhs, b: lhs.b*rhs, c: lhs.c*rhs, d: lhs.d*rhs)
  }
  public static prefix func - (x: Quaternion) -> Quaternion {
    return Quaternion(a: -x.a, b: -x.b, c: -x.c, d: -x.d)
  }
}

let q:  Quaternion = 1 + 2 * .i + 3 * .j + 4 * .k // 1+2i+3j+4k
let q1: Quaternion = 2 + 3 * .i + 4 * .j + 5 * .k // 2+3i+4j+5k
let q2: Quaternion = 3 + 4 * .i + 5 * .j + 6 * .k // 3+4i+5j+6k
let r: Double = 7

print("""
  q  = \(q)
  q1 = \(q1)
  q2 = \(q2)
  r = \(r)
  -q = \(-q)
  ‖q‖ = \(q.norm)
  conjugate of q = \(q.conjugate)
  r + q = q + r = \(r+q) = \(q+r)
  q₁ + q₂ = \(q1 + q2) = \(q2 + q1)
  qr = rq = \(q*r) = \(r*q)
  q₁q₂ = \(q1 * q2)
  q₂q₁ = \(q2 * q1)
  q₁q₂ ≠ q₂q₁ is \(q1*q2 != q2*q1)
""")


package require TclOO

# Support class that provides C++-like RAII lifetimes
oo::class create RAII-support {
    constructor {} {
	upvar 1 { end } end
	lappend end [self]
	trace add variable end unset [namespace code {my destroy}]
    }
    destructor {
	catch {
	    upvar 1 { end } end
	    trace remove variable end unset [namespace code {my destroy}]
	}
    }
    method return {{level 1}} {
	incr level
	upvar 1 { end } end
	upvar $level { end } parent
	trace remove variable end unset [namespace code {my destroy}]
	lappend parent [self]
	trace add variable parent unset [namespace code {my destroy}]
	return -level $level [self]
    }
}

# Class of quaternions
oo::class create Q {
    superclass RAII-support
    variable R I J K
    constructor {{real 0} {i 0} {j 0} {k 0}} {
	next
	namespace import ::tcl::mathfunc::* ::tcl::mathop::*
	variable R [double $real] I [double $i] J [double $j] K [double $k]
    }
    self method return args {
	[my new {*}$args] return 2
    }

    method p {} {
	return "Q($R,$I,$J,$K)"
    }
    method values {} {
	list $R $I $J $K
    }

    method Norm {} {
	+ [* $R $R] [* $I $I] [* $J $J] [* $K $K]
    }

    method conjugate {} {
	Q return $R [- $I] [- $J] [- $K]
    }
    method norm {} {
	sqrt [my Norm]
    }
    method unit {} {
	set n [my norm]
	Q return [/ $R $n] [/ $I $n] [/ $J $n] [/ $K $n]
    }
    method reciprocal {} {
	set n2 [my Norm]
	Q return [/ $R $n2] [/ $I $n2] [/ $J $n2] [/ $K $n2]
    }
    method - {{q ""}} {
	if {[llength [info level 0]] == 2} {
	    Q return [- $R] [- $I] [- $J] [- $K]
	}
	[my + [$q -]] return
    }
    method + q {
	if {[info object isa object $q]} {
	    lassign [$q values] real i j k
	    Q return [+ $R $real] [+ $I $i] [+ $J $j] [+ $K $k]
	}
	Q return [+ $R [double $q]] $I $J $K
    }
    method * q {
	if {[info object isa object $q]} {
	    lassign [my values] a1 b1 c1 d1
	    lassign [$q values] a2 b2 c2 d2
	    Q return [expr {$a1*$a2 - $b1*$b2 - $c1*$c2 - $d1*$d2}] \
		[expr {$a1*$b2 + $b1*$a2 + $c1*$d2 - $d1*$c2}] \
		[expr {$a1*$c2 - $b1*$d2 + $c1*$a2 + $d1*$b2}] \
		[expr {$a1*$d2 + $b1*$c2 - $c1*$b2 + $d1*$a2}]
	}
	set f [double $q]
	Q return [* $R $f] [* $I $f] [* $J $f] [* $K $f]
    }
    method == q {
	expr {
	    [info object isa object $q]
	    && [info object isa typeof $q [self class]]
	    && [my values] eq [$q values]
	}
    }

    export - + * ==
}


Option Base 1
Private Function norm(q As Variant) As Double
    norm = Sqr(WorksheetFunction.SumSq(q))
End Function

Private Function negative(q) As Variant
    Dim res(4) As Double
    For i = 1 To 4
        res(i) = -q(i)
    Next i
    negative = res
End Function

Private Function conj(q As Variant) As Variant
    Dim res(4) As Double
    res(1) = q(1)
    For i = 2 To 4
        res(i) = -q(i)
    Next i
    conj = res
End Function

Private Function addr(r As Double, q As Variant) As Variant
    Dim res As Variant
    res = q
    res(1) = r + q(1)
    addr = res
End Function

Private Function add(q1 As Variant, q2 As Variant) As Variant
    add = WorksheetFunction.MMult(Array(1, 1), Array(q1, q2))
End Function

Private Function multr(r As Double, q As Variant) As Variant
    multr = WorksheetFunction.MMult(r, q)
End Function

Private Function mult(q1 As Variant, q2 As Variant)
    Dim res(4) As Double
    res(1) = q1(1) * q2(1) - q1(2) * q2(2) - q1(3) * q2(3) - q1(4) * q2(4)
    res(2) = q1(1) * q2(2) + q1(2) * q2(1) + q1(3) * q2(4) - q1(4) * q2(3)
    res(3) = q1(1) * q2(3) - q1(2) * q2(4) + q1(3) * q2(1) + q1(4) * q2(2)
    res(4) = q1(1) * q2(4) + q1(2) * q2(3) - q1(3) * q2(2) + q1(4) * q2(1)
    mult = res
End Function

Private Sub quats(q As Variant)
    Debug.Print q(1); IIf(q(2) < 0, " - " & Abs(q(2)), " + " & q(2));
    Debug.Print IIf(q(3) < 0, "i - " & Abs(q(3)), "i + " & q(3));
    Debug.Print IIf(q(4) < 0, "j - " & Abs(q(4)), "j + " & q(4)); "k"
End Sub

Public Sub quaternions()
    q = [{ 1, 2, 3, 4}]
    q1 = [{2, 3, 4, 5}]
    q2 = [{3, 4, 5, 6}]
    Dim r_ As Double
    r_ = 7#
    Debug.Print "q            = ";: quats q
    Debug.Print "q1           = ";: quats q1
    Debug.Print "q2           = ";: quats q2
    Debug.Print "r            = "; r_
    Debug.Print "norm(q)      = "; norm(q)
    Debug.Print "negative(q)  = ";: quats negative(q)
    Debug.Print "conjugate(q) = ";: quats conj(q)
    Debug.Print "r + q        = ";: quats addr(r_, q)
    Debug.Print "q1 + q2      = ";: quats add(q1, q2)
    Debug.Print "q * r        = ";: quats multr(r_, q)
    Debug.Print "q1 * q2      = ";: quats mult(q1, q2)
    Debug.Print "q2 * q1      = ";: quats mult(q2, q1)
End Sub


Option Compare Binary
Option Explicit On
Option Infer On
Option Strict On

Structure Quaternion
    Implements IEquatable(Of Quaternion), IStructuralEquatable

    Public ReadOnly A, B, C, D As Double

    Public Sub New(a As Double, b As Double, c As Double, d As Double)
        Me.A = a
        Me.B = b
        Me.C = c
        Me.D = d
    End Sub

    Public ReadOnly Property Norm As Double
        Get
            Return Math.Sqrt((Me.A ^ 2) + (Me.B ^ 2) + (Me.C ^ 2) + (Me.D ^ 2))
        End Get
    End Property

    Public ReadOnly Property Conjugate As Quaternion
        Get
            Return New Quaternion(Me.A, -Me.B, -Me.C, -Me.D)
        End Get
    End Property

    Public Overrides Function Equals(obj As Object) As Boolean
        If TypeOf obj IsNot Quaternion Then Return False
        Return Me.Equals(DirectCast(obj, Quaternion))
    End Function

    Public Overloads Function Equals(other As Quaternion) As Boolean Implements IEquatable(Of Quaternion).Equals
        Return other = Me
    End Function

    Public Overloads Function Equals(other As Object, comparer As IEqualityComparer) As Boolean Implements IStructuralEquatable.Equals
        If TypeOf other IsNot Quaternion Then Return False
        Dim q = DirectCast(other, Quaternion)
        Return comparer.Equals(Me.A, q.A) AndAlso
               comparer.Equals(Me.B, q.B) AndAlso
               comparer.Equals(Me.C, q.C) AndAlso
               comparer.Equals(Me.D, q.D)
    End Function

    Public Overrides Function GetHashCode() As Integer
        Return HashCode.Combine(Me.A, Me.B, Me.C, Me.D)
    End Function

    Public Overloads Function GetHashCode(comparer As IEqualityComparer) As Integer Implements IStructuralEquatable.GetHashCode
        Return HashCode.Combine(
            comparer.GetHashCode(Me.A),
            comparer.GetHashCode(Me.B),
            comparer.GetHashCode(Me.C),
            comparer.GetHashCode(Me.D))
    End Function

    Public Overrides Function ToString() As String
        Return $"Q({Me.A}, {Me.B}, {Me.C}, {Me.D})"
    End Function

#Region "Operators"
    Public Shared Operator =(left As Quaternion, right As Quaternion) As Boolean
        Return left.A = right.A AndAlso
               left.B = right.B AndAlso
               left.C = right.C AndAlso
               left.D = right.D
    End Operator

    Public Shared Operator <>(left As Quaternion, right As Quaternion) As Boolean
        Return Not left = right
    End Operator

    Public Shared Operator +(q1 As Quaternion, q2 As Quaternion) As Quaternion
        Return New Quaternion(q1.A + q2.A, q1.B + q2.B, q1.C + q2.C, q1.D + q2.D)
    End Operator

    Public Shared Operator -(q As Quaternion) As Quaternion
        Return New Quaternion(-q.A, -q.B, -q.C, -q.D)
    End Operator

    Public Shared Operator *(q1 As Quaternion, q2 As Quaternion) As Quaternion
        Return New Quaternion(
            (q1.A * q2.A) - (q1.B * q2.B) - (q1.C * q2.C) - (q1.D * q2.D),
            (q1.A * q2.B) + (q1.B * q2.A) + (q1.C * q2.D) - (q1.D * q2.C),
            (q1.A * q2.C) - (q1.B * q2.D) + (q1.C * q2.A) + (q1.D * q2.B),
            (q1.A * q2.D) + (q1.B * q2.C) - (q1.C * q2.B) + (q1.D * q2.A))
    End Operator

    Public Shared Widening Operator CType(d As Double) As Quaternion
        Return New Quaternion(d, 0, 0, 0)
    End Operator
#End Region
End Structure


class Quaternion {
    construct new(a, b, c, d ) {
        _a = a
        _b = b
        _c = c
        _d = d
    }

    a { _a }
    b { _b }
    c { _c }
    d { _d }

    norm { (a*a + b*b + c*c + d*d).sqrt }

    - { Quaternion.new(-a, -b, -c, -d) }

    conj { Quaternion.new(a, -b, -c, -d) }

    + (q) {
        if (q is Num) return Quaternion.new(a + q, b, c, d)
        return Quaternion.new(a + q.a, b + q.b, c + q.c, d + q.d)
    }

    * (q) {
        if (q is Num) return Quaternion.new(a * q, b * q, c * q, d * q)
        return Quaternion.new(a*q.a - b*q.b - c*q.c - d*q.d,
                              a*q.b + b*q.a + c*q.d - d*q.c,
                              a*q.c - b*q.d + c*q.a + d*q.b,
                              a*q.d + b*q.c - c*q.b + d*q.a)
    }

    == (q) { a == q.a && b == q.b && c == q.c && d == q.d }
    != (q) { !(this == q) }

    toString { "(%(a), %(b), %(c), %(d))" }

    static realAdd(r, q) { q + r }

    static realMul(r, q) { q * r }
}

var q  = Quaternion.new(1, 2, 3, 4)
var q1 = Quaternion.new(2, 3, 4, 5)
var q2 = Quaternion.new(3, 4, 5, 6)
var q3 = q1 * q2
var q4 = q2 * q1
var r = 7

System.print("q           = %(q)")
System.print("q1          = %(q1)")
System.print("q2          = %(q2)")
System.print("r           = %(r)")
System.print("norm(q)     = %(q.norm)")
System.print("-q          = %(-q)")
System.print("conj(q)     = %(q.conj)")
System.print("r + q       = %(Quaternion.realAdd(r, q))")
System.print("q + r       = %(q + r))")
System.print("q1 + q2     = %(q1 + q2)")
System.print("q2 + q1     = %(q2 + q1)")
System.print("rq          = %(Quaternion.realMul(r, q))")
System.print("qr          = %(q * r)")
System.print("q1q2        = %(q3)")
System.print("q2q1        = %(q4)")
System.print("q1q2 ≠ q2q1 = %(q3 != q4)")


class Quat{
   fcn init(real=0,i1=0,i2=0,i3=0){
      var [const] vector= // Quat(r,i,j,k) or Quat( (r,i,j,k) )
              (if(List.isType(real)) real else vm.arglist).apply("toFloat");
      var r,i,j,k; r,i,j,k=vector; // duplicate data for ease of coding
      var [const]	// properties: This is one way to do it
         norm2=vector.apply("pow",2).sum(0.0), // Norm squared
	 abs=norm2.sqrt(),		       // Norm
	 arg=(r/abs()).acos(),		// Theta !!!this may be incorrect...
      ;
   }
   fcn toString { String("[",vector.concat(","),"]") }
   var [const proxy]	// properties that need calculation (or are recursive)
      conj   =fcn{ Quat(r,-i,-j,-k) },		// Conjugate
      recip  =fcn{ n2:=norm2; Quat(r/n2,-i/n2,-j/n2,-k/n2) },// Reciprocal
      pureim =fcn{ Quat(0, i, j, k) },   	// Pure imagery
      versor =fcn{ self / abs; }, 		// Unit versor
      iversor=fcn{ pureim / pureim.abs; },	// Unit versor of imagery part
   ;

   fcn __opEQ(z) { r == z.r and i == z.i and j == z.j and k == z.k }
   fcn __opNEQ(z){ (not (self==z)) }

   fcn __opNegate{ Quat(-r, -i, -j, -k) }
   fcn __opAdd(z){
      if (Quat.isInstanceOf(z)) Quat(vector.zipWith('+,z.vector));
      else			Quat(r+z,i,j,k);
   }
   fcn __opSub(z){
      if (Quat.isInstanceOf(z)) Quat(vector.zipWith('-,z.vector));
      else			Quat(r-z,vector.xplode(1)); // same as above
   }
   fcn __opMul(z){
      if (Quat.isInstanceOf(z)){
	 Quat(r*z.r - i*z.i - j*z.j - k*z.k,
	      r*z.i + i*z.r + j*z.k - k*z.j,
	      r*z.j - i*z.k + j*z.r + k*z.i,
	      r*z.k + i*z.j - j*z.i + k*z.r);
      }
      else Quat(vector.apply('*(z)));
   }
   fcn __opDiv(z){
      if (Quat.isInstanceOf(z)) self*z.recip;
      else			Quat(r/z,i/z,j/z,k/z);
   }

   fcn pow(r){ exp(r*iversor*arg)*abs.pow(r) }	// Power function
   fcn log{ iversor*(r / abs).acos() + abs.log() }
   fcn exp{					// e^q
      inorm:=pureim.abs;
      (iversor*inorm.sin() + inorm.cos()) * r.exp();
   }
}


LEA $000200,A3
JSR PrintString ;(my print routine is 255-terminated and there just so happens to be an FF after the name of the game.)


with Ada.Command_Line, Ada.Text_IO;

procedure Command_Name is
begin
   Ada.Text_IO.Put_Line(Ada.Command_Line.Command_Name);
end Command_Name;


BEGIN
   print ((program idf, newline))
END


#include <hbasic.h>
Begin
   GetParam(name File)
   Print("My Program name: ", name File,Newl)
End


10 GOSUB 40"GET PROGRAM NAME
20 PRINT N$
30 END

40 REMGET PROGRAM NAME
50 GOSUB 100"GET INPUT BUFFER
60 GOSUB 200"REMOVE RUN PREFIX
70 GOSUB 300"REMOVE , SUFFIXES
80 GOSUB 400"TRIM SPACES
90 RETURN

100 REMGET INPUT BUFFER
110 N$ = ""
120 FOR I = 512 TO 767
130     B =  PEEK (I) - 128
140     IF B < 32 THEN  RETURN
150     N$ = N$ +  CHR$ (B)
160 NEXT I
170 RETURN

200 REMREMOVE RUN PREFIX
210 P = 1
220 FOR I = 1 TO 3
230     FOR J = P TO LEN(N$)
240         C$ =  MID$ (N$,J,1)
250         P = P + 1
260         IF C$ = " " THEN  NEXT J
270         IF C$ = MID$("RUN",I,1) THEN NEXT I:N$ =  MID$(N$,P,LEN(N$)-P+1):RETURN
280 PRINT "YOU NEED TO RUN THIS PROGRAM USING THE  RUN COMMAND FROM DOS."
290 END

300 REMREMOVE , SUFFIXES
310 L =  LEN (N$)
320 FOR I = 1 TO L
330     C$ =  MID$ (N$,I,1)
340     IF C$ = "," THEN N$ =  LEFT$(N$,I - 1): RETURN
350 NEXT I
360 RETURN

400 REMTRIM SPACES
410 GOSUB 600

500 REMLEFT TRIM SPACES
510 L = LEN(N$) - 1
520 FOR I = L TO 0 STEP -1
530     IF I < 0 THEN RETURN
540     IF LEFT$ (N$,1) <> " " THEN RETURN
550     IF I THEN N$ = RIGHT$ (N$, I)
560 NEXT I
570 N$ = "
580 RETURN

600 REMRIGHT TRIM SPACES
610 L = LEN(N$) - 1
620 FOR I = L TO 0 STEP -1
630     IF I < 0 THEN RETURN
640     IF RIGHT$ (N$,1) <> " " THEN RETURN
650     IF I THEN N$ = LEFT$ (N$, I)
660 NEXT I
670 N$ = "
680 RETURN


/* ARM assembly Raspberry PI  */
/*  program namepgm.s   */
/* Constantes    */
.equ STDOUT, 1
.equ WRITE,  4
.equ EXIT,   1
/* Initialized data */
.data
szMessage: .asciz "Program : "       @
szRetourLigne: .asciz "\n"

.text
.global main
main:
    push {fp,lr}    /* save des  2 registres */
    add fp,sp,#8    /* fp <- adresse début */
    ldr r0, iAdrszMessage         @ adresse of message
    bl affichageMess            @ call function
    ldr r0,[fp,#4]                 @ recup name of program in command line
    bl affichageMess            @ call function
    ldr r0, iAdrszRetourLigne         @ adresse of message
    bl affichageMess            @ call function

 /* fin standard du programme */
    mov r0, #0                  @ return code
    pop {fp,lr}                 @restaur des  2 registres
    mov r7, #EXIT              @ request to exit program
    swi 0                       @ perform the system call
iAdrszMessage: .int szMessage
iAdrszRetourLigne: .int szRetourLigne
/******************************************************************/
/*     affichage des messages   avec calcul longueur              */
/******************************************************************/
/* r0 contient l adresse du message */
affichageMess:
	push {fp,lr}    /* save des  2 registres */
	push {r0,r1,r2,r7}    /* save des autres registres */
	mov r2,#0   /* compteur longueur */
1:	      /*calcul de la longueur */
        ldrb r1,[r0,r2]  /* recup octet position debut + indice */
	cmp r1,#0       /* si 0 c est fini */
	beq 1f
	add r2,r2,#1   /* sinon on ajoute 1 */
	b 1b
1:	/* donc ici r2 contient la longueur du message */
	mov r1,r0        /* adresse du message en r1 */
	mov r0,#STDOUT      /* code pour écrire sur la sortie standard Linux */
        mov r7, #WRITE                  /* code de l appel systeme "write" */
        swi #0                      /* appel systeme */
	pop {r0,r1,r2,r7}     /* restaur des autres registres */
	pop {fp,lr}    /* restaur des  2 registres */
        bx lr	        /* retour procedure */


# syntax: TAWK -f PROGRAM_NAME.AWK
#
# GAWK can provide the invoking program name from ARGV[0] but is unable to
# provide the AWK script name that follows -f.  Thompson Automation's TAWK
# version 5.0c, last released in 1998 and no longer commercially available, can
# provide the AWK script name that follows -f from the PROGFN built-in
# variable.  It should also provide the invoking program name, E.G. TAWK, from
# ARGV[0] but due to a bug it holds the fully qualified -f name instead.
#
# This example is posted here with hopes the TAWK built-in variables PROGFN
# (PROGram File Name) and PROGLN (PROGram Line Number) be added to GAWK by its
# developers.
#
BEGIN {
    printf("%s -f %s\n",ARGV[0],PROGFN)
    printf("line number %d\n",PROGLN)
    exit(0)
}


global _start

: syscall ( num:eax -- result:eax ) syscall ;

: exit ( status:edi -- noret ) 60 syscall ;
: bye ( -- noret ) 0 exit ;

: write ( buf:esi len:edx fd:edi -- ) 1 syscall drop ;

1 const stdout

: print ( buf len -- ) stdout write ;

: newline ( -- ) s" \n" print ;
: println ( buf len -- ) print newline ;

: find0 ( start:rsi -- end:rsi ) lodsb 0 cmp latest xne ;
: cstrlen ( str:rdi -- len:rsi ) dup find0 swap sub dec ;
: cstr>str ( cstr:rdx -- str:rsi len:rdx ) dup cstrlen xchg ;

: print-arg ( arg -- ) cstr>str println ;

: arg0 ( rsp -- rsp ) 8 add @ ; inline

: _start ( rsp -- noret ) arg0 print-arg bye ;


#include <stdio.h>

int main(int argc, char **argv) {
	printf("Executable: %s\n", argv[0]);

	return 0;
}


using System;
namespace ProgramName
{
	class Program
	{
		static void Main(string[] args)
		{
			Console.Write(Environment.CommandLine);
		}
	}
}


#include <iostream>

using namespace std;

int main(int argc, char **argv) {
	char *program = argv[0];
	cout << "Program: " << program << endl;
}


":";exec lein exec $0 ${1+"[email protected]"}
":";exit

(ns scriptname
  (:gen-class))

(defn -main [& args]
  (let [program (first *command-line-args*)]
    (println "Program:" program)))

(when (.contains (first *command-line-args*) *source-path*)
  (apply -main (rest *command-line-args*)))


       identification division.
       program-id. sample.

       data division.
       working-storage section.
       01 progname pic x(16).

       procedure division.
       sample-main.

       display 0 upon argument-number
       accept progname from argument-value
       display "argument-value zero :" progname ":"

       display "function module-id  :" function module-id ":"

       goback.
       end program sample.


#!/usr/bin/env coffee

main = () ->
  program = __filename
  console.log "Program: " + program

if not module.parent then main()


;;; Play nice with shebangs
(set-dispatch-macro-character #\# #\!
 (lambda (stream character n)
  (declare (ignore character n))
  (read-line stream nil nil t)
  nil))


#!/usr/bin/env rdmd

import std.stdio;

void main(in string[] args) {
    writeln("Program: ", args[0]);
}


#!/usr/bin/env dart

main() {
	var program = new Options().script;
	print("Program: ${program}");
}


program ProgramName;

{$APPTYPE CONSOLE}

begin
  Writeln('Program name: ' + ParamStr(0));
  Writeln('Command line: ' + CmdLine);
end.


!print( "Name of this file: " get-from !args 0 )


(js-eval "window.location.href")
    → "http://www.echolalie.org/echolisp/"


import extensions;

public program()
{
    console.printLine(program_arguments.asEnumerable());  // the whole command line

    console.printLine(program_arguments[0]); // the program name
}


:;exec emacs -batch -l $0 -f main $*

;;; Shebang from John Swaby
;;; http://www.emacswiki.org/emacs/EmacsScripts

(defun main ()
  (let ((program (nth 2 command-line-args)))
    (message "Program: %s" program)))


%% Compile
%%
%% erlc scriptname.erl
%%
%% Run
%%
%% erl -noshell -s scriptname

-module(scriptname).
-export([start/0]).

start() ->
  Program = ?FILE,
  io:format("Program: ~s~n", [Program]),
  init:stop().


constant cmd = command_line()
puts(1,cmd[2])


#light (*
	exec fsharpi --exec $0 --quiet
*)

let scriptname =
    let args = System.Environment.GetCommandLineArgs()

    let arg0 = args.[0]

    if arg0.Contains("fsi") then
        let arg1 = args.[1]
        if arg1 = "--exec" then
            args.[2]
        else
            arg1
    else
        arg0

let main =
    printfn "%s" scriptname


#! /usr/bin/env factor

USING: namespaces io command-line ;
IN: scriptname

: main ( -- ) script get print ;

MAIN: main


0 arg type cr    \ gforth or gforth-fast, for example
1 arg type cr     \ name of script


! program run with invalid name path/f
!
!-*- mode: compilation; default-directory: "/tmp/" -*-
!Compilation started at Sun Jun  2 00:18:31
!
!a=./f && make $a && OMP_NUM_THREADS=2 $a < unixdict.txt
!gfortran -std=f2008 -Wall -fopenmp -ffree-form -fall-intrinsics -fimplicit-none f.f08 -o f
!
!Compilation finished at Sun Jun  2 00:18:31

! program run with valid name path/rcname
!
!-*- mode: compilation; default-directory: "/tmp/" -*-
!Compilation started at Sun Jun  2 00:19:01
!
!gfortran -std=f2008 -Wall -fopenmp -ffree-form -fall-intrinsics -fimplicit-none f.f08 -o rcname && ./rcname
! ./rcname approved.
! program continues...
!
!Compilation finished at Sun Jun  2 00:19:02

module sundry

contains

  subroutine verify_name(required)
    ! name verification reduces the ways an attacker can rename rm as cp.
    character(len=*), intent(in) :: required
    character(len=1024) :: name
    integer :: length, status
    ! I believe get_command_argument is part of the 2003 FORTRAN standard intrinsics.
    call get_command_argument(0, name, length, status)
    if (0 /= status) stop
    if ((len_trim(name)+1) .ne. (index(name, required, back=.true.) + len(required))) stop
    write(6,*) trim(name)//' approved.'
  end subroutine verify_name

end module sundry

program name
  use sundry
  call verify_name('rcname')
  write(6,*)'program continues...'
end program name


' FB 1.05.0 Win64

Print "The program was invoked like this => "; Command(0) + " " + Command(-1)
Print "Press any key to quit"
Sleep


Public Sub Main()
Dim sTemp As String

Print "Command to start the program was ";;

For Each sTemp In Args.All
  Print sTemp;;
Next

End


[indent=4]
init
    print args[0]
    print Path.get_basename(args[0])
    print Environment.get_application_name()
    print Environment.get_prgname()


package main

import (
    "fmt"
    "os"
)

func main() {
    fmt.Println("Program:", os.Args[0])
}


#!/usr/bin/env groovy

def program = getClass().protectionDomain.codeSource.location.path

println "Program: " + program


import System (getProgName)

main :: IO ()
main = getProgName >>= putStrLn . ("Program: " ++)


procedure main()
write(&progname)    # obtain and write out the program name from the keyword &progname
end


#!/usr/bin/env io

main := method(
	program := System args at(0)

	("Program: " .. program) println
)

if (System args size > 0 and System args at(0) containsSeq("scriptname"), main)


#!/usr/bin/env jconsole

program =: monad : 0
	if. (#ARGV) > 1 do.
		> 1 { ARGV
	else.
		'Interpreted'
	end.
)

echo 'Program: ', program 0

exit ''


public class ScriptName {
	public static void main(String[] args) {
		String program = System.getProperty("sun.java.command").split(" ")[0];
		System.out.println("Program: " + program);
	}
}


function foo() {
  return arguments.callee.name;
}


#!/usr/bin/env jsish
/* Program name, in Jsish */
puts('Executable:', Info.executable());
puts('Argv0     :', Info.argv0());


prog = basename(Base.source_path())
println("This program file is \"", prog, "\".")


// version 1.0.6

// 'progname.kt' packaged as 'progname.jar'

fun main(args: Array<String>) {
    println(System.getProperty("sun.java.command"))  // may not exist on all JVMs
    println(System.getProperty("java.vm.name"))
}


writeln "script: ", _script
writeln "script args: ", _args


#!/usr/bin/lasso9

stdoutnl("Program: " + $argv->first)


nSize = _MAX_PATH + 2
lpFilename$ = space$(nSize); chr$(0)

    calldll #kernel32, "GetModuleFileNameA", _
        hModule     as ulong, _
        lpFilename$ as ptr, _
        nSize       as ulong, _
        result      as ulong
lpFilename$ = left$(lpFilename$,result)

print "Path to LB exe"
print lpFilename$
print "current program file (:last one on LRU list)"
print getLastLRU$(lbPath$)
end

Function getLastLRU$(lbPath$)
    open lbPath$+"lbasic404.ini" for input as #1
        while not(eof(#1))
            line input #1, a$
            if instr(a$, "recent files")<>0 then [readRecentFiles]
        wend
        getLastLRU$ = "* Failed: Recent files section not found *"
        close #1
        exit function

[readRecentFiles]
        nRecent = val(word$(a$,1))
        'print "nRecentFiles", nRecent
        for i = 1 to nRecent
            if eof(#1) then
                getLastLRU$ = "* Failed: File ended while in recent files section *"
                close #1
                exit function
            end if
            line input #1, a$
            'print i, a$
        next
    close #1
    getLastLRU$ = a$
end function


put _player.applicationName
-- "lsw.exe"
put _movie.name
-- "lsw_win_d11.dir"


$ make
llvm-as scriptname.ll
llc -disable-cfi scriptname.bc
gcc -o scriptname scriptname.s
./scriptname
Program: ./scriptname


#!/usr/bin/env lua

function main(arg)
	local program = arg[0]
	print("Program: " .. program)
end

if type(package.loaded[(...)]) ~= "userdata" then
	main(arg)
else
	module(..., package.seeall)
end


Module Checkit {
      Declare GetModuleFileName Lib "kernel32.GetModuleFileNameW"  {Long hModule, &lpFileName$, Long nSize}
      a$=string$(chr$(0), 260)
      namelen=GetModuleFileName(0, &a$, 260)
      a$=left$(a$, namelen)
      \\ normally m2000.exe is the caller of m2000.dll, the activeX script language
      Print Mid$(a$, Rinstr(a$, "\")+1)="m2000.exe"
}
Checkit
\\ command$ return the file's path plus name of script
\\ we can use edit "callme.gsb" to paste these, and use USE callme to call it from M2000 console.
Module SayIt {
      Show
      Print command$
      a$=key$
}
SayIt


NAME=$(CURDIR)/$(word $(words $(MAKEFILE_LIST)),$(MAKEFILE_LIST))

all:
	@echo $(NAME)


#!/usr/bin/env MathKernel -script
ScriptName[] = Piecewise[
	{
		{"Interpreted", Position[$CommandLine, "-script", 1] == {}}
	},
	$CommandLine[[Position[$CommandLine, "-script", 1][[1,1]] + 1]]
]
Program = ScriptName[];
Print["Program: " <> Program]


:- module program_name.
:- interface.

:- import_module io.
:- pred main(io::di, io::uo) is det.

:- implementation.

main(!IO) :-
    % The first argument is used as the program name if it is not otherwise
    % available.  (We could also have used the predicate io.progname_base/4
    % if we did not want path preceding the program name.)
    io.progname("", ProgName, !IO),
    io.print_line(ProgName, !IO).

:- end_module program_name.


all: test

test: scriptname
	./scriptname

scriptname: scriptname.oz
	ozc -x scriptname.oz

clean:
	-rm scriptname
	-rm *.exe


using System.Environment;
...
def program_name = GetCommandLineArgs()[0];
...


/* NetRexx */
options replace format comments java crossref symbols nobinary

package org.rosettacode.samples

say 'Source: ' source
say 'Program:' System.getProperty('sun.java.command')
return


#!/usr/bin/env newlisp

(let ((program (main-args 1)))
  (println (format "Program: %s" program))
  (exit))


import os
echo getAppFilename() # Prints the full path of the executed file
echo paramStr(0) # Prints argv[0]


MODULE ProgramName;
IMPORT
  NPCT:Args,
  Out;
BEGIN
  Out.Object("Program name: " + Args.Get(0));Out.Ln
END ProgramName.


#import <Foundation/Foundation.h>

int main(int argc, char **argv) {
	@autoreleasepool {

		char *program = argv[0];
		printf("Program: %s\n", program);

		// Alternatively:
		NSString *program2 = [[NSProcessInfo processInfo] processName];
		NSLog(@"Program: %@\n", program2);

	}

	return 0;
}


let () =
  print_endline Sys.executable_name;
  print_endline Sys.argv.(0)


function main()
	program = program_name();
	printf("Program: %s", program);
endfunction

main();


program ScriptName;
var
	prog : String;
begin
	prog := ParamStr(0);
	write('Program: ');
	writeln(prog)
end.


#!/usr/bin/env perl

use strict;
use warnings;

sub main {
	my $program = $0;
	print "Program: $program\n";
}

unless(caller) { main; }


with javascript_semantics
string cl2 = command_line()[2]
printf(1,"%s\n",cl2)                -- full path
printf(1,"%s\n",get_file_name(cl2)) -- eg test.exw or test.exe or test.htm
printf(1,"%s\n",get_file_base(cl2)) -- eg test


<?php
$program = $_SERVER["SCRIPT_NAME"];
echo "Program: $program\n";
?>


#INCLUDE "Win32API.inc"
'[...]
DIM fullpath AS ASCIIZ * 260, appname AS STRING
GetModuleFileNameA 0, fullpath, 260
IF INSTR(fullpath, "\") THEN
    appname = MID$(fullpath, INSTR(-1, fullpath, "\") + 1)
ELSE
    appname = fullpath
END IF


# write this in file <program.ps1>
$MyInvocation.MyCommand.Name
# launch with <.\program>


% SWI-Prolog version 8.0.0 for i686-linux.
% This will find itself, and return the knowledge base it is in.
file_name(F) :- true
   , M = user            % M is the module    .
   , P = file_name(_)    % P is the predicate .
   , source_file(M:P, F) % F is the file      .
   , \+ predicate_property(M:P, imported_from(_))
   .


If OpenConsole()
  PrintN(ProgramFilename())

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


#!/usr/bin/env python

import sys

def main():
    program = sys.argv[0]
    print("Program: %s" % program)

if __name__ == "__main__":
    main()


#!/usr/bin/env Rscript

getProgram <- function(args) {
	sub("--file=", "", args[grep("--file=", args)])
}

args <- commandArgs(trailingOnly = FALSE)
program <- getProgram(args)

cat("Program: ", program, "\n")

q("no")


#!/usr/bin/env racket
#lang racket

(define (program) (find-system-path 'run-file))

(module+ main (printf "Program: ~a\n" (program)))


/* Rexx */

Parse source . . pgmPath
Say pgmPath


see "Active Source File Name : " + filename() + nl


#!/usr/bin/env ruby

puts "Path: #{$PROGRAM_NAME}"  # or puts "Path: #{$0}"
puts "Name: #{File.basename $0}"


fn main() {
    println!("Program: {}", std::env::args().next().unwrap());
}


use StdIO: all;
use Array: all;
use String: { string };
use CommandLine: all;

int main() {
	program = argv(0);
	printf("Program: %s\n", program);
	return(0);
}


object ScriptName extends App {
  println(s"Program of instantiated object: ${this.getClass.getName}")
  // Not recommended, due various implementations
  println(s"Program via enviroment:         ${System.getProperty("sun.java.command")}")
}


#!/bin/sh
#|
exec csi -ss $0 ${1+"[email protected]"}
exit
|#

(use posix)
(require-extension srfi-1) ; lists
(require-extension srfi-13) ; strings

(define (main args)
	(let ((prog (cdr (program))))
		(display (format "Program: ~a\n" prog))
		(exit)))

(define (program)
	(if (string=? (car (argv)) "csi")
		(let ((s-index (list-index (lambda (x) (string-contains x "-s")) (argv))))
			(if (number? s-index)
				(cons 'interpreted (list-ref (argv) (+ 1 s-index)))
				(cons 'unknown "")))
		(cons 'compiled (car (argv)))))

(if (equal? (car (program)) 'compiled)
	(main (cdr (argv))))


$ include "seed7_05.s7i";

const proc: main is func
  local
    var integer: i is 0;
  begin
    writeln("Program path:      " <& path(PROGRAM));
    writeln("Program directory: " <& dir(PROGRAM));
    writeln("Program file:      " <& file(PROGRAM));
  end func;


say __MAIN__;
if (__MAIN__ != __FILE__) {
    say "This file has been included!";
}


"exec" "gst" "-f" "$0" "$0" "[email protected]"
"exit"

| program |

program := Smalltalk getArgv: 1.

Transcript show: 'Program: ', program; cr.


#!/usr/bin/env sml

let
	val program = CommandLine.name ()
in
	print ("Program: " ^ program ^ "\n")
end;


#!/usr/bin/env tclsh

proc main {args} {
    set program $::argv0
    puts "Program: $program"
}

if {$::argv0 eq [info script]} {
    main {*}$::argv
}


#!/usr/local/bin/txr -B
@(bind my-name @self-path)


public static void main(string[] args){
	string command_name = args[0];

	stdout.printf("%s\n", command_name);
}


Wscript.Echo "FullName:",Wscript.FullName
Wscript.Echo "Name:",Wscript.Name
Wscript.Echo "Path:",Wscript.Path
Wscript.Echo "ScriptFullName:",Wscript.ScriptFullName
Wscript.Echo "ScriptName:",Wscript.ScriptName


appname = App.EXEName 'appname = "MyVBapp"


import "os" for Process

System.print("My name is %(Process.allArguments[1])")


FORMAT=-f elf
RUN=./
BIN=scriptname
OBJ=scriptname.o

all: test

test: $(BIN)
	$(RUN)$(BIN)

$(BIN): $(OBJ)
	ld -o $(BIN) $(OBJ)

$(OBJ): scriptname.asm
	nasm $(FORMAT) -o $(OBJ) scriptname.asm

clean:
	-rm $(BIN)
	-rm $(OBJ)


print peek$("program_name")

s$ = system$("cd")
n = len(s$)
print left$(s$, n - 2), "\\", peek$("program_name")


const std = @import("std");

const debug = std.debug;
const heap = std.heap;
const process = std.process;

pub fn main() !void {
    var args = process.args();

    const program_name = try args.next(heap.page_allocator) orelse unreachable;
    defer heap.page_allocator.free(program_name);

    debug.warn("{}\n", .{program_name});
}


;assuming this is not a subroutine and runs inline.
cmp TestValue ;a label for a memory address that contains some value we want to test the accumulator against
beq continue
     rts      ;unlike the Z80 there is no conditional return so we have to branch around the return instruction.
continue:


PROC Main()
  DO
    IF Rand(0)=10 THEN
      PrintE("Terminate program by Break() procedure")
      Break()
    FI
  OD
  PrintE("This is a dead code")
RETURN


with Ada.Task_Identification;  use Ada.Task_Identification;

procedure Main is
   -- Create as many task objects as your program needs
begin
   -- whatever logic is required in your Main procedure
   if some_condition then
      Abort_Task (Current_Task);
   end if;
end Main;


void
f1(integer a)
{
    if (a) {
	exit(1);
    }
}

integer
main(void)
{
    f1(3);

    return 0;
}


if (someCondition) then error number -128


#!/usr/local/bin/apl --script --

⍝⍝ GNU APL script
⍝⍝ Usage: errout.apl <code>
⍝⍝
⍝⍝ $ echo $?   ## to see exit code
⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝
args ← 2↓⎕ARG~'--script' '--'  ⍝⍝ strip off script args we don't need

err ← ⍎⊃args[1]

∇main
  →(0=err)/ok
error:
  'Error! exiting.'
  ⍎')off 1'         ⍝⍝ NOTE: exit code arg was added to )OFF in SVN r1499 Nov 2021
ok:
  'No error, continuing...'
  ⍎')off'
∇

main


/* ARM assembly Raspberry PI  */
/*  program ending.s   */

/* Constantes               */
.equ EXIT,   1                          @ Linux syscall

/* Initialized data */
.data

/*  code section */
.text
.global main
main:                                   @ entry of program
    push {fp,lr}                        @ saves registers

OK:
    @ end program OK
    mov r0, #0                          @ return code
    b 100f
NONOK:
    @ if error detected end program no ok
    mov r0, #1                          @ return code
100:                                    @ standard end of the program
    pop {fp,lr}                         @restaur  registers
    mov r7, #EXIT                       @ request to exit program
    swi 0                               @ perform the system call Linux


#include <stdlib.h>
/* More "natural" way of ending the program: finish all work and return
   from main() */
int main(int argc, char **argv)
{
  /* work work work */
     ...
  return 0;  /* the return value is the exit code. see below */
}

if(problem){
  exit(exit_code);
  /* On unix, exit code 0 indicates success, but other OSes may follow
     different conventions.  It may be more portable to use symbols
     EXIT_SUCCESS and EXIT_FAILURE; it all depends on what meaning
     of codes are agreed upon.
  */
}


if (problem)
{
   Environment.Exit(1);
}


#include <cstdlib>

void problem_occured()
{
  std::exit(EXIT_FAILURE);
}


(if problem
   (. System exit integerErrorCode))
   ;conventionally, error code 0 is the code for "OK",
   ; while anything else is an actual problem
   ;optionally: (-> Runtime (. getRuntime) (. exit integerErrorCode))
}


(defun terminate (status)
  #+sbcl     (           sb-ext:quit      :unix-status status)    ; SBCL
  #+ccl      (              ccl:quit      status)                 ; Clozure CL
  #+clisp    (              ext:quit      status)                 ; GNU CLISP
  #+cmu      (             unix:unix-exit status)                 ; CMUCL
  #+ecl      (              ext:quit      status)                 ; ECL
  #+abcl     (              ext:quit      :status status)         ; Armed Bear CL
  #+allegro  (             excl:exit      status :quiet t)        ; Allegro CL
  #+gcl      (common-lisp-user::bye       status)                 ; GCL
  #+ecl      (              ext:quit      status)                 ; ECL
  (cl-user::quit))           ; Many implementations put QUIT in the sandbox CL-USER package.


import core.stdc.stdio, core.stdc.stdlib;

extern(C) void foo() nothrow {
    "foo at exit".puts;
}

extern(C) void bar() nothrow {
    "bar at exit".puts;
}

extern(C) void spam() nothrow {
    "spam at exit".puts;
}

int baz(in int x) pure nothrow
in {
    assert(x != 0);
} body {
    if (x < 0)
        return 10;
    if (x > 0)
        return 20;

    // x can't be 0.

    // In release mode this becomes a halt, and it's sometimes
    // necessary. If you remove this the compiler gives:
    // Error: function test.notInfinite no return exp;
    //    or assert(0); at end of function
    assert(false);
}

// This generates an error, that is not meant to be caught.
// Objects are not guaranteed to be finalized.
int empty() pure nothrow {
    throw new Error(null);
}

static ~this() {
    // This module destructor is never called if
    // the program calls the exit function.
    import std.stdio;
    "Never called".writeln;
}

void main() {
    atexit(&foo);
    atexit(&bar);
    atexit(&spam);

    //abort(); // Also this is allowed. Will not call foo, bar, spam.
    exit(0);
}


% Implemented by Arjun Sunel
if problem ->
	exit(1).


open System

if condition then
    Environment.Exit 1


USING: kernel system ;

t [ 0 exit ] when


debug @
if   QUIT  \ quit back to the interpreter
else BYE   \ exit forth environment completely (e.g. end of a Forth shell script)
then


IF (condition) STOP [message]
! message is optional and is a character string.
! If present, the message is output to the standard output device.


'FB 1.05.0 Win64 'endprog.bas'

Dim isError As Boolean = True
If isError Then
  End 1
End If

' The following code won't be executed
Print
Print "Press any key to quit"
Sleep


Public Sub Form_Open()
Dim siCount As Short

Do
  If siCount > 1000 Then Break
  Inc siCount
Loop

Me.Close

End


Star [email protected]{found a Star Trek reference\n}@abort


problem=1
if (problem) {
  exit gnuplot
}


func main() {
    if problem {
        return
    }
}


import Control.Monad
import System.Exit

when problem do
    exitWith ExitSuccess                    -- success
    exitWith (ExitFailure integerErrorCode) -- some failure with code
    exitSuccess                             -- success; in GHC 6.10+
    exitFailure                             -- generic failure


exit(i)          # terminates the program setting an exit code of i
stop(x1,x2,..)   # terminates the program writing out x1,..; if any xi is a file writing switches to that file
runerr(i,x)      # terminates the program with run time error 'i' for value 'x'


if(problem){
   System.exit(integerErrorCode);
   //conventionally, error code 0 is the code for "OK",
   // while anything else is an actual problem
   //optionally: Runtime.getRuntime().exit(integerErrorCode);
}


$ jq -n '"Hello", if 1 then error else 2 end'
"Hello"


quit() # terminates program normally, with its child processes. See also exit(0).


// version 1.0.6

fun main(args: Array<String>) {
    val problem = true
    if (problem) System.exit(1) // non-zero code passed to OS to indicate a problem
    println("Program terminating normally")  // this line will not be executed
}


#!/usr/bin/lasso9
//[

handle => {
	stdoutnl('The end is here')
}

stdoutnl('Starting execution')

abort

stdoutnl('Ending execution')


bye   ; exits to shell

throw "toplevel  ; exits to interactive prompt

pause      ; escapes to interactive prompt for debugging
continue   ; resumes after a PAUSE


if some_condition then
    os.exit( number )
end


Module Checkit {
      For i=1 to 200
      Thread {
            k++
            Print "Thread:"; num, "k=";k
      } as M
      Thread M Execute  {
            static num=M, k=1000*i
      }
      Thread M interval 100+900*rnd
      next i

      Task.Main 20 {
            if random(10)=1 then Set End
      }
}
Checkit


beginning
define(`problem',1)
ifelse(problem,1,`m4exit(1)')
ending


/* Basically, it's simply quit() */

block([ans], loop, if (ans: read("Really quit ? (y, n)")) = 'y
                   then quit()
                   elseif ans = 'n then (print("Nice choice!"), 'done)
                   else (print("I dont' understand..."), go(loop)));


/*
 Program termination, in Neko
*/

var sys_exit = $loader.loadprim("[email protected]_exit", 1)

var return_code = 42
if true sys_exit(return_code)

$print("Control flow does not make it this far")


using System.Environment
...
    when (problem) Exit(1)
...


/* NetRexx */
options replace format comments java crossref symbols nobinary

extremePrejudice = (1 == 1)
if extremePrejudice then do
  exit extremePrejudice
  end

return


if problem1:
  quit QuitFailure

if problem2:
  quit "There is a problem", QuitFailure


if problem then
  exit integerErrorCode;
  (* conventionally, error code 0 is the code for "OK",
     while anything else is an actual problem *)


import: os

some_condition ifTrue: [ 0 OS.exit ]


(shutdown 0) ; it can be any exit code instead of provided 0


if Problem then {Application.exit 0} end


if ($problem) {
    exit integerErrorCode;
    # conventionally, error code 0 is the code for "OK"
    #  (you can also omit the argument in this case)
    # while anything else is an actual problem
}


if error_code!=NO_ERROR then
    abort(0)
end if


(push '*Bye '(prinl "Goodbye world!"))
(bye)


STOP; /* terminates the entire program */
      /* PL/I does any required cleanup, such as closing files. */


INPUT "Press any key...", a$
IF 1 THEN SYSTEM


#lang racket
(run-stuff)
(when (something-bad-happened) (exit 1))


/*REXX program showing five ways to perform a REXX program termination. */

  /*─────1st way────────────────────────────────────────────────────────*/
exit

  /*─────2nd way────────────────────────────────────────────────────────*/
exit  (expression)     /*Note: the "expression" doesn't need parentheses*/
                       /*"expression"  is any REXX expression.          */

  /*─────3rd way────────────────────────────────────────────────────────*/
return                 /*which returns to this program's invoker.  If   */
                       /*this is the main body  (and not a subroutine), */
                       /*the REXX interpreter terminates the program.   */

  /*─────4th way────────────────────────────────────────────────────────*/
return (expression)    /* [See the note above concerning parentheses.]  */

  /*─────5th way────────────────────────────────────────────────────────*/
    /*control*/
    /*   │   */        /*if there is no EXIT and program control "falls */
    /*   │   */        /*through" to the "bottom" (end) of the program, */
    /*   │   */        /*an   EXIT   is simulated and the program is    */
    /*   │   */        /*terminated.                                    */
    /*   ↓   */
    /* e-o-f */        /* e-o-f   =   end-of-file.                      */


for n = 1 to 10
    see n + nl
    if n = 5 exit ok
next


if problem
  exit(1)
end

# or
if problem
  abort   # equivalent to exit(1)
end


fn main() {
    println!("The program is running");
    return;
    println!("This line won't be printed");
}


if (problem) {
  // sys.exit returns type "Nothing"
  sys.exit(0)
  // conventionally, error code 0 is the code for "OK",
  // while anything else is an actual problem
}


(if problem
  (exit)) ; exit successfully


$ include "seed7_05.s7i";

const proc: main is func
  begin
    # whatever logic is required in your main procedure
    if some_condition then
      exit(PROGRAM);
    end if;
  end func;


IF terminallyIll THEN terminate_program;


if problem then
  OS.Process.exit OS.Process.failure
  (* valid status codes include OS.Process.success and OS.Process.failure *)
else
  ()


if {$problem} {
    # Print a “friendly” message...
    puts stderr "some problem occurred"
    # Indicate to the caller of the program that there was a problem
    exit 1
}


    LET I = 0
10  IF I = 10 THEN END
    LET I = I + 1
    PRINT I
    GOTO 10


$$ MODE TUSCRIPT
IF (condition==1) STOP
-> execution stops and message:
IF (condition==2) ERROR/STOP "condition ",condition, " Execution STOP "


#!/bin/sh

a='1'
b='1'
if [ "$a" -eq "$b" ]; then
  exit 239    # Unexpected error
fi
exit 0    # Program terminated normally


'In case of problem this will terminate the program (without cleanup):
If problem then End
'As VBA is run within an application, such as Excel, a more rigorous way would be:
If problem then Application.Quit
'This will stop the application, but will prompt you to save work.


dim i, j
j = 0
do
    for i = 1 to 100
        while j < i
            if i = 3 then
                wscript.quit
            end if
        wend
    next
loop


if (#99 == 1) { Return }        // Exit current macro. Return to calling macro.
if (#99 == 2) { Break_Out() }   // Stop all macro execution and return to command mode.
if (#99 == 3) { Exit }          // Exit Vedit. Prompt for saving any changed files.
if (#99 == 4) { Exit(4) }       // As above, but return specified value (instead of 0) to OS
if (#99 == 5) { Xall }          // Exit Vedit. Save changed files without prompting.
if (#99 == 6) { Qall }          // Exit Vedit. Do not save any files.


Sub Main()
    '...
    If problem Then
        For n& = Forms.Count To 0 Step -1
            Unload Forms(n&)
        Next
        Exit Sub
    End If
    '...
End Sub


import "io" for Stdin, Stdout

System.write("Do you want to terminate the program y/n ?  ")
Stdout.flush()
var yn = Stdin.readLine()
if (yn == "y" || yn == "Y") {
    System.print("OK, shutting down")
    Fiber.suspend() // return to OS
}
System.print("OK, carrying on")


;assumes this runs inline
org &1000     ;program start
main:
call GetInput ;unimplemented input get routine, returns key press in accumulator
cp 'Y'        ;compare to ascii capital Y
ret z         ;return to BASIC if equal
jp main       ;loop back to main


if (die) System.exit();
if (die) System.exit(1);
if (die) System.exit("dumping core");


F get_primes(primes_count)
   V limit = 17 * primes_count
   V is_prime = [0B] * 2 [+] [1B] * (limit - 1)
   L(n) 0 .< Int(limit ^ 0.5 + 1.5)
      I is_prime[n]
         L(i) (n * n .< limit + 1).step(n)
            is_prime[i] = 0B

   [Int] primes
   L(prime) is_prime
      I prime
         primes.append(L.index)
         I primes.len == primes_count
            L.break
   R primes

V primes = get_primes(100000)

F primorial(n)
   BigInt r = 1
   L(i) 0 .< n
      r *= :primes[i]
   R r

print(‘First ten primorials: ’(0.<10).map(n -> primorial(n)))
L(e) 6
   V n = 10 ^ e
   print(‘primorial(#.) has #. digits’.format(n, String(primorial(n)).len))


#include <inttypes.h>
#include <math.h>
#include <stdlib.h>
#include <stdio.h>
#include <stdint.h>
#include <string.h>
#include <gmp.h>

/* Eratosthenes bit-sieve */
int es_check(uint32_t *sieve, uint64_t n)
{
    if ((n != 2 && !(n & 1)) || (n < 2))
        return 0;
    else
        return !(sieve[n >> 6] & (1 << (n >> 1 & 31)));
}

uint32_t *es_sieve(const uint64_t nth, uint64_t *es_size)
{
    *es_size = nth * log(nth) + nth * (log(log(nth)) - 0.9385f) + 1;
    uint32_t *sieve = calloc((*es_size >> 6) + 1, sizeof(uint32_t));

    for (uint64_t i = 3; i < sqrt(*es_size) + 1; i += 2)
        if (!(sieve[i >> 6] & (1 << (i >> 1 & 31))))
            for (uint64_t j = i * i; j < *es_size; j += (i << 1))
                sieve[j >> 6] |= (1 << (j >> 1 & 31));

    return sieve;
}

size_t mpz_number_of_digits(const mpz_t op)
{
    char *opstr = mpz_get_str(NULL, 10, op);
    const size_t oplen = strlen(opstr);
    free(opstr);
    return oplen;
}

#define PRIMORIAL_LIMIT 1000000

int main(void)
{
    /* Construct a sieve of the first 1,000,000 primes */
    uint64_t sieve_size;
    uint32_t *sieve = es_sieve(PRIMORIAL_LIMIT, &sieve_size);

    mpz_t primorial;
    mpz_init_set_ui(primorial, 1);

    uint64_t prime_count = 0;
    int print = 1;
    double unused;

    for (uint64_t i = 2; i < sieve_size && prime_count <= PRIMORIAL_LIMIT; ++i) {
        if (print) {
            if (prime_count < 10)
                gmp_printf("Primorial(%" PRIu64 ") = %Zd\n", prime_count, primorial);
            /* Is the current number a power of 10? */
            else if (!modf(log10(prime_count), &unused))
                printf("Primorial(%" PRIu64 ") has %zu digits\n", prime_count, mpz_number_of_digits(primorial));
            print = 0;
        }

        if (es_check(sieve, i)) {
            mpz_mul_ui(primorial, primorial, i);
            prime_count++;
            print = 1;
        }

    }

    free(sieve);
    mpz_clear(primorial);
    return 0;
}


#include <gmpxx.h>
#include <primesieve.hpp>

#include <cstdint>
#include <iomanip>
#include <iostream>

size_t digits(const mpz_class& n) { return n.get_str().length(); }

mpz_class primorial(unsigned int n) {
    mpz_class p;
    mpz_primorial_ui(p.get_mpz_t(), n);
    return p;
}

int main() {
    uint64_t index = 0;
    primesieve::iterator pi;
    std::cout << "First 10 primorial numbers:\n";
    for (mpz_class pn = 1; index < 10; ++index) {
        unsigned int prime = pi.next_prime();
        std::cout << index << ": " << pn << '\n';
        pn *= prime;
    }
    std::cout << "\nLength of primorial number whose index is:\n";
    for (uint64_t power = 10; power <= 1000000; power *= 10) {
        uint64_t prime = primesieve::nth_prime(power);
        std::cout << std::setw(7) << power << ": "
                  << digits(primorial(prime)) << '\n';
    }
    return 0;
}


(ns example
  (:gen-class))

; Generate Prime Numbers (Implementation from RosettaCode--link above)
(defn primes-hashmap
  "Infinite sequence of primes using an incremental Sieve or Eratosthenes with a Hashmap"
  []
  (letfn [(nxtoddprm [c q bsprms cmpsts]
            (if (>= c q) ;; only ever equal
              ; Update cmpsts with primes up to sqrt c
              (let [p2 (* (first bsprms) 2),
                    nbps (next bsprms),
                    nbp (first nbps)]
                (recur (+ c 2) (* nbp nbp) nbps (assoc cmpsts (+ q p2) p2)))

              (if (contains? cmpsts c)
                ; Not prime
                (recur (+ c 2) q bsprms
                       (let [adv (cmpsts c), ncmps (dissoc cmpsts c)]
                         (assoc ncmps
                           (loop [try (+ c adv)] ;; ensure map entry is unique
                             (if (contains? ncmps try)
                               (recur (+ try adv))
                               try))
                           adv)))
                ; prime
                (cons c (lazy-seq (nxtoddprm (+ c 2) q bsprms cmpsts))))))]
    (do (def baseoddprms (cons 3 (lazy-seq (nxtoddprm 5 9 baseoddprms {}))))
        (cons 2 (lazy-seq (nxtoddprm 3 9 baseoddprms {}))))))

;; Generate Primorial Numbers
(defn primorial [n]
  " Function produces the nth primorial number"
  (if (= n 0)
    1                                                           ; by definition
    (reduce *' (take n (primes-hashmap)))))                     ; multiply first n primes (retrieving primes from lazy-seq which generates primes as needed)

;; Show Results
(let [start (System/nanoTime)
      elapsed-secs (fn [] (/ (- (System/nanoTime) start) 1e9))]   ; System start time
  (doseq [i (concat (range 10) [1e2 1e3 1e4 1e5 1e6])
          :let [p (primorial i)]]                               ; Generate ith primorial number
    (if (< i 10)
      (println (format "primorial ( %7d ) = %10d" i (biginteger p)))         ; Output for first 10
      (println (format "primorial ( %7d ) has %8d digits\tafter %.3f secs"   ; Output with time since starting for remainder
                       (long i) (count (str p)) (elapsed-secs))))))


% This program uses the 'bigint' cluster from
% the 'misc.lib' included with PCLU.

isqrt = proc (s: int) returns (int)
    x0: int := s/2
    if x0=0 then return(s) end
    x1: int := (x0 + s/x0)/2
    while x1 < x0 do
        x0 := x1
        x1 := (x0 + s/x0)/2
    end
    return(x0)
end isqrt

sieve = proc (n: int) returns (array[bool])
    prime: array[bool] := array[bool]$fill(0,n+1,true)
    prime[0] := false
    prime[1] := false
    for p: int in int$from_to(2, isqrt(n)) do
        if prime[p] then
            for c: int in int$from_to_by(p*p,n,p) do
                prime[c] := false
            end
        end
    end
    return(prime)
end sieve

% Calculate the N'th primorial given a boolean array denoting primes
primorial = proc (n: int, prime: array[bool])
            returns (bigint) signals (out_of_primes)
    % 0'th primorial = 1
    p: bigint := bigint$i2bi(1)
    for i: int in array[bool]$indexes(prime) do
        if ~prime[i] then continue end
        if n=0 then break end
        p := p * bigint$i2bi(i)
        n := n-1
    end
    if n>0 then signal out_of_primes end
    return(p)
end primorial

% Find the length in digits of a bigint without converting it to a string.
% The naive way takes over an hour to count the digits for p(100000),
% this one ~5 minutes.
n_digits = proc (n: bigint) returns (int)
    own zero: bigint := bigint$i2bi(0)
    own ten: bigint := bigint$i2bi(10)

    digs: int := 1
    dstep: int := 1
    tenfac: bigint := ten
    step: bigint := ten

    while n >= tenfac do
        digs := digs + dstep
        step := step * ten
        dstep := dstep + 1
        next: bigint := tenfac*step
        if n >= next then
            tenfac := next
        else
            step, dstep := ten, 1
            tenfac := tenfac*step
        end
    end
    return(digs)
end n_digits

start_up = proc ()
    po: stream := stream$primary_output()

    % Sieve a million primes
    prime: array[bool] := sieve(15485863)

    % Show the first 10 primorials
    for i: int in int$from_to(0,9) do
        stream$puts(po, "primorial(" || int$unparse(i) || ") = ")
        stream$putright(po, bigint$unparse(primorial(i, prime)), 15)
        stream$putl(po, "")
    end

    % Show the length of some bigger primorial numbers
    for tpow: int in int$from_to(1,5) do
        p_ix: int := 10**tpow
        stream$puts(po, "length of primorial(")
        stream$putright(po, int$unparse(p_ix), 7)
        stream$puts(po, ") = ")
        stream$putright(po, int$unparse(n_digits(primorial(p_ix, prime))), 7)
        stream$putl(po, "")
    end
end start_up


(defun primorial-number-length (n w)
  (values (primorial-number n) (primorial-length w)))

(defun primorial-number (n)
  (loop for a below n collect (primorial a)))

(defun primorial-length (w)
  (loop for a in w collect (length (write-to-string (primorial a)))))

(defun primorial (n &optional (m 1) (k -1) (z 1) &aux (f (primep m)))
  (if (= k n) z (primorial n (1+ m) (+ k (if f 1 0)) (if f (* m z) z))))

(defun primep (n)
  (loop for a from 2 to (isqrt n) never (zerop (mod n a))))


import std.stdio;
import std.format;
import std.bigint;
import std.math;
import std.algorithm;

int sieveLimit = 1300_000;

bool[] notPrime;

void main()
{
  // initialize
  sieve(sieveLimit);

  // output 1
  foreach (i; 0..10)
    writefln("primorial(%d): %d", i, primorial(i));

  // output 2
  foreach (i; 1..6)
    writefln("primorial(10^%d) has length %d", i, count(format("%d", primorial(pow(10, i)))));

}

BigInt primorial(int n)
{
  if (n == 0) return BigInt(1);

  BigInt result = BigInt(1);
  for (int i = 0; i < sieveLimit && n > 0; i++)
  {
    if (notPrime[i]) continue;
    result *= BigInt(i);
    n--;
  }
  return result;
}

void sieve(int limit)
{
  notPrime = new bool[limit];
  notPrime[0] = notPrime[1] = true;

  auto max = sqrt(cast (float) limit);
  for (int n = 2; n <= max; n++)
  {
    if (!notPrime[n])
    {
      for (int k = n * n; k < limit; k += n)
      {
        notPrime[k] = true;
      }
    }
  }
}


defmodule SieveofEratosthenes do
  def init(lim) do
    find_primes(2,lim,(2..lim))
  end

  def find_primes(count,lim,nums) when (count * count) > lim do
    nums
  end

  def find_primes(count,lim,nums) when (count * count) <= lim do
    find_primes(count+1,lim,Enum.reject(nums,&(rem(&1,count) == 0 and &1 > count)))
  end
end


// Primorial Numbers. Nigel Galloway: August 3rd., 2021
primes32()|>Seq.scan((*)) 1|>Seq.take 10|>Seq.iter(printf "%d "); printfn "\n"
[10;100;1000;10000;100000]|>List.iter(fun n->printfn "%d" ((int)(System.Numerics.BigInteger.Log10 (Seq.item n (primesI()|>Seq.scan((*)) 1I)))+1))


USING: formatting kernel literals math math.functions
math.primes sequences ;
IN: rosetta-code.primorial-numbers

CONSTANT: primes $[ 1,000,000 nprimes ]

: digit-count ( n -- count ) log10 floor >integer 1 + ;

: primorial ( n -- m ) primes swap head product ;

: .primorial ( n -- ) dup primorial "Primorial(%d) = %d\n"
    printf ;

: .digit-count ( n -- ) dup primorial digit-count
    "Primorial(%d) has %d digits\n" printf ;

: part1 ( -- ) 10 iota [ .primorial ] each ;

: part2 ( -- ) { 10 100 1000 10000 100000 1000000 }
    [ .digit-count ] each ;

: main ( -- ) part1 part2 ;

MAIN: main


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

Const As UInteger Base_ = 1000000000
ReDim Shared As UInteger primes()

Sub sieve(need As UInteger)

    ' estimate is to high, but ensures that we have enough primes
    Dim As UInteger max = need * (Log(need) + Log(Log(need)))
    Dim As UInteger t = 1 ,x , x2
    Dim As Byte p(max)

    ReDim primes (need + need \ 3) ' we trim the array later
    primes(0) = 1                  ' by definition
    primes(1) = 2                  ' first prime, the only even prime

    ' only consider the odd number
    For x = 3 To Sqr(max) Step 2
        If p(x) = 0 Then
            For x2 = x * x To max Step x * 2
                p(x2) = 1
            Next
        End If
    Next

    ' move found primes to array
    For x = 3 To max Step 2
        If p(x) = 0 Then
            t += 1
            primes(t) = x
        EndIf
    Next
    'ReDim Preserve primes(t)
    ReDim Preserve primes(need)

End Sub

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

Dim As UInteger n, i, pow, primorial
Dim As String str_out, buffer = Space(10)

Dim As UInteger max = 100000 ' maximum number of primes we need

sieve(max)

primorial = 1
Print

For n = 0 To 9
    primorial = primorial * primes(n)
    Print Using " primorial(#) ="; n;
    RSet buffer, Str(primorial)
    str_out = buffer
    Print str_out
Next

' could use GMP, but why not make are own big integer routine
Dim As UInteger bigint(max), first = max, last = max
Dim As UInteger l, p, carry, low = 9, high = 10
Dim As ULongInt result
Dim As UInteger Ptr big_i

' start at the back, number grows to the left like normal number
bigint(last) = primorial
Print

For pow = 0 To Len(Str(max)) -2
    If pow > 0 Then
        low = high
        high = high * 10
    End If
    For n = low + 1 To high
        carry = 0
        big_i = @bigint(last)
        For i = last To first Step -1
            result = CULngInt(primes(n)) * *big_i + carry
            carry = result \ Base_
            *big_i = result - carry * Base_
            big_i = big_i -1
        Next i
        If carry <> 0 Then
            first = first -1
            *big_i = carry
        End If
    Next n
    l = Len(Str(bigint(first))) + (last - first) * 9
    Print " primorial("; high; ") has "; l ;" digits"
Next pow

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


primorial[n] := product[first[primes[], n]]

for n = 0 to 9
   println["primorial[$n] = " + primorial[n]]

for n = [10, 100, 1000, 10000, 100000, million]
   println["Length of primorial $n is " + length[toString[primorial[n]]] + " decimal digits."]


package main

import (
	"fmt"
	"math/big"
	"time"

	"github.com/jbarham/primegen.go"
)

func main() {
	start := time.Now()
	pg := primegen.New()
	var i uint64
	p := big.NewInt(1)
	tmp := new(big.Int)
	for i <= 9 {
		fmt.Printf("primorial(%v) = %v\n", i, p)
		i++
		p = p.Mul(p, tmp.SetUint64(pg.Next()))
	}
	for _, j := range []uint64{1e1, 1e2, 1e3, 1e4, 1e5, 1e6} {
		for i < j {
			i++
			p = p.Mul(p, tmp.SetUint64(pg.Next()))
		}
		fmt.Printf("primorial(%v) has %v digits", i, len(p.String()))
		fmt.Printf("\t(after %v)\n", time.Since(start))
	}
}


import Control.Arrow ((&&&))
import Data.List (scanl1, foldl1')

getNthPrimorial :: Int -> Integer
getNthPrimorial n = foldl1' (*) (take n primes)

primes :: [Integer]
primes = 2 : filter isPrime [3,5..]

isPrime :: Integer -> Bool
isPrime = isPrime_ primes
  where isPrime_ :: [Integer] -> Integer -> Bool
        isPrime_ (p:ps) n
          | p * p > n      = True
          | n `mod` p == 0 = False
          | otherwise      = isPrime_ ps n

primorials :: [Integer]
primorials = 1 : scanl1 (*) primes

main :: IO ()
main = do
  -- Print the first 10 primorial numbers
  let firstTen = take 10 primorials
  putStrLn $ "The first 10 primorial numbers are: " ++ show firstTen

  -- Show the length of the primorials with index 10^[1..6]
  let powersOfTen = [1..6]
      primorialTens = map (id &&& (length . show . getNthPrimorial . (10^))) powersOfTen
      calculate = mapM_ (\(a,b) -> putStrLn $ "Primorial(10^"++show a++") has "++show b++" digits")
  calculate primorialTens


import java.math.BigInteger;

public class PrimorialNumbers {
    final static int sieveLimit = 1300_000;
    static boolean[] notPrime = sieve(sieveLimit);

    public static void main(String[] args) {
        for (int i = 0; i < 10; i++)
            System.out.printf("primorial(%d): %d%n", i, primorial(i));

        for (int i = 1; i < 6; i++) {
            int len = primorial((int) Math.pow(10, i)).toString().length();
            System.out.printf("primorial(10^%d) has length %d%n", i, len);
        }
    }

    static BigInteger primorial(int n) {
        if (n == 0)
            return BigInteger.ONE;

        BigInteger result = BigInteger.ONE;
        for (int i = 0; i < sieveLimit && n > 0; i++) {
            if (notPrime[i])
                continue;
            result = result.multiply(BigInteger.valueOf(i));
            n--;
        }
        return result;
    }

    public static boolean[] sieve(int limit) {
        boolean[] composite = new boolean[limit];
        composite[0] = composite[1] = true;

        int max = (int) Math.sqrt(limit);
        for (int n = 2; n <= max; n++) {
            if (!composite[n]) {
                for (int k = n * n; k < limit; k += n) {
                    composite[k] = true;
                }
            }
        }
        return composite;
    }
}


def primes:
  2, range(3; infinite; 2) | select(is_prime);

# generate an infinite stream of primorials beginning with primorial(0)
def primorials:
  0, foreach primes as $p (1; .*$p; .);

"The first ten primorial numbers are:",
limit(10; primorials),

"\nThe primorials with the given index have the lengths shown:",
([10, 100, 1000, 10000, 100000] as $sample
| limit($sample|length;
    foreach primes as $p ([0,1];   # [index, primorial]
      .[0]+=1 | .[1] *= $p;
      select(.[0]|IN($sample[])) | [.[0], (.[1]|tostring|length)] ) ))


using Primes

primelist = primes(300000001) # primes to 30 million

primorial(n) = foldr(*, primelist[1:n], init=BigInt(1))

println("The first ten primorials are: $([primorial(n) for n in 1:10])")

for i in 1:6
    n = 10^i
    p = primorial(n)
    plen = Int(floor(log10(p))) + 1
    println("primorial($n) has length $plen digits in base 10.")
end


// version 1.0.6

import java.math.BigInteger

const val LIMIT = 1000000  // expect a run time of about 20 minutes on a typical laptop

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 countDigits(bi: BigInteger): Int = bi.toString().length

fun main(args: Array<String>) {
    println("Primorial(0) = 1")
    println("Primorial(1) = 2")
    var count = 1
    var p = 3
    var prod = BigInteger.valueOf(2)
    var target = 10
    while(true) {
        if (isPrime(p)) {
            count++
            prod *= BigInteger.valueOf(p.toLong())
            if (count < 10) {
                println("Primorial($count) = $prod")
                if (count == 9) println()
            }
            else if (count == target) {
                println("Primorial($target) has ${countDigits(prod)} digits")
                if (count == LIMIT) break
                target *= 10
            }
        }
        p += 2
    }
}


-- libs
sieve = script("math.primes").new()
bigint = script("bigint").new()

cnt = 1000 * 100
primes = sieve.getNPrimes(cnt)

pr = 1
put "Primorial 0: " & pr
repeat with i = 1 to 9
    pr = pr*primes[i]
    put "Primorial " & i & ": " & pr
end repeat

pow10 = 10
repeat with i = 10 to cnt
    pr = bigint.mul(pr, primes[i])
    if i mod pow10=0 then
        put "Primorial " & i & " has length: " & pr.length
        pow10 = pow10 * 10
    end if
end repeat


with(NumberTheory):

primorial := proc(n::integer)
 local total := 1:
 local count:
 for count from 1 to n do
  total *= ithprime(count):
 end:
 return total;
end proc:

primorialDigits := proc(n::integer)
 local logSum := 0:
 local count:
 for count from 1 to n do
  logSum += log10(ithprime(count)):
 end:
 return ceil(logSum);
end proc:

print("The first 10 primorial numbers");

for count from 0 to 9 do
 cat("primorial(", count, ") = ", primorial(count))
end;

for expon from 1 to 5 do
 cat("primorial(", 10^expon, ") has ", primorialDigits(10^expon), " digits");
end;


library "prime_sieve.5c"

# For 1 million primes
# int val = 15485867;
int val = 1299743;

int start = millis();
int [*] primes = PrimeSieve::primes(val);
printf("%d primes (%d) in %dms\n", dim(primes), primes[dim(primes)-1], millis() - start);

int primorial(int n) {
   if (n == 0) return 1;
   if (n == 1) return 2;
   int v = 2;
   for (int i = 2; i <= n; i++) {
       v *= primes[i-2];
   }
   return v;
}

for (int i = 0; i < 10; i++) {
   printf("primorial(%d) = %d\n", i, primorial(i));
}

for (int i = 1; i < 6; i++) {
   start = millis();
   int p = 10**i;
   int pn = primorial(p);

   int digits = floor(Math::log10(pn)) + 1;
   printf("primorial(%d) has %d digits, in %dms\n", p, digits, millis() - start);
}


import times

let t0 = cpuTime()

####################################################################################################
# Build list of primes.

const
  NPrimes = 1_000_000
  N = 16 * NPrimes

var sieve: array[(N - 1) div 2 + 1, bool]   # False (default) means prime.

for i, composite in sieve:
  if not composite:
    let n = 2 * i + 3
    for k in countup(n * n, N, 2 * n):
      sieve[(k - 3) div 2] = true

var primes = @[2]
for i, composite in sieve:
  if not composite:
    primes.add 2 * i + 3

if primes.len < NPrimes:
  quit "Not enough primes. Please, increase value of N."

####################################################################################################
# Compute primorial.

import strformat
import bignum

const LastToPrint = NPrimes

iterator primorials(): Int =
  ## Yield successive primorial numbers.
  var prim = newInt(1)
  yield prim
  for p in primes:
    prim *= p
    yield prim

var n = 0
for prim in primorials():
  echo &"primorial({n}) = {prim}"
  inc n
  if n == 10: break

n = 0
var nextToPrint = 10
for prim in primorials():
  if n == nextToPrint:
    echo &"primorial({n}) has {($prim).len} digits"
    if nextToPrint == LastToPrint: break
    nextToPrint *= 10
  inc n

echo ""
echo &"Total time: {cpuTime() - t0:.2f} s"


{$H+}
uses
  sysutils,mp_types,mp_base,mp_prime,mp_numth;
var
 x: mp_int;
 t0,t1: TDateTime;
 s: AnsiString;

var
  i,cnt : NativeInt;
  ctx :TPrimeContext;
begin
  mp_init(x);
  cnt := 1;
  i := 2;
  FindFirstPrime32(i,ctx);
  i := 10;
  t0 := time;
  repeat
    repeat
      FindNextPrime32(ctx);
      inc(cnt);
    until cnt = i;
    mp_primorial(ctx.prime,x);
    s:= mp_adecimal(x);
    writeln('MaxPrime ',ctx.prime:10,length(s):8,' digits');
    i := 10*i;
  until i > 1000*1000;
  t1 := time;
  Writeln((t1-t0)*86400.0:10:3,' s');
end.


use ntheory qw(pn_primorial);

say "First ten primorials: ", join ", ", map { pn_primorial($_) } 0..9;

say "primorial(10^$_) has ".(length pn_primorial(10**$_))." digits" for 1..6;


with javascript_semantics
include mpfr.e

function vecprod(sequence s)
    if s={} then
        s = {mpz_init(1)}
    else
        for i=1 to length(s) do
            s[i] = mpz_init(s[i])
        end for
        while length(s)>1 do
            for i=1 to floor(length(s)/2) do
                mpz_mul(s[i],s[i],s[-i])
            end for
            s = s[1..ceil(length(s)/2)]
        end while
    end if
    return s[1]
end function

constant t0 = time(),
         max10 = iff(platform()=JS?4:6),
         tests = tagset(9,0)&sq_power(10,tagset(max10)),
         primes = get_primes(1_000_000)

for i=1 to length(tests) do
    integer ti = tests[i]
    mpz primorial = vecprod(primes[1..ti])
    string ps = iff(ti<10?sprintf("= %s",{mpz_get_str(primorial,comma_fill:=true)})
                         :sprintf("has %,d digits",mpz_sizeinbase(primorial,10)))
    printf(1,"Primorial(%,d) %s\n", {ti, ps})
end for
?elapsed(time()-t0)


(de prime? (N Lst)
   (let S (sqrt N)
      (for D Lst
         (T (> D S) T)
         (T (=0 (% N D)) NIL) ) ) )

(de take (N)
   (let I 1
      (make
         (link 2)
         (do (dec N)
            (until (prime? (inc 'I 2) (made)))
            (link I) ) ) ) )

# This is a simple approach to calculate primorial may not be the fastest one
(de primorial (N)
   (apply * (take N)) )

#print 1st 10 primorial numbers
(for M 10 (prinl "primorial: "(primorial M)))

# print the length of primorial numbers.
[prinl (length (primorial (** 10 1)]
[prinl (length (primorial (** 10 2)]
[prinl (length (primorial (** 10 3)]
[prinl (length (primorial (** 10 4)]
#The last one takes a very long time to compute.
[prinl (length (primorial (** 10 5)]


from pyprimes import nprimes
from functools import reduce

primelist = list(nprimes(1000001))    # [2, 3, 5, ...]

def primorial(n):
    return reduce(int.__mul__, primelist[:n], 1)

if __name__ == '__main__':
    print('First ten primorals:', [primorial(n) for n in range(10)])
    for e in range(7):
        n = 10**e
        print('primorial(%i) has %i digits' % (n, len(str(primorial(n)))))


#lang racket

(require (except-in math/number-theory nth-prime))

(define-syntax-rule (define/cache (name arg) body ...)
  (begin
    (define cache (make-hash))
    (define (name arg)
      (hash-ref! cache arg (lambda () body ...)))))

(define (num-length n)
  ;warning: this defines (num-length 0) as 0
  (if (zero? n)
    0
    (add1 (num-length (quotient n 10)))))

(define/cache (nth-prime n)
  (if (zero? n)
      2
      (for/first ([p (in-naturals (add1 (nth-prime (sub1 n))))]
                  #:when (prime? p))
           p)))

(define (primorial n)
  (if (zero? n)
     1
     (* (primorial (sub1 n))
        (nth-prime (sub1 n)))))

(displayln
 (for/list ([i (in-range 10)])
   (primorial i)))

(for ([i (in-range 1 6)])
  (printf "Primorial(10^~a) has ~a digits.\n"
          i
          (num-length (primorial (expt 10 i)))))


use Math::Primesieve;

my $sieve = Math::Primesieve.new;
my @primes = $sieve.primes(10_000_000);

sub primorial($n) { [*] @primes[^$n] }

say "First ten primorials: {(primorial $_ for ^10)}";
say "primorial(10^$_) has {primorial(10**$_).chars} digits" for 1..5;