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 import Lambda.Parser.Fancy
  15
  16 data Definition = Definition String Term
  17
  18 dictionary :: [Definition] -> M.Map String Term
  19 dictionary = M.fromList . map (\ (Definition s t) -> (s, t))
  20
  21 parseDefinition :: Parser Definition
  22 parseDefinition = do
  23   name <- many1 letter
  24   char '='
  25   t <- parseTerm
  26   return $! Definition name t
  27
  28 parseImport :: Parser String
  29 parseImport = do
  30   string (T.pack "import ")
  31   many1 letter
  32
  33 parseFile :: Text -> ([FilePath], [Definition], [Term])
  34 parseFile txt = case cnt of
  35     (Right t) -> t
  36     (Left e) -> error e
  37   where cnt = parseOnly (parserF <* endOfInput) txt
  38         parserF = do
  39           imports <- many (parseImport <* char '\n')
  40           defs <- many (parseDefinition <* char '\n')
  41           terms <- many (parseTerm <* char '\n')
  42           return (imports, defs, terms)
  43
  44 printEval :: (Term -> Term) -> Term -> IO ()
  45 printEval def t = do
  46   putStrLn $ show t ++ ":"
  47   putStrLn $ "  " ++ show (reduce $ def t)
  48   putStrLn ""
  49
  50 makeDefTerm :: [Definition] -> Term -> Term
  51 makeDefTerm (Definition name dTerm : ds) t = App (Lambda name (makeDefTerm ds t)) dTerm
  52 makeDefTerm [] t = t
  53
  54 main :: IO ()
  55 main = do
  56   [filename] <- getArgs
  57   (imports, defs, terms) <- parseFile <$> T.readFile filename
  58   importDefs <- forM imports $ \ file ->  do
  59         (_, idefs, _) <- parseFile <$> T.readFile (file ++ ".lc")
  60         return idefs
  61   let defT = makeDefTerm $ concat importDefs ++ defs
  62   mapM_ (printEval defT) terms