-- extra data definitions avoid recursive types

data Table5 = Table5 (Table COMPUTATION5)

openT5 (Table5 t) = t
closeT5 t = Table5 t

data Heap5 = Heap5 (Heap COMPUTATION5)

openH5 (Heap5 h) = h
closeH5 h = Heap5 h

data Function5 = Function5 (COMPUTATION5 -> COMPUTATION5)

openF5 (Function5 f) = f
closeF5 f = Function5 f

-- some extra instances have to be defined

instance Initial Table5 where
  initial = closeT5 initial
  
instance EnvMonad (Table COMPUTATION5) COMPUTE5 where
 read = map openT5 read 
 with = with . closeT5  

instance Initial Heap5 where
  initial = closeH5 initial
  
instance StateMonad (Heap COMPUTATION5) COMPUTE5 where
  act f = map openH5 (act (closeH5 . f . openH5))
  
instance SubType (COMPUTATION5 -> COMPUTATION5) VALUE5 where
  inj = inj . closeF5 
  prj = openF5 . prj 

-- extra Write instances

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

instance Write Function5 where
  write _ = put "<function>"
      
-- SYNTAX5

type STRUCT5 = S SUM  D -- Local definitions
              (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 SYNTAX5 = REC STRUCT5

-- VALUE5

type VALUE5 = SUM Function5
	     (SUM Bool
	    (ONLY Int)) 

-- COMPUTE5

{-

type COMPUTE5 =  EnvT   Table5
                (StateT Heap5
                (ErrT   List))
-}

type COMPUTE5 =  StateT Heap5
                (EnvT   Table5
                (ErrT   List))

-- SEMANTICS5

type SEMANTICS5 = COMPUTATION5

type COMPUTATION5 = COMPUTE5 VALUE5

-- driver

parser5 :: TheParser SYNTAX5
parser5 = do { blanks ; parser }

parseWith5 :: (SYNTAX5 -> IO ()) -> [Char] -> IO ()
parseWith5 cont = parser5 `invokeWith` cont

unparse5 :: SYNTAX5 -> IO ()
unparse5 = fold

interpret5 :: SYNTAX5 -> SEMANTICS5
interpret5 = fold

run5 :: SEMANTICS5 -> IO ()
run5 = runIO

main5 :: IO ()
main5 = driver "5> " parseWith5 unparse5 interpret5 run5


