Declarations and scopes

{
    Shelves - the constants of a block: numbers, reals, characters and strings, constants that read other constants, a
    constant declared with a type and a table of them, each computed as the program compiles.

    A constant without a type keeps its exact value until a use gives it a type: 'Slots' is small enough to print as an
    'int32', 'Far' is too large for one and computes as an 'int64', and 'Share', a real without a type, computes in
    'float64'. A constant declared with a type is held to that type, and a table lists its elements in parentheses. A
    constant may read every constant its block declares, above or below it, and the functions the compiler computes as
    it compiles: 'Length' of a constant string, 'Ord' of a character and 'High' of a type.
}
program Shelves;

imp
    WriteLn, Length, Ord, High : std;

const
    Slots = Rows * Columns;
    Rows = 3;
    Columns = Rows + 1;
    Far = 5000000000;
    Share = 1.0 / Slots;
    Label = "shelf";
    LabelLength = Length(Label);
    Initial = 'S';
    InitialCode = Ord(Initial);
    Largest = High(int8);
    Tray : int16 = 250;
    Loads : LoadTable = (5, 10, 25);
    SlotLine = "%d slots in %d rows of %d";
    ShareLine = "%lld is far, and one slot is %lf of a shelf";
    LabelLine = "%ls has %lld characters and begins with %lc, code %lld";
    TypedLine = "a tray holds %lld, an int8 at most %lld, the second load is %lld";

type
    { The loads a shelf is rated for, the lightest first. }
    LoadTable = array[1..3] of int64;

begin
    WriteLn(SlotLine, Slots, Rows, Columns);
    WriteLn(ShareLine, Far, Share);
    WriteLn(LabelLine, Label, LabelLength, Initial, InitialCode);
    WriteLn(TypedLine, Tray as int64, Largest as int64, Loads[2]);
end.

12 slots in 3 rows of 4
5000000000 is far, and one slot is 0.083333 of a shelf
shelf has 5 characters and begins with S, code 83
a tray holds 250, an int8 at most 127, the second load is 10

{
    Garden - the types a block declares: a second name for a type, an enumeration, a subrange, a set, a pointer, a
    record and an array, each declared once and used by its name.

    'Litres' is a second name for 'float64', so a value of either is a value of both. 'Plant' is an enumeration, whose
    members are constants of the block, 'Week' a subrange of the integers and 'Plants' a set of the enumeration's
    members. 'BedLink' points at 'Bed', a record declared below it, and 'Beds' is an array of such records. The chain
    the body builds through 'BedLink' is made of cells that live until the program ends.
}
program Garden;

imp
    WriteLn, Ord : std;

const
    BedCount = 2;
    Rainfall = 2.5;
    TomatoWeek = 3;
    BeanWeek = 5;
    BedLine = "bed %lld grows plant %lld, sown in week %lld, with %lf litres";
    SetLine = "tomato planted %lld, lettuce planted %lld";
    ChainLine = "the chain holds %lld beds";

type
    { A volume of water, a second name for 'float64'. }
    Litres = float64;

    { What a bed grows. }
    Plant = (Bean, Lettuce, Tomato);

    { The weeks of a season, counted from one. }
    Week = 1..26;

    { The plants a gardener has set. }
    Plants = set of Plant;

    { A pointer to a bed, declared above the record it points at. }
    BedLink = pointer Bed;

    { One bed: what it grows, the week it was sown, its water and the next bed of a chain. }
    Bed = record
        crop : Plant;
        sown : Week;
        water : Litres;
        next : BedLink;
    end;

    { The beds of the garden, counted from one. }
    Beds = array[1..BedCount] of Bed;

var
    beds : Beds;
    planted : Plants;
    rain : float64;
    first : BedLink;
    walk : BedLink;
    index : int64;
    count : int64;

begin
    rain := Rainfall;
    beds[1].crop := Tomato;
    beds[1].sown := TomatoWeek;
    beds[1].water := rain;
    beds[2].crop := Bean;
    beds[2].sown := BeanWeek;
    beds[2].water := beds[1].water * 2.0;
    planted := [Tomato, Bean];

    for index := 1 to BedCount do
        WriteLn(BedLine, index, Ord(beds[index].crop), beds[index].sown as int64, beds[index].water);

    WriteLn(SetLine, Ord(Tomato in planted), Ord(Lettuce in planted));

    first := new Bed until program;
    first.next := new Bed until program;
    walk := first;
    while walk # nil do
    begin
        count := count + 1;
        walk := walk.next;
    end;
    WriteLn(ChainLine, count);
end.

bed 1 grows plant 2, sown in week 3, with 2.500000 litres
bed 2 grows plant 0, sown in week 5, with 5.000000 litres
tomato planted 1, lettuce planted 0
the chain holds 2 beds

{
    Ledger - the variables of a program, of a routine and of a compound statement, their initial values and how long
    each of them lives.

    The program's variables live as long as the program, and the initial value of 'balance' is a constant expression
    the program starts with. A routine's variables live for one call, and the initial value of 'twice' reads the
    parameter of the call it starts in. The loop's body declares 'counted' for itself, so the variable starts afresh at
    every round. 'Keep' makes a cell bound to the program with 'until program', so the cell outlives the call that made
    it and the body reads it afterwards.
}
program Ledger;

