# Logical operations, in LIL
set first [expr 1 == 1]
set second [expr 1 == 0]

func and-or-not {a b} {
    print a $a b $b
    print "a AND b" [expr $a && $b]
    print "a OR b " [expr $a || $b]
    print "NOT a  " [expr !$a]
}

and-or-not $first $second


function boolOps p1, p2
    local boolOpsResult
    put p1 && "AND" && p2 && "=" && merge("[[p1 and p2]]") & cr after boolOpsResult
    put p1 && "OR" && p2 && "=" && merge("[[p1 or p2]]") & cr after boolOpsResult
    put "NOT" && p1 && "=" && merge("[[not p1]]")  & cr after boolOpsResult
    return boolOpsResult
end boolOps


; This is not strictly LLVM, as it uses the C library function "printf".
; LLVM does not provide a way to print values, so the alternative would be
; to just load the string into memory, and that would be boring.

; Additional comments have been inserted, as well as changes made from the output produced by clang such as putting more meaningful labels for the jumps

;--- The declarations for the external C functions
declare i32 @printf(i8*, ...)

$"FORMAT_AND" = comdat any

$"FORMAT_OR" = comdat any

$"FORMAT_NOT" = comdat any

@"FORMAT_AND" = linkonce_odr unnamed_addr constant [15 x i8] c"a and b is %d\0A\00", comdat, align 1
@"FORMAT_OR" = linkonce_odr unnamed_addr constant [14 x i8] c"a or b is %d\0A\00", comdat, align 1
@"FORMAT_NOT" = linkonce_odr unnamed_addr constant [13 x i8] c"not a is %d\0A\00", comdat, align 1

; Function Attrs: noinline nounwind optnone uwtable
define void @print_logic(i32, i32) #0 {
  %3 = alloca i32, align 4          ;-- allocate b
  %4 = alloca i32, align 4          ;-- allocate a
  store i32 %1, i32* %3, align 4    ;-- copy parameter b
  store i32 %0, i32* %4, align 4    ;-- copy parameter a
  %5 = load i32, i32* %4, align 4   ;-- load a
  %6 = icmp ne i32 %5, 0            ;-- is a true?
  br i1 %6, label %and_true, label %and_false

and_true:
  %7 = load i32, i32* %3, align 4
  %8 = icmp ne i32 %7, 0
  br label %and_false

and_false:
  %9 = phi i1 [ false, %2 ], [ %8, %and_true ]
  %10 = zext i1 %9 to i32
  %11 = call i32 (i8*, ...) @printf(i8* getelementptr inbounds ([15 x i8], [15 x i8]* @"FORMAT_AND", i32 0, i32 0), i32 %10)
  %12 = load i32, i32* %4, align 4  ;-- load a
  %13 = icmp ne i32 %12, 0          ;-- is a true?
  br i1 %13, label %or_true, label %or_false

or_false:
  %14 = load i32, i32* %3, align 4  ;-- load b
  %15 = icmp ne i32 %14, 0          ;-- is b true?
  br label %or_true

or_true:
  %16 = phi i1 [ true, %and_false ], [ %15, %or_false ]
  %17 = zext i1 %16 to i32
  %18 = call i32 (i8*, ...) @printf(i8* getelementptr inbounds ([14 x i8], [14 x i8]* @"FORMAT_OR", i32 0, i32 0), i32 %17)

  %19 = load i32, i32* %4, align 4  ;-- load a
  %20 = icmp ne i32 %19, 0
  %21 = xor i1 %20, true
  %22 = zext i1 %21 to i32
  %23 = call i32 (i8*, ...) @printf(i8* getelementptr inbounds ([13 x i8], [13 x i8]* @"FORMAT_NOT", i32 0, i32 0), i32 %22)
  ret void
}

; Function Attrs: noinline nounwind optnone uwtable
define i32 @main() #0 {
  %1 = alloca i32, align 4          ;-- allocate i
  %2 = alloca i32, align 4          ;-- allocate j
  store i32 0, i32* %1, align 4     ;-- store 0 in i
  br label %loop_i

loop_i:
  %3 = load i32, i32* %1, align 4   ;-- load i
  %4 = icmp slt i32 %3, 2           ;-- i < 2
  br i1 %4, label %loop_j_init, label %exit

loop_j_init:
  store i32 0, i32* %2, align 4     ;-- store 0 in j
  br label %loop_j

loop_j:
  %5 = load i32, i32* %2, align 4   ;-- load j
  %6 = icmp slt i32 %5, 2           ;-- j < 2
  br i1 %6, label %loop_body, label %loop_i_inc

loop_body:
  %7 = load i32, i32* %2, align 4   ;-- load j
  %8 = load i32, i32* %1, align 4   ;-- load i
  call void @print_logic(i32 %8, i32 %7)
  %9 = load i32, i32* %2, align 4   ;-- load j
  %10 = add nsw i32 %9, 1           ;-- increment j
  store i32 %10, i32* %2, align 4   ;-- store j
  br label %loop_j

loop_i_inc:
  %11 = load i32, i32* %1, align 4  ;-- load i
  %12 = add nsw i32 %11, 1          ;-- increment i
  store i32 %12, i32* %1, align 4   ;-- store i
  br label %loop_i

exit:
  ret i32 0
}

attributes #0 = { noinline nounwind optnone uwtable "correctly-rounded-divide-sqrt-fp-math"="false" "disable-tail-calls"="false" "less-precise-fpmad"="false" "no-frame-pointer-elim"="false" "no-infs-fp-math"="false" "no-jump-tables"="false" "no-nans-fp-math"="false" "no-signed-zeros-fp-math"="false" "no-trapping-math"="false" "stack-protector-buffer-size"="8" "target-cpu"="x86-64" "target-features"="+fxsr,+mmx,+sse,+sse2,+x87" "unsafe-fp-math"="false" "use-soft-float"="false" }


to logic :a :b
  (print [a AND b =] and :a :b)
  (print [a OR b =] or :a :b)
  (print [NOT a =] not :a)
end


function logic(a,b)
  return a and b, a or b, not a
end


Module CheckIt {
      Def Boolean A, B
      Document Rep$
      A=True
      B=False
      k=(A, B)
      And=Lambda (a as Boolean, b as Boolean)-> a and b
      Or=Lambda (a as Boolean, b as Boolean)-> a or b
      Xor=Lambda (a as Boolean, b as Boolean)-> a xor b
      Not=Lambda (a)->Not a
      func=((And, "And"), (Or, "Or"), (Xor, "Xor"))
      F1=Each(func)
      While F1 {
            M1=Each(k)
            M2=Each(k)
            While M1 {
                  While M2 {
                       A=Array(Array(F1), 0)
                       Rep$=Format$("{0} {1} {2} = {3}",Array(M1), Array$(Array(F1), 1),Array(M2), A(Array(M1), Array(M2)))+{
                                    }
                  }
            }
      }
      M1=Each(k)
      While M1 {
            Rep$=Format$("Not {0} = {1}",Array(M1),  Not Array(M1))+{
                        }
      }
      Report Rep$
      Clipboard Rep$
}
CheckIt


f:=proc(a,b) a and b, a or b, not a; end proc:

f(true,true);
f(true,false);
f(false,true);
f(false,false);


f(a, b) := [not a, a or b, a and b];

/* to use multiple arguments, use any of these */
a and b and c and d;
a or b or c or d;
"and"(a, b, c, d);
"or"(a, b, c, d);
apply("and", [a, b, c, d]);
apply("or", [a, b, c, d]);


fn printLogic a b =
(
    format "a and b is %\n" (a and b)
    format "a or b is %\n" (a or b)
    format "not a is %\n" (not a)
)


def tf(expr a) = if a: "true" else: "false" fi enddef;
def test(expr a, b) =
  for o = "and", "or":
    message tf(a) & " " & o & " " & tf(b);
    show a scantokens(o) b;
  endfor
  message "not " & tf(a);
  show not a enddef;


(
  :b :a
  "xor is: " print! a b xor puts!
  "and is: " print! a b and puts!
  "or is: " print! a b or puts!
  "not is: " print! a not puts!
) :logical-operators


MODULE LogicalOps;
FROM FormatString IMPORT FormatString;
FROM Terminal IMPORT WriteString,WriteLn,ReadChar;

PROCEDURE Print(a,b : BOOLEAN);
VAR buf : ARRAY[0..31] OF CHAR;
BEGIN
    FormatString("a and b is %b\n", buf, a AND b);
    WriteString(buf);
    FormatString("a or b is %b\n", buf, a OR b);
    WriteString(buf);
    FormatString("not a is %b\n", buf, NOT a);
    WriteString(buf);
    WriteLn
END Print;

BEGIN
    Print(FALSE, FALSE);
    Print(FALSE, TRUE);
    Print(TRUE, TRUE);
    Print(TRUE, FALSE);

    ReadChar
END LogicalOps.


MODULE Logical EXPORTS Main;

FROM IO IMPORT Put;
FROM Fmt IMPORT Bool;

PROCEDURE Test(a, b: BOOLEAN) =
  BEGIN
    Put("a AND b is " & Bool(a AND b) & "\n");
    Put("a OR b is " & Bool(a OR b) & "\n");
    Put("NOT a is " & Bool(NOT a) & "\n");
  END Test;

BEGIN
  Test(TRUE, FALSE);
END Logical.


LOGIC(A,B)
 WRITE !,A," AND ",B," IS ",A&B
 WRITE !,A," OR  ",B," IS ",A!B
 WRITE !,"NOT ",A," AND ",B," IS ",'(A)&B
 WRITE !,"NOT ",A," OR ",B," IS ",'(A)!B


def logic(a, b)
	println "a and b: " + (a && b)
	println "a or b:  " + (a && b)
	println "not a:   " + !a
end


/**
 Logical operations, in Neko
*/

/* For logical operations, values need to be explicitly treated as boolean */
/* Only null, false and 0 evaluate as false with $istrue() */

var logical = 1
if logical $print("literal 1 tests true\n") else $print("literal 1 tests false\n")
if $istrue(logical) $print("$istrue(1) tests true\n")

/* supports && logical AND, || logical OR, $not(value) the opposite of $istrue() */

if $istrue(logical) && logical > 0 $print("true path for logical AND\n")
if $istrue(logical) || logical > 1 $print("true path for logical OR\n")
if $not(logical) $print("true path for $not(1)\n") else $print("false path for $not(1)\n")


using System;
using System.Console;

module Logical
{
    WriteLogical(a : bool, b : bool) : void
    {
        WriteLine("{0} and {1} is {2}", a, b, a && b);
        WriteLine("{0} or {1} is {2}", a, b, a || b);
        WriteLine("not {0} is {1}", a, !a);
    }

    Main() : void {WriteLogical(true, false)}
}


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

runSample(arg)
return

-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
method logicalOperation(xL = boolean, xR = boolean) public static
  say showBool(xL) 'AND' showBool(xR) '=' showBool(xL &  xR) -- AND
  say showBool(xL) 'OR ' showBool(xR) '=' showBool(xL |  xR) -- OR
  say showBool(xL) 'XOR' showBool(xR) '=' showBool(xL && xR) -- XOR
  say '     '      'NOT' showBool(xL) '=' showBool(\xL)      -- NOT
  say
  return

-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
method showBool(bb = boolean) public static
  if bb then bt = 'true '
  else       bt = 'false'
  return bt

-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
method runSample(arg) private static
  TRUE_  = (1 == 1)
  FALSE_ = \TRUE_
  lpairs = [ -
    [TRUE_,  TRUE_ ], -
    [TRUE_,  FALSE_], -
    [FALSE_, TRUE_ ], -
    [FALSE_, FALSE_]  -
  ]
  loop lx = 0 to lpairs.length - 1
    lpair = lpairs[lx]
    --say showBool(lpair[0]) showBool(lpair[1])
    logicalOperation(lpair[0], lpair[1])
    end lx
  return


(define (logic a b)
		(print "a and b is: " (and a b) "\n a or b is: " (or a b))
		(print "\n not a is: " (not a)))


proc logic(a, b: bool) =
  echo "a and b: ", a and b
  echo "a or b: ", a or b
  echo "not a: ", not a
  echo "a xor b: ", a xor b


bundle Default {
  class Logic {
    function : Main(args : String[]) ~ Nil {
      a := true;
      b := false;
      IO.Console->GetInstance()->Print("a and b is: ")->PrintLine(a & b);
      IO.Console->GetInstance()->Print("a or b is: ")->PrintLine(a | b);
      IO.Console->GetInstance()->Print("not a is: ")->PrintLine(a <> true);
    }
  }
}


let print_logic a b =
  Printf.printf "a and b is %B\n" (a && b);
  Printf.printf "a or b is %B\n" (a || b);
  Printf.printf "not a is %B\n" (not a)


function test(a, b)
  s1 = num2str(a);
  s2 = num2str(b);
  disp(strcat(s1, " and ", s2, " = ", num2str(a&&b)));
  disp(strcat(s1, " or ", s2, " = ", num2str(a||b)));
  disp(strcat("not ", s1, " = ", num2str(!a)));
endfunction

% constant true is 1, false is 0
test(true, true);
test(false, false);
test(true, false);
test(false, true);


: logical(b1, b2)
   System.Out "and = " << b1 b2 and << cr
   System.Out "or  = " << b1 b2 or << cr
   System.Out "xor = " << b1 b2 xor << cr
   System.Out "not = " << b1 not << cr ;


logic: func (a: Bool, b: Bool) {
  println()
  "A=#{a}, B=#{b}:"  println()
  "AND:   #{a && b}" println()
  "OR:    #{a || b}" println()
  "NOT A: #{!a}"     println()
}

main: func {
  logic(true, false)
  logic(true, true)
  logic(false, false)
  logic(false, true)
}


FUNCTION testLogical RETURNS CHAR (
   i_l1 AS LOGICAL,
   i_l2 AS LOGICAL
):

   RETURN
      SUBSTITUTE( '&1 and &2:  &3', i_l1, i_l2, i_l1 AND i_l2 ) + '~n' +
      SUBSTITUTE( '&1 or &2:  &3', i_l1, i_l2, i_l1 OR i_l2 )  + '~n' +
      SUBSTITUTE( 'not &1:  &2', i_l1, NOT i_l1 )
      .

END FUNCTION.


