fix bug in unification

[fp.git] / src / Main.hs

diff --git a/src/Main.hs b/src/Main.hs
index 4ddfe2d..8253f88 100644 (file)
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -1,62 +1,10 @@
-{-# OPTIONS_GHC -fno-warn-unused-do-bind #-}
-
 module Main where
 
-import Data.Text as T (Text, pack)
-import qualified Data.Text.IO as T
-import Data.Attoparsec.Text
-import qualified Data.Map as M
-import Control.Applicative
-import Control.Monad
 import System.Environment
 
-import Lambda
-import Lambda.Parser.Fancy
-
-data Definition = Definition String Term
-
-dictionary :: [Definition] -> M.Map String Term
-dictionary = M.fromList . map (\ (Definition s t) -> (s, t))
-
-parseDefinition :: Parser Definition
-parseDefinition = do
-  name <- many1 letter
-  char '='
-  t <- parseTerm
-  return $! Definition name t
-
-parseImport :: Parser String
-parseImport = do
-  string (T.pack "import ")
-  many1 letter
-
-parseFile :: Text -> ([FilePath], [Definition], [Term])
-parseFile txt = case cnt of
-    (Right t) -> t
-    (Left e) -> error e
-  where cnt = parseOnly (parserF <* endOfInput) txt
-        parserF = do
-          imports <- many (parseImport <* char '\n')
-          defs <- many (parseDefinition <* char '\n')
-          terms <- many (parseTerm <* char '\n')
-          return (imports, defs, terms)
-
-printEval :: (Term -> Term) -> Term -> IO ()
-printEval def t = do
-  putStrLn $ show t ++ ":"
-  putStrLn $ "  " ++ show (reduce $ def t)
-  putStrLn ""
-
-makeDefTerm :: [Definition] -> Term -> Term
-makeDefTerm (Definition name dTerm : ds) t = App (Lambda name (makeDefTerm ds t)) dTerm
-makeDefTerm [] t = t
+import Lambda.Interpreter as L
 
 main :: IO ()
 main = do
   [filename] <- getArgs
-  (imports, defs, terms) <- parseFile <$> T.readFile filename
-  importDefs <- forM imports $ \ file ->  do
-        (_, idefs, _) <- parseFile <$> T.readFile (file ++ ".lc")
-        return idefs
-  let defT = makeDefTerm $ concat importDefs ++ defs
-  mapM_ (printEval defT) terms
+  L.interpret filename