Learn X in Y minutes

(*  Comments look like this, and (* they nest *).  *)
(** A comment with two stars is documentation and is picked up by the
  documentation tools. *)

(* A compilation unit is always a MODULE. Keywords are written in upper
   case, identifiers are case sensitive, and the module name is repeated
   after the final END. The file is normally named after the module. *)
MODULE LearnActiveOberon;

(* Case convention: the scanner reads keywords case insensitively, and the
   extension of the file says which style is used. A file named X.Mod is
   written with UPPER CASE keywords, a file named x.mod with lower case
   ones, predeclared types and built-ins included:

     module HelloLower;
     import KernelLog;
     procedure Do*;
     var i: signed32;
     begin
       KernelLog.String("hi"); KernelLog.Ln
     end Do;
     end HelloLower.
*)

IMPORT
  KernelLog,            (* writes to the system log *)
  Streams,              (* Reader / Writer abstraction *)
  Commands,             (* command context: input, output, arguments *)
  Log := KernelLog;     (* an import may be renamed *)

CONST
  Max* = 100;           (* "*" exports the identifier *)
  Greeting = "Hello";   (* no mark: visible inside this module only *)
  EvenBits = {0, 2, 4, 6};                     (* a SET constant *)

TYPE
  Name* = ARRAY 32 OF CHAR;                    (* 0X terminated string *)
  Handler* = PROCEDURE {DELEGATE} (n: SIGNED32);

  Point* = RECORD
    x*, y*: SIGNED32;
  END;

  Point3d* = RECORD (Point)                    (* record extension *)
    z*: SIGNED32;
  END;

  Color* = ENUM Red*, Green*, Blue* END;       (* enumeration type *)

  Vec2* = RECORD x*, y*: FLOAT64 END;

VAR
  counter-: SIGNED32;   (* "-" exports read-only: clients cannot assign *)
  origin: Point;

(* ------------------------------------------------------------------ *)
(* Types, literals and operators                                       *)
(* ------------------------------------------------------------------ *)

PROCEDURE Basics;
VAR
  b: BOOLEAN;
  c: CHAR;
  i8: SIGNED8; i16: SIGNED16; i32: SIGNED32; i64: SIGNED64;
  u32: UNSIGNED32;
  f32: FLOAT32; f64: FLOAT64;
  z: COMPLEX64;
  s: SET;                        (* small bit set *)
  adr: ADDRESS; size: SIZE;      (* pointer sized integers *)
  any: ANY;                      (* reference to any object *)
