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
|
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
|
||||||
|
Loading…
x
Reference in New Issue
Block a user