proc {PrintLogic A B}
   %% using not short-circuiting standard library functions
   {Show {And A B}}
   {Show {Or A B}}
   {Show {Not A}}

   %% using short-circuiting keywords
   {Show A andthen B}
   {Show A orelse B}
end


logic(a,b)={
  print(a&b); \\ && is the same
  print(a|b); \\ || is the same
  print(!a);
};


procedure printlogic(a, b: boolean);
 begin
  writeln('a and b is ', a and b);
  writeln('a or b is ', a or b);
  writeln('not a is', not a);
 end;


sub show_bool
{
        return shift() ? 'true' : 'false', "\n";
}

sub test_logic
{
        my ($a, $b) = @_;
        print "a and b is ", show_bool $a && $b;
        print "a or b is ", show_bool $a || $b;
        print "not a is ", show_bool !$a;
        print "a xor b is ", show_bool($a xor $b);
}


function logicop(bool a, b)
    return {a, b, a and b, a or b, not a, a xor b, a==b, a!=b}
end function

printf(1,"  a      b     and    or      not     xor    ==     !=\n")
for a=FALSE to TRUE do  -- nb: TRUE to FALSE would need a "by -1".
    for b=FALSE to TRUE do
        printf(1,"%-5t  %-5t  %-5t  %-5t   %-5t   %-5t  %-5t  %-5t\n",logicop(a,b))
    end for
end for


function print_logic($a, $b)
{
    echo "a and b is ", $a && $b ? 'True' : 'False', "\n";
    echo "a or b is ", $a || $b ? 'True' : 'False', "\n";
    echo "not a is ", ! $a ? 'True' : 'False', "\n";
}


(de logic (A B)
   (prin "A AND B is ")
   (println (and A B))
   (prin "A OR B is ")
   (println (or A B))
   (prin "A XOR B is ")
   (println (xor A B))
   (prin "NOT A is ")
   (println (not A)) )


logical_ops: procedure (t, u);
   declare (t, u) bit (1);

   put skip list (t & u);
   put skip list (t | u); /* logical or   */
   put skip list (^t);    /* logical not  */
   put skip list (t ^ u); /* exclusive or */
end logical_ops;


define print_logic(a, b);
    printf(a and b, 'a and b is %p\n');
    printf(a or b, 'a or b is %p\n');
    printf(not(a), 'not a is %p\n');
enddefine;


/logical{
/a exch def
/b exch def
a b and =
a b or =
a not =
}def


function Test-Boolean ([bool] $a, [bool] $b) {
    Write-Host "A and B:   " ($a -and $b)
    Write-Host "A or B:    " ($a -or $b)
    Write-Host "not A:     " (-not $a)
    Write-Host "not A:     " (!$a)
    Write-Host "A xor B:   " ($a -xor $b)
}


 ?- true,true.
true.

 ?- true,false.
false.

 ?- true;false.
true .

 ?- false;true.
true .

 ?- false;false.
false .

 ?- \+true.
false.

 ?- \+false.
true.

 ?- \+((true,false)).
true.

 ?- \+((true;false)).
false.


Procedure LogicDebug(a,b)
  Debug a & b ;And
  Debug a | b ;Or
  Debug  ~a   ;Not
  Debug a ! b ;XOr
EndProcedure

