utils/ext-core/Driver.hs

   1 {- A simple driver that loads, typechecks, prepares, re-typechecks, and interprets the
   2     GHC standard Prelude modules and an application module called Main.
   3
   4    Note that, if compiled under GHC, this requires a very large heap to run!
   5 -}
   6
   7 import Monad
   8 import System.Environment
   9
  10 import Core
  11 import Printer
  12 import Parser
  13 import Lex
  14 import ParseGlue
  15 import Env
  16 import Prims
  17 import Check
  18 import Prep
  19 import Interp
  20
  21 process (senv,modules) f =
  22        do putStrLn ("Processing " ++ f)
  23           s <- readFile f
  24           case parse s 1 of
  25             OkP m -> do putStrLn "Parse succeeded"
  26                         {- writeFile (f ++ ".parsed") (show m) -}
  27                         case checkModule senv m of
  28                           OkC senv' ->
  29                             do putStrLn "Check succeeded"
  30                                let m' = prepModule senv' m
  31                                {- writeFile (f ++ ".prepped") (show m') -}
  32                                case checkModule senv m' of
  33                                  OkC senv'' ->
  34                                    do putStrLn "Recheck succeeded"
  35                                       return (senv'',modules ++ [m'])
  36                                  FailC s ->
  37                                    do putStrLn ("Recheck failed: " ++ s)
  38                                       error "quit"
  39                           FailC s ->
  40                             do putStrLn ("Check failed: " ++ s)
  41                                error "quit"
  42             FailP s -> do putStrLn ("Parse failed: " ++ s)
  43                           error "quit"
  44
  45 main = do fname <- getSingleArg
  46           (_,modules) <- foldM process (initialEnv,[]) [fname] -- flist
  47           let result = evalProgram modules
  48           putStrLn ("Result = " ++ show result)
  49           putStrLn "All done"
  50 -- TODO
  51 -- see what breaks
  52        where flist = ["Main.hcr"]
  53              getSingleArg = getArgs >>= (\ a ->
  54                                            case a of
  55                                              (f:_) -> return f
  56                                              _ -> error $ "usage: ./Driver [filename]")
  57 {-
  58          ["PrelBase.hcr",
  59                           "PrelMaybe.hcr",
  60                           "PrelTup.hcr",
  61                           "PrelList.hcr",
  62                           "PrelShow.hcr",
  63                           "PrelEnum.hcr",
  64                           "PrelNum.hcr",
  65                           "PrelST.hcr",
  66                           "PrelArr.hcr",
  67                           "PrelDynamic.hcr",
  68                           "PrelReal.hcr",
  69                           "PrelFloat.hcr",
  70                           "PrelRead.hcr",
  71                           "PrelIOBase.hcr",
  72                           "PrelException.hcr",
  73                           "PrelErr.hcr",
  74                           "PrelConc.hcr",
  75                           "PrelPtr.hcr",
  76                           "PrelByteArr.hcr",
  77                           "PrelPack.hcr",
  78                           "PrelBits.hcr",
  79                           "PrelWord.hcr",
  80                           "PrelInt.hcr",
  81                           "PrelCTypes.hcr",
  82                           "PrelStable.hcr",
  83                           "PrelCTypesISO.hcr",
  84                           "Monad.hcr",
  85                           "PrelStorable.hcr",
  86                           "PrelMarshalAlloc.hcr",
  87                           "PrelMarshalUtils.hcr",
  88                           "PrelMarshalArray.hcr",
  89                           "PrelCString.hcr",
  90                           "PrelMarshalError.hcr",
  91                           "PrelCError.hcr",
  92                           "PrelPosix.hcr",
  93                           "PrelHandle.hcr",
  94                           "PrelIO.hcr",
  95                           "Prelude.hcr",
  96                           "Main.hcr" ]
  97
  98 -}