%Gatemaker (for two-input gates)

fun{GateMaker F}
   fun{$ Xs Ys}
      fun{GateLoop Xs Ys}
	 case Xs#Ys of (X|Xr)#(Y|Yr) then
	    {F X Y}|{GateLoop Xr Yr}
	 end
      end
   in
      thread {GateLoop Xs Ys} end
   end
end
%exemples of gates
AndG={GateMaker fun{$ X Y} X*Y end}%and gate
OrG={GateMaker fun{$ X Y} X+Y-X*Y end}%or gate
NandG={GateMaker fun{$ X Y} 1-X*Y end}%not and gate
NorG={GateMaker fun{$ X Y} 1-X-Y+X*Y end}%not or gate
XorG={GateMaker fun{$ X Y} X+Y-2*X*Y end}%exclusive or gate
      
%Barrier for concurrent composition

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}%waits until all the zero-arg proc are terminated
end

%Bounded buffer (data-driven concurrent version)

proc{Buffer N ?Xs Ys}
   fun{Startup N ?Xs}
      if N==0 then Xs
      else Xr in
	 Xs=_|Xr
	 {Startup N-1 Xr}
      end
   end

   proc{AskLoop Ys ?Xs ?End}
      case Ys of Y|Yr then Xr End2 in
	 Xs=Y|Xr    % get element from buffer
	 End=_|End2 % replenish the buffer
	 {AskLoop Yr Xr End2}
      end
   end
   End={Startup N Xs}
in
   {AskLoop Ys Xs End}
end

%Bounded buffer (correct lazy version)

fun{Buffer2 In N}
   End=thread {List.drop In N} end%skips over N elements of In
   fun lazy{Loop In End}
      case In of I|In2 then
	 I|{Loop In2 thread End.2 end}
      end
   end
in
   {Loop In End}
end

%NewPortObject abstraction with state

fun{NewPortObject Init Fun}
   proc{MsgLoop S1 State}
      case S1 of M|S2 then
	 {MsgLoop S2 {Fun M State}}
      [] nil then skip
      end
   end
   S in
   thread {MsgLoop S Init} end
   {NewPort S}
end

%NewPortObject abstraction without state

fun{NewPortObject2 Proc}
   Sin in
   thread for Msg in Sin do {Proc Msg} end end
   {NewPort Sin}
end

declare
proc {NewPortObject F Init ?P}
   S
   proc {Loop S State}
      case S of Msg|Sr then NS={F Msg State} in
	 {Browse NS}
	 {Loop Sr NS}
      end
   end
in
   thread {Loop S Init} end
   {NewPort S P}
