root/hh2008/ujihisa/uhc.hs

module Main (main) where

import Text.ParserCombinators.Parsec

p :: Parser Module
p = do spaces
       string "module"
       spaces
       modid <- do { c <- upper; cs <- many lower; return $ c:cs }
       spaces
       string "where"
       spaces
       body <- pBody
       return $ Module modid [] body
  where
    pBody :: Parser Body
    pBody = do char '{'
               bs <- many pBodyLine
               spaces
               char '}'
               return $ Body bs
    pBodyLine :: Parser TopDecl
    pBodyLine = many (noneOf "\n}") >> ((try pGenDecl) <|> (try pFunctionLHS))
      where
        pGenDecl = do spaces
                      name <- many lower
                      spaces
                      string "::"
                      spaces
                      cs <- many1 $ noneOf "\n"
                      return $ TopDecl $ GenDecl name cs
        pFunctionLHS = do spaces
                          name <- many lower
                          spaces
                          string "="
                          spaces
                          cs <- many1 $ noneOf "\n"
                          return $ TopDecl $ FunctionLHS name cs

compile :: String -> String
compile str = case parse p "" str of
                Right exp -> show exp
                Left err -> "Error -- " ++ show err

main = do cs <- getContents
          putStrLn $ compile cs

data Module = Module String [String] Body deriving Show
data Body = Body [TopDecl] deriving Show
data TopDecl = TopDecl Decl | NotImplemented deriving Show
data Decl = GenDecl String String | FunctionLHS String String deriving Show