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