with javascript_semantics
include complex.e

procedure m_print(sequence a)
    a = deep_copy(a)
    integer l = length(a)
    for i=1 to l do
        for j=1 to l do
            a[i][j] = complex_sprint(a[i][j])
        end for
        a[i] = "["&join(a[i],",")&"]"
    end for
    puts(1,join(a,"\n")&"\n")
end procedure

function conjugate_transpose(sequence a)
    sequence res = deep_copy(a)
    integer l = length(a)
    for i=1 to l do
        for j=1 to l do
          res[i][j] = complex_conjugate(a[j][i])
        end for
    end for
    return res
end function

function m_unitary(sequence act)
-- note: a was normal and act = a*ct already
    integer l = length(act)
    for i=1 to l do
        for j=1 to l do
            atom {re,im} = act[i,j]
            -- round to nearest billionth
            -- (powers of 2 help the FPU out)
            re = round(re,1024*1024*1024)
            im = round(im,1024*1024*1024)
            if im!=0
            or (i=j and re!=1)
            or (i!=j and re!=0) then
                return 0
            end if
        end for
    end for
    return 1
end function

function m_mul(sequence a, sequence b)
    sequence res = sq_mul(a,0)
    integer l = length(a)
    for i=1 to l do
        for j=1 to l do
            for k=1 to l do
                res[i][j] = complex_add(res[i][j],complex_mul(a[i][k],b[k][j]))
            end for
        end for
    end for
    return res
end function

procedure test(sequence a)
    sequence ct = conjugate_transpose(a)
    printf(1,"Original matrix:\n")
    m_print(a)
    printf(1,"Conjugate transpose:\n")
    m_print(ct)
    -- note: rounding similar to that in m_unitary may be rqd (in a similar
    --       loop in a new m_equal function) on these two equality tests,
    --       but as it is, all tests pass with the builtin = operator.
    printf(1,"Hermitian?: %t\n",a=ct) -- (this one)
    sequence act = m_mul(a,ct), cta = m_mul(ct,a)
    bool normal = act=cta                                   -- (&this one)
    printf(1,"Normal?: %t\n",normal)
    printf(1,"Unitary?: %t\n\n",normal and m_unitary(act))
end procedure

constant x = sqrt(2)/2,
         tests = {{{{3, 0},{2,1}},
                   {{2,-1},{1,0}}},

                  {{{ 1, 0},{ 1, 1},{ 0, 2}},
                   {{ 1,-1},{ 5, 0},{-3, 0}},
                   {{ 0,-2},{-3, 0},{ 0, 0}}},

                  {{{0.5,+0.5},{0.5,-0.5}},
                   {{0.5,-0.5},{0.5,+0.5}}},

                  {{{ 1, 0},{ 1, 0},{ 0, 0}},
                   {{ 0, 0},{ 1, 0},{ 1, 0}},
                   {{ 1, 0},{ 0, 0},{ 1, 0}}},

                  {{{x, 0},{x, 0},{0, 0}},
                   {{0,-x},{0, x},{0, 0}},
                   {{0, 0},{0, 0},{0, 1}}},

                  {{{2,7},{9,-5}},
                   {{3,4},{8,-6}}}}

papply(tests,test)


test: procedure options (main); /* 1 October 2012 */
   declare n fixed binary;

   put ('Conjugate a complex square matrix.');
   put skip list ('What is the order of the matrix?:');
   get (n);
   begin;
      declare (M, MH, MM, MM_MMH, MM_MHM, IDENTITY)(n,n) fixed complex;
      declare i fixed binary;

      IDENTITY = 0; do i = 1 to n; IDENTITY(I,I) = 1; end;
      put skip list ('Please type the matrix:');
      get list (M);
      do i = 1 to n;
         put skip list (M(i,*));
      end;
      do i = 1 to n;
         MH(i,*) = conjg(M(*,i));
      end;
      put skip list ('The conjugate transpose is:');
      do i = 1 to n;
         put skip list (MH(i,*));
      end;
      if all(M=MH) then
         put skip list ('Matrix is Hermitian');
      call MMULT(M, MH, MM_MMH);
      call MMULT(MH, M, MM_MHM);

      if all(MM_MMH = MM_MHM) then
         put skip list ('Matrix is Normal');

      if all(ABS(MM_MMH - IDENTITY) < 0.0001) then
         put skip list ('Matrix is unitary');
      if all(ABS(MM_MHM - IDENTITY) < 0.0001) then
         put skip list ('Matrix is unitary');
   end;

MMULT: procedure (M, MH, MM);
   declare (M, MH, MM)(*,*) fixed complex;
   declare (i, j, n) fixed binary;

   n = hbound(M,1);
   do i = 1 to n;
      do j = 1 to n;
         MM(i,j) = sum(M(i,*) * MH(*,j) );
      end;
   end;
end MMULT;
end test;


function conjugate-transpose($a) {
    $arr = @()
    if($a) {
        $n = $a.count - 1
        if(0 -lt $n) {
            $m = ($a | foreach {$_.count} | measure-object -Minimum).Minimum - 1
            if( 0 -le $m) {
                if (0 -lt $m) {
                    $arr [email protected](0)*($m+1)
                    foreach($i in 0..$m) {
                        $arr[$i] = foreach($j in 0..$n) {@([System.Numerics.complex]::Conjugate($a[$j][$i]))}
                    }
                } else {$arr = foreach($row in $a) {[System.Numerics.complex]::Conjugate($row[0])}}
            }
        } else {$arr = foreach($row in $a) {[System.Numerics.complex]::Conjugate($row[0])}}
    }
    $arr
}

function multarrays-complex($a, $b) {
    $c = @()
    if($a -and $b) {
        $n = $a.count - 1
        $m = $b[0].count - 1
        $c = @([System.Numerics.complex]::new(0,0))*($n+1)
        foreach ($i in 0..$n) {
            $c[$i] = foreach ($j in 0..$m) {
                [System.Numerics.complex]$sum = [System.Numerics.complex]::new(0,0)
                foreach ($k in 0..$n){$sum = [System.Numerics.complex]::Add($sum, ([System.Numerics.complex]::Multiply($a[$i][$k],$b[$k][$j])))}
                $sum
            }
        }
    }
    $c
}

function identity-complex($n) {
    if(0 -lt $n) {
        $array = @(0) * $n
        foreach ($i in 0..($n-1)) {
            $array[$i] = @([System.Numerics.complex]::new(0,0)) * $n
            $array[$i][$i] = [System.Numerics.complex]::new(1,0)
        }
        $array
    } else { @() }
}

function are-eq ($a,$b) { -not (Compare-Object $a $b -SyncWindow 0)}

function show($a) {
    if($a) {
        0..($a.Count - 1) | foreach{ if($a[$_]){"$($a[$_])"}else{""} }
    }
}
function complex($a,$b) {[System.Numerics.complex]::new($a,$b)}

$id2 = identity-complex 2
$m = @(@((complex 2 7), (complex 9 -5)),@((complex 3 4), (complex 8 -6)))
$hm = conjugate-transpose $m
$mhm = multarrays-complex $m $hm
$hmm = multarrays-complex $hm $m
"`$m ="
show $m
""
"`$hm = conjugate-transpose `$m ="
show $hm
""
"`$m * `$hm ="
show $mhm
""
"`$hm * `$m ="
show $hmm
""
"Hermitian? `$m = $(are-eq $m $hm)"
"Normal? `$m = $(are-eq $mhm $hmm)"
"Unitary? `$m = $((are-eq $id2 $hmm) -and (are-eq $id2 $mhm))"


def conjugate_transpose(m):
    return tuple(tuple(n.conjugate() for n in row) for row in zip(*m))

def mmul( ma, mb):
    return tuple(tuple(sum( ea*eb for ea,eb in zip(a,b)) for b in zip(*mb)) for a in ma)

def mi(size):
    'Complex Identity matrix'
    sz = range(size)
    m = [[0 + 0j for i in sz] for j in sz]
    for i in range(size):
        m[i][i] = 1 + 0j
    return tuple(tuple(row) for row in m)

def __allsame(vector):
    first, rest = vector[0], vector[1:]
    return all(i == first for i in rest)

def __allnearsame(vector, eps=1e-14):
    first, rest = vector[0], vector[1:]
    return all(abs(first.real - i.real) < eps and abs(first.imag - i.imag) < eps
               for i in rest)

def isequal(matrices, eps=1e-14):
    'Check any number of matrices for equality within eps'
    x = [len(m) for m in matrices]
    if not __allsame(x): return False
    y = [len(m[0]) for m in matrices]
    if not __allsame(y): return False
    for s in range(x[0]):
        for t in range(y[0]):
            if not __allnearsame([m[s][t] for m in matrices], eps): return False
    return True

def ishermitian(m, ct):
    return isequal([m, ct])

def isnormal(m, ct):
    return isequal([mmul(m, ct), mmul(ct, m)])

def isunitary(m, ct):
    mct, ctm = mmul(m, ct), mmul(ct, m)
    mctx, mcty, cmx, ctmy = len(mct), len(mct[0]), len(ctm), len(ctm[0])
    ident = mi(mctx)
    return isequal([mct, ctm, ident])

def printm(comment, m):
    print(comment)
    fields = [['%g%+gj' % (f.real, f.imag) for f in row] for row in m]
    width = max(max(len(f) for f in row) for row in fields)
    lines = (', '.join('%*s' % (width, f) for f in row) for row in fields)
    print('\n'.join(lines))

if __name__ == '__main__':
    for matrix in [
            ((( 3.000+0.000j), (+2.000+1.000j)),
            (( 2.000-1.000j), (+1.000+0.000j))),

            ((( 1.000+0.000j), (+1.000+0.000j), (+0.000+0.000j)),
            (( 0.000+0.000j), (+1.000+0.000j), (+1.000+0.000j)),
            (( 1.000+0.000j), (+0.000+0.000j), (+1.000+0.000j))),

            ((( 2**0.5/2+0.000j), (+2**0.5/2+0.000j), (+0.000+0.000j)),
            (( 0.000+2**0.5/2j), (+0.000-2**0.5/2j), (+0.000+0.000j)),
            (( 0.000+0.000j), (+0.000+0.000j), (+0.000+1.000j)))]:
        printm('\nMatrix:', matrix)
        ct = conjugate_transpose(matrix)
        printm('Its conjugate transpose:', ct)
        print('Hermitian? %s.' % ishermitian(matrix, ct))
        print('Normal?    %s.' % isnormal(matrix, ct))
        print('Unitary?   %s.' % isunitary(matrix, ct))


#lang racket
(require math)
(define H matrix-hermitian)

(define (normal? M)
  (define MH (H M))
  (equal? (matrix* MH M)
          (matrix* M MH)))

(define (unitary? M)
  (define MH (H M))
  (and (matrix-identity? (matrix* MH M))
       (matrix-identity? (matrix* M MH))))

(define (hermitian? M)
  (equal? (H M) M))


for [ # Test Matrices
       [   1, 1+i, 2i],
       [ 1-i,   5, -3],
       [0-2i,  -3,  0]
    ],
    [
       [1, 1, 0],
       [0, 1, 1],
       [1, 0, 1]
    ],
    [
       [0.707 ,    0.707,  0],
       [0.707i, 0-0.707i,  0],
       [0     ,        0,  i]
    ]
    -> @m {
        say "\nMatrix:";
        @m.&say-it;
        my @t = @m».conj.&mat-trans;
        say "\nTranspose:";
        @t.&say-it;
        say "Is Hermitian?\t{is-Hermitian(@m, @t)}";
        say "Is Normal?\t{is-Normal(@m, @t)}";
        say "Is Unitary?\t{is-Unitary(@m, @t)}";
    }

