Added sample Triangle programs.

programs/arrays.tri

@@ -0,0 +1,47 @@
+let
+  type Vector ~ array 3 of Integer;
+  type Matrix ~ array 3 of Vector;
+
+  proc putvector (v: Vector) ~
+    let var i: Integer
+    in
+      begin
+      put ('['); putint (v[0]);
+      i := 1;
+      while i < 3 do
+        begin
+        put (' '); putint (v[i]);
+        i := i+1
+        end;
+      put (']')
+      end;
+
+  proc putmatrix (m: Matrix) ~
+    let var i: Integer
+    in
+      begin
+      i := 0;
+      while i < 3 do
+        begin
+        putvector (m[i]);
+        puteol ();
+        i := i+1
+        end
+      end;
+
+  func diagonal
+          (m: Matrix): Vector ~
+    [m[0][0], m[1][1], m[2][2]];
+
+  var me: Matrix
+    
+in
+  begin
+  me := [[1,2,3], [4,5,6], [7,8,9]];
+  putmatrix (me); puteol ();
+  putvector (diagonal (me));
+  puteol (); puteol ();
+  me[1] := [10,11,12];
+  me[1][1] := 22;
+  putmatrix (me); puteol ()
+  end

programs/bank.tri

@@ -0,0 +1,86 @@
+let
+  const max ~ 9999;
+  const invalid ~ 0-1;
+  type Money ~ Integer;  ! 0 .. max
+  type Trans ~ Char;     ! 'd' | 'w' | 'q'
+
+  func sum (m: Money, n: Money): Money ~
+    let const s ~ m + n
+    in
+       if s <= max then s else invalid;
+
+  func diff (m: Money, n: Money): Money ~
+    let const d ~ m - n
+    in
+       if 0 <= d then d else invalid;
+
+  proc gettrans (var code: Trans,
+                 var amount: Money) ~
+      begin
+      get(var code);
+      if code = 'q' then
+        ! skip
+      else
+       begin
+       getint(var amount);
+       if (0 > amount) \/ (amount > max) then
+        begin
+        amount := invalid; code := '?'
+        end
+       else if (code \= 'd') /\ (code \= 'w') then
+        code := '?'
+       else
+        ! ok
+       end;
+      geteol()
+      end;
+
+  proc processtrans (code: Trans,
+                     amount: Money,
+                     var balance: Money) ~
+      let
+        var newbalance: Money
+      in
+      begin
+      if code = 'd' then
+        begin
+        put('D'); put('e'); put('p'); put('o'); put('s'); 
+        put('i'); put('t'); put(' '); 
+        putint(amount); puteol();
+        newbalance := sum(balance, amount)
+        end
+      else if code = 'w' then
+        begin
+        put('W'); put('i'); put('t'); put('h'); put('d'); 
+        put('r'); put('a'); put('w'); put(' '); 
+        putint(amount); puteol();
+        newbalance := diff(balance, amount)
+        end
+      else
+        ; !skip
+      if (code = '?') \/ (newbalance = invalid) then
+        begin
+        put('I'); put('n'); put('v'); put('a'); put('l'); 
+        put('i'); put('d'); puteol()
+        end
+      else
+        balance := newbalance;
+      put('B'); put('a'); put('l'); put('a'); put('n'); 
+      put('c'); put('e'); put(' '); 
+      putint(balance); puteol();
+      end;
+
+  var balance:    Money;
+  var amount:     Money;
+  var trans:      Trans
+
+in
+  begin
+  balance := 0;
+  gettrans(var trans, var amount);
+  while trans \= 'q' do
+    begin
+    processtrans(trans, amount, var balance);
+    gettrans(var trans, var amount)
+    end
+  end

programs/control.tri

@@ -0,0 +1,26 @@
+! Plot a histogram from a stream of nonzero integers.
+
+let
+ const mark ~ '+';
+	var n : Integer
+in
+	begin
+	getint (var n); geteol ();
+	while n \= 0 do
+  let
+   var i : Integer;
+   var gap : Integer
+  in
+		 begin
+		 gap := if n > 0 then 20 else 20 + n;
+		 if n < 0 then  n := 0 - n else ;
+	 	i := 0;
+		 while i < gap do
+		 	begin put (' '); i := i + 1 end;
+		 i := 0;
+		 while i < n do
+		 	begin put (mark); i := i + 1 end;
+		 puteol ();
+	 	getint (var n); geteol ()
+   end
+	end

