----------------------- CARPET MODEL ---------------------

-- sierpinskiCarpet :: Int -> [[Bool]]
on sierpinskiCarpet(n)

    -- rowStates :: Int -> [Bool]
    script rowStates
        on |λ|(x, _, xs)

            -- cellState :: Int -> Bool
            script cellState

                -- inCarpet :: Int -> Int -> Bool
                on inCarpet(x, y)
                    if (0 = x or 0 = y) then
                        true
                    else
                        not ((1 = x mod 3) and ¬
                            (1 = y mod 3)) and ¬
                            inCarpet(x div 3, y div 3)
                    end if
                end inCarpet

                on |λ|(y)
                    inCarpet(x, y)
                end |λ|
            end script

            map(cellState, xs)
        end |λ|
    end script

    map(rowStates, enumFromTo(0, (3 ^ n) - 1))
end sierpinskiCarpet

--------------------------- TEST -------------------------
on run
    -- Carpets of orders 1, 2, 3

    set strCarpets to ¬
        intercalate(linefeed & linefeed, ¬
            map(showCarpet, enumFromTo(1, 3)))

    set the clipboard to strCarpets

    return strCarpets
end run

---------------------- CARPET DISPLAY --------------------

-- showCarpet :: Int -> String
on showCarpet(n)

    -- showRow :: [Bool] -> String
    script showRow
        -- showBool :: Bool -> String
        script showBool
            on |λ|(bool)
                if bool then
                    character id 9608
                else
                    " "
                end if
            end |λ|
        end script

        on |λ|(xs)
            intercalate("", map(my showBool, xs))
        end |λ|
    end script

    intercalate(linefeed, map(showRow, sierpinskiCarpet(n)))
end showCarpet

-------------------- GENERIC FUNCTIONS -------------------

-- enumFromTo :: Int -> Int -> [Int]
on enumFromTo(m, n)
    if m ≤ n then
        set xs to {}
        repeat with i from m to n
            set end of xs to i
        end repeat
        xs
    else
        {}
    end if
end enumFromTo

-- intercalate :: Text -> [Text] -> Text
on intercalate(strText, lstText)
    set {dlm, my text item delimiters} to {my text item delimiters, strText}
    set strJoined to lstText as text
    set my text item delimiters to dlm
    return strJoined
end intercalate

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

-- Lift 2nd class handler function into 1st class script wrapper
-- mReturn :: Handler -> Script
on mReturn(f)
    if class of f is script then
        f
    else
        script
            property |λ| : f
        end script
    end if
end mReturn


TEST(0,0)
TEST(0,1)
TEST(1,0)
TEST(1,1)
Return

Lbl TEST
r₁→X
r₂→Y
Disp X▶Hex+3," and ",Y▶Hex+3," = ",(A(X)?B(Y))▶Hex+3,i
Disp X▶Hex+3," or  ",Y▶Hex+3," = ",(A(X)??B(Y))▶Hex+3,i
.Wait for keypress
getKeyʳ
Return

Lbl A
r₁
Return

Lbl B
r₁
Return


' Short-circuit evaluation
FUNCTION a(f)
    PRINT "FUNCTION a"
    RETURN f
END FUNCTION

FUNCTION b(f)
    PRINT "FUNCTION b"
    RETURN f
END FUNCTION

PRINT "FALSE and TRUE"
x = a(FALSE) AND b(TRUE)
PRINT x

PRINT "TRUE and TRUE"
x = a(TRUE) AND b(TRUE)
PRINT x

PRINT "FALSE or FALSE"
y = a(FALSE) OR b(FALSE)
PRINT y

PRINT "TRUE or FALSE"
y = a(TRUE) OR b(FALSE)
PRINT y


 100 HGR
 110 POKE 49234,0
 120 DEF  FN M(X) = X -  INT (D * 3) *  INT (X /  INT (D * 3))
 130 DE = 4
 140 DI = 3 ^ DE * 3
 150 FOR I = 0 TO DI - 1
 160      FOR J = 0 TO DI - 1
 170          FOR D = DI / 3 TO 0 STEP 0
 180              IF  INT ( FN M(I) / D) = 1 AND  INT ( FN M(J) / D) = 1 THEN 200BREAK
 190              D =  INT (D / 3): NEXT D
 200          HCOLOR= 3 * (D = 0)
 210          HPLOT J,I
 220      NEXT J
 230 NEXT I


inCarpet?: function [x,y][
    X: x
    Y: y
    while [true][
        if or? zero? X
               zero? Y -> return true
        if and? 1 = X % 3
                1 = Y % 3 -> return false

        X: X / 3
        Y: Y / 3
    ]
]

carpet: function [n][
    loop 0..dec 3^n 'i [
        loop 0..dec 3^n 'j [
            prints (inCarpet? i j)? -> "# "
                                    -> "  "
        ]
        print ""
    ]
]

carpet 3


%=== Batch Files have no booleans. ===%
%=== I will instead use 1 as true and 0 as false. ===%

@echo off
setlocal enabledelayedexpansion
echo AND
for /l %%i in (0,1,1) do (
for /l %%j in (0,1,1) do (
		echo.a^(%%i^) AND b^(%%j^)
		call :a %%i
		set res=!bool_a!
		if not !res!==0 (
			call :b %%j
			set res=!bool_b!
		)
		echo.=^>	!res!
)
)

echo ---------------------------------
echo OR
for /l %%i in (0,1,1) do (
	for /l %%j in (0,1,1) do (
		echo a^(%%i^) OR b^(%%j^)
		call :a %%i
		set res=!bool_a!
		if !res!==0 (
			call :b %%j
			set res=!bool_b!
		)
		echo.=^>	!res!
	)
)
pause>nul
exit /b 0

::----------------------------------------
:a
echo.	calls func a
set bool_a=%1
goto :EOF

:b
echo.	calls func b
set bool_b=%1
goto :EOF


path across(path p, real node) {
    return
        point(p, node + 1/3) + point(p, node - 1/3) - point(p, node);
}

path corner_subquad(path p, real node) {
    return
        point(p, node) --
        point(p, node + 1/3) --
        across(p, node) --
        point(p, node - 1/3) --
        cycle;
}

path noncorner_subquad(path p, real node1, real node2) {
    return
        point(p, node1 + 1/3) --
        across(p, node1) --
        across(p, node2) --
        point(p, node2 - 1/3) --
        cycle;
}

void carpet(path p, int order) {
    if (order == 0)
        fill(p);
    else {
        for (real node : sequence(0, 3)) {
            carpet(corner_subquad(p, node), order - 1);
            carpet(noncorner_subquad(p, node, node + 1), order - 1);
        }
    }
}

path q =
   // A square
   unitsquare
   // An oblong rhombus
   // (0, 0) -- (5, 3) -- (0, 6) -- (-5, 3) -- cycle
   // A trapezoid
   // (0, 0) -- (4, 2) -- (6, 2) -- (10, 0) -- cycle
   // A less regular quadrilateral
   // (0, 0) -- (4, 1) -- (9, -4) -- (1, -1) -- cycle
   // A concave shape
   // (0, 0) -- (5, 3) -- (10, 0) -- (5, 1) -- cycle
   ;

size(9 inches, 6 inches);

carpet(q, 5);


      REM TRUE is represented as -1, FALSE as 0
      FOR i% = TRUE TO FALSE
        FOR j% = TRUE TO FALSE
          PRINT "For x=a(";FNboolstring(i%);") AND b(";FNboolstring(j%);")"
          x% = FALSE
          REM Short-circuit AND can be simulated by cascaded IFs:
          IF FNa(i%) IF FNb(j%) THEN x%=TRUE
          PRINT "x is ";FNboolstring(x%)
          PRINT
          PRINT "For y=a(";FNboolstring(i%);") OR b(";FNboolstring(j%);")"
          y% = FALSE
          REM Short-circuit OR can be simulated by De Morgan's laws:
          IF NOTFNa(i%) IF NOTFNb(j%) ELSE y%=TRUE : REM Note ELSE without THEN
          PRINT "y is ";FNboolstring(y%)
          PRINT
        NEXT:NEXT
      END

      DEFFNa(bool%)
      PRINT "Function A used; ";
      =bool%

      DEFFNb(bool%)
      PRINT "Function B used; ";
      =bool%

      DEFFNboolstring(bool%)
      IF bool%=0 THEN ="FALSE" ELSE="TRUE"


( (a=.out$"I'm a"&!!arg)
& (b=.out$"I'm b"&!!arg)
& (false==~)
& (true==)
& !false !true:?outer
&   whl
  ' ( !outer:%?x ?outer
    & !false !true:?inner
    &   whl
      ' ( !inner:%?y ?inner
        &   out
          $ ( Testing
              (!!x&true|false)
              AND
              (!!y&true|false)
            )
        & `(a$!x&b$!y)
        &   out
          $ ( Testing
              (!!x&true|false)
              OR
              (!!y&true|false)
            )
        & `(a$!x|b$!y)
        )
    )
& done
);


#include <stdio.h>
#include <stdbool.h>

bool a(bool in)
{
  printf("I am a\n");
  return in;
}

bool b(bool in)
{
  printf("I am b\n");
  return in;
}

