%
% Higher-Order Programming
%

%SumList
declare
fun {FoldFactory F U}
   fun {FoldR L F U}
      case L
      of nil then U
      []  X|L2 then {F X  {FoldR L2 F U}}
      end
   end
in
   fun {$ L} {FoldR L F U} end
end

declare
SumList={FoldFactory fun {$ A B} A+B end 0}
{Browse {SumList [1 2 3]}}

%for I in 1..10 do {Browse I} 
declare
proc {For I J P}
   if I >= J then skip
   else {P I} {For I+1 J P}
   end
end
{For 1 10 Browse}

%
declare
proc {ForAll Xs P}
   case Xs
   of nil then skip
   [] X|Xr then
      {P X} {ForAll Xr P}
   end
end
{ForAll [m n s t]
 proc{$ I} {System.showInfo "the item is: " # I} end}

declare 
for I in [a b c d] do
   {System.showInfo "the item is: " # I}
end

%map
declare
fun {Map Xs F}
   case Xs
   of nil then nil
   [] X|Xr then
      {F X}|{Map Xr F}
   end
end
{Browse {Map [1 2 3 4] fun {$ I} I*I end}}

%filter
declare
fun {Filter Xs P}
   case Xs
   of nil then nil
   [] X|Xr andthen {P X} then
      X|{Filter Xr P}
   [] X|Xr then {Filter Xr P}
   end
end
{Browse {Filter [1 2 3 4] fun {$ A} A<3 end}}

%DFS tree
declare
proc {DFS Tree F}
   case Tree of tree(node:N sons:Sons ...) then
      {F N}
      for T in Sons do {DFS T F} end
   end
end
T=tree(node:1 sons:[tree(node:2 sons:nil) tree(node:3 sons:[tree(node:4 sons:nil)])])
{DFS T Browse}

%
declare
fun {FoldL Xs F U}
   case Xs
   of nil then U
   [] X|Xr then {FoldL Xr F {F X U}}
   end
end
{Browse {FoldL [1 2 3]
	 fun {$ X Y} X|Y end nil}}


%
% Abstract Data Types
%

% A Stack ADT using lists (open, declarative, unbundled)

declare NewStack Push Pop IsEmpty in
fun {NewStack} nil end
fun {Push S E} E|S end
fun {Pop S E} case S of  X|S1 then E = X  S1 end end
fun {IsEmpty S} S==nil end

local S1 S2 V in
   S1 = {Push {Push {NewStack} 1} 2}
   {Browse S1}
   S2 = {Pop S1 V}
   {Browse V}
   {Browse S2}
   case S2 of H|T then {Browse H} end % misuse of ABSTRACT data type;
                                      % will not work with record representation.
end

% Another Stack ADT Implementation using records
declare NewStack Push Pop IsEmpty in
fun {NewStack} emptyStack end
fun {Push S E} stack(E S) end
fun {Pop S E} case S of stack(X S1) then E = X S1 end end
fun {IsEmpty S} S==emptyStack end

local S1 S2 V in
   S1 = {Push {Push {NewStack} 1} 2}
   {Browse S1}
   S2 = {Pop S1 V}
   {Browse V}
   {Browse S2}
end

% A wrapper/unwrapper implementation using higher-order programming
declare NewWrapper in
proc {NewWrapper ?Wrap ?Unwrap} 
   	Key={NewName} 
in 
   	fun {Wrap X} 
            fun {$ K} if K==Key then X end end
   	end 
   	fun {Unwrap C} 
            {C Key}
  	end 
end

% A secure declarative unbundled Stack
declare NewStack Push Pop IsEmpty in
local Wrap Unwrap in
	{NewWrapper Wrap Unwrap}
	fun {NewStack} {Wrap nil} end
	fun {Push S E} {Wrap E|{Unwrap S}} end
	fun {Pop S E}
		case {Unwrap S} of X|S1 then E=X  {Wrap S1} end
	end
	fun {IsEmpty S} {Unwrap S}==nil end
end

local S1 S2 V in
   S1 = {Push {Push {NewStack} 1} 2}
   {Browse S1}
   S2 = {Pop S1 V}
   {Browse V}
   {Browse S2}
end

% A wrapper/unwrapper implementation using chunks (restricted records)
declare NewWrapper in
proc {NewWrapper ?Wrap ?Unwrap} 
   Key={NewName} 
in 
   fun {Wrap X} 
      {NewChunk foo(Key:X)} 
   end 
   fun {Unwrap C} 
      C.Key 
   end 
end

declare NewStack Push Pop IsEmpty in
local Wrap Unwrap in
	{NewWrapper Wrap Unwrap}
	fun {NewStack} {Wrap nil} end
	fun {Push S E} {Wrap E|{Unwrap S}} end
	fun {Pop S E}
		case {Unwrap S} of X|S1 then E=X  {Wrap S1} end
	end
	fun {IsEmpty S} {Unwrap S}==nil end
end

local S1 S2 V in
   S1 = {Push {Push {NewStack} 1} 2}
   {Browse S1}
   S2 = {Pop S1 V}
   {Browse V}
   {Browse S2}
end

% exercise:  write a secure Stack implementation using chunks directly

% A wrapper/unwrapper implementation using ONLY higher-order programming
% courtesy of Jason Laporte
declare NewWrapper in
proc {NewWrapper ?Wrap ?Unwrap} 
   	Key=fun {$} 0 end
in 
   	fun {Wrap X} 
            fun {$ K} if K==Key then X end end
   	end 
   	fun {Unwrap C} 
            {C Key}
  	end 
end

declare NewStack Push Pop IsEmpty in
local Wrap Unwrap in
	{NewWrapper Wrap Unwrap}
	fun {NewStack} {Wrap nil} end
	fun {Push S E} {Wrap E|{Unwrap S}} end
	fun {Pop S E}
		case {Unwrap S} of X|S1 then E=X  {Wrap S1} end
	end
	fun {IsEmpty S} {Unwrap S}==nil end
end

local S1 S2 V in
   S1 = {Push {Push {NewStack} 1} 2}
   {Browse S1}
   S2 = {Pop S1 V}
   {Browse V}
   {Browse S2}
end