-- Comparative example of the call-by-ref pattern
-- Sergio Antoy and Michael Hanus
-- Mon Apr 18 13:07:40 PDT 2011
-- updated Wed Jul  5 12:29:32 PDT 2017

import Test.EasyCheck
-- execute with: curry check state

-- a Record maps a key to a value
type Record = (String,Int)
-- a Symbol Table is a sequence of Records
type Table = [Record]

emptyTable = []

------------------------------------------------------------------
-- Call-by-ref approach

-- insert a Record in a table that must NOT contain the key
insert :: Record -> Table -> Table -> Bool
insert (s,v) [] x = x =:= [(s,v)] &> True
insert (s,v) ((w,z):t) x | s == w = x =:= (w,z):t &> False
                         | otherwise = let b = insert (s,v) t t'
                                        in x =:= (w,z):t' &> b  where t' free

-- remove a Record from a table that must contain the key
remove :: String -> Table -> Table -> Bool
remove _ [] [] = False
remove s ((w,z):t) x | s == w = x =:= t &> True
                     | otherwise = let b = remove s t t'
                                    in x =:= (w,z):t' &> b  where t' free

------------------------------------------------------------------
-- Usage

test10 = let r1 = insert ("x",1) emptyTable t1
             r2 = insert ("y",2) t1 t2
             r3 = remove "z" t2 t3
             t1, t2, t3 free
	 in [r1,r2,r3] == [True,True,False] &>
	    t3 -=- [("x",1),("y",2)]

test11 = let r1 = insert ("x",1) emptyTable t1
             r2 = insert ("x",2) t1 t2
             r3 = remove "x" t2 t3
             t1, t2, t3 free
	 in [r1,r2,r3] == [True,False,True] &>
	    t3 -=- emptyTable
	    
-- ===============================================================
-- These are presented for comparison only.
-- They are no part of the pattern
-- ===============================================================

-- Approach using a structure holding several values

pinsert :: Record -> Table -> (Table,Bool)
pinsert (s,v) [] = ([(s,v)],True)
pinsert (s,v) ((w,z):t) 
  | s == w = ((w,z):t,False)
  | otherwise = let (t',b) = pinsert (s,v) t
                in ((w,z):t',b)

premove :: String -> Table -> (Table,Bool) 
premove _ [] = ([],False)
premove s ((w,z):t)
  | s == w = (t,True)
  | otherwise = let (t',b) = premove s t 
                in ((w,z):t',b)

ptest = let (t1,b1) = pinsert ("x",1) emptyTable
        in if b1 then let (t2,b2) = pinsert ("y",2) t1
                      in if b2 then let (t3,b3) = premove "x" t2
                                    in if b3 then t3 -=- [("y",2)]
                                       else error "Oops"
                               else error "Oops"
                  else error "Oops"

------------------------------------------------------------------
-- Execution in monadic style

ptest2 = pinsert ("x",1) emptyTable `op` 
         pinsert ("y",2) `op` 
         premove "x" `op`
	 id

op :: (a,Bool) -> (a -> b) -> b
op (t,b) f     = if b then f t else error "Oops"