diff --git a/programs/arrays.tri b/programs/arrays.tri new file mode 100644 index 0000000..1cfbd28 --- /dev/null +++ b/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 diff --git a/programs/bank.tri b/programs/bank.tri new file mode 100644 index 0000000..e7f3c0f --- /dev/null +++ b/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 diff --git a/programs/control.tri b/programs/control.tri new file mode 100644 index 0000000..9d76146 --- /dev/null +++ b/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 diff --git a/programs/deepnest.tri b/programs/deepnest.tri new file mode 100644 index 0000000..315b123 --- /dev/null +++ b/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 () diff --git a/programs/directories.tri b/programs/directories.tri new file mode 100644 index 0000000..49e6794 --- /dev/null +++ b/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 diff --git a/programs/errors.tri b/programs/errors.tri new file mode 100644 index 0000000..ed0e097 --- /dev/null +++ b/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 diff --git a/programs/every.tri b/programs/every.tri new file mode 100644 index 0000000..011fd1c --- /dev/null +++ b/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 diff --git a/programs/factorials.tri b/programs/factorials.tri new file mode 100644 index 0000000..c1db33c --- /dev/null +++ b/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 diff --git a/programs/functions.tri b/programs/functions.tri new file mode 100644 index 0000000..d343874 --- /dev/null +++ b/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 diff --git a/programs/hi.tri b/programs/hi.tri new file mode 100644 index 0000000..aac4ec1 --- /dev/null +++ b/programs/hi.tri @@ -0,0 +1,3 @@ +begin + put('H'); put('i'); put('!') +end diff --git a/programs/hullo.tri b/programs/hullo.tri new file mode 100644 index 0000000..a7a40a0 --- /dev/null +++ b/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 diff --git a/programs/names.tri b/programs/names.tri new file mode 100644 index 0000000..741167a --- /dev/null +++ b/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 diff --git a/programs/nesting.tri b/programs/nesting.tri new file mode 100644 index 0000000..90838ca --- /dev/null +++ b/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 + + diff --git a/programs/procedural.tri b/programs/procedural.tri new file mode 100644 index 0000000..65263d0 --- /dev/null +++ b/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 diff --git a/programs/procedures.tri b/programs/procedures.tri new file mode 100644 index 0000000..a72f68c --- /dev/null +++ b/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 diff --git a/programs/records.tri b/programs/records.tri new file mode 100644 index 0000000..5d8f63e --- /dev/null +++ b/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 \ No newline at end of file diff --git a/programs/repl.tri b/programs/repl.tri new file mode 100644 index 0000000..f6cf367 --- /dev/null +++ b/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 diff --git a/programs/triangle.tri b/programs/triangle.tri new file mode 100644 index 0000000..555ea81 --- /dev/null +++ b/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