sub is-Hermitian (@m, @t, --> Bool) {
    so @m».Complex eqv @t».Complex
 }

sub is-Normal (@m, @t, --> Bool) {
    so mat-mult(@m, @t)».Complex eqv mat-mult(@t, @m)».Complex
}

sub is-Unitary (@m, @t, --> Bool) {
    so mat-mult(@m, @t, 1e-3)».Complex eqv mat-ident(+@m)».Complex;
}

sub mat-trans (@m) { map { [ @m[*;$_] ] }, ^@m[0] }

sub mat-ident ($n) { [ map { [ flat 0 xx $_, 1, 0 xx $n - 1 - $_ ] }, ^$n ] }

sub mat-mult (@a, @b, \ε = 1e-15) {
    my @p;
    for ^@a X ^@b[0] -> ($r, $c) {
        @p[$r][$c] += @a[$r][$_] * @b[$_][$c] for ^@b;
        @p[$r][$c].=round(ε); # avoid floating point math errors
    }
    @p
}

sub say-it (@array) { $_».fmt("%9s").say for @array }


/*REXX program performs a  conjugate transpose  on a  complex  square matrix.           */
parse arg N elements;  if N==''|N==","  then N=3 /*Not specified?  Then use the default.*/
k= 0;             do   r=1  for N
                    do c=1  for N;    k= k+1;      M.r.c= word( word(elements, k)  1,  1)
                    end   /*c*/
                  end     /*r*/
call showCmat 'M'        ,N                      /*display a nicely formatted matrix.   */
identity.= 0;                     do d=1  for N;   identity.d.d= 1;    end  /*d*/
call conjCmat 'MH', "M"  ,N                      /*conjugate the  M  matrix  ───►  MH   */
call showCmat 'MH'       ,N                      /*display a nicely formatted matrix.   */
say 'M is Hermitian:  '    word('no yes', isHermitian('M', "MH", N) + 1)
call multCmat 'M',  'MH', 'MMH',  N              /*multiple the two matrices together.  */
call multCmat 'MH', 'M',  'MHM',  N              /*    "     "   "      "        "      */
say '  M is Normal:   '           word('no yes', isHermitian('MMH', "MHM", N) + 1)
say '  M is Unary:    '           word('no yes',     isUnary('M',   N) + 1)
say 'MMH is Unary:    '           word('no yes',     isUnary('MMH', N) + 1)
say 'MHM is Unary:    '           word('no yes',     isUnary('MHM', N) + 1)
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
cP:       procedure; arg ',' c;        return word( strip( translate(c, , 'IJ') )  0, 1)
rP:       procedure; parse arg r ',';  return word( r 0, 1)  /*◄──maybe return a 0 ↑    */
/*──────────────────────────────────────────────────────────────────────────────────────*/
conjCmat: parse arg matX,matY,rows 1 cols;                call normCmat matY, rows
             do   r=1  for rows;   _=
               do c=1  for cols;   v= value(matY'.'r"."c)
               rP= rP(v);     cP= -cP(v);                 call value matX'.'c"."r, rP','cP
               end   /*c*/
             end     /*r*/;                return
/*──────────────────────────────────────────────────────────────────────────────────────*/
isHermitian: parse arg matX,matY,rows 1 cols;                 call normCmat matX, rows
                                                              call normCmat matY, rows
             do   r=1  for rows;  _=
               do c=1  for cols
               if value(matX'.'r"."c) \= value(matY'.'r"."c)  then return 0
               end   /*c*/
             end     /*r*/;                return 1
/*──────────────────────────────────────────────────────────────────────────────────────*/
isUnary: parse arg matX,rows 1 cols
             do   r=1  for rows;    _=
               do c=1  for cols;    z= value(matX'.'r"."c);   rP= rP(z);       cP= cP(z)
               if abs( sqrt( rP(z) **2  +  cP(z)**2)  -  (r==c)) >= .0001  then return 0
               end   /*c*/
             end     /*r*/;                return 1
/*──────────────────────────────────────────────────────────────────────────────────────*/
multCmat: parse arg matA,matB,matT,rows 1 cols;               call value matT'.', 0
             do     r=1  for rows;  _=
               do   c=1  for cols
                 do k=1  for cols;  T= value(matT'.'r"."c);   Tr= rP(T);   Tc= cP(T)
                                    A= value(matA'.'r"."k);   Ar= rP(A);   Ac= cP(A)
                                    B= value(matB'.'k"."c);   Br= rP(B);   Bc= cP(B)
                 Pr= Ar*Br - Ac*Bc;    Pc= Ac*Br  +  Ar*Bc;   Tr= Tr+Pr;   Tc= Tc+Pc
                 call value  matT'.'r"."c,Tr','Tc
                 end   /*k*/
               end     /*c*/
             end       /*r*/;              return
/*──────────────────────────────────────────────────────────────────────────────────────*/
normCmat: parse arg matN,rows 1 cols
             do   r=1  to rows;  _=
               do c=1  to cols;  v= translate( value(matN'.'r"."c), , "IiJj")
               parse upper  var  v  real  ','  cplx
               if real\==''  then real= real / 1
               if cplx\==''  then cplx= cplx / 1;             if cplx=0  then cplx=
               if cplx\==''  then cplx= cplx"j"
               call value matN'.'r"."c,  strip(real','cplx,  "T",  ',')
               end   /*c*/
             end     /*r*/;                return
/*──────────────────────────────────────────────────────────────────────────────────────*/
showCmat: parse arg matX,rows,cols;    if cols==''  then cols= rows;       @@= left('', 6)
          say;  say center('matrix' matX, 79, '─');      call normCmat matX, rows, cols
             do   r=1  to rows;  _=
               do c=1  to cols;  _= _ @@ left( value(matX'.'r"."c),  9)
               end   /*c*/
             say _
             end     /*r*/;      say;      return
/*──────────────────────────────────────────────────────────────────────────────────────*/
sqrt: procedure; parse arg x;  if x=0  then return 0;   d=digits();  numeric form;   h=d+6
      numeric digits; parse value format(x,2,1,,0) 'E0'  with  g 'E' _ .;  g=g *.5'e'_ % 2
      m.=9;  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*/; return g


require 'matrix'

# Start with some matrix.
i = Complex::I
matrix = Matrix[[i, 0, 0],
                [0, i, 0],
                [0, 0, i]]

# Find the conjugate transpose.
#   Matrix#conjugate appeared in Ruby 1.9.2.
conjt = matrix.conj.t           # aliases for matrix.conjugate.tranpose
print 'conjugate tranpose: '; puts conjt

if matrix.square?
  # These predicates appeared in Ruby 1.9.3.
  print 'Hermitian? '; puts matrix.hermitian?
  print '   normal? '; puts matrix.normal?
  print '  unitary? '; puts matrix.unitary?
else
  # Matrix is not square. These predicates would
  # raise ExceptionForMatrix::ErrDimensionMismatch.
  print 'Hermitian? false'
  print '   normal? false'
  print '  unitary? false'
end


extern crate num; // crate for complex numbers

use num::complex::Complex;
use std::ops::Mul;
use std::fmt;

#[derive(Debug, PartialEq)]
struct Matrix<f32> {
    grid: [[Complex<f32>; 2]; 2], // used to represent matrix
}

impl Matrix<f32> { // implements a method call for calculating the conjugate transpose
    fn conjugate_transpose(&self) -> Matrix<f32> {
        Matrix {grid: [[self.grid[0][0].conj(), self.grid[1][0].conj()],
        [self.grid[0][1].conj(), self.grid[1][1].conj()]]}
    }
}

impl Mul for Matrix<f32> { // implements '*' (multiplication) for the matrix
    type Output = Matrix<f32>;

    fn mul(self, other: Matrix<f32>) -> Matrix<f32> {
        Matrix {grid: [[self.grid[0][0]*other.grid[0][0] + self.grid[0][1]*other.grid[1][0],
            self.grid[0][0]*other.grid[0][1] + self.grid[0][1]*other.grid[1][1]],
            [self.grid[1][0]*other.grid[0][0] + self.grid[1][1]*other.grid[1][0],
            self.grid[1][0]*other.grid[1][0] + self.grid[1][1]*other.grid[1][1]]]}
    }
}

impl Copy for Matrix<f32> {} // implemented to prevent 'moved value' errors in if statements below
impl Clone for Matrix<f32> {
    fn clone(&self) -> Matrix<f32> {
        *self
    }
}

impl fmt::Display for Matrix<f32> { // implemented to make output nicer
    fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result {
        write!(f, "({}, {})\n({}, {})", self.grid[0][0], self.grid[0][1], self.grid[1][0], self.grid[1][1])
    }
}

fn main() {
    let a = Matrix {grid: [[Complex::new(3.0, 0.0), Complex::new(2.0, 1.0)],
        [Complex::new(2.0, -1.0), Complex::new(1.0, 0.0)]]};

    let b = Matrix {grid: [[Complex::new(0.5, 0.5), Complex::new(0.5, -0.5)],
        [Complex::new(0.5, -0.5), Complex::new(0.5, 0.5)]]};

    test_type(a);
    test_type(b);
}

fn test_type(mat: Matrix<f32>) {
    let identity = Matrix {grid: [[Complex::new(1.0, 0.0), Complex::new(0.0, 0.0)],
        [Complex::new(0.0, 0.0), Complex::new(1.0, 0.0)]]};
    let mat_conj = mat.conjugate_transpose();

    println!("Matrix: \n{}\nConjugate transpose: \n{}", mat, mat_conj);

    if mat == mat_conj {
        println!("Hermitian?: TRUE");
    } else {
        println!("Hermitian?: FALSE");
    }

    if mat*mat_conj == mat_conj*mat {
        println!("Normal?: TRUE");
    } else {
        println!("Normal?: FALSE");
    }

    if mat*mat_conj == identity {
        println!("Unitary?: TRUE");
    } else {
        println!("Unitary?: FALSE");
    }
}


object ConjugateTranspose {

  case class Complex(re: Double, im: Double) {
    def conjugate(): Complex = Complex(re, -im)
    def +(other: Complex) = Complex(re + other.re, im + other.im)
    def *(other: Complex) = Complex(re * other.re - im * other.im, re * other.im + im * other.re)
    override def toString(): String = {
      if (im < 0) {
        s"${re}${im}i"
      } else {
        s"${re}+${im}i"
      }
    }
  }

  case class Matrix(val entries: Vector[Vector[Complex]]) {

    def *(other: Matrix): Matrix = {
      new Matrix(
        Vector.tabulate(entries.size, other.entries(0).size)((r, c) => {
          val rightRow = entries(r)
          val leftCol = other.entries.map(_(c))
          rightRow.zip(leftCol)
            .map{ case (x, y) => x * y } // multiply pair-wise
            .foldLeft(new Complex(0,0)){ case (x, y) => x + y } // sum over all
        })
      )
    }

    def conjugateTranspose(): Matrix = {
      new Matrix(
        Vector.tabulate(entries(0).size, entries.size)((r, c) => entries(c)(r).conjugate)
      )
    }

    def isHermitian(): Boolean = {
      this == conjugateTranspose()
    }

    def isNormal(): Boolean = {
      val ct = conjugateTranspose()
      this * ct == ct * this
    }

    def isIdentity(): Boolean = {
      val entriesWithIndexes = for (r <- 0 until entries.size; c <- 0 until entries(r).size) yield (r, c, entries(r)(c))
      entriesWithIndexes.forall { case (r, c, x) =>
        if (r == c) {
          x == Complex(1.0, 0.0)
        } else {
          x == Complex(0.0, 0.0)
        }
      }
    }

    def isUnitary(): Boolean = {
      (this * conjugateTranspose()).isIdentity()
    }

    override def toString(): String = {
      entries.map("  " + _.mkString("[", ",", "]")).mkString("[\n", "\n", "\n]")
    }

  }

