1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
|
module ParserCoreUtils where
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 =
catch (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
|
