-- extra data definitions avoid recursive types

data Table4 = Table4 (Table COMPUTATION4)

openT4 (Table4 t) = t
closeT4 t = Table4 t

data Heap4 = Heap4 (Heap COMPUTATION4)

openH4 (Heap4 h) = h
closeH4 h = Heap4 h

data Function4 = Function4 (COMPUTATION4 -> COMPUTATION4)

openF4 (Function4 f) = f
closeF4 f = Function4 f

-- some extra instances have to be defined

instance Initial Table4 where
  initial = closeT4 initial
  
instance EnvMonad (Table COMPUTATION4) COMPUTE4 where
 read = map openT4 read 
 with = with . closeT4  

instance Initial Heap4 where
  initial = closeH4 initial
  
instance StateMonad (Heap COMPUTATION4) COMPUTE4 where
  act f = map openH4 (act (closeH4 . f . openH4))
  
instance SubType (COMPUTATION4 -> COMPUTATION4) VALUE4 where
  inj = inj . closeF4 
  prj = openF4 . prj 

-- extra Write instances

instance Write x => Write (Heap4,x) where
  write (_,x) = write x

instance Write Function4 where
  write _ = put "<function>"
  
-- SYNTAX4

type STRUCT4 = S SUM  F -- Functions
              (S SUM  V -- Variables
              (S SUM  L -- Non-Determinism (Lists)
              (S SUM  B -- Boolean operators
              (O ONLY N -- Numeric operators
              ))))

type SYNTAX4 = REC STRUCT4

-- VALUE4

type VALUE4 =  SUM Function4
	      (SUM Bool
	     (ONLY Int)) 

-- COMPUTE4

{-

type COMPUTE4 = StateT Heap4
               (EnvT   Table4
               (ErrT   List)) 

-}

type COMPUTE4 = EnvT   Table4
               (StateT Heap4
               (ErrT   List))           
 
-- SEMANTICS4

type SEMANTICS4 = COMPUTATION4
        
type COMPUTATION4 = COMPUTE4 VALUE4  

-- driver

parser4 :: TheParser SYNTAX4
parser4 = do { blanks ; parser }

parseWith4 :: (SYNTAX4 -> IO ()) -> [Char] -> IO ()
parseWith4 cont = parser4 `invokeWith` cont

unparse4 :: SYNTAX4 -> IO ()
unparse4 = fold

interpret4 :: SYNTAX4 -> SEMANTICS4
interpret4 = fold

run4 :: SEMANTICS4 -> IO ()
run4 = runIO

main4 :: IO ()
main4 = driver "4> " parseWith4 unparse4 interpret4 run4