  def main(args: Array[String]): Unit = {
    val m = new Matrix(
      Vector.fill(3, 3)(new Complex(Math.random() * 2 - 1.0, Math.random() * 2 - 1.0))
    )
    println("Matrix: " + m)
    println("Conjugate Transpose: " + m.conjugateTranspose())
    println("Hermitian: " + m.isHermitian())
    println("Normal: " + m.isNormal())
    println("Unitary: " + m.isUnitary())
  }

}


func is_Hermitian (Array m, Array t) -> Bool { m == t }

func mat_mult (Array a, Array b, Number ε = -3) {
    var p = []
    for r, c in (^a ~X ^b[0]) {
        for k in (^b) {
            p[r][c] := 0 += (a[r][k] * b[k][c]) -> round!(ε)
        }
    }
    return p
}

func mat_trans (Array m) {
    var r = []
    for i,j in (^m ~X ^m[0]) {
        r[j][i] = m[i][j]
    }
    return r
}

func mat_ident (Number n) {
    ^n -> map {|i|
        [i.of(0)..., 1, (n - i - 1).of(0)...]
    }
}

func is_Normal (Array m, Array t) -> Bool {
    mat_mult(m, t) == mat_mult(t, m)
}

func is_Unitary (Array m, Array t) -> Bool {
    mat_mult(m, t) == mat_ident(m.len)
}

func say_it (Array a) {
    a.each {|b|
        b.map { "%9s" % _ }.join(' ').say
    }
}

[
    [
       [   1, 1+1i, 2i],
       [1-1i,    5, -3],
       [0-2i,   -3,  0]
    ],
    [
       [1, 1, 0],
       [0, 1, 1],
       [1, 0, 1]
    ],
    [
       [0.707 ,   0.707,  0],
       [0.707i, -0.707i,  0],
       [0     ,       0,  1i]
    ]
].each { |m|
    say "\nMatrix:"
    say_it(m)
    var t = mat_trans(m.map{.map{.conj}})
    say "\nTranspose:"
    say_it(t)
    say "Is Hermitian?\t#{is_Hermitian(m, t)}"
    say "Is Normal?\t#{is_Normal(m, t)}"
    say "Is Unitary?\t#{is_Unitary(m, t)}"
}


# Computes conjugate transpose of M
let conjTransp = function conjTransp(M) {
	return map(range(sizeof M[0]), function(row) {
		return map(range(sizeof M), function(col) {
			return cplx_conj(M[col][row]);
		});
	});
};

# Helper for cplxMatMul
let cplxVecScalarMul = function cplxVecScalarMul(A, B, row, col) {
	var M = { "re": 0.0, "im": 0.0 };
	let N = sizeof A;
	for (var i = 0; i < N; i++) {
		let P = cplx_mul(A[row][i], B[i][col]);
		M = cplx_add(M, P);
	}
	return M;
};

# Multiplies matrices A and B
# A and B are assumed to be square and of the same size,
# this condition is not checked.
let cplxMatMul = function cplxMatMul(A, B) {
	var R = {};
	let N = sizeof A;
	for (var row = 0; row < N; row++) {
		R[row] = {};
		for (var col = 0; col < N; col++) {
			R[row][col] = cplxVecScalarMul(A, B, row, col);
		}
	}
	return R;
};

# Helper for creating an array representing a complex number
# given its textual representation
let _ = function makeComplex(str) {
	let sep = indexof(str, "+", 1);
	if sep < 0 {
		sep = indexof(str, "-", 1);
	}
	let reStr = substrto(str, sep);
	let imStr = substrfrom(str, sep);
	return { "re": tofloat(reStr), "im": tofloat(imStr) };
};

# Formats a complex matrix
let printCplxMat = function printCplxMat(M) {
	foreach(M, function(i, row) {
		foreach(row, function(j, elem) {
			printf("    %.2f%+.2fi", elem.re, elem.im);
		});
		print();
	});
};

# A Hermitian matrix
let H = {
	{ _("3+0i"), _("2+1i") },
	{ _("2-1i"), _("0+0i") }
};

# A normal matrix
let N = {
	{ _("1+0i"), _("1+0i"), _("0+0i") },
	{ _("0+0i"), _("1+0i"), _("1+0i") },
	{ _("1+0i"), _("0+0i"), _("1+0i") }
};

# A unitary matrix
let U = {
	{ _("0.70710678118+0i"), _("0.70710678118+0i"), _("0+0i") },
	{ _("0-0.70710678118i"), _("0+0.70710678118i"), _("0+0i") },
	{ _("0+0i"),             _("0+0i"),             _("0+1i") }
};

print("Hermitian matrix:\nH = ");
printCplxMat(H);
print("H* = ");
printCplxMat(conjTransp(H));
print();

print("Normal matrix:\nN = ");
printCplxMat(N);
print("N* = ");
printCplxMat(conjTransp(N));
print("N* x N = ");
printCplxMat(cplxMatMul(conjTransp(N), N));
print("N x N* = ");
printCplxMat(cplxMatMul(N, conjTransp(N)));
print();

print("Unitary matrix:\nU = ");
printCplxMat(U);
print("U* = ");
printCplxMat(conjTransp(U));
print("U x U* = ");
printCplxMat(cplxMatMul(U, conjTransp(U)));
print();


package require struct::matrix
package require math::complexnumbers

proc complexMatrix.equal {m1 m2 {epsilon 1e-14}} {
    if {[$m1 rows] != [$m2 rows] || [$m1 columns] != [$m2 columns]} {
	return 0
    }
    # Compute the magnitude of the difference between two complex numbers
    set ceq [list apply {{epsilon a b} {
	expr {[mod [- $a $b]] < $epsilon}
    } ::math::complexnumbers} $epsilon]
    for {set i 0} {$i<[$m1 columns]} {incr i} {
	for {set j 0} {$j<[$m1 rows]} {incr j} {
	    if {![{*}$ceq [$m1 get cell $i $j] [$m2 get cell $i $j]]} {
		return 0
	    }
	}
    }
    return 1
}

proc complexMatrix.multiply {a b} {
    if {[$a columns] != [$b rows]} {
        error "incompatible sizes"
    }
    # Simplest to use a lambda in the complex NS
    set cpm {{sum a b} {
	+ $sum [* $a $b]
    } ::math::complexnumbers}
    set c0 [math::complexnumbers::complex 0.0 0.0];   # Complex zero
    set c [struct::matrix]
    $c add columns [$b columns]
    $c add rows [$a rows]
    for {set i 0} {$i < [$a rows]} {incr i} {
        for {set j 0} {$j < [$b columns]} {incr j} {
            set sum $c0
	    foreach rv [$a get row $i] cv [$b get column $j] {
		set sum [apply $cpm $sum $rv $cv]
            }
	    $c set cell $j $i $sum
        }
    }
    return $c
}

proc complexMatrix.conjugateTranspose {matrix} {
    set mat [struct::matrix]
    $mat = $matrix
    $mat transpose
    for {set c 0} {$c < [$mat columns]} {incr c} {
	for {set r 0} {$r < [$mat rows]} {incr r} {
	    set val [$mat get cell $c $r]
	    $mat set cell $c $r [math::complexnumbers::conj $val]
	}
    }
    return $mat
}


import "/complex" for Complex, CMatrix
import "/fmt" for Fmt

var cm1 = CMatrix.new(
    [
        [Complex.new(3), Complex.new(2, 1)],
        [Complex.new(2, -1), Complex.one  ]
    ]
)
var cm2 = CMatrix.fromReals([ [1, 1, 0], [0, 1, 1], [1, 0, 1] ])
var x = 2.sqrt/2
var cm3 = CMatrix.new(
    [
        [Complex.new(x), Complex.new(x), Complex.zero],
        [Complex.new(0, -x), Complex.new(0, x), Complex.zero],
        [Complex.zero, Complex.zero, Complex.imagOne]
    ]
)

for (cm in [cm1, cm2, cm3]) {
    System.print("Matrix:")
    Fmt.mprint(cm, 5, 3)
    System.print("\nConjugate transpose:")
    Fmt.mprint(cm.conjTranspose, 5, 3)
    System.print("\nHermitian : %(cm.isHermitian)")
    System.print("Normal    : %(cm.isNormal)")
    System.print("Unitary   : %(cm.isUnitary)")
    System.print()
}

System.print("For the final example if we use a tolerance of 1e-14:")
var cm4 = cm3 * cm3.conjTranspose
var id = CMatrix.identity(3)
System.print("Unitary   : %(cm4.almostEquals(id))")


T Point
   Int x, y

   F (x, y)
      .x = x
      .y = y


(defstructure point
   (x (:assert (rationalp x)))
   (y (:assert (rationalp y))))

(assign p1 (make-point :x 1 :y 2))
(point-x (@ p1)) ; Access the x value of the point
(assign p1 (update-point (@ p1) :x 3)) ; Update the x value
(point-x (@ p1))
(point-p (@ p1)) ; Recognizer for points


MAX_POINT_OBJECTS = 64               ; define a constant

    .rsset $0400                     ; reserve memory storage starting at address $0400
point_x .rs MAX_POINT_OBJECTS        ; reserve 64 bytes for x-coordinates
point_y .rs MAX_POINT_OBJECTS        ; reserve 64 bytes for y-coordinates


INCLUDE "D2:REAL.ACT" ;from the Action! Tool Kit

DEFINE REALPTR="CARD"
TYPE PointI=[INT x,y]
TYPE PointR=[REALPTR rx,ry]

PROC Main()
  PointI p1
  PointR p2
  REAL realx,realy

  Put(125) PutE() ;clear screen

  p1.x=123
  p1.y=4567

  ValR("12.34",realx)
  ValR("5.6789",realy)
  p2.rx=realx
  p2.ry=realy

  PrintF("Integer point p1=(%I,%I)%E",p1.x,p1.y)

  Print("Real point p2=(")
  PrintR(p2.rx) Print(",")
  PrintR(p2.ry) Print(")")
RETURN


package
{
    public class Point
    {
        public var x:Number;
        public var y:Number;

        public function Point(x:Number, y:Number)
        {
            this.x = x;
            this.y = y;
        }
    }
}


type Point is tagged record
   X : Integer := 0;
   Y : Integer := 0;
end record;


MODE UNIONX = UNION(
   STRUCT(REAL r, INT i),
   INT,
   REAL,
   STRUCT(INT ii),
   STRUCT(REAL rr),
   STRUCT([]REAL r)
);


begin
    % create the compound data type %
    record Point( real x, y );
    % declare a Point variable %
    reference(Point) p;
    % assign a value to p %
    p := Point( 1, 0.5 );
    % access the fields of p - note Algol W uses x(p) where many languages would use p.x %
    write( x(p), y(p) )
end.


OBJECT point
  x, y
ENDOBJECT

PROC main()
  DEF pt:PTR TO point,

  NEW pt
  -> Floats are also stored as integer types making
  -> the float conversion operator necessary.
  pt.x := !10.4
  pt.y := !3.14
  END pt
ENDPROC


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

/************************************/
/* Constantes                       */
/************************************/
.equ STDOUT, 1     @ Linux output console
.equ EXIT,   1     @ Linux syscall
.equ WRITE,  4     @ Linux syscall

