SICP Chapter #03 Examples in Oz
% Functions defined in previous chapters
fun {Gcd A B}
   if B == 0 then
      A
   else
      {Gcd B (A mod B)}
   end
end
fun {Square X} X * X end
fun {Average X Y} (X + Y) / 2.0 end
fun {HasNoDivisors N C}
   case C
      of 1 then true
      else
         if N mod C == 0 then
            false
         else
            {HasNoDivisors N C-1}
         end
   end
end
fun {IsPrime N} {HasNoDivisors N N-1} end
fun {EnumerateInterval Low High}
   if Low > High then
      nil
   else
      Low | {EnumerateInterval Low+1 High}
   end
end

% 3.1.1 - Assignment and Local State - Local State Variables
Balance = {NewCell 100}

proc {Withdraw Amount}
   if @Balance >= Amount then
      Balance := @Balance - Amount
   else
      raise insufficientFunds(@Balance) end
   end
end

{Withdraw 25}
{Withdraw 25}
try {Withdraw 60} catch insufficientFunds(B) then skip end
{Withdraw 15}
{Browse @Balance}

local
   Balance = {NewCell 100}
in
   proc {NewWithdraw Amount}
      if @Balance >= Amount then
         Balance := @Balance - Amount
      else
         raise insufficientFunds(@Balance) end
      end
   end
end

fun {MakeWithdraw Balance}
   proc {$ Amount}
      if @Balance >= Amount then
         Balance := @Balance - Amount
      else
         raise insufficientFunds(@Balance) end
      end
   end
end

W1 = {MakeWithdraw {NewCell 100}}
W2 = {MakeWithdraw {NewCell 100}}

{W1 50}
{W2 70}
try {W2 40} catch insufficientFunds(B) then skip end
{W1 40}

fun {MakeAccount InitBalance}
   Balance = {NewCell InitBalance}
   proc {Withdraw Amount}
      if @Balance >= Amount then
         Balance := @Balance - Amount
      else
         raise insufficientFunds(@Balance) end
      end
   end
   proc {Deposit Amount}
      Balance := @Balance + Amount
   end
   fun {GetBalance} @Balance end
in
   account(withdraw:Withdraw deposit:Deposit balance:GetBalance)
end

Acc = {MakeAccount 100}
{Acc.withdraw 50}
try {Acc.withdraw 60} catch insufficientFunds(B) then skip end
{Acc.deposit 40}
{Acc.withdraw 60}
{Browse {Acc.balance}}

Acc2 = {MakeAccount 100}

% Exercise 3.1
fun {MakeAccumulator Initial}
   Accumulator = {NewCell Initial}
in
   fun {$ X}
      Accumulator := @Accumulator + X
      @Accumulator
   end
end
A = {MakeAccumulator 5}
{Browse {A 10}}
{Browse {A 10}}

% Exercise 3.2
fun {MakeMonitored Proc}
   CallCount = {NewCell 0}
in
   fun {$ M}
      case M
      of how_many_calls then @CallCount
      [] reset_count then CallCount := 0
      else
         CallCount := @CallCount + 1
         {Proc M}
      end
   end
end
Sm = {MakeMonitored Sqrt}
{Browse {Sm 100.0}}
{Browse {Sm 25.0}}
{Browse {Sm how_many_calls}}

% Exercise 3.3
fun {MakePasswordAccount InitBalance SecretPassword}
   Balance = {NewCell InitBalance}
   proc {Withdraw Amount}
      if @Balance >= Amount then
         Balance := @Balance - Amount
      else
         raise insufficientFunds(@Balance) end
      end
   end
   proc {Deposit Amount}
      Balance := @Balance + Amount
   end
   fun {GetBalance} @Balance end
in
   fun {$ M Password}
      if Password == SecretPassword then
         case M
         of withdraw then Withdraw
         [] deposit then Deposit
         [] balance then GetBalance
         else raise unknownRequest(M) end
         end
      else
         raise passwordInvalid end
      end
   end
end
PswdAcc = {MakePasswordAccount 100 "secret-password"}
{{PswdAcc withdraw "secret-password"} 40}
try {{PswdAcc withdraw "some-other-password"} 50} catch passwordInvalid then skip end
{Browse {{PswdAcc balance "secret-password"}}}

% Exercise 3.4
fun {MakePoliceAccount InitBalance SecretPassword}
   Balance = {NewCell InitBalance}
   BadPasswordCount = {NewCell 0}
   proc {Withdraw Amount}
      if @Balance >= Amount then
         Balance := @Balance - Amount
      else
         raise insufficientFunds(@Balance) end
      end
   end
   proc {Deposit Amount}
      Balance := @Balance + Amount
   end
   fun {GetBalance} @Balance end
in
   fun {$ M Password}
      if Password == SecretPassword then
         BadPasswordCount := 0
         case M
         of withdraw then Withdraw
         [] deposit then Deposit
         [] balance then GetBalance
         else raise unknownRequest(M) end
         end
      else
         BadPasswordCount := @BadPasswordCount + 1
         if @BadPasswordCount > 7 then
            raise call_the_cops end
         else
            raise passwordInvalid end
         end
      end
   end
end

% 3.1.2 - Assignment and Local State - The Benefits of Introducing Assignment
RandomInit = {NewCell 7}

fun {RandUpdate X}
   A = 27
   B = 26
   M = 127
in
   (A*X + B) mod M
end

fun {Rand}
   X = RandomInit
in
   X := {RandUpdate @X}
end

fun {CesaroTest}
   {Gcd {Rand} {Rand}} == 1
end

fun {MonteCarlo Trials Experiment}
   fun {Iter TrialsRemaining TrialsPassed}
      if TrialsRemaining == 0 then
         {IntToFloat TrialsPassed} / {IntToFloat Trials}
      else
         if {Experiment} then
            {Iter TrialsRemaining-1 TrialsPassed+1}
         else
            {Iter TrialsRemaining-1 TrialsPassed}
         end
      end
   end
in
   {Iter Trials 0}
end

fun {EstimatePi Trials}
   {Sqrt 6.0 / {MonteCarlo Trials CesaroTest}}
end

{Browse {EstimatePi 10}}

% second version (no assignment)
fun {RandomGcdTest Trials InitialX}
   fun {Iter TrialsRemaining TrialsPassed X}
      X1 = {RandUpdate X}
      X2 = {RandUpdate X1}
   in
      if TrialsRemaining == 0 then
         {IntToFloat TrialsPassed} / {IntToFloat Trials}
      else
         if {Gcd X1 X2} == 1 then
            {Iter TrialsRemaining-1 TrialsPassed+1 X2}
         else
            {Iter TrialsRemaining-1 TrialsPassed X2}
         end
      end
   end
in
   {Iter Trials 0 InitialX}
end

% Exercise 3.5
{OS.srand 0}
fun {RandomInRange Min Max}
   X = {IntToFloat {OS.rand}}
   MinOS
   MaxOS
in
   {OS.randLimits ?MinOS ?MaxOS}
   Min + X*(Max - Min) / {IntToFloat (MaxOS - MinOS)}
end
fun {RectArea X1 X2 Y1 Y2}
   {Abs (X2-X1) * (Y2-Y1)}
end
fun {EstimateIntegral P X1 X2 Y1 Y2 Trials}
   fun {IntegralTest}
      {P {RandomInRange X1 X2} {RandomInRange Y1 Y2}}
   end
in
   {RectArea X1 X2 Y1 Y2} * {MonteCarlo Trials IntegralTest}
end
fun {UnitPred X Y}
   {Square X} + {Square Y} =< 1.0
end
fun {EstimatePi_ Trials}
   {EstimateIntegral UnitPred 1.0 ~1.0 1.0 ~1.0 10000}
end
{Browse {EstimatePi_ 10}}

% Exercise 3.6
fun {RandWithReset Cmd}
   case Cmd
   of generate then Rand
   [] reset then {OS.srand 0}
   else raise badCommand(Cmd) end
   end
end

% 3.1.3 - Assignment and Local State - The Cost of Introducing Assignment
fun {MakeSimplifiedWithdraw Balance}
   fun {$ Amount}
      Balance := @Balance - Amount
      @Balance
   end
end

W = {MakeSimplifiedWithdraw {NewCell 25}}
_ = {W 20}
_ = {W 10}

