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

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

module CoreLittleStepTest where
import CoreLangParser
import CoreTypeHelpers
import CoreTyping
import CoreLittleStep
import Domains
import CoreLangProgs
import Testing

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


config_listC :: (ATree Command, DStore) -> [(ATree Command, DStore)]
config_listC config@(com ::: atr, stor)
   | terminalC com = [config]
   | otherwise = config : config_listC (stepC config)

config_listE :: (ATree Expression, DStore) -> [(ATree Expression, DStore)]
config_listE config@(exp ::: atr, stor)
   | terminalE exp = [config]
   | otherwise = config : config_listE (stepE config)


repC :: String -> IO ()
repC input =
   let c = read input
       (Tree_Subst (ca@(_ ::: Node atr _)) _) = annotate c
   in if atr == Aerr
      then putStrLn "type error"
      else let initial_config = (ca, sample_store)
               configs = config_listC initial_config
           in mapM_ putStrLn (connectWith arrow (map show configs))

repE :: String -> IO ()
repE input =
   let e = read input
       (Tree_Subst (ea@(_ ::: Node atr _)) _) = annotate e
   in if atr == Aerr
      then putStrLn "type error"
      else let initial_config = (ea, sample_store)
               configs = config_listE initial_config
           in mapM_ putStrLn (connectWith arrow (map show configs))

arrow = "==> "

connectWith  :: [a] -> [[a]] -> [[a]]
connectWith conn []       = []
connectWith conn [x]      = [x]
connectWith conn (x:xs)   = x : map (\x1 -> conn ++ x1) xs


test n = repC (prog n)


runC :: String -> DStore
runC input =
   let c = read input
       (Tree_Subst (ca@(_ ::: Node atr _)) _) = annotate c
   in if atr == Aerr
      then error "type error"
      else let initial_config = (ca, sample_store)
               configs = config_listC initial_config
           in snd (last configs)


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