Friday, December 11, 2009

converting recursive to iterative computations

A recursive definition of length of a list is..
fun {Length Xs}
case Xs of nil then 0
[] _|Xr then 1+{Length Xr}
end
end
In general, to convert a recursive computation into iterative one we'll have to formulate the problem as a sequence of state transformations. That is, we start with a state S0 and transform it successively, giving S1, S2, ... untill we reach the final state S-final, which contains the answer.

To calculate the list length, we can take state as pair of (i, Ys) where i is the length of the list already seen and Ys is the part of the list not seen yet. We can put this state into the function argument and can rewrite iterative definition of length calculation as follow..
fun {IterLength I Ys}
case Ys
of nil then I
[] _|Yr then {IterLength I+1 Yr}
end
end

In general, we can prove correctness of any iterative computation by finding a state invariant property. That is, a property which remains same across state transformations.
In case of the Length example, state invariant property is the sum of i + Length(Ys).. this will always be equal to length of the original list.

Ref: Section 3.4.2.4 of CTM

Sunday, April 5, 2009

a pause....

Well It's been a fun-filled, enlightening journey reading this book. I've read it upto chapter 8 and that is the core of the book and about 70% of the total content. Before I go forward, I want to stop here for a while, take a step back and want to "really" learn what has been covered so far and will resume it once I'm comfortable enough with the concepts and techniques covered so far. So in order to use and intimately understand the techniques presented here I'm trying to get some hands on experience with lisp and posting stuff on my new tech blog here.

Sunday, March 22, 2009

Ch8, Ex13

Only method Trans inside TMClass is changed to following:
meth Trans(P ?R TS)
Halt={NewName}
T=trans(stamp:TS save:{NewDictionary} body:P
state:{NewCell running} result:R)
proc {ExcT C X Y} S1 S2 in
{proc {$}
{@tm getlock(T C S1)}
end}
if S1==halt then raise Halt end end
{@tm savestate(T C S2)} {Wait S2}
{Exchange C.state X Y}
end
proc {AccT C ?X} {ExcT C X X} end
proc {AssT C X} {ExcT C _ X} end
proc {AboT} {@tm abort(T)} R=abort raise Halt end end
SubThread %Change: New Addition
in
%Change here
thread {NewThread
proc {$}
try Res={T.body t(access:AccT assign:AssT
exchange:ExcT abort:AboT
subthread:SubThread)}
in {@tm commit(T)} R=commit(Res)
catch E then
if E\=Halt then {@tm abort(T)} R=abort(E) end
end end SubThread} end
end


If one needs to start another thread inside the transaction then it can use {T.subthread <0-argument-proc>} to do so.

Ch8, Ex12

Please don't pay attention to this solution as its far from complete and maybe wrong. Its here just for my record.
each cell now has two queues, readqueue and writequeue. And yet another queue of readowners.

Issue: What happens when a T that first requests a read lock on a cell and then a write lock some time later, if it puts all read lock threads on probation then it'll put itself on probation too i.e. it'll just keep on restarting all the time no matter what happens. And if it waits then its a deadlock as its waiting for itself to release the read lock. Solution is that it does put everyone else on probation except itself.

Some Use-Cases:

I. T1, T2 and T3 have read lock on cell C and T4 requests a write lock. If priority(T4)>Max(priotiry(T1),priority(T2),priority(T3)) then T4 waits in the write wait queue of C. Else T1, T2 and T3 are put on probation.

II. T1, T2 have a read lock on cell C and T1 requests a write lock on C. First T1 releases the read lock on C then case I is followed.

