Fix CodingStyle#Warnings URLs
[ghc-hetmet.git] / compiler / parser / ParserCoreUtils.hs
1 {-# OPTIONS -w #-}
2 -- The above warning supression flag is a temporary kludge.
3 -- While working on this module you are encouraged to remove it and fix
4 -- any warnings in the module. See
5 --     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
6 -- for details
7
8 module ParserCoreUtils where
9
10 import IO 
11
12 data ParseResult a = OkP a | FailP String
13 type P a = String -> Int -> ParseResult a
14
15 thenP :: P a -> (a -> P b) -> P b
16 m `thenP`  k = \ s l -> 
17   case m s l of 
18     OkP a -> k a s l
19     FailP s -> FailP s
20
21 returnP :: a -> P a
22 returnP m _ _ = OkP m
23
24 failP :: String -> P a
25 failP s s' _ = FailP (s ++ ":" ++ s')
26
27 getCoreModuleName :: FilePath -> IO String
28 getCoreModuleName fpath = 
29    catch (do 
30      h  <- openFile fpath ReadMode
31      ls <- hGetContents h
32      let mo = findMod (words ls)
33       -- make sure we close up the file right away.
34      (length mo) `seq` return ()
35      hClose h
36      return mo)
37     (\ _ -> return "Main")
38  where
39    findMod [] = "Main"
40    -- TODO: this should just return the module name, without the package name
41    findMod ("%module":m:_) = m
42    findMod (_:xs) = findMod xs
43
44
45 data Token =
46    TKmodule
47  | TKdata
48  | TKnewtype
49  | TKforall
50  | TKrec
51  | TKlet
52  | TKin
53  | TKcase
54  | TKof
55  | TKcast
56  | TKnote
57  | TKexternal
58  | TKlocal
59  | TKwild
60  | TKoparen
61  | TKcparen
62  | TKobrace
63  | TKcbrace
64  | TKhash
65  | TKeq
66  | TKcolon
67  | TKcoloncolon
68  | TKcoloneqcolon
69  | TKstar
70  | TKrarrow
71  | TKlambda
72  | TKat
73  | TKdot
74  | TKquestion
75  | TKsemicolon
76  | TKname String
77  | TKcname String
78  | TKinteger Integer
79  | TKrational Rational
80  | TKstring String
81  | TKchar Char
82  | TKEOF
83