BEGIN
  (* INTEGER, REAL and SET are the default width variants; A2 code
     usually spells the width out: SIGNED32, FLOAT64, SET32, ... *)
  i32 := 42;  i32 := 2AH;  i32 := 0x2A;  i32 := 0b101010;
  i32 := 1'000'000;              (* digit separators are allowed *)
  i8 := -1; i16 := 1000; i64 := 1; u32 := 0FFFFFFFFH;
  c := "A";  c := 41X;           (* character, hexadecimal character *)
  f32 := 1.5;  f64 := 1.5E-3;
  z := 1 + 2*IMAG;               (* IMAG is the imaginary unit *)
  f64 := RE(z);  f64 := IM(z);

  (* Arithmetic: + - * / DIV MOD, integer division is DIV *)
  i32 := 7 DIV 2;  i32 := 7 MOD 2;  f64 := 7 / 2;
  i32 := ABS(-3);  INC(i32);  DEC(i32, 2);

  (* Relations: = # < <= > >= IN IS. Booleans: & OR ~ (not) *)
  b := (i32 = 5) OR (i32 # 6) & ~(i32 < 0);

  (* Sets *)
  s := {0, 3, 5..7};  s := s + {1};  s := s * EvenBits;  s := s - {3};
  b := 3 IN s;  INCL(s, 9);  EXCL(s, 0);

  (* Conversions are explicit *)
  i32 := ORD("A");  c := CHR(65);  f64 := i32;  i32 := ENTIER(f64);
  adr := ADDRESSOF(i32);  size := SIZEOF(Point);

  any := NIL;
  ASSERT(i32 >= 0);              (* traps if the condition is FALSE *)
END Basics;

(* ------------------------------------------------------------------ *)
(* Control flow                                                        *)
(* ------------------------------------------------------------------ *)

PROCEDURE ControlFlow(n: SIGNED32): SIGNED32;
VAR i, sum: SIGNED32; c: CHAR; color: Color;
BEGIN
  IF n < 0 THEN
    n := -n
  ELSIF n = 0 THEN
    n := 1
  ELSE
    (* nothing *)
  END;

  c := "x";
  CASE c OF
      "a".."m": sum := 1
    | "n".."z": sum := 2
  ELSE
    sum := 0
  END;

  color := Color.Green;          (* enumerators are qualified *)
  IF color = Color.Green THEN sum := sum + 1 END;

  WHILE n > 1 DO n := n DIV 2 END;

  REPEAT INC(n) UNTIL n >= 4;

  FOR i := 0 TO 10 BY 2 DO sum := sum + i END;

  LOOP
    INC(i);
    IF i > 100 THEN EXIT END
  END;

  VAR local := sum + 1;          (* inline VAR declaration, type inferred *)
  RETURN local
END ControlFlow;

(* ------------------------------------------------------------------ *)
(* Arrays, strings, records and pointers                               *)
(* ------------------------------------------------------------------ *)

TYPE
  IntArray* = POINTER TO ARRAY OF SIGNED32;    (* dynamic array *)
  PointPtr* = POINTER TO Point;

PROCEDURE Sum(CONST a: ARRAY OF SIGNED32): SIGNED32;   (* open array *)
VAR i: SIZE; s: SIGNED32;                (* LEN returns a SIZE *)
BEGIN
  FOR i := 0 TO LEN(a) - 1 DO s := s + a[i] END;
  RETURN s
END Sum;

PROCEDURE Swap(VAR a, b: SIGNED32);      (* VAR = by reference *)
VAR t: SIGNED32;
BEGIN t := a; a := b; b := t
END Swap;

PROCEDURE Aggregates;
VAR
  fixed: ARRAY 4 OF SIGNED32;
  matrix: ARRAY 3, 3 OF FLOAT64;       (* multidimensional *)
  dyn: IntArray;
  name: Name;
  p: Point3d;
  pp: PointPtr;
BEGIN
  fixed[0] := 1; fixed[1] := 2;
  matrix[1, 2] := 0.5;
  NEW(dyn, 10);                        (* length known at run time *)
  dyn[0] := Sum(fixed);
  Swap(fixed[0], fixed[1]);

  COPY(Greeting, name);                (* safe string copy *)
  Strings0(name);

  p.x := 1; p.y := 2; p.z := 3;        (* Point3d inherits x and y *)
  origin.x := p.x; origin.y := p.y;

  NEW(pp);                             (* garbage collected, no free *)
  pp.x := 10;
  pp := NIL;
END Aggregates;

PROCEDURE Strings0(VAR name: Name);
VAR i: SIGNED32;
BEGIN
  i := 0;
  WHILE name[i] # 0X DO INC(i) END;    (* strings end with 0X *)
  Log.String(name); Log.Int(i, 1); Log.Ln
END Strings0;

(* ------------------------------------------------------------------ *)
(* Procedures, delegates and exception handling                        *)
(* ------------------------------------------------------------------ *)

PROCEDURE Outer(n: SIGNED32): SIGNED32;

  PROCEDURE Inner(k: SIGNED32): SIGNED32;   (* nested, sees n *)
  BEGIN RETURN k * n
  END Inner;

BEGIN
  RETURN Inner(2)
END Outer;

PROCEDURE Print(n: SIGNED32);
BEGIN Log.Int(n, 1); Log.Ln
END Print;

PROCEDURE UseDelegate;
VAR h: Handler;
BEGIN
  h := Print;                          (* plain procedure *)
  h(42);
  (* A DELEGATE may also hold a method together with its object. *)
END UseDelegate;

PROCEDURE MayTrap(a, b: SIGNED32): SIGNED32;
VAR result: SIGNED32;
BEGIN
  result := a DIV b;                   (* traps if b = 0 *)
  RETURN result
FINALLY                                  (* runs on a trap as well *)
  RETURN 0
END MayTrap;

(* ------------------------------------------------------------------ *)
(* Operator overloading                                                *)
(* ------------------------------------------------------------------ *)

OPERATOR "+"* (CONST a, b: Vec2): Vec2;
VAR r: Vec2;
BEGIN
  r.x := a.x + b.x; r.y := a.y + b.y;
  RETURN r
END "+";

(* ------------------------------------------------------------------ *)
(* Objects: methods, constructor, inheritance                          *)
(* ------------------------------------------------------------------ *)

TYPE
  Shape* = OBJECT
  VAR
    name-: Name;

    PROCEDURE &Init*(CONST n: ARRAY OF CHAR);   (* constructor *)
    BEGIN
      COPY(n, name)
    END Init;

    PROCEDURE Area*(): FLOAT64;                 (* overridable *)
    BEGIN
      RETURN 0
    END Area;

    PROCEDURE Describe*;
    BEGIN
      Log.String(name); Log.String(" area=");
      Log.Int(ENTIER(SELF.Area()), 1); Log.Ln   (* SELF = this *)
    END Describe;
  END Shape;

  Circle* = OBJECT (Shape)                        (* single inheritance *)
  VAR radius: FLOAT64;

    PROCEDURE &InitCircle*(r: FLOAT64);
    BEGIN
      Init("circle");                         (* call inherited method *)
      radius := r
    END InitCircle;

    PROCEDURE Area*(): FLOAT64;                 (* override *)
    BEGIN
      RETURN 3.14159 * radius * radius
    END Area;
  END Circle;

PROCEDURE UseObjects;
VAR s: Shape; c: Circle;
BEGIN
  NEW(c, 2.0);                (* NEW passes the constructor arguments *)
  c.Describe;
  s := c;                     (* a Circle is a Shape *)
  s.Describe;                 (* dynamic dispatch: prints the circle area *)

  IF s IS Circle THEN         (* run time type test *)
    Log.String(s(Circle).name); Log.Ln    (* type guard *)
  END;

  WITH s: Circle DO           (* regional type guard *)
    Log.Int(ENTIER(s.Area()), 1); Log.Ln
  END
END UseObjects;

(* ------------------------------------------------------------------ *)
(* Active objects: the reason the language is called *Active* Oberon   *)
(* ------------------------------------------------------------------ *)

TYPE
  (* An object with a BEGIN {ACTIVE} body owns a thread that starts as
     soon as the object is created. {EXCLUSIVE} turns an object into a
     monitor: only one activity at a time may run inside such a block,
     and AWAIT blocks until the condition becomes true. *)
  Buffer* = OBJECT
  VAR
    data: ARRAY 16 OF SIGNED32;
    head, tail, count: SIGNED32;
    alive: BOOLEAN;

    PROCEDURE &Init*;
    BEGIN
      head := 0; tail := 0; count := 0; alive := TRUE
    END Init;

    PROCEDURE Put*(x: SIGNED32);
    BEGIN {EXCLUSIVE}
      AWAIT(count < LEN(data));         (* wait until there is room *)
      data[tail] := x;
      tail := (tail + 1) MOD LEN(data);
      INC(count)
    END Put;

    PROCEDURE Get*(): SIGNED32;
    VAR x: SIGNED32;
    BEGIN {EXCLUSIVE}
      AWAIT(count > 0);                 (* wait for an element *)
      x := data[head];
      head := (head + 1) MOD LEN(data);
      DEC(count);
      RETURN x
    END Get;

    PROCEDURE Close*;
    BEGIN {EXCLUSIVE}
      alive := FALSE
    END Close;

  BEGIN {ACTIVE}                            (* the body is a thread *)
    WHILE alive DO
      Log.Int(SELF.Get(), 1); Log.Ln
    END
  END Buffer;

PROCEDURE Producer*;
VAR b: Buffer; i: SIGNED32;
BEGIN
  NEW(b);                                   (* the thread starts here *)
  FOR i := 1 TO 5 DO b.Put(i) END;
  b.Close
END Producer;

(* A whole procedure body can be a critical section, and a plain
   BEGIN {EXCLUSIVE} ... END block may also appear inside a procedure. *)

PROCEDURE Guarded(o: Buffer);
BEGIN
  BEGIN {EXCLUSIVE}
    INC(counter)
  END
END Guarded;

(* ------------------------------------------------------------------ *)
(* Math arrays: array structured types with element wise operators     *)
(* ------------------------------------------------------------------ *)

PROCEDURE MathArrays;
VAR
  v: ARRAY [*] OF FLOAT64;         (* one dimensional, open *)
  m: ARRAY [*, *] OF FLOAT64;      (* two dimensional *)
  t: ARRAY [?] OF FLOAT64;         (* tensor, any rank *)
  w: ARRAY [3] OF FLOAT64;         (* fixed length *)
  f: FLOAT64;
BEGIN
  NEW(v, 3); NEW(m, 3, 3);
  v := [1.0, 2.0, 3.0];            (* array constructor *)
  v := v .* v;                     (* element wise product *)
  v := 2 * v;                      (* scalar broadcast *)
  m := m + m;
  v := m * v;                      (* matrix vector product *)
  f := SUM(v);
  f := v[1];  v[0..1] := v[1..2];  (* ranges and slices *)
  Log.Int(LEN(v, 0), 1); Log.Ln;   (* length of dimension 0 *)
  Log.Int(DIM(m), 1); Log.Ln       (* number of dimensions *)
END MathArrays;

(* ------------------------------------------------------------------ *)
(* Commands: procedures callable from the A2 shell                     *)
(* ------------------------------------------------------------------ *)

(* An exported parameterless procedure, or one taking a
   Commands.Context, can be started from the command line or from any
   piece of text in the system by clicking on it. *)

PROCEDURE Hello*(context: Commands.Context);
VAR name: Name;
BEGIN
  context.arg.SkipWhitespace;
  context.arg.String(name);                    (* read an argument *)
  IF name = "" THEN COPY("world", name) END;
  context.out.String(Greeting); context.out.String(", ");
  context.out.String(name); context.out.String("!");
  context.out.Ln;
  context.out.Update                           (* flush the writer *)
END Hello;

PROCEDURE WriteTo(w: Streams.Writer);
BEGIN
  w.String("Streams.Writer works with files, network and screen");
  w.Ln; w.Update
END WriteTo;

(* The module body runs once, when the module is loaded. *)
BEGIN
  counter := 0;
  KernelLog.String("LearnActiveOberon loaded"); KernelLog.Ln
END LearnActiveOberon.

(* Text below the final dot is ignored by the compiler, so A2 sources
   traditionally end with the commands that build and test the module.
   In A2 you execute them by middle clicking on them:

Compiler.Compile LearnActiveOberon.Mod ~
LearnActiveOberon.Hello Active Oberon ~
LearnActiveOberon.Producer ~
System.Free LearnActiveOberon ~
*)