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

Added sample Triangle programs.

Browse Source
This commit is contained in:
Deryck Brown 2022-05-17 19:49:08 +01:00
parent c8ed9462d8
commit 1db90b20a8
18 changed files with 808 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

47
programs/arrays.tri Normal file
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 Normal file
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 Normal file
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 Normal file
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 Normal file
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 Normal file
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 Normal file
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 Normal file
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 Normal file
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 Normal file
View File

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

53
programs/hullo.tri Normal file
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 Normal file
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 Normal file
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 Normal file
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 Normal file
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 Normal file
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 Normal file
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 Normal file
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