compiler/parser/ParserCoreUtils.hs

   1 module ParserCoreUtils where
   2
   3 import Exception
   4 import System.IO
   5
   6 data ParseResult a = OkP a | FailP String
   7 type P a = String -> Int -> ParseResult a
   8
   9 thenP :: P a -> (a -> P b) -> P b
  10 m `thenP`  k = \ s l ->
  11   case m s l of
  12     OkP a -> k a s l
  13     FailP s -> FailP s
  14
  15 returnP :: a -> P a
  16 returnP m _ _ = OkP m
  17
  18 failP :: String -> P a
  19 failP s s' _ = FailP (s ++ ":" ++ s')
  20
  21 getCoreModuleName :: FilePath -> IO String
  22 getCoreModuleName fpath =
  23    catchIO (do
  24      h  <- openFile fpath ReadMode
  25      ls <- hGetContents h
  26      let mo = findMod (words ls)
  27       -- make sure we close up the file right away.
  28      (length mo) `seq` return ()
  29      hClose h
  30      return mo)
  31     (\ _ -> return "Main")
  32  where
  33    findMod [] = "Main"
  34    -- TODO: this should just return the module name, without the package name
  35    findMod ("%module":m:_) = m
  36    findMod (_:xs) = findMod xs
  37
  38
  39 data Token =
  40    TKmodule
  41  | TKdata
  42  | TKnewtype
  43  | TKforall
  44  | TKrec
  45  | TKlet
  46  | TKin
  47  | TKcase
  48  | TKof
  49  | TKcast
  50  | TKnote
  51  | TKexternal
  52  | TKlocal
  53  | TKwild
  54  | TKoparen
  55  | TKcparen
  56  | TKobrace
  57  | TKcbrace
  58  | TKhash
  59  | TKeq
  60  | TKcolon
  61  | TKcoloncolon
  62  | TKcoloneqcolon
  63  | TKstar
  64  | TKrarrow
  65  | TKlambda
  66  | TKat
  67  | TKdot
  68  | TKquestion
  69  | TKsemicolon
  70  | TKname String
  71  | TKcname String
  72  | TKinteger Integer
  73  | TKrational Rational
  74  | TKstring String
  75  | TKchar Char
  76  | TKEOF
  77