root/compiler/parser/ParserCoreUtils.hs

module ParserCoreUtils where

import Exception
import System.IO

data ParseResult a = OkP a | FailP String
type P a = String -> Int -> ParseResult a

thenP :: P a -> (a -> P b) -> P b
m `thenP`  k = \ s l -> 
  case m s l of 
    OkP a -> k a s l
    FailP s -> FailP s

returnP :: a -> P a
returnP m _ _ = OkP m

failP :: String -> P a
failP s s' _ = FailP (s ++ ":" ++ s')

getCoreModuleName :: FilePath -> IO String
getCoreModuleName fpath = 
   catchIO (do
     h  <- openFile fpath ReadMode
     ls <- hGetContents h
     let mo = findMod (words ls)
      -- make sure we close up the file right away.
     (length mo) `seq` return ()
     hClose h
     return mo)
    (\ _ -> return "Main")
 where
   findMod [] = "Main"
   -- TODO: this should just return the module name, without the package name
   findMod ("%module":m:_) = m
   findMod (_:xs) = findMod xs


data Token =
   TKmodule
 | TKdata
 | TKnewtype
 | TKforall
 | TKrec
 | TKlet
 | TKin
 | TKcase
 | TKof
 | TKcast
 | TKnote
 | TKexternal
 | TKlocal
 | TKwild
 | TKoparen
 | TKcparen
 | TKobrace
 | TKcbrace
 | TKhash
 | TKeq
 | TKcolon
 | TKcoloncolon
 | TKcoloneqcolon
 | TKstar
 | TKrarrow
 | TKlambda
 | TKat
 | TKdot
 | TKquestion
 | TKsemicolon
 | TKname String
 | TKcname String
 | TKinteger Integer
 | TKrational Rational
 | TKstring String
 | TKchar Char
 | TKEOF