summaryrefslogtreecommitdiff
path: root/compiler/parser/ParserCoreUtils.hs
blob: a590fb5c9338e2d54a98f33542812a4e26927b3b (plain)
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
module ParserCoreUtils where

import 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"
   findMod ("%module":m:_) = m
   findMod (_:xs) = findMod xs


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