logicDebug(#True, #True)
logicDebug(#True, #False)
logicDebug(#False, #False)


def logic(a, b):
    print('a and b:', a and b)
    print('a or b:', a or b)
    print('not a:', not a)


Dim As _Unsigned _Bit First, Second
First = 0: Second = 1
Print "  Operator    F    S   results "

Print "  AND         1    0  "; First And Second
Print "  XOR         1    0  "; First Xor Second
Print "   OR         1    0  "; First Or Second
Print "  NOT         1       "; Not First
Print "  EQV         1    0  "; First Eqv Second
Print "  IMP         1    0  "; First Imp Second


  [ iff [ say "true" ]
    else [ say "false"] ]         is echobool (   b --> )

  [ 2dup and
    say "A and B is " echobool cr
    over or
    say "A or B is " echobool cr
    not
    say "not A is " echobool cr ] is task     ( A B --> )


logic <- function(a, b) {
  print(a && b)
  print(a || b)
  print(! a)
}

logic(TRUE, TRUE)
logic(TRUE, FALSE)
logic(FALSE, FALSE)


#lang racket

(define (logic a b)
  (displayln (format "a and b equals ~a" (and a b)))
  (displayln (format "a or b equals ~a" (or a b)))
  (displayln (format "not a equals ~a" (not a)))
  (displayln (format "a nand b equals ~a" (nand a b)))
  (displayln (format "a nor b equals ~a" (nor a b)))
  (displayln (format "a implies b equals ~a" (implies a b)))
  (displayln (format "a xor b equals ~a" (xor a b))))


sub logic($a,$b) {
    say "$a && $b is ", $a && $b;     # short-circuiting
    say "$a || $b is ", $a || $b;     # short-circuiting
    say "$a ^^ $b is ", $a ^^ $b;
    say "!$a is ",     !$a;

    say "$a ?& $b is ", $a ?& $b;     # non-short-circuiting
    say "$a ?| $b is ", $a ?| $b;     # non-short-circuiting
    say "$a ?^ $b is ", $a ?^ $b;     # non-short-circuiting

    say "$a +& $b is ", $a +& $b;     # numeric bitwise
    say "$a +| $b is ", $a +| $b;     # numeric bitwise
    say "$a +^ $b is ", $a +^ $b;     # numeric bitwise

    say "$a ~& $b is ", $a ~& $b;     # buffer bitwise
    say "$a ~| $b is ", $a ~| $b;     # buffer bitwise
    say "$a ~^ $b is ", $a ~| $b;     # buffer bitwise

    say "$a & $b is ", $a & $b;       # junctional/autothreading
    say "$a | $b is ", $a | $b;       # junctional/autothreading
    say "$a ^ $b is ", $a ^ $b;       # junctional/autothreading

    say "$a and $b is ", ($a and $b); # loose short-circuiting
    say "$a or $b is ",  ($a or $b);  # loose short-circuiting
    say "$a xor $b is ", ($a xor $b);
    say "not $a is ",    (not $a);
}

logic(3,10);


import IO;

public void logic(bool a, bool b){
	println("a and b, is <a && b>");
	println("a or b, is <a || b>");
	println("a equivalent to b, is <a <==> b>");
	println("a implies b, is <a ==> b>");
	println("not a", <!a>");
}


logics: func [a [logic!] b [logic!]] [
    print ['and tab a and b]
    print ['or  tab a or  b]
    print ['not tab   not a]
    print ['xor tab a xor b]

    print ['and~ tab and~ a b]
    print ['or~  tab or~  a b]
    print ['xor~ tab xor~ a b]

    print ['any tab any [a b]]
    print ['all tab all [a b]]
]


program logic(x,y)
relation a, b, op, result
insert x, y, "and", x and y
insert x, y, "or", x or y
insert x, "", "not", not x
insert x, y, "xor", x xor y
print
end program

run logic(0,0)
run logic(0,1)
run logic(1,0)
run logic(1,1)


let logic = (a, b) => {
  Js.log(string_of_bool(a) ++ " and " ++ string_of_bool(b) ++ " = " ++ string_of_bool(a && b))
  Js.log(string_of_bool(a) ++ " or " ++ string_of_bool(b) ++ " = " ++ string_of_bool(a || b))
}

let logic2 = (a) =>
  Js.log("not(" ++ string_of_bool(a) ++ ") = " ++ string_of_bool(!a))

logic(true, true)
logic(true, false)
logic(false, true)
logic(false, false)

logic2(true)
logic2(false)


: .bool ( f- ) [ "true" ] [ "false" ] if puts cr ;
: logic ( ab- )
 "\na = "  puts over .bool "b = " puts dup .bool
 "\na and b = " puts 2dup and .bool
 "\na  or b = " puts over  or .bool
 "\nnot a = " puts not .bool ;


/*REXX program  demonstrates some  binary  (also known as  bit  or logical)  operations.*/
                        x= 1    ;    @x= ' x '   /*set the initial values of  X  and Y, */
                        y= 0    ;    @y= ' y '   /*  and a couple of literals for HDRs. */
                                                 /* [↓]  echo  the   X  and  Y   values.*/
call $ 'name', "value"                           /*display the  header  (title) line.   */
call $ 'x'   ,    x                              /*display "x"  and then the value of X.*/
call $ 'y'   ,    y                              /*   "    "y"   "    "   "    "    " Y */
                                                 /* [↓]  negate the X; then the Y value.*/
call $ 'name', "negated"                         /*some REXXes support the  ¬  character*/
call $ 'x'   ,   \x                              /*display "x"  and then the value of ¬X*/
call $ 'y'   ,   \y                              /*   "    "y"   "    "   "    "    " ¬Y*/
say
say
call $ @x, @y, 'AND';    do x=0  to 1;   do y=0  to 1;   call $ x, y, x  & y;    end;  end
call $ @x, @y, 'OR' ;    do x=0  to 1;   do y=0  to 1;   call $ x, y, x  | y;    end;  end
call $ @x, @y, 'XOR';    do x=0  to 1;   do y=0  to 1;   call $ x, y, x && y;    end;  end
exit 0                                           /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
$: parse arg @.1, @.2, @.3, @.4;         hdr= length(@.1) \== 1;        if hdr  then say
             do j=0  to hdr;             _=
                   do k=1  for arg();    _= _  center(@.k, 7)
                   end   /*k*/
             say _
             @.= copies('═', 7)                  /*define a new header separator line.  */
             end         /*j*/
   return


x = true
y = false

see "x and y = " + (x and y) + nl
see "x or y = " + (x or y) + nl
see  "not x = " + (not x) + nl


def logic(a, b)
  print 'a and b: ', a && b, "\n"
  print 'a or b: ' , a || b, "\n"
  print 'not a: '  , !a    , "\n"
  print 'a xor b: ' , a ^ b, "\n"
end


fn boolean_ops(a: bool, b: bool) {
    println!("{} and {} -> {}", a, b, a && b);
    println!("{} or {} -> {}", a, b, a || b);
    println!("{} xor {} -> {}", a, b, a ^ b);
    println!("not {} -> {}\n", a, !a);
}

fn main() {
    boolean_ops(true, true);
    boolean_ops(true, false);
    boolean_ops(false, true);
    boolean_ops(false, false)
}


def logical(a: Boolean, b: Boolean): Unit = {
  println("and: " + (a && b))
  println("or:  " + (a || b))
  println("not: " + !a)
}

logical(true, false)


(define (logic a b)
  (display "a and b is ")
  (display (and a b))
  (newline)
  (display "a or b is ")
  (display (or a b))
  (newline)
  (display "not a is ")
  (display (not a))
  (newline))


const proc: writeLogic (in boolean: a, in boolean: b) is func
  begin
    writeln("a and b is " <& a and b);
    writeln("a or b is " <& a or b);
    writeln("not a is " <& not a);
  end func;


true not = false.
( true && false ) = false.
( true ^^ false ) = true. "xor"
( true || false ) = true. "or"


func logic(a, b) {
    say ("a and b: ", a && b);
    say ("a  or b: ", a || b);
    say ("a xor b: ", a ^ b);
    say ("  not a: ", !a);
}

logic(false, true);


!logic:
  (a? b?)
    [
    println("a and b: " a and b)
    println("a or b: "  a or b)
    println("not a: "   not a)
    println("a xor b: " a xor b)
    println("a nand b: " a nand b)
    println("a nor b: " a nor b)
    println("a not xor b: " a nxor b)
    ]


{#/\. #\/. #not} do: [ |:func|
  func arity = 1 ifTrue: [inform: 'True ' ; (func as: String) ; ' = ' ; (func sendTo: {True}) printString.
                          inform: 'False ' ; (func as: String) ; ' = ' ; (func sendTo: {False}) printString.].

  func arity = 2
    ifTrue: [{{True. True}. {True. False}. {False. True}. {False. False}} do:
              [ |:each| inform: each first printString ; (func as: String) ; each second printString ; ' = ' ; (func sendTo: each) printString]]

].


|test|
test := [ :a :b |
  ('%1 %2 %3 = %4' % { a. 'and'. b. (a & b) }) displayNl.
  ('%1 %2 %3 = %4' % { a. 'or'. b. (a | b) }) displayNl.
  ('%1 %2 = %3' % {'not'. a. (a not) }) displayNl
].

test value: true value: true.
test value: false value: false.
test value: true value: false.
test value: false value: true.


fun print_logic (a, b) = (
  print ("a and b is " ^ Bool.toString (a andalso b) ^ "\n");
  print ("a or b is " ^ Bool.toString (a orelse b) ^ "\n");
  print ("not a is " ^ Bool.toString (not a) ^ "\n")
)


prog def bool
	args a b
	di `a'&`b'
	di `a'|`b'
	di !`a'
end


func logic(a: Bool, b: Bool) {
  println("a AND b: \(a && b)");
  println("a OR b: \(a || b)");
  println("NOT a: \(!a)");
}


proc logic {a b} {
    puts "a and b: [expr {$a && $b}]"
    puts "a or b:  [expr {$a || $b}]"
    puts "not a:   [expr {!$a}]"
}


[ 0 <> [ ." true" ] [ ." false"] ifTrueFalse ] is .bool
[ ( a b -- )
  cr ." a = " over .bool ."   b = " dup .bool
  cr ." a and b = " 2dup and .bool
  cr ." a  or b = " over  or .bool
  cr ." not a = " 0 = .bool
] is logic


Proc _Boolean(4, 2)
Proc _Boolean(0, 2)
Proc _Boolean(2, 0)

End

_Boolean Param(2)
  [email protected] = [email protected] # 0                          ' Transform to true booleans
  [email protected] = [email protected] # 0

  print "A and B is "; [email protected] * [email protected]         ' Multiplication will now do AND
  print "A or B is "; [email protected] + [email protected]          ' Addition will now do OR
  print "not A is "; [email protected] = 0            ' This will invert the boolean value
  print
Return


[mylogic
  [get2 [dup] dip swap [dup] dip].
   get2 and puts
   get2 or puts
   swap not puts
   pop
 ].


public class Program {
    private static void print_logic (bool a, bool b) {
        print ("a and b is %s\n", (a && b).to_string ());
        print ("a or b is %s\n", (a || b).to_string ());
        print ("not a %s\n", (!a).to_string ());
    }
    public static int main (string[] args) {
        if (args.length < 3) error ("Provide 2 arguments!");
        bool a = bool.parse (args[1]);
        bool b = bool.parse (args[2]);
        print_logic (a, b);
        return 0;
    }
}


module main;
integer a, b;

  initial begin
      a = 1; //true
      b = 0; //false
      $display(a && b);  //AND
      $display(a || b);  //OR
      $display(!a);      //NOT
      $finish ;
    end
endmodule


Function Test(ByVal a As Boolean, ByVal b As Boolean)
    Console.WriteLine("And " & a And b)
    Console.WriteLine("Or " & a Or b)
    Console.WriteLine("Not " & Not a)
    Console.WriteLine("Xor " & a Xor b)
    Console.WriteLine("And, short-circuited " & a AndAlso b)
    Console.WriteLine("Or, short-circuited " & a OrElse b)
End Function


var f = Fn.new { |a, b|
    System.print("a      = %(a)")
    System.print("b      = %(b)")
    System.print("!a     = %(!a)")
    System.print("a && b = %(a && b)")
    System.print("a || b = %(a || b)")
    System.print()
}

var tests = [ [true, true], [true, false], [false, true], [false, false] ]
for (test in tests) f.call(test[0], test[1])


(defun logical-functions (a b)
    (print `(a and b = ,(and a b)))
    (print `(a or b = ,(or a b)))
    (print `(not a = ,(not a))) )


include c:\cxpl\codes;          \intrinsic 'code' declarations

func Logic(A, B);
int  A, B;
[HexOut(0, A and B);  ChOut(0, ^ );
 HexOut(0, A or  B);  ChOut(0, ^ );
 HexOut(0, not A);    ChOut(0, ^ );
 HexOut(0, A xor B);
]; \Logic

[Logic(false, false); CrLf(0);
 Logic(true, false);  CrLf(0);
 Logic(true, true);   CrLf(0);
 Logic(1, 1);   CrLf(0);
 Logic(1, 2);   CrLf(0);
]


<xsl:template name="logic">
  <xsl:param name="a" select="true()"/>
  <xsl:param name="b" select="false()"/>
  <fo:block>a and b = <xsl:value-of select="$a and $b"/></fo:block>
  <fo:block>a or b = <xsl:value-of select="$a or $b"/></fo:block>
  <fo:block>not a = <xsl:value-of select="not($a)"/></fo:block>
 </xsl:template>


fcn f(a,b){a and b}
fcn g(a,b){a or b}
fcn h(a){(not a)}


CLASS lcl_pythagorean_triplet DEFINITION CREATE PUBLIC.
  PUBLIC SECTION.
    TYPES: BEGIN OF ty_triplet,
             x TYPE i,
             y TYPE i,
             z TYPE i,
           END OF ty_triplet,
           tty_triplets TYPE STANDARD TABLE OF ty_triplet WITH NON-UNIQUE EMPTY KEY.

    CLASS-METHODS:
      get_triplets
        IMPORTING
          n                 TYPE i
        RETURNING
          VALUE(r_triplets) TYPE tty_triplets.

  PRIVATE SECTION.
    CLASS-METHODS:
      _is_pythagorean
        IMPORTING
          i_triplet               TYPE ty_triplet
        RETURNING
          VALUE(r_is_pythagorean) TYPE abap_bool.
ENDCLASS.

CLASS lcl_pythagorean_triplet IMPLEMENTATION.
  METHOD get_triplets.
    DATA(triplets) = VALUE tty_triplets( FOR x = 1 THEN x + 1 WHILE x <= n
                                         FOR y = x THEN y + 1 WHILE y <= n
                                         FOR z = y THEN z + 1 WHILE z <= n
                                            ( x = x y = y z = z ) ).

    LOOP AT triplets ASSIGNING FIELD-SYMBOL(<triplet>).
      IF _is_pythagorean( <triplet> ) = abap_true.
        INSERT <triplet> INTO TABLE r_triplets.
      ENDIF.
    ENDLOOP.
  ENDMETHOD.

  METHOD _is_pythagorean.
    r_is_pythagorean = COND #( WHEN i_triplet-x * i_triplet-x + i_triplet-y * i_triplet-y = i_triplet-z * i_triplet-z THEN abap_true
                               ELSE abap_false ).
  ENDMETHOD.
ENDCLASS.

START-OF-SELECTION.
  cl_demo_output=>display( lcl_pythagorean_triplet=>get_triplets( n = 20 ) ).


with Ada.Text_IO; use Ada.Text_IO;
with Ada.Containers.Doubly_Linked_Lists;

procedure Pythagore_Set is

   type Triangles is array (1 .. 3) of Positive;

   package Triangle_Lists is new Ada.Containers.Doubly_Linked_Lists (
      Triangles);
   use Triangle_Lists;

   function Find_List (Upper_Bound : Positive) return List is
      L : List := Empty_List;
   begin
      for A in 1 .. Upper_Bound loop
         for B in A + 1 .. Upper_Bound loop
            for C in B + 1 .. Upper_Bound loop
               if ((A * A + B * B) = C * C) then
                  Append (L, (A, B, C));
               end if;
            end loop;
         end loop;
      end loop;
      return L;
   end Find_List;

   Triangle_List : List;
   C             : Cursor;
   T             : Triangles;

begin
   Triangle_List := Find_List (Upper_Bound => 20);

   C := First (Triangle_List);
   while Has_Element (C) loop
      T := Element (C);
      Put
        ("(" &
         Integer'Image (T (1)) &
         Integer'Image (T (2)) &
         Integer'Image (T (3)) &
         ") ");
      Next (C);
   end loop;
end Pythagore_Set;


MODE XYZ = STRUCT(INT x,y,z);

OP +:= = (REF FLEX[]XYZ lhs, XYZ rhs)FLEX[]XYZ: (
  [UPB lhs+1]XYZ out;
  out[:UPB lhs] := lhs;
  out[UPB out] := rhs;
  lhs := out
);

INT n = 20;
print (([]XYZ(
  FLEX[0]XYZ xyz;
  FOR x TO n DO FOR y FROM x+1 TO n DO FOR z FROM y+1 TO n DO IF x*x + y*y = z*z THEN xyz +:= XYZ(x,y,z) FI OD OD OD;
  xyz), new line
))


-- List comprehension by direct and unsugared use of list monad

-- pythagoreanTriples :: Int -> [(Int, Int, Int)]
on pythagoreanTriples(n)
    script x
        on |λ|(x)
            script y
                on |λ|(y)
                    script z
                        on |λ|(z)
                            if x * x + y * y = z * z then
                                [[x, y, z]]
                            else
                                []
                            end if
                        end |λ|
                    end script

                    |>>=|(enumFromTo(1 + y, n), z)
                end |λ|
            end script

            |>>=|(enumFromTo(1 + x, n), y)
        end |λ|
    end script

    |>>=|(enumFromTo(1, n), x)
end pythagoreanTriples

-- TEST -----------------------------------------------------------------------
on run
    --   Pythagorean triples drawn from integers in the range [1..n]
    --  {(x, y, z) | x <- [1..n], y <- [x+1..n], z <- [y+1..n], (x^2 + y^2 = z^2)}

    pythagoreanTriples(25)

    --> {{3, 4, 5}, {5, 12, 13}, {6, 8, 10}, {7, 24, 25}, {8, 15, 17},
    --   {9, 12, 15}, {12, 16, 20}, {15, 20, 25}}
end run

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

-- Monadic (>>=) (or 'bind') for lists is simply flip concatMap
-- (concatMap with arguments reversed)
-- It applies a function f directly to each value in the list,
-- and returns the set of results as a concat-flattened list

-- The concatenation eliminates any empty lists,
-- combining list-wrapped results into a single results list

-- (>>=) :: Monad m => m a -> (a -> m b) -> m b
on |>>=|(xs, f)
    concatMap(f, xs)
end |>>=|

-- concatMap :: (a -> [b]) -> [a] -> [b]
on concatMap(f, xs)
    set acc to {}
    tell mReturn(f)
        repeat with x in xs
            set acc to acc & |λ|(contents of x)
        end repeat
    end tell
    return acc
end concatMap

-- enumFromTo :: Int -> Int -> [Int]
on enumFromTo(m, n)
    if n < m then
        set d to -1
    else
        set d to 1
    end if
    set lst to {}
    repeat with i from m to n by d
        set end of lst to i
    end repeat
    return lst
end enumFromTo

-- 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


n: 20
triplets: @[
    loop 1..n 'x [
        loop x..n 'y [
            loop y..n 'z [if (z^2) = (x^2)+(y^2) -> @[x y z]]
        ]
    ]
]
print triplets


comprehend("show", range(1, 20), "triples")
return

comprehend(doToVariable, inSet, satisfying)
{
  set := %satisfying%(inSet.begin, inSet.end)
  index := 1
  While % set[index, 1]
  {
    item := set[index, 1] . ", " . set[index, 2] . ", " . set[index, 3]
    %doToVariable%(item)
    index += 1
  }
  return
}

show(var)
{
  msgbox % var
}

range(begin, end)
 {
   set := object()
   set.begin := begin
   set.end := end
   return set
 }

!r::reload
!q::exitapp

triples(begin, end)
{

  set := object()
  index := 1
  range := end - begin

  loop, % range
  {
    x := begin + A_Index
    loop, % range
    {
      y := A_Index + x
      if y > 20
	break
loop, % range
{
  z := A_Index + y
  if z > 20
    break
  isTriple := ((x ** 2 + y ** 2) == z ** 2)
  if isTriple
  {
    set[index, 1] := x
    set[index, 2] := y
    set[index, 3] := z
    index += 1
  ; msgbox % "triple: "  x . y . z
  }

}
}
}
return set
}


  :?py                         { Initialize the accumulating result list. }
& (     1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20   { This is the subject }
    :   ?                      { Here starts the pattern }
        %@?x
        ?
        %@?y
        ?
        %@?z
        ( ?
        & -1*!z^2+!x^2+!y^2:0
        & (!x,!y,!z) !py:?py
        & ~                    { This 'failure' expression forces backtracking }
        )                      { Here ends the pattern }
  | out$!py                    { You get here when backtracking has
                                 exhausted all combinations of x, y and z }
  );


for (int i = f + 1; i <= t; i ++) { e = e->nx = listNew(sizeof i, &i); }


using System.Linq;

static class Program
{
  static void Main()
  {
    var ts =
      from a in Enumerable.Range(1, 20)
      from b in Enumerable.Range(a, 21 - a)
      from c in Enumerable.Range(b, 21 - b)
      where a * a + b * b == c * c
      select new { a, b, c };

      foreach (var t in ts)
        System.Console.WriteLine("{0}, {1}, {2}", t.a, t.b, t.c);
  }
}


#include <vector>
#include <cmath>
#include <iostream>
#include <algorithm>
#include <iterator>

void list_comprehension( std::vector<int> & , int ) ;

int main( ) {
   std::vector<int> triangles ;
   list_comprehension( triangles , 20 ) ;
   std::copy( triangles.begin( ) , triangles.end( ) ,
	 std::ostream_iterator<int>( std::cout , " " ) ) ;
   std::cout << std::endl ;
   return 0 ;
}

void list_comprehension( std::vector<int> & numbers , int upper_border ) {
   for ( int a = 1 ; a < upper_border ; a++ ) {
      for ( int b = a + 1 ; b < upper_border ; b++ ) {
	 double c = pow( a * a + b * b , 0.5 ) ; //remembering Mr. Pythagoras
	 if ( ( c * c ) < pow( upper_border , 2 ) + 1 ) {
	    if ( c == floor( c ) ) {
	       numbers.push_back( a ) ;
	       numbers.push_back( b ) ;
	       numbers.push_back( static_cast<int>( c ) ) ;
	    }
	 }
      }
   }
}


(defn pythagorean-triples [n]
  (for [x (range 1 (inc n))
	y (range x (inc n))
	z (range y (inc n))
	:when (= (+ (* x x) (* y y)) (* z z))]
    [x y z]))


flatten = (arr) -> arr.reduce ((memo, b) -> memo.concat b), []

pyth = (n) ->
  flatten (for x in [1..n]
    flatten (for y in [x..n]
      for z in [y..n] when x*x + y*y is z*z
        [x, y, z]
    ))

console.dir pyth 20


(defun pythagorean-triples (n)
  (loop for x from 1 to n
        append (loop for y from x to n
                     append (loop for z from y to n
                                  when (= (+ (* x x) (* y y)) (* z z))
                                  collect (list x y z)))))


import std.stdio, std.meta, std.range;

TA[] select(TA, TI1, TC1, TI2, TC2, TI3, TC3, TP)
           (lazy TA mapper,
            ref TI1 iter1, TC1 items1,
            ref TI2 iter2, lazy TC2 items2,
            ref TI3 iter3, lazy TC3 items3,
            lazy TP where) {
  Appender!(TA[]) result;
  auto iters = AliasSeq!(iter1, iter2, iter3);

  foreach (el1; items1) {
    iter1 = el1;
    foreach (el2; items2) {
      iter2 = el2;
      foreach (el3; items3) {
        iter3 = el3;
        if (where())
          result ~= mapper();
      }
    }
  }

  AliasSeq!(iter1, iter2, iter3) = iters;
  return result.data;
}

void main() {
  enum int n = 21;
  int x, y, z;
  auto r = select([x,y,z], x, iota(1,n+1), y, iota(x,n+1), z,
                  iota(y, n + 1), x*x + y*y == z*z);
  writeln(r);
}


pragma.enable("accumulator") # considered experimental

accum [] for x in 1..n { for y in x..n { for z in y..n { if (x**2 + y**2 <=> z**2) { _.with([x,y,z]) } } } }


pythag = fn (N) {
    [(A, B, C) for A in lists.seq(1, N) \
         for B in lists.seq(A, N) \
         for C in lists.seq(B, N) \
         if A + B + C <= N and A * A + B * B == C * C]
}

@public
run = fn () {
    io.format("~p~n", [pythag(20)])
}


pythag(N) ->
    [ {A,B,C} || A <- lists:seq(1,N),
                 B <- lists:seq(A,N),
                 C <- lists:seq(B,N),
                 A+B+C =< N,
                 A*A+B*B == C*C ].


let pyth n = [ for a in [1..n] do
               for b in [a..n] do
               for c in [b..n] do
               if (a*a+b*b = c*c) then yield (a,b,c)]


USING: backtrack kernel locals math math.ranges ;

:: pythagorean-triples ( n -- seq )
    [
          n [1,b] amb-lazy :> a
        a n [a,b] amb-lazy :> b
        b n [a,b] amb-lazy :> c
        a a * b b * + c c * = must-be-true { a b c }
    ] bag-of ;


!-*- mode: compilation; default-directory: "/tmp/" -*-
!Compilation started at Fri Jun  7 23:39:20
!
!a=./f && make $a && $a
!gfortran -std=f2008 -Wall -fopenmp -ffree-form -fall-intrinsics -fimplicit-none f.f08 -o f
!   3   4   5
!   5  12  13
!   6   8  10
!   8  15  17
!   9  12  15
!  12  16  20
!
!Compilation finished at Fri Jun  7 23:39:20

program list_comprehension
  integer, parameter :: n = 20
  integer, parameter :: m = n*(n+1)/2
  integer :: i, j
  complex, dimension(m) :: a
  real, dimension(m) :: b
  logical, dimension(m) :: c
  integer, dimension(3, m) :: d
  a = [ ( ( cmplx(i,j), i=j,n), j=1,n) ] ! list comprehension, implicit do loop
  b = abs(a)
  c = (b .eq. int(b)) .and. (b .le. n)
  i = sum(merge(1,0,c))
  d(2,:i) = int(real(pack(a, c))) ! list comprehensions: array
  d(1,:i) = int(imag(pack(a, c))) ! assignments and operations.
  d(3,:i) = int(pack(b,c))
  print '(3i4)',d(:,:i)
end program list_comprehension


Dim As Integer x, y, z, n = 25
For  x = 1 To n
    For  y = x To n
        For  z = y To n
            If x^2 + y^2 = z^2 Then Print Using "{##_, ##_, ##}"; x; y; z
        Next z
    Next y
Next x
Sleep


package main

import "fmt"

type (
    seq  []int
    sofs []seq
)

func newSeq(start, end int) seq {
    if end < start {
        end = start
    }
    s := make(seq, end-start+1)
    for i := 0; i < len(s); i++ {
        s[i] = start + i
    }
    return s
}

func newSofs() sofs {
    return sofs{seq{}}
}

func (s sofs) listComp(in seq, expr func(sofs, seq) sofs, pred func(seq) bool) sofs {
    var s2 sofs
    for _, t := range expr(s, in) {
        if pred(t) {
            s2 = append(s2, t)
        }
    }
    return s2
}

func (s sofs) build(t seq) sofs {
    var u sofs
    for _, ss := range s {
        for _, tt := range t {
            uu := make(seq, len(ss))
            copy(uu, ss)
            uu = append(uu, tt)
            u = append(u, uu)
        }
    }
    return u
}

func main() {
    pt := newSofs()
    in := newSeq(1, 20)
    expr := func(s sofs, t seq) sofs {
        return s.build(t).build(t).build(t)
    }
    pred := func(t seq) bool {
        if len(t) != 3 {
            return false
        }
        return t[0]*t[0]+t[1]*t[1] == t[2]*t[2] && t[0] < t[1] && t[1] < t[2]
    }
    pt = pt.listComp(in, expr, pred)
    fmt.Println(pt)
}


require'stats'
buildSet=:conjunction def '(#~ v) u y'
triples=: 1 + 3&comb
isPyth=: 2&{"1 = 1&{"1 +&.:*: 0&{"1
pythTr=: triples buildSet isPyth


// Boilerplate
import java.util.Arrays;
import java.util.List;
import static java.util.function.Function.identity;
import static java.util.stream.Collectors.toList;
import static java.util.stream.IntStream.range;
public interface PythagComp{
    static void main(String... args){
        System.out.println(run(20));
    }

    static List<List<Integer>> run(int n){
        return
            // Here comes the list comprehension bit
            // input stream - bit clunky
            range(1, n).mapToObj(
                x -> range(x, n).mapToObj(
                    y -> range(y, n).mapToObj(
                        z -> new Integer[]{x, y, z}
                    )
                )
            )
                .flatMap(identity())
                .flatMap(identity())
                // predicate
                .filter(a -> a[0]*a[0] + a[1]*a[1] == a[2]*a[2])
                // output expression
                .map(Arrays::asList)
                // the result is a list
                .collect(toList())
        ;
    }
}


// USING A LIST MONAD DIRECTLY, WITHOUT SPECIAL SYNTAX FOR LIST COMPREHENSIONS

(function (n) {

    return mb(r(1,     n), function (x) {  // x <- [1..n]
    return mb(r(1 + x, n), function (y) {  // y <- [1+x..n]
    return mb(r(1 + y, n), function (z) {  // z <- [1+y..n]

       return x * x + y * y === z * z ? [[x, y, z]] : [];

    })})});

    // LIBRARY FUNCTIONS

    // Monadic bind for lists
    function mb(xs, f) {
        return [].concat.apply([], xs.map(f));
    }

    // Monadic return for lists is simply lambda x -> [x]
    // as in [[x, y, z]] : [] above

    // Integer range [m..n]
    function r(m, n) {
        return Array.apply(null, Array(n - m + 1))
            .map(function (n, x) {
                return m + x;
            });
    }

})(100);


T LinearCongruentialGenerator
   seed = 0
   Int a, c, m

   F (a, c, m)
      .a = a
      .c = c
      .m = m

   F ()()
      .seed = (.a * .seed + .c) [&] .m
      R .seed

V bsd_rnd = LinearCongruentialGenerator(1103515245, 12345, 7FFF'FFFF)
V ms_rnd  = LinearCongruentialGenerator(214013, 2531011, 7FFF'FFFF)

print(‘BSD RAND:’)
L 5
   print(bsd_rnd())
print()
print(‘MS RAND:’)
L 5
   print(ms_rnd() >> 16)


def triples(n):
  range(1;n+1) as $x | range($x;n+1) as $y | range($y;n+1) as $z
  | select($x*$x + $y*$y == $z*$z)
  | [$x, $y, $z] ;


// version 1.0.6

fun pythagoreanTriples(n: Int) =
    (1..n).flatMap {
        x -> (x..n).flatMap {
            y -> (y..n).filter {
                z ->  x * x + y * y == z * z
            }.map { Triple(x, y, it) }
        }
    }

fun main(args: Array<String>) {
    println(pythagoreanTriples(20))
}


#!/usr/bin/lasso9

local(n = 20)
local(triples =
  with x in generateSeries(1, #n),
       y in generateSeries(#x, #n),
       z in generateSeries(#y, #n)
    where #x*#x + #y*#y == #z*#z
  select (:#x, #y, #z)
)
#triples->join('\n')


*        Linear congruential generator   07/03/2017
LINCONG  CSECT
         USING  LINCONG,R12
         LR     R12,R15            set base register
BEGIN    SR     R5,R5              bsdseed=0
         SR     R7,R7              msseed=0
         LA     R8,1               i=1
         L      R9,=F'10'          number of loop
LOOP     M      R4,=F'1103515245'  bsdseed*=1103515245
         A      R5,=F'12345'       bsdseed+=12345
         LR     R3,R5              bsdrand=bsdseed
         LTR    R5,R5              if bsdseed<0
         BP     CONT               then
         L      R3,COMP2             -2**31
         SR     R3,R5                -bsdseed
         LPR    R3,R3                bsdrand=abs(-2**31-bsdseed)
CONT     M      R6,=F'214013'      msseed*=214013
         A      R7,=F'2531011'     msseed+=2531011
         XR     R6,R6
         D      R6,TWO16           /2**16
         XDECO  R8,XDEC            i
         MVC    PG(4),XDEC+8
         XDECO  R3,XDEC            bsdrand
         MVC    PG+4(12),XDEC
         XDECO  R7,XDEC            msseed
         MVC    PG+16(7),XDEC+5
         XPRNT  PG,L'PG            print buffer
         LA     R8,1(R8)           i=i+1
         BCT    R9,LOOP            loop
RETURN   XR     R15,R15            set return code
         BR     R14                return to caller
         DS     0F                 alignment
TWO16    DC     XL4'00010000'      2**16
COMP2    DC     XL4'80000000'      -2**31
PG       DC     CL80' '
XDEC     DS     CL12
         YREGS
         END    LINCONG


generic
   type Base_Type is mod <>;
   Multiplyer, Adder: Base_Type;
   Output_Divisor: Base_Type := 1;
package LCG is

   procedure Initialize(Seed: Base_Type);
   function Random return Base_Type;
   -- changes the state and outputs the result

end LCG;


BEGIN
COMMENT
   Algol 68 Genie checks for integer overflow whereas the reference
   language leaves the result undefined so for portability we need to
   see how wide a variable must be to hold the maximum possible value
   before range reduction. This occurs in the BSD RNG when
   rseed=2147483647 and is therefore 2147483647 * 1103515245 + 12345 =
   2369780942852710860, which itself is 19 decimal digits.  Use
   evironmental queries to determine the width needed.
COMMENT
   MODE RANDINT = UNION (INT, LONG INT, LONG LONG INT);
   RANDINT rseed := (int width > 18 | 0 |:
		     long int width > 18 |
		     LONG 0 | LONG LONG 0);
   PROC srand = (INT x) VOID :
   (rseed | (INT): rseed := x,
    (LONG INT): rseed := LENG x | rseed := LENG LENG x);
   PROC bsd rand = INT :
   BEGIN
      CASE rseed IN
      (INT ri):
      BEGIN
	 INT a = 1103515245, c = 12345, m1 = 2^16, m2 = 2^15;
COMMENT
   That curious declaration is because 2^31 might overflow during
   compilation but the MODE declaration for RANDINT guarantees that it
   will not overflow at run-time.  We assume that an INT is at least
   32 bits wide, otherwise a similar workaround would be needed for
   the declaration of a.
COMMENT
	 INT result = (ri * a + c) MOD (m1 * m2); rseed := result;
	 result
      END,
      (LONG INT rli):
      BEGIN
	 LONG INT a = LONG 1103515245, c = LONG 12345, m = LONG 2^31;
	 LONG INT result = (rli * a + c) MOD m; rseed := result;
	 SHORTEN result
      END,
      (LONG LONG INT rlli) :
      BEGIN
	 LONG LONG INT a = LONG LONG 1103515245,
	 c = LONG LONG 12345, m = LONG LONG 2^31;
	 LONG LONG INT result = (rlli * a + c) MOD  m; rseed := result;
	 SHORTEN SHORTEN result
      END
      ESAC
   END;
   PROC ms rand = INT :
   BEGIN
      CASE rseed IN
      (INT ri):
      BEGIN
	 INT a = 214013, c = 2531011, m1 = 2^15, m2 = 2^16;
	 INT result = (ri * a + c) MOD (m1 * m2); rseed := result;
	 result % m2
      END,
      (LONG INT rli):
      BEGIN
	 LONG INT a = LONG 214013, c = LONG 2531011, m = LONG 2^31, m2 = LONG 2^16;
	 LONG INT result = (rli * a + c) MOD m; rseed := result;
	 SHORTEN (result % m2)
      END,
      (LONG LONG INT rlli) :
      BEGIN
	 LONG LONG INT a = LONG LONG 214013,
	 c = LONG LONG 2531011, m = LONG LONG 2^31, m2 = LONG LONG 2^16;
	 LONG LONG INT result = (rlli * a + c) MOD m; rseed := result;
	 SHORTEN SHORTEN (result % m2)
      END
      ESAC
   END;
   srand (0);
   TO 10 DO printf (($g(0)l$, bsd rand)) OD;
   print (newline);
   srand (0);
   TO 10 DO printf (($g(0)l$, ms rand)) OD;
   srand (0)
END


LC={}
LC.__index = LC

function LC:new(o)
  o = o or {}
  setmetatable(o, self)
  return o
end

function LC:add_iter(func)
  local prev_iter = self.iter
  self.iter = coroutine.wrap(
    (prev_iter == nil) and (function() func{} end)
    or (function() for arg in prev_iter do func(arg) end end))
  return self
end

function maybe_call(maybe_func, arg)
  if type(maybe_func) == "function" then return maybe_func(arg) end
  return maybe_func
end

function LC:range(key, first, last)
  return self:add_iter(function(arg)
    for value=maybe_call(first, arg), maybe_call(last, arg) do
      arg[key] = value
      coroutine.yield(arg)
    end
  end)
end

function LC:where(pred)
  return self:add_iter(function(arg) if pred(arg) then coroutine.yield(arg) end end)
end


@echo off & setlocal enabledelayedexpansion

echo BSD Rand
set /a a=0,cnt=1
:b
set /a "a=1103515245 *a+12345,a&=0x7fffffff, cnt+=1"
call:prettyprint !cnt! !a!
if !cnt! leq 10 goto :b

echo.
echo Microsoft Rand
set /a a=0,cnt=1
:c
set /a "a=214013 *a+2531011,a&=0x7fffffff, b=a>>16,cnt+=1"
call:prettyprint !cnt! !b!
if !cnt! lss 10 goto :c
pause
goto:eof

:prettyprint
set p1= %1
set p2=        %2
echo %p1:~-2%  %p2:~-10%
goto:eof


      @% = &D0D
      PRINT "MS generator:"
      dummy% = FNrandMS(0)
      FOR i% = 1 TO 10
        PRINT FNrandMS(-1)
      NEXT
      PRINT '"BSD generator:"
      dummy% = FNrandBSD(0)
      FOR i% = 1 TO 10
        PRINT FNrandBSD(-1)
      NEXT
      END

      DEF FNrandMS(seed%)
      PRIVATE state%
      IF seed% >= 0 THEN
        state% = seed%
      ELSE
        state% = FNmuladd(state%, 214013, 2531011)
      ENDIF
      = state% >> 16

      DEF FNrandBSD(seed%)
      PRIVATE state%
      IF seed% >= 0 THEN
        state% = seed%
      ELSE
        state% = FNmuladd(state%, 1103515245, 12345)
      ENDIF
      = state%

      DEF FNmuladd(A%,B%,C%) : PRIVATE M% : LOCAL P% : IF M% = 0 DIM P% 8
      IF P% THEN [OPT 0 : .M% mul ebx : add eax,ecx : btr eax,31 : ret :]
      = USR M%


:- module pythtrip.
:- interface.
:- import_module io.
:- import_module int.

:- type triple ---> triple(int, int, int).

:- pred pythTrip(int::in,triple::out) is nondet.
:- pred main(io::di, io::uo) is det.

:- implementation.
:- import_module list.
:- import_module solutions.
:- import_module math.

pythTrip(Limit,triple(X,Y,Z)) :-
    nondet_int_in_range(1,Limit,X),
    nondet_int_in_range(X,Limit,Y),
    nondet_int_in_range(Y,Limit,Z),
    pow(Z,2) = pow(X,2) + pow(Y,2).

main(!IO) :-
     solutions((pred(Triple::out) is nondet :- pythTrip(20,Triple)),Result),
     write(Result,!IO).


using System;
using System.Console;
using System.Collections.Generic;

module Program
{

    PythTriples(n : int) : list[int * int * int]
    {
        $[ (x, y, z) | x in [1..n], y in [x..n], z in [y..n], ((x**2) + (y**2)) == (z**2) ]
    }

    GetPythTriples(n : int) : IEnumerable[int * int * int]
    {
        foreach (x in [1..n])
        {
            foreach (y in [x..n])
            {
                foreach (z in [y..n])
                {
                    when (((x**2) + (y**2)) == (z**2))
                    {
                        yield (x, y, z)
                    }
                }
            }
        }
    }

    Main() : void
    {
        WriteLine("Pythagorean triples up to x = 20: {0}", PythTriples(20));

        foreach (triple in GetPythTriples(20))
        {
            Write(triple)
        }
    }
}


import sugar, math

let n = 20
let triplets = collect(newSeq):
  for x in 1..n:
    for y in x..n:
      for z in y..n:
        if x^2 + y^2 == z^2:
          (x,y,z)
echo triplets


functor
import
   LazyList
   Application
   System
define

   fun {Pyth N}
      <<list [X Y Z] with
	 X <- {List.number 1 N 1}
	 Y <- {List.number X N 1}
	 Z <- {List.number Y N 1}
	 where X*X + Y*Y == Z*Z
      >>
   end

   {ForAll {Pyth 20} System.show}

   {Application.exit 0}
end


F bagchain(x, n, bb, start = 0)
   I n == 0
      R [x]

   [(Int, String)] out
   L(i) start .< bb.len
      V (c, s) = bb[i]
      I c <= n
         out.extend(bagchain((x[0] + c, x[1]‘’s), n - c, bb, i))

   R out

F bags(n)
   I n == 0
      R [(0, ‘’)]

   [(Int, String)] upto
   L(x) (n - 1 .< 0).step(-1)
      upto.extend(bags(x))

   R bagchain((0, ‘’), n - 1, upto).map((c, s) -> (c + 1, ‘(’s‘)’))

F replace_brackets(s)
   V depth = 0
   [String] out
   L(c) s
      I c == ‘(’
         out.append(‘([{’[depth % 3])
         depth++
      E
         depth--
         out.append(‘)]}’[depth % 3])
   R out.join(‘’)

L(x) bags(5)
   print(replace_brackets(x[1]))


/* BSD rand */

define rand() {
	randseed = (randseed * 1103515245 + 12345) % 2147483648
	return randseed
}

randseed = 1
rand(); rand(); rand(); print "\n"

/* Microsoft rand */

define rand() {
	randseed = (randseed * 214013 + 2531011) % 2147483648
	return randseed / 65536
}

randseed = 1
rand(); rand(); rand(); print "\n"


#include <stdio.h>

/* always assuming int is at least 32 bits */
int rand();
int rseed = 0;

inline void srand(int x)
{
	rseed = x;
}

#ifndef MS_RAND
#define RAND_MAX ((1U << 31) - 1)

inline int rand()
{
	return rseed = (rseed * 1103515245 + 12345) & RAND_MAX;
}

#else /* MS rand */

#define RAND_MAX_32 ((1U << 31) - 1)
#define RAND_MAX ((1U << 15) - 1)

inline int rand()
{
	return (rseed = (rseed * 214013 + 2531011) & RAND_MAX_32) >> 16;
}

#endif/* MS_RAND */

int main()
{
	int i;
	printf("rand max is %d\n", RAND_MAX);

	for (i = 0; i < 100; i++)
		printf("%d\n", rand());

	return 0;
}


global function new_dict(integer pool_only=0)
global procedure destroy_dict(integer tid, integer justclear=0)
global procedure setd(object key, object data, integer tid=1)
global function getd(object key, integer tid=1)
global procedure destroy_dict(integer tid, integer justclear=0)
global function getd_index(object key, integer tid=1)
global function getd_by_index(integer node, integer tid=1)
global procedure deld(object key, integer tid=1)
global procedure traverse_dict(integer rid, object user_data=0, integer tid=1)
global function dict_size(integer tid=1)


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

typedef unsigned int uint;
typedef unsigned long long tree;
#define B(x) (1ULL<<(x))

tree *list = 0;
uint cap = 0, len = 0;
uint offset[32] = {0, 1, 0};

void append(tree t)
{
	if (len == cap) {
		cap = cap ? cap*2 : 2;
		list = realloc(list, cap*sizeof(tree));
	}
	list[len++] = 1 | t<<1;
}

void show(tree t, uint len)
{
	for (; len--; t >>= 1)
		putchar(t&1 ? '(' : ')');
}

void listtrees(uint n)
{
	uint i;
	for (i = offset[n]; i < offset[n+1]; i++) {
		show(list[i], n*2);
		putchar('\n');
	}
}

/* assemble tree from subtrees
	n:   length of tree we want to make
	t:   assembled parts so far
	sl:  length of subtree we are looking at
	pos: offset of subtree we are looking at
	rem: remaining length to be put together
*/
void assemble(uint n, tree t, uint sl, uint pos, uint rem)
{
	if (!rem) {
		append(t);
		return;
	}

	if (sl > rem) // need smaller subtrees
		pos = offset[sl = rem];
	else if (pos >= offset[sl + 1]) {
		// used up sl-trees, try smaller ones
		if (!--sl) return;
		pos = offset[sl];
	}

	assemble(n, t<<(2*sl) | list[pos], sl, pos, rem - sl);
	assemble(n, t, sl, pos + 1, rem);
}

void mktrees(uint n)
{
	if (offset[n + 1]) return;
	if (n) mktrees(n - 1);

	assemble(n, 0, n-1, offset[n-1], n-1);
	offset[n+1] = len;
}

int main(int c, char**v)
{
	int n;
	if (c < 2 || (n = atoi(v[1])) <= 0 || n > 25) n = 5;

	// init 1-tree
	append(0);

	mktrees((uint)n);
	fprintf(stderr, "Number of %d-trees: %u\n", n, offset[n+1] - offset[n]);
	listtrees((uint)n);

	return 0;
}


using System;
using System.Collections.Generic;
using System.Linq;
using static System.Console;

namespace LinearCongruentialGenerator
{
    static class LinearCongruentialGenerator
    {
        static int _seed = (int)DateTime.Now.Ticks; // from bad random gens might as well have bad seed!
        static int _bsdCurrent = _seed;
        static int _msvcrtCurrent = _seed;

        static int Next(int seed, int a, int b) => (a * seed + b) & int.MaxValue;

        static int BsdRand() => _bsdCurrent = Next(_bsdCurrent, 1103515245, 12345);

        static int MscvrtRand() => _msvcrtCurrent = Next (_msvcrtCurrent << 16,214013,2531011) >> 16;

        static void PrintRandom(int count, bool isBsd)
        {
            var name = isBsd ? "BSD" : "MS";
            WriteLine($"{name} next {count} Random");
            var gen = isBsd ? (Func<int>)(BsdRand) : MscvrtRand;
            foreach (var r in Enumerable.Repeat(gen, count))
                WriteLine(r.Invoke());
        }

        static void Main(string[] args)
        {
            PrintRandom(10, true);
            PrintRandom(10, false);
            Read();
        }
    }
}


(de pythag (N)
   (job '((X . 1) (Y . 1) (Z . 0))
      (loop
         (when (> (inc 'Z) N)
            (when (> (inc 'Y) N)
               (setq Y (inc 'X)) )
            (setq Z Y) )
         (T (> X N))
         (T (= (+ (* X X) (* Y Y)) (* Z Z))
            (list X Y Z) ) ) ) )

(while (pythag 20)
   (println @) )


% We need operators
:- op(700, xfx, <-).
:- op(450, xfx, ..).
:- op(1100, yfx, &).

% use for explicit list usage
my_bind(V, [H|_]) :- V = H.
my_bind(V, [_|T]) :- my_bind(V, T).

% we need to define the intervals of numbers
Vs <- M..N :-
        integer(M),
	integer(N),
	M =< N,
	between(M, N, Vs).

% for explicit list comprehension like Vs <- [1,2,3]
Vs <- Xs :-
	is_list(Xs),
	my_bind(Vs, Xs).

% finally we define list comprehension
% prototype is Vs <- {Var, Dec, Pred} where
% Var is the list of variables to output
% Dec is the list of intervals of the variables
% Pred is the list of predicates
Vs <- {Var & Dec & Pred} :-
	findall(Var,  maplist(call, [Dec, Pred]), Vs).

% for list comprehension without Pred
Vs <- {Var & Dec} :-
	findall(Var, maplist(call, [Dec]), Vs).


#include <iostream>
#include <vector>

std::vector<long> TREE_LIST;
std::vector<int> OFFSET;

void init() {
    for (size_t i = 0; i < 32; i++) {
        if (i == 1) {
            OFFSET.push_back(1);
        } else {
            OFFSET.push_back(0);
        }
    }
}

void append(long t) {
    TREE_LIST.push_back(1 | (t << 1));
}

void show(long t, int l) {
    while (l-- > 0) {
        if (t % 2 == 1) {
            std::cout << '(';
        } else {
            std::cout << ')';
        }
        t = t >> 1;
    }
}

void listTrees(int n) {
    for (int i = OFFSET[n]; i < OFFSET[n + 1]; i++) {
        show(TREE_LIST[i], 2 * n);
        std::cout << '\n';
    }
}

void assemble(int n, long t, int sl, int pos, int rem) {
    if (rem == 0) {
        append(t);
        return;
    }

    auto pp = pos;
    auto ss = sl;

    if (sl > rem) {
        ss = rem;
        pp = OFFSET[ss];
    } else if (pp >= OFFSET[ss + 1]) {
        ss--;
        if (ss == 0) {
            return;
        }
        pp = OFFSET[ss];
    }

    assemble(n, t << (2 * ss) | TREE_LIST[pp], ss, pp, rem - ss);
    assemble(n, t, ss, pp + 1, rem);
}

void makeTrees(int n) {
    if (OFFSET[n + 1] != 0) {
        return;
    }
    if (n > 0) {
        makeTrees(n - 1);
    }
    assemble(n, 0, n - 1, OFFSET[n - 1], n - 1);
    OFFSET[n + 1] = TREE_LIST.size();
}

void test(int n) {
    if (n < 1 || n > 12) {
        throw std::runtime_error("Argument must be between 1 and 12");
    }

    append(0);

    makeTrees(n);
    std::cout << "Number of " << n << "-trees: " << OFFSET[n + 1] - OFFSET[n] << '\n';
    listTrees(n);
}

int main() {
    init();
    test(5);

    return 0;
}


(defun make-rng (&key (seed 0) (mode nil))
  "returns an RNG according to :seed and :mode keywords
  default mode: bsd
  default seed: 0 (should be 1 actually)"
  (if (eql mode 'ms)
    #'(lambda ()
	(ash (setf seed (mod (+ (* 214013 seed) 2531011) (expt 2 31))) -16))
    #'(lambda () (setf seed (mod (+ (* seed 1103515245) 12345) (expt 2 31))))))

(let ((rng (make-rng)))
      (dotimes (x 10) (format t "BSD: ~d~%" (funcall rng))))

(let ((rng (make-rng :mode 'ms :seed 1)))
      (dotimes (x 10) (format t "MS: ~d~%" (funcall rng))))


[(x,y,z) for x in xrange(1,n+1) for y in xrange(x,n+1) for z in xrange(y,n+1) if x**2 + y**2 == z**2]


#lang racket
(for*/list ([x (in-range 1 21)]
            [y (in-range x 21)]
            [z (in-range y 21)]
            #:when (= (+ (* x x) (* y y)) (* z z)))
  (list x y z))


import std.stdio, std.conv;

alias Tree = ulong,
      TreeList = Tree[],
      Offset = uint[32];

void listTees(in uint n, in ref Offset offset, in TreeList list) nothrow @nogc @safe {
    static void show(in Tree t, in uint len) nothrow @nogc @safe {
        foreach (immutable i; 0 .. len)
            putchar(t & (2 ^^ i) ? '(' : ')');
    }

    foreach (immutable i; offset[n] .. offset[n + 1]) {
        show(list[i], n * 2);
        putchar('\n');
    }
}

void append(in Tree t, ref TreeList list, ref uint len) pure nothrow @safe {
    if (len == list.length)
        list.length = list.length ? list.length * 2 : 2;
    list[len] = 1 | (t << 1);
    len++;
}

/**
Assemble tree from subtrees.

Params:
  n   = length of tree we want to make.
  t   = assembled parts so far.
  sl  = length of subtree we are looking at.
  pos = offset of subtree we are looking at.
  rem = remaining length to be put together.
*/
void assemble(in uint n, in Tree t, uint sl, uint pos, in uint rem, in ref Offset offset,
              ref TreeList list, ref uint len) pure nothrow @safe {
    if (!rem) {
        append(t, list, len);
        return;
    }

    if (sl > rem) { // Need smaller subtrees.
        sl = rem;
        pos = offset[sl];
    } else if (pos >= offset[sl + 1]) {
        // Used up sl-trees, try smaller ones.
        sl--;
        if (!sl)
            return;
        pos = offset[sl];
    }

    assemble(n, t << (2 * sl) | list[pos], sl, pos, rem - sl, offset, list, len);
    assemble(n, t, sl, pos + 1, rem, offset, list, len);
}

void makeTrees(in uint n, ref Offset offset,
               ref TreeList list, ref uint len) pure nothrow @safe {
    if (offset[n + 1])
        return;
    if (n)
        makeTrees(n - 1, offset, list, len);

    assemble(n, 0, n - 1, offset[n - 1], n - 1, offset, list, len);
    offset[n + 1] = len;
}

void main(in string[] args) {
    immutable uint n = (args.length == 2) ? args[1].to!uint : 5;
    if (n >= 25)
        return;

    Offset offset;
    offset[1] = 1;

    Tree[] list;
    uint len = 0;

    // Init 1-tree.
    append(0, list, len);

    makeTrees(n, offset, list, len);
    stderr.writefln("Number of %d-trees: %u", n, offset[n + 1] - offset[n]);
    listTees(n, offset, list);
}


struct LinearCongruentialGenerator {
    enum uint RAND_MAX = (1U << 31) - 1;
    uint seed = 0;

    uint randBSD() pure nothrow @nogc {
        seed = (seed * 1_103_515_245 + 12_345) & RAND_MAX;
        return seed;
    }

    uint randMS() pure nothrow @nogc {
        seed = (seed * 214_013 + 2_531_011) & RAND_MAX;
        return seed >> 16;
    }
}

void main() {
    import std.stdio;

    LinearCongruentialGenerator rnd;

    foreach (immutable i; 0 .. 10)
        writeln(rnd.randBSD);
    writeln;

    rnd.seed = 0;
    foreach (immutable i; 0 .. 10)
        writeln(rnd.randMS);
}


[*
 * lrx -- (random number from 0 to 2147483647)
 *
 * Returns a number from the BSD rand() sequence.
 * Seeded by storing a seed in register R.
 *]sz
[lR 1103515245 * 12345 + 2147483648 % d sR]sr

[* Set seed to 1, then print the first 3 random numbers. *]sz
1 sR
lrx psz lrx psz lrx psz


public list[tuple[int, int, int]]  PythTriples(int n) = [<a, b, c> | a <- [1..n], b <- [1..n], c <- [1 .. n], a*a + b*b == c*c];


/*REXX program displays a vertical list of Pythagorean triples up to a specified number.*/
parse arg n .                                    /*obtain optional argument from the CL.*/
if n=='' | n==","  then n= 100                   /*Not specified?  Then use the default.*/
say  'Pythagorean triples  (a² + b² = c²,   c ≤'  n"):"     /*display the list's title. */
$=                                               /*assign a  null  to the triples list. */
            do     a=1   for n-2;  aa=a*a
              do   b=a+1  to n-1;  ab=aa + b*b
                do c=b+1  to n  ;  cc= c*c
                if ab<cc   then leave            /*Too small?   Then try the next  B.   */
                if ab==cc  then do;  $=$  '{'a","   ||   b','c"}";  leave;  end
                end   /*c*/
              end     /*b*/
            end       /*a*/
#= words($);                       sat
            do j=1  for #
            say  left('', 20)      word($, j)    /*display  a  member  of the list,     */
            end       /*j*/                      /* [↑]   list the members vertically.  */
say
say #  ' members listed.'                        /*stick a fork in it,  we're all done. */


for  x = 1 to 20
     for  y = x to 20
          for  z = y to 20
               if pow(x,2) + pow(y,2) = pow(z,2)
                  see "[" + x + "," + y + "," + z + "]" + nl ok
          next
     next
next


n = 20

# select Pythagorean triplets
r = ((1..n).flat_map { |x|
       (x..n).flat_map { |y|
         (y..n).flat_map { |z|
           [[x, y, z]].keep_if { x * x + y * y == z * z }}}})

p r # print the array _r_


package main

import (
    "fmt"
    "log"
    "os"
    "strconv"
)

type tree uint64

var (
    list   []tree
    offset = [32]uint{1: 1}
)

func add(t tree) {
    list = append(list, 1|t<<1)
}

func show(t tree, l uint) {
    for ; l > 0; t >>= 1 {
        l--
        var paren byte
        if (t & 1) != 0 {
            paren = '('
        } else {
            paren = ')'
        }
        fmt.Printf("%c", paren)
    }
}

func listTrees(n uint) {
    for i := offset[n]; i < offset[n+1]; i++ {
        show(list[i], n*2)
        fmt.Println()
    }
}

/* assemble tree from subtrees
n:   length of tree we want to make
t:   assembled parts so far
sl:  length of subtree we are looking at
pos: offset of subtree we are looking at
rem: remaining length to be put together
*/

func assemble(n uint, t tree, sl, pos, rem uint) {
    if rem == 0 {
        add(t)
        return
    }

    if sl > rem { // need smaller sub-trees
        sl = rem
        pos = offset[sl]
    } else if pos >= offset[sl+1] {
        // used up sl-trees, try smaller ones
        sl--
        if sl == 0 {
            return
        }
        pos = offset[sl]
    }

    assemble(n, t<<(2*sl)|list[pos], sl, pos, rem-sl)
    assemble(n, t, sl, pos+1, rem)
}

func mktrees(n uint) {
    if offset[n+1] > 0 {
        return
    }
    if n > 0 {
        mktrees(n - 1)
    }

    assemble(n, 0, n-1, offset[n-1], n-1)
    offset[n+1] = uint(len(list))
}

func main() {
    if len(os.Args) != 2 {
        log.Fatal("There must be exactly 1 command line argument")
    }
    n, err := strconv.Atoi(os.Args[1])
    if err != nil {
        log.Fatal("Argument is not a valid number")
    }
    if n <= 0 || n > 19 { // stack overflow for n == 20
        n = 5
    }
    // init 1-tree
    add(0)

    mktrees(uint(n))
    fmt.Fprintf(os.Stderr, "Number of %d-trees: %d\n", n, offset[n+1]-offset[n])
    listTrees(uint(n))
}


program Linear_congruential_generator;

{$APPTYPE CONSOLE}
{$R *.res}

uses
  System.SysUtils,
  Winapi.Windows;

type
  TRandom = record
  private
    FSeed: Cardinal;
    FBsdCurrent: Cardinal;
    FMsvcrtCurrent: Cardinal;
    class function Next(seed, a, b: Cardinal): Cardinal; static;
  public
    constructor Create(const seed: Cardinal);
    function Rand(Bsd: Boolean = True): Cardinal;
    property Seed: Cardinal read FSeed;
  end;

{ TRandom }

class function TRandom.Next(seed, a, b: Cardinal): Cardinal;
begin
  Result := (a * seed + b) and MAXDWORD;
end;

function TRandom.Rand(Bsd: Boolean): Cardinal;
begin
  if Bsd then
  begin
    FBsdCurrent := Next(FBsdCurrent, 1103515245, 12345);
    Result := FBsdCurrent;
  end
  else
  begin
    FMsvcrtCurrent := Next(FMsvcrtCurrent shl 16, 214013, 2531011) shr 16;
    Result := FMsvcrtCurrent;
  end;
end;

constructor TRandom.Create(const seed: Cardinal);
begin
  FSeed := seed;
  FBsdCurrent := FSeed;
  FMsvcrtCurrent := FSeed;
end;

var
  r: TRandom;

procedure PrintRandom(count: Integer; IsBsd: Boolean);
const
  NAME: array[Boolean] of string = ('MS', 'BSD');
var
  i: Integer;
begin
  Writeln(NAME[IsBsd], ' next ', count, ' Random'#10);
  for i := 0 to count - 1 do
    writeln('   ', r.Rand(IsBsd));
  writeln;
end;

begin
  r.Create(GetTickCount);
  PrintRandom(10, True);
  PrintRandom(10, False);
  readln;
end.


for  x = 1 to 20
 for  y = x to 20
  for  z = y to 20
   if x^2 + y^2 = z^2 then  print "[";x;",";y;",";z;"]"
  next z
 next y
next x


fn pyth(n: u32) -> impl Iterator<Item = [u32; 3]> {
    (1..=n).flat_map(move |x| {
        (x..=n).flat_map(move |y| {
            (y..=n).filter_map(move |z| {
                if x.pow(2) + y.pow(2) == z.pow(2) {
                    Some([x, y, z])
                } else {
                    None
                }
            })
        })
    })
}


def pythagoranTriangles(n: Int) = for {
  x <- 1 to 21
  y <- x to 21
  z <- y to 21
  if x * x + y * y == z * z
} yield (x, y, z)


(list-ec (:range x 1 21)
         (:range y x 21)
         (:range z y 21)
         (if (= (* z z) (+ (* x x) (* y y))))
         (list x y z))


var n = 20
say gather {
    for x in (1 .. n) {
        for y in (x .. n) {
           for z in (y .. n) {
             take([x,y,z]) if (x*x + y*y == z*z)
           }
        }
    }
}


-- break n down into sum of smaller integers
parts :: Int -> [[(Int, Int)]]
parts n = f n 1
  where
    f n x
      | n == 0 = [[]]
      | x > n = []
      | otherwise =
        f n (x + 1) ++
        concatMap
          (\c -> map ((c, x) :) (f (n - c * x) (x + 1)))
          [1 .. n `div` x]

-- choose n strings out of a list and join them
pick :: Int -> [String] -> [String]
pick _ [] = []
pick 0 _ = [""]
pick n aa@(a:as) = map (a ++) (pick (n - 1) aa) ++ pick n as

-- pick parts to build a series of subtrees that add up to n-1,
-- then wrap them up
trees :: Int -> [String]
trees n =
  map (\x -> "(" ++ x ++ ")") $
  concatMap (foldr (prod . build) [""]) (parts (n - 1))
  where
    build (c, x) = pick c $ trees x
    prod aa bb =
      [ a ++ b
      | a <- aa
      , b <- bb ]

main :: IO ()
main = mapM_ putStrLn $ trees 5


 [Linear congruential generators for pseudo-random numbers.
  EDSAC program, Initial Orders 2.]

 [Library subroutine R9, to read integer constants at load time.
  See Wilkes, Wheeler & Gill, 1951 edition, pages 98 & 148.]
  ..PK
  T 56 K [must be loaded at 56]
  [email protected]@[email protected]@

 [Modification of library subroutine P7.
  Prints non-negative integer, up to 10 digits, right-justified.
  55 locations, load at even address.
  Set up to be called with 'G N', so that caller needn't know its address.
  See Wilkes, Wheeler & Gill, 1951 edition, page 18.]
            T  46 K  [location corresponding to N parameter]
            P  72 F  [load subroutine at 72]
            E  25 K  TN
  [email protected]@[email protected]@[email protected]@[email protected]#@[email protected]
  [email protected]@[email protected]@[email protected]@[email protected]@
  [email protected]@[email protected][email protected]@[email protected]@

 [BSD linear congruential generator.
  Call with 'G B' to initialize, passing seed in 0D.
  Call with 'G 1 B' to get next value, returned in 0D.]
            T  53 K  [location corresponding to B parameter]
            P 140 F  [load subroutine at 140]
            E  25 K  TB GK
      [0]   G  10 @  [jump to initialize]
      [1]   G  15 @  [jump to get next value]
      [2]   PF  PF   [mask, 2^31 - 1]
      [4]   PF  PF   [multiplier]
      [6]   PF  PF   [added constant]
         [Call R9 to set the 3 preceding constants at load time.]
            E69KT2#@
            2147483647F1103515245F12345#
            T8Z
      [8]   PF  PF    [current state]

         [Initialize; caller places seed in 0D]
     [10]   A    3 F  [make jump back to caller]
            T   14 @  [plant in code]
            A      D  [load seed passed by caller]
            T    8#@  [store as initial state]
     [14]   Z      F  [overwritten by jump back to caller]

         [Get next value from BSD; return it in 0D]
     [15]   A    3 F  [make jump back to caller]
            T   28 @  [plant in code, acc := 0]
            H    4#@  [mult reg := multiplier]
            V    8#@  [acc := state * multiplier]
            LF  LF  L64F  [shift 34 left, done as 13 + 13 + 8]
            A    6#@  [add the constant]
            T      D  [temp store in 0D]
            H    2#@  [mult reg := mask]
            C      D  [acc := result modulo 2^31]
            U    8#@  [update state]
            T      D  [also to 0D for caller]
     [28]   Z      F  [overwritten by jump back to caller]

 [Microsoft linear congruential generator.
  Call with 'G M' to initialize, passing seed in 0D.
  Call with 'G 1 M' to get next value, returned in 0D.
  Very similar to code for BSD, so given in condensed form.]
  [email protected]@PFPFPFPFPFPFE69KT2#@
         2147483647F214013F2531011# [the 3 constants]
  [email protected]#@[email protected]#@V8#@LFLFL64FA6#@TDH2#@CDU8#@
 [Unlike BSD, MS returns the state divided by 2^16]
            RF  RD  [shift 16 right, done as 15 + 1]
            T    D  [to 0D for caller]
     [30]   Z    F  [overwritten by jump back to caller]

 [Main routine]
            T  220 K  [load at 220]
            G      K  [set theta parameter as usual]
      [0]   PF    PF  [35-bit seed]
         [Use library subroutine R9 to set seed]
            E69K T#@
            1#        [non-negative seed followed by '#']
            T2Z
      [2]   P      F  [negative counter for loop]
      [3]   P   10 F  [to print first 10 values]
         [Characters for printing]
      [4]   B      F
      [5]   D      F
      [6]   E      F
      [7]   M      F
      [8]   S      F
      [9]   C      F  [colon when in figures mode]
     [10]   K 2048 F  [set letters on teleprinter]
     [11]   #      F  [set figures on teleprinter]
     [12]   @      F  [carriage return]
     [13]   &      F  [line feed]
     [14]   K 4096 F  [null]

        [Enter with acc = 0]
        [Print 'SEED:' and then the seed]
     [15]   [email protected] [email protected] [email protected] [email protected] [email protected] [email protected] [email protected]
            A     #@  [load seed]
            T      D  [store in 0D for printing]
     [24]   A   24 @  [pass return address]
            G      N  [call print subroutine]
            [email protected] [email protected] [print new line]

         [Initialize the BSD generator]
            A     #@  [load seed]
            T      D  [pass seed in 0D]
     [30]   A   30 @  [pass return address]
            G      B  [call BSD initializer]
            [email protected] [email protected] [email protected] [email protected] [email protected] [email protected] [email protected] [email protected]  [print 'BSD:']
            S    3 @  [load negative of count]
         [Loop printing values from BSD generator]
     [41]   T    2 @  [update negative counter]
     [42]   A   42 @  [pass return address]
            G    1 B  [call BSD to get next value in 0D]
     [44]   A   44 @  [pass return address]
            G      N  [call print subroutine]
            [email protected] [email protected] [print new line]
            A    2 @  [load negative counter]
            A    2 F  [increment]
            G   41 @  [loop until counter = 0]

 [Microsoft LCG, very similar to BSD, so given in condensed form]
  A#@[email protected]@[email protected]@[email protected]@[email protected]@[email protected]@[email protected]@[email protected]@[email protected]@

            O   14 @  [print null to flush teleprinter buffer]
            Z      F  [stop]
            E   15 Z  [define entry point]
            P      F  [acc = 0 on entry]


defmodule LCG do
  def ms_seed(seed) do
    Process.put(:ms_state, seed)
    ms_rand
    Process.put(:ms_seed, seed)
  end

  def ms_rand do
    state = Process.get(:ms_state)
    state2 = rem(214013 * state + 2531011, 2147483648)
    Process.put(:ms_state, state2)
    div(state, 65536)
  end

  def bsd_seed(seed) do
    Process.put(:bsd_state, seed)
    Process.put(:bsd_seed, seed)
  end

  def bsd_rand do
    state = Process.get(:bsd_state)
    state2 = rem(1103515245 * state + 12345, 2147483648)
    Process.put(:bsd_state, state2)
    state2
  end
end

Enum.each([0,1], fn i ->
  IO.puts "\nRandom seed: #{i}\n        BSD      MS"
  LCG.bsd_seed(i)
  LCG.ms_seed(i)
  Enum.each(1..10, fn _ ->
    :io.format "~11w~8w~n", [LCG.bsd_rand, LCG.ms_rand]
  end)
end)


-module(lcg).
-export([bsd_seed/1, ms_seed/1, bsd_rand/0, ms_rand/0]).

bsd_seed(Seed) -> put(bsd_state, Seed).
ms_seed(Seed)  -> put(ms_state, Seed).

bsd_rand() ->
  State = (get(bsd_state) * 1103515245 + 12345) rem 2147483648,
  put(bsd_state,State),
  State.

ms_rand() ->
  State = (get(ms_state) * 214013 + 2531011) rem 2147483648,
  put(ms_state,State),
  State div 65536.

main(_) ->
  bsd_seed(0),
  ms_seed(0),
  io:fwrite("~10s~c~5s~n", ["BSD", 9, "MS"]),
  lists:map(fun(_) -> io:fwrite("~10w~c~5w~n", [bsd_rand(),9,ms_rand()]) end, lists:seq(1,10)).


| test |

test := [ :a :b :c | a*a+(b*b)=(c*c) ].

(1 to: 20)
    combinations: 3 atATimeDo: [ :x |
        (test valueWithArguments: x)
            ifTrue: [ ':-)' logCr: x ] ].

"output on Transcript:
#(3 4 5)
#(5 12 13)
#(6 8 10)
#(8 15 17)
#(9 12 15)
#(12 16 20)"


typealias F1 = (Int) -> [(Int, Int, Int)]
typealias F2 = (Int) -> Bool

func pythagoreanTriples(n: Int) -> [(Int, Int, Int)] {
  (1...n).flatMap({x in
    (x...n).flatMap({y in
      (y...n).filter({z in
        x * x + y * y == z * z
      } as F2).map({ (x, y, $0) })
    } as F1)
  } as F1)
}

print(pythagoreanTriples(n: 20))


package require Tcl 8.5

# from http://wiki.tcl.tk/12574
proc lcomp {expression args} {
    # Check the number of arguments.
    if {[llength $args] < 2} {
        error "wrong # args: should be \"lcomp expression var1 list1\
            ?... varN listN? ?condition?\""
    }

    # Extract condition from $args, or use default.
    if {[llength $args] % 2 == 1} {
        set condition [lindex $args end]
        set args [lrange $args 0 end-1]
    } else {
        set condition 1
    }

    # Collect all var/list pairs and store in reverse order.
    set varlst [list]
    foreach {var lst} $args {
        set varlst [concat [list $var] [list $lst] $varlst]
    }

    # Actual command to be executed, repeatedly.
    set script {lappend result [subst $expression]}

    # If necessary, make $script conditional.
    if {$condition ne "1"} {
        set script [list if $condition $script]
    }

    # Apply layers of foreach constructs around $script.
    foreach {var lst} $varlst {
        set script [list foreach $var $lst $script]
    }

    # Do it!
    set result [list]
    {*}$script ;# Change to "eval $script" if using Tcl 8.4 or older.
    return $result
}

set range {1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20}
puts [lcomp {$x $y $z} x $range y $range z $range {$x < $y && $x**2 + $y**2 == $z**2}]


import java.util.ArrayList;
import java.util.List;

public class ListRootedTrees {
    private static final List<Long> TREE_LIST = new ArrayList<>();

    private static final List<Integer> OFFSET = new ArrayList<>();

    static {
        for (int i = 0; i < 32; i++) {
            if (i == 1) {
                OFFSET.add(1);
            } else {
                OFFSET.add(0);
            }
        }
    }

    private static void append(long t) {
        TREE_LIST.add(1 | (t << 1));
    }

    private static void show(long t, int l) {
        while (l-- > 0) {
            if (t % 2 == 1) {
                System.out.print('(');
            } else {
                System.out.print(')');
            }
            t = t >> 1;
        }
    }

    private static void listTrees(int n) {
        for (int i = OFFSET.get(n); i < OFFSET.get(n + 1); i++) {
            show(TREE_LIST.get(i), n * 2);
            System.out.println();
        }
    }

    private static void assemble(int n, long t, int sl, int pos, int rem) {
        if (rem == 0) {
            append(t);
            return;
        }

        var pp = pos;
        var ss = sl;

        if (sl > rem) {
            ss = rem;
            pp = OFFSET.get(ss);
        } else if (pp >= OFFSET.get(ss + 1)) {
            ss--;
            if (ss == 0) {
                return;
            }
            pp = OFFSET.get(ss);
        }

        assemble(n, t << (2 * ss) | TREE_LIST.get(pp), ss, pp, rem - ss);
        assemble(n, t, ss, pp + 1, rem);
    }

    private static void makeTrees(int n) {
        if (OFFSET.get(n + 1) != 0) {
            return;
        }
        if (n > 0) {
            makeTrees(n - 1);
        }
        assemble(n, 0, n - 1, OFFSET.get(n - 1), n - 1);
        OFFSET.set(n + 1, TREE_LIST.size());
    }

    private static void test(int n) {
        if (n < 1 || n > 12) {
            throw new IllegalArgumentException("Argument must be between 1 and 12");
        }

        append(0);

        makeTrees(n);
        System.out.printf("Number of %d-trees: %d\n", n, OFFSET.get(n + 1) - OFFSET.get(n));
        listTrees(n);
    }

    public static void main(String[] args) {
        test(5);
    }
}


PROGRAM RNG

!$DOUBLE

DIM CARDS%[52]

PROCEDURE XRANDOM(SEED->XRND)
   POW31=2^31
   POW16=2^16
   SEED=SEED*214013+2531011
   SEED=SEED-POW31*INT(SEED/POW31)
   XRND=INT(SEED/POW16)
END PROCEDURE

PROCEDURE YRANDOM(SEED->YRND)
   POW31=2^31
   SEED=SEED*1103515245+12345
   SEED=SEED-POW31*INT(SEED/POW31)
   YRND=SEED
END PROCEDURE

BEGIN
    PRINT(CHR$(12);)
    SEED=0  PRINT("BSD:")
    FOR I%=1 TO 10 DO
       YRANDOM(SEED->YRND)
       PRINT(TAB(10);YRND)
    END FOR
    SEED=0  PRINT("MSD:")
    FOR I%=1 TO 10 DO
       XRANDOM(SEED->XRND)
       PRINT(TAB(10);XRND)
    END FOR
END PROGRAM


module lcg =
    let bsd seed =
        let state = ref seed
        (fun (_:unit) ->
            state := (1103515245 * !state + 12345) &&& System.Int32.MaxValue
            !state)

    let ms seed =
        let state = ref seed
        (fun (_:unit) ->
            state := (214013 * !state + 2531011) &&& System.Int32.MaxValue
            !state / (1<<<16))


USING: fry io kernel lists lists.lazy math prettyprint ;

: lcg ( seed a c m quot: ( state -- rand ) -- list )
    [ '[ _ * _ + _ mod ] lfrom-by ] [ lmap-lazy cdr ] bi* ; inline

0 1103515245 12345 2147483648 [ ] lcg           ! bsd
0 214013 2531011 2147483648 [ -16 shift ] lcg   ! ms
[ 10 swap ltake [ . ] leach nl ] [email protected]


Module ListComp
    Sub Main()
        Dim ts = From a In Enumerable.Range(1, 20) _
                 From b In Enumerable.Range(a, 21 - a) _
                 From c In Enumerable.Range(b, 21 - b) _
                 Where a * a + b * b = c * c _
                 Select New With { a, b, c }

        For Each t In ts
            System.Console.WriteLine("{0}, {1}, {2}", t.a, t.b, t.c)
        Next
    End Sub
End Module


implement main
    open core, std

domains
    pythtrip = pt(integer, integer, integer).

class predicates
    pythTrips : (integer) -> pythtrip nondeterm (i).

clauses
    pythTrips(Limit) = pt(X,Y,Z) :-
        X = fromTo(1,Limit),
        Y = fromTo(X,Limit),
        Z = fromTo(Y,Limit),
        Z^2 = X^2 + Y^2.

    run():-
        console::init(),
        Triples = [ X || X = pythTrips(20) ],
        console::write(Triples),
        Junk = console::readLine(),
        succeed().
end implement main

goal
    mainExe::run(main::run).


(() => {
    'use strict';

    const main = () =>
        bagPatterns(5)
        .join('\n');

    // BAG PATTERNS ---------------------------------------

    // bagPatterns :: Int -> [String]
    const bagPatterns = n =>
        nub(map(
            composeList([
                commasFromTree,
                depthSortedTree,
                treeFromParentIndices
            ]),
            parentIndexPermutations(n)
        ));

    // parentIndexPermutations :: Int -> [[Int]]
    const parentIndexPermutations = n =>
        sequenceA(
            map(curry(enumFromToInt)(0),
                enumFromToInt(0, n - 2)
            )
        );

    // treeFromParentIndices :: [Int] -> Tree Int
    const treeFromParentIndices = pxs => {
        const go = (tree, tplIP) =>
            Node(
                tree.root,
                tree.root === snd(tplIP) ? (
                    tree.nest.concat(Node(fst(tplIP)), [])
                ) : map(t => go(t, tplIP), tree.nest)
            );
        return foldl(
            go, Node(0, []),
            zip(enumFromToInt(1, pxs.length), pxs)
        );
    };

    // Siblings sorted by descendant count

    // depthSortedTree :: Tree a -> Tree Int
    const depthSortedTree = t => {
        const go = tree =>
            isNull(tree.nest) ? (
                Node(0, [])
            ) : (() => {
                const xs = map(go, tree.nest);
                return Node(
                    1 + foldl((a, x) => a + x.root, 0, xs),
                    sortBy(flip(comparing(x => x.root)), xs)
                );
            })();
        return go(t);
    };

    // Serialisation of the tree structure

    // commasFromTree :: Tree a -> String
    const commasFromTree = tree => {
        const go = t => `(${concat(map(go, t.nest))})`
        return go(tree);
    };

    // GENERIC FUNCTIONS --------------------------------------

    // Node :: a -> [Tree a] -> Tree a
    const Node = (v, xs) => ({
        type: 'Node',
        root: v, // any type of value (but must be consistent across tree)
        nest: xs || []
    });

    // Tuple (,) :: a -> b -> (a, b)
    const Tuple = (a, b) => ({
        type: 'Tuple',
        '0': a,
        '1': b,
        length: 2
    });

    // comparing :: (a -> b) -> (a -> a -> Ordering)
    const comparing = f =>
        (x, y) => {
            const
                a = f(x),
                b = f(y);
            return a < b ? -1 : (a > b ? 1 : 0);
        };

    // composeList :: [(a -> a)] -> (a -> a)
    const composeList = fs =>
        x => fs.reduceRight((a, f) => f(a), x, fs);

    // concat :: [[a]] -> [a]
    // concat :: [String] -> String
    const concat = xs =>
        xs.length > 0 ? (() => {
            const unit = typeof xs[0] === 'string' ? '' : [];
            return unit.concat.apply(unit, xs);
        })() : [];

        // concatMap :: (a -> [b]) -> [a] -> [b]
    const concatMap = (f, xs) => []
        .concat.apply(
            [],
            (Array.isArray(xs) ? (
                xs
            ) : xs.split('')).map(f)
        );

        // cons :: a -> [a] -> [a]
    const cons = (x, xs) =>  [x].concat(xs);

    // Flexibly handles two or more arguments, applying
    // the function directly if the argument array is complete,
    // or recursing with a concatenation of any existing and
    // newly supplied arguments, if gaps remain.
    // curry :: ((a, b) -> c) -> a -> b -> c
    const curry = (f, ...args) => {
        const go = xs => xs.length >= f.length ? (
            f.apply(null, xs)
        ) : function() {
            return go(xs.concat(Array.from(arguments)));
        };
        return go(args);
    };

    // enumFromToInt :: Int -> Int -> [Int]
    const enumFromToInt = (m, n) =>
        n >= m ? (
            iterateUntil(x => x >= n, x => 1 + x, m)
        ) : [];

    // flip :: (a -> b -> c) -> b -> a -> c
    const flip = f => (a, b) => f.apply(null, [b, a]);

    // foldl :: (a -> b -> a) -> a -> [b] -> a
    const foldl = (f, a, xs) => xs.reduce(f, a);

    // fst :: (a, b) -> a
    const fst = tpl => tpl[0];

    // isNull :: [a] -> Bool
    // isNull :: String -> Bool
    const isNull = xs =>
        Array.isArray(xs) || typeof xs === 'string' ? (
            xs.length < 1
        ) : undefined;

    // iterateUntil :: (a -> Bool) -> (a -> a) -> a -> [a]
    const iterateUntil = (p, f, x) => {
        let vs = [x],
            h = x;
        while (!p(h))(h = f(h), vs.push(h));
        return vs;
    };

    // liftA2List :: (a -> b -> c) -> [a] -> [b] -> [c]
    const liftA2List = (f, xs, ys) =>
        concatMap(x => concatMap(y => [f(x, y)], ys), xs);

    // map :: (a -> b) -> [a] -> [b]
    const map = (f, xs) => xs.map(f);

    // nub :: [a] -> [a]
    const nub = xs => nubBy((a, b) => a === b, xs);

    // nubBy :: (a -> a -> Bool) -> [a] -> [a]
    const nubBy = (p, xs) => {
        const go = xs => xs.length > 0 ? (() => {
            const x = xs[0];
            return [x].concat(
                go(xs.slice(1)
                    .filter(y => !p(x, y))
                )
            )
        })() : [];
        return go(xs);
    };

    // sequenceA :: (Applicative f, Traversable t) => t (f a) -> f (t a)
    const sequenceA = tfa =>
        traverseList(x => x, tfa);

    // traverseList :: (Applicative f) => (a -> f b) -> [a] -> f [b]
    const traverseList = (f, xs) => {
        const lng = xs.length;
        return 0 < lng ? (() => {
            const
                vLast = f(xs[lng - 1]),
                t = vLast.type || 'List';
            return xs.slice(0, -1).reduceRight(
                (ys, x) => liftA2List(cons, f(x), ys),
                liftA2List(cons, vLast, [[]])
            );
        })() : [
            []
        ];
    };

    // snd :: (a, b) -> b
    const snd = tpl => tpl[1];

    // sortBy :: (a -> a -> Ordering) -> [a] -> [a]
    const sortBy = (f, xs) =>
        xs.slice()
        .sort(f);

    // zip :: [a] -> [b] -> [(a, b)]
    const zip = (xs, ys) =>
        xs.slice(0, Math.min(xs.length, ys.length))
        .map((x, i) => Tuple(x, ys[i]));

    // MAIN ---
    return main()
})();


1 31 lshift 1- constant MAX-RAND-BSD
1 15 lshift 1- constant MAX-RAND-MS

variable seed                         \ seed variable

: (random) seed @ * + dup seed ! ;    ( -- n)
: BSDrandom MAX-RAND-BSD 12345 1103515245 (random) and ;
: MSrandom MAX-RAND-MS 2531011 214013 (random) 16 rshift and ;

: test-random
  1 seed ! cr ." BSD (seed=1)" cr
  5 0 do BSDrandom . cr loop
  1 seed ! cr ." MS  (seed=1)" cr
  5 0 do MSrandom . cr loop
;

test-random


module lcgs
  implicit none

  integer, parameter :: i64 = selected_int_kind(18)
  integer, parameter :: a1 = 1103515245, a2 = 214013
  integer, parameter :: c1 = 12345, c2 = 2531011
  integer, parameter :: div = 65536
  integer(i64), parameter :: m = 2147483648_i64  ! need to go to 64 bits because
                                                 ! of the use of signed integers
contains

function bsdrand(seed)
  integer :: bsdrand
  integer, optional, intent(in) :: seed
  integer(i64) :: x = 0

  if(present(seed)) x = seed
  x = mod(a1 * x + c1, m)
  bsdrand = x
end function

function msrand(seed)
  integer :: msrand
  integer, optional, intent(in) :: seed
  integer(i64) :: x = 0

  if(present(seed)) x = seed
  x = mod(a2 * x + c2, m)
  msrand = x / div
end function
end module

program lcgtest
  use lcgs
  implicit none
  integer :: i

  write(*, "(a)") "      BSD            MS"
  do i = 1, 10
    write(*, "(2i12)") bsdrand(), msrand()
  end do
end program


' version 04-11-2016
' compile with: fbc -s console

' to seed BSD_lcg(seed > -1)
' to get random number BSD_lcg(-1) or BSD_lcg() or just BSD_lcg
Function BSD_lcg(seed As UInteger = -1) As UInteger

    Static As UInteger bsd_state

    If seed <> -1 Then
        bsd_state = seed Mod 2 ^ 31
    Else
        bsd_state = (1103515245 * bsd_state + 12345) Mod 2 ^ 31
    End If

    Return bsd_state

End Function

' to seed ms_lcg(seed > -1)
' to get random number ms_lcg(-1) or ms_lcg() or just ms_lcg
Function ms_lcg(seed As Integer = -1) As UInteger

    Static As UInteger ms_state

    If seed <> -1 Then
        ms_state = seed Mod 2 ^ 31
    Else
        ms_state = (214013 * ms_state + 2531011) Mod 2 ^ 31
    End If

    Return ms_state Shr 16

End Function

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

Dim As Long i

Print "MS generator"
' ms_lcg(0)      ' state = 0 at the start of the program
For i = 1 To 10
    Print Using "###########"; ms_lcg
Next

Print
Print "BSD generator"
' BSD_lcg(0)     ' state = 0 at the start of the program
For i  = 1 To 10
    Print Using "###########"; BSD_lcg
Next

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


F levenshteinAlign(aa, bb)
   V a = aa.lowercase()
   V b = bb.lowercase()
   V costs = [[0] * (b.len + 1)] * (a.len + 1)
   L(j) 0 .. b.len
      costs[0][j] = j
   L(i) 1 .. a.len
      costs[i][0] = i
      L(j) 1 .. b.len
         V tmp = costs[i - 1][j - 1] + Int(a[i - 1] != b[j - 1])
         costs[i][j] = min(1 + min(costs[i - 1][j], costs[i][j - 1]), tmp)

   V aPathRev = ‘’
   V bPathRev = ‘’
   V i = a.len
   V j = b.len
   L i != 0 & j != 0
      V tmp = costs[i - 1][j - 1] + Int(a[i - 1] != b[j - 1])
      I costs[i][j] == tmp
         aPathRev ‘’= a[--i]
         bPathRev ‘’= b[--j]
      E I costs[i][j] == 1 + costs[i - 1][j]
         aPathRev ‘’= a[--i]
         bPathRev ‘’= ‘-’
      E I costs[i][j] == 1 + costs[i][j - 1]
         aPathRev ‘’= ‘-’
         bPathRev ‘’= b[--j]
      E
         assert(0B, ‘Internal error’)

   R (reversed(aPathRev), reversed(bPathRev))

V result = levenshteinAlign(‘place’, ‘palace’)
print(result[0])
print(result[1])
print()

result = levenshteinAlign(‘rosettacode’, ‘raisethysword’)
print(result[0])
print(result[1])


var pythTriples = Fiber.new { |n|
    (1..n-2).each { |x|
        (x+1..n-1).each { |y|
            (y+1..n).each { |z| (x*x + y*y == z*z) && Fiber.yield([x, y, z]) }
        }
    }
}

var n = 20
while (!pythTriples.isDone) {
    var res = pythTriples.call(n)
    res && System.print(res)
}


# add one bag somewhere
def addbag:
  def sortmap: map(sortmap) | sort;
  if . == null then []             # one bag
  else ([[]] + .),
   (paths as $p
    | getpath($p) as $x
    | setpath($p; [[]] + $x)
    | sortmap                      # indistinguishability of bags
   )
  end ;

# emit a stream of the distinct rooted trees of order $n > 0
def rootedtrees($n):
  if $n==1 then []
  else foreach range(0; $n-1) as $i ([[]];
    [.[] | addbag] | unique;
    select($i == $n-2))
  | .[]
  end;

# emit $n arrays of the form [$i, $count] for 0 < $i <= $n
def count_rootedtrees($n):
  [1, 1],
  foreach range(0; $n - 1) as $i ([[]];
    [.[] | addbag] | unique;
    [$i + 2, length]) ;

rootedtrees(5),
"",
count_rootedtrees(17)


bags(n,cache="") = n < 1 ? [(0, "")] :
    [(c + 1, "(" * s * ")") for (c, s) in bagchain((0, ""), n - 1,
        n < 2 ? [] : reduce(append!, [bags(x) for x in n-1:-1:1]))]

bagchain(x, n, bb, start=1) = n < 1 ? [x] :
    reduce(append!, [bagchain((x[1] + bb[i][1], x[2] * bb[i][2]),
        n - bb[i][1], bb, i) for i in start:length(bb) if bb[i][1] <= n])

for bag in bags(5)
    println(bag[2])
end


// version 1.1.3

typealias Tree = Long

val treeList = mutableListOf<Tree>()
val offset = IntArray(32) { if (it == 1) 1 else 0 }

fun append(t: Tree) {
    treeList.add(1L or (t shl 1))
}

fun show(t: Tree, l: Int) {
    var tt = t
    var ll = l
    while (ll-- > 0) {
        print(if (tt % 2L == 1L) "(" else ")")
        tt = tt ushr 1
    }
}

fun listTrees(n: Int) {
    for (i in offset[n] until offset[n + 1]) {
        show(treeList[i], n * 2)
        println()
    }
}

/* assemble tree from subtrees
	n:   length of tree we want to make
	t:   assembled parts so far
	sl:  length of subtree we are looking at
	pos: offset of subtree we are looking at
	rem: remaining length to be put together
*/

fun assemble(n: Int, t: Tree, sl: Int, pos: Int, rem: Int) {
    if (rem == 0) {
        append(t)
        return
    }

    var pp = pos
    var ss = sl

    if (sl > rem) { // need smaller subtrees
        ss = rem
        pp = offset[ss]
    }
    else if (pp >= offset[ss + 1]) {
        // used up sl-trees, try smaller ones
        ss--
        if(ss == 0) return
        pp = offset[ss]
    }

    assemble(n, (t shl (2 * ss)) or treeList[pp], ss, pp, rem - ss)
    assemble(n, t, ss, pp + 1, rem)
}

fun makeTrees(n: Int) {
    if (offset[n + 1] != 0) return
    if (n > 0) makeTrees(n - 1)
    assemble(n, 0, n - 1, offset[n - 1], n - 1)
    offset[n + 1] = treeList.size
}

fun main(args: Array<String>) {
    if (args.size != 1) {
        throw IllegalArgumentException("There must be exactly 1 command line argument")
    }
    val n = args[0].toIntOrNull()
    if (n == null) throw IllegalArgumentException("Argument is not a valid number")
    // n limited to 12 to avoid overflowing default stack
    if (n !in 1..12) throw IllegalArgumentException("Argument must be between 1 and 12")

    // init 1-tree
    append(0)

    makeTrees(n)
    println("Number of $n-trees: ${offset[n + 1] - offset[n]}")
    listTrees(n)
}


package main

import "fmt"

// basic linear congruential generator
func lcg(a, c, m, seed uint32) func() uint32 {
    r := seed
    return func() uint32 {
        r = (a*r + c) % m
        return r
    }
}

// microsoft generator has extra division step
func msg(seed uint32) func() uint32 {
    g := lcg(214013, 2531011, 1<<31, seed)
    return func() uint32 {
        return g() / (1 << 16)
    }
}

func example(seed uint32) {
    fmt.Printf("\nWith seed = %d\n", seed)
    bsd := lcg(1103515245, 12345, 1<<31, seed)
    msf := msg(seed)
    fmt.Println("       BSD  Microsoft")
    for i := 0; i < 5; i++ {
        fmt.Printf("%10d    %5d\n", bsd(), msf())
    }
}

func main() {
    example(0)
    example(1)
}


print join.with:"\n" levenshtein.align "place" "palace"
print join.with:"\n" levenshtein.align "rosettacode" "raisethysword"


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

typedef struct edit_s edit_t, *edit;
struct edit_s {
	char c1, c2;
	int n;
	edit next;
};

void leven(char *a, char *b)
{
	int i, j, la = strlen(a), lb = strlen(b);
	edit *tbl = malloc(sizeof(edit) * (1 + la));
	tbl[0] = calloc((1 + la) * (1 + lb), sizeof(edit_t));
	for (i = 1; i <= la; i++)
		tbl[i] = tbl[i-1] + (1+lb);

	for (i = la; i >= 0; i--) {
		char *aa = a + i;
		for (j = lb; j >= 0; j--) {
			char *bb = b + j;
			if (!*aa && !*bb) continue;

			edit e = &tbl[i][j];
			edit repl = &tbl[i+1][j+1];
			edit dela = &tbl[i+1][j];
			edit delb = &tbl[i][j+1];

			e->c1 = *aa;
			e->c2 = *bb;
			if (!*aa) {
				e->next = delb;
				e->n = e->next->n + 1;
				continue;
			}
			if (!*bb) {
				e->next = dela;
				e->n = e->next->n + 1;
				continue;
			}

			e->next = repl;
			if (*aa == *bb) {
				e->n = e->next->n;
				continue;
			}

			if (e->next->n > delb->n) {
				e->next = delb;
				e->c1 = 0;
			}
			if (e->next->n > dela->n) {
				e->next = dela;
				e->c1 = *aa;
				e->c2 = 0;
			}
			e->n = e->next->n + 1;
		}
	}

	edit p = tbl[0];
	printf("%s -> %s: %d edits\n", a, b, p->n);

	while (p->next) {
		if (p->c1 == p->c2)
			printf("%c", p->c1);
		else {
			putchar('(');
			if (p->c1) putchar(p->c1);
			putchar(',');
			if (p->c2) putchar(p->c2);
			putchar(')');
		}

		p = p->next;
	}
	putchar('\n');

	free(tbl[0]);
	free(tbl);
}

int main(void)
{
	leven("raisethysword", "rosettacode");
	return 0;
}


tree_list = {}
offset = {}

function init()
    for i=1,32 do
        if i == 2 then
            table.insert(offset, 1)
        else
            table.insert(offset, 0)
        end
    end
end

function append(t)
    local v = 1 | (t << 1)
    table.insert(tree_list, v)
end

function show(t, l)
    while l > 0 do
        l = l - 1
        if (t % 2) == 1 then
            io.write('(')
        else
            io.write(')')
        end
        t = t >> 1
    end
end

function listTrees(n)
    local i = offset[n]
    while i < offset[n + 1] do
        show(tree_list[i + 1], n * 2)
        print()
        i = i + 1
    end
end

function assemble(m, t, sl, pos, rem)
    if rem == 0 then
        append(t)
        return
    end

    local pp = pos
    local ss = sl

    if sl > rem then
        ss = rem
        pp = offset[ss]
    elseif pp >= offset[ss + 1] then
        ss = ss - 1
        if ss == 0 then
            return
        end
        pp = offset[ss]
    end

    assemble(n, t << (2 * ss) | tree_list[pp + 1], ss, pp, rem - ss)
    assemble(n, t, ss, pp + 1, rem)
end

function makeTrees(n)
    if offset[n + 1] ~= 0 then
        return
    end
    if n > 0 then
        makeTrees(n - 1)
    end
    assemble(n, 0, n - 1, offset[n - 1], n - 1)
    offset[n + 1] = #tree_list
end

function test(n)
    append(0)

    makeTrees(n)
    print(string.format("Number of %d-trees: %d", n, offset[n+1] - offset[n]))
    listTrees(n)
end

init()
test(5)