-- Comparative example of the call-by-ref pattern
-- Sergio Antoy and Michael Hanus
-- Mon Apr 18 13:07:40 PDT 2011


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

------------------------------------------------------------------
-- 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

emptyTable = []

test = if insert ("x",1) emptyTable t1 &&
          insert ("y",2) t1 t2 &&
          remove "z" t2 t3 then t3
       else error "Oops"
       where t1, t2, t3 free

-- ===============================================================
-- 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
                                       else error "Oops"
                               else error "Oops"
                  else error "Oops"

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

mtest = pinsert ("x",1) emptyTable `op` 
        pinsert ("y",2) `op` 
        premove "x" $ (\(t,b) -> if b then t else error "Oops")

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