Revision 16, 1.6 kB
(checked in by ujihisa, 17 years ago)
|
hh2008/ujihisa: initial import
|
Rev | Line | |
---|
[16] | 1 | module Main (main) where |
---|
| 2 | |
---|
| 3 | import Text.ParserCombinators.Parsec |
---|
| 4 | |
---|
| 5 | p :: Parser Module |
---|
| 6 | p = do spaces |
---|
| 7 | string "module" |
---|
| 8 | spaces |
---|
| 9 | modid <- do { c <- upper; cs <- many lower; return $ c:cs } |
---|
| 10 | spaces |
---|
| 11 | string "where" |
---|
| 12 | spaces |
---|
| 13 | body <- pBody |
---|
| 14 | return $ Module modid [] body |
---|
| 15 | where |
---|
| 16 | pBody :: Parser Body |
---|
| 17 | pBody = do char '{' |
---|
| 18 | bs <- many pBodyLine |
---|
| 19 | spaces |
---|
| 20 | char '}' |
---|
| 21 | return $ Body bs |
---|
| 22 | pBodyLine :: Parser TopDecl |
---|
| 23 | pBodyLine = many (noneOf "\n}") >> ((try pGenDecl) <|> (try pFunctionLHS)) |
---|
| 24 | where |
---|
| 25 | pGenDecl = do spaces |
---|
| 26 | name <- many lower |
---|
| 27 | spaces |
---|
| 28 | string "::" |
---|
| 29 | spaces |
---|
| 30 | cs <- many1 $ noneOf "\n" |
---|
| 31 | return $ TopDecl $ GenDecl name cs |
---|
| 32 | pFunctionLHS = do spaces |
---|
| 33 | name <- many lower |
---|
| 34 | spaces |
---|
| 35 | string "=" |
---|
| 36 | spaces |
---|
| 37 | cs <- many1 $ noneOf "\n" |
---|
| 38 | return $ TopDecl $ FunctionLHS name cs |
---|
| 39 | |
---|
| 40 | compile :: String -> String |
---|
| 41 | compile str = case parse p "" str of |
---|
| 42 | Right exp -> show exp |
---|
| 43 | Left err -> "Error -- " ++ show err |
---|
| 44 | |
---|
| 45 | main = do cs <- getContents |
---|
| 46 | putStrLn $ compile cs |
---|
| 47 | |
---|
| 48 | data Module = Module String [String] Body deriving Show |
---|
| 49 | data Body = Body [TopDecl] deriving Show |
---|
| 50 | data TopDecl = TopDecl Decl | NotImplemented deriving Show |
---|
| 51 | data Decl = GenDecl String String | FunctionLHS String String deriving Show |
---|