fun {MakeDecrementer Balance}
   fun {$ Amount} Balance - Amount end
end

D = {MakeDecrementer 25}
{Browse {D 20}}
{Browse {D 10}}

{Browse {{MakeDecrementer 25} 20}}
{Browse {fun {$ Amount} 25 - Amount end 20}}
{Browse 25 - 20}

{Browse {{MakeSimplifiedWithdraw {NewCell 25}} 20}}

% Sameness and change
D1 = {MakeDecrementer 25}
D2 = {MakeDecrementer 25}

W3 = {MakeSimplifiedWithdraw {NewCell 25}}
W4 = {MakeSimplifiedWithdraw {NewCell 25}}
{Browse {W3 20}}
{Browse {W3 20}}
{Browse {W4 20}}

PeterAcc = {MakeAccount 100}
PaulAcc = {MakeAccount 100}

PeterAcc1 = {MakeAccount 100}
PaulAcc1 = PeterAcc1

% Pitfalls of imperative programming
fun {Factorial N}
   fun {Iter Product Counter}
      if Counter > N then
         Product
      else
         {Iter Counter*Product Counter+1}
      end
   end
in
   {Iter 1 1}
end

fun {Factorial1 N}
   Product = {NewCell 1}
   Counter = {NewCell 1}
   fun {Iter}
      if @Counter > N then
         @Product
      else
         Product := @Counter * @Product
         Counter := @Counter + 1
         {Iter}
      end
   end
in
   {Iter}
end

{Show {Factorial1 5}}

% Exercise 3.7
fun {MakeJoint Acc AccPass NewPass}
   fun {$ M Password}
      if Password == NewPass then
         {Acc M AccPass}
      else
         raise badJointPassword end
      end
   end
end
PeterAcc2 = {MakePasswordAccount 100 "open_sesame"}
PaulAcc2 = {MakeJoint PeterAcc2 "open_sesame" "rosebud"}
{{PeterAcc2 withdraw "open_sesame"} 40}
{{PaulAcc2 withdraw "rosebud"} 20}
{Browse {{PeterAcc2 balance "open_sesame"}}}
{Browse {{PaulAcc2 balance "rosebud"}}}

% Exercise 3.8
fun {Fs}
   State = {NewCell 1}
in
   fun {$ N}
      State := @State * N
      @State
   end
end
Fa = {Fs}
Fb = {Fs}
{Browse {Fa 0} + {Fa 1}}
{Browse {Fb 1} + {Fb 0}}

% 3.2.1 - The Environment Model of Evaluation - The Rules for Evaluation

% Same as above
% fun {Square X} X * X end

Square1 = fun {$ X} X * X end

% 3.2.2 - The Environment Model of Evaluation - Applying Simple Procedures

% fun {Square X} X * X end

fun {SumOfSquares X Y}
   {Square X} + {Square Y}
end

fun {F A}
   {SumOfSquares A+1 A*2}
end

% Exercise 3.9
fun {Factorial2 N}
   if N == 1 then
      1
   else
      N * {Factorial2 N-1}
   end
end
fun {FactIter Product Counter MaxCount}
   if Counter > MaxCount then
      Product
   else
      {FactIter Counter*Product Counter+1 MaxCount}
   end
end
fun {Factorial3 N} {FactIter 1 1 n} end

% 3.2.3 - The Environment Model of Evaluation - Frames as Repository of Local State
fun {MakeWithdraw1 Balance}
   proc {$ Amount}
      if @Balance >= Amount then
         Balance := @Balance - Amount
      else
         raise insufficientFunds(@Balance) end
      end
   end
end

W5 = {MakeWithdraw1 {NewCell 100}}
{W5 50}
W6 = {MakeWithdraw1 {NewCell 100}}

% Exercise 3.10
fun {MakeWithdraw2 InitialAmount}
   Balance = {NewCell InitialAmount}
in
   proc {$ Amount}
      if @Balance >= Amount then
         Balance := @Balance - Amount
      else
         raise insufficientFunds(@Balance) end
      end
   end
end

W7 = {MakeWithdraw2 100}
{W7 50}
W8 = {MakeWithdraw2 100}

% 3.2.4 - The Environment Model of Evaluation - Internal Definitions

% same as in section 1.1.8
fun {Sqrt_3 X}
   fun {GoodEnough Guess}
      {Abs ({Square Guess} - X)} < 0.001
   end
   fun {Improve Guess}
      {Average Guess X/Guess}
   end
   fun {SqrtIter Guess}
      if {GoodEnough Guess} then
         Guess
      else
         {SqrtIter {Improve Guess}}
      end
   end
in
   {SqrtIter 1.0}
end

% Exercise 3.11
fun {MakeAccount1 InitBalance}
   Balance = {NewCell InitBalance}
   proc {Withdraw Amount}
      if @Balance >= Amount then
         Balance := @Balance - Amount
      else
         raise insufficientFunds(@Balance) end
      end
   end
   proc {Deposit Amount}
      Balance := @Balance + Amount
   end
   fun {GetBalance} @Balance end
in
   account(withdraw:Withdraw deposit:Deposit balance:GetBalance)
end
Acc3 = {MakeAccount 50}
{Acc3.deposit 40}
{Acc3.withdraw 60}
Acc4 = {MakeAccount 100}

% 3.3.1 - Modeling with Mutable Data - Mutable List Structure
fun {MCONS X Y} mcons({NewCell X} {NewCell Y}) end

fun {MCAR mcons(X _)} @X end
fun {MCDR mcons(_ Xs)} @Xs end

fun {MCAR_Cell mcons(X _)} X end
fun {MCDR_Cell mcons(_ Xs)} Xs end


proc {SetMCAR mcons(X _) Y} X := Y end
proc {SetMCDR mcons(_ Xs) Ys} Xs := Ys end

% Exercise 3.12
fun {MAppend Xs Ys}
   case Xs
   of mcons(H T) then {MCONS @H {MAppend @T Ys}}
   [] nil then Ys
   end
end

% Exercise 3.12
fun {LastPair Xs}
   case {MCDR Xs}
   of nil then Xs
   [] Tail then {LastPair Tail}
   end
end

fun {MAppend1 Xs Ys}
   {SetMCDR {LastPair Xs} Ys}
   Xs
end

fun {MList Xs}
   {FoldR Xs fun {$ V B} {MCONS V B} end nil}
end

Xm = {MList [a b]}
Ym = {MList [c d]}
Zm = {MAppend1 Xm Ym}

Wx = {MAppend1 Xm Ym}
{Browse Wx}
{Browse Xm}

% Exercise 3.13
fun {MakeCycle Xs}
   {SetMCDR {LastPair Xs} Xs}
    Xs
end
Z = {MakeCycle {MList [a b]}}

% Exercise 3.14
fun {Mystery X}
   fun {Loop X Y}
      if X == nil then
         Y
      else
         local Temp in
            Temp = {MCDR X}
            {SetMCDR X Y}
            {Loop Temp X}
         end
      end
   end
in
   {Loop X {NewCell nil}}
end
Vm = {MList [a b c d]}
Wm = {Mystery Vm}

% Sharing and identity
X = {MList [a b]}
Z1 = {MList [X X]}
Z2 = {MCONS {MList [a b]} {MList [a b]}}

proc {SetToWow X}
   {SetMCAR {MCAR X} "Wow"}
end

{Browse Z1}
{SetToWow Z1}
{Browse Z2}
{SetToWow Z2}

% Exercise 3.16
fun {IsMPair X}
   case X
   of mcons(...) then true
   else false
   end
end
fun {BadCountPairs X}
   if {Not {IsMPair X}} then
      0
   else
      {BadCountPairs {MCAR X}} + {BadCountPairs {MCDR X}} + 1
   end
end
E1 = {MList [a b c]}
{Browse {BadCountPairs E1}}
{SetMCAR {MCDR E1} {MCDR {MCDR E1}}}
{Browse {BadCountPairs E1}}
{SetMCAR E1 {MCDR E1}}
{Browse {BadCountPairs E1}}
% infinite loop
%{SetMCAR E1 E1}
%{Browse {BadCountPairs E1}}

% Exercise 3.17
fun {InList Xs X}
   if {MCAR Xs} == X then
      true
   else
      case {MCDR Xs}
      of nil then false
      [] Tail then {InList Tail X}
      end
   end