#define TEST(X,Y,O)						\
  do {								\
    x = a(X) O b(Y);						\
    printf(#X " " #O " " #Y " = %s\n\n", x ? "true" : "false");	\
  } while(false);

int main()
{
  bool x;

  TEST(false, true, &&); // b is not evaluated
  TEST(true, false, ||); // b is not evaluated
  TEST(true, false, &&); // b is evaluated
  TEST(false, false, ||); // b is evaluated

  return 0;
}


Loop 4
   MsgBox % Carpet(A_Index)

Carpet(n) {
   Loop % 3**n {
      x := A_Index-1
      Loop % 3**n
         t .= Dot(x,A_Index-1)
      t .= "`n"
   }
   Return t
}

Dot(x,y) {
   While x>0 && y>0
      If (mod(x,3)=1 && mod(y,3)=1)
         Return " "
      Else x //= 3, y //= 3
   Return "."
}


# WSC.AWK - Waclaw Sierpinski's carpet contributed by Dan Nielsen
#
# syntax: GAWK -f WSC.AWK [-v o={a|A}{b|B}] [-v X=anychar] iterations
#
#   -v o=ab default
#      a|A  loose weave | tight weave
#      b|B  don't show | show how the carpet is built
#   -v X=?  Carpet is built with X's. The character assigned to X replaces all X's.
#
#   iterations
#      The number of iterations. The default is 0 which produces one carpet.
#
# what is the difference between a loose weave and a tight weave:
#   loose                tight
#   X X X X X X X X X    XXXXXXXXX
#   X   X X   X X   X    X XX XX X
#   X X X X X X X X X    XXXXXXXXX
#   X X X       X X X    XXX   XXX
#   X   X       X   X    X X   X X
#   X X X       X X X    XXX   XXX
#   X X X X X X X X X    XXXXXXXXX
#   X   X X   X X   X    X XX XX X
#   X X X X X X X X X    XXXXXXXXX
#
# examples:
#   GAWK -f WSC.AWK 2
#   GAWK -f WSC.AWK -v o=Ab -v X=# 2
#   GAWK -f WSC.AWK -v o=Ab -v X=\xDB 2
#
BEGIN {
    optns = (o == "") ? "ab" : o
    n = ARGV[1] + 0 # iterations
    if (n !~ /^[0-9]+$/) { exit(1) }
    seed = (optns ~ /A/) ? "XXX,X X,XXX" : "X X X ,X   X ,X X X " # tight/loose weave
    leng = row = split(seed,A,",") # seed the array
    for (i=1; i<=n; i++) { # build carpet
      for (a=1; a<=3; a++) {
        row = 0
        for (b=1; b<=3; b++) {
          for (c=1; c<=leng; c++) {
            row++
            tmp = (a == 2 && b == 2) ? sprintf("%*s",length(A[c]),"") : A[c]
            B[row] = B[row] tmp
          }
          if (optns ~ /B/) { # show how the carpet is built
            if (max_row < row+0) { max_row = row }
            for (r=1; r<=max_row; r++) {
              printf("i=%d row=%02d a=%d b=%d '%s'\n",i,r,a,b,B[r])
            }
            print("")
          }
        }
      }
      leng = row
      for (j=1; j<=row; j++) { A[j] = B[j] } # re-seed the array
      for (j in B) { delete B[j] } # delete work array
    }
    for (j=1; j<=row; j++) { # print carpet
      if (X != "") { gsub(/X/,substr(X,1,1),A[j]) }
      sub(/ +$/,"",A[j])
      printf("%s\n",A[j])
    }
    exit(0)
}


using System;

class Program
{
    static bool a(bool value)
    {
        Console.WriteLine("a");
        return value;
    }

    static bool b(bool value)
    {
        Console.WriteLine("b");
        return value;
    }

    static void Main()
    {
        foreach (var i in new[] { false, true })
        {
            foreach (var j in new[] { false, true })
            {
                Console.WriteLine("{0} and {1} = {2}", i, j, a(i) && b(j));
                Console.WriteLine();
                Console.WriteLine("{0} or {1} = {2}", i, j, a(i) || b(j));
                Console.WriteLine();
            }
        }
    }
}


function in_carpet(x, y)
	while x <> 0 and y <> 0
		if(x mod 3) = 1 and (y mod 3) = 1 then return False
		y = int(y / 3): x = int(x / 3)
	end while
	return True
end function

Subroutine carpet(n)
	k = (3^n)-1

	for i = 0 to k
		for j = 0 to k
			if in_carpet(i, j) then print("#"); else print(" ");
		next j
		print
	next i
end subroutine

for k = 0 to 3
	print "N = "; k
	call carpet(k)
	print
next k
end


      Order% = 3
      side% = 3^Order%
      VDU 23,22,8*side%;8*side%;64,64,16,128
      FOR Y% = 0 TO side%-1
        FOR X% = 0 TO side%-1
          IF FNincarpet(X%,Y%) PLOT X%*16,Y%*16+15
        NEXT
      NEXT Y%
      REPEAT WAIT 1 : UNTIL FALSE
      END

      DEF FNincarpet(X%,Y%)
      REPEAT
        IF X% MOD 3 = 1 IF Y% MOD 3 = 1 THEN = FALSE
        X% DIV= 3
        Y% DIV= 3
      UNTIL X%=0 AND Y%=0
      = TRUE


#include <iostream>

bool a(bool in)
{
    std::cout << "a" << std::endl;
    return in;
}

bool b(bool in)
{
    std::cout << "b" << std::endl;
    return in;
}

void test(bool i, bool j) {
    std::cout << std::boolalpha << i << " and " << j << " = " << (a(i) && b(j)) << std::endl;
    std::cout << std::boolalpha << i << " or " << j << " = " << (a(i) || b(j)) << std::endl;
}

int main()
{
    test(false, false);
    test(false, true);
    test(true, false);
    test(true, true);
    return 0;
}


_decode ← {⌽𝕗|⌊∘÷⟜𝕗⍟(↕1+·⌊𝕗⋆⁼1⌈⊢)}
Carpet ← {  # 2D Array method using ∾.
  {∾(3‿3⥊4≠↕9)⊏⟨(≢𝕩)⥊0,𝕩⟩}⍟(𝕩-1) 1‿1⥊1
}
Carpet1 ← { # base conversion method, works in a single step.
  ¬{∨´𝕨∧○((-𝕨⌈○≠𝕩)⊸↑)𝕩}⌜˜2|3 _decode¨↕3⋆𝕩-1
}

•Show " #"⊏˜Carpet 4
•Show (Carpet ≡ Carpet1) 4


#include <stdio.h>

int main()
{
	int i, j, dim, d;
	int depth = 3;

	for (i = 0, dim = 1; i < depth; i++, dim *= 3);

	for (i = 0; i < dim; i++) {
		for (j = 0; j < dim; j++) {
			for (d = dim / 3; d; d /= 3)
				if ((i % (d * 3)) / d == 1 && (j % (d * 3)) / d == 1)
					break;
			printf(d ? "  " : "##");
		}
		printf("\n");
	}

	return 0;
}


(letfn [(a [bool] (print "(a)") bool)
        (b [bool] (print "(b)") bool)]
  (doseq [i [true false] j [true false]]
    (print i "OR" j "= ")
    (println (or (a i) (b j)))
    (print i "AND" j " = ")
    (println (and (a i) (b j)))))


(defun a (F)
     (print 'a)
     F )

(defun b (F)
     (print 'b)
     F )

(dolist (x '((nil nil) (nil T) (T T) (T nil)))
        (format t "~%(and ~S)" x)
        (and (a (car x)) (b (car(cdr x))))
        (format t "~%(or ~S)" x)
        (or (a (car x)) (b (car(cdr x)))))


using System;
using System.Collections.Generic;
using System.Linq;

class Program
{
    static List<string> NextCarpet(List<string> carpet)
    {
        return carpet.Select(x => x + x + x)
                     .Concat(carpet.Select(x => x + x.Replace('#', ' ') + x))
                     .Concat(carpet.Select(x => x + x + x)).ToList();
    }

    static List<string> SierpinskiCarpet(int n)
    {
        return Enumerable.Range(1, n).Aggregate(new List<string> { "#" }, (carpet, _) => NextCarpet(carpet));
    }

    static void Main(string[] args)
    {
        foreach (string s in SierpinskiCarpet(3))
            Console.WriteLine(s);
    }
}


// contributed to rosettacode.org by Peter Helcmanovsky
// BCT = Binary-Coded Ternary: pairs of bits form one digit [0,1,2] (0b11 is invalid digit)

#include <cstdint>
#include <cstdlib>
#include <cstdio>

static constexpr int32_t bct_low_bits = 0x55555555;

static int32_t bct_decrement(int32_t v) {
    --v;            // either valid BCT (v-1), or block of bottom 0b00 digits becomes invalid 0b11
    return v ^ (v & (v>>1) & bct_low_bits);     // fix all 0b11 to 0b10 (digit "2")
}

int main (int argc, char *argv[])
{
    // parse N from first argument, if no argument, use 3 as default value
    const int32_t n = (1 < argc) ? std::atoi(argv[1]) : 3;
    // check for valid N (0..9) - 16 requires 33 bits for BCT form 1<<(n*2) => hard limit
    if (n < 0 || 9 < n) {                       // but N=9 already produces 370MB output
        std::printf("N out of range (use 0..9): %ld\n", long(n));
        return 1;
    }

    const int32_t size_bct = 1<<(n*2);          // 3**n in BCT form (initial value for loops)
    // draw the carpet, two nested loops counting down in BCT form of values
    int32_t y = size_bct;
    do {                                        // all lines loop
        y = bct_decrement(y);                   // --Y (in BCT)
        int32_t x = size_bct;
        do {                                    // line loop
            x = bct_decrement(x);               // --X (in BCT)
            // check if x has ternary digit "1" at same position(s) as y -> output space (hole)
            std::putchar((x & y & bct_low_bits) ? ' ' : '#');
        } while (0 < x);
        std::putchar('\n');
    } while (0 < y);

    return 0;
}


/* ARM assembly AARCH64 Raspberry PI 3B or android 64 bits */
/*  program merkleRoot64.s   */

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

.equ O_RDWR,  0x0002             // open for reading and writing

.equ BUFFERSIZE,         65535   // file buffer
.equ LGBLOCK,            1024    // block length

.equ LGHASH, 32                  // hash length
.equ NBELEMENTS, 40              // array size
.equ LGZONETRAV, 2048            // process array size

/*******************************************/
/* Structures                               */
/********************************************/
/*  structure  variables hash compute */
    .struct  0
var_a:                     // a
    .struct  var_a + 4
var_b:                     // b
    .struct  var_b + 4
var_c:                     // c
    .struct  var_c + 4
var_d:                     // d
    .struct  var_d + 4
var_e:                     // e
    .struct  var_e + 4
var_f:                     // f
    .struct  var_f + 4
var_g:                     // g
    .struct  var_g + 4
var_h:                     // h
    .struct  var_h + 4
/***********************************/
/* Initialized data                */
/***********************************/
.data
szFileName:              .asciz "title.png"
szCarriageReturn:        .asciz "\n"
szMessErreur:            .asciz "Error detected.\n"
szMessNbHash:            .asciz "Start hash number : @ \n"
szMessTest:              .asciz "Rosetta code"
.align 4
/* array constantes Hi */
tbConstHi:           .int 0x6A09E667       // H0
                     .int 0xBB67AE85       // H1
                     .int 0x3C6EF372       // H2
                     .int 0xA54FF53A       // H3
                     .int 0x510E527F       // H4
                     .int 0x9B05688C       // H5
                     .int 0x1F83D9AB       // H6
                     .int 0x5BE0CD19       // H7
/* array  64 constantes Kt */
tbConstKt:
  .int 0x428a2f98, 0x71374491, 0xb5c0fbcf, 0xe9b5dba5, 0x3956c25b, 0x59f111f1, 0x923f82a4, 0xab1c5ed5
  .int 0xd807aa98, 0x12835b01, 0x243185be, 0x550c7dc3, 0x72be5d74, 0x80deb1fe, 0x9bdc06a7, 0xc19bf174
  .int 0xe49b69c1, 0xefbe4786, 0x0fc19dc6, 0x240ca1cc, 0x2de92c6f, 0x4a7484aa, 0x5cb0a9dc, 0x76f988da
  .int 0x983e5152, 0xa831c66d, 0xb00327c8, 0xbf597fc7, 0xc6e00bf3, 0xd5a79147, 0x06ca6351, 0x14292967
  .int 0x27b70a85, 0x2e1b2138, 0x4d2c6dfc, 0x53380d13, 0x650a7354, 0x766a0abb, 0x81c2c92e, 0x92722c85
  .int 0xa2bfe8a1, 0xa81a664b, 0xc24b8b70, 0xc76c51a3, 0xd192e819, 0xd6990624, 0xf40e3585, 0x106aa070
  .int 0x19a4c116, 0x1e376c08, 0x2748774c, 0x34b0bcb5, 0x391c0cb3, 0x4ed8aa4a, 0x5b9cca4f, 0x682e6ff3
  .int 0x748f82ee, 0x78a5636f, 0x84c87814, 0x8cc70208, 0x90befffa, 0xa4506ceb, 0xbef9a3f7, 0xc67178f2
/***********************************/
/* UnInitialized data              */
/***********************************/
.bss
sBuffer:                     .skip BUFFERSIZE     // file buffer
.align 8
qNbBlocs:                    .skip 8
qNbHash:                     .skip 8
sZoneConv:                   .skip 24
sZoneTrav:                   .skip LGZONETRAV
HashResult:                  .skip LGHASH + 8
HashProcess:                 .skip LGHASH * 2
tbListHash:                  .skip LGHASH * NBELEMENTS
tbH:                         .skip 4 * 8         // 8 variables H
tbabcdefgh:                  .skip 4 * 8
tbW:                         .skip 4 * 64        // 64 words W

/***********************************/
/*  code section                   */
/***********************************/
.text
.global main
main:
    mov x0,AT_FDCWD                     // current directory
    ldr x1,qAdrszFileName               // File name
    mov x2,#O_RDWR                      //  flags
    mov x3,#0                           // mode
    mov x8,#OPEN                        // open file
    svc #0
    cmp x0,#0                           // error ?
    ble error
    mov x19,x0                          // save fd
    ldr x1,qAdrsBuffer
    mov x2,#BUFFERSIZE
    mov x8,#READ                        // call system read file
    svc 0
    cmp x0,#0                           // error read ?
    ble error
    mov x7,x0                           // number of read characters
    ldr x6,qAdrsBuffer
    mov x5,#0                           // counter characters block
1:
    add x0,x6,x5                        // start address of each block
    ldr x1,qAdrHashResult
    mov x2,#LGBLOCK
    bl computeSHA256LG
    bl storeHash                        // store hash in start array
    cmp x0,#-1
    beq error
    add x5,x5,#LGBLOCK                     // new buffer offset
    sub x0,x7,x5                        //
    cmp x0,#LGBLOCK                     // last block
    bge 1b                              // and loop
    sub x2,x7,x5                        // length last block
    add x0,x6,x5                        // address last block
    ldr x1,qAdrHashResult
    bl computeSHA256LG
    bl storeHash
    cmp x0,#-1
    beq error
    ldr x0,qAdrqNbHash
    ldr x0,[x0]
    ldr x1,qAdrsZoneConv
    bl conversion10
    ldr x0,qAdrszMessNbHash
    ldr x1,qAdrsZoneConv
    bl strInsertAtCharInc
    bl affichageMess

    ldr x0,qAdrtbListHash
    ldr x1,qAdrHashResult
    bl calculerMerkleRoot
    ldr x0,qAdrHashResult
    bl displaySHA256                   // display résult

end:
    mov x0,x19                          // FD
    mov x8, #CLOSE                      // call system close file
    svc #0
    cmp x0,#0
    blt error
    mov x0,#0                           // return code
    b 100f
error:
    ldr x0,qAdrszMessErreur             // error message
    bl   affichageMess
    mov x0,#1                           // return error code
100:                                    // standard end of the program
    mov x8, #EXIT                       // request to exit program
    svc 0                               // perform system call
qAdrsBuffer:               .quad sBuffer
qAdrszFileName:            .quad szFileName
qAdrszMessErreur:          .quad szMessErreur
qAdrszCarriageReturn:      .quad szCarriageReturn
qAdrHashResult:            .quad HashResult
qAdrszMessNbHash:          .quad szMessNbHash
qAdrszMessTest:            .quad szMessTest
/******************************************************************/
/*     store hash in start array                   */
/******************************************************************/
/* x0 hash address              */
storeHash:
    stp x1,lr,[sp,-16]!      // save  registers
    stp x2,x3,[sp,-16]!      // save  registers
    stp x4,x5,[sp,-16]!      // save  registers
    ldr x2,qAdrqNbHash           // number element counter
    ldr x3,[x2]
    ldr x1,qAdrtbListHash        // address array hash
    mov x4,#LGHASH               // hash length
    madd x5,x4,x3,x1              // compute store address
    mov x1,#0                    // counter
1:
    ldr w4,[x0,x1]               // load four bytes
    str w4,[x5,x1]               // store four bytes
    add x1,x1,#4
    cmp x1,#LGHASH               // 32 bytes ?
    blt 1b                       // no -> loop
    add x3,x3,#1
    cmp x3,#NBELEMENTS
    bge 99f                      // error
    str x3,[x2]                  // store new counter hash
    b 100f
99:
    mov x0,#-1                   // error ?
100:
    ldp x4,x5,[sp],16            // restaur  2 registers
    ldp x2,x3,[sp],16            // restaur  2 registers
    ldp x1,lr,[sp],16            // restaur  2 registers
    ret                          // return to address lr x30
qAdrqNbHash:    .quad qNbHash
qAdrtbListHash: .quad tbListHash
/******************************************************************/
/*     compute hash root Merkle                                   */
/******************************************************************/
// x0 start array hash address
// x1 result array address   (32 bytes)
calculerMerkleRoot:
    stp x1,lr,[sp,-16]!      // save  registers
    stp x2,x3,[sp,-16]!      // save  registers
    mov x10,x1
    mov x12,sp               // save stack adresse
    ldr x3,qAdrqNbHash
    ldr x3,[x3]
    cmp x3,#0                // 0 hash ?
    beq 99f                  // error
    mov x4,#LGHASH * 2
    mul x1,x3,x4             // compute hash size * blocks number * 2
    sub sp,sp,x1             // reserve array
    mov fp,sp                // address previousTreeLayer
    lsr x1,x1,#1                // reserve size / 2
    add x7,fp,x1             // address TreeLayer

    mov x2,#0                // counter
    mov x4,#LGHASH
1:
    mul x1,x2,x4
    add x6,x0,x1
    add x8,fp,x1
    mov x5,#0
2:                          // loop copying 32 octets hash
    ldr w9,[x6,x5]
    str w9,[x8,x5]
    add x5,x5,#4             // count
    cmp x5,#LGHASH
    blt 2b
    add x2,x2,#1                // next hash block
    cmp x2,x3                // maxi ?
    blt 1b
    mov x0,fp
    mov x11,#0               // indice TreeLayer
    mov x5,#0               // indice layer
3:                          // loop
    cmp x3,#1               // one hash ?
    beq 12f                 // yes -> end
    sub x3,x3,#1
    mov x4,#LGHASH
    madd x8,x11,x4,fp         // address hash 1
    mov x9,x7               // raz TreeLayer
4:
    cmp x11,x3
    bgt 11f                 // end loop ?
    blt 5f
    mov x0,x8               // last odd hash
    add x11,x11,#1            // no concatenation
    mov x1,#0
41:                         // but loop copy odd hash in treelayer
    ldr w4,[x0,x1]
    str w4,[x9,x1]
    add x1,x1,#4
    cmp x1,#LGHASH
    blt 41b
    b 9f
5:                          // other hashes
    add x6,x8,#LGHASH       // address hash  N + 1
6:
    add x11,x11,#1
    ldr x1,qAdrHashProcess  // address array hash concatenation
    mov x0,#0
7:                          // loop copy element N
    ldr w4,[x8,x0]
    rev w4,w4               // inversion byte in word
    str w4,[x1,x0]
    add x0,x0,#4
    cmp x0,#LGHASH
    blt 7b
    add x1,x1,#LGHASH
    mov x0,#0
8:                          // loop copy element N + 1
    ldr w4,[x6,x0]
    rev w4,w4               // inversion byte in word
    str w4,[x1,x0]
    add x0,x0,#4
    cmp x0,#LGHASH
    blt 8b
    ldr x0,qAdrHashProcess
    mov x1,x9
    mov x2,#LGHASH * 2
    bl computeSHA256LG        // calcul du hash complet
9:
    add x11,x11,#1         // incremente counter previousTreeLayer
    add x5,x5,#1           // incremente counter treeLayer
    add x9,x9,#LGHASH      // next address treeLayer
    add x8,x6,#LGHASH      // maj element N avec N + 2
    b 4b

11:
    mov x0,fp
    mov fp,x7             // treelayer in previous
    mov x7,x0
    mov x3,x5             // counter previous = counter treelayer
    mov x5,#0             // raz treelayer
    mov x11,#0            // raz previousTreeLayer
    b 3b                  // and loop

12:                       // end process
    mov x1,fp
    mov x2,#0
13:                       // loop copy result
    ldr w3,[x1,x2]
    str w3,[x10,x2]
    add x2,x2,#4
    cmp x2,#LGHASH
    blt 13b
    mov x0,x10            // return address result
    b 100f
99:                       // error
   mov x0,#-1

100:
    mov sp,x12            // restaur stack
    ldp x2,x3,[sp],16     // restaur  2 registers
    ldp x1,lr,[sp],16     // restaur  2 registers
    ret
qAdrHashProcess:     .quad HashProcess

/******************************************************************/
/*     compute SHA256  avec longueur                      */
/******************************************************************/
/* x0 contains the string address */
/* x1 contains the return area address */
/* x2 contains string length  */
computeSHA256LG:
    stp x1,lr,[sp,-16]!      // save  registers
    stp x2,x3,[sp,-16]!      // save  registers
    stp x4,x5,[sp,-16]!      // save  registers
    stp x6,x7,[sp,-16]!      // save  registers
    stp x8,x9,[sp,-16]!      // save  registers
    stp x10,x11,[sp,-16]!      // save  registers
    stp x12,x13,[sp,-16]!      // save  registers
    stp x19,x20,[sp,-16]!      // save  registers
    mov x19,x1
    ldr x1,qAdrtbH
    mov x3,0
1:                          // modif 12/11/2021  boucle raz des 3 zones
    str xzr,[x1,x3,lsl 3]
    add x3,x3,1
    cmp x3,4+4+32
    blt 1b

    ldr x1,qAdrsZoneTrav
    mov x3,0
2:                          // modif 12/11/2021  boucle raz zone de travail
    str xzr,[x1,x3,lsl 3]
    add x3,x3,1
    cmp x3,LGZONETRAV/8
    blt 2b
    mov x5,x2
    mov x2,#0                // counter length
debCopy:                     // copy string in work area
    ldrb w3,[x0,x2]
    strb w3,[x1,x2]
    cmp x2,x5               // modification 21/11/2021
    add x4,x2,1
    csel x2,x4,x2,ne
    bne debCopy
    //affmemtit copieSH x1 3
    //affregtit copie 0
    lsl x6,x2,#3             // initial message length in bits
    mov x3,#0b10000000       // add bit 1 at end of string
    strb w3,[x1,x2]
    //affmemtit copieSH1 x1 3
    add x2,x2,#1             // length in bytes
    lsl x4,x2,#3             // length in bits
    mov x3,#0
addZeroes:
    lsr x5,x2,#6
    lsl x5,x5,#6
    sub x5,x2,x5
    cmp x5,#56
    beq storeLength          // yes -> end add
    strb w3,[x1,x2]          // add zero at message end
    add x2,x2,#1              // increment lenght bytes
    add x4,x4,#8             // increment length in bits
    b addZeroes
storeLength:
    add x2,x2,#4             // add four bytes
    rev w6,w6                // inversion bits initials message length
    str w6,[x1,x2]           // and store at end

    ldr x7,qAdrtbConstHi     // constantes H address
    ldr x4,qAdrtbH           // start area H
    mov x5,#0
loopConst:                   // init array H with start constantes
    ldr w6,[x7,x5,lsl #2]    // load constante
    str w6,[x4,x5,lsl #2]    // and store
    add x5,x5,#1
    cmp x5,#8
    blt loopConst
                             // split into block of 64 bytes
    add x2,x2,#4                //
    lsr x4,x2,#6             // blocks number
    ldr x0,qAdrqNbBlocs
    str x4,[x0]              // save block maxi
    mov x7,#0                // n° de block et x1 contient l adresse zone de travail
loopBlock:                   // begin loop of each block of 64 bytes
    mov x0,x7
    bl inversion             // inversion each word because little indian
    ldr x3,qAdrtbW           // working area W address
    mov x6,#0                // indice t
                             /* x2  address begin each block */
    ldr x1,qAdrsZoneTrav
    add x2,x1,x7,lsl #6      //  compute block begin  indice * 4 * 16
    //mov x0,x2
    //affmemtit  verifBloc x0 10
loopPrep:                    // loop for expand 80 words
    cmp x6,#15               //
    bgt expand1
    ldr w0,[x2,x6,lsl #2]    // load word message
    str w0,[x3,x6,lsl #2]    // store in first 16 block
    b expandEnd

expand1:
    sub x8,x6,#2
    ldr w9,[x3,x8,lsl #2]
    ror w10,w9,#17           // fonction e1 (256)
    ror w11,w9,#19
    eor w10,w10,w11
    lsr w11,w9,#10
    eor w10,w10,w11
    sub x8,x6,#7
    ldr w9,[x3,x8,lsl #2]
    add w9,w9,w10            // + w - 7
    sub x8,x6,#15
    ldr w10,[x3,x8,lsl #2]
    ror w11,w10,#7          // fonction e0 (256)
    ror w12,w10,#18
    eor w11,w11,w12
    lsr w12,w10,#3
    eor w10,w11,w12
    add w9,w9,w10
    sub x8,x6,#16
    ldr w11,[x3,x8,lsl #2]
    add w9,w9,w11

    str w9,[x3,x6,lsl #2]
expandEnd:
    add x6,x6,#1
    cmp x6,#64                 // 64 words ?
    blt loopPrep               // and loop

    /* COMPUTING THE MESSAGE DIGEST */
    /* x1  area H constantes address */
    /* x3  working area W address  */
    /* x5  address constantes K   */
    /* x6  counter t */
    /* x7  block counter */
    /* x8  addresse variables a b c d e f g h  */
    //ldr x0,qAdrtbW
    //affmemtit  verifW80 x0 20
                               // init variable a b c d e f g h
    ldr x0,qAdrtbH
    //affmemtit  veriftbh x0 20
    ldr x8,qAdrtbabcdefgh
    mov x1,#0
loopInita:
    ldr w9,[x0,x1,lsl #2]
    str w9,[x8,x1,lsl #2]
    add x1,x1,#1
    cmp x1,#8
    blt loopInita

    ldr x1,qAdrtbConstHi
    ldr x5,qAdrtbConstKt
    mov x6,#0
loop64T:                      // begin loop 64 t
    ldr w9,[x8,#var_h]
    ldr w10,[x8,#var_e]       // calcul T1
    ror w11,w10,#6            // fonction sigma 1
    ror w12,w10,#11
    eor w11,w11,w12
    ror w12,w10,#25
    eor w11,w11,w12
    add w9,w9,w11             // h + sigma1 (e)
    ldr w0,[x8,#var_f]        //  fonction ch  x and y xor (non x and z)
    ldr w4,[x8,#var_g]
    and w11,w10,w0
    mvn w12,w10
    and w12,w12,w4
    eor w11,w11,w12
    add w9,w9,w11             // h + sigma1 (e) + ch (e,f,g)
    ldr w0,[x5,x6,lsl #2]     // load constantes k0
    add w9,w9,w0
    ldr w0,[x3,x6,lsl #2]     // Wt
    add w9,w9,w0
                              // calcul T2
    ldr w10,[x8,#var_a]       // fonction sigma 0
    ror w11,w10,#2
    ror w12,w10,#13
    eor w11,w11,w12
    ror w12,w10,#22
    eor w11,w11,w12
    ldr w2,[x8,#var_b]
    ldr w4,[x8,#var_c]
                              // fonction maj x and y xor x and z xor y and z
    and w12,w10,w2
    and w0,w10,w4
    eor w12,w12,w0
    and w0,w2,w4
    eor w12,w12,w0            //
    add w12,w12,w11           // T2
                              // compute variables
    ldr w4,[x8,#var_g]
    str w4,[x8,#var_h]
    ldr w4,[x8,#var_f]
    str w4,[x8,#var_g]
    ldr w4,[x8,#var_e]
    str w4,[x8,#var_f]
    ldr w4,[x8,#var_d]
    add w4,w4,w9              // add T1
    str w4,[x8,#var_e]
    ldr w4,[x8,#var_c]
    str w4,[x8,#var_d]
    ldr w4,[x8,#var_b]
    str w4,[x8,#var_c]
    ldr w4,[x8,#var_a]
    str w4,[x8,#var_b]
    add w4,w9,w12             // add T1 T2
    str w4,[x8,#var_a]

    add x6,x6,#1              // increment t
    cmp x6,#64
    blt loop64T
                              // End block
    ldr x0,qAdrtbH            // start area H
    mov x10,#0
loopStoreH:
    ldr w9,[x8,x10,lsl #2]
    ldr w3,[x0,x10,lsl #2]
    add w3,w3,w9
    str w3,[x0,x10,lsl #2]    // store variables in H0
    add x10,x10,#1
    cmp x10,#8
    blt loopStoreH
                              // other bloc
    add x7,x7,#1                 // increment block
    ldr x0,qAdrqNbBlocs
    ldr x4,[x0]               // restaur maxi block
    cmp x7,x4                 // maxi ?

    blt loopBlock             //  loop other block

    ldr x0,qAdrtbH            // adresse resultat
    //affmemtit resultat x0 3
    mov x3,0
loopRes:                        // boucle de copie du hash
    ldr w1,[x0,x3]              // dans zone de retour
    str w1,[x19,x3]
    add x3,x3,4
    cmp x3,28
    ble loopRes
    mov x0,x19

100:
    ldp x19,x20,[sp],16              // restaur  2 registers
    ldp x12,x13,[sp],16              // restaur  2 registers
    ldp x10,x11,[sp],16              // restaur  2 registers
    ldp x8,x9,[sp],16              // restaur  2 registers
    ldp x6,x7,[sp],16              // restaur  2 registers
    ldp x4,x5,[sp],16              // restaur  2 registers
    ldp x2,x3,[sp],16              // restaur  2 registers
    ldp x1,lr,[sp],16              // restaur  2 registers
    ret                            // return to address lr x30
qAdrsZoneTrav:            .quad sZoneTrav
qAdrtbConstHi:            .quad tbConstHi
qAdrtbConstKt:            .quad tbConstKt
qAdrtbH:                  .quad tbH
qAdrtbW:                  .quad tbW
qAdrtbabcdefgh:           .quad tbabcdefgh
qAdrqNbBlocs:             .quad qNbBlocs
/******************************************************************/
/*     inversion des mots de 32 bits d un bloc                    */
/******************************************************************/
/* x0 contains N° block   */
inversion:
    stp x1,lr,[sp,-16]!            // save  registers
    stp x2,x3,[sp,-16]!            // save  registers
    ldr x1,qAdrsZoneTrav
    add x1,x1,x0,lsl #6           // debut du bloc
    mov x2,#0
1:                                                  // start loop
    ldr w3,[x1,x2,lsl #2]
    rev w3,w3
    str w3,[x1,x2,lsl #2]
    add x2,x2,#1
    cmp x2,#16
    blt 1b
100:
    ldp x2,x3,[sp],16              // restaur  2 registers
    ldp x1,lr,[sp],16              // restaur  2 registers
    ret                            // return to address lr x30
/******************************************************************/
/*     display hash  SHA1                         */
/******************************************************************/
/* x0 contains the address of hash  */
/* x1 contains the address of recept zone */
conversionSHA256:
    stp x1,lr,[sp,-16]!            // save  registers
    stp x2,x3,[sp,-16]!            // save  registers
    mov x3,x0
    mov x2,#0
1:
    ldr w0,[x3,x2,lsl #2]          // load 4 bytes
    //rev x0,x0                    // reverse bytes
    bl conversion16_4W             // conversion hexa
    add x1,x1,8
    add x2,x2,#1
    cmp x2,#LGHASH / 4
    blt 1b                         // and loop

100:
    ldp x2,x3,[sp],16              // restaur  2 registers
    ldp x1,lr,[sp],16              // restaur  2 registers
    ret                            // return to address lr x30
/******************************************************************/
/*     display hash  SHA1                         */
/******************************************************************/
/* x0 contains the address of hash  */
displaySHA256:
    stp x1,lr,[sp,-16]!            // save  registers
    stp x2,x3,[sp,-16]!            // save  registers
    mov x3,x0
    mov x2,#0
1:
    ldr w0,[x3,x2,lsl #2]          // load 4 bytes
    //rev x0,x0                    // reverse bytes
    ldr x1,qAdrsZoneConv
    bl conversion16_4W             // conversion hexa
    ldr x0,qAdrsZoneConv
    bl affichageMess
    add x2,x2,#1
    cmp x2,#LGHASH / 4
    blt 1b                         // and loop
    ldr x0,qAdrszCarriageReturn
    bl affichageMess               // display message
100:
    ldp x2,x3,[sp],16              // restaur  2 registers
    ldp x1,lr,[sp],16              // restaur  2 registers
    ret                            // return to address lr x30
qAdrsZoneConv:            .quad sZoneConv
/******************************************************************/
/*     conversion  hexadecimal register 32 bits                   */
/******************************************************************/
/* x0 contains value and x1 address zone receptrice   */
conversion16_4W:
    stp x0,lr,[sp,-48]!        // save  registres
    stp x1,x2,[sp,32]          // save  registres
    stp x3,x4,[sp,16]          // save  registres
    mov x2,#28                 // start bit position
    mov x4,#0xF0000000         // mask
    mov x3,x0                  // save entry value
1:                             // start loop
    and x0,x3,x4               // value register and mask
    lsr x0,x0,x2               // right shift
    cmp x0,#10                 // >= 10 ?
    bge 2f                     // yes
    add x0,x0,#48              // no is digit
    b 3f
2:
    add x0,x0,#55              // else is a letter A-F
3:
    strb w0,[x1],#1            // load result  and + 1 in address
    lsr x4,x4,#4               // shift mask 4 bits left
    subs x2,x2,#4              // decrement counter 4 bits <= zero  ?
    bge 1b                     // no -> loop

100:                           // fin standard de la fonction
    ldp x3,x4,[sp,16]          // restaur des  2 registres
    ldp x1,x2,[sp,32]          // restaur des  2 registres
    ldp x0,lr,[sp],48          // restaur des  2 registres
    ret

/********************************************************/
/*        File Include fonctions                        */
/********************************************************/
/* for this file see task include a file in language AArch64 assembly */
.include "../includeARM64.inc"


import std.stdio, std.algorithm;

T a(T)(T answer) {
    writefln("  # Called function a(%s) -> %s", answer, answer);
    return answer;
}

T b(T)(T answer) {
    writefln("  # Called function b(%s) -> %s", answer, answer);
    return answer;
}

void main() {
    foreach (immutable x, immutable y;
             [false, true].cartesianProduct([false, true])) {
        writeln("\nCalculating: r1 = a(x) && b(y)");
        immutable r1 = a(x) && b(y);
        writeln("Calculating: r2 = a(x) || b(y)");
        immutable r2 = a(x) || b(y);
    }
}


program ShortCircuitEvaluation;

{$APPTYPE CONSOLE}

uses SysUtils;

function A(aValue: Boolean): Boolean;
begin
  Writeln('a');
  Result := aValue;
end;

function B(aValue: Boolean): Boolean;
begin
  Writeln('b');
  Result := aValue;
end;

var
  i, j: Boolean;
begin
  for i in [False, True] do
  begin
    for j in [False, True] do
    begin
      Writeln(Format('%s and %s = %s', [BoolToStr(i, True), BoolToStr(j, True), BoolToStr(A(i) and B(j), True)]));
      Writeln;
      Writeln(Format('%s or %s = %s', [BoolToStr(i, True), BoolToStr(j, True), BoolToStr(A(i) or B(j), True)]));
      Writeln;
    end;
  end;
end.


(ns example
  (:require [clojure.contrib.math :as math]))

(defn in-carpet? [x y]
  (loop [x x, y y]
    (cond
     (or (zero? x) (zero? y))              true
     (and (= 1 (mod x 3)) (= 1 (mod y 3))) false
     :else                                 (recur (quot x 3) (quot y 3)))))

(defn carpet [n]
  (apply str
         (interpose
	  \newline
	  (for [x (range (math/expt 3 n))]
	    (apply str
		   (for [y (range (math/expt 3 n))]
		     (if (in-carpet? x y) "*" " ")))))))

(println (carpet 3))


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

/* REMARK 1 : this program use routines in a include file
   see task Include a file language arm assembly
   for the routine affichageMess conversion10
   see at end of this program the instruction include */
/* for constantes see task include a file in arm assembly */
/************************************/
/* Constantes                       */
/************************************/
.include "../constantes.inc"
.equ READ,   3
.equ OPEN,   5

.equ O_RDWR,  0x0002             @ open for reading and writing

.equ BUFFERSIZE,         65535   @ file buffer
.equ LGBLOCK,            1024    @ block length

.equ LGHASH, 32                  @ hash length
.equ NBELEMENTS, 40              @ array size
.equ LGZONETRAV, 2048            @ process array size

/*******************************************/
/* Structures                               */
/********************************************/
/*  structure  variables hash compute */
    .struct  0
var_a:                     @ a
    .struct  var_a + 4
var_b:                     @ b
    .struct  var_b + 4
var_c:                     @ c
    .struct  var_c + 4
var_d:                     @ d
    .struct  var_d + 4
var_e:                     @ e
    .struct  var_e + 4
var_f:                     @ f
    .struct  var_f + 4
var_g:                     @ g
    .struct  var_g + 4
var_h:                     @ h
    .struct  var_h + 4
/* structure linkedlist*/
    .struct  0
@llist_next:                    @ next element
@    .struct  llist_next + 4
@llist_value:                   @ element value
@    .struct  llist_value + 4
@llist_fin:
/***********************************/
/* Initialized data                */
/***********************************/
.data
szFileName:              .asciz "title.png"
szCarriageReturn:        .asciz "\n"
szMessErreur:            .asciz "Error detected.\n"
szMessNbHash:            .asciz "Start hash number : @ \n"
.align 4
/* array constantes Hi */
tbConstHi:           .int 0x6A09E667       @ H0
                     .int 0xBB67AE85       @ H1
                     .int 0x3C6EF372       @ H2
                     .int 0xA54FF53A       @ H3
                     .int 0x510E527F       @ H4
                     .int 0x9B05688C       @ H5
                     .int 0x1F83D9AB       @ H6
                     .int 0x5BE0CD19       @ H7
/* array  64 constantes Kt */
tbConstKt:
  .int 0x428a2f98, 0x71374491, 0xb5c0fbcf, 0xe9b5dba5, 0x3956c25b, 0x59f111f1, 0x923f82a4, 0xab1c5ed5
  .int 0xd807aa98, 0x12835b01, 0x243185be, 0x550c7dc3, 0x72be5d74, 0x80deb1fe, 0x9bdc06a7, 0xc19bf174
  .int 0xe49b69c1, 0xefbe4786, 0x0fc19dc6, 0x240ca1cc, 0x2de92c6f, 0x4a7484aa, 0x5cb0a9dc, 0x76f988da
  .int 0x983e5152, 0xa831c66d, 0xb00327c8, 0xbf597fc7, 0xc6e00bf3, 0xd5a79147, 0x06ca6351, 0x14292967
  .int 0x27b70a85, 0x2e1b2138, 0x4d2c6dfc, 0x53380d13, 0x650a7354, 0x766a0abb, 0x81c2c92e, 0x92722c85
  .int 0xa2bfe8a1, 0xa81a664b, 0xc24b8b70, 0xc76c51a3, 0xd192e819, 0xd6990624, 0xf40e3585, 0x106aa070
  .int 0x19a4c116, 0x1e376c08, 0x2748774c, 0x34b0bcb5, 0x391c0cb3, 0x4ed8aa4a, 0x5b9cca4f, 0x682e6ff3
  .int 0x748f82ee, 0x78a5636f, 0x84c87814, 0x8cc70208, 0x90befffa, 0xa4506ceb, 0xbef9a3f7, 0xc67178f2
/***********************************/
/* UnInitialized data              */
/***********************************/
.bss
sBuffer:                     .skip BUFFERSIZE     @ file buffer
.align 4
iNbBlocs:                    .skip 4
iNbHash:                     .skip 4
sZoneConv:                   .skip 24
sZoneTrav:                   .skip LGZONETRAV
HashResult:                  .skip LGHASH + 4
HashProcess:                 .skip LGHASH * 2
.align 8
tbListHash:                  .skip LGHASH * NBELEMENTS
tbH:                         .skip 4 * 8         @ 8 variables H
tbabcdefgh:                  .skip 4 * 8
tbW:                         .skip 4 * 64        @ 64 words W

/***********************************/
/*  code section                   */
/***********************************/
.text
.global main
main:
    ldr r0,iAdrszFileName               @ File name
    mov r1,#O_RDWR                      @  flags
    mov r2,#0                           @ mode
    mov r7,#OPEN                        @ open file
    svc #0
    cmp r0,#0                           @ error ?
    ble error
    mov r12,r0                          @ save fd
    ldr r1,iAdrsBuffer
    mov r2,#BUFFERSIZE
    mov r7,#READ                        @ call system read file
    svc 0
    cmp r0,#0                           @ error read ?
    ble error
    mov r7,r0                           @ number of read characters
    ldr r6,iAdrsBuffer
    mov r5,#0                           @ counter characters block
1:
    add r0,r6,r5                        @ start address of each block
    mov r1,#LGBLOCK
    bl computeSHA256
    bl storeHash                        @ store hash in start array
    cmp r0,#-1
    beq error
    add r5,#LGBLOCK                     @ new buffer offset
    sub r0,r7,r5                        @
    cmp r0,#LGBLOCK                     @ last block
    bge 1b                              @ and loop
    sub r1,r7,r5                        @ length last block
    add r0,r6,r5                        @ address last block
    bl computeSHA256
    bl storeHash
    cmp r0,#-1
    beq error
    ldr r0,iAdriNbHash
    ldr r0,[r0]
    ldr r1,iAdrsZoneConv
    bl conversion10
    ldr r0,iAdrszMessNbHash
    ldr r1,iAdrsZoneConv
    bl strInsertAtCharInc
    bl affichageMess
    ldr r0,iAdrtbListHash
    ldr r1,iAdrHashResult

    bl calculerMerkleRoot
    ldr r0,iAdrHashResult
    bl displaySHA256                   @ display résult

end:
    mov r0,r12                          @ FD
    mov r7, #CLOSE                      @ call system close file
    svc #0
    cmp r0,#0
    blt error
    mov r0,#0                           @ return code
    b 100f
error:
    ldr r1,iAdrszMessErreur             @ error message
    bl   displayError
    mov r0,#1                           @ return error code
100:                                    @ standard end of the program
    mov r7, #EXIT                       @ request to exit program
    svc 0                               @ perform system call
iAdrsBuffer:               .int sBuffer
iAdrszFileName:            .int szFileName
iAdrszMessErreur:          .int szMessErreur
iAdrszCarriageReturn:      .int szCarriageReturn
iAdrHashResult:            .int HashResult
iAdrszMessNbHash:          .int szMessNbHash
/******************************************************************/
/*     store hash in start array                   */
/******************************************************************/
/* r0 hash address              */
storeHash:
    push {r1-r5,lr}
    ldr r2,iAdriNbHash           @ number element counter
    ldr r3,[r2]
    ldr r1,iAdrtbListHash        @ address array hash
    mov r4,#LGHASH               @ hash length
    mla r5,r4,r3,r1              @ compute store address
    mov r1,#0                    @ counter
1:
    ldr r4,[r0,r1]               @ load four bytes
    str r4,[r5,r1]               @ store four bytes
    add r1,#4
    cmp r1,#LGHASH               @ 32 bytes ?
    blt 1b                       @ no -> loop
    add r3,#1
    cmp r3,#NBELEMENTS
    movge r0,#-1                 @ error ?
    bge 100f
    str r3,[r2]                  @ store new counter hash

100:
    pop {r1-r5,lr}               @ restaur registers
    bx lr
iAdriNbHash:    .int iNbHash
iAdrtbListHash: .int tbListHash
/******************************************************************/
/*     compute hash root Merkle                                   */
/******************************************************************/
@ r0 start array hash address
@ r1 result array address   (32 bytes)
calculerMerkleRoot:
    push {r1-r12,lr}         @ save  registers
    mov r10,r1
    mov r12,sp               @ save stack adresse
    ldr r3,iAdriNbHash
    ldr r3,[r3]
    cmp r3,#0                @ 0 hash ?
    moveq r0,#-1             @ error
    beq 100f
    mov r4,#LGHASH * 2
    mul r1,r3,r4             @ compute hash size * blocks number * 2
    sub sp,sp,r1             @ reserve array
    mov fp,sp                @ address previousTreeLayer
    lsr r1,#1                @ reserve size / 2
    add r7,fp,r1             @ address TreeLayer

    mov r2,#0                @ counter
    mov r4,#LGHASH
1:
    mul r1,r2,r4
    add r6,r0,r1
    add r8,fp,r1
    mov r5,#0
2:                          @ loop copying 32 octets hash
    ldr r9,[r6,r5]
    str r9,[r8,r5]
    add r5,r5,#4             @ count
    cmp r5,#LGHASH
    blt 2b
    add r2,#1                @ next hash block
    cmp r2,r3                @ maxi ?
    blt 1b
    mov r0,fp
    mov r2,#0               @ indice TreeLayer
    mov r5,#0               @ indice layer
3:                          @ loop
    cmp r3,#1               @ one hash ?
    beq 12f                 @ yes -> end
    sub r3,#1
    mov r4,#LGHASH
    mla r8,r2,r4,fp         @ address hash 1
    mov r9,r7               @ raz TreeLayer
4:
    cmp r2,r3
    bgt 11f                 @ end loop ?
    blt 5f
    mov r0,r8               @ last odd hash
    add r2,#1               @ no concatenation
    b 9f
5:                          @ other hashes
    add r6,r8,#LGHASH       @ address hash  N + 1
6:
    add r2,#1
    ldr r1,iAdrHashProcess  @ address array hash concatenation
    mov r0,#0
7:                          @ loop copy element N
    ldr r4,[r8,r0]
    rev r4,r4               @ inversion byte in word
    str r4,[r1,r0]
    add r0,r0,#4
    cmp r0,#LGHASH
    blt 7b
    add r1,r1,#LGHASH
    mov r0,#0
8:                          @ loop copy element N + 1
    ldr r4,[r6,r0]
    rev r4,r4               @ inversion byte in word
    str r4,[r1,r0]
    add r0,r0,#4
    cmp r0,#LGHASH
    blt 8b

    ldr r0,iAdrHashProcess
    mov r1,#LGHASH * 2
    bl computeSHA256        @ calcul du hash complet

9:
    mov r1,#0
10:                         @ loop copy hash in treelayer
    ldr r4,[r0,r1]
    str r4,[r9,r1]
    add r1,r1,#4
    cmp r1,#LGHASH
    blt 10b

    mov r1,r9

    add r2,r2,#1           @ incremente counter previousTreeLayer
    add r5,r5,#1           @ incremente counter treeLayer
    add r9,#LGHASH         @ next address treeLayer
    add r8,r6,#LGHASH      @ maj element N avec N + 2
    b 4b

11:
    mov r0,fp
    mov fp,r7             @ treelayer in previous
    mov r7,r0
    mov r3,r5             @ counter previous = counter treelayer
    mov r5,#0             @ raz treelayer
    mov r2,#0             @ raz previousTreeLayer
    b 3b                  @ and loop

12:                       @ end process
    mov r1,fp
    mov r2,#0
13:                       @ loop copy result
    ldr r3,[r1,r2]
    str r3,[r10,r2]
    add r2,r2,#4
    cmp r2,#LGHASH
    blt 13b
    mov r0,r10            @ return address result
    b 100f
99:                       @ error
   mov r0,#-1

100:
    mov sp,r12            @ restaur stack
    pop {r1-r12,lr}       @ restaur registers
    bx lr                 @ return
iAdrHashProcess:     .int HashProcess
/******************************************************************/
/*     compute SHA1                         */
/******************************************************************/
/* r0 contains the address of the message */
/* r1 contains string length  */
computeSHA256:
    push {r1-r12,lr}         @ save  registres
    mov r5,r1                @ counter length
    ldr r1,iAdrtbH
    mov r3,#0
    mov r4,#0
razTB:
    str r4,[r1,r3]
    add r3,#4
    cmp r3,#8 + 8 + 64
    blt razTB
    ldr r1,iAdrsZoneTrav
    mov r3,#0
    mov r4,#0
razZone:
    str r4,[r1,r3]
    add r3,#4
    cmp r3,#LGZONETRAV
    blt razZone
    @vidregtit apresraz
    mov r2,#0
debCopy:                     @ copy string in work area
    ldrb r3,[r0,r2]
    strb r3,[r1,r2]
    cmp r2,r5
    addne r2,r2,#1
    bne debCopy
    @vidregtit aprescopie
    lsl r6,r2,#3             @ initial message length in bits
    mov r3,#0b10000000       @ add bit 1 at end of string
    strb r3,[r1,r2]
    add r2,r2,#1             @ length in bytes
    lsl r4,r2,#3             @ length in bits
    mov r3,#0
addZeroes:
    lsr r5,r2,#6
    lsl r5,r5,#6
    sub r5,r2,r5
    cmp r5,#56
    beq storeLength          @ yes -> end add
    strb r3,[r1,r2]          @ add zero at message end
    add r2,#1                @ increment lenght bytes
    add r4,#8                @ increment length in bits
    b addZeroes
storeLength:
    add r2,#4                @ add four bytes
    rev r6,r6                @ inversion bits initials message length
    str r6,[r1,r2]           @ and store at end

    ldr r7,iAdrtbConstHi     @ constantes H address
    ldr r4,iAdrtbH           @ start area H
    mov r5,#0
loopConst:                   @ init array H with start constantes
    ldr r6,[r7,r5,lsl #2]    @ load constante
    str r6,[r4,r5,lsl #2]    @ and store
    add r5,r5,#1
    cmp r5,#8
    blt loopConst
                             @ split into block of 64 bytes
    add r2,#4                @  TODO : à revoir
    lsr r4,r2,#6             @ blocks number
    ldr r0,iAdriNbBlocs
    str r4,[r0]              @ save block maxi
    mov r7,#0                @ n° de block et r1 contient l adresse zone de travail
loopBlock:                   @ begin loop of each block of 64 bytes
    mov r0,r7
    bl inversion             @ inversion each word because little indian
    ldr r3,iAdrtbW           @ working area W address
    mov r6,#0                @ indice t
                             /* r2  address begin each block */
    ldr r1,iAdrsZoneTrav
    add r2,r1,r7,lsl #6      @  compute block begin  indice * 4 * 16
    @vidregtit avantloop
    @mov r0,r2
    @vidmemtit  verifBloc r0 10
loopPrep:                    @ loop for expand 80 words
    cmp r6,#15               @
    bgt expand1
    ldr r0,[r2,r6,lsl #2]    @ load byte message
    str r0,[r3,r6,lsl #2]    @ store in first 16 block
    b expandEnd

expand1:
    sub r8,r6,#2
    ldr r9,[r3,r8,lsl #2]
    ror r10,r9,#17           @ fonction e1 (256)
    ror r11,r9,#19
    eor r10,r10,r11
    lsr r11,r9,#10
    eor r10,r10,r11
    sub r8,r6,#7
    ldr r9,[r3,r8,lsl #2]
    add r9,r9,r10            @ + w - 7
    sub r8,r6,#15
    ldr r10,[r3,r8,lsl #2]
    ror r11,r10,#7          @ fonction e0 (256)
    ror r12,r10,#18
    eor r11,r12
    lsr r12,r10,#3
    eor r10,r11,r12
    add r9,r9,r10
    sub r8,r6,#16
    ldr r11,[r3,r8,lsl #2]
    add r9,r9,r11

    str r9,[r3,r6,lsl #2]
expandEnd:
    add r6,r6,#1
    cmp r6,#64                 @ 64 words ?
    blt loopPrep               @ and loop

    /* COMPUTING THE MESSAGE DIGEST */
    /* r1  area H constantes address */
    /* r3  working area W address  */
    /* r5  address constantes K   */
    /* r6  counter t */
    /* r7  block counter */
    /* r8  addresse variables a b c d e f g h  */
    @ldr r0,iAdrtbW
    @vidmemtit  verifW80 r0 20
                               @ init variable a b c d e f g h
    ldr r0,iAdrtbH
    ldr r8,iAdrtbabcdefgh
    mov r1,#0
loopInita:
    ldr r9,[r0,r1,lsl #2]
    str r9,[r8,r1,lsl #2]
    add r1,r1,#1
    cmp r1,#8
    blt loopInita

    ldr r1,iAdrtbConstHi
    ldr r5,iAdrtbConstKt
    mov r6,#0
loop64T:                     @ begin loop 64 t
    ldr r9,[r8,#var_h]
    ldr r10,[r8,#var_e]      @ calcul T1
    ror r11,r10,#6           @ fonction sigma 1
    ror r12,r10,#11
    eor r11,r12
    ror r12,r10,#25
    eor r11,r12
    add r9,r9,r11             @ h + sigma1 (e)
    ldr r0,[r8,#var_f]        @  fonction ch  x and y xor (non x and z)
    ldr r4,[r8,#var_g]
    and r11,r10,r0
    mvn r12,r10
    and r12,r12,r4
    eor r11,r12
    add r9,r9,r11             @ h + sigma1 (e) + ch (e,f,g)
    ldr r0,[r5,r6,lsl #2]     @ load constantes k0
    add r9,r9,r0
    ldr r0,[r3,r6,lsl #2]     @ Wt
    add r9,r9,r0
                              @ calcul T2
    ldr r10,[r8,#var_a]       @ fonction sigma 0
    ror r11,r10,#2
    ror r12,r10,#13
    eor r11,r11,r12
    ror r12,r10,#22
    eor r11,r11,r12
    ldr r2,[r8,#var_b]
    ldr r4,[r8,#var_c]
                              @ fonction maj x and y xor x and z xor y and z
    and r12,r10,r2
    and r0,r10,r4
    eor r12,r12,r0
    and r0,r2,r4
    eor r12,r12,r0            @
    add r12,r12,r11           @ T2
                              @ compute variables
    ldr r4,[r8,#var_g]
    str r4,[r8,#var_h]
    ldr r4,[r8,#var_f]
    str r4,[r8,#var_g]
    ldr r4,[r8,#var_e]
    str r4,[r8,#var_f]
    ldr r4,[r8,#var_d]
    add r4,r4,r9              @ add T1
    str r4,[r8,#var_e]
    ldr r4,[r8,#var_c]
    str r4,[r8,#var_d]
    ldr r4,[r8,#var_b]
    str r4,[r8,#var_c]
    ldr r4,[r8,#var_a]
    str r4,[r8,#var_b]
    add r4,r9,r12             @ add T1 T2
    str r4,[r8,#var_a]
    mov r0,r8

    add r6,r6,#1              @ increment t
    cmp r6,#64
    blt loop64T
                              @ End block
    ldr r0,iAdrtbH            @ start area H
    mov r10,#0
loopStoreH:
    ldr r9,[r8,r10,lsl #2]
    ldr r3,[r0,r10,lsl #2]
    add r3,r9
    str r3,[r0,r10,lsl #2]    @ store variables in H0
    add r10,r10,#1
    cmp r10,#8
    blt loopStoreH
                              @ other bloc
    add r7,#1                 @ increment block
    ldr r0,iAdriNbBlocs
    ldr r4,[r0]               @ restaur maxi block
    cmp r7,r4                 @ maxi ?

    blt loopBlock             @  loop other block

    ldr r0,iAdrtbH            @ return result area H
100:
    pop {r1-r12,lr}           @ restaur registers
    bx lr                     @ return
iAdrtbConstHi:            .int tbConstHi
iAdrtbConstKt:            .int tbConstKt
iAdrtbH:                  .int tbH
iAdrtbW:                  .int tbW
iAdrtbabcdefgh:           .int tbabcdefgh
iAdriNbBlocs:             .int iNbBlocs
iAdrsZoneTrav:            .int sZoneTrav
/******************************************************************/
/*     inversion des mots de 32 bits d un bloc                    */
/******************************************************************/
/* r0 contains N° block   */
inversion:
    push {r1-r3,lr}            @ save registers
    ldr r1,iAdrsZoneTrav
    add r1,r0,lsl #6           @ debut du bloc
    mov r2,#0
1:                             @ start loop
    ldr r3,[r1,r2,lsl #2]
    rev r3,r3
    str r3,[r1,r2,lsl #2]
    add r2,r2,#1
    cmp r2,#16
    blt 1b
100:
    pop {r1-r3,lr}             @ restaur registres
    bx lr                      @return
/******************************************************************/
/*     display hash  SHA256                         */
/******************************************************************/
/* r0 contains the address of hash  */
displaySHA256:
    push {r1-r3,lr}                @ save  registres
    mov r3,r0
    mov r2,#0
1:
    ldr r0,[r3,r2,lsl #2]          @ load 4 bytes
    @rev r0,r0                      @ reverse bytes
    ldr r1,iAdrsZoneConv
    bl conversion16                @ conversion hexa
    mov r4,#0
    strb r4,[r1,r0]                @ 0 final
    ldr r0,iAdrsZoneConv
    bl affichageMess
    add r2,r2,#1
    cmp r2,#LGHASH / 4
    blt 1b                         @ and loop
    ldr r0,iAdrszCarriageReturn
    bl affichageMess               @ display message
100:
    pop {r1-r3,lr}                 @ restaur registers
    bx lr                          @ return
iAdrsZoneConv:           .int sZoneConv

/***************************************************/
/*      ROUTINES INCLUDE                           */
/***************************************************/
.include "../affichage.inc"


func a(v) {
    print(nameof(a), terminator: "")
    return v
}

func b(v) {
    print(nameof(b), terminator: "")
    return v
}

func testMe(i, j) {
    print("Testing a(\(i)) && b(\(j))")
    print("Trace: ", terminator: "")
    print("\nResult: \(a(i) && b(j))")

    print("Testing a(\(i)) || b(\(j))")
    print("Trace: ", terminator: "")
    print("\nResult: \(a(i) || b(j))")

    print()
}

testMe(false, false)
testMe(false, true)
testMe(true, false)
testMe(true, true)


def a(v) { println("a"); return v }
def b(v) { println("b"); return v }

def x := a(i) && b(j)
def y := b(i) || b(j)


import system'routines;
import extensions;

Func<bool, bool> a = (bool x){ console.writeLine:"a"; ^ x };

Func<bool, bool> b = (bool x){ console.writeLine:"b"; ^ x };

const bool[] boolValues = new bool[]{ false, true };

public program()
{
    boolValues.forEach:(bool i)
    {
        boolValues.forEach:(bool j)
        {
            console.printLine(i," and ",j," = ",a(i) && b(j));

            console.writeLine();
            console.printLine(i," or ",j," = ",a(i) || b(j));
            console.writeLine()
        }
    }
}


(defun print-carpet (order)
  (let ((size (expt 3 order)))
    (flet ((trinary (x) (format nil "~3,vR" order x))
           (ones (a b) (and (eql a #\1) (eql b #\1))))
      (loop for i below size do
        (fresh-line)
        (loop for j below size do
          (princ (if (some #'ones (trinary i) (trinary j))
                   " "
                   "#")))))))


def sierpinski_carpet(n)
  carpet = ["#"]
  n.times do
    carpet = carpet.map { |x| x + x + x } +
             carpet.map { |x| x + x.tr("#"," ") + x } +
             carpet.map { |x| x + x + x }
  end
  carpet
end

5.times{ |i| puts "\nN=#{i}"; sierpinski_carpet(i).each { |row| puts row } }


#include <glib.h>
#include <stdlib.h>
#include <stdio.h>
#include <string.h>

guchar* sha256_merkle_tree(FILE* in, size_t block_size) {
    gchar* buffer = g_malloc(block_size);
    GPtrArray* hashes = g_ptr_array_new_with_free_func(g_free);
    gssize digest_length = g_checksum_type_get_length(G_CHECKSUM_SHA256);
    GChecksum* checksum = g_checksum_new(G_CHECKSUM_SHA256);
    size_t bytes;
    while ((bytes = fread(buffer, 1, block_size, in)) > 0) {
        g_checksum_reset(checksum);
        g_checksum_update(checksum, (guchar*)buffer, bytes);
        gsize len = digest_length;
        guchar* digest = g_malloc(len);
        g_checksum_get_digest(checksum, digest, &len);
        g_ptr_array_add(hashes, digest);
    }
    g_free(buffer);
    guint hashes_length = hashes->len;
    if (hashes_length == 0) {
        g_ptr_array_free(hashes, TRUE);
        g_checksum_free(checksum);
        return NULL;
    }
    while (hashes_length > 1) {
        guint j = 0;
        for (guint i = 0; i < hashes_length; i += 2, ++j) {
            guchar* digest1 = g_ptr_array_index(hashes, i);
            guchar* digest_out = g_ptr_array_index(hashes, j);
            if (i + 1 < hashes_length) {
                guchar* digest2 = g_ptr_array_index(hashes, i + 1);
                g_checksum_reset(checksum);
                g_checksum_update(checksum, digest1, digest_length);
                g_checksum_update(checksum, digest2, digest_length);
                gsize len = digest_length;
                g_checksum_get_digest(checksum, digest_out, &len);
            } else {
                memcpy(digest_out, digest1, digest_length);
            }
        }
        hashes_length = j;
    }
    guchar* result = g_ptr_array_steal_index(hashes, 0);
    g_ptr_array_free(hashes, TRUE);
    g_checksum_free(checksum);
    return result;
}

int main(int argc, char** argv) {
    if (argc != 2) {
        fprintf(stderr, "usage: %s filename\n", argv[0]);
        return EXIT_FAILURE;
    }
    FILE* in = fopen(argv[1], "rb");
    if (in) {
        guchar* digest = sha256_merkle_tree(in, 1024);
        fclose(in);
        if (digest) {
            gssize length = g_checksum_type_get_length(G_CHECKSUM_SHA256);
            for (gssize i = 0; i < length; ++i)
                printf("%02x", digest[i]);
            printf("\n");
            g_free(digest);
        }
    } else {
        perror(argv[1]);
        return EXIT_FAILURE;
    }
    return EXIT_SUCCESS;
}


defmodule Short_circuit do
  defp a(bool) do
    IO.puts "a( #{bool} ) called"
    bool
  end

  defp b(bool) do
    IO.puts "b( #{bool} ) called"
    bool
  end

  def task do
    Enum.each([true, false], fn i ->
      Enum.each([true, false], fn j ->
        IO.puts "a( #{i} ) and b( #{j} ) is #{a(i) and b(j)}.\n"
        IO.puts "a( #{i} ) or b( #{j} ) is #{a(i)  or b(j)}.\n"
      end)
    end)
  end
end

Short_circuit.task


-module( short_circuit_evaluation ).

-export( [task/0] ).

task() ->
	[task_helper(X, Y) || X <- [true, false], Y <- [true, false]].

a( Boolean ) ->
	io:fwrite( " a ~p~n", [Boolean] ),
	Boolean.

b( Boolean ) ->
	io:fwrite( " b ~p~n", [Boolean] ),
	Boolean.

task_helper( Boolean1, Boolean2 ) ->
	io:fwrite( "~p andalso ~p~n", [Boolean1, Boolean2] ),
	io:fwrite( "=> ~p~n", [a(Boolean1) andalso b(Boolean2)] ),
	io:fwrite( "~p orelse ~p~n", [Boolean1, Boolean2] ),
	io:fwrite( "=> ~p~n", [a(Boolean1) orelse b(Boolean2)] ).


import std.stdio, std.string, std.algorithm, std.array;

auto sierpinskiCarpet(in int n) pure nothrow @safe {
    auto r = ["#"];
    foreach (immutable _; 0 .. n) {
        const p = r.map!q{a ~ a ~ a}.array;
        r = p ~ r.map!q{a ~ a.replace("#", " ") ~ a}.array ~ p;
    }
    return r.join('\n');
}

void main() {
    3.sierpinskiCarpet.writeln;
}


function InCarpet(x, y : Integer) : Boolean;
begin
   while (x<>0) and (y<>0) do begin
      if ((x mod 3)=1) and ((y mod 3)=1) then
         Exit(False);
      x := x div 3;
      y := y div 3;
   end;
   Result := True;
end;

procedure Carpet(n : Integer);
var
   i, j, p : Integer;
begin
   p := Round(IntPower(3, n));

   for i:=0 to p-1 do begin
      for j:=0 to p-1 do begin
         if InCarpet(i, j) then
            Print('#')
         else Print(' ');
      end;
      PrintLn('');
   end;
end;

Carpet(3);


#include <cstdlib>
#include <fstream>
#include <iomanip>
#include <iostream>
#include <sstream>
#include <vector>
#include <openssl/sha.h>

class sha256_exception : public std::exception {
public:
    const char* what() const noexcept override {
        return "SHA-256 error";
    }
};

class sha256 {
public:
    sha256() { reset(); }
    sha256(const sha256&) = delete;
    sha256& operator=(const sha256&) = delete;
    void reset() {
        if (SHA256_Init(&context_) == 0)
            throw sha256_exception();
    }
    void update(const void* data, size_t length) {
        if (SHA256_Update(&context_, data, length) == 0)
            throw sha256_exception();
    }
    std::vector<unsigned char> digest() {
        std::vector<unsigned char> digest(SHA256_DIGEST_LENGTH);
        if (SHA256_Final(digest.data(), &context_) == 0)
            throw sha256_exception();
        return digest;
    }
private:
    SHA256_CTX context_;
};

std::string digest_to_string(const std::vector<unsigned char>& digest) {
    std::ostringstream out;
    out << std::hex << std::setfill('0');
    for (size_t i = 0; i < digest.size(); ++i)
        out << std::setw(2) << static_cast<int>(digest[i]);
    return out.str();
}

std::vector<unsigned char> sha256_merkle_tree(std::istream& in, size_t block_size) {
    std::vector<std::vector<unsigned char>> hashes;
    std::vector<char> buffer(block_size);
    sha256 md;
    while (in) {
        in.read(buffer.data(), block_size);
        size_t bytes = in.gcount();
        if (bytes == 0)
            break;
        md.reset();
        md.update(buffer.data(), bytes);
        hashes.push_back(md.digest());
    }
    if (hashes.empty())
        return {};
    size_t length = hashes.size();
    while (length > 1) {
        size_t j = 0;
        for (size_t i = 0; i < length; i += 2, ++j) {
            auto& digest1 = hashes[i];
            auto& digest_out = hashes[j];
            if (i + 1 < length) {
                auto& digest2 = hashes[i + 1];
                md.reset();
                md.update(digest1.data(), digest1.size());
                md.update(digest2.data(), digest2.size());
                digest_out = md.digest();
            } else {
                digest_out = digest1;
            }
        }
        length = j;
    }
    return hashes[0];
}

int main(int argc, char** argv) {
    if (argc != 2) {
        std::cerr << "usage: " << argv[0] << " filename\n";
        return EXIT_FAILURE;
    }
    std::ifstream in(argv[1], std::ios::binary);
    if (!in) {
        std::cerr << "Cannot open file " << argv[1] << ".\n";
        return EXIT_FAILURE;
    }
    try {
        std::cout << digest_to_string(sha256_merkle_tree(in, 1024)) << '\n';
    } catch (const std::exception& ex) {
        std::cerr << ex.what() << "\n";
        return EXIT_FAILURE;
    }
    return EXIT_SUCCESS;
}


let a (x : bool) = printf "(a)"; x
let b (x : bool) = printf "(b)"; x

[for x in [true; false] do for y in [true; false] do yield (x, y)]
|> List.iter (fun (x, y) ->
    printfn "%b AND %b = %b" x y ((a x) && (b y))
    printfn "%b OR %b = %b" x y ((a x) || (b y)))


USING: combinators.short-circuit.smart io prettyprint ;
IN: rosetta-code.short-circuit

: a ( ? -- ? ) "(a)" write ;
: b ( ? -- ? ) "(b)" write ;

"f && f = " write { [ f a ] [ f b ] } && .
"f || f = " write { [ f a ] [ f b ] } || .
"f && t = " write { [ f a ] [ t b ] } && .
"f || t = " write { [ f a ] [ t b ] } || .
"t && f = " write { [ t a ] [ f b ] } && .
"t || f = " write { [ t a ] [ f b ] } || .
"t && t = " write { [ t a ] [ t b ] } && .
"t || t = " write { [ t a ] [ t b ] } || .


class Main
{
  static Bool a (Bool value)
  {
    echo ("in a")
    return value
  }

  static Bool b (Bool value)
  {
    echo ("in b")
    return value
  }

  public static Void main ()
  {
    [false,true].each |i|
    {
      [false,true].each |j|
      {
        Bool result := a(i) && b(j)
        echo ("a($i) && b($j): " + result)
        result = a(i) || b(j)
        echo ("a($i) || b($j): " + result)
      }
    }
  }
}


def inCarpet(var x, var y) {
    while (x > 0 && y > 0) {
        if (x %% 3 <=> 1 && y %% 3 <=> 1) {
            return false
        }
        x //= 3
        y //= 3
    }
    return true
}

def carpet(order) {
    for y in 0..!(3**order) {
        for x in 0..!(3**order) {
            print(inCarpet(x, y).pick("#", " "))
        }
        println()
    }
}


program SHA256_Merkle_tree;

{$APPTYPE CONSOLE}

uses
  System.SysUtils,
  System.Classes,
  DCPsha256;

function SHA256(const Input: TArray<Byte>; Len: Integer = -1): TArray<Byte>;
var
  Hasher: TDCP_sha256;
  l: Integer;
begin
  if Len < 0 then
    l := length(Input)
  else
    l := Len;

  Hasher := TDCP_sha256.Create(nil);
  try
    Hasher.Init;
    Hasher.Update(Input[0], l);
    SetLength(Result, Hasher.HashSize div 8);
    Hasher.final(Result[0]);
  finally
    Hasher.Free;
  end;
end;

function Merkle_tree(FileName: TFileName): string;
const
  blockSize = 1024;
var
  f: TMemoryStream;
  hashes: TArray<TArray<byte>>;
  bytesRead: Cardinal;
  buffer: TArray<byte>;
  i, index: Integer;
begin
  Result := '';
  if not FileExists(FileName) then
    exit;

  SetLength(buffer, blockSize);
  FillChar(buffer[0], blockSize, 0);
  f := TMemoryStream.Create;
  f.LoadFromFile(FileName);
  index := 0;
  repeat
    bytesRead := f.Read(buffer, blockSize);
    if 0 = bytesRead then
      Break;

    Insert(SHA256(buffer, bytesRead), hashes, index);
    inc(index);
  until false;
  f.Free;

  SetLength(buffer, 64);

  while Length(hashes) > 1 do
  begin
    var hashes2: TArray<TArray<byte>>;
    index := 0;
    i := 0;
    while i < length(hashes) do
    begin
      if i < length(hashes) - 1 then
      begin
        buffer := copy(hashes[i], 0, length(hashes[i]));
        buffer := concat(buffer, copy(hashes[i + 1], 0, length(hashes[i])));
        Insert(SHA256(buffer), hashes2, index);
        inc(index);
      end
      else
      begin
        Insert(hashes[i], hashes2, index);
        inc(index);
      end;
      inc(i, 2);
    end;
    hashes := hashes2;
  end;

  Result := '';
  for var b in hashes[0] do
  begin
    Result := Result + b.ToHexString(2);
  end;
end;

begin
  writeln(Merkle_tree('title.png'));
  readln;
end.


\ Short-circuit evaluation definitions from Wil Baden, with minor name changes
:  ENDIF  postpone THEN ; immediate

:   COND  0 ; immediate
: ENDIFS  BEGIN DUP WHILE postpone ENDIF REPEAT DROP ; immediate
: ORELSE  s" ?DUP 0= IF"  evaluate ; immediate
:  ANDIF  s" DUP IF DROP" evaluate ; immediate

: .bool IF ." true  " ELSE ." false " THEN ;
: A  ." A=" DUP .bool ;
: B  ." B=" DUP .bool ;

: test
  CR
  1 -1 DO 1 -1 DO
    COND I A ANDIF  J B ENDIFS ." ANDIF="  .bool CR
    COND I A ORELSE J B ENDIFS ." ORELSE=" .bool CR
  LOOP LOOP ;

\ An alternative based on explicitly short-circuiting conditionals, Dave Keenan
: END-PRIOR-IF  1 CS-ROLL postpone ENDIF ; immediate

: test
  CR
  1 -1 DO 1 -1 DO
    I A    IF J B IF 1 ELSE END-PRIOR-IF 0 ENDIF ." ANDIF="  .bool CR
    I A 0= IF J B IF END-PRIOR-IF 1 ELSE 0 ENDIF ." ORELSE=" .bool CR
  LOOP LOOP ;


program Short_Circuit_Eval
  implicit none

  logical :: x, y
  logical, dimension(2) :: l = (/ .false., .true. /)
  integer :: i, j

  do i = 1, 2
    do j = 1, 2
      write(*, "(a,l1,a,l1,a)") "Calculating x = a(", l(i), ") and b(", l(j), ")"
      ! a AND b
      x = a(l(i))
      if(x) then
        x = b(l(j))
        write(*, "(a,l1)") "x = ", x
      else
        write(*, "(a,l1)") "x = ", x
      end if

      write(*,*)
      write(*, "(a,l1,a,l1,a)") "Calculating y = a(", l(i), ") or b(", l(j), ")"
      ! a OR b
      y = a(l(i))
      if(y) then
        write(*, "(a,l1)") "y = ", y
      else
        y = b(l(j))
        write(*, "(a,l1)") "y = ", y
      end if
      write(*,*)
    end do
  end do

contains

function a(value)
  logical :: a
  logical, intent(in) :: value

  a = value
  write(*, "(a,l1,a)") "Called function a(", value, ")"
end function

function b(value)
  logical :: b
  logical, intent(in) :: value

  b = value
  write(*, "(a,l1,a)") "Called function b(", value, ")"
end function
end program


defmodule RC do
  def sierpinski_carpet(n), do: sierpinski_carpet(n, ["#"])

  def sierpinski_carpet(0, carpet), do: carpet
  def sierpinski_carpet(n, carpet) do
    new_carpet = Enum.map(carpet, fn x -> x <> x <> x end) ++
                 Enum.map(carpet, fn x -> x <> String.replace(x, "#", " ") <> x end) ++
                 Enum.map(carpet, fn x -> x <> x <> x end)
    sierpinski_carpet(n-1, new_carpet)
  end
end

Enum.each(0..3, fn n ->
  IO.puts "\nN=#{n}"
  Enum.each(RC.sierpinski_carpet(n), fn line -> IO.puts line end)
end)


% Implemented by Arjun Sunel
-module(carpet).
-export([main/0]).

main() ->
	sierpinski_carpet(3).

sierpinski_carpet(N) ->
	lists: foreach(fun(X) -> lists: foreach(fun(Y) -> carpet(X,Y) end,lists:seq(0,trunc(math:pow(3,N))-1)), io:format("\n") end, lists:seq(0,trunc(math:pow(3,N))-1)).

carpet(X,Y) ->
	if
		X=:=0 ; Y=:=0 ->
			io:format("*");
		(X rem 3)=:=1, (Y rem 3) =:=1 ->
			io:format(" ");
		true ->
			carpet(X div 3, Y div 3)
	end.


USING: checksums checksums.sha fry grouping io
io.encodings.binary io.files kernel make math math.parser
namespaces sequences ;

: each-block ( ... size quot: ( ... block -- ... ) -- ... )
    input-stream get spin (each-stream-block) ; inline

: >sha-256 ( seq -- newseq ) sha-256 checksum-bytes ;

: (hash-read) ( path encoding chunk-size -- )
    '[ _ [ >sha-256 , ] each-block ] with-file-reader ;

! Read a file in chunks as a sequence of sha-256 hashes, so as
! not to store a potentially large file in memory all at once.

: hash-read ( path chunk-size -- seq )
    binary swap [ (hash-read) ] { } make ;

: hash-combine ( seq -- newseq )
    2 <groups>
    [ dup length 1 > [ concat >sha-256 ] [ first ] if ] map ;

: merkle-hash ( path chunk-size -- str )
    hash-read [ dup length 1 = ] [ hash-combine ] until first
    bytes>hex-string ;

"title.png" 1024 merkle-hash print


package main

import (
    "crypto/sha256"
    "fmt"
    "io"
    "log"
    "os"
)

func main() {
    const blockSize = 1024
    f, err := os.Open("title.png")
    if err != nil {
        log.Fatal(err)
    }
    defer f.Close()

    var hashes [][]byte
    buffer := make([]byte, blockSize)
    h := sha256.New()
    for {
        bytesRead, err := f.Read(buffer)
        if err != nil {
            if err != io.EOF {
                log.Fatal(err)
            }
            break
        }
        h.Reset()
        h.Write(buffer[:bytesRead])
        hashes = append(hashes, h.Sum(nil))
    }
    buffer = make([]byte, 64)
    for len(hashes) > 1 {
        var hashes2 [][]byte
        for i := 0; i < len(hashes); i += 2 {
            if i < len(hashes)-1 {
                copy(buffer, hashes[i])
                copy(buffer[32:], hashes[i+1])
                h.Reset()
                h.Write(buffer)
                hashes2 = append(hashes2, h.Sum(nil))
            } else {
                hashes2 = append(hashes2, hashes[i])
            }
        }
        hashes = hashes2
    }
    fmt.Printf("%x", hashes[0])
    fmt.Println()
}


{-# LANGUAGE BangPatterns, LambdaCase #-}

import Control.Monad (mfilter)
import Crypto.Hash.SHA256 (hash)
import qualified Data.ByteString as B
import Data.ByteString.Builder (byteStringHex, char7, hPutBuilder)
import Data.Functor ((<&>))
import Data.Maybe (listToMaybe)
import Data.Strict.Tuple (Pair(..))
import qualified Data.Strict.Tuple as T
import System.Environment (getArgs)
import System.IO (Handle, stdin, stdout)
import System.IO.Streams (InputStream)
import qualified System.IO.Streams as S
import Text.Read (readMaybe)

type Node a    = Pair Int a
type LevelPred = Int -> Int -> Bool
type Combine a = a -> a -> a

-- From a stream of nodes construct the root of a tree from the bottom up.  For
-- each level of the tree pairs of nodes are combined to form a parent node one
-- level higher.  Use a stack to store nodes waiting to be combined with another
-- node on their level.  (An exception to this is at the end of processing,
-- where all the nodes on the stack can be combined.)
build :: Combine a -> [Node a] -> InputStream (Node a) -> IO (Maybe (Node a))
build combine !stack is = S.read is >>= \case
  Nothing -> return $ listToMaybe $ reduce always combine stack
  Just h  -> build combine (reduce (==) combine (h:stack)) is

-- Given a predicate, combining function and a stack, then as long as the
-- predicate is true, repeatedly replace the two top values on the stack with
-- their combined values.
reduce :: LevelPred -> Combine a -> [Node a] -> [Node a]
reduce prd combine (x@(i :!: _):y@(j :!: _):zs)
  | prd i j = reduce prd combine (nodeLift combine y x : zs)
reduce _ _ zs = zs

-- Apply a combining function to the values in two nodes while calculating the
-- appropriate level for the new node.
nodeLift :: Combine a -> Node a -> Node a -> Node a
nodeLift f (i :!: x) (j :!: y) = max i j + 1 :!: f x y

always :: a -> b -> Bool
always _ _ = True

-- Build a SHA256-based Merkle tree using bytes read from a handle, and hashing
-- the data using the given chunk size.
merkleTreeSha256 :: Int -> Handle -> IO (Maybe B.ByteString)
merkleTreeSha256 sz h = mkHash <&> fmap T.snd
  where mkHash = S.makeInputStream getBuf >>=
                 S.map (\bs -> 0 :!: hash bs) >>=
                 build (\x y -> hash (x `B.append` y)) []
        getBuf = B.hGet h sz <&> (mfilter (/= B.empty) . Just)

-- Print a ByteString in hex.
printByteStringHex :: B.ByteString -> IO ()
printByteStringHex = hPutBuilder stdout . (<> char7 '\n') . byteStringHex

main :: IO ()
main = getArgs <&> map readMaybe >>= \case
  [Just sz] -> merkleTreeSha256 sz stdin >>= \case
                 Nothing -> putStrLn "No input to hash"
                 Just h  -> printByteStringHex h
  _         -> putStrLn "Argument usage: chunk-size"


' FB 1.05.0 Win64

Function a(p As Boolean) As Boolean
  Print "a() called"
  Return p
End Function

Function b(p As Boolean) As Boolean
  Print "b() called"
  Return p
End Function

Dim As Boolean i, j, x, y
i = False
j = True
Print "Without short-circuit evaluation :"
Print
x = a(i) And b(j)
y = a(i) Or b(j)
Print "x = "; x; " y = "; y
Print
Print "With short-circuit evaluation :"
Print
x = a(i) AndAlso b(j) '' b(j) not called as a(i) = false and so x must be false
y = a(i) OrElse b(j)  '' b(j) still called as can't determine y unless it is
Print "x = "; x; " y = "; y
Print
Print "Press any key to quit"
Sleep


package main

import "fmt"

func a(v bool) bool {
    fmt.Print("a")
    return v
}

func b(v bool) bool {
    fmt.Print("b")
    return v
}

func test(i, j bool) {
    fmt.Printf("Testing a(%t) && b(%t)\n", i, j)
    fmt.Print("Trace:  ")
    fmt.Println("\nResult:", a(i) && b(j))

    fmt.Printf("Testing a(%t) || b(%t)\n", i, j)
    fmt.Print("Trace:  ")
    fmt.Println("\nResult:", a(i) || b(j))

    fmt.Println("")
}

func main() {
    test(false, false)
    test(false, true)
    test(true, false)
    test(true, true)
}


PROGRAM SIERP_CARPET

! for rosettacode.org

!$INTEGER

BEGIN
 OPEN("O",1,"OUT.PRN")
 PRINT(CHR$(12);) !CLS
 DEPTH=3
 DIMM=1

 FOR I=0 TO DEPTH-1 DO
   DIMM=DIMM*3
 END FOR

 FOR I=0 TO DIMM-1 DO
   FOR J=0 TO DIMM-1 DO
     D=DIMM DIV 3
     REPEAT
        EXIT IF ((I MOD (D*3)) DIV D=1 AND (J MOD (D*3)) DIV D=1)
        D=D DIV 3
     UNTIL NOT(D>0)
     IF D>0 THEN PRINT(#1,"  ";)  ELSE PRINT(#1,"##";) END IF
   END FOR
   PRINT(#1,)
 END FOR
 ! PRINT(#1,CHR$(12);) for printer only!
 CLOSE(1)
END PROGRAM


include std/math.e

integer order = 4

function InCarpet(atom x, atom y)
	while 1 do
		if x = 0 or y = 0 then
			return 1
		elsif floor(mod(x,3)) = 1 and floor(mod(y,3)) = 1 then
			return 0
		end if
		x /= 3
		y /= 3
	end while
end function

for i = 0 to power(3,order)-1 do
	for j = 0 to power(3,order)-1 do
		if InCarpet(i,j) = 1 then
			puts(1,"#")
		else
			puts(1," ")
		end if
	end for
	puts(1,'\n')
end for


import java.io.*;
import java.security.*;
import java.util.*;

public class SHA256MerkleTree {
    public static void main(String[] args) {
        if (args.length != 1) {
            System.err.println("missing file argument");
            System.exit(1);
        }
        try (InputStream in = new BufferedInputStream(new FileInputStream(args[0]))) {
            byte[] digest = sha256MerkleTree(in, 1024);
            if (digest != null)
                System.out.println(digestToString(digest));
        } catch (Exception e) {
            e.printStackTrace();
        }
    }

    private static String digestToString(byte[] digest) {
        StringBuilder result = new StringBuilder();
        for (int i = 0; i < digest.length; ++i)
            result.append(String.format("%02x", digest[i]));
        return result.toString();
    }

    private static byte[] sha256MerkleTree(InputStream in, int blockSize) throws Exception {
        byte[] buffer = new byte[blockSize];
        int bytes;
        MessageDigest md = MessageDigest.getInstance("SHA-256");
        List<byte[]> digests = new ArrayList<>();
        while ((bytes = in.read(buffer)) > 0) {
            md.reset();
            md.update(buffer, 0, bytes);
            digests.add(md.digest());
        }
        int length = digests.size();
        if (length == 0)
            return null;
        while (length > 1) {
            int j = 0;
            for (int i = 0; i < length; i += 2, ++j) {
                byte[] digest1 = digests.get(i);
                if (i + 1 < length) {
                    byte[] digest2 = digests.get(i + 1);
                    md.reset();
                    md.update(digest1);
                    md.update(digest2);
                    digests.set(j, md.digest());
                } else {
                    digests.set(j, digest1);
                }
            }
            length = j;
        }
        return digests.get(0);
    }
}


def f = { println '  AHA!'; it instanceof String }
def g = { printf ('%5d ', it); it > 50 }

println 'bitwise'
assert g(100) & f('sss')
assert g(2) | f('sss')
assert ! (g(1) & f('sss'))
assert g(200) | f('sss')

println '''
logical'''
assert g(100) && f('sss')
assert g(2) || f('sss')
assert ! (g(1) && f('sss'))
assert g(200) || f('sss')


SHOWBLOCKS
=LAMBDA(xs,
    IF(0 <> xs, "█", " ")
)

SIERPCARPET
=LAMBDA(n,
    APPLYN(n)(
        SIERPWEAVE
    )(1)
)

SIERPWEAVE
=LAMBDA(xs,
    LET(
        triple, REPLICATECOLS(3)(xs),
        gap, LAMBDA(x, IF(x, 0, 0))(xs),
        middle, APPENDCOLS(
            APPENDCOLS(xs)(gap)
        )(xs),

        APPENDROWS(
            APPENDROWS(triple)(middle)
        )(triple)
    )
)


open System

let blank x = new String(' ', String.length x)

let nextCarpet carpet =
  List.map (fun x -> x + x + x) carpet @
  List.map (fun x -> x + (blank x) + x) carpet @
  List.map (fun x -> x + x + x) carpet

let rec sierpinskiCarpet n =
  let rec aux n carpet =
    if n = 0 then carpet
             else aux (n-1) (nextCarpet carpet)
  aux n ["#"]

List.iter (printfn "%s") (sierpinskiCarpet 3)


using SHA

function merkletree(filename="title.png", blocksize=1024)
    bytes = codeunits(read(filename, String))
    len = length(bytes)
    hsh = [sha256(view(bytes. i:min(i+blocksize-1, len)])) for i in 1:1024:len]
    len = length(hsh)
    while len > 1
        hsh = [i == len ? hsh[i] : sha256(vcat(hsh[i], hsh[i + 1])) for i in 1:2:len]
        len = length(hsh)
    end
    return bytes2hex(hsh[1])
end

println(merkletree())


import nimcrypto

const BlockSize = 1024

var hashes: seq[MDigest[256]]

let f = open("title.png")
var buffer: array[BlockSize, byte]
while true:
  let n = f.readBytes(buffer, 0, BlockSize)
  if n == 0: break
  hashes.add sha256.digest(buffer[0].addr, n.uint)
f.close()

var ctx: sha256
while hashes.len != 1:
  var newHashes: seq[MDigest[256]]
  for i in countup(0, hashes.high, 2):
    if i < hashes.high:
      ctx.init()
      ctx.update(hashes[i].data)
      ctx.update(hashes[i + 1].data)
      newHashes.add ctx.finish()
      ctx.clear()
    else:
      newHashes.add hashes[i]
  hashes= newHashes

echo hashes[0]


program SHA256_Merkle_tree;
{$IFDEF WINDOWS}
  {$APPTYPE CONSOLE}
{$ENDIF}
{$IFDEF DELPHI}
uses
  System.SysUtils,
  System.Classes,
  DCPsha256;
type
  TmyByte = TArray<Byte>;
  TmyHashes = TArray<TArray<byte>>;
{$ENDIF}
{$IFDEF FPC}
  {$Mode DELPHI}
uses
  SysUtils,
  Classes,
  DCPsha256;
type
  TmyByte = array of byte;
  TmyHashes = array of TmyByte;
{$ENDIF}

function SHA256(const Input: TmyByte; Len: Integer = -1): TmyByte;
var
  Hasher: TDCP_sha256;
  l: Integer;
begin
  if Len < 0 then
    l := length(Input)
  else
    l := Len;
  Hasher := TDCP_sha256.Create(nil);
  try
    Hasher.Init;
    Hasher.Update(Input[0], l);
    SetLength(Result, Hasher.HashSize div 8);
    Hasher.final(Result[0]);
  finally
    Hasher.Free;
  end;
end;

function Merkle_tree(FileName: TFileName): string;
const
  blockSize = 1024;
var
  f: TMemoryStream;
  hashes,
  hashes2: TmyHashes;
  bytesRead: Cardinal;
  buffer: TmyByte;
  i, index: Integer;
  b: byte;
begin
  Result := '';
  if not FileExists(FileName) then
    exit;

  SetLength(buffer, blockSize);
  FillChar(buffer[0], blockSize, #0);
  f := TMemoryStream.Create;
  f.LoadFromFile(FileName);
  index := 0;
  repeat
    //freepascal needs buffer[0] instead buffer
    bytesRead := f.Read(buffer[0], blockSize);
    if bytesRead= 0 then
      BREAK;
    Insert(SHA256(buffer, bytesRead), hashes, index);
    inc(index);
  until bytesRead<blockSize;
  f.Free;

  SetLength(buffer, 64);
  while Length(hashes) > 1 do
  begin
    //first clear old hashes2
    setlength(hashes2,0);
    index := 0;
    i := 0;
    while i < length(hashes) do
    begin
      if i < length(hashes) - 1 then
      begin
        buffer := copy(hashes[i], 0, length(hashes[i]));
        buffer := concat(buffer,copy(hashes[i + 1], 0, length(hashes[i])));
        Insert(SHA256(buffer), hashes2, index);
        inc(index);
      end
      else
      begin
        Insert(hashes[i], hashes2, index);
        inc(index);
      end;
      inc(i, 2);
    end;
    hashes := hashes2;
  end;

  Result := '';
  for b in hashes[0] do
  begin
    Result := Result + b.ToHexString(2);
  end;
end;

begin
  writeln(Merkle_tree('title.png'));
{$IFDEF WINDOWS}
  readln;
{$ENDIF}
end.


module ShortCircuit where

import Prelude hiding ((&&), (||))
import Debug.Trace

False && _     = False
True  && False = False
_     && _     = True

True  || _     = True
False || True  = True
_     || _     = False

a p = trace ("<a " ++ show p ++ ">") p
b p = trace ("<b " ++ show p ++ ">") p

main = mapM_ print (    [ a p || b q | p <- [False, True], q <- [False, True] ]
                     ++ [ a p && b q | p <- [False, True], q <- [False, True] ])


procedure main()
&trace := -1 # ensures functions print their names

every (i := false | true ) & ( j := false | true) do {
  write("i,j := ",image(i),", ",image(j))
  write("i & j:")
  x := i() & j()   # invoke true/false
  write("i | j:")
  y := i() | j()   # invoke true/false
  }
end

procedure true()   #: succeeds always (returning null)
return
end

procedure false()  #: fails always
fail    # for clarity but not needed as running into end has the same effect
end


USING: kernel math math.matrices prettyprint ;

: sierpinski ( n -- )
    1 - { { 1 1 1 } { 1 0 1 } { 1 1 1 } } swap over [ kron ]
    curry times [ 1 = "#" " " ? ] matrix-map simple-table. ;

3 sierpinski


**
** Generates a square Sierpinski gasket
**
class SierpinskiCarpet
{
  public static Bool inCarpet(Int x, Int y){
    while(x!=0 && y!=0){
      if (x % 3 == 1 && y % 3 == 1)
        return false;
      x /= 3;
      y /= 3;
    }
    return true;
  }

  static Int pow(Int n, Int exp)
  {
    rslt := 1
    exp.times { rslt *= n }
    return rslt
  }

  public static Void carpet(Int n){
    for(i := 0; i < pow(3, n); i++){
      buf := StrBuf()
      for(j := 0; j < pow(3, n); j++){
        if( inCarpet(i, j))
          buf.add("*");
        else
          buf.add(" ");
      }
      echo(buf);
    }
  }

  Void main()
  {
    carpet(4)
  }
}


(fn in-carpet? [x y]
  (if
    (or (= 0 x) (= 0 y)) true
    (and (= 1 (% x 3)) (= 1 (% y 3))) false
    (in-carpet? (// x 3) (// y 3))))

(fn make-carpet [size]
  (for [y 0 (- (^ 3 size) 1)]
    (for [x 0 (- (^ 3 size) 1)]
      (if (in-carpet? x y)
        (io.write "#")
        (io.write " ")))
    (io.write "\n")))

(for [i 0 3]
  (make-carpet i)
  (print))


# 20210222 Perl programming solution

use strict;
use warnings;

use Crypt::Digest::SHA256 'sha256' ;

my @blocks;

open my $fh, '<:raw', './title.png';

while ( read $fh, my $chunk, 1024 ) { push @blocks, sha256 $chunk }

while ( scalar @blocks > 1 ) {
   my @clone = @blocks and @blocks = ();
   while ( @_ = splice @clone, 0, 2 ) {
      push @blocks, scalar @_ == 1 ? $_[0] : sha256 $_[0].$_[1]
   }
}

print unpack ( 'H*', $blocks[0] ) , "\n";


without javascript_semantics
include builtins\libcurl.e
include builtins\sha256.e

constant ONE_MB = 1024 * 1024

function merkle(string filename, url, integer block_size=ONE_MB)
    if not file_exists(filename) then
        printf(1,"Downloading %s...\n",{filename})
        CURLcode res = curl_easy_get_file(url,"",filename) -- (no proxy)
        if res!=CURLE_OK then
            string error = sprintf("%d",res)
            if res=CURLE_COULDNT_RESOLVE_HOST then
                error &= " [CURLE_COULDNT_RESOLVE_HOST]"
            end if
            crash("Error %s downloading file\n", {error})
        end if
    end if
    string data = get_text(filename)
    sequence blocks = {}
    for i=1 to length(data) by block_size do
        blocks = append(blocks,sha256(data[i..min(i+block_size-1,length(data))]))
    end for
    while length(blocks)>1 do
        integer l = 0
        for i=1 to length(blocks) by 2 do
            l += 1
            blocks[l] = iff(i<length(blocks)?sha256(blocks[i]&blocks[i+1])
                                            :blocks[i])
        end for
        blocks = blocks[1..l]
    end while
    return blocks[1]
end function

function asHex(string s)
string res = ""
    for i=1 to length(s) do
        res &= sprintf("%02X",s[i])
    end for
    return res
end function

printf(1,"%s\n",asHex(merkle("title.png", "https://rosettacode.org/mw/title.png", 1024)))


a := method(bool,
    writeln("a(#{bool}) called." interpolate)
    bool
)
b := method(bool,
    writeln("b(#{bool}) called." interpolate)
    bool
)

list(true,false) foreach(avalue,
    list(true,false) foreach(bvalue,
        x := a(avalue) and b(bvalue)
        writeln("x = a(#{avalue}) and b(#{bvalue}) is #{x}" interpolate)
        writeln
        y := a(avalue) or b(bvalue)
        writeln("y = a(#{avalue}) or b(#{bvalue}) is #{y}" interpolate)
        writeln
    )
)


labeled=:1 :'[ [email protected],&":~&m'
A=: 'A ' labeled
B=: 'B ' labeled
and=: ^:
or=: 2 :'u^:([email protected])'


public class ShortCirc {
    public static void main(String[] args){
        System.out.println("F and F = " + (a(false) && b(false)) + "\n");
        System.out.println("F or F = " + (a(false) || b(false)) + "\n");

        System.out.println("F and T = " + (a(false) && b(true)) + "\n");
        System.out.println("F or T = " + (a(false) || b(true)) + "\n");

        System.out.println("T and F = " + (a(true) && b(false)) + "\n");
        System.out.println("T or F = " + (a(true) || b(false)) + "\n");

        System.out.println("T and T = " + (a(true) && b(true)) + "\n");
        System.out.println("T or T = " + (a(true) || b(true)) + "\n");
    }

    public static boolean a(boolean a){
        System.out.println("a");
        return a;
    }

    public static boolean b(boolean b){
        System.out.println("b");
        return b;
    }
}


\ Generates a square Sierpinski gasket
: 1? over 3 mod 1 = ;                  ( n1 n2 -- n1 n2 f)
: 3/ 3 / swap ;                        ( n1 n2 -- n2/3 n1)
                                       \ is this cell in the carpet?
: incarpet                             ( n1 n2 -- f)
  begin over over or while 1? 1? and if 2drop false exit then 3/ 3/ repeat
  2drop true                           \ return true if in the carpet
;
                                       \ draw a carpet of n size
: carpet                               ( n --)
  1 swap 0 ?do 3 * loop dup            \ calculate power of 3
  0 ?do dup 0 ?do i j incarpet if [char] # else bl then emit loop cr loop
  drop                                 \ evaluate every cell in the carpet
;

cr 4 carpet


program Sierpinski_carpet
  implicit none

  call carpet(4)

contains

function In_carpet(a, b)
  logical :: in_carpet
  integer, intent(in) :: a, b
  integer :: x, y

  x = a ; y = b
  do
    if(x == 0 .or. y == 0) then
      In_carpet = .true.
      return
    else if(mod(x, 3) == 1 .and. mod(y, 3) == 1) then
      In_carpet = .false.
      return
    end if
    x = x / 3
    y = y / 3
  end do
end function

subroutine Carpet(n)
  integer, intent(in) :: n
  integer :: i, j

  do i = 0, 3**n - 1
    do j = 0, 3**n - 1
      if(In_carpet(i, j)) then
        write(*, "(a)", advance="no") "#"
      else
        write(*, "(a)", advance="no") " "
      end if
    end do
    write(*,*)
  end do
end subroutine Carpet
end program Sierpinski_carpet


#!/usr/bin/env python
# compute the root label for a SHA256 Merkle tree built on blocks of a given
# size (default 1MB) taken from the given file(s)
import argh
import hashlib
import sys

@argh.arg('filename', nargs='?', default=None)
def main(filename, block_size=1024*1024):
    if filename:
        fin = open(filename, 'rb')
    else:
        fin = sys.stdin

    stack = []
    block = fin.read(block_size)
    while block:
        # a node is a pair: ( tree-level, hash )
        node = (0, hashlib.sha256(block).digest())
        stack.append(node)

        # concatenate adjacent pairs at the same level
        while len(stack) >= 2 and stack[-2][0] == stack[-1][0]:
            a = stack[-2]
            b = stack[-1]
            l = a[0]
            stack[-2:] = [(l+1, hashlib.sha256(a[1] + b[1]).digest())]

        block = fin.read(block_size)

    while len(stack) > 1:
        # at the end we have to concatenate even across levels
        a = stack[-2]
        b = stack[-1]
        al = a[0]
        bl = b[0]
        stack[-2:] = [(max(al, bl)+1, hashlib.sha256(a[1] + b[1]).digest())]

    print(stack[0][1].hex())

argh.dispatch_command(main)


use Digest::SHA256::Native;

unit sub MAIN(Int :b(:$block-size) = 1024 × 1024, *@args);

my $in = @args ?? IO::CatHandle.new(@args) !! $*IN;

my @blocks = do while my $block = $in.read: $block-size { sha256 $block };

while @blocks > 1 {
  @blocks = @blocks.batch(2).map: { $_ > 1 ?? sha256([~] $_) !! .[0] }
}

say @blocks[0]».fmt('%02x').join;


(function () {
    'use strict';

    function a(bool) {
        console.log('a -->', bool);

        return bool;
    }

    function b(bool) {
        console.log('b -->', bool);

        return bool;
    }

    var x = a(false) && b(true),
        y = a(true) || b(false),
        z = true ? a(true) : b(false);

  return [x, y, z];
})();


def a(x): "  a(\(x))" | stderr | x;

def b(y): "  b(\(y))" | stderr | y;

"and:", (a(true) and b(true)),
"or:",  (a(true) or b(true)),
"and:", (a(false) and b(true)),
"or:",  (a(false) or b(true))


a(x) = (println("\t# Called a($x)"); return x)
b(x) = (println("\t# Called b($x)"); return x)

for i in [true,false], j in [true, false]
    println("\nCalculating: x = a($i) && b($j)"); x = a(i) && b(j)
    println("\tResult: x = $x")
    println("\nCalculating: y = a($i) || b($j)"); y = a(i) || b(j)
    println("\tResult: y = $y")
end


Function in_carpet(x As Uinteger, y As Uinteger) As Boolean
    While x <> 0 And y <> 0
        If(x Mod 3) = 1 And (y Mod 3) = 1 Then Return False
        y = y \ 3: x = x \ 3
    Wend
    Return True
End Function

Sub carpet(n As Uinteger)
    Dim As Uinteger i, j, k = (3^n)-1

    For i = 0 To k
        For j = 0 To k
            If in_carpet(i, j) Then Print("#"); Else Print(" ");
        Next j
        Print
    Next i
End Sub

For k As Byte = 0 To 4
    Print !"\nN ="; k
    carpet(k)
Next k
Sleep