Merge pull request 'Adds "compiler" and CLI argument handling' (#3) from feature/compiler-CLI into main
Reviewed-on: #3
This commit is contained in:
commit
fe70aa72ac
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
|
||||
|
||||
library :: Map.Map String T
|
||||
library :: Env
|
||||
library = evalTricu Map.empty $ parseTricu $ unlines
|
||||
[ "false = t"
|
||||
, "true = t t"
|
||||
|
39
src/Main.hs
39
src/Main.hs
@ -1,5 +1,6 @@
|
||||
module Main where
|
||||
|
||||
import Compiler
|
||||
import Eval (evalTricu, result)
|
||||
import Library (library)
|
||||
import Parser (parseTricu)
|
||||
@ -7,16 +8,40 @@ import REPL (repl)
|
||||
import Research (T)
|
||||
|
||||
import Text.Megaparsec (runParser)
|
||||
import System.Console.CmdArgs
|
||||
|
||||
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 = do
|
||||
putStrLn "Welcome to the tricu Interpreter"
|
||||
putStrLn "You can exit at any time by typing and entering: "
|
||||
putStrLn ":_exit"
|
||||
repl library
|
||||
args <- cmdArgs $ modes [replMode, compileMode]
|
||||
&= help "tricu: Exploring Tree Calculus"
|
||||
&= program "tricu"
|
||||
&= 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
|
||||
|
||||
repl :: Map.Map String T -> IO ()
|
||||
repl :: Env -> IO ()
|
||||
repl env = runInputT defaultSettings (loop env)
|
||||
where
|
||||
loop :: Map.Map String T -> InputT IO ()
|
||||
loop :: Env -> InputT IO ()
|
||||
loop env = do
|
||||
minput <- getInputLine "tricu < "
|
||||
case minput of
|
||||
@ -28,7 +28,7 @@ repl env = runInputT defaultSettings (loop env)
|
||||
newEnv <- liftIO $ (processInput env input `catch` errorHandler env)
|
||||
loop newEnv
|
||||
|
||||
processInput :: Map.Map String T -> String -> IO (Map.Map String T)
|
||||
processInput :: Env -> String -> IO (Env)
|
||||
processInput env input = do
|
||||
let clearEnv = Map.delete "__result" env
|
||||
newEnv = evalSingle clearEnv (parseSingle input)
|
||||
@ -39,7 +39,7 @@ repl env = runInputT defaultSettings (loop env)
|
||||
Nothing -> return ()
|
||||
return newEnv
|
||||
|
||||
errorHandler :: Map.Map String T -> SomeException -> IO (Map.Map String T)
|
||||
errorHandler :: Env -> SomeException -> IO (Env)
|
||||
errorHandler env e = do
|
||||
putStrLn $ "Error: " ++ show e
|
||||
return env
|
||||
|
@ -89,6 +89,8 @@ toList (Fork x rest) = case toList rest of
|
||||
toList _ = Left "Invalid Tree Calculus list"
|
||||
|
||||
-- Utility
|
||||
type Env = Map.Map String T
|
||||
|
||||
toAscii :: T -> String
|
||||
toAscii tree = go tree "" True
|
||||
where
|
||||
|
@ -19,6 +19,7 @@ executable tricu
|
||||
default-extensions:
|
||||
ConstraintKinds
|
||||
DataKinds
|
||||
DeriveDataTypeable
|
||||
DeriveGeneric
|
||||
FlexibleContexts
|
||||
FlexibleInstances
|
||||
@ -28,11 +29,13 @@ executable tricu
|
||||
ghc-options: -threaded -rtsopts -with-rtsopts=-N -optl-pthread -fPIC
|
||||
build-depends:
|
||||
base >=4.7
|
||||
, cmdargs
|
||||
, containers
|
||||
, haskeline
|
||||
, megaparsec
|
||||
, mtl
|
||||
other-modules:
|
||||
Compiler
|
||||
Eval
|
||||
Lexer
|
||||
Library
|
||||
@ -47,6 +50,7 @@ test-suite tricu-tests
|
||||
hs-source-dirs: test, src
|
||||
build-depends:
|
||||
base
|
||||
, cmdargs
|
||||
, containers
|
||||
, haskeline
|
||||
, megaparsec
|
||||
@ -56,6 +60,7 @@ test-suite tricu-tests
|
||||
, tasty-quickcheck
|
||||
default-language: Haskell2010
|
||||
other-modules:
|
||||
Compiler
|
||||
Eval
|
||||
Lexer
|
||||
Library
|
||||
|
Loading…
x
Reference in New Issue
Block a user