programs/deepnest.tri

@@ -0,0 +1,16 @@
+let proc p1 () ~
+ let var c1: Char;
+     proc p2 () ~
+   let proc p3 () ~
+    let proc p4 () ~
+     let proc p5 () ~
+      let proc p6 () ~
+       let proc p7 () ~
+        put (c1)
+       in p7 ()
+      in p6 ()
+     in p5 ()
+    in p4 ()
+   in p3 ()
+ in begin c1 := '+'; p2 () end
+in p1 ()

programs/directories.tri

@@ -0,0 +1,117 @@
+let
+ type Name   ~ array 6 of Char;
+ type Number ~ Integer;
+
+ proc prompt () ~
+  begin
+  put('N'); put('a'); put('m'); put('e');
+  put('?'); put(' ')
+  end;
+
+ proc getname (var newname: Name) ~
+  let var i: Integer
+  in
+   begin
+   i := 0;
+   while i < 6 do
+    begin
+     if eol () then
+      newname[i] := ' '
+     else
+      get (var newname[i]);
+     i := i+1
+    end
+   end;
+
+ proc putname (newname: Name) ~
+  let var i: Integer
+  in
+   begin
+   i := 0;
+   while i < 6 do
+    begin
+     put (newname[i]);
+     i := i+1
+    end
+   end;
+
+ type Entry     ~ record
+                   number: Number,
+                   name: Name
+                  end;
+ type Directory ~ record
+                   size: Integer,
+                   entry: array 100 of Entry
+                  end;
+
+ proc initialize (var dir: Directory) ~
+  dir.size := 0;
+
+ proc add (var dir: Directory,
+           newname: Name,
+           newnumber: Number) ~
+  begin
+   dir.entry[dir.size] :=
+    {number ~ newnumber, name ~ newname};
+   dir.size := dir.size + 1
+  end;
+
+ proc lookup (var dir: Directory,
+              oldname: Name,
+              var oldnumber: Number,
+              var found: Boolean) ~
+  let
+   var i: Integer;
+   var searching: Boolean
+  in
+   begin
+    i := 0; searching := true;
+    while (i < dir.size) /\ searching do
+     if dir.entry[i].name = oldname then
+      searching := false
+     else
+      i := i+1;
+    found := \searching;
+    if found then
+     oldnumber := dir.entry[i].number
+    else !skip
+   end;
+
+ var mydir: Directory
+
+in
+
+ begin
+  initialize (var mydir);
+  add (var mydir,
+   ['D','a','v','i','d',' '], 6041);
+  add (var mydir,
+   ['M','u','f','f','y',' '], 4969);
+  add (var mydir,
+   ['K','i','e','r','a','n'], 6042);
+  add (var mydir,
+   ['A','l','e','x','a',' '], 5322);
+   
+  let
+   const blank ~ [' ', ' ', ' ', ' ', ' ', ' '];
+   var name: Name;
+   var num: Number;
+   var ok: Boolean
+  in
+   begin
+    prompt ();
+   	getname (var name); geteol ();
+     while name \= blank do
+      begin
+       putname (name); put (' ');
+       lookup (var mydir, name, var num, var ok);
+       if ok then
+        putint (num)
+       else
+        put ('?');
+       puteol ();
+       prompt ();
+       getname (var name); geteol ()
+     end
+   end
+ end

programs/errors.tri

@@ -0,0 +1,30 @@
+! Program with a variety of contextual errors.
+
+let
+  type String ~ array 4 of Char;
+  type Name ~ array 3 of String;
+  type Rec ~ record x: Integer, x: Integer end;
+
+  var me: Name;
+  var silly : maxint;
+  var silly: Rec;
+
+  proc putstr (s: String) ~
+    let var i: Integer
+    in
+      begin
+      s[4] := ' ';
+      i := 0;
+      while i do
+        begin i := i+true;
+              put (s[\i])
+        end
+      end
+    
+in
+  begin
+  me[true] := ['T','i','n','y'];
+  me[2][2] := 0;
+  put (me[1]); put (4); put ();
+  putstr (initials (me)); puteol ()
+  end

programs/every.tri