end
fun {NewBB N}
   PO={NewPortObject
       fun {$ Msg State}
	  case Msg
	  of get(X)#Ack then
	     Ack=X
	     if State.size==0 then
		buffer(size:0 queue:State.queue
		       waitget:(X|State.waitget) waitput:State.waitput)
	     else
		case State.waitput
		of nil then
		   case State.queue of S|Sr then
		      X=S
		      buffer(size:(State.size-1) queue:Sr
			     waitput:State.waitput waitget:State.waitget)
		   end
		[] (P#A)|Pr then
		   X=P A=unit
		   buffer(size:State.size queue:State.queue
			  waitget:State.waitget waitput:Pr)
		end
	     end
	  [] put(X)#Ack then
	     if State.size==N then
		buffer(size:N queue:State.queue
		       waitget:State.waitget waitput:((X#Ack)|State.waitput))
	     else
		case State.waitget
		of nil then
		   Ack=unit
		   buffer(size:(State.size+1) queue:(X|State.queue)
			  waitget:State.waitget waitput:State.waitput)
		[] G|Gr then
		   G=X Ack=unit
		   buffer(size:State.size queue:State.queue
			  waitget:Gr waitput:State.waitput)
		end
	     end
	  end
       end buffer(size:0 queue:nil waitget:nil waitput:nil)}
in
   proc {$ Msg} Ack in
      {Send PO Msg#Ack}
      {Wait Ack}
   end
end

declare
BB={NewBB 4}

local X in
   {BB get(X)}
   {Browse X}
end

{BB put(6)} {Browse ok}

declare
fun {RunAve N Xs}
   fun {Ave Nb List Count Acc}
      if Count==Nb then Acc#ok
      else
	 case List of nil then _#ko
	 [] H|T then
	    {Ave Nb T Count+1
	     Acc+(H/{Int.toFloat Nb})}
	 end
      end
   end

   fun {Loop L}
      case L of nil then nil
      [] H|T then Ack S in
	 {Ave N L 0 0.0 S#Ack}
	 if Ack == ko then nil
	 else S|{Loop T}
	 end
      end
   end
in
   thread {Loop Xs} end
end

declare
X=1.0|2.0|3.0|4.0|_
{Browse {RunAve 3 X}} % perfect 2.0|3.0|_

declare
X=1.0|2.0|3.0|4.0|nil
{Browse {RunAve 3 X}} % perfect [2.0 3.0]

% Bonus : non, ma fonction n'accumule pas les erreurs
% d'arrondis, car elle fait chaque fois une nouvelle
% moyenne sans réutiliser de résultat antérieur ...

declare
fun lazy {Ones}
   thread 1|{Ones} end
end
fun {Sum Xs}
   fun lazy {Loop Xs Acc}
      case Xs
      of H|T then (Acc+H)|{Loop T Acc+H}
      [] nil then Acc
      end
   end
in
   thread {Loop Xs 0} end
end



declare
Xs={Ones}
{Browse Xs}
Ys={Sum Xs}
{Wait Ys.2.2.2.2.1}

declare
fun {Map Xs F}
   case Xs of nil then nil
   [] H|T then {F H}|{Map T F}
   end
end
% test :
{Browse {Map [1 2 3 4 5 6] fun {$ X} X*2 end}}

declare
fun {Map Xs F}
   case Xs of nil then nil
   [] H|T then thread {F H} end|{Map T F}
   end
end
{Browse {Map [1 2 _ 4 5 6] fun {$ X} X*2 end}}

declare
F
{Browse {Map [1 2 _ 4 5 6] F}}

F=fun {$ E} E*3 end

declare
fun {NewPortObject Init F}
   L
   proc {Loop L State}
      case L of nil then skip
      [] Msg|T then
	 {Loop T {F Msg State}}
      end
   end
in
   thread {Loop L Init} end
   {NewPort L}
end
fun {BFct Msg State}
   case Msg of query(I ?P) then P=State.I State
   [] buy(I) then {Browse I#State.I} State
   end
end
B1 = {NewPortObject merchandise(tomate:56 banane:34) BFct}
B2 = {NewPortObject merchandise(tomate:54 banane:37) BFct}
F = {NewPortObject _
     fun {$ Msg State}
	case Msg of query(I ?P ?N) then
	   P1 P2 in
	   {Send B1 query(I P1)}
	   {Send B2 query(I P2)}
	   if (P1>P2) then P=P2 N=2
	   else P=P1 N=1
	   end
	[] buy(I N) then
	   if (N==1) then {Send B1 buy(I)}
	   else {Send B2 buy(I)} end
	end
	_ end}
C = {NewPortObject _
     fun {$ Msg State}
	case Msg of buy(I ?P) then N in
	   {Send F query(I P N)} state(item:I price:P b:N)
	[] buyit then {Send F buy(State.item State.b)} _
	end
     end}
{Browse {Send C buy(tomate $)}}
{Send C buyit}

declare
fun {XorG L1 L2}
   fun {Loop I1 I2}
      case I1#I2
      of (H1|T1)#(H2|T2) then
	 (H1+H2 - 2*H1*H2)|{Loop T1 T2}
      [] nil#nil then nil
      end
   end
in
   thread {Loop L1 L2} end
end

fun {NotG L}
   fun {Loop L1}
      case L1 of H|T then (1-H)|{Loop T}
      [] nil then nil end
   end
in
   thread {Loop L} end
end

fun {DelayG L}
   0|L
end

{Browse {XorG 1|1|0|0|_ 1|0|1|0|_}}
{Browse {NotG 1|0|1|1|_}}
{Browse {DelayG 1|0|1|1|_}}

declare
proc {Processor Input Output}
   thread
      {XorG Input {NotG {DelayG Output}} Output}
   end
end

{Browse {Processor 0|1|0|1|0|1|0|1|_}}
% 110011001100 ...
% Avec un seul thread ...

declare
proc {Processor2 Input Output}
   proc {Loop I O}
      case I#O of (H|T)#(H2|T2) then
	 L M K
      in
	 L=(1-H2)
	 H+L-2*H*L|K=T2
	 {Loop T T2}
      end
   end
in
   thread {Loop Input {DelayG Output}} end
end

{Browse {Processor2 0|1|0|1|0|1|0|1|_}} % perfect

declare X Y Z
X=4
Z=X+Y
{Browse Z}

Y=3 % affiche 7

declare
fun {Add Xs Ys}
   fun {Loop Xs Ys}
      case Xs#Ys of (X|Xr)#(Y|Yr) then
	 (X+Y)|{Loop Xr Yr}
      end
   end
in
   thread {Loop Xs Ys} end
end

{Browse {Add 1|2|3|_ 1|2|3|_}}

declare
fun {Double Xs}
   fun {Loop Xs}
      case Xs of X|Xr then
	 (2*X)|{Loop Xr}
      end
   end
in
   thread {Loop Xs} end
end

{Browse {Double 1|2|3|_}}

declare
fun {Pipeline F N Xs}
   fun {Pipe F N Xs Count}
      if Count==N then Xs
      else 
	 {Pipe F N {F Xs} Count+1 }
      end
   end
in
   thread {Pipe F N Xs 0} end
end

declare
Xs=1|2|3|4|5|6

{Browse {Pipeline Double 4 Xs}}

declare
fun {Fifteen Xs} 
   fun {Loop Xs Zs} Ys in
      {Delay 100}
      Ys = {Pipeline Double 4 Xs }
      case Xs#Ys of (X|Xr)#(Y|Yr) then (Y-X)|{Loop Xr Zs}
      []nil#nil then Zs
      end
   end
   Zs
in
   thread {Loop Xs _}end   
end

{Browse {Fifteen 1|2|3|_}}

declare
fun {NewPortObject Init Fun}
   proc {Loop S State}
      case S of Msg|Sr then {Loop Sr {Fun Msg State}} end
   end
   S
in
   thread {Loop S Init} end
   {NewPort S}
end
proc {NewAgents N Update ?Agents}
   Agents={MakeTuple N}
   fun {AgentFun Msg State}
      case Msg
      of tick then Q=({Random N}+1) Sq in
         {Send Agents.Q push(State Sq)}
         {Update State Sq}
      [] push(Sp Sq) then
         Sq=State
         {Update Sq Sp}
      end
   end
in
   for I in 1..N do
      Agents.I={NewPortObject I AgentFun} % assume initial state is I
   end
end