MainIO.hs

module MainIO where

import Prelude
import Monad
import System
import StrategyLib
import ParseLib
import Datatypes
import Parser
import Instance



--- Main function for I/O and transformation ---------------------------------

mainIO f1 f2
  = do {
         str          <- readFile f1;
         (trafo,prog) <- pApply parseTestFile str;
         prog'        <- tApply trafo prog;
         str'         <- (return.show) prog';
         writeFile f2 str'
       }



--- Parsing transformation scripts -------------------------------------------

parseTestFile :: Parser (TrafoJoos, Program)
parseTestFile = do {
                  td <- parseTrafoDeclaration;
                  parseSymbol "in";
                  prog <- parseProgram;
                  return (td,prog)
                }


parseTrafoDeclaration :: Parser TrafoJoos
parseTrafoDeclaration =
 do { parseSymbol "declare";
      md <- parseMethodDecl;
      return (introduceJoos md)
    }
 +++
 do { parseSymbol "eliminate";
      return eliminateJoos
    }
 +++
 do { parseSymbol "extract";
      i <- parseIdentifier;
      return (extractJoos i)
    }


--- Report on result of parsing ----------------------------------------------

pApply p s
  = case okParses of
      []     -> Monad.fail "ERROR: parsing failed!!\n"
      [x]    -> putStrLn "Status: successful parse." >> return (fst x)
      (x:xs) -> putStrLn "WARNING: ambiguous parse." >> return (fst x)
    where okParses = filter (null.snd) (papply p s)



--- Report on result of transformation ---------------------------------------

tApply trafo prog
 =
   case trafo prog of
    Nothing    -> putStrLn "WARNING: refactoring failed."    >> return prog
    Just prog' -> putStrLn "Status: successful refactoring." >> return prog' 



--- Illustrative code for focus selection  -----------------------------------

selectStatement :: Term t => t -> Maybe Statement
selectStatement =  applyTU selectStatementStrategy
  where
    selectStatementStrategy :: TU Statement Maybe
    selectStatementStrategy =  
      (adhocTU failTU 
               (\stat -> case stat of
                           StatementFocus stat' -> Just stat'
                           _                    -> Nothing))
      `choiceTU`
      oneTU selectStatementStrategy

------------------------------------------------------------------------------

selectStatement' :: Term t => t -> Maybe Statement
selectStatement' =  selectFocus unwrapStatememt
 where
  unwrapStatememt (StatementFocus stat') = Just stat'
  unwrapStatememt _ = Nothing

------------------------------------------------------------------------------