X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fparser%2FParserCoreUtils.hs;fp=compiler%2Fparser%2FParserCoreUtils.hs;h=a590fb5c9338e2d54a98f33542812a4e26927b3b;hp=0000000000000000000000000000000000000000;hb=0065d5ab628975892cea1ec7303f968c3338cbe1;hpb=28a464a75e14cece5db40f2765a29348273ff2d2

diff --git a/compiler/parser/ParserCoreUtils.hs b/compiler/parser/ParserCoreUtils.hs
new file mode 100644
index 0000000..a590fb5
--- /dev/null
+++ b/compiler/parser/ParserCoreUtils.hs
@@ -0,0 +1,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
+