push

Interpreter.hs

@@ -0,0 +1,65 @@
+module Interpreter (interFile) where
+
+import qualified Data.Map.Strict as Map
+import Lexer (lexL)
+import Parser (AstNode(..), parse)
+
+interFile :: FilePath -> IO ()
+interFile path = do
+  putStrLn $ "Interpreting " ++ path
+  content <- readFile path
+  let ls = zip [1..] (lines content)
+  mapM_ (uncurry interLine) ls
+
+interLine :: Int -> String -> IO ()
+interLine lineNum line =
+  case lexL lineNum line of
+    Left e  -> error $ "Lexer error: " ++ e
+    Right toks ->
+      case parse toks of
+        Left e  -> error $ "Parser error: " ++ e
+        Right ast ->
+          case ast of
+            Epsilon -> return ()
+            _ -> do
+              let result = evaluate ast
+              putStrLn $ show ast ++ " => " ++ show result
+
+evaluate :: AstNode -> AstNode
+evaluate ast =
+  let ast' = reduce ast Map.empty
+  in if ast' == ast then ast else evaluate ast'
+
+reduce :: AstNode -> Map.Map String AstNode -> AstNode
+reduce (Abstraction p t) env =
+  case p of
+    Identifier pid ->
+      let env' = Map.delete pid env
+      in case t of
+           Application tl tr
+             | tr == p && not (isFree tl p) -> reduce tl env'
+           _ -> Abstraction p (reduce t env')
+    _ -> error "Invalid abstraction"
+
+reduce (Application l r) env =
+  case l of
+    Abstraction p body ->
+      case p of
+        Identifier pid ->
+          let env' = Map.insert pid (reduce r env) env
+          in reduce body env'
+        _ -> error "Invalid application"
+    _ -> Application (reduce l env) (reduce r env)
+
+reduce (Identifier id_) env =
+  case Map.lookup id_ env of
+    Just x  -> x
+    Nothing -> Identifier id_
+
+reduce Epsilon _ = Epsilon
+
+isFree :: AstNode -> AstNode -> Bool
+isFree (Abstraction p t) id_ = id_ /= p && isFree t id_
+isFree (Application l r) id_ = isFree l id_ || isFree r id_
+isFree (Identifier s)    id_ = Identifier s == id_
+isFree _                 _   = False