imp
    WriteLn : std;

const
    OpeningBalance = 100;
    FirstAmount = 20;
    SecondAmount = 30;
    EntryLine = "entry %lld books %lld, twice that is %lld, the balance is %lld";
    RoundLine = "round %lld counted %lld";
    KeptLine = "the kept balance is %lld";
    Rounds = 3;

type
    { A balance kept beyond the call that records it. }
    Kept = record
        amount : int64;
    end;

    { A pointer to a kept balance. }
    KeptLink = pointer Kept;

var
    balance : int64 := OpeningBalance;
    first, second : int64;
    kept : KeptLink;
    round : int64;

{ One entry booked: the local 'twice' starts from the parameter at every call. }
procedure Book(entry : int64, amount : int64);
var
    twice : int64 := amount * 2;
begin
    balance := balance + amount;
    WriteLn(EntryLine, entry, amount, twice, balance);
end;

{ A balance kept in a cell that lives until the program ends, beyond this call. }
procedure Keep(amount : int64);
begin
    kept := new Kept until program;
    kept.amount := amount;
end;

begin
    first := FirstAmount;
    second := SecondAmount;
    Book(1, first);
    Book(2, second);

    for round := 1 to Rounds do
    begin
        var counted : int64;
        counted := counted + 1;
        WriteLn(RoundLine, round, counted);
    end;

    Keep(balance);
    WriteLn(KeptLine, kept.amount);
end.

entry 1 books 20, twice that is 40, the balance is 120
entry 2 books 30, twice that is 60, the balance is 150
round 1 counted 1
round 2 counted 1
round 3 counted 1
the kept balance is 150

{
    Counters - procedures and functions, the three ways a parameter is handed over, a function's result and 'leave'.

    'Report' calls the routines declared below it, which a block allows: every routine sees every routine its block
    declares. A value parameter is the routine's own copy of the argument, so 'Double' changes its copy and the caller's
    variable keeps its value. A 'const' parameter is read and never written. A parameter of a pointer type receives an
    address, 'address count' at the call, and 'Bump' writes the caller's variable through it with 'value'. A function
    answers the value last assigned to its name, which starts at its type's start value and reads like a variable inside
    the function, and 'leave' ends a routine where it stands. 'Factorial' calls itself.
}
program Counters;

imp
    WriteLn : std;

const
    CopyLine = "Double answers %lld, and the caller's count is still %lld";
    BumpLine = "Bump wrote %lld through the address";
    SumLine = "the numbers 1 to %lld add up to %lld";
    SquareLine = "the first square past %lld is %lld";
    FactorialLine = "the factorial of %lld is %lld";
    StartCount = 5;
    SquareLimit : int64 = 50;

var
    count : int64;

{ The report of what each routine below answers, which calls them above their declarations. }
procedure Report();
begin
    count := StartCount;
    WriteLn(CopyLine, Double(count), count);
    Bump(address count);
    WriteLn(BumpLine, count);
    WriteLn(SumLine, count, Sum(count));
    WriteLn(SquareLine, SquareLimit, FirstSquarePast(SquareLimit));
    WriteLn(FactorialLine, count, Factorial(count));
end;