III. T1 has a write lock on C, T2 requests a read lock. if priority(T2)>priority(T1) then T1 is put on probation and T2 waits in the read wait queue.
declare
class TMClass
attr timestamp tm
meth init(TM) timestamp:=0 tm:=TM end
meth Unlockall(T RestoreFlag)
for X in {Dictionary.items T.save} do
case X of save(cell:C state:S) then
(C.owner):=unit
if RestoreFlag then (C.state):=S end
if {Not {C.queue.isEmpty}} then
Sync2#T2 = {C.queue.dequeue} in
case @(T2.state) of waiting_on(C) then
(T2.state):=running
(C.owner):=T2 Sync2=ok
[] waiting_read_on(C) then
(T2.state):=running
(C.owner):=T2 Sync2=ok
for Sync3#T3 in {C.queue.allItems} do
case @(T3.state) of waiting_on(C) then
skip
[] waiting_read_on(C) then
Sync3#T3={(C.queue).delete T3.stamp}
(T3.state):=running
Sync3=ok
end
end
end
end
[] save(cell:C) then
T = {(C.readOwners).delete T.stamp}
if {C.readOwners.isEmpty} then
if {Not {C.queue.isEmpty}} then
Sync2#T2 = {C.queue.dequeue} in
case @(T2.state) of waiting_on(C) then
(T2.state):=running
(C.owner):=T2 Sync2=ok
[] waiting_read_on(C) then
(T2.state):=running
(C.owner):=T2 Sync2=ok
for Sync3#T3 in {C.queue.allItems} do
case @(T3.state) of waiting_on(C) then
skip
[] waiting_read_on(C) then
Sync3#T3={(C.queue).delete T3.stamp}
(T3.state):=running
Sync3=ok
end
end
end
end
end
end
end
end
meth Trans(P ?R TS)
Halt={NewName}
T=trans(stamp:TS save:{NewDictionary} body:P
state:{NewCell running} result:R)
proc {ExcT C X Y} S1 S2 in
if {Not {Dictionary.member T.save C.name}} then
{@tm getWriteLock(T C S1)}
if S1==halt then raise Halt end end
{@tm savewritestate(T C S2)} {Wait S2}
else if (T.save).(C.name) == save(cell:C) then
{Dictionary.remove T.save C.name}
T={C.readOwners.delete T.stamp}
{@tm getWriteLock(T C S1)}
if S1==halt then raise Halt end end
{@tm savewritestate(T C S2)} {Wait S2}
end
end
{Exchange C.state X Y}
end
proc {AccT C ?X}
if {Not {Dictionary.member T.save C.name}} then S1 S2 in
{@tm getReadLock(T C S1)}
if S1==halt then raise Halt end end
{@tm savereadstate(T C S2)} {Wait S2}
end
{Exchange C.state X X}
end
proc {AssT C X} {ExcT C _ X} end
proc {AboT} {@tm abort(T)} R=abort raise Halt end end
in
thread try Res={T.body t(access:AccT assign:AssT
exchange:ExcT abort:AboT)}
in {@tm commit(T)} R=commit(Res)
catch E then
if E\=Halt then {@tm abort(T)} R=abort(E) end
end end
end
meth getReadLock(T C ?Sync)
if @(T.state)==probation then
{self Unlockall(T true)}
{self Trans(T.body T.result T.stamp)} Sync=halt
elseif @(C.owner)==unit then
{C.readOwners.enqueue T T.stamp}
Sync = ok
else T2 = @(C.owner) in
if T2.stamp==T.stamp then
%what if T itself has the write lock
%just let it proceed
Sync = ok
else
%Put T on read wait queue of C
{C.queue.enqueue Sync#T T.stamp}
(T.state):=waiting_read_on(C)
if T.stamp < T2.stamp then
%Correct the cases that follow
case @(T2.state) of waiting_on(C2) then
Sync2#_={C2.queue.delete T2.stamp} in
{self Unlockall(T2 true)}
{self Trans(T2.body T2.result T2.stamp)}
Sync2=halt
[] waiting_read_on(C2) then
Sync2#_={C2.queue.delete T2.stamp} in
{self Unlockall(T2 true)}
{self Trans(T2.body T2.result T2.stamp)}
Sync2=halt
[] running then
(T2.state):=probation
[] probation then skip end
end
end
end
end
%here we need to take care of the issue if a read and then a
%a write is requested by the same thread.
meth getWriteLock(T C ?Sync)
if @(T.state)==probation then
{self Unlockall(T true)}
{self Trans(T.body T.result T.stamp)} Sync=halt
elseif @(C.owner)==unit andthen
{(C.readOwners).isEmpty}==true then
(C.owner):=T Sync=ok
elseif @(C.owner)\=unit andthen
T.stamp==@(C.owner).stamp then
Sync=ok
elseif @(C.owner)\=unit then T2=@(C.owner) in
{C.queue.enqueue Sync#T T.stamp}
(T.state):=waiting_on(C)
if T.stamp<T2.stamp then
case @(T2.state) of waiting_on(C2) then
Sync2#_={C2.queue.delete T2.stamp} in
{self Unlockall(T2 true)}
{self Trans(T2.body T2.result T2.stamp)}
Sync2=halt
[] waiting_read_on(C2) then
Sync2#_={C2.queue.delete T2.stamp} in
{self Unlockall(T2 true)}
{self Trans(T2.body T2.result T2.stamp)}
Sync2=halt
[] running then
(T2.state):=probation
[] probation then skip end
end
else /* someone has readlock on C */ T2={(C.readOwners).dequeue} in
{C.readOwners.enqueue T2 T2.stamp}
{C.queue.enqueue Sync#T T.stamp}
(T.state):=waiting_on(C)
if T.stamp<T2.stamp then
for Ti in {(C.readOwners).allItems} do
if Ti.stamp == T.stamp then
{Dictionary.remove T.save C.name}
{C.readOwners.delete T.stamp}
else
case @(Ti.state) of waiting_on(C2) then
Sync2#_={C2.queue.delete Ti.stamp} in
{self Unlockall(Ti true)}
{self Trans(Ti.body Ti.result Ti.stamp)}
Sync2=halt
[] waiting_read_on(C2) then
Sync2#_={C2.queue.delete Ti.stamp} in
{self Unlockall(Ti true)}
{self Trans(Ti.body Ti.result Ti.stamp)}
Sync2=halt
[] running then
(Ti.state):=probation
[] probation then skip end
end
end
end
end
end
meth newtrans(P ?R)
timestamp:=@timestamp+1 {self Trans(P R @timestamp)}
end
meth savereadstate(T C ?Sync)
if {Not {Dictionary.member T.save C.name}} then
(T.save).(C.name):= save(cell:C)
end Sync=ok
end
meth savewritestate(T C ?Sync)
if {Not {Dictionary.member T.save C.name}} then
(T.save).(C.name):=save(cell:C state:@(C.state))
end Sync=ok
end
meth commit(T) {self Unlockall(T false)} end
meth abort(T) {self Unlockall(T true)} end
end
fun {NewActive Class Init}
Obj={New Class Init}
P
in
thread S in
{NewPort S P}
for M in S do {Obj M} end
end
proc {$ M} {Send P M} end
end
fun {NewPrioQueue}
Q={NewCell nil}
proc {Enqueue X Prio}
fun {InsertLoop L}
case L of pair(Y P)|L2 then
if Prio<P then pair(X Prio)|L
else pair(Y P)|{InsertLoop L2} end
[] nil then [pair(X Prio)] end
end
in Q:={InsertLoop @Q} end
fun {Dequeue}
pair(Y _)|L2=@Q
in
Q:=L2 Y
end
fun {Delete Prio}
fun {DeleteLoop L}
case L of pair(Y P)|L2 then
if P==Prio then X=Y L2
else pair(Y P)|{DeleteLoop L2} end
[] nil then nil end
end X
in
Q:={DeleteLoop @Q}
X
end
%CHANGED - NEW ADDITION
fun {AllElems}
proc {Iter L ?A}
case L of pair(Y P)|L2 then X in
A=Y|X
{Iter L2 X}
[] nil then
A = nil
end
end
in
{Iter @Q $}
end
fun {IsEmpty} @Q==nil end
in
queue(enqueue:Enqueue dequeue:Dequeue allItems:AllElems
delete:Delete isEmpty:IsEmpty)
end
proc {NewTrans ?Trans ?NewCellT}
TM={NewActive TMClass init(TM)} in
fun {Trans P ?B} R in
{TM newtrans(P R)}
case R of abort then B=abort unit
[] abort(Exc) then B=abort raise Exc end
[] commit(Res) then B=commit Res end
end
fun {NewCellT X}
%CHANGED HERE
cell(name:{NewName} owner:{NewCell unit}
queue:{NewPrioQueue} state:{NewCell X}
readOwners:{NewPrioQueue})
end
end

==============NEW VERSION=====================
Transaction can now be in following states:
running
probation
waiting_read_on#C
waiting_write_on#C

The dictionary at T.save now stores records like save(cell:C state:S locktype:LockT) where LockT is either read or write.

Instead of a single owner, a Cell can now have either one owner with the write lock(represented by write#T) or several owners with the read lock(represented by read#T1,read#T2 etc) on the cell. These owners are stored in a priority queue at C.owners.

declare
class TMClass
attr timestamp tm
meth init(TM) timestamp:=0 tm:=TM end
meth Unlockall(T RestoreFlag)
{Show 'entered unlockall'}
for save(cell:C state:S locktype:LockT) in {Dictionary.items T.save} do
LockT#T = {C.owners.delete T.stamp}
if RestoreFlag then (C.state) := S end
if {Not {C.queue.isEmpty}} andthen {C.owners.isEmpty} then
Sync#T0 = {C.queue.peek} in
if @(T0.state)==waiting_write_on#C then
{Show 'unlockall01'}
Sync#T0 = {C.queue.delete T0.stamp}
(T0.state):=running
{Show 'unlockall02'}
in
{Show 'unlockall2'}
{@tm getWriteLock(T0 C Sync)}
{Show 'unlockall3'}
else
for Synci#Ti in {C.queue.allItems} do
if @(Ti.state) == waiting_read_on#C then
Synci#Ti = {C.queue.delete Ti.stamp}
(Ti.state) := running
{C.owners.enqueue read#Ti Ti.stamp}
Synci = ok
end
end
end
end
end
{Show 'exited unlockall'}
end
meth Trans(P ?R TS)
Halt={NewName}
T=trans(stamp:TS save:{NewDictionary} body:P
state:{NewCell running} result:R)
proc {ExcT C X Y} S1 S2 in
{Show 'entered ExcT'}
if {Dictionary.member T.save C.name} andthen
((T.save).(C.name)).locktype==write then
skip
else
{Show 'ExcT1'}
{@tm getWriteLock(T C S1)}
{Show 'Ext01'}
{Wait S1}
{Show 'Ext001'}
if S1==halt then {Show 'Ext02'} raise Halt end end
{Show 'Ext03'}
{@tm savewritestate(T C S2)} {Wait S2}
{Show 'ExcT2'}
end
{Show 'ExcT3'}
{Exchange C.state X Y}
{Show 'exited ExcT'}
end
proc {AccT C ?X}
{Show 'entered AccT'}
if {Not {Dictionary.member T.save C.name}} then S1 S2 in
{@tm getReadLock(T C S1)}
if S1==halt then raise Halt end end
{@tm savereadstate(T C S2)} {Wait S2}
end
{Show 'AccT2'}
{Exchange C.state X X}
{Show 'exited AccT'}
end
proc {AssT C X} {ExcT C _ X} end
proc {AboT} {@tm abort(T)} R=abort raise Halt end end
in
thread try Res={T.body t(access:AccT assign:AssT
exchange:ExcT abort:AboT)}
in {@tm commit(T)} R=commit(Res)
catch E then
if E\=Halt then {@tm abort(T)} R=abort(E) end
end end
end
meth getReadLock(T C ?Sync)
{Show 'entered getReadLock'}
if @(T.state)==probation then
{self Unlockall(T true)}
{self Trans(T.body T.result T.stamp)} Sync=halt
elseif {C.owners.isEmpty} then
{C.owners.enqueue read#T T.stamp} Sync=ok
else LockT#T2={C.owners.peek} in
if LockT==read then
{C.owners.enqueue read#T T.stamp} Sync=ok
elseif LockT==write then
if T.stamp==T2.stamp then Sync=ok
else
{C.queue.enqueue Sync#T T.stamp}
(T.state) := waiting_read_on#C
if T.stamp<T2.stamp then
case @(T2.state) of
running then
(T2.state) := probation
[] probation then skip
[] WaitT#C2 then
Sync2#_={C2.queue.delete T2.stamp} in
{self Unlockall(T2 true)}
{self Trans(T2.body T2.result T2.stamp)}
Sync2=halt
end
end
end
end
end
{Show 'exited getReadLock'}
end
meth getWriteLock(T C ?Sync)
{Show 'entered getWriteLock'}
if @(T.state)==probation then
{self Unlockall(T true)}
{self Trans(T.body T.result T.stamp)} Sync=halt
elseif {C.owners.isEmpty} then
{C.owners.enqueue write#T T.stamp} Sync=ok
else LockT#T2 = {C.owners.peek} in
if T.stamp==T2.stamp andthen LockT==write then
Sync = ok
elseif T.stamp==T2.stamp andthen LockT==read then
LockT#T2 = {C.owners.delete T2.stamp}
{Dictionary.remove T.save C.name}
{@tm getWriteLock(T C Sync)}
else
{C.queue.enqueue Sync#T T.stamp}
(T.state) := waiting_write_on#C
if T.stamp<T2.stamp then
%This is WRONG as we're not really emptying the
%owner queue and putting such condition.
{While
fun {$} {Not {C.owners.isEmpty}} end
proc {$}
_#Ti = {C.owners.dequeue}
in
{Show 'entered case'}
{Show state#Ti}
case @(Ti.state) of
running then
(Ti.state) := probation
[] probation then skip
[] WaitT#C2 then
Sync2#_={C2.queue.delete Ti.stamp} in
{self Unlockall(Ti true)}
{self Trans(Ti.body Ti.result Ti.stamp)}
Sync2=halt
end
{Show 'exited case'}
end}
end
end
end
{Show 'exited getWriteLock'}
end
meth newtrans(P ?R)
timestamp:=@timestamp+1 {self Trans(P R @timestamp)}
end
meth savereadstate(T C ?Sync)
if {Not {Dictionary.member T.save C.name}} then
(T.save).(C.name):= save(cell:C state:@(C.state) locktype:read)
end Sync=ok
end
meth savewritestate(T C ?Sync)
(T.save).(C.name):=save(cell:C state:@(C.state) locktype:write)
Sync = ok
end
meth commit(T) {self Unlockall(T false)} end
meth abort(T) {self Unlockall(T true)} end
end
fun {NewActive Class Init}
Obj={New Class Init}
P
in
thread S in
{NewPort S P}
for M in S do {Obj M} end
end
proc {$ M} {Send P M} end
end
fun {NewPrioQueue}
Q={NewCell nil}
proc {Enqueue X Prio}
fun {InsertLoop L}
case L of pair(Y P)|L2 then
if Prio<P then pair(X Prio)|L
else pair(Y P)|{InsertLoop L2} end
[] nil then [pair(X Prio)] end
end
in Q:={InsertLoop @Q} end
fun {Dequeue}
pair(Y _)|L2=@Q
in
Q:=L2 Y
end
fun {Delete Prio}
fun {DeleteLoop L}
case L of pair(Y P)|L2 then
if P==Prio then X=Y L2
else pair(Y P)|{DeleteLoop L2} end
[] nil then nil end
end X
in
{Show 'deleteentered'}
Q:={DeleteLoop @Q}
{Show 'deleteexited'#X}
X
end
%CHANGED - NEW ADDITION
fun {AllElems}
proc {Iter L ?A}
case L of pair(Y P)|L2 then X in
A=Y|X
{Iter L2 X}
[] nil then
A = nil
end
end
in
{Iter @Q $}
end
fun {Peek}
pair(Y _)|L2=@Q
in
Y
end
fun {IsEmpty} @Q==nil end
in
queue(enqueue:Enqueue dequeue:Dequeue allItems:AllElems
peek:Peek delete:Delete isEmpty:IsEmpty)
end
proc {NewTrans ?Trans ?NewCellT}
TM={NewActive TMClass init(TM)} in
fun {Trans P ?B} R in
{TM newtrans(P R)}
case R of abort then B=abort unit
[] abort(Exc) then B=abort raise Exc end
[] commit(Res) then B=commit Res end
end
fun {NewCellT X}
%CHANGED HERE
cell(name:{NewName} owners:{NewPrioQueue}
queue:{NewPrioQueue} state:{NewCell X})
end
end

=================code to run sum example==============
declare S D Rand Mix Sum Trans NewCellT
{NewTrans Trans NewCellT}
D={MakeTuple db 100}
for I in 1..100 do D.I={NewCellT I} end
fun {Rand} {OS.rand} mod 100 + 1 end
proc {Mix} {Trans
proc {$ T _}
I={Rand} J={Rand} K={Rand}
{Show I#J#K}
A={T.access D.I} B={T.access D.J} C={T.access D.K}
{Show mix1}
in
{Show mix2}
{T.assign D.I A+B-C}
{Show mix3}
{T.assign D.J A-B+C}
{Show mix4}
if I==J orelse I==K orelse J==K then {T.abort} end
{Show mix5}
{T.assign D.K ~A+B+C}
{Show mix6}
end _ _}
end
S={NewCellT 0}
fun {Sum}
{Trans
fun {$ T} {T.assign S 0}
for I in 1..100 do
{T.assign S {T.access S}+{T.access D.I}} end
{T.access S}
end _}
end

{Browse {Sum}} % Displays 5050
for I in 1..1000 do thread {Mix} end end
{Browse {Sum}} % Still displays 5050

Ch8, Ex11

Only definition of method Trans(inside class TMClass) needs to be modified. I've changed ExcT to check whether T already has a lock on the cell in question before doing getlock.
meth Trans(P ?R TS)
Halt={NewName}
T=trans(stamp:TS save:{NewDictionary} body:P
state:{NewCell running} result:R)
proc {ExcT C X Y}
if {Not {Dictionary.member T.save C.name}}
then S1 S2 in
{@tm getlock(T C S1)}
if S1==halt then raise Halt end end
{@tm savestate(T C S2)} {Wait S2}
end
{Exchange C.state X Y}
end
proc {AccT C ?X}
{ExcT C X X}
end
proc {AssT C X}
{ExcT C _ X}
end
proc {AboT} {@tm abort(T)} R=abort raise Halt end end
in
thread try Res={T.body t(access:AccT assign:AssT
exchange:ExcT abort:AboT)}
in {@tm commit(T)} R=commit(Res)
catch E then
if E\=Halt then {@tm abort(T)} R=abort(E) end
end end
end

Ch8, Ex10

The reason that sum is locking all the cells is that its calculating the whole sum in one big transaction and in the growing phase of this transaction it locks all the cells and keep them all locked unless whole sum is calculated. So, the strategy is to simply break the calculation of full sum into partial sums. Here is the code..
declare Sum S={NewCellT 0}
fun {Sum}
{Trans proc {$ T _} {T.assign S 0} end _ _}
for J in 0..80;20 do
{Trans
proc {$ T _}
for I in J+1..J+20 do
{T.assign S {T.access S}+{T.access D.I}} end
end _ _}
end
{Trans fun {$ T} {T.access S} end _}
end

transaction impl code from the book

This is needed to run various solutions.
declare
class TMClass
attr timestamp tm
meth init(TM) timestamp:=0 tm:=TM end
meth Unlockall(T RestoreFlag)
for save(cell:C state:S) in {Dictionary.items T.save} do
(C.owner):=unit
if RestoreFlag then (C.state):=S end
if {Not {C.queue.isEmpty}} then
Sync2#T2={C.queue.dequeue} in
(T2.state):=running
(C.owner):=T2 Sync2=ok
end
end
end
meth Trans(P ?R TS)
Halt={NewName}
T=trans(stamp:TS save:{NewDictionary} body:P
state:{NewCell running} result:R)
proc {ExcT C X Y} S1 S2 in
{@tm getlock(T C S1)}
if S1==halt then raise Halt end end
{@tm savestate(T C S2)} {Wait S2}
{Exchange C.state X Y}
end
proc {AccT C ?X} {ExcT C X X} end
proc {AssT C X} {ExcT C _ X} end
proc {AboT} {@tm abort(T)} R=abort raise Halt end end
in
thread try Res={T.body t(access:AccT assign:AssT
exchange:ExcT abort:AboT)}
in {@tm commit(T)} R=commit(Res)
catch E then
if E\=Halt then {@tm abort(T)} R=abort(E) end
end end
end
meth getlock(T C ?Sync)
if @(T.state)==probation then
{self Unlockall(T true)}
{self Trans(T.body T.result T.stamp)} Sync=halt
elseif @(C.owner)==unit then
(C.owner):=T Sync=ok
elseif T.stamp==@(C.owner).stamp then
Sync=ok
else /* T.stamp\=@(C.owner).stamp */ T2=@(C.owner) in
{C.queue.enqueue Sync#T T.stamp}
(T.state):=waiting_on(C)
if T.stamp<T2.stamp then
case @(T2.state) of waiting_on(C2) then
Sync2#_={C2.queue.delete T2.stamp} in
{self Unlockall(T2 true)}
{self Trans(T2.body T2.result T2.stamp)}
Sync2=halt
[] running then
(T2.state):=probation
[] probation then skip end
end
end
end
meth newtrans(P ?R)
timestamp:=@timestamp+1 {self Trans(P R @timestamp)}
end
meth savestate(T C ?Sync)
if {Not {Dictionary.member T.save C.name}} then
(T.save).(C.name):=save(cell:C state:@(C.state))
end Sync=ok
end
meth commit(T) {self Unlockall(T false)} end
meth abort(T) {self Unlockall(T true)} end
end
fun {NewActive Class Init}
Obj={New Class Init}
P
in
thread S in
{NewPort S P}
for M in S do {Obj M} end
end
proc {$ M} {Send P M} end
end
fun {NewPrioQueue}
Q={NewCell nil}
proc {Enqueue X Prio}
fun {InsertLoop L}
case L of pair(Y P)|L2 then
if Prio<P then pair(X Prio)|L
else pair(Y P)|{InsertLoop L2} end
[] nil then [pair(X Prio)] end
end
in Q:={InsertLoop @Q} end
fun {Dequeue}
pair(Y _)|L2=@Q
in
Q:=L2 Y
end
fun {Delete Prio}
fun {DeleteLoop L}
case L of pair(Y P)|L2 then
if P==Prio then X=Y L2
else pair(Y P)|{DeleteLoop L2} end
[] nil then nil end
end X
in
Q:={DeleteLoop @Q}
X
end
fun {IsEmpty} @Q==nil end
in
queue(enqueue:Enqueue dequeue:Dequeue
delete:Delete isEmpty:IsEmpty)
end
proc {NewTrans ?Trans ?NewCellT}
TM={NewActive TMClass init(TM)} in
fun {Trans P ?B} R in
{TM newtrans(P R)}
case R of abort then B=abort unit
[] abort(Exc) then B=abort raise Exc end
[] commit(Res) then B=commit Res end
end
fun {NewCellT X}
cell(name:{NewName} owner:{NewCell unit}
queue:{NewPrioQueue} state:{NewCell X})
end
end

Ch8, Ex9

The new monitor supports only two operations, lock and newcondition. lock is same and newcondition gives a new condition variable which supports two operations wait and notify.

I. Buffer reimplementation
class Buffer
attr m buf first last n i nonempty nonfull
meth init(N)
m:={NewMonitor}
buf:={NewArray 0 N-1 null}
n:=N i:=0 first:=0 last:=0
nonempty := @m.newcondition
nonfull := @m.newcondition
end
meth put(X)
{@m.'lock' proc {$}
if @i>=@n then
{@nonfull.wait}
{self put(X)}
else
@buf.@last:=X
last:=(@last+1) mod @n
i:=@i+1
{@nonempty.notify}
end
end}
end
meth get(X)
{@m.'lock' proc {$}
if @i==0 then
{@nonempty.wait}
{self get(X)}
else
X=@buf.@first
first:=(@first+1) mod @n
i:=@i-1
{@nonfull.notify}
end
end}
end
end

II. Monitor Reimplementation
fun {NewMonitor}
L={NewGRLock}
proc {LockM P}
{L.get} try {P} finally {L.release} end
end
fun {NewCondition}
Q={NewQueue}
proc {WaitM}
X in
{Q.insert X} {L.release} {Wait X} {L.get}
end
proc {NotifyM}
U={Q.deleteNonBlock} in
case U of [X] then X=unit else skip end
end
in
c(wait:WaitM notify:NotifyM)
end
in
monitor('lock':LockM newcondition:NewCondition)
end

Ch8, Ex8

declare NewThread
local
M = {NewMonitor}
C = {NewCell 0}
proc {ExitOnTermination}
if {Not (@C==0)} then
{M.'lock' proc {$}
{M.wait}
{M.notifyAll}
end}
end
end
in
proc {NewThread P ?SubThread}
Is Pt={NewPort Is}
in
proc {SubThread P}
X Y in
{Exchange C X Y}
Y = X+1
thread {M.'lock'
proc {$} X Y in {P}
C:=@C-1
{M.notifyAll} end}
end
end
{SubThread P}
{ExitOnTermination}
end
end

%Test
local SubThread in
{NewThread
proc {$} {Browse started1}
{SubThread proc {$} {Delay 5000} {Browse f2} end}
{Browse finished1}
end
SubThread}
{Browse done}
end

%Complete Monitor impl code from book
%copying here as its needed to run
%the above solution
declare
fun {NewQueue}
X C={NewCell q(0 X X)} L={NewLock}
proc {Insert X}
N S E1 N1 in
{Exchange C q(N S X|E1) q(N1 S E1)}
N1=N+1
end
fun {Delete}
N S1 E N1 X in
{Exchange C q(N X|S1 E) q(N1 S1 E)}
N1=N-1
X
end
fun {Size}
lock L then @C.1 end
end
fun {DeleteAll}
lock L then
X q(_ S E)=@C in
C:=q(0 X X)
E=nil S
end
end
fun {DeleteNonBlock}
lock L then
if {Size}>0 then [{Delete}] else nil end
end
end
in
queue(insert:Insert delete:Delete size:Size
deleteAll:DeleteAll deleteNonBlock:DeleteNonBlock)
end
fun {NewGRLock}
Token1={NewCell unit}
Token2={NewCell unit}
CurThr={NewCell unit}
proc {GetLock}
if {Thread.this}\=@CurThr then Old New in
{Exchange Token1 Old New}
{Wait Old}
Token2:=New
CurThr:={Thread.this}
end
end
proc {ReleaseLock}
CurThr:=unit
unit=@Token2
end
in
'lock'(get:GetLock release:ReleaseLock)
end
fun {NewMonitor}
Q={NewQueue}
L={NewGRLock}
proc {LockM P}
{L.get} try {P} finally {L.release} end
end
proc {WaitM}
X in
{Q.insert X} {L.release} {Wait X} {L.get}
end
proc {NotifyM}
U={Q.deleteNonBlock} in
case U of [X] then X=unit else skip end
end
proc {NotifyAllM}
L={Q.deleteAll} in
for X in L do X=unit end
end
in
monitor('lock':LockM wait:WaitM notify:NotifyM
notifyAll:NotifyAllM)
end

Ch8, Ex7 (todo)

tbd (haven't followed erlang section yet)

Ch8, Ex6

declare Channel
local
proc {MySend C M}
X in
{Send C.send send(M#X)}
{Wait X}
end
fun {Receive C}
M in
{Send C.receive receive(M)}
{Wait M}
M
end
proc {MReceive Cs}
%see later for MReceive definition
skip
end
fun {New}
P1 P2 S1 S2
{NewPort S1 P1} %for receive msgs
{NewPort S2 P2} %for send msgs
proc {Iter S1 S2}
case S1#S2 of (receive(R)|S1s)#(send(X#Y)|S2s)
then
R=X
Y = unit
{Iter S1s S2s}
end
end
in
thread {Iter S1 S2} end
channel(receive:P1 send:P2)
end
in
Channel = c(new:New send:MySend
receive:Receive
mreceive:MReceive)
end
From the book its not clear what mreceive is actually supposed to do, following are my various interpretations

mreceive version#1
In this version mreceive starts listeners for all the channels and exits immediately. All the Si will be called as and when messages are received on respective channels.
proc {MReceive Cs}
for Ci#Si in Cs do
thread
{Si {Channel.receive Ci}}
end
end
end

mreceive version#2
In this version mreceive starts listeners for all the channels and waits untill messages are received on all the channels and all corresponding Si are executed.
proc {MReceive Cs}
Exit Count = {NewCell 0} in
for Ci#Si in Cs do
thread
{Si {Channel.receive Ci}}
Count := 1+@Count
if @Count == {List.length Cs} then Exit=unit end
end
end
{Wait Exit}
end

mreceive version#3
In this version mreceive starts listeners for all the channels and waits. As soon as a message is received any of the channels, corresponding Si is executed and mreceive exits. In this case only one Si is executed on whose channel a message is received first.
proc {MReceive Cs}
Exit A = {NewCell 0} in
for Ci#Si in Cs do
thread
local M in
M = {Channel.receive Ci}
if @A==0 then
{Exchange A _ 1}
{Si M}
Exit = unit
end
end
end
end
{Wait Exit}
end

NOTE: I could not understand what exactly does the extended version of mreceive is supposed to do.

TESTS
%This test proves that receive operation blocks
%until there is a send
local C in
{Browse started}
C = {Channel.new}
thread {Browse rec1#{Channel.receive C}} end
thread {Browse rec2#{Channel.receive C}} end
thread {Browse rec3#{Channel.receive C}} end

{Delay 5000}
{Channel.send C msg1}
{Delay 5000}
{Channel.send C msg2}
{Delay 5000}
{Channel.send C msg3}

end

%This test proves that send operation blocks
%until there is a receive
local C in
{Browse started}
C = {Channel.new}
thread {Channel.send C msg1} {Browse send1done} end
thread {Channel.send C msg2} {Browse send2done} end
thread {Channel.send C msg3} {Browse send3done} end

{Delay 5000}
{Browse {Channel.receive C}}
{Delay 5000}
{Browse {Channel.receive C}}
{Delay 5000}
{Browse {Channel.receive C}}
end

Ch8, Ex5

declare
fun {NewMVar}
P1 P2 Si1 Si2
{NewPort Si1 P1} %put msgs received on P1
{NewPort Si2 P2} %get msgs received on P2
%Put puts the content in C if box is empty or waits
C = {NewCell _}
%content of D is either empty or unbound variable
%signifying empty or full box respectivaly
D = {NewCell empty}
proc {PutIter Xs}
case Xs of (Sync#X)|Xr then
{Wait @D}
@C = X
Sync = ok
D := _
{PutIter Xr}
end
end
proc {GetIter Xs}
case Xs of (Sync#X)|Xr then
{Wait @C}
X = @C
Sync = ok
C := _
@D = empty
{GetIter Xr}
end
end
proc {Put X}
Sync in
{Send P1 Sync#X}
{Wait Sync}
end
proc {Get ?X}
Sync in
{Send P2 Sync#X}
{Wait Sync}
end
in
thread {PutIter Si1} end
thread {GetIter Si2} end
mvar(put:Put get:Get)
end

Ch8, Ex4

A very naive version
declare
fun {SlowNet3 Obj Time}
D = {NewDictionary}
proc {RemoveTerminatedThreads L}
case L of X|Xr then
if {Thread.state X}==terminated
then {D.remove X} end
[] nil then skip
end
end
in
proc {$ M}
Old New T = {Thread.this} in
{RemoveTerminatedThreads {D.keys}}
if {Not {D.member T}} then
{D.put T {NewCell unit}}
end
{Exchange {D.get T} Old New}
thread
{Delay Time}
{Wait Old}
{Obj M}
New=unit
end
end
end
Note: We can't use the oz dictionary as it doesn't allow us to put result of {Thread.this} as key into it. Instead, the dictionary implementation done for Chapter-6, Ex-13 at http://ctamcp-himanshu.blogspot.com/2009/02/ch6-ex13.html is to be used.

Ch8, Ex3 (todo)

tbd

Tuesday, February 17, 2009

Ch8, Ex2

I.Well, have a look at the kernel transform of the given program
local X in
local Y in
Y = X+1
{Exchange C X Y}
end
end

Now its clear to see that X is unbound and above program will keep on waiting for X to bind(that'll never happen) at line Y=X+1 and will never execute Exchange. Here is the program with a simple fix:
L = {NewLock}
lock L then X Y in
{Exchange C X Y}
Y = X+1
end

II. The simple fix that I have given above will not work in a language that doesn't have dataflow variables because it is *using* dataflow behavior of variable Y to work.

III. Another fix that doesn't use dataflow variables and hence, is possible in a language without dataflow variables:
L = {NewLock}
lock L then
C:=@C+1
end

Ch8, Ex1

Possible number of interleaving for n threads with k operations each:

(nk)! / (k!)^n

n^(nk + 1/2)
= -----------------
(2k.PI)^(n-1)/2

Ch7, Ex8 (todo)

todo

Ch7, Ex7 (tbd)

todo

Ch7, Ex6

Sequential stateful without short circuiting:
An array N elements is created, all initialized to true. We start iterating over the array from index one, keep on setting values to false whenever (Count mod K) is 0. We keep track of number of survivors also and as soon as it reaches 1, we return the closest array index which is still true( or alive). As we never remove elements from array (no short circuiting).
declare
fun {Josephus N K}
A = {NewArray 1 N true}
fun {NextI I} (I mod N)+1 end
fun {Iter N C I}
if N==1 andthen {Array.get A I}==true then I
elseif N==1 then {Iter N C {NextI I}}
elseif {Array.get A I}==true andthen (C mod K)==0 then
{Array.put A I false}
{Iter N-1 C+1 {NextI I}}
elseif {Array.get A I}==true then
{Iter N C+1 {NextI I}}
else {Iter N C {NextI I}}
end
end
in
{Iter N 1 1}
end

Sequential stateful with short circuiting:
The only difference here is that, we use a dictionary instead of array and remove(rather than setting value to false) whenever (Count mod K) is 0. Structurally both these programs are the same.
declare
fun {Josephus N K}
D = {NewDictionary}
for I in 1..N do D.I:=t end
fun {NextI I} (I mod N)+1 end
fun {Iter N C I}
if N==1 andthen {Dictionary.condGet D I f}==t then I
elseif N==1 then {Iter N C {NextI I}}
elseif {Dictionary.condGet D I f}==t
andthen (C mod K)==0 then
{Dictionary.remove D I}
{Iter N-1 C+1 {NextI I}}
elseif {Dictionary.condGet D I f}==t then
{Iter N C+1 {NextI I}}
else {Iter N C {NextI I}}
end
end
in
{Iter N 1 1}
end

Structure of Active object based version from the book:
Here we basically create a doubly linked list of Victim active objects and pass the kill(I) token. Every Vicim on the list passes the token to next object in the list(and also is removed if I mod K is 0). This way the token keeps on circulating untill there is just one item(survivor) remaining in the list.

Apart from the models used, The main differences between the above versions and those there in the book, are in the code size and the iteration. In above versions iterations is done explicitly while in the versions from the book iteration is implicit due to the message passing technique.

b) I'm passing the analysis of finding the (n,k) region for which short circuiting is helpful because It's easy to understand by logic only. Larger the N and smaller the K(but greater than 1 or else there won't be second iteration and hence no use of shortcircuiting), more is the advantage of short circuiting as less number of items are to be traversed in subsequenct iterations one after another. If short circuiting was not there then we have to traverse all N items in all the iterations no matter how many of them are alive.
However, in above two versions the version with short circuiting is actually slower but that is because Dictionary operations are much more expensive than Array operations and that shadows the advantage bought by short circuiting.

I used following code to find about the timings of the three versions.
for N in 1000..1050 do
for K in 100..110 do T1 T2 R in
T1 = {Property.get 'time.total'}
R = {Josephus N K}
{Wait R}
T2 = {Property.get 'time.total'}
{Show josephus(n:N k:K result:R timeTaken:(T2-T1))}
end
end

The version that uses OO model was hovering around 130ms, declarative concurrent version(fastest) was hovering aroung 70ms and declarative sequential model(slowest) was taking around 210ms. Declarative sequential model is slow because of the Dictionary operations as they're expensive.

Asymptotically all three versions have the same time complexity as they're effectively doing the same thing which is to keep on following the list(killing the unfortunates on the way and removing them from the list) circularly unless there is only one survivor left. Note: The word list is used in a very loose sense, its not the list type of oz.

=========================================================================
A declarative sequential solution to josephus problem...While reading the book I wrote this one(nothing fancy).We start with a list [1..N], keep on iterating over it in circular fashion and keep on removing every Kth item untill there is just one element left and that last element is the survivor.
declare Josephus
local
%Generates list [1 2 3..N]
%Usage: {GenerateList N nil}
fun {GenerateList N A}
if N>0 then {GenerateList N-1 N|A}
else A end
end
in
fun {Josephus N K}
% N: number of survivors
% C: count
% Xs: Active list of survivors
% Ys: ongoing list of survivors from Xs
fun {Iter N C Xs Ys}
if N==1 then Xs.1
else
case Xs of X|nil andthen (C mod K)==0 then
{Iter N-1 C+1 {Reverse Ys} nil}
[] X|nil then
{Iter N C+1 {Reverse X|Ys} nil}
[] X|Xr andthen (C mod K)==0 then
{Iter N-1 C+1 Xr Ys}
[] X|Xr then
{Iter N C+1 Xr X|Ys}
end
end
end
in
{Iter N 1 {GenerateList N nil} nil}
end
end

Ch7, Ex5

I- Synchronous RMI
declare
class ServerProc
meth init
skip
end
meth send(Msg)
case Msg of calc(X Y) then
Y=X*X+2.0*X+2.0
end
end
end
Server = {NewActive ServerProc init}

declare
class ClientProc
meth init
skip
end
meth send(Msg)
case Msg
of work(Y) then
Y1 Y2 in
{Server send(calc(10.0 Y1))}
{Wait Y1}
{Server send(calc(20.0 Y2))}
{Wait Y2}
Y=Y1+Y2
end
end
end
Client = {NewActive ClientProc init}

{Browse {Client send(work($))}}

II- Asynchronous RMI
Only ClientProc is changed, everything else remains same as the synchronous RMI.
declare
class ClientProc
meth init
skip
end
meth send(Msg)
case Msg
of work(Y) then
Y1 Y2 in
{Server send(calc(10.0 Y1))}
{Server send(calc(20.0 Y2))}
Y=Y1+Y2
end
end
end

III- RMI with callback(with thread)
declare
class ServerProc
meth init
skip
end
meth send(Msg)
%{Browse server#Msg}
case Msg
of calc(X Y Client) then
X1 D in
{Client send(delta(D))}
X1=X+D
Y=X1*X1+2.0*X1+2.0
end
end
end
Server = {NewActive ServerProc init}

declare
class ClientProc
meth init
skip
end
meth send(Msg)
%{Browse client#Msg}
case Msg
of work(Z) then
Y in
{Server send(calc(10.0 Y self))}
%here we don't need to create another
%thread as we're passing self and not
%Client
Z=Y+100.0
[] delta(D) then
D=1.0
end
end
end
Client = {NewActive ClientProc init}

{Browse {Client send(work($))}}

IV- RMI with callback (using record continuation)
declare
class ServerProc
meth init
skip
end
meth send(Msg)
%{Browse server#Msg}
case Msg
of calc(X Client Cont) then
X1 D Y in
{Client send(delta(D))}
X1=X+D
Y=X1*X1+2.0*X1+2.0
{Client send(Cont#Y)}
end
end
end
Server = {NewActive ServerProc init}

declare
class ClientProc
meth init
skip
end
meth send(Msg)
%{Browse client#Msg}
case Msg
of work(?Z) then
{Server send(calc(10.0 self cont(Z)))}
[] cont(Z)#Y then
Z=Y+100.0
[] delta(?D) then
D=1.0
end
end
end
Client = {NewActive ClientProc init}

{Browse {Client send(work($))}}

V- RMI with callback (using procedure continuation)
Only ClientProc is changed, everything else remains same as the record continuation technique
class ClientProc
meth init
skip
end
meth send(Msg)
%{Browse client#Msg}
case Msg
of work(?Z) then
C = proc {$ Y} Z=Y+100.0 end
in
{Server send(calc(10.0 self cont(C)))}
[] cont(C)#Y then
{C Y}
[] delta(?D) then
D=1.0
end
end
end

VI- Error Reporting
class ServerProc
meth init
skip
end
meth send(Msg)
case Msg
of sqrt(X Y E) then
try
Y={Sqrt X}
E=normal
catch Exc then
E=exception(Exc)
end
end
end
end
Server = {NewActive ServerProc init}

%It can be used as
{Server send(sqrt X Y E)}
case E of exception(Exc) then
raise Exc end end

VII- Asynchronous RMI with callback
declare
class ServerProc
meth init
skip
end
meth send(Msg)
case Msg
of calc(X ?Y Client) then
X1 D in
{Client send(delta(D))}
thread
X1=X+D
Y=X1*X1+2.0*X1+2.0
end
end
end
end
Server = {NewActive ServerProc init}

declare
class ClientProc
meth init
skip
end
meth send(Msg)
case Msg
of work(?Y) then
Y1 Y2 in
{Server send(calc(10.0 Y1 self))}
{Server send(calc(20.0 Y2 self))}
thread Y=Y1+Y2 end
[] delta(?D) then
D=1.0
end
end
end
Client = {NewActive ClientProc init}

{Browse {Client send(work($))}}

VIII-Double Callbacks
declare
class ServerProc
meth init
skip
end
meth send(Msg)
case Msg
of calc(X ?Y Client) then
X1 D in
{Client send(delta(D))}
thread
X1=X+D
Y=X1*X1+2.0*X1+2.0
end
[] serverdelta(?S) then
S=0.01
end
end
end
Server = {NewActive ServerProc init}

declare
class ClientProc
meth init
skip
end
meth send(Msg)
case Msg
of work(Z) then
Y in
{Server send(calc(10.0 Y self))}
thread Z=Y+100.0 end
[] delta(?D) then S in
{Server send(serverdelta(S))}
thread D=1.0+S end
end
end
end
Client = {NewActive ClientProc init}

{Browse {Client send(work($))}}

Ch7, Ex4

To allow multiple inheritance(for 1 or more), I have just generalized the "From" function from the book. Instead of taking fixed number of classes to be inherited it now takes a list of classes to be inherited.
I'm redoing the Account, LoggedAccount example from section 7.3.2 to show how to achieve static binding with the object system of section 7.6 . However, It doesn't look very clean solution... will change it once I can think something else.
For better understanding, Please read the code below along with the embedded comments.

%Helpers-----------------------------------------------------
declare NewWrapper Wrap Unwrap Union Inter Minus LogObj

LogObj = {New class $
attr entries
meth init
entries:=nil
end
meth addEntry(X)
entries:=X|(@entries)
end
meth getEntries(?X)
X={List.reverse @entries}
end
meth clear
entries:=nil
end
end
init}

proc {NewWrapper ?W ?U}
Key={NewName}
in
fun {W X}
fun {$ K} if K==Key then X end end
end
fun {U Y}
{Y Key}
end
end

{NewWrapper Wrap Unwrap}

%Download Set.oz from book's suppliment site then
%create ozc file by running following command
%$ozc -c Set.oz
%CHANGE PATH
declare
[Set]= {Module.link ['/path/Set.ozf']}
Union=Set.union
Inter=Set.inter
Minus=Set.minus

declare New2
fun {New2 WClass InitialMethod}
State Obj Class
in
Class={Unwrap WClass}
State = {MakeRecord s Class.attrs}
{Record.forAll State proc {$ A} {NewCell _ A} end}
proc {Obj M}
{Class.methods.{Label M} M State Obj}
end
{Obj InitialMethod}
Obj
end
%Helpers finished-------------------------------------------------

%New From to allow multiple inheritence,
%Returns new class record whose base defn
%is BaseC and inherits all classes in
%list Classes
declare
fun {From BaseC Classes}
c(methods:M attrs:A) = {Unwrap BaseC}
ParentMeths = {Map Classes
fun {$ X}
c(methods:M attrs:_)={Unwrap X}
in M
end}
ParentMethArities = {Map ParentMeths
fun {$ M} {Arity M} end}
ParentAttrs = {Map Classes
fun {$ X}
c(methods:_ attrs:A)={Unwrap X}
in A
end}
ConfMeth=if {List.length Classes}>1 then
{Minus {FoldL ParentMethArities
fun {$ MA1 MA2} {Inter MA1 MA2} end
ParentMeths.1} {Arity M}}
else
nil end
ConfAttr=if {List.length Classes}>1 then
{Minus {FoldL ParentAttrs
fun {$ A1 A2} {Inter A1 A2} end
ParentAttrs.1} A}
else
nil end
in
if ConfMeth\=nil then
raise illegalInheritance(methConf:ConfMeth) end
end
if ConfAttr\=nil then
raise illegalInheritance(attrConf:ConfAttr) end
end
{Wrap c(methods:{Adjoin {FoldL ParentMeths
fun {$ M1 M2}
{Adjoin M1 M2}end
nil} M}
attrs:{Union {FoldL ParentAttrs
fun {$ A1 A2}
{Union A1 A2} end
nil} A})}
end

%Account,LoggedAccount example
declare Account
local
Attrs = [balance]
MethodTable = m(init:Init
transfer:Transfer
getBal:GetBal
batchTransfer:BatchTransfer)
proc {Init M S Self}
init(Bal) = M
in
(S.balance):=Bal
end

proc {Transfer M S Self}
transfer(Amt) = M
in
(S.balance):=Amt+@(S.balance)
end

proc {GetBal M S Self}
getBal(Bal) = M
in
Bal = @(S.balance)
end

proc {BatchTransfer M S Self}
batchTransfer(AmtList) = M
in
for A in AmtList do
{Self transfer(A)} end
end
in
Account = {Wrap c(methods:MethodTable attrs:Attrs)}
end

% LoggedAccount inherits Account
declare LoggedAccountBase
local
Attrs = nil
MethodTable = m(transfer:Transfer)
proc {Transfer M S Self}
{LogObj addEntry(M)}
%----------Static Binding----------
%its fair to know about the superclasses at
%the time of defining the subclass
{{Unwrap Account}.methods.transfer M S Self}
end
in
LoggedAccountBase = {Wrap c(methods:MethodTable
attrs:Attrs)}
end

%Test
local
LoggedAccClass
LoggedAccObj
in
{LogObj clear}
LoggedAccClass = {From LoggedAccountBase [Account]}
LoggedAccObj = {New2 LoggedAccClass init(0)}
{LoggedAccObj transfer(100)}
{LoggedAccObj transfer(200)}
{LoggedAccObj transfer(300)}
%This prints the above transactions that means the
%Transfer code from LoggedAccount is executed
{Browse {LogObj getEntries($)}}
%This prints the balance=600(100+200+300) that means
%static binding worked and Transfer code from Account
%was executed.
{Browse {LoggedAccObj getBal($)}}
end

Ch7, Ex3

declare
fun {TraceNew2 Class Init}
TInit={NewName}
class Tracer
attr obj:{New Class Init}
meth !TInit skip end
meth otherwise(M)
{Browse entering({Label M})}
{@obj M}
{Browse exiting({Label M})}
end
end
in {New Tracer TInit} end

Ch7, Ex2

Make a functor to represent the package as follow:
functor
export
%export the all defined classes
a:A
%......
define
%create names for all the protected methods
P1 = {NewName}
%......

%all the above created names are available to *any*
%class inside this functor(or say package)

class A
%put all protected method as a record
%inside an attribute
attr setOfAllProtectedMethods:p(p1:P1)

meth init
skip
end

meth !P1(?Msg)
Msg='I am protected'
end
end

%......
end
This is how a class inheriting A can access protected methods.
%Create an instance of above functor, bind it to an
%identifier, lets call it TestPackage. Then this is how protected
%method P1 in class A can be used from a class inheriting it.
declare
class B from TestPackage.a
meth callP1(Msg)
P1 = (@setOfAllProtectedMethods).p1 in
{self P1(Msg)}
end
end

%Test
local O in
O = {New B init}
{Browse {O callP1($)}}
end

Ch7, Ex1

declare
fun {New2 Class}
K = {NewName}
class Mixin from Class
meth !K
skip
end
end
in
{New Mixin K}
end

Thursday, February 5, 2009

Ch6, Ex18

functor
import
File %Dict, custom Dict module is no more needed
QTk at 'x-oz://system/wp/QTk.ozf'
define
fun {WordChar C}
(&a=<C andthen C=<&z) orelse
(&A=<C andthen C=<&Z) orelse (&0=<C andthen C=<&9) end
fun {WordToAtom PW} {StringToAtom {Reverse PW}} end
Put=Dictionary.put
CondGet=Dictionary.condGet
proc {IncWord D W}
{Put D W {CondGet D W 0}+1}
end
fun {CharsToWords PW Cs}
case Cs
of nil andthen PW==nil then
nil
[] nil then
[{WordToAtom PW}]
[] C|Cr andthen {WordChar C} then
{CharsToWords {Char.toLower C}|PW Cr}
[] _|Cr andthen PW==nil then
{CharsToWords nil Cr}
[] _|Cr then
{WordToAtom PW}|{CharsToWords nil Cr}
end
end
proc {CountWords D Ws}
case Ws
of W|Wr then
{IncWord D W}
{CountWords D Wr}
[] nil then skip
end
end
fun {WordFreq Cs}
D={NewDictionary}
in
{CountWords D {CharsToWords nil Cs}}
D
end
fun {Entries D}
Ws = {Arity {Dictionary.toRecord label D}}
Ns = {Record.toList {Dictionary.toRecord label D}}
proc {Iter Xs Ys ?A}
case Xs#Ys of (X|Xr)#(Y|Yr) then Z in
A = (X#Y)|Z
{Iter Xr Yr Z}
[] nil#nil then A=nil
end
end
in
{Iter Ws Ns $}
end
L={File.readList stdin}
E={Entries {WordFreq L}}
S={Sort E fun {$ A B} A.2>B.2 end}
H Des=td(title:'Word frequency count'
text(handle:H tdscrollbar:true glue:nswe))
W={QTk.build Des} {W show}
for X#Y in S do {H insert('end' X#': '#Y#' times\n')} end
end

Ch6, Ex17

Following are the changes:
%Add  a variable for threhold number of users on one site
declare N=10000 M=500000 T=200 Threshold=100

%Add methods for incrementing/decrementing hits
%Procedures for incrementing/decrementing by 1 user on site
proc {IncrementHits S}
C = 1.0
in
Sites.S.hits := Sites.S.hits + 1
if Sites.S.hits>Threshold then
Sites.S.performance := Sites.S.performance - C
end
end
proc {DecrementHits S}
C = 1.0
in
if Sites.S.hits>Threshold then
Sites.S.performance := Sites.S.performance + C
end
Sites.S.hits := Sites.S.hits - 1
end

%Never increment/decrement hits manualy but use above methods
declare
Users={MakeTuple users M}
for I in 1..M do
S={UniformI 1 N}
in
Users.I={Record.toDictionary o(currentSite:S)}
{IncrementHits S}
end
proc {UserStep I}
U = Users.I
% Ask three users for their performance information
L = {List.map [{UniformI 1 M} {UniformI 1 M} {UniformI 1 M}]
fun{$ X}
(Users.X.currentSite) #
Sites.(Users.X.currentSite).performance
+ {Gauss}*{IntToFloat N}
end}
% Calculate the best site
MS#MP = {List.foldL L
fun {$ X1 X2} if X2.2>X1.2 then X2 else X1 end end
U.currentSite #
Sites.(U.currentSite).performance
+ {Abs {Gauss}*{IntToFloat N}}
}
in
if MS\=U.currentSite then
{DecrementHits U.currentSite}
U.currentSite := MS
{IncrementHits MS}
end
end

Ch6, Ex16

We can divide M users in K groups of equal size and in UserStep, user I can ask for performance information from the 3 users belonging to his group only.

These are the changes:
%We add another variable K that
%denotes the number of groups. K should be chosen
%so that (M mod K) is 0 i.e. It should be able
%to divide M users in K groups of equal size
declare
N=10000 M=500000 T=200 K=100 %K is the number of groups

%Sets A and B to the extremes of the group in
%which I fall into
proc {GroupEdges I ?A ?B}
X1 = (K*I) div M
X2 = (K*I) mod M
in
if X2==0 then
A = (X1-1)*(M div K)+1
B = X1*(M div K)
else
A = X1*(M div K) + 1
B = (X1+1)*(M div K)
end
end

%Chose users from the same group only
proc {UserStep I}
U = Users.I
local A B in
{GroupEdges I A B}
% Ask three users(belonging to I's group only) for
% their performance information
L = {List.map [{UniformI A B} {UniformI A B}
{UniformI A B}]
fun{$ X}
(Users.X.currentSite) #
Sites.(Users.X.currentSite).performance
+ {Gauss}*{IntToFloat N}
end}
end
% Calculate the best site
MS#MP = {List.foldL L
fun {$ X1 X2} if X2.2>X1.2 then X2 else X1 end end
U.currentSite #
Sites.(U.currentSite).performance
+ {Abs {Gauss}*{IntToFloat N}}
}
in
if MS\=U.currentSite then
Sites.(U.currentSite).hits :=
Sites.(U.currentSite).hits - 1
U.currentSite := MS
Sites.MS.hits := Sites.MS.hits + 1
end
end

==================================================================
Complete Code to run word-of-mouth simulation:
%Download File.oz from book's suppliment site then
%create ozc file by running following command
%$ozc -c File.oz

%CHANGE THESE PATHS
declare FileOzrc SimResults
FileOzrc=
'/path/File.ozf'
SimResults=
'/path/wordofmouth.txt'
declare
[File]= {Module.link [FileOzrc]}

declare NewRand
local
A=333667
B=213453321
M=1000000000
in
proc {NewRand ?Rand ?Init ?Max}
X={NewCell 0}
in
proc {Init Seed} X:=Seed end
fun {Rand} X:=(A*@X+B) mod M in @X end
Max=M
end
end

declare Rand Init Max Uniform UniformI Gauss
{NewRand Rand Init Max}
local
FMax={IntToFloat Max}
in
fun {Uniform}
{IntToFloat {Rand}}/FMax
end
fun {UniformI A B}
A+{FloatToInt {Floor {Uniform}*{IntToFloat B-A+1}}}
end
end
local
TwoPi=4.0*{Float.acos 0.0}
GaussCell={NewCell nil} in
fun {Gauss}
Prev={Exchange GaussCell $ nil}
in
if Prev\=nil then Prev
else R Phi in
R={Sqrt ~2.0*{Log {Uniform}}}
Phi=TwoPi*{Uniform}
GaussCell:=R*{Cos Phi}
R*{Sin Phi}
end
end
end

declare
N=10000 M=500000 T=200
{Init 0}
{File.writeOpen SimResults}
proc {Out S}
{File.write {Value.toVirtualString S 10 10}#"\n"}
end


declare
Sites={MakeTuple sites N}
for I in 1..N do
Sites.I={Record.toDictionary
o(hits:0 performance:{IntToFloat
{UniformI 1 80000}})}
end

declare
Users={MakeTuple users M}
for I in 1..M do
S={UniformI 1 N}
in
Users.I={Record.toDictionary o(currentSite:S)}
Sites.S.hits := Sites.S.hits + 1
end

proc {UserStep I}
U = Users.I
% Ask three users for their performance information
L = {List.map [{UniformI 1 M} {UniformI 1 M} {UniformI 1 M}]
fun{$ X}
(Users.X.currentSite) #
Sites.(Users.X.currentSite).performance
+ {Gauss}*{IntToFloat N}
end}
% Calculate the best site
MS#MP = {List.foldL L
fun {$ X1 X2} if X2.2>X1.2 then X2 else X1 end end
U.currentSite #
Sites.(U.currentSite).performance
+ {Abs {Gauss}*{IntToFloat N}}
}
in
if MS\=U.currentSite then
Sites.(U.currentSite).hits :=
Sites.(U.currentSite).hits - 1
U.currentSite := MS
Sites.MS.hits := Sites.MS.hits + 1
end
end

for J in 1..N do
{Out {Record.adjoinAt {Dictionary.toRecord site Sites.J}
name J}}
end
{Out endOfRound(time:0 nonZeroSites:N)}
for I in 1..T do
X = {NewCell 0}
in
for U in 1..M do {UserStep U} end
for J in 1..N do
H=Sites.J.hits in
if H\=0 then
{Out {Record.adjoinAt
{Dictionary.toRecord site Sites.J} name J}}
X:=1+@X
end
end
{Out endOfRound(time:I nonZeroSites:@X)}
end
{Out finished}
{File.writeClose}

Ch6, Ex15

declare
proc {Break}
raise breakException end
end
proc {Block P}
try {P Break}
catch X then
if X==breakException then skip
else raise X end end
end
end

%usage

%no break in statements, so prints one, two
{Block proc{$ Break} {Browse one} {Browse two} end}

%prints one only as after it {Break} is called
{Block proc{$ Break} {Browse one} {Break} {Browse two} end}

%nested blocks, it prints one, two and four... notice that
%calling Break in inner block breaks it only
{Block proc{$ Break1}
{Browse one}
{Block proc{$ Break2}
{Browse two} {Break2} {Browse three} end}
{Browse four} end}

Ch6, Ex14 (tbd)

tbd

Ch6, Ex13

declare
fun {NewDictionary}
L={NewCell nil}
proc {Put K V}
{Remove K}
L:=(K#V)|@L
end
fun {Get K}
fun {Iter Xs}
case Xs of
(Key#Val)|Xr andthen K==Key then Val
[] (Key#Val)|Xr then {Iter Xr}
[] nil then raise keyNotFound end
end
end
in
{Iter @L}
end
fun {CondGet K A}
try {Get K}
catch X then A
end
end
fun {Member K}
fun {Iter Xs}
case Xs of
(Key#Val)|Xr andthen K==Key then true
[] (Key#Val)|Xr then {Iter Xr}
[] nil then false
end
end
in
{Iter @L}
end
proc {Remove K}
fun {Iter Xs}
case Xs of
(Key#Val)|Xr andthen K==Key then {Iter Xr}
[] (Key#Val)|Xr then (Key#Val)|{Iter Xr}
[] nil then nil
end
end
in
L:={Iter @L}
end
fun {Keys}
proc {Iter Xs ?R}
case Xs of
(Key#Val)|Xr then Y in
R=Key|Y
{Iter Xr Y}
[] nil then R=nil
end
end
in
{Iter @L $}
end
%for debugging only
fun {ListContent}
@L
end
in
dict(put:Put get:Get condGet:CondGet member:Member
remove:Remove list:ListContent keys:Keys)
end

Note: We can not support Dictionary.toRecord operation for this dictionary as record feature can only be atom, bool or int and in this dictionary keys can be any value.

Ch6, Ex12

declare
fun {NewExtensibleArray L H Init}
A={NewCell {NewArray L H Init}}#Init
proc {CheckOverOrUnderflow I}
Arr=@(A.1)
Low={Array.low Arr}
High={Array.high Arr}
in
if I>High then
High2=Low+{Max I 2*(High-Low)}
Arr2={NewArray Low High2 A.2}
in
for K in Low..High do Arr2.K:=Arr.K end
(A.1):=Arr2
elseif I<Low then
Low2 = Low - {Max (High-Low) (Low-I)}
Arr2={NewArray Low2 High A.2}
in
for K in Low..High do Arr2.K:=Arr.K end
(A.1):=Arr2
end
end
proc {Put I X}
{CheckOverOrUnderflow I}
@(A.1).I:=X
end
fun {Get I}
{CheckOverOrUnderflow I}
@(A.1).I
end
in extArray(get:Get put:Put)
end

Ch6, Ex11 (tbd)

tbd

Ch6, Ex10

Swap code impl with call by need:
declare
proc {Swap X Y}
Xarg = {X}
Yarg = {Y}
T = {NewCell @Xarg}
in
Xarg:=@Yarg
Yarg:=@T
end

Counterintuitive behavior does not occur with this version.

Sqr code call by need impl with using laziness:
declare
proc {Sqr A}
B={A}
in
B:=@B*@B
end

local C={NewCell 0} in
C:=25
%made the argument function lazy
{Sqr fun lazy {$} C end}
{Browse @C}
end

Ch6, Ex9

With "Call By Name", argument is evaluated everytime its needed, It doesn't work because in the code we need a[i] twice, first time i is one so we refer to a[1], second time when we refer to a[i] then i is 2 so we refer to a[2] though we intended to refer to a[1].
It'll be clear from the code and explaination below.
Code in stateful computation model:
declare
proc {Swap X Y}
T = {NewCell @{X}}
in
{X}:=@{Y}
{Y}:=@T
end
local A I in
A={MakeTuple array 10}
for J in 1..10 do A.J={NewCell 0} end
I = {NewCell 1}
(A.1):=2
(A.2):=1
{Swap fun {$} I end fun {$} A.(@I) end}
{Browse @I}
{Browse @(A.1)}
{Browse @(A.2)}
end

Explaination:
STEP1:
T = {NewCell @{X}} , here @{X} returns @I i.e. 1

STEP2:
{X}:=@{Y} , here {X} returns I and {Y} returns A.(@I) i.e. A.1
so this step effectively does I:=2

STEP3:
{Y}:=@T , here {Y} returns A.(@I) i.e. A.2
so this step effectively does A.2:=2

Its clear that when, in STEP3, it was intended to change A.1, we unknowingly did it to A.2 .

Ch6, Ex8

%First representation
declare
fun {NewCollector}
H in
{NewCell H|H}
end
proc {Collect C X}
H T in
{Exchange C H|(X|T) H|T}
end
fun {EndCollect C}
X|nil = @C
in
X
end

%Second representation
declare
fun {NewCollector}
H in
H|{NewCell H}
end
proc {Collect C X}
T in
{Exchange C.2 X|T T}
end
fun {EndCollect C}
X|Y = C
in
@Y = nil
X
end

%Test
local C in
C = {NewCollector}
{Collect C 1}
{Collect C 2}
{Collect C 3}
{Browse {EndCollect C}} %[1 2 3]
end

Notice that for both the implementations a collector C becomes useless once EndCollector has been called on it, I don't know if this is not supposed to happen for the actual solution.

Memory Usage: To find out memory usage of both versions of Collect we'll have to transform their body in kernel language.
%First Version
declare
proc {Collect C X}
local H in
local T in
local Tmp1 in
Tmp1 = H|(X|T)
local Tmp2 in
Tmp2 = H|T
{Exchange C Tmp1 Tmp2}
end
end
end
end
end

Memory Usage-
For Tmp1 = H|(X|T) it is (1+2)+(1+2)+m(X)= 6+m(X)
For Tmp2 = H|T it is 1+2 = 3
And assume that for Exchange operation the memory used be E0
Total Memory Used = 1+1+1+6+m(X)+1+3+E0 = 13+E0 + m(X)
13+E0 words become inactive after the call
%Second Version
declare
proc {Collect C X}
local T in
local Tmp1 in
Tmp1 = C.2 %Let this causes m0 memory
local Tmp2 in
Tmp2 = X|T
{Exchange Tmp1 Tmp2 T}
end
end
end
end


Memory Usage-
Total: 1+1+m0+1+(1+2)+m(X)+E0 = 6+m0+E0 +m(X)
and 6+m0+E0 words become inactive after the call. If m0=2(don't know for a fact though) then 8+E0 becomes inactive.

Its clear that second version will leave less work for garbage collector and will take less time allocating the memory and hence better from the performance perspective.

Ch6, Ex7 (tbd)

tbd

Ch6, Ex6

I don't think its possible to maintain the same identity for an object after state changes using declarative model because of the very fact of declarativeness that result of an operation should always be same i.e. it can't have a hidden state.

Ch6, Ex5

It seems to be true as is evident by variations of stack implementation in the book, in the implementation of Ports in ex3, explicit state is needed to keep track of the end of the stream and not for security.

Ch6, Ex4

An open unbundled stateful version
declare
proc {NewPort S P}
P = {NewCell S}
end
proc {Send P X}
S=@P S1 in
S = X|S1
P:=S1
end

A Secure unbundled stateful version
declare
proc {NewWrapper ?Wrap ?Unwrap}
Key={NewName}
in
fun {Wrap X}
fun {$ K} if K==Key then X end end
end
fun {Unwrap W}
{W Key}
end
end

declare NewPort Send
local Wrap Unwrap in
{NewWrapper Wrap Unwrap}
proc {NewPort S P}
P = {Wrap {NewCell S}}
end
proc {Send P X}
C={Unwrap P} S=@C S1 in
S = X|S1
C:=S1
end
end

A Secure Bundled stateful version
declare
proc {NewPort S P}
C = {NewCell S}
proc {Send X}
S = @C S1 in
S = X|S1
C := S1
end
in
P = port(send:Send)
end

%Usage
declare P S
{NewPort S P}
{Browse S}
{P.send a}
{P.send b}

Note: In chapter 5 it is said that end of port stream is a readonly variable, I don't completely understand the meaning of that and hence above versions don't support that statement, Someday I'll give more thought to it.

Ch6, Ex3

I could not find a way to have encapsulated sum count without using explicit state and also had to change the arguments in SumList. The difficulty is that count variable needs to change with each call to SumList but in declarative model we can not change a variable value once its bound,so we have to keep track of change by creating new variables and binding them to new values.
This is my new SumList
declare
fun {SumList Xs S CountS CountSnext}
CurrentCount Cs
in
CountS = access(CurrentCount)|assign(CurrentCount+1)|Cs
%{Browse currentcount} {Browse CurrentCount}
case Xs
of nil then
CountSnext = Cs
S
[] X|Xr then
{SumList Xr X+S Cs CountSnext}
end
end
fun {MakeState Init}
proc {Loop S V}
case S of access(X)|S2 then
X=V {Loop S2 V}
[] assign(X)|S2 then
{Loop S2 X}
else skip end
end
S
in
thread {Loop S Init} end
S
end

%usage, notice how the state is wind up in C0, C1,...
%calling SumList the first time
declare C0 S={MakeState 0}
{Browse {SumList [1 2 3 4] 0 S C0}}

%Accessing current count
declare C1 in
local X in
C0=access(X)|C1
{Browse X} %5
end

%Calling SumList again
declare C2 in
{Browse {SumList [1 2] 0 C1 C2}}

%Accessing current count
declare C3 in
local X in
C2=access(X)|C3
{Browse X} %8
end

Clearly this version is not readable, not easy to use(because counting functionality is not encapsulated) as caller needs to keep track of variables.. hence declarative model alone is not expressive enough to give this functionality

Ch6, Ex2

declare
fun {SumList Xs}
C={NewCell 0}
fun {Recurse Xs}
case Xs of X|Xr then
C := @C + X
{Recurse Xr}
else @C
end
end
in
{Recurse Xs}
end
%Test
{Browse {SumList [1 2 3 4]}} %10

Another version which is slightly more readable but works only for sequential computation model, it breaks if multiple threads use it(Why? Hint: All threads can change the contents in the cell)
declare SumList
local C={NewCell 0}
in
fun {SumList Xs}
case Xs of X|Xr then
C := @C + X
{SumList Xr}
else Y=@C in
C := 0
Y
end
end
end

%Code that shows that this fails with concurrent model
%MakeList creates a list of 1s of length N
declare
fun {MakeList N}
fun {Iter X N}
if N>0 then {Iter 1|X N-1}
else X
end
end
in
{Iter nil N}
end

%Test
%should print 100000
{Browse {SumList {MakeList 100000}}}
%Both of these should also print 100000
%but they mostly don't
thread {Browse {SumList {MakeList 100000}}} end
thread {Browse {SumList {MakeList 100000}}} end

Ch6, Ex1

In case of state we're just interested in the final result of the sequence and not the intermediate values whereas in case of comics we're interested in all the values. State sequence exists in time and not in space whereas comics sequence exists in space only. Transition between the sequence elements is not important in State but in Comics.

Note: This exercise is not there in the pdf version of the book.

Ch5, Ex8

Well,it works but not practical because it doesn't seem to be easy to use. Moreover as specified in the footnote, its not possible to name the NameServer object and it has to be passed around.

(I bet there is more that can be added, please drop your thoughts..)

Ch5, Ex7 (tbd)

dint follow the section on erlang as it felt like really hard to get into understanding another language at this point, will come back to it later

Ch5, Ex6 (tbd)

dint follow the section on erlang as it felt like really hard to get into understanding another language at this point, will come back to it later

Tuesday, February 3, 2009

Ch5, Ex5

Code that can be used to run the various code snippets in the problem:
declare
proc {Barrier Ps}
fun {BarrierLoop Ps L}
case Ps of P|Pr then M in
thread {P} M=L end
{BarrierLoop Pr M}
[] nil then L
end
end
S={BarrierLoop Ps unit}
in
{Wait S}
end
proc {NewPortClose ?S ?Send ?Close}
PC={NewCell S}
in
proc {Send M}
S in
{Exchange PC M|S S}
end
proc {Close}
nil=@PC
end
end
proc {ConcFilter L F ?L2}
Send Close
in
{NewPortClose L2 Send Close}
{Barrier
{Map L
fun {$ X}
proc {$}
if {F X} then {Send X} end
end
end}}
{Close}
end

a:)It shows [5 4] but [4 5] is also possible and depends upon the thread execution order put down by the thread scheduler which are created by Barrier. Clearly there is an observable nondeterminism.
BTW here is a snippet that *almost* makes sure that [4 5] is printed
declare Out A
thread {Delay 500} A = 5 end
%ConcFilter doesn't wait for A and carries on with other
%elements, A is processed later when its bound, Regular
%Filter in this case will wait for A to bound and still
%print [5 4]
{ConcFilter [A 1 2 4 0] fun {$ X} X>2 end Out}
{Show Out}

b:)Same as a.

c:)Nothing is displayed as Barrier blocks because one of the child thread is blocked at A.
Once A is bound to 3, Out can have two values [5 4 3] and [4 5 3]. 3 always comes last because all the threads except that needing A finish there execution.

d:)Well complexity of both is O(n). But execution time depends upon following cases
I. If all the elements in input list are bound then Filter is much faster because ConcFilter does exactly the same things as Filter but with the overhead of creating threads for processing each element.
II.If let say first element of the list is not bound, in this case Filter will not be able to process the other elements also unless first one is bound while ConcFilter can carry on processing other elements even though first is not bound, so if list length is sufficiently large and predicate function is time consuming then ConcFilter will do a better job.

Ch5, Ex4

PartI- Well, One way to understand it is by seeing that the assertion, which said "The sum of elements on the port's stream is greater than or equal to the number of active threads." ,that was stated to prove the correctness of NewThread symantics is no longer always true with this new definition of SubThread. Let us look carefully at the two definitions of SubThread and the embedded comments that provide the explaination.
% Correct Version
proc {SubThread P}
%Notice that +1 is sent to the Port's stream before
%starting the new thread, this makes sure that sum of
%elements is *incremented before* any new thread is started
{Send Pt 1}
thread
{P} {Send Pt ~1}
end
end
% Incorrect Version
proc {SubThread P}
%thread is started before sending +1 to the port's stream
%so right after creation of this thread, if scheduler
%doesn't execute it then a thread is created but sum of
%elements is not incremented and that means assertion is
%no longer true.
thread
{Send Pt 1}
{P} {Send Pt ~1}
end
end


PartII- Required Example
declare NewThread
local
proc {ZeroExit N Is}
case Is of I|Ir then
if N+I\=0 then {ZeroExit N+I Ir}
else
% 'ZeroExit Finished' is displayed when call to
% ZeroExit is over.
{Browse 'ZeroExit Finished'}
end
end
end
in
proc {NewThread P ?SubThread}
Is Pt={NewPort Is}
in
proc {SubThread P}
thread
{Send Pt 1}
{P} {Send Pt ~1}
end
end
{SubThread P}
{ZeroExit 0 Is}
end
end

local SubThread in
{NewThread
proc {$}
{Browse 'T1 started'}
{SubThread
proc {$}
{Browse 'T2 started'} {Delay 2000}
{Browse 'T2 finished'}
end} %T2
{Browse 'T1 finished'}
end
SubThread}
{Browse 'NewThread Finished'}
end


Notice that "ZeroExit Finished" is printed before "T2 finished" that is sum of elemtents on the port stream became zero though T2 was not finished.

Ch5, Ex3 (TBD)

----WORK IN PROGRESS-----------

We can add one more state to Floor, called "keepopen", when Floor receives a call msg while door is open, then Floor starts another timer and goes to state "keepopen", all the call msgs in keepopen state are ignored and getting stoptimer puts the Floor back in doorsopen state. Add state "down" to Lift, when it receives any msg in this state it simply replies with down(id). When Floor receives a down msg it simply tries to call another lift. When a lift sends arrived msg to a Floor, it also sets a timer, on receipt of stoptimer, if its still waiting for Floor to close the doors then it goes into down state.

Ch5, Ex2

a.
Well, In the current implementation, one controller can be associated with one lift only. If we have one controller and every lift send it step(N), controller will keep on moving one lift only. Obviously its a pretty bad idea.

b.
fun {Controller Init}
Tid={Timer}
Cid={NewPortObject Init
fun {$ Msg state(Motor F Lid)}
case Motor
of running then
case Msg
of stoptimer then
{Send Lid 'at'(F)}
state(stopped F Lid)
end
[] stopped then
case Msg
of step(Dest) then
if F==Dest then
state(stopped F Lid)
elseif F < Dest then X=Dest-F in %CHANGED HERE
{Send Tid starttimer(5000*X Cid)}
state(running F+X Lid)
else X=F-Dest in % F>Dest
{Send Tid starttimer(5000*X Cid)}
state(running F-X Lid)
end
end
end
end}
in Cid end

fun {Lift Num Init Cid Floors}
{NewPortObject Init
fun {$ Msg state(Pos Sched Moving)}
case Msg
of call(N) then
{Browse 'Lift '#Num#' needed at floor '#N}
if N==Pos andthen {Not Moving} then
{Wait {Send Floors.Pos arrive($)}}
state(Pos Sched false)
else Sched2 in
Sched2={ScheduleLast Sched N}
if {Not Moving} then
{Send Cid step(N)} end
state(Pos Sched2 true)
end
[] 'at'(NewPos) then
{Browse 'Lift '#Num#' at floor '#NewPos}
case Sched
of S|Sched2 then
if NewPos==S then
{Wait {Send Floors.S arrive($)}}
if Sched2==nil then
state(NewPos nil false)
else
{Send Cid step(Sched2.1)}
state(NewPos Sched2 true)
end
else %NOT CHANGED REALLY
{Browse 'ERROR: this should not happen'}
{Send Cid step(S)}
state(NewPos Sched Moving)
end
end
end
end}
end

Ch5, Ex1

Interleaving is in lockstep.

Message sequence sent is
ping(0) pong(100000) pong(1) ping(100001) ping(2) pong(100002)...

because we first send ping(0) and then immediately pong(100000),
processing of first msg sends pong(1) and processing of second msg
sends ping(100001) and this goes on....

its possible to see by running following code:
declare [QTk]={Module.link [ 'x-oz://system/wp/QTk.ozf']}
declare
proc {NewPortObjects ?AddPortObject ?Call}
Sin P={NewPort Sin}
proc {MsgLoop S1 Procs}
case S1
of msg(I M)|S2 then
try {Procs.I M} catch _ then skip end
{MsgLoop S2 Procs}
[] add(I Proc Sync)|S2 then Procs2 in
Procs2={AdjoinAt Procs I Proc}
Sync=unit
{MsgLoop S2 Procs2}
[] nil then skip end
end
in
proc {AddPortObject I Proc}
Sync in
{Send P add(I Proc Sync)}
{Wait Sync}
end
proc {Call I M}
{Send P msg(I M)}
end
thread {MsgLoop Sin procs} end
end
fun {NewProgWindow CheckMsg}
InfoHdl See={NewCell true}
H D=td(label(text:nil handle:InfoHdl)
checkbutton(
text:CheckMsg handle:H init:true
action:proc {$} See:={H get($)} end))
in
{{QTk.build D} show}
proc {$ Msg}
if @See then {Delay 50} {InfoHdl set(text:Msg)} end
end
end

declare AddPortObject Call
{NewPortObjects AddPortObject Call}
InfoMsg={NewProgWindow "See ping-pong"}
fun {PingPongProc Other}
proc {$ Msg}
case Msg
of ping(N) then
{InfoMsg "ping("#N#")"}
{Delay 1000}
{Call Other pong(N+1)}
[] pong(N) then
{InfoMsg "pong("#N#")"}
{Delay 1000}
{Call Other ping(N+1)}
end
end
end
{AddPortObject pingobj {PingPongProc pongobj}}
{AddPortObject pongobj {PingPongProc pingobj}}
{Call pingobj ping(0)}
{Call pongobj pong(100000)}

Sunday, February 1, 2009

Ch4, Ex22 (todo)

tbd

Ch4, Ex21 (todo)

tbd

Ch4, Ex20 (tbd)

tbd

Ch4, Ex19

In case of Merge, recise order of reading is clear. So result is always deterministic while in client/server example we can have observable nondeterminism due to no restrictions on the order of read of various client streams.

Ch4, Ex18

Results Possible:
1.
bing
bong
2.
bong
bing

Multiple executions are possible.

Ch4, Ex17

% First generate primes then solve hamming problem
declare
proc {Touch L N}
if N > 0 then
{Touch L.2 N-1}
else skip
end
end
fun lazy {Filter Xs F}
case Xs of nil then nil
[] X|Xr andthen {F X} then X|{Filter Xr F}
[] X|Xr then {Filter Xr F}
end
end
fun lazy {Integers N}
N|{Integers N+1}
end
fun lazy {Sieve Xs}
case Xs
of nil then nil
[] X|Xr then Ys in
thread Ys={Filter Xr fun {$ Y} Y mod X \= 0 end} end
X|{Sieve Ys}
end
end
% Generate list of first k primes; k >=1
fun {GeneratePrimes K}
Ps = {Sieve {Integers 2}}
fun {Iter K Ps}
if K==0 then nil
else
case Ps of P|Pr then P|{Iter K-1 Pr} end
end
end
in
{Iter K Ps}
end

% Test, Generating first 10 primes
{Browse {GeneratePrimes 10}}

% Generalized Hamming Problem
declare
fun lazy {Times N H}
case H of X|H2 then N*X|{Times N H2} end
end
fun lazy {Merge Xs Ys}
case Xs#Ys of (X|Xr)#(Y|Yr) then
if X<Y then X|{Merge Xr Ys}
elseif X>Y then Y|{Merge Xs Yr}
else X|{Merge Xr Yr}
end
end
end
fun {Hamming K}
fun {Recur Ps H}
case Ps of P|nil then {Times P H}
[] P|Pr then
{Merge {Times P H} {Recur Pr H}}
end
end
H
in
H = 1|{Recur {GeneratePrimes K} H}
H
end

% Test, Compare results from both, they should be equal
local X in
X = {Hamming 3}
{Touch X 10}
{Browse X}
end

local H in
H=1|{Merge {Times 2 H}
{Merge {Times 3 H}
{Times 5 H}}}
{Browse H}
{Touch H 10}
end