simonkellet
/
Triangle-Tools
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Added sample Triangle programs.

Browse Source
main
Deryck Brown 2 years ago
parent c8ed9462d8
commit 1db90b20a8
18 changed files with 808 additions and 0 deletions
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Show Stats Download Patch File Download Diff File
  1. 47
      programs/arrays.tri
  2. 86
      programs/bank.tri
  3. 26
      programs/control.tri
  4. 16
      programs/deepnest.tri
  5. 117
      programs/directories.tri
  6. 30
      programs/errors.tri
  7. 148
      programs/every.tri
  8. 15
      programs/factorials.tri
  9. 28
      programs/functions.tri
  10. 3
      programs/hi.tri
  11. 53
      programs/hullo.tri
  12. 52
      programs/names.tri
  13. 31
      programs/nesting.tri
  14. 56
      programs/procedural.tri
  15. 31
      programs/procedures.tri
  16. 24
      programs/records.tri
  17. 13
      programs/repl.tri
  18. 32
      programs/triangle.tri

47
programs/arrays.tri
Unescape View File

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

86
programs/bank.tri
Unescape View File

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

26
programs/control.tri
Unescape View File

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

16
programs/deepnest.tri
Unescape View File

@ -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 ()

117
programs/directories.tri
Unescape View File

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

30
programs/errors.tri
Unescape View File

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

148
programs/every.tri
Unescape View File

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

15
programs/factorials.tri
Unescape View File

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

28
programs/functions.tri
Unescape View File

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

3
programs/hi.tri
Unescape View File

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

53
programs/hullo.tri
Unescape View File

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

52
programs/names.tri
Unescape View File

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

31
programs/nesting.tri
Unescape View File

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

56
programs/procedural.tri
Unescape View File

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

31
programs/procedures.tri
Unescape View File

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

24
programs/records.tri
Unescape View File

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

13
programs/repl.tri
Unescape View File

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

32
programs/triangle.tri
Unescape View File

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