end
fun {GoodCountPairs X}
   D = {NewCell {MList [garbage]}}
   fun {Iterate X}
      if {Not {IsMPair X}} then
         0
      elseif {InList @D X} then
         0
      else
         D := {MCONS X @D}
         {Iterate {MCAR X}} + {Iterate {MCDR X}} + 1
      end
   end
in
   {Iterate X}
end
E2 = {MList [a b c]}
{Browse {GoodCountPairs E2}}
{SetMCAR {MCDR E2} {MCDR {MCDR E2}}}
{Browse {GoodCountPairs E2}}
{SetMCAR E2 {MCDR E2}}
{Browse {GoodCountPairs E2}}
{SetMCAR E2 E2}
{Browse {GoodCountPairs E2}}

% Exercise 3.18
fun {HasCycle X}
   D = {NewCell {MList [garbage]}}
   fun {Iterate X}
      if {Not {IsMPair X}} then
         false
      elseif {InList @D X} then
         true
      else
         D := {MCONS X @D}
         {Iterate {MCDR X}}
      end
   end
in
   {Iterate X}
end
E3 = {MList [a b c]}
{Browse {HasCycle E3}}
{SetMCAR {MCDR E3} {MCDR {MCDR E3}}}
{Browse {HasCycle E3}}
{SetMCAR E3 {MCDR E3}}
{Browse {HasCycle E3}}
{SetMCDR E3 E3}
{Browse {HasCycle E3}}

% Exercise 3.19
fun {HasCycle01Space X}
   fun {Iterate Slow Fast}
      if Slow == nil orelse Fast == nil then
         false
      elseif Slow == Fast then
         true
      elseif {MCDR Slow} == nil orelse {MCDR Fast} == nil then
         false
      else
         {Iterate {MCDR Slow} {MCDR {MCDR Fast}}}
      end
   end
in
   if X == nil orelse {MCDR X} == nil then
      false
   else
      {Iterate X {MCDR X}}
   end
end
E4 = {MList [a b c]}
{Browse {HasCycle01Space E4}}
{SetMCAR {MCDR E4} {MCDR {MCDR E4}}}
{Browse {HasCycle01Space E4}}
{SetMCAR E4 {MCDR E4}}
{Browse {HasCycle01Space E4}}
{SetMCDR E4 E4}
{Browse {HasCycle01Space E4}}

% Mutation as assignment
fun {MCONS1 X Y}
   fun {Dispatch M}
      case M
      of car then X
      [] cdr then Y
      end
   end
in
   Dispatch
end
fun {MCAR1 Z} {Z car} end
fun {MCDR1 Z} {Z cdr} end

fun {MCONS2 A B}
   X = {NewCell A}
   Y = {NewCell B}
   proc {SetX V} X := V end
   proc {SetY V} Y := V end
   fun {Dispatch Op}
      case Op
      of mcar then @X
      [] mcdr then @Y
      [] setmcar then SetX
      [] setmcdr then SetY
      end
   end
in
   Dispatch
end

fun {MCAR2 Z} {Z mcar} end
fun {MCDR2 Z} {Z mcdr} end
proc {SetMCAR2 Z V} {{Z setmcar} V} end
proc {SetMCDR2 Z V} {{Z setmcdr} V} end

% Exercise 3.20
X3 = {MCONS2 1 2}
Z3 = {MCONS2 X3 X3}
{SetMCAR2 {MCDR2 Z3} 17}
{Browse {MCAR2 X3}}


