-- $Id: CoreMonadTest.hs,v 1.4 2004/10/18 23:47:48 leavens Exp leavens $

-- Gary T. Leavens
-- Semantic testing for the language of Chapter 1

module CoreMonadTest where
import CoreLangParser
import CoreTypeHelpers
import CoreTyping
import MonadStore
import CoreMonadSemantics
import Domains
import CoreLangProgs
import Testing

sample_store :: DStore
sample_store = [1..10]


showValSample :: Show a => MStore a -> String
showValSample m = show (runForVal m sample_store)

showStoreSample :: Show a => MStore a -> String
showStoreSample m = show (runForStore m sample_store)


runForVal :: MStore a -> DStore -> a
runForVal (Store f) s0 = let (v, _) = f s0
                         in v

runForStore :: MStore a -> DStore -> DStore
runForStore (Store f) s0 = let (_, s) = f s0
                           in s


evalC :: Command -> String
evalC c = let (Tree_Subst (ca@(_ ::: Node atr _)) _) = annotate c
          in if atr == Aerr
             then "type error"
             else showStoreSample (meaningC ca)
evalE :: Expression -> String
evalE e = let (Tree_Subst (ea@(_ ::: Node atr _)) _) = annotate e
          in if atr == Aerr
             then "type error"
             else showValSample (meaningE ea)


repC :: String -> IO ()
repC = putStrLn . evalC . read
repE :: String -> IO ()
repE = putStrLn . evalE . read


test n = repC (prog n)


runC :: String -> DStore
runC c = let (Tree_Subst (ca@(_ ::: Node atr _)) _) = annotate (read c)
         in runForStore (meaningC ca) sample_store


tests :: [TestCase DStore DStore]
tests = map (\(c,m) -> eqTest c (runC c) (m sample_store)) progs_with_results

-- The following runs all the test programs

go :: IO ()
go = run_tests tests