Adds "compiler" and CLI argument handling
This commit is contained in:
		
							
								
								
									
										23
									
								
								src/Compiler.hs
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										23
									
								
								src/Compiler.hs
									
									
									
									
									
										Normal file
									
								
							| @ -0,0 +1,23 @@ | |||||||
|  | module Compiler where | ||||||
|  |  | ||||||
|  | import Eval | ||||||
|  | import Parser | ||||||
|  | import Research | ||||||
|  |  | ||||||
|  | import System.IO | ||||||
|  |  | ||||||
|  | import qualified Data.Map as Map | ||||||
|  |  | ||||||
|  | evaluateFile :: FilePath -> IO T | ||||||
|  | evaluateFile filePath = do | ||||||
|  |   contents <- readFile filePath | ||||||
|  |   let linesOfFile = lines contents | ||||||
|  |   let env = foldl evaluateLine Map.empty linesOfFile | ||||||
|  |   case Map.lookup "__result" env of | ||||||
|  |     Just finalResult -> return finalResult | ||||||
|  |     Nothing -> error "No result found in final environment" | ||||||
|  |  | ||||||
|  | evaluateLine :: Env -> String -> Env | ||||||
|  | evaluateLine env line = | ||||||
|  |   let ast = parseSingle line | ||||||
|  |   in evalSingle env ast | ||||||
| @ -6,7 +6,7 @@ import Research | |||||||
|  |  | ||||||
| import qualified Data.Map as Map | import qualified Data.Map as Map | ||||||
|  |  | ||||||
| library :: Map.Map String T | library :: Env | ||||||
| library = evalTricu Map.empty $ parseTricu $ unlines  | library = evalTricu Map.empty $ parseTricu $ unlines  | ||||||
|   [ "false = t"  |   [ "false = t"  | ||||||
|   , "true = t t" |   , "true = t t" | ||||||
|  | |||||||
							
								
								
									
										39
									
								
								src/Main.hs
									
									
									
									
									
								
							
							
						
						
									
										39
									
								
								src/Main.hs
									
									
									
									
									
								
							| @ -1,5 +1,6 @@ | |||||||
| module Main where | module Main where | ||||||
|  |  | ||||||
|  | import Compiler | ||||||
| import Eval     (evalTricu, result) | import Eval     (evalTricu, result) | ||||||
| import Library  (library) | import Library  (library) | ||||||
| import Parser   (parseTricu) | import Parser   (parseTricu) | ||||||
| @ -7,16 +8,40 @@ import REPL     (repl) | |||||||
| import Research (T) | import Research (T) | ||||||
|  |  | ||||||
| import Text.Megaparsec (runParser) | import Text.Megaparsec (runParser) | ||||||
|  | import System.Console.CmdArgs | ||||||
|  |  | ||||||
| import qualified Data.Map as Map | import qualified Data.Map as Map | ||||||
|  |  | ||||||
|  | data TricuArgs | ||||||
|  |   = Repl | ||||||
|  |   | Compile { file :: FilePath } | ||||||
|  |   deriving (Show, Data, Typeable) | ||||||
|  |  | ||||||
|  | replMode :: TricuArgs | ||||||
|  | replMode = Repl | ||||||
|  |   &= help "Start interactive REPL" | ||||||
|  |   &= auto | ||||||
|  |   &= name "repl" | ||||||
|  |  | ||||||
|  | compileMode :: TricuArgs | ||||||
|  | compileMode = Compile { file = def &= typ "FILE" &= help "Relative or absolute path to compile" } | ||||||
|  |   &= help "Compile a file and return the result of the expression in the final line" | ||||||
|  |   &= explicit | ||||||
|  |   &= name "compile" | ||||||
|  |  | ||||||
| main :: IO () | main :: IO () | ||||||
| main = do | main = do | ||||||
|   putStrLn "Welcome to the tricu Interpreter" |   args <- cmdArgs $ modes [replMode, compileMode] | ||||||
|   putStrLn "You can exit at any time by typing and entering: " |     &= help "tricu: Exploring Tree Calculus" | ||||||
|   putStrLn ":_exit" |     &= program "tricu" | ||||||
|   repl library |     &= summary "tricu - compiler and repl" | ||||||
|  |  | ||||||
|  |   case args of | ||||||
|  |     Repl -> do | ||||||
|  |       putStrLn "Welcome to the tricu REPL" | ||||||
|  |       putStrLn "You can exit with `CTRL+D` or the `:_exit` command.`" | ||||||
|  |       repl Map.empty | ||||||
|  |     Compile filePath -> do | ||||||
|  |       result <- evaluateFile filePath | ||||||
|  |       print result | ||||||
|  |  | ||||||
| runTricu :: String -> T |  | ||||||
| runTricu s = result (evalTricu Map.empty $ parseTricu s) |  | ||||||
| runTricuEnv env s = result (evalTricu env $ parseTricu s) |  | ||||||
|  | |||||||
| @ -12,10 +12,10 @@ import System.Console.Haskeline | |||||||
|  |  | ||||||
| import qualified Data.Map as Map | import qualified Data.Map as Map | ||||||
|  |  | ||||||
| repl :: Map.Map String T -> IO () | repl :: Env -> IO () | ||||||
| repl env = runInputT defaultSettings (loop env) | repl env = runInputT defaultSettings (loop env) | ||||||
|   where |   where | ||||||
|     loop :: Map.Map String T -> InputT IO () |     loop :: Env -> InputT IO () | ||||||
|     loop env = do |     loop env = do | ||||||
|       minput <- getInputLine "tricu < " |       minput <- getInputLine "tricu < " | ||||||
|       case minput of |       case minput of | ||||||
| @ -28,7 +28,7 @@ repl env = runInputT defaultSettings (loop env) | |||||||
|           newEnv <- liftIO $ (processInput env input `catch` errorHandler env) |           newEnv <- liftIO $ (processInput env input `catch` errorHandler env) | ||||||
|           loop newEnv |           loop newEnv | ||||||
|  |  | ||||||
|     processInput :: Map.Map String T -> String -> IO (Map.Map String T) |     processInput :: Env -> String -> IO (Env) | ||||||
|     processInput env input = do |     processInput env input = do | ||||||
|       let clearEnv = Map.delete "__result" env |       let clearEnv = Map.delete "__result" env | ||||||
|           newEnv = evalSingle clearEnv (parseSingle input) |           newEnv = evalSingle clearEnv (parseSingle input) | ||||||
| @ -39,7 +39,7 @@ repl env = runInputT defaultSettings (loop env) | |||||||
|         Nothing -> return () |         Nothing -> return () | ||||||
|       return newEnv |       return newEnv | ||||||
|  |  | ||||||
|     errorHandler :: Map.Map String T -> SomeException -> IO (Map.Map String T) |     errorHandler :: Env -> SomeException -> IO (Env) | ||||||
|     errorHandler env e = do |     errorHandler env e = do | ||||||
|       putStrLn $ "Error: " ++ show e |       putStrLn $ "Error: " ++ show e | ||||||
|       return env |       return env | ||||||
|  | |||||||
| @ -89,6 +89,8 @@ toList (Fork x rest) = case toList rest of | |||||||
| toList _ = Left "Invalid Tree Calculus list" | toList _ = Left "Invalid Tree Calculus list" | ||||||
|  |  | ||||||
| -- Utility | -- Utility | ||||||
|  | type Env = Map.Map String T  | ||||||
|  |  | ||||||
| toAscii :: T -> String | toAscii :: T -> String | ||||||
| toAscii tree = go tree "" True | toAscii tree = go tree "" True | ||||||
|   where |   where | ||||||
|  | |||||||
| @ -19,6 +19,7 @@ executable tricu | |||||||
|   default-extensions: |   default-extensions: | ||||||
|       ConstraintKinds |       ConstraintKinds | ||||||
|       DataKinds |       DataKinds | ||||||
|  |       DeriveDataTypeable | ||||||
|       DeriveGeneric |       DeriveGeneric | ||||||
|       FlexibleContexts |       FlexibleContexts | ||||||
|       FlexibleInstances |       FlexibleInstances | ||||||
| @ -28,11 +29,13 @@ executable tricu | |||||||
|   ghc-options: -threaded -rtsopts -with-rtsopts=-N -optl-pthread -fPIC |   ghc-options: -threaded -rtsopts -with-rtsopts=-N -optl-pthread -fPIC | ||||||
|   build-depends: |   build-depends: | ||||||
|     base >=4.7 |     base >=4.7 | ||||||
|  |     , cmdargs | ||||||
|     , containers |     , containers | ||||||
|     , haskeline |     , haskeline | ||||||
|     , megaparsec |     , megaparsec | ||||||
|     , mtl |     , mtl | ||||||
|   other-modules: |   other-modules: | ||||||
|  |     Compiler | ||||||
|     Eval |     Eval | ||||||
|     Lexer |     Lexer | ||||||
|     Library |     Library | ||||||
| @ -47,6 +50,7 @@ test-suite tricu-tests | |||||||
|   hs-source-dirs:      test, src |   hs-source-dirs:      test, src | ||||||
|   build-depends:        |   build-depends:        | ||||||
|     base |     base | ||||||
|  |     , cmdargs | ||||||
|     , containers |     , containers | ||||||
|     , haskeline |     , haskeline | ||||||
|     , megaparsec |     , megaparsec | ||||||
| @ -56,6 +60,7 @@ test-suite tricu-tests | |||||||
|     , tasty-quickcheck |     , tasty-quickcheck | ||||||
|   default-language:    Haskell2010 |   default-language:    Haskell2010 | ||||||
|   other-modules: |   other-modules: | ||||||
|  |     Compiler | ||||||
|     Eval |     Eval | ||||||
|     Lexer |     Lexer | ||||||
|     Library |     Library | ||||||
|  | |||||||
		Reference in New Issue
	
	Block a user
	 James Eversole
					James Eversole