% 3.3.2 - Modeling with Mutable Data - Local State Variables
fun {FrontPtr A#B} A end
fun {RearPtr A#B} B end

proc {SetFrontPtr Q=F#R Item} F := Item end
proc {SetRearPtr Q=F#R Item} R := Item end

fun {EmptyQueue Q}
   @{FrontPtr Q} == nil
end

fun {MakeQueue}
   {NewCell nil}#{NewCell nil}
end

fun {FrontQueue Q}
   case @{FrontPtr Q}
   of node(A _) then A
   end
end

proc {InsertQueue Q Item}
   N = node(Item {NewCell nil})
in
   case @{FrontPtr Q}
   of nil then
      {SetFrontPtr Q N}
      {SetRearPtr Q N}
   else
      case @{RearPtr Q}
      of node(_ Nxt) then
         Nxt := N
         {SetRearPtr Q N}
      end
   end
end

fun {DeleteQueue Q}
   case @{FrontPtr Q}
   of node(X Nxt) then
      {SetFrontPtr Q @Nxt}
      X
   end
end

% Exercise 3.21
fun {QueueToList A#_}
   case @A
   of nil then nil
   [] node(X Y) then X|{QueueToList Y#_}
   end
end
proc {PrintQueue Q}
   {Browse {QueueToList Q}}
end
Q1 = {MakeQueue}
{InsertQueue Q1 a}
{InsertQueue Q1 b}
{InsertQueue Q1 c}
{PrintQueue Q1}
{Browse {DeleteQueue Q1}}
{Browse {DeleteQueue Q1}}
{Browse {DeleteQueue Q1}}

% Exercise 3.22
fun {MakeQueue2}
   Front = {NewCell nil}
   Rear = {NewCell nil}
   fun {EmptyQueue} @Front == nil end
   proc {InsertQueue Item}
      N = node(Item {NewCell nil})
   in
      case @Front
      of nil then
         Front := N
         Rear := N
      else
         case @Rear
         of node(_ Nxt) then
            Nxt := N
            Rear := N
         end
      end
   end
   fun {DeleteQueue}
      case @Front
      of node(X Nxt) then
          Front := @Nxt
          X
      end
   end
   fun {QueueToList A}
      case @A
      of nil then nil
      [] node(X Y) then X|{QueueToList Y}
      end
   end
   proc {PrintQueue}
      {Browse {QueueToList Front}}
   end
in
   queue(empty_queue: EmptyQueue
         insert_queue: InsertQueue
         delete_queue: DeleteQueue
         print_queue: PrintQueue)
end
Q2 = {MakeQueue2}
{Q2.insert_queue a}
{Q2.insert_queue b}
{Q2.insert_queue c}
{Q2.print_queue}
{Browse {Q2.delete_queue}}
{Browse {Q2.delete_queue}}
{Browse {Q2.delete_queue}}

% Exercise 3.23
fun {MakeDeque}
   Front = {NewCell nil}
   Rear = {NewCell nil}
   fun {EmptyDeque} @Front == nil orelse @Rear == nil end
   proc {FrontInsertDeque Item}
      N = node(Item {NewCell nil} {NewCell nil})
   in
      case @Front
      of nil then
         Front := N
         Rear := N
      else
         case N
         of node(_ Nxt Prv) then Nxt := @Front
         end
         case @Front
         of node(_ Nxt Prv) then Prv := N
         end
         Front := N
      end
   end
   proc {RearInsertDeque Item}
      N = node(Item {NewCell nil} {NewCell nil})
   in
      if {EmptyDeque} then
         Front := N
         Rear := N
      else
         case N
         of node(_ Nxt Prv) then Prv := @Rear
         end
         case @Rear
         of node(_ Nxt Prv) then Nxt := N
         end
         Rear := N
      end
   end

   fun {FrontDeleteDeque}
      if {EmptyDeque} then raise empty end end
      case @Front
      of node(X Nxt Prv) then
          Front := @Nxt
          Prv := {NewCell nil}
          X
      end
   end
   fun {RearDeleteDeque}
      if {EmptyDeque} then raise empty end end
      case @Rear
      of node(X Nxt Prv) then
          Rear := @Prv
          Nxt := {NewCell nil}
          X
      end
   end
   fun {DequeToList A}
      case @A
      of nil then nil
      [] node(X Y Z) then X|{DequeToList Z}
      end
   end
   proc {PrintDeque}
      {Browse {DequeToList Rear}}
   end
in
   deque(empty_deque: EmptyDeque
         front_insert_deque: FrontInsertDeque
         rear_insert_deque: RearInsertDeque
         front_delete_deque: FrontDeleteDeque
         rear_delete_deque: RearDeleteDeque
         print_deque: PrintDeque)
end
Q3 = {MakeDeque}
{Q3.front_insert_deque a}
{Q3.front_insert_deque b}
{Q3.front_insert_deque c}
{Q3.rear_insert_deque d}
{Q3.rear_insert_deque e}
{Q3.rear_insert_deque f}
{Q3.print_deque}
{Browse {Q3.rear_delete_deque}}
{Browse {Q3.rear_delete_deque}}
{Browse {Q3.rear_delete_deque}}
{Browse {Q3.front_delete_deque}}
{Browse {Q3.front_delete_deque}}
{Browse {Q3.front_delete_deque}}
{Browse {Q3.empty_deque}}

% 3.3.3 - Modeling with Mutable Data - Representing Tables
fun {Assoc Key Rec}
   case Rec
   of tab(Xs) then {Assoc Key @Xs}
   [] leaf then leaf
   [] tree(K V Xs) then
      if Key == K then
         Rec
      else
         {Assoc Key @Xs}
      end
   end
end

fun {Lookup Key Table}
   Record = {Assoc Key Table}
in
   case Record
   of tree(K V _) then some(@V)
   else none
   end
end

proc {Insert Key Value Table}
   Record = {Assoc Key Table}
in
   case Record
   of tree(K V _) then V := Value
   else
      case Table
      of tab(Xs) then Xs := tree(Key {NewCell Value} {NewCell @Xs})
      end
   end
end

fun {MakeTable} tab({NewCell leaf}) end

D3 = {MakeTable}
{Insert abc 123 D3}
{Browse {Lookup abc D3}}

% two-dimensional
fun {Lookup2 Key1 Key2 Table}
   Record = {Assoc Key1 Table}
in
   case Record
   of tree(K1 V _) then {Lookup Key2 @V}
   else none
   end
end

proc {Insert2 Key1 Key2 Value Table}
   Record = {Assoc Key1 Table}
in
   case Record
   of tree(K V _) then {Insert Key2 Value @V}
   else
      case Table
      of tab(Xs) then
         local
            NewTab = {MakeTable}
         in
            {Insert Key2 Value NewTab}
            Xs := tree(Key1 {NewCell NewTab} {NewCell @Xs})
         end
      end
   end
end

D4 = {MakeTable}
{Insert2 abc 123 12.3 D4}
{Browse {Lookup2 abc 123 D4}}

% local tables
DICTIONARY2 =
   functor
   export
      get : Get
      put : Put
   define
      fun {MakeTable} tab({NewCell leaf}) end
      Table = {MakeTable}

      fun {Assoc Key Rec}
         case Rec
         of tab(Xs) then {Assoc Key @Xs}
         [] leaf then leaf
         [] tree(K V Xs) then
            if Key == K then
               Rec
            else
               {Assoc Key @Xs}
            end
         end
      end
      fun {Lookup Key Table}
         Record = {Assoc Key Table}
      in
         case Record
         of tree(K V _) then some(@V)
         else none
         end
      end
      proc {Insert Key Value Table}
         Record = {Assoc Key Table}
      in
         case Record
         of tree(K V _) then V := Value
         else
            case Table
            of tab(Xs) then Xs := tree(Key {NewCell Value} {NewCell @Xs})
            end
         end
      end

      fun {Get Key1 Key2}
         Record = {Assoc Key1 Table}
      in
         case Record
         of tree(K1 V _) then {Lookup Key2 @V}
         else none
         end
      end
      proc {Put Key1 Key2 Value}
         Record = {Assoc Key1 Table}
      in
         case Record
         of tree(K V _) then {Insert Key2 Value @V}
         else
            case Table
            of tab(Xs) then
               local
                  NewTab = {MakeTable}
               in
                  {Insert Key2 Value NewTab}
                  Xs := tree(Key1 {NewCell NewTab} {NewCell @Xs})
               end
            end
         end
      end
   end

[Dictionary2] = {Module.apply [DICTIONARY2]}

{Dictionary2.put abc 123 12.3}
{Browse {Dictionary2.get abc 123}}

% Exercise 3.24
DICTIONARY3 =
   functor
   export
      init : Init
      get  : Get
      put  : Put
   define
      Equals
      Table = tab({NewCell leaf})
      proc {Init Feq}
         Equals = Feq
      end
      fun {Assoc Key Rec}
         case Rec
         of tab(Xs) then {Assoc Key @Xs}
         [] leaf then leaf
         [] tree(K V Xs) then
            if {Equals Key K} then
               Rec
            else
               {Assoc Key @Xs}
            end
         end
      end
      fun {Lookup Key Table}
         Record = {Assoc Key Table}
      in
         case Record
         of tree(K V _) then some(@V)
         else none
         end
      end
      proc {Insert Key Value Table}
         Record = {Assoc Key Table}
      in
         case Record
         of tree(K V _) then V := Value
         else
            case Table
            of tab(Xs) then Xs := tree(Key {NewCell Value} {NewCell @Xs})
            end
         end
      end
      fun {Get Key1 Key2}
         Record = {Assoc Key1 Table}
      in
         case Record
         of tree(K1 V _) then {Lookup Key2 @V}
         else none
         end
      end
      proc {Put Key1 Key2 Value}
         Record = {Assoc Key1 Table}
      in
         case Record
         of tree(K V _) then {Insert Key2 Value @V}
         else
            case Table
            of tab(Xs) then
               local
                  NewTab = {MakeTable}
               in
                  {Insert Key2 Value NewTab}
                  Xs := tree(Key1 {NewCell NewTab} {NewCell @Xs})
               end
            end
         end
      end
   end
[Dictionary3] = {Module.apply [DICTIONARY3]}
{Dictionary3.init fun {$ X Y} X == Y end}
{Dictionary3.put abc 123 12.3}
{Browse {Dictionary3.get abc 123}}

% Exercise 3.25
fun {XEquals X Y}
   case X#Y
   of (Hx|Tx)#(Hy|Ty) andthen Hx == Hy then {XEquals Tx Ty}
   else X == Y
   end
end
[DictionaryX] = {Module.apply [DICTIONARY3]}
{DictionaryX.init XEquals}
{DictionaryX.put [abc def] 123 12.3}
{Browse {DictionaryX.get [abc def] 123}}

% Exercise 3.26
% ToDo - Binary Tree
DICTIONARY4 =
   functor
   %export
   %   init : Init
   %   get  : Get
   %   put  : Put
   define
      Table = tab({NewCell leaf})
      /*
      fun {Assoc Key Rec}
         case Rec
         of tab(Xs) then {Assoc Key @Xs}
         [] leaf then leaf
         [] tree(K V L R) then
            if Key == K then
               Rec
            else
               {Assoc Key @Xs}
            end
         end
      end
      fun {Lookup Key Table}
         Record = {Assoc Key Table}
      in
         case Record
         of tree(K V _) then some(@V)
         else none
         end
      end
      proc {Insert Key Value Table}
         Record = {Assoc Key Table}
      in
         case Record
         of tree(K V _) then V := Value
         else
            case Table
            of tab(Xs) then Xs := tree(Key {NewCell Value} {NewCell @Xs})
            end
         end
      end
      fun {Get Key1 Key2}
         Record = {Assoc Key1 Table}
      in
         case Record
         of tree(K1 V _) then {Lookup Key2 @V}
         else none
         end
      end
      proc {Put Key1 Key2 Value}
         Record = {Assoc Key1 Table}
      in
         case Record
         of tree(K V _) then {Insert Key2 Value @V}
         else
            case Table
            of tab(Xs) then
               local
                  NewTab = {MakeTable}
               in
                  {Insert Key2 Value NewTab}
                  Xs := tree(Key1 {NewCell NewTab} {NewCell @Xs})
               end
            end
         end
      end
      */
   end
[Dictionary4] = {Module.apply [DICTIONARY4]}
%{Dictionary4.init fun {$ X Y} X == Y end}
%{Dictionary4.put abc 123 12.3}
%{Browse {Dictionary4.get abc 123}}

      {Application.exit 0}

% Exercise 3.27
fun {Fib N}
   case N
   of 0 then 0
   [] 1 then 1
   else {Fib N-1} + {Fib N-2}
   end
end

local
   Table = {MakeTable}
in
   fun {Memoize F X}
      local
         PreviouslyComputedResult = {Lookup X Table}
      in
         case PreviouslyComputedResult
         of some(Item) then Item
         [] none then
            local
               Result = {F X}
            in
               {Insert X Result Table}
               Result
            end
         end
      end
   end
end

fun {MemoFib N}
   fun {Fib N}
      case N
      of 0 then 0
      [] 1 then 1
      else {MemoFib N-1} + {MemoFib N-2}
      end
   end
in
   {Memoize Fib N}
end

{Browse {MemoFib 10}}

% 3.3.4 - Modeling with Mutable Data - A Simulator for Digital Circuits
proc {CallEach L}
   case L
   of nil then skip
   [] P|Ps then
      {P}
      {CallEach Ps}
   end
end

fun {GetSignal Wire} {Wire.get_signal} end
proc {SetSignal Wire NewValue} {Wire.set_signal NewValue} end
proc {AddAction Wire ActionProcedure} {Wire.add_action ActionProcedure} end

fun {MakeWire}
   SignalValue = {NewCell lo}
   ActionProcedures = {NewCell nil}
   proc {SetMySignal NewValue}
      if {Not @SignalValue == NewValue} then
         SignalValue := NewValue
         {CallEach @ActionProcedures}
      else
         skip
      end
   end
   proc {AcceptActionProcedure Proc}
      ActionProcedures := Proc | @ActionProcedures
   end
   fun {GetSignal} @SignalValue end
in
   wire( get_signal : GetSignal
         set_signal : SetMySignal
         add_action : AcceptActionProcedure )
end

fun {LogicalNot S}
   if S == lo then
      hi
   else
      lo
   end
end

fun {LogicalAnd S1 S2}
   if S1 == hi andthen S2 == hi then
      hi
   else
      lo
   end
end

fun {LogicalOr S1 S2}
   if S1 == lo andthen S2 == lo then
      lo
   else
      hi
   end
end

fun {MakeTimeSegment Time Queue} time_segment({NewCell Time} Queue) end
fun {SegmentTime time_segment(Time Queue)} Time end
fun {SegmentQueue time_segment(Time Queue)} Queue end

% agenda is a list of time segments
fun {MakeAgenda} {MCONS {MakeTimeSegment 0 {MakeQueue}} nil} end
fun {CurrentTime Agenda} @{SegmentTime {MCAR Agenda}} end
fun {CurrentTimeRef Agenda} {SegmentTime {MCAR Agenda}} end
proc {SetCurrentTime Agenda Time} {CurrentTimeRef Agenda} := Time end

fun {Segments Agenda} {MCDR Agenda} end
proc {SetSegments Agenda Segments} {SetMCDR Agenda Segments} end
fun {FirstSegment Agenda} {MCAR {Segments Agenda}} end
fun {RestSegments Agenda} {MCDR {Segments Agenda}} end

fun {EmptyAgenda Agenda} {Segments Agenda} == nil end

fun {FirstAgendaItem Agenda}
   if {EmptyAgenda Agenda} then
      raise agenda("Agenda is empty -- FIRST-AGENDA-ITEM") end
   else
      local
         FirstSeg = {FirstSegment Agenda}
      in
         {SetCurrentTime Agenda @{SegmentTime FirstSeg}}
         {FrontQueue {SegmentQueue FirstSeg}}
      end
   end
end

proc {RemoveFirstAgendaItem Agenda}
   Q = {SegmentQueue {FirstSegment Agenda}}
in
   _ = {DeleteQueue Q}
   if {EmptyQueue Q} then
      {SetSegments Agenda {RestSegments Agenda}}
   else
      skip
   end
end

proc {AddToAgenda Time Action Agenda}
   fun {BelongsBefore Segments}
      if Segments == nil then
         true
      else
         Time < @{SegmentTime {MCAR Segments}}
      end
   end
   fun {MakeNewTimeSegment Time Action}
      Q = {MakeQueue}
   in
      {InsertQueue Q Action}
      {MakeTimeSegment Time Q}
   end
   proc {AddToSegments Segments}
      if @{SegmentTime {MCAR Segments}} == Time then
         {InsertQueue {SegmentQueue {MCAR Segments}} Action}
      else
         local
            Rest = {MCDR Segments}
         in
            if {BelongsBefore Rest} then
               {SetMCDR Segments {MCONS {MakeNewTimeSegment Time Action} {MCDR Segments}}}
            else
               {AddToSegments Rest}
            end
         end
      end
   end
   SegmentsX = {Segments Agenda}
in
   if {BelongsBefore SegmentsX} then
      {SetSegments Agenda {MCONS {MakeNewTimeSegment Time Action} SegmentsX}}
   else
      {AddToSegments SegmentsX}
   end
end

TheAgenda = {MakeAgenda}
proc {AfterDelay Delay Action}
   {AddToAgenda Delay+{CurrentTime TheAgenda} Action TheAgenda}
end

InverterDelay = 2
AndGateDelay = 3
OrGateDelay = 5

proc {Inverter Input Output}
   NewValue = {LogicalNot {GetSignal Input}}
   proc {InvertInput}
      {AfterDelay InverterDelay proc {$} {SetSignal Output NewValue} end}
   end
in
   {AddAction Input InvertInput}
end

proc {AndGate A1 A2 Output}
   NewValue = {LogicalAnd {GetSignal A1} {GetSignal A2}}
   proc {AndActionProcedure}
      {AfterDelay AndGateDelay proc {$} {SetSignal Output NewValue} end}
   end
in
   {AddAction A1 AndActionProcedure}
   {AddAction A2 AndActionProcedure}
end

proc {OrGate A1 A2 Output}
   NewValue = {LogicalOr {GetSignal A1} {GetSignal A2}}
   proc {OrActionProcedure}
      {AfterDelay OrGateDelay proc {$} {SetSignal Output NewValue} end}
   end
in
   {AddAction A1 OrActionProcedure}
   {AddAction A2 OrActionProcedure}
end

proc {HalfAdder A B S C}
   D = {MakeWire}
   E = {MakeWire}
in
   {OrGate A B D}
   {AndGate A B C}
   {Inverter C E}
   {AndGate D E S}
end

proc {OrGate1 A1 A2 Output}
   B = {MakeWire}
   C = {MakeWire}
   D = {MakeWire}
in
   {Inverter A1 B}
   {Inverter A2 C}
   {AndGate B C D}
   {Inverter D Output}
end

Aw = {MakeWire}
Bw = {MakeWire}
Cw = {MakeWire}
Dw = {MakeWire}
Ew = {MakeWire}
Sw = {MakeWire}

{OrGate1 Aw Bw Dw}
{AndGate Aw Bw Cw}
{Inverter Cw Ew}
{AndGate Dw Ew Sw}

proc {FullAdder A B Cin Sum Cout}
   S = {MakeWire}
   C1 = {MakeWire}
   C2 = {MakeWire}
in
   {HalfAdder B Cin S C1}
   {HalfAdder A S Sum C2}
   {OrGate C1 C2 Cout}
end

proc {Propagate}
   if {EmptyAgenda TheAgenda} then
      skip
   else
      local
         FirstItem = {FirstAgendaItem TheAgenda}
      in
         {FirstItem}
         {RemoveFirstAgendaItem TheAgenda}
         {Propagate}
      end
   end
end

proc {Probe Name Wire}
   {AddAction
      Wire
      proc {$}
         {Browse Name#" "#{CurrentTime TheAgenda}#"  NewValue = "#{GetSignal Wire}}
      end}
end

% Sample simulation
Input1 = {MakeWire}
Input2 = {MakeWire}
Sum = {MakeWire}
Carry = {MakeWire}

{Probe sum Sum}
{Probe carry Carry}

{HalfAdder Input1 Input2 Sum Carry}
{SetSignal Input1 hi}
{Propagate}

{SetSignal Input2 hi}
{Propagate}

% Exercise 3.28
% ToDo

% Exercise 3.31
% fun {AcceptActionProcedure1 Proc}
%    ActionProcedures := Proc|ActionProcedures
% end


% 3.3.5 - Modeling with Mutable Data - Propagation of Constraints

proc {InformAboutValue Propagator}
   {Propagator.process_new_value}
end

proc {InformAboutNoValue Propagator}
   {Propagator.process_forget_value}
end

fun {HasValue Connector}
   {Connector.has_value}
end

fun {GetValue Connector}
   {Connector.get_value}
end

proc {SetValue Connector NewValue Informant}
   {Connector.set_value NewValue Informant}
end

proc {ForgetValue Connector Retractor}
   {Connector.forget_value Retractor}
end

proc {Connect Connector NewConstraint}
   {Connector.connect NewConstraint}
end

proc {ForEachExcept Except Procedure List}
   proc {Loop L}
      case L
      of nil then skip
      [] H|T then
         if H == Except then
            {Loop T}
         else
            {Procedure H}
            {Loop T}
         end
      end
   end
in
   {Loop List}
end

fun {MakeConnector}
   ValueList = {NewCell nil}
   InformantList = {NewCell nil}
   Constraints = {NewCell nil}
   fun {HasValue} {Not @ValueList==nil} end
   fun {GetValue} @ValueList.1 end
   fun {Informant} @InformantList.1 end
   proc {SetValue NewVal Setter}
      if {Not {HasValue}} then
         ValueList := [NewVal]
         InformantList := [Setter]
         {ForEachExcept Setter InformAboutValue @Constraints}
      else
         if {Not {GetValue} == newval} then
            raise constraint("Contradiction") end
         else
            skip
         end
      end
   end
   proc {ForgetValue Retractor}
      if {Not @InformantList == nil} andthen Retractor == {Informant} then
         InformantList := nil
         ValueList := nil
         {ForEachExcept Retractor InformAboutNoValue @Constraints}
      else
         skip
      end
   end
   proc {Connect NewConstraint}
      if {Not {Member NewConstraint @Constraints}} then
         Constraints := NewConstraint | @Constraints
      else
         skip
      end
      if {HasValue} then
         {InformAboutValue NewConstraint}
      else
         skip
      end
   end
in
   connector( has_value : HasValue
              get_value : GetValue
              set_value : SetValue
              forget_value : ForgetValue
              connect : Connect )
end

proc {Adder A1 A2 Sum}
   Me
   proc {ProcessNewValue}
      if {HasValue A1} andthen {HasValue A2} then
         {SetValue Sum {GetValue A1}+{GetValue A2} Me}
      else
         if {HasValue A1} andthen {HasValue Sum} then
            {SetValue A2 {GetValue Sum}-{GetValue A1} Me}
         else
            if {HasValue A2} andthen {HasValue Sum} then
               {SetValue A1 {GetValue Sum}-{GetValue A2} Me}
            else
               skip
            end
         end
      end
   end
   proc {ProcessForgetValue}
      {ForgetValue Sum Me}
      {ForgetValue A1 Me}
      {ForgetValue A2 Me}
      {ProcessNewValue}
   end
in
   Me = propagator( process_new_value : ProcessNewValue
                    process_forget_value : ProcessForgetValue )
   {Connect A1 Me}
   {Connect A2 Me}
   {Connect Sum Me}
end

proc {Multiplier M1 M2 Product}
   Me
   proc {ProcessNewValue}
      if ({HasValue M1} andthen {GetValue M1} == 0.0) orelse
         ({HasValue M2} andthen {GetValue M2} == 0.0) then
            {SetValue Product 0.0 Me}
      else
         if {HasValue M1} andthen {HasValue M2} then
            {SetValue Product {GetValue M1}*{GetValue M2} Me}
         else
            if {HasValue Product} andthen {HasValue M1} then
               {SetValue M2 {GetValue Product}/{GetValue M1} Me}
            else
               if {HasValue Product} andthen {HasValue M2} then
                  {SetValue M1 {GetValue Product}/{GetValue M2} Me}
               else
                  skip
               end
            end
         end
      end
   end
   proc {ProcessForgetValue}
      {ForgetValue Product Me}
      {ForgetValue M1 Me}
      {ForgetValue M2 Me}
      {ProcessNewValue}
   end
in
   Me = propagator( process_new_value : ProcessNewValue
                    process_forget_value : ProcessForgetValue )
   {Connect M1 Me}
   {Connect M2 Me}
   {Connect Product Me}
end

proc {Constant Value Connector}
   proc {ProcessNewValue}
      raise constraint("Unknown request -- CONSTANT -- process_new_value") end
   end
   fun {ProcessForgetValue}
      raise constraint("Unknown request -- CONSTANT  -- process_forget_value") end
   end
   Me = propagator( process_new_value : ProcessNewValue
                    process_forget_value : ProcessForgetValue )
in
   {Connect Connector Me}
   {SetValue Connector Value Me}
end

proc {ProbeConnector Name Connector}
   proc {PrintProbe Value}
      {Browse "Probe: "#Name#" = "#Value}
   end
   proc {ProcessNewValue}
      {PrintProbe {GetValue Connector}}
   end
   proc {ProcessForgetValue}
      {Browse "Probe: "#Name#" = ?"}
   end
   Me = propagator( process_new_value : ProcessNewValue
                    process_forget_value : ProcessForgetValue )
in
   {Connect Connector Me}
end

User = propagator( process_new_value : proc {$} skip end
                   process_forget_value : proc {$} skip end )

proc {CelsiusFahrenheitConverter C F}
   U = {MakeConnector}
   V = {MakeConnector}
   W = {MakeConnector}
   X = {MakeConnector}
   Y = {MakeConnector}
in
   {Multiplier C W U}
   {Multiplier V X U}
   {Adder V Y F}
   {Constant 9.0 W}
   {Constant 5.0 X}
   {Constant 32.0 Y}
end

Cx = {MakeConnector}
Fx = {MakeConnector}

{CelsiusFahrenheitConverter Cx Fx}

{ProbeConnector 'Celsius temp' Cx}
{ProbeConnector 'Fahrenheit temp' Fx}

{SetValue Cx 100.0 User}
{ForgetValue Cx User}
{SetValue Fx 32.0 User}


% Exercise 3.34
proc {Squarer A B}
   {Multiplier A A B}
end

% Exercise 3.36
Ay = {MakeConnector}
By = {MakeConnector}
{SetValue Ay 10 User}

% Exercise 3.37
% exercise left to reader to define appropriate functions
% proc {CelsiusFahrenheitConverter X}
%    {CPlus {CTimes {CDivide {Cv 9} {Cv 5}} X} Cv 32}
% end
% C = {MakeConnector}
% F = {CelsiusFahrenheitConverter C}
% fun {CPlus X Y}
%    Z = {MakeConnector()
% in
%    {Adder X Y Z}
%    Z
% end


% 3.4.1 - Concurrency: Time Is of the Essence - The Nature of Time in Concurrent Systems

Balance1 = {NewCell 100}

proc {Withdraw1 Amount}
   if @Balance1 >= Amount then
      Balance1 := @Balance1 - Amount
   else
      raise insufficientFunds(@Balance1) end
   end
end

% Exercise 3.38
Balance1 := @Balance1 + 10
Balance1 := @Balance1 - 20
Balance1 := @Balance1 - (@Balance1 div 2)


% 3.4.2 - Concurrency: Time Is of the Essence - Mechanisms for Controlling Concurrency

proc {ParallelExecute F1 F2}
   thread {F1} end
   thread {F2} end
end

X4 = {NewCell 10}
{ParallelExecute proc {$} X4 := @X4 * @X4 end
                 proc {$} X4 := @X4 + 1 end}

% Implementing serializers
fun {MakeMutex} {NewLock} end

fun {MakeSerializer}
   Mutex = {MakeMutex}
in
   fun {$ P}
      lock Mutex then {P} end
   end
end

X5 = {NewCell 10}
S5 = {MakeSerializer}
{ParallelExecute proc {$} _ = {S5 fun {$} X5 := @X5 * @X5 end} end
                 proc {$} _ = {S5 fun {$} X5 := @X5 + 1 end} end}

fun {MakeAccount2 InitBalance}
   Balance = {NewCell InitBalance}
   proc {Withdraw Amount}
      if @Balance >= Amount then
         Balance := @Balance - Amount
      else
         raise insufficientFunds(@Balance) end
      end
   end
   proc {Deposit Amount}
      Balance := @Balance + Amount
   end
   fun {GetBalance} @Balance end
   Lock = {NewLock}
in
   account( withdraw : proc {$ Amount} lock Lock then {Withdraw Amount} end end
            deposit  : proc {$ Amount} lock Lock then {Deposit Amount} end end
            balance  : GetBalance )
end

% Exercise 3.39
X6 = {NewCell 10}
S6 = {MakeSerializer}
{ParallelExecute proc {$} X6 := {S6 fun {$} @X6 * @X6 end} end
                 proc {$} _ = {S6 fun {$} X6 := @X6 + 1 end} end}

% Exercise 3.40
X7 = {NewCell 10}
{ParallelExecute proc {$} X7 := @X7 * @X7 end
                 proc {$} X7 := @X7 * @X7 * @X7 end}

X8 = {NewCell 10}
S8 = {MakeSerializer}
{ParallelExecute proc {$} _ = {S8 fun {$} X8 := @X8 * @X8 end} end
                 proc {$} _ = {S8 fun {$} X8 := @X8 * @X8 * @X8 end} end}

% Exercise 3.41
fun {MakeAccount3 InitBalance}
   Balance = {NewCell InitBalance}
   proc {Withdraw Amount}
      if @Balance >= Amount then
         Balance := @Balance - Amount
      else
         raise insufficientFunds(@Balance) end
      end
   end
   proc {Deposit Amount}
      Balance := @Balance + Amount
   end
   Lock = {NewLock}
in
   account( withdraw : proc {$ Amount} lock Lock then {Withdraw Amount} end end
            deposit  : proc {$ Amount} lock Lock then {Deposit Amount} end end
            balance  : fun {$} lock Lock then @Balance end end )
end


% Exercise 3.42
fun {MakeAccount4 InitBalance}
   Balance = {NewCell InitBalance}
   proc {Withdraw Amount}
      if @Balance >= Amount then
         Balance := @Balance - Amount
      else
         raise insufficientFunds(@Balance) end
      end
   end
   proc {Deposit Amount}
      Balance := @Balance + Amount
   end
   fun {GetBalance} @Balance end
   Lock = {NewLock}
   proc {ProtectedWithdraw Amount} lock Lock then {Withdraw Amount} end end
   proc {ProtectedDeposit Amount} lock Lock then {Deposit Amount} end end
in
   account( withdraw : ProtectedWithdraw
            deposit : ProtectedDeposit
            balance : GetBalance )
end

% Multiple shared resources
fun {MakeAccount5 InitBalance}
   Balance = {NewCell InitBalance}
   proc {Withdraw Amount}
      if @Balance >= Amount then
         Balance := @Balance - Amount
      else
         raise insufficientFunds(@Balance) end
      end
   end
   proc {Deposit Amount}
      Balance := @Balance + Amount
   end
   fun {GetBalance} @Balance end
   Lock = {NewLock}
in
   account( withdraw : Withdraw
            deposit : Deposit
            balance : GetBalance
            serializer : Lock )
end

fun {ExchangeX Account1 Account2}
   Difference = {Account1.balance} - {Account2.balance}
in
   {Account1.withdraw Difference}
   {Account2.deposit Difference}
   Difference
end

fun {Deposit Account Amount}
   S = Account.serializer
   D = Account.deposit
in
   lock S then {D Amount} end
end

fun {SerializedExchange Account1 Account2}
   Serializer1 = Account1.serializer
   Serializer2 = Account2.serializer
in
   lock Serializer1 then
      lock Serializer2 then {ExchangeX Account1 Account2} end
   end
end

% Exercise 3.44
fun {Transfer FromAccount ToAccount Amount}
   {FromAccount.withdraw Amount}
   {ToAccount.deposit Amount}
end

% Exercise 3.45
fun {MakeAccount6 InitBalance}
   proc {Withdraw Amount}
      if @Balance >= Amount then
         Balance := @Balance - Amount
      else
         raise insufficientFunds(@Balance) end
      end
   end
   proc {Deposit Amount}
      Balance := @Balance + Amount
   end
   fun {GetBalance} @Balance end
   Lock = {NewLock}
in
   account( withdraw : proc {$ Amount} lock Lock then {Withdraw Amount} end end
            deposit  : proc {$ Amount} lock Lock then {Deposit Amount} end end
            balance  : GetBalance
            serializer : Lock )
end

fun {Deposit1 Account Amount}
   {Account.deposit Amount}
end


% 3.5.1 - Streams - Streams Are Delayed Lists

fun {SumPrimes A B}
   fun {Iter Count Accum}
      if Count > B then
         Accum
      else
         if {IsPrime Count} then
            {Iter Count+1 Count+Accum}
         else
            {Iter Count+1 Accum}
         end
      end
   end
in
   {Iter A 0}
end

fun {SumPrimes1 A B}
   {FoldR {Filter {EnumerateInterval A B} IsPrime} Number.'+' 0}
end

% {Browse {Filter {EnumerateInterval 10000 1000000} IsPrime}.2.1}

fun {Force A} {Wait A} A end
TheEmptyStream = nil
fun {StreamNull Xs} Xs == TheEmptyStream end
fun lazy {ConsStream X Xs} X | Xs end
fun {StreamCAR Stream} Stream.1 end
fun {StreamCDR Stream} {Force Stream.2} end

fun {StreamRef0 S N}
   if N == 0 then
      S.1
   else
      {StreamRef S.2 N-1}
   end
end
StreamRef = List.take

fun lazy {StreamMap L Proc}
   case L
   of nil then nil
   [] H|T then {Proc H} | {StreamMap T Proc}
   end
end

fun lazy {StreamForEach L Proc}
   case L
   of nil then nil
   [] H|T then
      {Proc H}
      {StreamForEach T Proc}
   end
end

proc {DisplayLine X}
   {Browse X}
end

proc {DisplayStream S}
   _ = {StreamForEach S DisplayLine}
end

fun lazy {StreamEnumerateInterval Low High}
   if Low > High then
      nil
   else
      Low | {StreamEnumerateInterval Low+1 High}
   end
end

fun lazy {StreamFilter L Pred}
   case L
   of nil then nil
   [] H|T then
      if {Pred H} then
         H | {StreamFilter T Pred}
      else
         {StreamFilter T Pred}
      end
   end
end

{Browse {StreamFilter {StreamEnumerateInterval 10000 1000000} IsPrime}.2.1}

fun {MemoProc Proc}
   AlreadyRun = {NewCell false}
   Result
in
   fun {$}
      if {Not @AlreadyRun} then
         AlreadyRun := true
         Result = {Proc}
         Result
      else
         Result
      end
   end
end

% Exercise 3.51
fun {ShowX X}
   {Browse X}
   X
end
X9 = {StreamMap {StreamEnumerateInterval 0 10} ShowX}
_ = {List.take X9 5}
_ = {List.take X9 7}

% Exercise 3.52
Sum1 = {NewCell 0}

fun {Accum X}
   Sum1 := @Sum1 + X
   @Sum1
end

Seq = {StreamMap {StreamEnumerateInterval 1 20} Accum}
Ya = {StreamFilter Seq IsEven}
Za = {StreamFilter Seq fun {$ X} X mod 5 == 0 end}

_ = {List.take Ya 7}
{DisplayStream Za}


% 3.5.2 - Streams - Infinite Streams
fun lazy {IntegersStartingFrom N}
   N | {IntegersStartingFrom N+1}
end

Integers = {IntegersStartingFrom 1}

fun {IsDivisible X Y} X mod Y == 0 end

NoSevens = {StreamFilter Integers fun {$ X} {Not {IsDivisible X 7}} end}

{Browse {List.take NoSevens 100}}

fun lazy {FibGen A B}
   A | {FibGen B A+B}
end

Fibs = {FibGen 0 1}

fun lazy {Sieve Stream}
   Stream.1 |
   {Sieve
      {StreamFilter
         Stream.2
         fun {$ X} {Not {IsDivisible X Stream.1}} end}}
end

Primes = {Sieve {IntegersStartingFrom 2}}

{Browse {List.take Primes 10}}

% Defining streams implicitly
fun lazy {OnesGen} 1 | {OnesGen} end
Ones = {OnesGen}

fun lazy {AddStreams L1 L2}
   case L1#L2
   of (X|Xs)#(Y|Ys) then X+Y | {AddStreams Xs Ys}
   end
end

fun lazy {IntegersGen} 1 | {AddStreams Ones {IntegersGen}} end
Integers1 = {IntegersGen}

fun lazy {FibsGen} 0 | 1 | {AddStreams {FibsGen}.2 {FibsGen}} end
Fibs = {FibsGen}
{Browse {List.take Fibs 10}}

fun {ScaleStream Stream Factor}
   {StreamMap Stream fun {$ X} X * Factor end}
end

fun lazy {DoubleGen} 1 | {ScaleStream {DoubleGen} 2} end
Double = {DoubleGen}
{Browse {List.take Double 10}}

fun {PrimesGen} 2 | {StreamFilter {IntegersStartingFrom 3} IsPrime} end
Primes1 = {PrimesGen}
{Browse {List.take Primes1 10}}

fun {IsPrime1 N}
   fun {Iter Ps}
      if {Square Ps.1} > N then
         true
      else
         if {IsDivisible N Ps.1} then
            false
         else
            {Iter Ps.2}
         end
      end
   end
in
   {Iter Primes}
end

% Exercise 3.53
fun lazy {SGen} 1 | {AddStreams {SGen} {SGen}} end
S = {SGen}

% Exercise 3.56
fun lazy {MergeX L1 L2}
   case L1#L2
   of nil#_ then L2
   [] _#nil then L1
   else
      local
         L1car = L1.1
         L2car = L2.1
      in
         if L1car < L2car then
            L1car | {MergeX L1.2 L2}
         else
            if L1car > L2car then
               L2car | {MergeX L1 L2.2}
            else
               L1car | {MergeX L1.2 L2.2}
            end
         end
      end
   end
end

% Exercise 3.58
fun lazy {Expand Num Den Radix}
   ((Num * Radix) div Den) |
      {Expand ((Num * Radix) mod Den) Den Radix}
end

% Exercise 3.59
% exercise left to reader to define appropriate functions
%   fun lazy {ExpSeriesGen} 1 | {IntegrateSeries ExpSeriesGen} end
%   Gen = {ExpSeriesGen}


% 3.5.3 - Streams - Exploiting the Stream Paradigm
fun {SqrtImprove Guess X}
  {Average Guess X/Guess}
end

fun {SqrtStream X}
   fun lazy {GuessesGen}
      1.0 | {StreamMap {GuessesGen} fun {$ Guess} {SqrtImprove Guess X} end}
   end
in
   {GuessesGen}
end

{Browse {List.take {SqrtStream 2.0} 5}}

fun lazy {AddStreamsReal L1 L2}
   case L1#L2
   of (X|Xs)#(Y|Ys) then X+Y | {AddStreamsReal Xs Ys}
   end
end

fun lazy {PartialSums A}
   A.1 | {AddStreamsReal {PartialSums A} A.2}
end
fun {ScaleStreamReal Stream Factor}
   {StreamMap Stream fun {$ X} X * Factor end}
end

fun lazy {PiSummands N}
   1.0/{IntToFloat N} | {StreamMap {PiSummands N+2} fun {$ X} 0.0 - X end}
end

fun {PiStreamGen} {ScaleStreamReal {PartialSums {PiSummands 1}} 4.0} end
PiStream = {PiStreamGen}

{Browse {List.take PiStream 5}}

fun lazy {EulerTransform S}
   S0 = {Nth S 1}
   S1 = {Nth S 2}
   S2 = {Nth S 3}
in
   (S2 - {Square S2-S1} / (S0 + (~2.0 * S1) + S2)) | {EulerTransform S.2}
end

{Browse {List.take {EulerTransform PiStream} 8}}

fun lazy {MakeTableau S Transform} S | {MakeTableau {Transform S} Transform} end

fun {AcceleratedSequence S Transform}
   {StreamMap {MakeTableau S Transform} fun {$ L} L.1 end}
end

{Browse {List.take {AcceleratedSequence PiStream EulerTransform} 8}}

% Exercise 3.63
fun lazy {SqrtStream1 X}
   1.0 | {StreamMap {SqrtStream1 X} fun {$ Guess} {SqrtImprove Guess X} end}
end

% Exercise 3.64
% exercise left to reader to define appropriate functions
%   fun {Sqrt X Tolerance}
%      {StreamLimit {SqrtStream X} Tolerance}
%   end

% Infinite streams of pairs
fun lazy {StreamAppend L1 L2}
   case L1
   of nil then L2
   [] H|T then H | {StreamAppend T L2}
   end
end

fun lazy {Interleave L1 L2}
   case L1
   of nil then L2
   [] H|T then H | {Interleave L2 T}
   end
end

fun lazy {Pairs S T}
   [S.1 T.1] | {Interleave {StreamMap T.2 fun {$ X} [S.1 X] end} {Pairs S.2 T.2}}
end

{Browse {List.take {Pairs Integers Integers} 10}}

IntPairs = {Pairs Integers Integers}

fun lazy {SopGen} {StreamFilter IntPairs fun {$ Pair} {IsPrime Pair.1 + Pair.2.1} end} end

% Exercise 3.68
fun lazy {Pairs1 S T}
   {Interleave
      {StreamMap T fun {$ X} [S.1 X] end}
      {Pairs S.2 T.2}}
end
{Browse {List.take {Pairs1 Integers Integers} 10}}

% Streams as signals
fun {Integral Integrand InitialValue Dt}
   fun lazy {IntGen} InitialValue | {AddStreamsReal {ScaleStreamReal Integrand Dt} {IntGen}} end
in
   {IntGen}
end

% Exercise 3.74
% exercise left to reader to define appropriate functions
%  fun lazy {MakeZeroCrossings InputStream LastValue}
%     {SignChangeDetector InputStream.1 LastValue} |
%        {MakeZeroCrossings InputStream.2 InputStream.2}
%  end
%  ZeroCrossings = {MakeZeroCrossings SenseData 0}

% Exercise 3.75
% exercise left to reader to define appropriate functions
%  fun lazy make_zero_crossings (input_stream, last_value) =
%     Avpt = (InputStream.1 + LastValue) / 2.0
%  in
%     {SignChangeDetector Avpt LastValue) |
%        {MakeZeroCrossings InputStream.2 Avpt}
%  end


% 3.5.4 - Streams - Streams and Delayed Evaluation

% Note: I don't know if these are working?

fun {Solve1 F Y0 Dt}
   Dy
   Y = {Integral Dy Y0 Dt}
in
   Dy = {StreamMap Y F}
   Y
end

fun {Integral2 DelayedIntegrand InitialValue Dt}
   Integrand = {Force DelayedIntegrand}
   fun lazy {IntGen} InitialValue | {AddStreamsReal {ScaleStreamReal Integrand Dt} {IntGen}} end
in
   {IntGen}
end

fun {Solve2 F Y0 Dt}
   Dy
   Y = {Integral2 Dy Y0 Dt}
in
   Dy = {StreamMap Y F}
   Y
end
% {Browse {Force {Nth {Solve1 fun {$ Y} Y end 1.0 0.001} 1000}}}

% Exercise 3.77
fun lazy {Integral3 Integrand InitialValue Dt}
   InitialValue |
      if Integrand == nil then
         nil
      else
         {Integral Integrand.2 (Dt*Integrand.1)+InitialValue Dt}
      end
end

% 3.5.5 - Streams - Modularity of Functional Programs and Modularity of Objects
% same as in section 3.1.2
fun {Rand1}
   X = RandomInit
in
   X := {RandUpdate @X}
   @X
end

fun lazy {RandomNumbersGen}
   @RandomInit | {StreamMap {RandomNumbersGen} RandUpdate}
end
RandomNumbers = {RandomNumbersGen}

fun lazy {MapSuccessivePairs S F}
   {F S.1 S.2.1} | {MapSuccessivePairs S.2.2 F}
end

CesaroStream =
   {MapSuccessivePairs RandomNumbers fun {$ R1 R2} {Gcd R1 R2} == 1 end}

fun lazy {MonteCarlo1 ExperimentStream Passed Failed}
   fun {Next Passed Failed}
      {IntToFloat Passed} / {IntToFloat Passed+Failed} |
         {MonteCarlo1 ExperimentStream.2 Passed Failed}
   end
in
   if ExperimentStream.1 then
      {Next Passed+1 Failed}
   else
      {Next Passed Failed+1}
   end
end

Pi = {StreamMap {MonteCarlo1 CesaroStream 0 0} fun {$ P} {Sqrt 6.0/P} end}
{Wait {List.take Pi 10}}
{Browse Pi}

% same as in section 3.1.3
fun {MakeSimplifiedWithdraw1 Balance}
   fun {$ Amount}
      Balance := @Balance - Amount
      @Balance
   end
end

fun lazy {StreamWithdraw Balance AmountStream}
   Balance | {StreamWithdraw Balance-AmountStream.1 AmountStream.2}
end