{ Twice a number, computed in the routine's own copy of the argument. }
function Double(number : int64) : int64;
begin
    number := number * 2;
    Double := number;
end;

{ One added to the caller's variable, which the parameter points at. }
procedure Bump(counter : pointer int64);
begin
    value counter := value counter + 1;
end;

{ The sum of the numbers from 1 to 'last': the result starts at zero and adds every number to itself. }
function Sum(const last : int64) : int64;
var
    index : int64;
begin
    for index := 1 to last do
        Sum := Sum + index;
end;

{ The first square above 'limit', answered by 'leave' as soon as it is found. }
function FirstSquarePast(const limit : int64) : int64;
var
    root : int64;
begin
    for root := 1 to limit do
    begin
        FirstSquarePast := root * root;
        leave when FirstSquarePast > limit;
    end;
end;

{ The product of the numbers from 1 to 'number', computed by a function that calls itself. }
function Factorial(number : int64) : int64;
begin
    if number <= 1 then
        Factorial := 1
    else
        Factorial := number * Factorial(number - 1);
end;

begin
    Report();
end.

Double answers 10, and the caller's count is still 5
Bump wrote 6 through the address
the numbers 1 to 6 add up to 21
the first square past 50 is 64
the factorial of 6 is 720

function Clip(x : float64, low : float64 := 0.0, high : float64 := 1.0) : float64;

procedure Greet(text : string := "hello");
function Shade(c : Color := Blue) : int64;
function Total(table : PrimeTable := Primes) : int64;
procedure Speak(words : WordRow := ("one", "two", "three"));

function Pick(a : int64 := 1, b : int64) : int64;

n := Pick(b: 2);        { a takes its default, 1 }
n := Pick(5, 2);        { by position the call writes both }

function Scaled(value : T, factor : T := 3) : T;
gen
    T is numeric;

{
    Scores - routines nested in a routine, and what they see of the routines around them.

    'Grade' declares a variable and then two routines of its own. 'Add' reads and writes the parameter and the variable
    of 'Grade', and it calls 'Settle', declared below it, since routines declared side by side see each other. 'Settle'
    assigns the result of 'Grade'. 'Running' holds a generator, 'Sums', that reads the parameters of 'Running' as it
    emits. A nested routine is a name of the routine that declares it, so the program's body calls 'Grade' and
    'Running', never 'Add' or 'Sums'.
}
program Scores;

imp
    WriteLn : std;

const
    GradeLine = "scores %lld and %lld with a bonus of %lld grade %lld";
    SumLine = "running sum %lld";
    GradeStep = 10;
    FirstScore : int64 = 31;
    SecondScore : int64 = 44;
    Bonus : int64 = 3;
    Step : int64 = 5;
    Rounds : int64 = 3;

{ The grade of two scores and a bonus added to each: one grade for every ten points. }
function Grade(first : int64, second : int64, bonus : int64) : int64;
var
    total : int64;

    { The step that adds one score and the bonus to the total, then settles the grade the total has reached. }
    procedure Add(points : int64);
    begin
        total := total + points + bonus;
        Settle();
    end;

    { The answer of 'Grade', whose result is the total in whole steps. }
    procedure Settle();
    begin
        Grade := total / GradeStep;
    end;

begin
    Add(first);
    Add(second);
end;

{ The running sums of 'count' numbers that grow by 'step', printed as a generator nested here emits them. }
procedure Running(step : int64, count : int64);
var
    pulled : int64;

    { The running sums, emitted as the generator reads 'step' and 'count' from the routine around it. }
    generator Sums() : stream of int64;
    var
        index : int64;
        sum : int64;
    begin
        for index := 1 to count do
        begin
            sum := sum + step;
            emit sum;
        end;
    end;

begin
    for pulled in Sums() do
        WriteLn(SumLine, pulled);
end;

begin
    WriteLn(GradeLine, FirstScore, SecondScore, Bonus, Grade(FirstScore, SecondScore, Bonus));
    Running(Step, Rounds);
end.

scores 31 and 44 with a bonus of 3 grade 8
running sum 5
running sum 10
running sum 15

{
    Nearest - every name means its nearest declaration, looked up from the place that uses it outwards.

    The program declares 'level' and 'Describe'. 'Inspect' declares a 'level' and a 'Describe' of its own, which hide the
    program's inside 'Inspect' and every routine nested in it. A compound statement declares a third 'level', which hides
    the routine's for the statements of the compound; after the compound the routine's 'level' is the nearest again. A
    record's field lives in its record, so 'level' names a field of 'Floor' beside the program's variable.
}
program Nearest;

imp
    WriteLn : std;

const
    InspectLine = "Inspect sees level %lld";
    CompoundLine = "the compound sees level %lld";
    NestedLine = "the Describe of Inspect sees level %lld";
    ProgramLine = "the Describe of the program sees level %lld";
    FieldLine = "the field level is %lld, the variable level %lld";
    ProgramLevel = 1;
    InspectLevel = 2;
    CompoundLevel = 3;
    FloorLevel = 4;

type
    { A floor of a building, whose field shares its name with the program's variable. }
    Floor = record
        level : int64;
    end;

var
    level : int64;
    floor : Floor;

{ The program's description, which sees the program's 'level'. }
procedure Describe();
begin
    WriteLn(ProgramLine, level);
end;

{ A routine whose own 'level' and 'Describe' hide the program's. }
procedure Inspect();
var
    level : int64;

    { The description of 'Inspect', which sees the 'level' of 'Inspect', the nearest one. }
    procedure Describe();
    begin
        WriteLn(NestedLine, level);
    end;

begin
    level := InspectLevel;
    WriteLn(InspectLine, level);
    begin
        var level : int64;
        level := CompoundLevel;
        WriteLn(CompoundLine, level);
    end;
    Describe();
end;

begin
    level := ProgramLevel;
    Inspect();
    Describe();
    floor.level := FloorLevel;
    WriteLn(FieldLine, floor.level, level);
end.

Inspect sees level 2
the compound sees level 3
the Describe of Inspect sees level 2
the Describe of the program sees level 1
the field level is 4, the variable level 1

program Steps;

imp
    WriteLn : std;

const
    Line = "%lf %lf %lf";
    Half = 0.5;

var
    i : int64;
    v, w : vector[3] of float64;

{ The step of one value is its square plus itself, written once for any numeric type. }
elemental function Step(x : T) : T;
gen
    T is numeric;
begin
    Step := x * x + x;
end;

begin
    for i := 0 to 2 do
        v[i] := (i as float64) + Half;

    w := Step(v);
    WriteLn(Line, w[0], w[1], w[2]);
end.