src/Main.hs

   1 {-# OPTIONS_GHC -fno-warn-unused-do-bind #-}
   2
   3 module Main where
   4
   5 import Data.Text as T (Text, pack)
   6 import qualified Data.Text.IO as T
   7 import Data.Attoparsec.Text
   8 import qualified Data.Map as M
   9 import Control.Applicative
  10 import Control.Monad
  11 import System.Environment
  12
  13 import Lambda
  14
  15 data Definition = Definition String Term
  16
  17 dictionary :: [Definition] -> M.Map String Term
  18 dictionary = M.fromList . map (\ (Definition s t) -> (s, t))
  19
  20 parseDefinition :: Parser Definition
  21 parseDefinition = do
  22   name <- many1 letter
  23   char '='
  24   t <- parseTerm
  25   return $! Definition name t
  26
  27 parseImport :: Parser String
  28 parseImport = do
  29   string (T.pack "import ")
  30   many1 letter
  31
  32 parseFile :: Text -> ([FilePath], [Definition], [Term])
  33 parseFile txt = case cnt of
  34     (Right t) -> t
  35     (Left e) -> error e
  36   where cnt = parseOnly (parserF <* endOfInput) txt
  37         parserF = do
  38           imports <- many (parseImport <* char '\n')
  39           defs <- many (parseDefinition <* char '\n')
  40           terms <- many (parseTerm <* char '\n')
  41           return (imports, defs, terms)
  42
  43 printEval :: (Term -> Term) -> Term -> IO ()
  44 printEval def t = do
  45   putStrLn $ show t ++ ":"
  46   putStrLn $ "  " ++ show (reduce $ def t)
  47   putStrLn ""
  48
  49 makeDefTerm :: [Definition] -> Term -> Term
  50 makeDefTerm (Definition name dTerm : ds) t = App (Lambda name (makeDefTerm ds t)) dTerm
  51 makeDefTerm [] t = t
  52
  53 main :: IO ()
  54 main = do
  55   [filename] <- getArgs
  56   (imports, defs, terms) <- parseFile <$> T.readFile filename
  57   importDefs <- forM imports $ \ file ->  do
  58         (_, idefs, _) <- parseFile <$> T.readFile (file ++ ".lc")
  59         return idefs
  60   let defT = makeDefTerm $ concat importDefs ++ defs
  61   mapM_ (printEval defT) terms