@@ -0,0 +1,148 @@
+! Marry a woman and man.
+! Input following data for each person (woman then man):
+!     surname, forename (each up to 10 non-blank chars),
+!     sex ('M'|'F'), marital status ('m'|'u'),
+!     day, month, year of birth.
+
+let
+	type Month ~ Integer;
+	const Jan ~ 1;	const Feb ~ 2;	const Mar ~ 3;
+	const Apr ~ 4;	const May ~ 5;	const Jun ~ 6;
+	const Jul ~ 7;	const Aug ~ 8;	const Sep ~ 9;
+	const Oct ~ 10;	const Nov ~ 11;	const Dec ~ 12;
+
+	type Date ~ record
+              y : Integer,
+              m : Month,
+              d : Integer
+             end;
+	const today ~ {y ~ 1993, m ~ Apr, d ~ 1};
+
+	proc getdate (var date : Date) ~
+		begin
+		getint (var date.d); getint (var date.m); getint (var date.y)
+		end;
+
+	proc putdate (date : Date) ~
+		begin
+		putint (date.d); put ('/');
+		putint (date.m); put ('/');
+		putint (date.y // 100)
+		end;
+
+	func yearsbefore (yrs : Integer, date : Date) : Date ~
+		{y ~ date.y - yrs, m ~ date.m, d ~ date.d};
+
+	func earlier (date1 : Date, date2 : Date) : Boolean ~
+		if date1.y < date2.y then true
+		else if date1.y > date2.y then false
+		else if date1.m < date2.m then true
+		else if date1.m > date2.m then false
+		else date1.d < date2.d;
+
+	const maxname ~ 10;
+	type Name ~ array 10 of Char;
+
+	proc getname (var name : Name) ~
+		let
+			var ch : Char;
+			var length : Integer
+		in
+			begin
+			get (var ch); while ch = ' ' do get (var ch);
+			length := 0;
+			while length < maxname do
+				begin
+				length := length + 1; name[length] := ch;
+				if ch \= ' ' then get (var ch) else ! skip
+				end
+			end;
+
+	proc putname (name : Name) ~
+		let
+			var pad : Boolean;
+			var length : Integer
+		in
+			begin
+			pad := false; length := 0;
+			while (\ pad) /\ (length < maxname) do
+				begin
+				length := length + 1;
+				if name[length] = ' ' then
+					pad := true
+				else
+					put (name[length])
+				end
+			end;
+
+	type Person ~ record
+	                surname  : Name,
+	                forename : Name,
+	                male     : Boolean,
+	                married  : Boolean,
+	                dob      : Date
+	              end;
+
+	proc getperson (var person : Person) ~
+		let
+			var fore : Name;
+			var sur  : Name;
+			var s : Char;
+			var m : Char;
+			var birth : Date
+		in
+			begin
+			getname (var sur); getname (var fore);
+			get (var s); while s = ' ' do get (var s);
+			get (var m); while m = ' ' do get (var m);
+			getdate (var birth);
+			person := {surname ~ sur, forename ~ fore,
+			           male ~ (s = 'M'), married ~ (m = 'm'), 
+			           dob ~ birth}
+			end;
+
+	proc putperson (person : Person) ~
+		begin
+		putname (person.surname); put (' ');
+		putname (person.forename); put (' ');
+		put (if person.male then 'M' else 'F'); put (' ');
+		put (if person.married then 'm' else 'u'); put (' ');
+		putdate (person.dob)
+		end;
+
+	func age (person : Person) : Integer ~
+		let
+			const dob ~ person.dob
+		in
+			if (today.m > dob.m) \/
+			   ((today.m = dob.m) /\ (today.d >= dob.d))
+			then today.y - dob.y
+			else today.y - dob.y - 1;
+
+	const latestdob ~ yearsbefore (16, today);
+
+	var bride : Person;
+	var groom : Person
+
+in
+	begin
+	getperson (var bride);
+	getperson (var groom);
+	puteol ();
+	if \ bride.male /\ groom.male /\
+	   \ (bride.married \/ groom.married) /\
+	   \ earlier (latestdob, bride.dob) /\
+	   \ earlier (latestdob, groom.dob) then
+		begin
+		put ('O'); put ('K'); puteol ();
+		bride.married := true; groom.married := true;
+		bride.surname := groom.surname
+		end
+	else
+		begin
+		put ('N'); put ('o'); put ('!'); puteol ()
+		end;
+	putperson (bride); put (' '); putint (age (bride)); puteol ();
+	putperson (groom); put (' '); putint (age (groom)); puteol ();
+	putdate (today);  puteol ()
+	end

programs/factorials.tri

@@ -0,0 +1,15 @@
+let
+ func factorial (n: Integer): Integer ~
+  if n <= 1
+  then 1
+  else n * factorial (n-1);
+
+ var i: Integer
+
+in
+ begin
+ getint (var i);
+ putint (i); put ('!');
+ put (' '); put ('='); put (' ');
+ putint (factorial (i))
+ end

programs/functions.tri

@@ -0,0 +1,28 @@
+! Print powers of integers.
+
+let
+	func even (n : Integer) : Boolean ~
+		(n // 2) = 0;
+
+	func sqr (n : Integer) : Integer ~
+		n * n;
+
+	func power (b : Integer, n : Integer) : Integer ~
+		! assume n >= 0
+		if n = 0
+		then 1
+		else
+		if even (n)
+		then sqr (power (b, n/2))
+		else sqr (power (b, n/2)) * b;
+
+	var x : Integer;
+	var m : Integer
+in
+	begin
+	getint (var x); getint (var m);
+	putint (x); put ('^'); putint (m);  
+	put (' ');  put ('=');  put (' ');
+	putint (power (x, m));
+ puteol ()
+	end

programs/hi.tri

@@ -0,0 +1,3 @@
+begin
+ put('H'); put('i'); put('!')
+end

programs/hullo.tri

@@ -0,0 +1,53 @@
+let
+ const maxlength ~ 15;
+ type String ~ array 16 of Char;
+ const null ~ chr(0);
+!Strings will be padded with nulls.
+
+ proc getstring (var s: String) ~
+  let var l: Integer
+  in
+   begin
+   l := 0;
+   while l < maxlength do
+    begin
+    if eol () then
+     s[l] := null
+    else
+     get (var s[l]);
+    l := l+1;
+    end;
+   s[maxlength] := null
+   end;
+
+ proc putstring (s: String) ~
+  let var i: Integer
+  in
+   begin
+   i := 0;
+   while s[i] \= null do
+    begin
+     put (s[i]);
+     i := i+1
+    end
+   end;
+
+ var you: String
+
+in
+ begin
+ putstring (
+  ['W','h','o',' ',
+   'a','r','e',' ', 
+   'y','o','u','?',
+   null,null,null,null]);
+ puteol ();
+ getstring (var you); geteol ();
+ putstring (
+  ['H','u','l','l',
+   'o',',',' ',null,
+   null,null,null,null,
+   null,null,null,null]);
+ putstring (you); put ('!');
+ puteol ()
+end

programs/names.tri

@@ -0,0 +1,52 @@
+let
+ type Name   ~ array 6 of Char;
+ type Number ~ Integer;
+
+ proc getname (var newname: Name) ~
+  let var i: Integer
+  in
+   begin
+   i := 0;
+   while i < 6 do
+    begin
+     if eol () then
+      newname[i] := ' '
+     else
+      get (var newname[i]);
+     i := i+1
+    end
+   end;
+
+ proc putname (newname: Name) ~
+  let var i: Integer
+  in
+   begin
+   i := 0;
+   while i < 6 do
+    begin
+     put (newname[i]);
+     i := i+1
+    end
+   end;
+
+ func samename (name1: Name, name2: Name) : Boolean ~
+  let
+   func same (n: Integer) : Boolean ~
+    (name1[n] = name2[n]) /\
+     (if n = 0 then true else same (n-1))
+  in
+   same (5);
+
+ var nam: Name
+
+in
+
+ begin
+  getname (var nam); geteol ();
+  putname (nam); put (' ');
+  if samename (nam, ['D','a','v','i','d',' ']) then
+   put ('Y')
+  else
+   put ('N');
+  puteol ()
+ end

programs/nesting.tri

@@ -0,0 +1,31 @@
+let
+ var g: Integer;
+
+ proc P() ~
+  let
+   var p: Integer;
+
+			proc Q() ~
+    let
+     var q: Integer;
+     proc R() ~
+      let
+       var r: Integer
+      in
+       r := (g+p+q) * 1000   ! should cause overflow
+    in
+     begin q := g+p; R() end;
+
+   proc S() ~
+    let
+     var s: Integer
+    in
+     begin s := g+p+1; Q() end
+
+  in
+   begin p := g+1; S() end
+
+in
+ begin g := 1000; P() end
+
+        

programs/procedural.tri

@@ -0,0 +1,56 @@
+! test program proc.Æ
+let
+   const size   ~ 6;
+   type  String ~ array 6 of Char;
+
+  proc putstr (s: String) ~
+    let var i: Integer
+    in
+      begin
+      i := 0;
+      while i < size do
+        begin put (s[i]); i := i+1 end
+      end;
+
+   proc apply (proc p (var c : Char), var s : String) ~
+      let
+         var i : Integer
+      in
+         begin
+         i := 0;
+         while i < size do
+            begin
+            p (var s[i]);
+            i := i+1
+            end
+         end; !apply
+
+   proc shift (var l : Char) ~
+      let const ordl ~ ord (l)
+      in
+         if (ord('a') <= ordl)
+            /\ (ordl <= ord('z')) then
+            l := chr (ordl - ord('a') + ord('A'))
+         else
+            ; !skip
+
+   proc replaceall (old: Char, new: Char,
+                    var s: String) ~
+      let
+         proc zap (var c: Char) ~
+            if c = old then c := new else !skip
+      in
+         apply (proc zap, var s);
+
+   var name : String
+
+in
+   begin
+   apply (proc get, var name);
+   geteol ();
+   putstr (name); puteol ();
+   apply (proc shift, var name);
+   putstr (name); puteol ();
+   replaceall ('I', 'i', var name);
+   putstr (name); puteol ()
+   end

programs/procedures.tri

@@ -0,0 +1,31 @@
+! Plot a histogram from a stream of nonzero integers.
+
+let
+	const mid ~ 40;
+	var n : Integer;
+
+	proc putmany (c : Char, n : Integer) ~
+		let
+			var i : Integer
+		in
+	  begin
+			i := 0;
+			while i < n do
+				begin put (c); i := i + 1 end
+		 end;
+
+	proc makenonnegative (var n : Integer) ~
+		if n < 0 then n := 0 - n else
+
+in
+	begin
+	getint (var n); geteol ();
+	while n \= 0 do
+		begin
+		putmany (' ', if n > 0 then mid else mid + n);
+		makenonnegative (var n);
+		putmany ('+', n);
+		puteol ();
+		getint (var n); geteol ()
+		end
+	end

programs/records.tri

@@ -0,0 +1,24 @@
+! test program record.Æ
+let
+  type Month ~ array 3 of Char;
+  type Date ~ record d: Integer, m: Month end;
+  const xmas ~ {d ~ 25,
+                m ~ ['D','e','c']};
+  var eve: Date;
+
+  proc putmonth (mth: Month) ~
+    begin
+    put (mth[0]); put (mth[1]); put (mth[2])
+    end;
+
+  proc putdate (date: Date) ~
+    begin
+    putint (date.d); put ('/'); putmonth (date.m)
+    end
+
+in
+  begin
+  putdate (xmas); puteol ();
+  eve := {d ~ xmas.d-1, m ~ xmas.m};
+  putdate (eve); puteol ()
+  end

programs/repl.tri

@@ -0,0 +1,13 @@
+let
+  type Str ~ array 10 of Char;
+
+  func replicate (c: Char): Str ~
+    [c,c,c,c,c,c,c,c,c,c];
+
+  var s: Str
+in
+
+  begin
+  s := replicate('*');
+  put (s[0]); put(s[9]); puteol()
+  end

programs/triangle.tri

@@ -0,0 +1,32 @@
+let
+
+ proc putmany (n: Integer, c: Char) ~
+  let
+   var i: Integer
+  in
+   begin
+   i := 0;
+   while i < n do
+    begin i := i+1; put (c) end
+   end;
+
+ var n: Integer;  var r: Integer;
+ const mark ~ '@'
+
+in
+ begin
+ getint (var n); geteol ();
+ r := 0;
+ while r < (n-1) do
+  begin
+  r := r + 1;
+  putmany (n-r, ' '); put (mark);
+  if r >= 2 then
+   begin
+   putmany (2*r - 3, ' '); put (mark)
+   end
+  else; !skip
+  puteol ()
+  end;
+ putmany (2*n - 1, mark)
+ end