--- /dev/null
+def
+ bits.in.character = 8,
+ number.of.characters= 1 << bits.in.character,
+ number.of.codes = number.of.characters + 1,
+ character.mask = not ((not 0) << bits.in.character):
+
+def
+ root = 0, size.of.tree = (2* number.of.codes)-1, not.a.node = size.of.tree:
+
+var
+ escape, weight[size.of.tree],
+ children[size.of.tree], parent[size.of.tree],
+ character[size.of.tree], representative[number.of.characters] :
+
+proc construct.tree =
+ -- Create a tree for the encoding in which every character is escaped
+ seq
+ escape := root
+ weight[escape] := 1
+ children[escape] := root -- it is a leaf
+ seq ch= [0 for number.of.characters]
+ representative[ch] := not.a.node :
+
+proc create.leaf(var new.leaf, value ch) =
+ -- Extend the tree by fision of the escape leaf into two new leaves
+ var new.escape:
+ seq
+ new.leaf := escape + 1
+ new.escape := escape + 2
+
+ children[escape] := new.leaf -- escape is the new parent
+
+ weight[new.leaf] := 0
+ children[new.leaf] := root
+ parent[new.leaf] := escape
+ character[new.leaf] := ch
+ representative[ch /\ character.mask] := new.leaf
+
+ weight[new.escape] := 1
+ children[new.escape]:= root
+ parent[new.escape] := escape
+
+ escape := new.escape :
+
+proc swap.trees(value i, j) =
+ -- Exchange disjoint sub-trees routed at i and j
+ proc swap.words(var p,q) =
+ -- Exchange values stored in p and q
+ var t:
+ seq
+ t := p
+ p := q
+ q := t :
+
+ proc adjust.offspring(value i) =
+ -- Restore downstream pointers to node i
+ if
+ children[i] = root
+ representative[character[i] /\ character.mask] := i
+ children[i] <> root
+ seq child=[children[i] for 2]
+ parent[child] := i :
+
+ seq
+ swap.words(children[i], children[j])
+ swap.words(character[i], character[j])
+ adjust.offspring(i)
+ adjust.offspring(j) :
+
+proc increment.frequency(value ch) =
+ -- Adjust the weights of all relevant nodes to account for one more occurence
+ -- of the character ch, and adjust the shape of the tree if necessary
+ var node:
+ seq
+ if
+ representative[ch /\ character.mask] <> not.a.node
+ node := representative[ch /\ character.mask]
+ representative[ch /\ character.mask] = not.a.node
+ create.leaf(node, ch)
+ while node <> root
+ if
+ weight[node-1] > weight[node]
+ seq
+ weight[node] := weight[node] + 1
+ node := parent[node]
+ weight[node-1] = weight[node]
+ if i= [1 for (node-root)-1]
+ weight[(node-i)-1] > weight[node]
+ seq
+ swap.trees(node, node-i)
+ node := node-i
+ weight[root] := weight[root] + 1 :
+
+proc encode.character(chan output, value ch) =
+ -- Transmit the encoding of ch along output
+ def size.of.encoding = bits.in.character + (number.of.codes - 1) :
+ var encoding[size.of.encoding], length, node:
+ seq
+ if
+ representative[ch /\ character.mask] <> not.a.node
+ seq
+ length := 0
+ node := representative[ch /\ character.mask]
+ representative[ch /\ character.mask] = not.a.node
+ seq
+ seq i=[0 for bits.in.character]
+ encoding[i] := (ch >> i) /\ 1 -- i'th bit of unencoded ch
+ length := bits.in.character
+ node := escape
+ while node <> root
+ seq
+ encoding[length] := node - children[parent[node]]
+ length := length + 1
+ node := parent[node]
+ seq i= [1 for length]
+ output ! encoding[length-i] :
+
+proc decode.character(chan input, var ch) =
+ -- Receive an encoding along input and store the corresponding character in ch
+ var node:
+ seq
+ node := root
+ while children[node] <> root
+ var bit:
+ seq
+ input ? bit
+ node := children[node] + bit
+ if
+ node < escape
+ ch := character[node]
+ node = escape
+ var bit:
+ seq
+ input ? bit
+ ch := -bit
+ seq i= [2 for bits.in.character - 1]
+ seq
+ input ? bit
+ ch := (ch << 1) \/ bit :
+
+def end.of.message = -1:
+
+proc copy.encoding(chan source, sink) =
+ -- Read a stream of characters from source, until signalled on end.of.source,
+ -- and transmit their encodings in sequence along sink, followed by that of
+ -- end.of.message, maintaining throughout the encoding tree for the encoding
+ -- determined by the cumulative frequencies of the characters transmitted
+ var more.characters.expected:
+ seq
+ construct.tree
+ more.characters.expected := true
+ while more.characters.expected
+ var ch:
+ seq
+ source ? ch
+ if
+ ch <> end.of.message
+ seq
+ encode.character(sink, ch)
+ increment.frequency(ch)
+ ch = end.of.message
+ more.characters.expected := false
+ encode.character(sink, end.of.message) :
+
+proc copy.decoding(chan source, sink) =
+ -- Read the encodings of a stream of characters, up to and including the
+ -- encoding of end.of.message, from source and transmit the corresponding
+ -- characters along sink, maintaining the encoding tree for encoding
+ -- determined by the cumulative frequencies of the characters received
+ var more.characters.expected:
+ seq
+ construct.tree
+ more.characters.expected := true
+ while more.characters.expected
+ var ch:
+ seq
+ decode.character(source, ch)
+ if
+ ch <> end.of.message
+ seq
+ sink ! ch
+ increment.frequency(ch)
+ ch = end.of.message
+ more.characters.expected:=false :
+
+var choose:
+seq
+ input ? choose
+ if
+ choose='e'
+ copy.encoding(input, output)
+ choose='d'
+ copy.decoding(input, output)
--- /dev/null
+This directory only contains some Occam programs, not a testset.
--- /dev/null
+def otherwise=true:
+
+proc xxtoy(chan in, out, value x, y)=
+ var c:
+ seq
+ c:= not EOF
+ while c<>EOF
+ seq
+ in ? c
+ if
+ c=x
+ seq
+ in ? c
+ if
+ c=x
+ out ! y
+ otherwise
+ out ! x; c
+ otherwise
+ out ! c
+:
+chan link:
+par
+ xxtoy(input, link, 'a', 'b')
+ xxtoy(link, output, 'b', 'c')
--- /dev/null
+def N=10:
+
+proc copy(chan in, out)=
+ var char:
+ seq
+ char:='x'
+ while char<>EOF
+ seq
+ in ? char
+ out ! char
+:
+
+chan junk[N]:
+par
+ copy(input, junk[0])
+
+ par i=[0 FOR N-1]
+ copy(junk[i], junk[i+1])
+
+ var char:
+ seq
+ junk[N-1] ? char
+ while char<>EOF
+ seq
+ output ! char
+ junk[N-1] ? char
--- /dev/null
+#include "dec.ocm"
+var ch:
+seq
+ output ! RAW
+
+ input ? ch
+
+ seq i=[0 for 10]
+ seq
+ decout(output, ch, 0)
+ output ! '*n'
+ input ? ch
+
+ output ! TEXT
--- /dev/null
+def otherwise=true:
+
+def dead=0, alive= not dead:
+
+def radius=1,
+ diameter= (2*radius)+1,
+ neighbours= (diameter*diameter)-1:
+
+proc calculate.next.state(chan link[], value in[], state, var next.state)=
+ var count:
+ seq
+ var state.of.neighbour[neighbours]:
+ seq
+ par i=[0 for neighbours]
+ link[in[i]] ? state.of.neighbour[i]
+ count:=0
+ seq i=[0 for neighbours]
+ if
+ state.of.neighbour[i]=alive
+ count:=count+1
+ state.of.neighbour[i]=dead
+ skip
+ if
+ count<2
+ next.state:=dead
+ count=2
+ next.state:=state
+ count=3
+ next.state:=alive
+ count>3
+ next.state:=dead
+:
+
+proc broadcast.present.state(chan link[], value out[], state)=
+ par i=[0 for neighbours]
+ link[out[i]] ! state
+:
+
+def set.state=1, ask.state=2, terminate=3:
+
+proc cell(chan link[], value in[], out[], chan control, sense)=
+ var state, instruction:
+ seq
+ state:=dead
+ control ? instruction
+ while instruction <> terminate
+ seq
+ if
+ instruction=set.state
+ control ? state
+ instruction=ask.state
+ var next.state:
+ seq
+ par
+ broadcast.present.state(link, out, state)
+ seq
+ calculate.next.state(link, in, state,
+ next.state)
+ sense ! (state<>next.state); next.state
+
+ state:=next.state
+
+ control ? instruction
+:
+
+def array.width=5, array.height=5:
+def number.of.cells=array.height*array.width,
+ number.of.links=neighbours*number.of.cells:
+
+proc initialize(value x, y, var in[], out[])=
+ seq delta.x=[-radius for diameter]
+ seq delta.y=[-radius for diameter]
+ var direction:
+ seq
+ direction:=delta.x+(diameter*delta.y)
+ if
+ direction<>0
+ var index, process:
+ seq
+ process:=x+(array.width*y)
+ index:=(neighbours+direction) \ (neighbours+1)
+ out[index]:=index+(neighbours*process)
+
+ process:=((x+delta.x+array.width) \ array.width) +
+ (array.width*
+ ((y+delta.y+array.height) \ array.height))
+ index:=(neighbours-direction) \ (neighbours+1)
+ in[index]:=index+(neighbours*process)
+ direction=0
+ skip
+:
+
+def control= not ((not 0)<<5), escape=control/\'[':
+
+proc move.cursor(chan screen, value x, y)=
+ screen ! escape; '='; '*s'+y; '*s'+x
+:
+
+proc initialize.display(chan screen)=
+ screen ! control /\ 'Z'
+:
+
+proc clean.up.display(chan screen)=
+ move.cursor(screen, 0, array.height)
+:
+
+proc display.state(chan screen, value x, y, state)=
+ seq
+ move.cursor(screen, x, y)
+ if
+ state=alive
+ screen ! '**'
+ state=dead
+ screen ! '*s'
+:
+
+proc generation(chan screen, control[], sense[], var active)=
+ seq
+ seq cell=[0 for number.of.cells]
+ control[cell] ! ask.state
+ active:=false
+ seq cell=[0 for number.of.cells]
+ var changed, next.state:
+ seq
+ sense[cell] ? changed; next.state
+ if
+ changed
+ seq
+ display.state(screen, cell\array.width,
+ cell/array.width, next.state)
+ active:=true
+ not changed
+ skip
+:
+
+proc edit(chan keyboard, screen, control[])=
+ def ctrl= not ((not 0)<<5):
+ def left.key= 'h', right.key= 'l', up.key= 'k', down.key= 'j',
+ uproot.key= '*s', plant.key= '**', plant.key2= '8':
+ var x, y, editing, ch:
+ seq
+ x:=array.width/2
+ y:=array.height/2
+ editing:=true
+ while editing
+ seq
+ move.cursor(screen, x, y)
+ keyboard ? ch
+ if
+ (ch=left.key) and (x>0)
+ x:=x-1
+ (ch=right.key) and (x<(array.width-1))
+ x:=x+1
+ (ch=up.key) and (y>0)
+ y:=y-1
+ (ch=down.key) and (y<(array.height-1))
+ y:=y+1
+ (ch=uproot.key) or (ch=plant.key) or (ch=plant.key2)
+ var state:
+ seq
+ state:=(dead /\ (ch=uproot.key)) \/
+ (alive /\ ((ch=plant.key) or (ch=plant.key2)))
+ control[x+(array.width*y)] ! set.state; state
+ display.state(screen, x, y, state)
+ (ch='q') or (ch='Q')
+ editing:=false
+ otherwise
+ skip
+:
+
+def idle=1, editing=2, single.stepping=3, free.running=4, terminated=5:
+
+proc display.activity(chan screen, value activity)=
+ seq
+ move.cursor(screen, array.width+1, array.height+2)
+
+ proc write.string(value str[])=
+ seq i=[1 for str[byte 0]]
+ screen ! str[byte i]
+ :
+ if
+ activity=idle
+ write.string("Idle")
+ activity=editing
+ write.string("Edit")
+ activity=single.stepping
+ write.string("Step")
+ activity=free.running
+ write.string("Busy")
+ activity=terminated
+ write.string("Done")
+:
+
+proc controller(chan keyboard, screen, control[], sense[])=
+ var activity:
+ seq
+ activity:=idle
+ initialize.display(screen)
+ while activity<>terminated
+ seq
+ display.activity(screen, activity)
+ var ch:
+ pri alt
+ (activity <> editing) & keyboard ? ch
+ if
+ (ch='q') or (ch='Q')
+ activity:=terminated
+ (ch='i') or (ch='I')
+ activity:=idle
+ (ch='e') or (ch='E')
+ activity:=editing
+ (ch='r') or (ch='R')
+ activity:=free.running
+ (ch='s') or (ch='S')
+ activity:=single.stepping
+ (activity=editing) & skip
+ seq
+ edit(keyboard, screen, control)
+ activity:=idle
+ (activity=free.running) or (activity=single.stepping) & skip
+ var changing:
+ seq
+ generation(screen, control, sense, changing)
+ if
+ (activity=single.stepping) or (not changing)
+ activity:=idle
+ (activity=free.running) and changing
+ skip
+ display.activity(screen, activity)
+ seq cell=[0 for number.of.cells]
+ control[cell] ! terminate
+ clean.up.display(screen)
+:
+
+chan link[number.of.links], control[number.of.cells], sense[number.of.cells]:
+seq
+ output ! RAW
+ par
+ controller(input, output, control, sense)
+
+ par x=[0 for array.width]
+ par y=[0 for array.height]
+ var in[neighbours], out[neighbours]:
+ seq
+ initialize(x, y, in, out)
+ cell(link, in, out, control[x+(array.width*y)],
+ sense[x+(array.width*y)])
+ output ! TEXT
--- /dev/null
+#include "dec.ocm"
+
+proc prompt(value str[])=
+ seq i=[1 for str[byte 0]]
+ output ! str[byte i]
+:
+def N=20 :
+
+var n:
+var A[N*N], x[N], k[N], y[N] :
+
+proc initialise=
+ var c:
+ seq
+ prompt("n?*n")
+ c:='*s'
+ decin(input, n, c)
+
+ prompt("A?*n")
+ seq i= [0 for n]
+ seq j= [0 for n]
+ decin(input, A[(i*n)+j], c)
+
+ prompt("x?*n")
+ seq i= [0 for n]
+ decin(input, x[i], c)
+
+ prompt("k?*n")
+ seq i= [0 for n]
+ decin(input, k[i], c) :
+
+proc produce.xj(value j, chan south) =
+ -- north row: source of x values
+ while true
+ south ! x[j] :
+
+proc consume.yi(value i, chan east) =
+ -- west column: read y values
+ east ? y[i] :
+
+proc offset(value ki, chan west) =
+ -- east column: source of k offsets
+ while true
+ west ! ki :
+
+proc multiplier(value aij, chan north, south, west, east) =
+ -- middle: responsible for a values
+ var xj, aij.times.xj, yi :
+ seq
+ north ? xj
+ while true
+ seq
+ par
+ south ! xj
+ aij.times.xj:= aij*xj
+ east ? yi
+ par
+ west ! yi+aij.times.xj
+ north ? xj :
+
+proc sink(chan north) =
+ -- south row: sink for unused outputs
+ while true
+ north ? any :
+
+seq
+ initialise
+
+ chan north.south[(N+1)*N], east.west[N*(N+1)] :
+ par
+ par j= [0 for n] -- producer of co-ordinates x[j]
+ produce.xj(j, north.south[j])
+
+ par -- the matrix multiplier
+ par i= [0 for n]
+ offset(k[i], east.west[(n*n)+i])
+ par i= [0 for n]
+ par j= [0 for n]
+ multiplier(A[(n*i)+j],
+ north.south[(n*i)+j],
+ north.south[(n*(i+1))+j],
+ east.west[i+(n*j)],
+ east.west[i+(n*(j+1))])
+ par j= [0 for n]
+ sink(north.south[(n*n)+j])
+
+ seq
+ par i= [0 for n]-- consumer of transformed co-ordinates
+ consume.yi(i, east.west[i])
+
+ seq i= [0 for n]
+ seq
+ output ! 'y'; '['
+ decout(output, i, 0)
+ output ! ']'; '='
+ decout(output, y[i], 5)
+ output ! '*n'
+ exit(0)
--- /dev/null
+-- This file contains a recursive call to sorter, so this is not really Occam.
+#include "dec.ocm"
+
+var c:
+seq
+ c:='*s'
+ proc comparator(value num, chan in, out)=
+ var old.num, new.num:
+ seq
+ old.num:=num
+ in ? new.num
+ while new.num
+ seq
+ in ? new.num
+ if
+ new.num<=old.num
+ out ! true; new.num
+ new.num>old.num
+ seq
+ out ! true; old.num
+ old.num:=new.num
+ in ? new.num
+ out ! true; old.num; false
+ :
+ proc sorter(chan out)=
+ chan in:
+ var num:
+ seq
+ decin(input, num, c)
+ if
+ c<0
+ out ! false
+ c>=0
+ par
+ sorter(in)
+ comparator(num, in, out)
+ :
+ chan out:
+ var num:
+ par
+ sorter(out)
+ seq
+ out ? num
+ while num
+ seq
+ out ? num
+ decout(output, num, 0)
+ output ! '*n'
+ out ? num
--- /dev/null
+#include <dec.ocm>
+#include <prints.ocm>
+
+var fmt[byte 100]:
+var d, c:
+seq
+ input ? c
+ decin(input, d, c)
+ while c<>EOF
+ seq
+ chan link:
+ par
+ printd(link, "XXXX %%%ds XXXXX*#00", d)
+ var c, i:
+ seq
+ i:=0
+ link ? c
+ while c<>0
+ seq
+ i:=i+1
+ fmt[byte i]:=c
+ link ? c
+ prints("XXXX %s XXXXX", "YYYYY")
+ decin(input, d, c)
--- /dev/null
+#include <dec.ocm>
+#include <printd.ocm>
+
+seq
+ printd(output, "philosopher %d eats ice*n", 2048)
+ printd(output, "phil. %20d also*n", 65536)
+ chan link:
+ par
+ printd(link, "%d times %d makes 100*n", 10)
+
+ var c:
+ seq
+ c:='x'
+ while c<>'*n'
+ seq
+ link ? c
+ output ! c
--- /dev/null
+def otherwise=true:
+
+def NLET= ('z'-'a')+1:
+
+proc xxtoy(chan in, out, value x, y)=
+ var c:
+ seq
+ c:= not EOF
+ while c<>EOF
+ seq
+ in ? c
+ if
+ c=x
+ seq
+ in ? c
+ if
+ c=x
+ out ! y
+ otherwise
+ out ! x; c
+ otherwise
+ out ! c
+:
+chan link[NLET-1]:
+
+par
+ xxtoy(input, link[0], 'a', 'b')
+
+ par i=[0 for NLET-2]
+ xxtoy(link[i], link[i+1], i+'b', i+'c')
+
+ xxtoy(link[NLET-2], output, 'y', 'z')
public / ack.git / commitdiff