-- extra data definitions avoid recursive types

data Table6 = Table6 (Table COMPUTATION6)

openT6 (Table6 t) = t
closeT6 t = Table6 t

data Heap6 = Heap6 (Heap COMPUTATION6)

openH6 (Heap6 h) = h
closeH6 h = Heap6 h

data Function6 = Function6 (COMPUTATION6 -> COMPUTATION6)

openF6 (Function6 f) = f
closeF6 f = Function6 f

-- some extra instances have to be defined

instance Initial Table6 where
  initial = closeT6 initial
  
instance EnvMonad (Table COMPUTATION6) COMPUTE6 where
 read = map openT6 read 
 with = with . closeT6  

instance Initial Heap6 where
  initial = closeH6 initial
  
instance StateMonad (Heap COMPUTATION6) COMPUTE6 where
  act f = map openH6 (act (closeH6 . f . openH6))
  
instance SubType (COMPUTATION6 -> COMPUTATION6) VALUE6 where
  inj = inj . closeF6 
  prj = openF6 . prj 

-- extra Write instances

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

instance Write Function6 where
  write _ = put "<function>"
 
-- SYNTAX6

type STRUCT6 = S SUM  T -- Trace info
              (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 SYNTAX6 = REC STRUCT6

-- VALUE6

type VALUE6 =  SUM Function6
	      (SUM Bool
	     (ONLY Int)) 

-- COMPUTE6

type COMPUTE6 = StateT Heap6
               (StateT Level
               (EnvT   Table6
               (GenT   (IO ())
               (ErrT   List))))

{-

type COMPUTE6 = EnvT   Table6
               (StateT Heap6
               (StateT Level
               (GenT   (IO ())
               (ErrT   List))))

-}
       
-- SEMANTICS6

type SEMANTICS6 = COMPUTATION6
type COMPUTATION6 = COMPUTE6 VALUE6

-- driver

parser6 :: TheParser SYNTAX6
parser6 = do { blanks ; parser }

parseWith6 :: (SYNTAX6 -> IO ()) -> [Char] -> IO ()
parseWith6 cont = parser6 `invokeWith` cont

unparse6 :: SYNTAX6 -> IO ()
unparse6 = fold

interpret6 :: SYNTAX6 -> SEMANTICS6
interpret6 = fold

run6 :: SEMANTICS6 -> IO ()
run6 = runIO

main6 :: IO ()
main6 = driver "6> " parseWith6 unparse6 interpret6 run6