/*******************************************/
/* Structures                             */
/********************************************/
    .struct  0
point_x:                                        @ x coordinate
    .struct  point_x + 4
point_y:                                        @ y coordinate
    .struct  point_y + 4
point_end:                                      @ end structure point
/*********************************/
/* Initialized data              */
/*********************************/
.data
sMessResult:        .ascii "value x : "
sMessValeur:        .fill 11, 1, ' '            @ size => 11
szCarriageReturn:   .asciz "\n"

/*********************************/
/* UnInitialized data            */
/*********************************/
.bss
stPoint:           .skip point_end               @ reservation place in memory
/*********************************/
/*  code section                 */
/*********************************/
.text
.global main
main:                                             @ entry of program
    ldr r1,iAdrstPoint
    mov r0,#5                                     @ x value
    str r0,[r1,#point_x]
    mov r0,#10                                    @ y value
    str r0,[r1,#point_y]
                                                  @ display value
    ldr r2,iAdrstPoint
    ldr r0,[r2,#point_x]
    ldr r1,iAdrsMessValeur
    bl conversion10                               @ call conversion decimal
    ldr r0,iAdrsMessResult
    bl affichageMess                              @ display message

100:                                              @ standard end of the program
    mov r0, #0                                    @ return code
    mov r7, #EXIT                                 @ request to exit program
    svc #0                                        @ perform the system call

iAdrsMessValeur:          .int sMessValeur
iAdrszCarriageReturn:     .int szCarriageReturn
iAdrsMessResult:          .int sMessResult
iAdrstPoint:              .int stPoint

/******************************************************************/
/*     display text with size calculation                         */
/******************************************************************/
/* r0 contains the address of the message */
affichageMess:
    push {r0,r1,r2,r7,lr}                          @ save  registres
    mov r2,#0                                      @ counter length
1:                                                 @ loop length calculation
    ldrb r1,[r0,r2]                                @ read octet start position + index
    cmp r1,#0                                      @ if 0 its over
    addne r2,r2,#1                                 @ else add 1 in the length
    bne 1b                                         @ and loop
                                                   @ so here r2 contains the length of the message
    mov r1,r0                                      @ address message in r1
    mov r0,#STDOUT                                 @ code to write to the standard output Linux
    mov r7, #WRITE                                 @ code call system "write"
    svc #0                                         @ call systeme
    pop {r0,r1,r2,r7,lr}                           @ restaur des  2 registres */
    bx lr                                          @ return
/******************************************************************/
/*     Converting a register to a decimal unsigned                */
/******************************************************************/
/* r0 contains value and r1 address area   */
/* r0 return size of result (no zero final in area) */
/* area size => 11 bytes          */
.equ LGZONECAL,   10
conversion10:
    push {r1-r4,lr}                                 @ save registers
    mov r3,r1
    mov r2,#LGZONECAL

1:                                                  @ start loop
    bl divisionpar10U                               @ unsigned  r0 <- dividende. quotient ->r0 reste -> r1
    add r1,#48                                      @ digit
    strb r1,[r3,r2]                                 @ store digit on area
    cmp r0,#0                                       @ stop if quotient = 0
    subne r2,#1                                     @ else previous position
    bne 1b                                          @ and loop
                                                    @ and move digit from left of area
    mov r4,#0
2:
    ldrb r1,[r3,r2]
    strb r1,[r3,r4]
    add r2,#1
    add r4,#1
    cmp r2,#LGZONECAL
    ble 2b
                                                      @ and move spaces in end on area
    mov r0,r4                                         @ result length
    mov r1,#' '                                       @ space
3:
    strb r1,[r3,r4]                                   @ store space in area
    add r4,#1                                         @ next position
    cmp r4,#LGZONECAL
    ble 3b                                            @ loop if r4 <= area size

100:
    pop {r1-r4,lr}                                    @ restaur registres
    bx lr                                             @return

/***************************************************/
/*   division par 10   unsigned                    */
/***************************************************/
/* r0 dividende   */
/* r0 quotient    */
/* r1 remainder   */
divisionpar10U:
    push {r2,r3,r4, lr}
    mov r4,r0                                          @ save value
    ldr r3,iMagicNumber                                @ r3 <- magic_number    raspberry 1 2
    umull r1, r2, r3, r0                               @ r1<- Lower32Bits(r1*r0) r2<- Upper32Bits(r1*r0)
    mov r0, r2, LSR #3                                 @ r2 <- r2 >> shift 3
    add r2,r0,r0, lsl #2                               @ r2 <- r0 * 5
    sub r1,r4,r2, lsl #1                               @ r1 <- r4 - (r2 * 2)  = r4 - (r0 * 10)
    pop {r2,r3,r4,lr}
    bx lr                                              @ leave function
iMagicNumber:  	.int 0xCCCCCCCD


typedef point (t : [email protected]+) = @(t, t)
val p : point double = (1.0, 3.0)


point := Object()
point.x := 1
point.y := 0


TYPE Point
   x AS INTEGER
   y AS INTEGER
 END TYPE


( ( Point
  =   (x=)
      (y=)
      (new=.!arg:(?(its.x).?(its.y)))
  )
& new$(Point,(3.4)):?pt
& out$(!(pt..x) !(pt..y))
  { Show independcy by changing x, but not y }
& 7:?(pt..x)
& out$(!(pt..x) !(pt..y))
);


typedef struct Point
{
  int x;
  int y;
} Point;


struct Point
{
  public int x, y;
  public Point(int x, int y) {
    this.x = x;
    this.y = y;
  }
}


% Definitions
point = struct[x, y: int]
mutable_point = record[x, y: int]

% Initialization
p: point := point${x: 10, y: 20}
mp: mutable_point := mutable_point${x: 10, y: 20}


# Lightweight JS objects (with CS sugar).
point =
  x: 5
  y: 3

console.log point.x, point.y # 5 3

# Heavier OO style
class Point
  constructor: (@x, @y) ->
  distance_from: (p2) ->
    dx = p2.x - @x
    dy = p2.y - @y
    Math.sqrt dx*dx + dy*dy

p1 = new Point(1, 6)
p2 = new Point(6, 18)
console.log p1 # { x: 1, y: 6 }
console.log p1.distance_from # [Function]
console.log p1.distance_from p2 # 13


CL-USER> (defstruct point (x 0) (y 0))  ;If not provided, x or y default to 0
POINT


struct Point(T)
  getter x : T
  getter y : T
  def initialize(@x, @y)
  end
end

puts Point(Int32).new 13, 12  #=> Point(Int32)(@x=13, @y=12)


void main() {
    // A normal POD struct
    // (if it's nested and it's not static then it has a hidden
    // field that points to the enclosing function):
    static struct Point {
        int x, y;
    }

    auto p1 = Point(10, 20);

    // It can also be parametrized on the coordinate type:
    static struct Pair(T) {
        T x, y;
    }

    // A pair with integer coordinates:
    auto p2 = Pair!int(3, 5);

    // A pair with floating point coordinates:
    auto p3 = Pair!double(3, 5);

    // Classes (static inner):
    static class PointClass {
        int x, y;
        this(int x_, int y_) {
            this.x = x_;
            this.y = y_;
        }
    }

    auto p4 = new PointClass(1, 2);

    // There are also library-defined tuples:
    import std.typecons;

    alias Tuple!(int,"x", int,"y") PointXY;

    auto p5 = PointXY(3, 5);

    // And even built-in "type tuples":
    import std.typetuple;

    alias TypeTuple!(int, 5) p6;

    static assert(is(p6[0] == int));
    static assert(p6[1] == 5);
}


  TPoint = record
    X: Longint;
    Y: Longint;
  end;


def makePoint(x, y) {
    def point {
        to getX() { return x }
        to getY() { return y }
    }
    return point
}


(lib 'struct)
    (struct Point (x y))
    (Point 3 4)
  → #<Point> (3 4)

;; run-time type checking is possible
(lib 'types)
    (struct Point (x y))
    (struct-type Point Number Number)
    (Point 3 4)
    (Point 3 'albert)
❌ error: #number? : type-check failure : albert → 'Point:y'


struct Point
{
    prop int X;

    prop int Y;

    constructor new(int x, int y)
    {
        X := x;
        Y := y
    }
}


iex(1)> defmodule Point do
...(1)>   defstruct x: 0, y: 0
...(1)> end
{:module, Point, <<70, 79, 82, ...>>, %Point{x: 0, y: 0}}
iex(2)> origin = %Point{}
%Point{x: 0, y: 0}
iex(3)> pa = %Point{x: 10, y: 20}
%Point{x: 10, y: 20}
iex(4)> pa.x
10
iex(5)> %Point{pa | y: 30}
%Point{x: 10, y: 30}
iex(6)> %Point{x: px, y: py} = pa        # pattern matching
%Point{x: 10, y: 20}
iex(7)> px
10
iex(8)> py
20


--Compound Data type can hold multiple independent values
--In Elm data can be compounded using List, Tuple, Record
--In a List
point = [2,5]
--This creates a list having x and y which are independent and can be accessed by List functions
--Note that x and y must be of same data type

--Tuple is another useful data type that stores different independent values
point = (3,4)
--Here we can have multiple data types
point1 = ("x","y")
point2 = (3,4.5)
--The order of addressing matters
--Using a Record is the best option
point = {x=3,y=4}
--To access
point.x
point.y
--Or Use it as a function
.x point
.y point
--Also to alter the value
{point | x=7}
{point | y=2}
{point | x=3,y=4}
--Each time a new record is generated
--END


-module(records_test).
-compile(export_all).

-record(point,{x,y}).

test() ->
    P1 = #point{x=1.0,y=2.0}, % creates a new point record
    io:fwrite("X: ~f, Y: ~f~n",[P1#point.x,P1#point.y]),
    P2 = P1#point{x=3.0}, % creates a new point record with x set to 3.0, y is copied from P1
    io:fwrite("X: ~f, Y: ~f~n",[P2#point.x,P2#point.y]).


enum x, y

sequence point = {0,0}

printf(1,"x = %d, y = %3.3f\n",point)

point[x] = 'A'
point[y] = 53.42

printf(1,"x = %d, y = %3.3f\n",point)
printf(1,"x = %s, y = %3.3f\n",point)


type Point = { x : int; y : int }

let points = [
    {x = 1; y = 1};
    {x = 5; y = 5} ]

Seq.iter (fun p -> printfn "%d,%d" p.x p.y) points


// define a class to contain the two fields
// accessors to get/set the field values are automatically generated
class Point
{
  Int x
  Int y
}

class Main
{
  public static Void main ()
  {
    // empty constructor, so x,y set to 0
    point1 := Point()
    // constructor uses with-block, to initialise values
    point2 := Point { x = 1; y = 2}
    echo ("Point 1 = (" + point1.x + ", " + point1.y + ")")
    echo ("Point 2 = (" + point2.x + ", " + point2.y + ")")
  }
}


: pt>x ( point -- x ) ;
: pt>y ( point -- y ) CELL+ ;
: .pt ( point -- ) dup pt>x @ . pt>y @ . ;    \ or for this simple structure, [email protected] . .

create point 6 , 0 ,
7 point pt>y !
.pt    \ 6 7


program typedemo
    type rational                                           ! Type declaration
        integer :: numerator
        integer :: denominator
    end type rational

    type( rational ), parameter :: zero = rational( 0, 1 )  ! Variables initialized
    type( rational ), parameter :: one  = rational( 1, 1 )  ! by constructor syntax
    type( rational ), parameter :: half = rational( 1, 2 )
    integer :: n, halfd, halfn
    type( rational ) :: &
        one_over_n(20) = (/ (rational( 1, n ), n = 1, 20) /) ! Array initialized with
                                                             ! constructor inside
                                                             ! implied-do array initializer
    integer :: oon_denoms(20)

    halfd = half%denominator                       ! field access with "%" delimiter
    halfn = half%numerator

    oon_denoms = one_over_n%denominator            ! Access denominator field in every
                                                   ! rational array element & store
end program typedemo                               ! as integer array


' FB 1.05.0 Win64

Type Point
  As Integer x, y
End Type

Dim p As Point = (1, 2)
Dim p2 As Point = (3, 4)
Print p.x, p.y
Print p2.x, p2.y
Sleep


class Point {
    int x
    int y

    // Default values make this a 0-, 1-, and 2-argument constructor
    Point(int x = 0, int y = 0) { this.x = x; this.y = y }
    String toString() { "{x:${x}, y:${y}}" }
}


 data Tree = Empty
           | Leaf Int
           | Node Tree Tree
 deriving (Eq, Show)

 t1 = Node (Leaf 1) (Node (Leaf 2) (Leaf 3))


point = {x: 6 , y: 0 }
point.y = 7
print, point
;=> {       6       7}


   NB.  Create a "Point" class
   coclass'Point'

   NB. Define its constructor
   create =: 3 : 0
     'X Y' =: y
   )

   NB.  Instantiate an instance (i.e. an object)
   cocurrent 'base'
   P =: 10 20 conew 'Point'

   NB.  Interrogate its members
   X__P
10
   Y__P
20


public class Point
{
  public int x, y;
  public Point() { this(0); }
  public Point(int x0) { this(x0,0); }
  public Point(int x0, int y0) { x = x0; y = y0; }

  public static void main(String args[])
  {
    Point point = new Point(1,2);
    System.out.println("x = " + point.x );
    System.out.println("y = " + point.y );
  }
}


//using object literal syntax
var point = {x : 1, y : 2};

//using constructor
var Point = function (x, y) {
  this.x = x;
  this.y = y;
};
point = new Point(1, 2);

//using ES6 class syntax
class Point {
  constructor(x, y) {
    this.x = x;
    this.y = y;
  }
}
point = new Point(1, 2);


struct Point{T<:Real}
    x::T
    y::T
end


Var:Create(
  Point,
    Number x,
    Number y
)


data class Point(var x: Int, var y: Int)

fun main(args: Array<String>) {
    val p = Point(1, 2)
    println(p)
    p.x = 3
    p.y = 4
    println(p)
}


1) a pair
{def P {P.new 1 2}}
-> P
{P.left {P}}
-> 1
{P.right {P}}
-> 2

2) its Lispsish variant
{def Q {cons 1 2}}
-> Q
{car {Q}}
-> 1
{cdr {Q}}
-> 2

3) as an array
{def R {A.new 1 2}}
-> R
{A.first {R}}
-> 1
{A.last {R}}
-> 2


define Point => type {
    parent pair

    public onCreate(x,y) => {
        ..onCreate(#x=#y)
    }

    public x => .first
    public y => .second
}

local(point) = Point(33, 42)
#point->x
#point->y


-- parent script "MyPoint"
property x
property y
on new (me, px, py)
  me.x = px
  me.y = py
  return me
end


setpos [100 100] setpos [100 0] setpos [0 0]
show pos  ; [0 0]


Point:= Record(x = 2,y = 4):

Point:-x;
Point:-y;


defstruct(point(x, y))$

p: new(point)$

q: point(1, 2)$

[email protected]: 5$


struct myPoint (x, y)
newPoint = myPoint x:3 y:4


TYPE Point = RECORD
  x, y     : INTEGER
END;


TYPE Point = RECORD
  x, y: INTEGER;
END;


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

class RCompoundDataType
  method main(args = String[]) public static
    pp = Point(2, 4)
    say pp
    return

class RCompoundDataType.Point -- inner class "Point"
  properties indirect -- have NetRexx create getters & setters
    x = Integer
    y = Integer

  method Point(x_ = 0, y_ = 0) public -- providing default values for x_ & y_ lets NetRexx generate intermediate constructors Point() & Point(x_)
    this.x = Integer(x_)
    this.y = Integer(y_)
    return

  method toString() public returns String
    res = 'X='getX()',Y='getY()
    return res


type Point = tuple[x, y: int]

var p: Point = (12, 13)
var p2: Point = (x: 100, y: 200)


MODULE Point;
TYPE
	Object* = POINTER TO ObjectDesc;
	ObjectDesc* = RECORD
		x-,y-: INTEGER;
	END;

	PROCEDURE (p: Object) Init(x,y: INTEGER);
	BEGIN
		p.x := x; p.y := y
	END Init;

	PROCEDURE New*(x,y: INTEGER): Object;
	VAR
		p: Object;
	BEGIN
		NEW(p);p.Init(x,y);RETURN p;
	END New;

END Point.


class Point {
  @x : Int;
  @y : Int;

  New() {
    @x := 0;
    @y := 0;
  }

  New(x : Int, y : Int) {
    @x := x;
    @y := y;
  }

  New(p : Point) {
    @x := p->GetX();
    @y := p->GetY();
  }

  method : public : GetX() ~ Int {
    return @x;
  }

  method : public : GetY() ~ Int {
    return @y;
  }

  method : public : SetX(x : Int) ~ Nil {
    @x := x;
  }

  method : public : SetY(y : Int) ~ Nil {
    @y := y;
  }
}


type tree = Empty
          | Leaf of int
          | Node of tree * tree

let t1 = Node (Leaf 1, Node (Leaf 2, Leaf 3))


p = .point~new(3,4)
say "x =" p~x
say "y =" p~y

::class point
::method init
  expose x y
  use strict arg x = 0, y = 0   -- defaults to 0 for any non-specified coordinates

::attribute x
::attribute y


DEF TEMP-TABLE point
  FIELD X AS INT
  FIELD Y AS INT
  .


'SHORT FORM
type point float x,y

'FULL FORM
type point
  float x
  float y
end type

point p

'WITH DEFAULT VALUES
type point
  float x = 1.0
  float y = 1.0
end type

point p = {} 'assigns the set of default values

print p.x " " p.y


type point = record
              x, y: integer;
             end;


with javascript_semantics
enum x,y
type point(object p)
    return sequence(p) and length(p)=y and atom(p[x]) and atom(p[y])
end type

point p = {175,3.375}
p[x] -= p[y]*20
puts(1,"point p is ")
?p
printf(1,"p[x]:%g, p[y]:%g\n",{p[x],p[y]})
p[x] = 0            -- fine
p[y] = "string"     -- run-time error (not pwa/p2js)


# Using pack/unpack
$point = pack("ii", 1, 2);

$u = unpack("ix/iy", $point);
echo $x;
echo $y;

list($x,$y) = unpack("ii", $point);
echo $x;
echo $y;


(class +Point)

(dm T (X Y)
   (=: x X)
   (=: y Y) )

(setq P (new '(+Point) 3 4))

(show P)


class Point {
    int x, y;
    void create(int _x, int _y)
    {
        x = _x;
        y = _y;
    }
}

void main()
{
    object point = Point(10, 20);
    write("%d %d\n", point->x, point->y);
}


define structure
  1 point,
     2 x float,
     2 y float;


A cartesian point is a record with an x coord and a y coord.


uses objectclass;
define :class Point;
   slot x = 0;
   slot y = 0;
enddefine;


class Point {
  [Int]$a
  [Int]$b
  Point() {
      $this.a = 0
      $this.b = 0
  }
  Point([Int]$a, [Int]$b) {
      $this.a = $a
      $this.b = $b
  }
  [Int]add() {return $this.a + $this.b}
  [Int]mul() {return $this.a * $this.b}
}
$p1  = [Point]::new()
$p2 = [Point]::new(3,2)
$p1.add()
$p2.mul()


Structure MyPoint
  x.i
  y.i
EndStructure


Type Point
    x As Double
    y As Double
End Type

Dim p As Point
p.x = 15.42
p.y = 2.412

Print p.x; p.y


  [ ' [ 0 0 ] ] is point ( --> [ )

  [ 0 ]         is x     ( --> n )

  [ 1 ]         is y     ( --> n )

  point
  dup x peek     echo cr
  99 swap y poke
  y peek         echo cr


my @point = 3, 8;

my Int @point = 3, 8; # or constrain to integer elements


see new point {x=10 y=20} class point x y


Point = Struct.new(:x,:y)
pt = Point.new(6,7)
puts pt.x        #=> 6
pt.y = 3
puts pt          #=> #<struct Point x=6, y=3>

# The other way of accessing
pt = Point[2,3]
puts pt[:x]      #=> 2
pt['y'] = 5
puts pt          #=> #<struct Point x=2, y=5>

pt.each_pair{|member, value| puts "#{member} : #{value}"}
                 #=> x : 2
                 #=> y : 5


 // Defines a generic struct where x and y can be of any type T
struct Point<T> {
    x: T,
    y: T,
}
fn main() {
    let p = Point { x: 1.0, y: 2.5 }; // p is of type Point<f64>
    println!("{}, {}", p.x, p.y);
}


case class Point(x: Int = 0, y: Int = 0)

val p = Point(1, 2)
println(p.y)   //=> 2


(define-record-type point
    (make-point x y)
    point?
    (x point-x)
    (y point-y))


const type: Point is new struct
    var integer: x is 0;
    var integer: y is 0;
  end struct;


(datatype point
  X : number; Y : number;
  ====================
  [point X Y] : point;)


struct Point {x, y};
var point = Point(1, 2);
say point.y;                #=> 2


type mypoint
  embed
  integer x
  integer y
end type


datatype tree = Empty
              | Leaf of int
              | Node of tree * tree

val t1 = Node (Leaf 1, Node (Leaf 2, Leaf 3))


mata
struct Point {
	real scalar x, y
}

// dumb example
function test() {
	struct Point scalar a
	a.x = 10
	a.y = 20
	printf("%f\n",a.x+a.y)
}

test()
30
end


// Structure
struct Point {
    var x:Int
    var y:Int
}

// Tuple
typealias PointTuple = (Int, Int)

// Class
class PointClass {
    var x:Int!
    var y:Int!

    init(x:Int, y:Int) {
        self.x = x
        self.y = y
    }
}


array set point {x 4 y 5}
set point(y) 7
puts "Point is {$point(x),$point(y)}"
# => Point is {4,7}


typeset -T Point=(
  typeset x
  typeset y
)
Point p
p.x=1
p.y=2
echo $p
echo ${p.x} ${p.y}
Point q=(x=3 y=4)
echo ${q.x} ${q.y}


Type point
    x As Integer
    y As Integer
End Type


function MakePoint(x, y)    " 'Constructor'
    return {"x": a:x, "y": a:y}
endfunction

let p1 = MakePoint(3, 2)
let p2 = MakePoint(-1, -4)

echon "Point 1: x = " p1.x ", y = " p1.y "\n"
echon "Point 2: x = " p2.x ", y = " p2.y "\n"


Structure Point
   Public X, Y As Integer
End Structure


class Point {
    construct new(x, y) {
        _x = x
        _y = y
    }
    x { _x }
    y { _y }

    // for illustration allow Points to be mutated
    x=(value) { _x = value }
    y=(value) { _y = value }

    toString { "(%(_x), %(_y))" }
}

var p = Point.new(1, 2)
System.print(p.toString)

// mutate Point object
p.x = 2
p.y = 3
// print without using the toString method
System.printAll(["(", p.x, ", ", p.y, ")"])


<point x="20" y="30"/>

<!-- context is a point node. The '@' prefix selects named attributes of the current node. -->
<fo:block>Point = <xsl:value-of select="@x"/>, <xsl:value-of select="@y"/></fo:block>


class Point{ var x,y;
   fcn init(x,y){self.x=x.toFloat(); self.y=y.toFloat(); }
   fcn toString{ "P(%f,%f)".fmt(x,y) }
   fcn __opADD(P){} //+: add Point, constant or whatever
   //... __opEQ == etc
}
Point(1,2).println() //-->P(1.000000,2.000000)


{ref,public} (* class *)
	Point = object(ord,abs: integer)
	var
		(* instance variables *)
		{public,immutable} x,y: integer;

	(* method *)
	procedure {public} Ord():integer;
	begin
		return y
	end Ord;

	(* method *)
	procedure {public} Abs():integer;
	begin
		return x
	end Abs;

	(* constructor *)
	begin
		self.x := ord;
		self.y := abs;
	end Point;


COMPCALA CSECT
         L      R1,=A(FACT10)      r1=10!
         XDECO  R1,PG
         XPRNT  PG,L'PG            print buffer
         BR     R14                exit
FACT10   EQU    10*9*8*7*6*5*4*3*2*1   factorial computation
PG       DS     CL12


; Display the value of 10!, which is precomputed at assembly time
; on any Commodore 8-bit.

.ifndef __CBM__
.error "Target must be a Commodore system."
.endif

; zero-page work pointer
temp         = $fb

; ROM routines used
chrout       = $ffd2

    .code

    lda #<tenfactorial
    sta temp
    lda #>tenfactorial
    sta temp+1
    ldy #0
loop:
    lda (temp),y
    beq done
    jsr chrout
    iny
    bne loop
done:
    rts

    .data

; the actual value to print
tenfactorial: .byte 13,"10! = ",.string(10*9*8*7*6*5*4*3*2*1),13,0


tenfactorial equ 10*9*8*7*6*5*4*3*2

MOVE.L #tenfactorial,D1  ;load the constant integer 10! into D1
LEA tenfactorial,A1      ;load into A1 the memory address 10! = 0x375F00
ADD.L #tenfactorial,D2   ;add 10! to whatever is stored in D2 and store the result in D2


with Ada.Text_Io;
procedure CompileTimeCalculation is
   Factorial : constant Integer := 10*9*8*7*6*5*4*3*2*1;

begin
   Ada.Text_Io.Put(Integer'Image(Factorial));
end CompileTimeCalculation;


-- This handler must be declared somewhere above the relevant property declaration
-- so that the compiler knows about it when compiling the property.
on factorial(n)
    set f to 1
    repeat with i from 2 to n
        set f to f * i
    end repeat

    return f
end factorial

property compiledValue : factorial(10)
-- Or of course simply:
-- property compiledValue : 2 * 3 * 4 * 5 * 6 * 7 * 8 * 9 * 10

on run
    return compiledValue
end run


#include <stdio.h>
#include <order/interpreter.h>

#define ORDER_PP_DEF_8fac ORDER_PP_FN( \
8fn(8X, 8seq_fold(8times, 1, 8seq_iota(1, 8inc(8X)))) )

int main(void) {
	printf("10! = %d\n", ORDER_PP( 8to_lit( 8fac(10) ) ) );
	return 0;
}


using System;

public static class Program
{
    public const int FACTORIAL_10 = 10 * 9 * 8 * 7 * 6 * 5 * 4 * 3 * 2 * 1;
    static void Main()
    {
        Console.WriteLine(FACTORIAL_10);
    }
}


#include <iostream>

template<int i> struct Fac
{
    static const int result = i * Fac<i-1>::result;
};

template<> struct Fac<1>
{
    static const int result = 1;
};

int main()
{
    std::cout << "10! = " << Fac<10>::result << "\n";
    return 0;
}


(defn fac [n] (apply * (range 1 (inc n))))
(defmacro ct-factorial [n] (fac n))


(eval-when (:compile-toplevel :load-toplevel :execute)
  (defun factorial ...))


long fact(in long x) pure nothrow @nogc {
    long result = 1;
    foreach (immutable i; 2 .. x + 1)
        result *= i;
    return result;
}

void main() {
    // enum means "compile-time constant", it forces CTFE.
    enum fact10 = fact(10);

    import core.stdc.stdio;

    printf("%ld\n", fact10);
}


(define-constant DIX! (factorial 10))
(define-constant DIX!+1 (1+ DIX!))

(writeln DIX!+1)
3628801


: factorial ( n -- n! ) [1,b] product ;

CONSTANT: 10-factorial $[ 10 factorial ]


: fac ( n -- n! ) 1 swap 1+ 2 max 2 ?do i * loop ;

: main  ." 10! = " [ 10 fac ] literal . ;

see main
: main
  .\" 10! = " 3628800 . ; ok


 program test

   implicit none
   integer,parameter :: t = 10*9*8*7*6*5*4*3*2  !computed at compile time

   write(*,*) t  !write the value the console.

 end program test


' FB 1.05.0 Win64

' Calculations can be done in a Const declaration at compile time
' provided only literals or other constant expressions are used

Const factorial As Integer = 2 * 3 * 4 * 5 * 6 * 7 * 8 * 9 * 10
Print factorial ' 3628800
Sleep


package main

import "fmt"

func main() {
    fmt.Println(2*3*4*5*6*7*8*9*10)
}


module Factorial where
import Language.Haskell.TH.Syntax

fact n = product [1..n]

factQ :: Integer -> Q Exp
factQ = lift . fact


// version 1.0.6
const val TEN_FACTORIAL = 10 * 9 * 8 * 7 * 6 * 5 * 4 * 3 * 2

fun main(args: Array<String>) {
    println("10! = $TEN_FACTORIAL")
}


-- create new (movie) script at runtime
m = new(#script)

-- the following line triggers compilation to bytecode
m.scriptText = "on fac10"&RETURN&"return "&(10*9*8*7*6*5*4*3*2)&RETURN&"end"

put fac10()
-- 3628800


local factorial = 10*9*8*7*6*5*4*3*2*1
print(factorial)


define(`factorial',
`ifelse($1, 0, 1, `eval($1 * factorial(eval($1 - 1)))')')dnl
dnl
BEGIN {
	print "10! is factorial(10)"
}


proc fact(x: int): int =
  result = 1
  for i in 2..x:
    result = result * i

const fact10 = fact(10)
echo(fact10)


MODULE CompileTime;
IMPORT
  Out;
CONST
    tenfac = 10*9*8*7*6*5*4*3*2;
BEGIN
  Out.String("10! =");Out.LongInt(tenfac,0);Out.Ln
END CompileTime.


bundle Default {
  class CompileTime {
    function : Main(args : String[]) ~ Nil {
      (10*9*8*7*6*5*4*3*2*1)->PrintLine();
    }
  }
}


let days_to_seconds n =
  let conv = 24 * 60 * 60 in
  (n * conv)
;;


10 seq reduce(#*) Constant new: FACT10
: newFunction  FACT10 . ;


'LIBRARY CALLS
'=============

extern lib "../../oxygen.dll"

declare o2_basic (string src)
declare o2_exec  (optional sys p) as sys
declare o2_errno () as sys
declare o2_error () as string

extern lib "kernel32.dll"

declare QueryPerformanceFrequency(quad*freq)
declare QueryPerformanceCounter(quad*count)

end extern

'EMBEDDED SOURCE CODE
'====================

src=quote

===Source===

def  Pling10 2*3*4*5*6*7*8*9*10

byte a[pling10] 'Pling10 is resolved to a number here at compile time

print pling10

===Source===

'TIMER
'=====

quad ts,tc,freq
QueryPerformanceFrequency freq
QueryPerformanceCounter ts

'COMPILE/EXECUTE
'===============

o2_basic src

if o2_errno then
  print o2_error
else
  QueryPerformanceCounter tc
  print "Compile time: " str((tc-ts)*1000/freq, 1) " MilliSeconds"
  o2_exec 'Run the program
end if


functor
import
   System Application
prepare
   fun {Fac N}
      {FoldL {List.number 1 N 1} Number.'*' 1}
   end
   Fac10 = {Fac 10}
define
   {System.showInfo "10! = "#Fac10}
   {Application.exit 0}
end


program in out;

const

X = 10*9*8*7*6*5*4*3*2*1 ;

begin

writeln(x);

end;


my $tenfactorial;
print "$tenfactorial\n";

BEGIN
   {$tenfactorial = 1;
    $tenfactorial *= $_ foreach 1 .. 10;}


(de fact (N)
   (apply * (range 1 N)) )

(de foo ()
   (prinl "The value of fact(10) is " `(fact 10)) )


/* Factorials using the pre-processor. */
test: procedure options (main);

%factorial: procedure (N) returns (fixed);
   declare N fixed;
   declare (i, k) fixed;

   k = 1;
   do i = 2 to N;
      k = k*i;
   end;
   return (k);

%end factorial;

%activate factorial;

   declare (x, y) fixed decimal;
   x = factorial (4);
   put ('factorial 4  is ', x);
   y = factorial (6);
   put skip list ('factorial 6 is ', y);

end test;


function fact([BigInt]$n){
    if($n -ge ([BigInt]::Zero)) {
        $fact = [BigInt]::One
        ([BigInt]::One)..$n | foreach{
            $fact = [BigInt]::Multiply($fact, $_)
        }
        $fact

    } else {
        Write-Error "$n is lower than 0"
    }
}
"$((Measure-Command {$fact = fact 10}).TotalSeconds) Seconds"
$fact


% Taken from RosettaCode Factorial page for Prolog
fact(X, 1) :- X<2.
fact(X, F) :- Y is X-1, fact(Y,Z), F is Z*X.

goal_expansion((X = factorial_of(N)), (X = F)) :- fact(N,F).

test :-
	F = factorial_of(10),
	format('!10 = ~p~n', F).


#lang racket

;; Import the math library for compile-time
;; Note: included in Racket v5.3.2
(require (for-syntax math))

;; In versions older than v5.3.2, just define the function
;; for compile-time
;;
;; (begin-for-syntax
;;   (define (factorial n)
;;     (if (zero? n)
;;         1
;;         (factorial (- n 1)))))

;; define a macro that calls factorial at compile-time
(define-syntax (fact10 stx)
  #`#,(factorial 10))

;; use the macro defined above
(fact10)


constant $tenfact = [*] 2..10;
say $tenfact;


/*REXX program computes 10! (ten factorial) during REXX's equivalent of "compile─time". */

say '10! ='    !(10)
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
!: procedure;  !=1;            do j=2  to arg(1);    !=!*j;    end  /*j*/;        return !


a = 10*9*8*7*6*5*4*3*2*1
b = factorial(10)
see a + nl
see b + nl

func factorial nr if nr = 1 return 1 else return nr * factorial(nr-1) ok


fn factorial(n: i64) -> i64 {
    let mut total = 1;
    for i in 1..n+1 {
        total *= i;
    }
    return total;
}

fn main() {
    println!("Factorial of 10 is {}.", factorial(10));
}


object Main extends {
  val tenFactorial = 10 * 9 * 8 * 7 * 6 * 5 * 4 * 3 * 2

  def tenFac = 10 * 9 * 8 * 7 * 6 * 5 * 4 * 3 * 2

  println(s"10! = $tenFactorial", tenFac)
}


$ include "seed7_05.s7i";

const proc: main is func
  local
    const integer: factorial is !10;
  begin
    writeln(factorial);
  end func;


proc makeFacExpr n {
    set exp 1
    for {set i 2} {$i <= $n} {incr i} {
        append exp " * $i"
    }
    return "expr \{$exp\}"
}
eval [makeFacExpr 10]


#import nat

x = factorial 10

#executable&

comcal = ! (%nP x)--<''>


Module Program
    Const FACTORIAL_10 = 10 * 9 * 8 * 7 * 6 * 5 * 4 * 3 * 2 * 1

    Sub Main()
        Console.WriteLine(FACTORIAL_10)
    End Sub
End Module


var factorial10 = 10 * 9 * 8 * 7 * 6 * 5 * 4 * 3 * 2

System.print(factorial10)


(defmacro f10-at-compile-time () (* 2 3 4 5 6 7 8 9 10))


const { [1..10].reduce('*).println(" parse time") }

#fcn fact(N) { [1..N].reduce('*).println(" tokenize time"); ""}
   // paste output of fact into source
#tokenize fact(10)

println("compiled program running.");


const std = @import("std");
fn factorial(n: u64) u64 {
    var total: u64 = 1;
    var i: u64 = 1;
    while (i < n + 1) : (i += 1) {
        total *= i;
    }
    return total;
}
pub fn main() void {
    @setEvalBranchQuota(1000); // minimum loop quota for backwards branches
    const res = comptime factorial(10); // arbitrary Compile Time Function Evaluation
    std.debug.print("res: {d}", .{res}); // output only at runtime
}


I x == 0
   foo()
E I x == 1
   bar()
E
   baz()


* Unconditional Branch or No Branch:
        B      label       Unconditional
        BR     Rx          "
        NOP    label       No Operation
        NOPR   Rx          "
* After Compare Instructions
        BH     label       Branch on High
        BHR    Rx          "
        BL     label       Branch on Low
        BLR    Rx          "
        BE     label       Branch on Equal
        BER    Rx          "
        BNH    label       Branch on Not High
        BNHR   Rx          "
        BNL    label       Branch on Not Low
        BNLR   Rx          "
        BNE    label       Branch on Not Equal
        BNER   Rx          "
* After Arithmetic Instructions:
        BP     label       Branch on Plus
        BPR    Rx          "
        BM     label       Branch on Minus
        BMR    Rx          "
        BZ     label       Branch on Zero
        BZR    Rx          "
        BO     label       Branch on Overflow
        BOR    Rx          "
        BNP    label       Branch on Not Plus
        BNPR   Rx          "
        BNM    label       Branch on Not Minus
        BNMR   Rx          "
        BNZ    label       Branch on Not Zero
        BNZR   Rx          "
        BNO    label       Branch on No Overflow
        BNOR   Rx          "
* After Test Under Mask Instructions:
        BO     label       Branch if Ones
        BOR    Rx          "
        BM     label       Branch if Mixed
        BMR    Rx          "
        BZ     label       Branch if Zero
        BZR    Rx          "
        BNO    label       Branch if Not Ones
        BNOR   Rx          "
        BNM    label       Branch if Not Mixed
        BNMR   Rx          "
        BNZ    label       Branch if Not Zero
        BNZR   Rx          "


MOVE.L #$FFFFFF00,D0
CMP.B #0,D0   ;equals zero, so zero flag is set.
CMP.W #0,D0   ;doesn't equals zero, so zero flag is clear.


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

/*******************************************/
/* Constantes file                         */
/*******************************************/
/* for this file see task include a file in language AArch64 assembly*/
.include "../includeConstantesARM64.inc"
/*******************************************/
/* Initialized data                        */
/*******************************************/
.data
szMessTest1:   .asciz "The test 1 is equal.\n"
szMessTest1N:  .asciz "The test 1 is not equal.\n"
szMessTest1A:  .asciz "The test 1A is equal.\n"
szMessTest1AN: .asciz "The test 1A is not equal.\n"
szMessTest2:   .asciz "The test 2 is equal.\n"
szMessTest2N:  .asciz "The test 2 is not equal.\n"
szMessTest3:   .asciz "The test 3 is <.\n"
szMessTest3N:  .asciz "The test 3 is >.\n"
szMessTest4:   .asciz "The test 4 is <=.\n"
szMessTest4N:  .asciz "The test 4 is >.\n"
szMessTest5:   .asciz "The test 5 is negative.\n"
szMessTest5N:  .asciz "The test 5 is positive ou equal 0.\n"
szMessTest6:   .asciz "Test 6 : carry is off.\n"
szMessTest6N:  .asciz "Test 6 : carry is set.\n"
szMessTest7:   .asciz "Test 7 : no overflow.\n"
szMessTest7N:  .asciz "Test 7 : overflow.\n"
szMessTest8:   .asciz "Test 8 : then.\n"
szMessTest8N:  .asciz "Test 8 : else.\n"
szMessResult:  .asciz "Test result = @ \n"
/*******************************************/
/* UnInitialized data                      */
/*******************************************/
.bss
sZoneConv:               .skip 30
/*******************************************/
/*  code section                           */
/*******************************************/
.text
.global main
main:                           // entry of program

                                // classic test equal zero, not equal zero
  //mov x1,0                    // comments
    mov x1,1                    //  or uncomments
    cmp x1,0                    // structure if else
    bne 1f
    ldr x0,qAdrszMessTest1      // if equal
    b 2f
1:
    ldr x0,qAdrszMessTest1N     // else
2:
    bl affichageMess

    mov x1,0                    //  comments
    //mov x1,1                  //  or uncomments
    cbnz x1,3f                  // other test and branch if not zero
    ldr x0,qAdrszMessTest1A
    b 4f
3:
    ldr x0,qAdrszMessTest1AN
4:
    bl affichageMess
                                // test equal 5, not equal 5
    //mov x1,#5
    mov x1,10
    cmp x1,5
    bne 5f
    ldr x0,qAdrszMessTest2
    b 6f
5:
    ldr x0,qAdrszMessTest2N
6:
    bl affichageMess

                                // test < 5,  > 5  SIGNED
    mov x1,#-10
    //mov x1,#10
    cmp x1,#5
    bgt 7f
    ldr x0,qAdrszMessTest3
    b 8f
7:
    ldr x0,qAdrszMessTest3N
8:
    bl affichageMess

                                // test < 5,  > 5  UNSIGNED
    //mov x1,#-10
    mov x1,#2
    cmp x1,#5
    bhi 9f
    ldr x0,qAdrszMessTest4
    b 10f
9:
    ldr x0,qAdrszMessTest4N
10:
    bl affichageMess

                               // test < 0,  > 0
    mov x1,2
    subs x1,x1,5               // s --> flags
    bpl 11f
    ldr x0,qAdrszMessTest5
    b 12f
11:
    ldr x0,qAdrszMessTest5N
12:
    bl affichageMess

    // carry off carry on
    //mov x1,#-10             // for carry set
    //mov x1,#10              // for carry off
    mov x1,(2<<62) - 1        // for carry off
    adds x1,x1,20             // s --> flags
    bcs 13f
    ldr x0,qAdrszMessTest6    // carry clear
    b 14f
13:
    ldr x0,qAdrszMessTest6N   // carry set
14:
    bl affichageMess

                              // overflow off overflow on
    //mov x1,#-10             // for not overflow
    //mov x1,#10              // for not overflow
    mov x1,(2<<62) - 1        // for overflow
    adds x1,x1,20             // s --> flags
    bvs 15f
    ldr x0,qAdrszMessTest7    // overflow off
    b 16f
15:
    ldr x0,qAdrszMessTest7N   // overflow on
16:
    bl affichageMess

    // other conditionnel test csel
    mov x2,-20
    mov x3,25
    mov x1,10                   // for equal
    //mov x1,#20                // for else
    cmp x1,10
    csel x0,x2,x3,eq            // if x1=10 x0 = x2 else x0 = x3
    ldr x1,qAdrsZoneConv
    bl conversion10S
    ldr x0,qAdrszMessResult
    ldr x1,qAdrsZoneConv
    bl strInsertAtCharInc       // insert result at @ character
    bl affichageMess

                                // other conditionnel test cset
    //mov x1,10                 // for equal
    mov x1,20                   // for else
    cmp x1,10
    cset x0,eq                  // if x1=10 x0 = 1 else x0 = 0
    ldr x1,qAdrsZoneConv
    bl conversion10S
    ldr x0,qAdrszMessResult
    ldr x1,qAdrsZoneConv
    bl strInsertAtCharInc       // insert result at @ character
    bl affichageMess

                                // other conditionnel test cinc
    mov x0,3
    mov x1,10                   // for equal
    //mov x1,20                 // for else
    cmp x1,10
    cinc x0,x0,eq               // if x1=10 x0 = x0+1 else x0 = x0
    ldr x1,qAdrsZoneConv
    bl conversion10S
    ldr x0,qAdrszMessResult
    ldr x1,qAdrsZoneConv
    bl strInsertAtCharInc      // insert result at @ character
    bl affichageMess

                               // other conditionnel test csinc
    mov x0,3
    mov x2,6
    mov x3,11
    mov x1,10                  // for equal
    //mov x1,20                // for else
    cmp x1,10
    csinc x0,x2,x3,ne          // if x1<>10 x0 = x2  else x0 = x3 + 1
    ldr x1,qAdrsZoneConv
    bl conversion10S
    ldr x0,qAdrszMessResult
    ldr x1,qAdrsZoneConv
    bl strInsertAtCharInc      // insert result at @ character
    bl affichageMess
100:                           // standard end of the program
    mov x0,0                   // return code
    mov x8,EXIT                // request to exit program
    svc 0                      // perform the system call
qAdrszMessTest1:         .quad szMessTest1
qAdrszMessTest1N:        .quad szMessTest1N
qAdrszMessTest1A:        .quad szMessTest1A
qAdrszMessTest1AN:       .quad szMessTest1AN
qAdrszMessTest2:         .quad szMessTest2
qAdrszMessTest2N:        .quad szMessTest2N
qAdrszMessTest3:         .quad szMessTest3
qAdrszMessTest3N:        .quad szMessTest3N
qAdrszMessTest4:         .quad szMessTest4
qAdrszMessTest4N:        .quad szMessTest4N
qAdrszMessTest5:         .quad szMessTest5
qAdrszMessTest5N:        .quad szMessTest5N
qAdrszMessTest6:         .quad szMessTest6
qAdrszMessTest6N:        .quad szMessTest6N
qAdrszMessTest7:         .quad szMessTest7
qAdrszMessTest7N:        .quad szMessTest7N
qAdrszMessTest8:         .quad szMessTest8
qAdrszMessTest8N:        .quad szMessTest8N
qAdrszMessResult:        .quad szMessResult
qAdrsZoneConv:           .quad sZoneConv
/********************************************************/
/*        File Include fonctions                        */
/********************************************************/
/* for this file see task include a file in language AArch64 assembly */
.include "../includeARM64.inc"


PROC Main()
  INT i

  FOR i=-1 TO 1
  DO
    IF i<0 THEN
      PrintF("%I is less than zero%E",i)
    ELSEIF i>0 THEN
      PrintF("%I is greater than zero%E",i)
    ELSE
      PrintF("%I is zero%E",i)
    FI
  OD
RETURN


type Restricted is range 1..10;
My_Var : Restricted;

if My_Var = 5 then
  -- do something
elsif My_Var > 5 then
  -- do something
else
  -- do something
end if;


if (c1) {
  // first condition is true...
} elif (c2) {
  // second condition is true...
} elif (c3) {
  // third condition is true...
} else {
  // none was true...
}


 expression::=  if conditional_expression then expression else expression
   K:=if X=Y then I else J


begin
    integer a, b, c;

    a := 1; b := 2; c := 3;

    % algol W has the traditional Algol if-the-else statement                %
    % there is no "elseif" contraction                                       %
    if a = b
    then write( "a = b" )
    else if a = c
         then write( "a = c" )
         else write( "a is ", a );

    % if-then-else can also be used in an expression                         %
    write( if a < 4 then "lt 4" else "ge 4" );

    % algol W also has a "case" statement, an integer expression is used to  %
    % select the statement to execute. If the expression evaluates to 1,    %
    % the first statement is executed, if 2, the second is executed etc.     %
    % If the expression is less than 1 or greater than the number of         %
    % statements, a run time error occurs                                    %
    case a + b of
    begin write( "a + b is one"   )
        ; write( "a + b is two"   )
        ; write( "a + b is three" )
        ; write( "a + b is four"  )
    end;

    % there is also an expression form of the case:                          %
    write( case c - a of ( "one", "two", "three", "four" ) )

end.


if: condition then: {
  // condition is true...
} else: {
  // condition is false...
}


IF condition
  -> if condition is true...
ELSEIF condition2
  -> else if condition2 is true...
ELSE
  -> if all other conditions are not true...
ENDIF


if (s == 'Hello World') {
    foo();
} else if (s == 'Bye World') {
    bar();
} else {
    deusEx();
}


V cellcountx = 6
V cellcounty = 5
V celltable = [(1, 2) = 1,
               (1, 3) = 1,
               (0, 3) = 1]
DefaultDict[(Int, Int), Int] universe
universe[(1, 1)] = 1
universe[(2, 1)] = 1
universe[(3, 1)] = 1
universe[(1, 4)] = 1
universe[(2, 4)] = 1
universe[(3, 4)] = 1

L(i) 4
   print("\nGeneration "i‘:’)
   L(row) 0 .< cellcounty
      print(‘  ’(0 .< cellcountx).map(col -> [‘. ’, ‘O ’][:universe[(@row, col)]]).join(‘’))

   DefaultDict[(Int, Int), Int] nextgeneration
   L(row) 0 .< cellcounty
      L(col) 0 .< cellcountx
         nextgeneration[(row, col)] = celltable.get(
              (universe[(row, col)],
              -universe[(row, col)] + sum(multiloop(row-1..row+1,
                                                    col-1..col+1, (r, c) -> :universe[(r, c)]))
              ), 0)
   universe = nextgeneration


if myVar is "ok" then return true

set i to 0
if i is 0 then
       return "zero"
else if i mod 2 is 0 then
       return "even"
else
       return "odd"
end if


randfill:   stx $01          ;$200 for indirect
            ldx #$02         ;addressing
            stx $02
randloop:   lda $fe          ;generate random
            and #$01         ;pixels on the
            sta ($01),Y      ;screen
            jsr inc0103
            cmp #$00
            bne randloop
            lda $02
            cmp #$06
            bne randloop

clearmem:   lda #$df         ;set $07df-$0a20
            sta $01          ;to $#00
            lda #$07
            sta $02
clearbyte:  lda #$00
            sta ($01),Y
            jsr inc0103
            cmp #$20
            bne clearbyte
            lda $02
            cmp #$0a
            bne clearbyte

starttick:
copyscreen: lda #$00         ;set up source
            sta $01          ;pointer at
            sta $03          ;$01/$02 and
            lda #$02         ;dest pointer
            sta $02          ;at $03/$04
            lda #$08
            sta $04
            ldy #$00
copybyte:   lda ($01),Y      ;copy pixel to
            sta ($03),Y      ;back buffer
            jsr inc0103      ;increment pointers
            cmp #$00         ;check to see
            bne copybyte     ;if we're at $600
            lda $02          ;if so, we've
            cmp #$06         ;copied the
            bne copybyte     ;entire screen

conway:     lda #$df         ;apply conway rules
            sta $01          ;reset the pointer
            sta $03          ;to $#01df/$#07df
            lda #$01         ;($200 - $21)
            sta $02          ;($800 - $21)
            lda #$07
            sta $04
onecell:    lda #$00         ;process one cell
            ldy #$01         ;upper cell
            clc
            adc ($03),Y
            ldy #$41         ;lower cell
            clc
            adc ($03),Y
chkleft:    tax              ;check to see
            lda $01          ;if we're at the
            and #$1f         ;left edge
            tay
            txa
            cpy #$1f
            beq rightcells
leftcells:  ldy #$00         ;upper-left cell
            clc
            adc ($03),Y
            ldy #$20         ;left cell
            clc
            adc ($03),Y
            ldy #$40         ;lower-left cell
            clc
            adc ($03),Y
chkright:   tax              ;check to see
            lda $01          ;if we're at the
            and #$1f         ;right edge
            tay
            txa
            cpy #$1e
            beq evaluate
rightcells: ldy #$02         ;upper-right cell
            clc
            adc ($03),Y
            ldy #$22         ;right cell
            clc
            adc ($03),Y
            ldy #$42         ;lower-right cell
            clc
            adc ($03),Y
evaluate:   ldx #$01         ;evaluate total
            ldy #$21         ;for current cell
            cmp #$03         ;3 = alive
            beq storex
            ldx #$00
            cmp #$02         ;2 = alive if
            bne storex       ;c = alive
            lda ($03),Y
            and #$01
            tax
storex:     txa              ;store to screen
            sta ($01),Y
            jsr inc0103      ;move to next cell
conwayloop: cmp #$e0         ;if not last cell,
            bne onecell      ;process next cell
            lda $02
            cmp #$05
            bne onecell
            jmp starttick    ;run next tick

inc0103:    lda $01          ;increment $01
            cmp #$ff         ;and $03 as 16-bit
            bne onlyinc01    ;pointers
            inc $02
            inc $04
onlyinc01:  inc $01
            lda $01
            sta $03
            rts


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

/* Constantes    */
.equ STDOUT, 1     @ Linux output console
.equ EXIT,   1     @ Linux syscall
.equ WRITE,  4     @ Linux syscall
/* Initialized data */
.data
szMessTest1: .asciz "The test 1 is equal.\n"
szMessTest1N: .asciz "The test 1 is not equal.\n"
szMessTest2: .asciz "The test 2 is equal.\n"
szMessTest2N: .asciz "The test 2 is not equal.\n"
szMessTest3: .asciz "The test 3 is <.\n"
szMessTest3N: .asciz "The test 3 is >.\n"
szMessTest4: .asciz "The test 4 is <=.\n"
szMessTest4N: .asciz "The test 4 is >.\n"
szMessTest5: .asciz "The test 5 is negative.\n"
szMessTest5N: .asciz "The test 5 is positive ou equal 0.\n"
szMessTest6: .asciz "Test 6 : carry is off.\n"
szMessTest6N: .asciz "Test 6 : carry is set.\n"
szMessTest7: .asciz "Test 7 : no overflow.\n"
szMessTest7N: .asciz "Test 7 : overflow.\n"
szMessTest8: .asciz "Test 8 : then.\n"
szMessTest8N: .asciz "Test 8 : else.\n"

/* UnInitialized data */
.bss

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

    @ test equal zero, not equal zero
    @movs r1,#0      @ comments
    movs r1,#1          @  @ s --> flags   and uncomments
    ldreq r0,iAdrszMessTest1
    ldrne r0,iAdrszMessTest1N
    bl affichageMess

    @ test equal 5, not equal 5
    @mov r1,#5
    mov r1,#10
    cmp r1,#5
    ldreq r0,iAdrszMessTest2
    ldrne r0,iAdrszMessTest2N
    bl affichageMess

    @ test < 5,  > 5  SIGNED
    mov r1,#-10
    @mov r1,#10
    cmp r1,#5
    ldrlt r0,iAdrszMessTest3
    ldrgt r0,iAdrszMessTest3N
    bl affichageMess

    @ test < 5,  > 5  UNSIGNED
    @mov r1,#-10
    mov r1,#2
    cmp r1,#5
    ldrls r0,iAdrszMessTest4
    ldrhi r0,iAdrszMessTest4N
    bl affichageMess

    @ test < 0,  > 0
    @movs r1,#-10
    movs r1,#2     @ s --> flags
    ldrmi r0,iAdrszMessTest5
    ldrpl r0,iAdrszMessTest5N
    bl affichageMess

    @ carry off carry on
    @mov r1,#-10     @ for carry set
    @mov r1,#10  @ for carry off
    mov r1,#(2<<30) - 1   @ for carry off
    adds r1,#20    @ s --> flags
    ldrcc r0,iAdrszMessTest6    @ carry clear
    ldrcs r0,iAdrszMessTest6N   @ carry set
    bl affichageMess

    @ overflow off overflow on
    @mov r1,#-10     @ for not overflow
    @mov r1,#10  @ for not overflow
    mov r1,#(2<<30) - 1  @ for overflow
    adds r1,#20    @ s --> flags
    ldrvc r0,iAdrszMessTest7    @ overflow off
    ldrvs r0,iAdrszMessTest7N   @ overflow on
    bl affichageMess

    @ other if then else
    mov r1,#5  @ for then
    @mov r1,#20  @ for else
    cmp r1,#10
    ble 1f         @ less or equal
    @bge 1f      @ greather or equal
    @else
    ldr r0,iAdrszMessTest8N    @ overflow off
    bl affichageMess
    b 2f
1:   @ then
   ldr r0,iAdrszMessTest8    @ overflow off
    bl affichageMess
2:

100:   /* standard end of the program */
    mov r0, #0                  @ return code
    pop {fp,lr}                 @restaur 2 registers
    mov r7, #EXIT              @ request to exit program
    swi 0                       @ perform the system call
iAdrszMessTest1:		.int szMessTest1
iAdrszMessTest1N:		.int szMessTest1N
iAdrszMessTest2:		.int szMessTest2
iAdrszMessTest2N:		.int szMessTest2N
iAdrszMessTest3:		.int szMessTest3
iAdrszMessTest3N:		.int szMessTest3N
iAdrszMessTest4:		.int szMessTest4
iAdrszMessTest4N:		.int szMessTest4N
iAdrszMessTest5:		.int szMessTest5
iAdrszMessTest5N:		.int szMessTest5N
iAdrszMessTest6:		.int szMessTest6
iAdrszMessTest6N:		.int szMessTest6N
iAdrszMessTest7:		.int szMessTest7
iAdrszMessTest7N:		.int szMessTest7N
iAdrszMessTest8:		.int szMessTest8
iAdrszMessTest8N:		.int szMessTest8N
/******************************************************************/
/*     display text with size calculation                         */
/******************************************************************/
/* r0 contains the address of the message */
affichageMess:
    push {fp,lr}    			/* save  registres */
    push {r0,r1,r2,r7}    		/* save others registers */
    mov r2,#0   				/* counter length */
1:      	/* loop length calculation */
    ldrb r1,[r0,r2]  			/* read octet start position + index */
    cmp r1,#0       			/* if 0 its over */
    addne r2,r2,#1   			/* else add 1 in the length */
    bne 1b          			/* and loop */
                                /* so here r2 contains the length of the message */
    mov r1,r0        			/* address message in r1 */
    mov r0,#STDOUT      		/* code to write to the standard output Linux */
    mov r7, #WRITE             /* code call system "write" */
    swi #0                      /* call systeme */
    pop {r0,r1,r2,r7}     		/* restaur others registers */
    pop {fp,lr}    				/* restaur des  2 registres */
    bx lr	        			/* return  */