Fakultas Ilmu Komputer UI

Commit cba6a55d authored by Sean Gillespie's avatar Sean Gillespie
Browse files

Prerequisites for supporting Global state

parent af6297b7
...@@ -8,55 +8,64 @@ import System.Console.Shell ...@@ -8,55 +8,64 @@ import System.Console.Shell
import System.Console.Shell.ShellMonad import System.Console.Shell.ShellMonad
import System.Console.Shell.Backend.Haskeline (haskelineBackend) import System.Console.Shell.Backend.Haskeline (haskelineBackend)
import qualified Data.Map as Map
import qualified Paths_lambda_calculator as P import qualified Paths_lambda_calculator as P
import Language.Lambda
import Language.Lambda.Util.PrettyPrint import Language.Lambda.Util.PrettyPrint
import Language.SystemF
import qualified Language.Lambda as Lambda
import qualified Language.SystemF as SystemF
main :: IO () main :: IO ()
main = execParser opts >>= runShell' main = execParser opts >>= runShell'
where opts = info (helper <*> cliParser) where opts = info (helper <*> cliParser)
(briefDesc <> progDesc "A Lambda Calculus Interpreter") (briefDesc <> progDesc "A Lambda Calculus Interpreter")
-- Option Parsing -- | Option Parsing
data CliOptions = CliOptions { data CliOptions = CliOptions {
language :: Eval Language, language :: Eval Language,
version :: Bool version :: Bool
} }
-- Supported Languages: -- | Supported Languages:
-- --
-- * Untyped Lambda Calculus -- * Untyped Lambda Calculus
-- * System F -- * System F
data Language data Language
= Untyped = Untyped
| SystemF | SystemF
-- The result of an evaluation -- | Globals are Maps that map names to expressions.
type Result a = Either a -- An error data Globals n t
a -- The result = GlobalsUntyped (Map.Map n (Lambda.LambdaExpr n))
| GlobalsSystemF (Map.Map n (SystemF.SystemFExpr n t))
-- | The result of an evaluation
type Result a state = Either a -- ^ An error
(a, state) -- ^ The result along with its state
-- Represent a language together with its evaluation function -- | Represent a language together with its evaluation function
data Eval a = Eval a (String -> Result String) data Eval a = Eval a (String -> Result String (Globals String String))
untyped :: Eval Language untyped :: Eval Language
untyped = Eval Untyped eval untyped = Eval Untyped eval
where eval = fromEvalString Language.Lambda.evalString where eval = fromEvalString Lambda.evalString
systemf :: Eval Language systemf :: Eval Language
systemf = Eval SystemF eval systemf = Eval SystemF eval
where eval = fromEvalString Language.SystemF.evalString where eval = fromEvalString SystemF.evalString
-- Take a typed evaluation function and return a function that returns a result -- | Take a typed evaluation function and return a function that returns a result
-- --
-- For example: -- For example:
-- (String -> Either ParseError (LambdaExpr String)) -> (String -> Result String) -- (String -> Either ParseError (LambdaExpr String)) -> (String -> Result String)
-- (String -> Either ParseError (SystemFExpr String String)) -> (String -> Result String) -- (String -> Either ParseError (SystemFExpr String String)) -> (String -> Result String)
fromEvalString :: (Show s, PrettyPrint p) fromEvalString :: (Show s, PrettyPrint p)
=> (String -> Either s p) => (String -> Either s p)
-> (String -> Result String) -> (String -> Result String (Globals String String))
fromEvalString f = either (Left . show) (Right . prettyPrint) . f fromEvalString f = either (Left . show) (Right . toResult) . f
-- TODO[sgillespie]: Remove placeholder below
where toResult expr = (prettyPrint expr, GlobalsUntyped Map.empty)
cliParser :: Parser CliOptions cliParser :: Parser CliOptions
cliParser = CliOptions cliParser = CliOptions
...@@ -69,14 +78,14 @@ cliParser = CliOptions ...@@ -69,14 +78,14 @@ cliParser = CliOptions
short 'v' <> short 'v' <>
help "Print the version") help "Print the version")
-- Interactive Shell -- | Interactive Shell
runShell' :: CliOptions -> IO () runShell' :: CliOptions -> IO ()
runShell' CliOptions{version=True} = putStrLn version' runShell' CliOptions{version=True} = putStrLn version'
runShell' CliOptions{language=Eval lang eval} runShell' CliOptions{language=Eval lang eval}
= runShell (mkShellDesc lang eval) haskelineBackend () = runShell (mkShellDesc lang eval) haskelineBackend ()
mkShellDesc :: Language mkShellDesc :: Language
-> (String -> Result String) -> (String -> Result String (Globals String String))
-> ShellDescription () -> ShellDescription ()
mkShellDesc language f = shellDesc' $ mkShellDescription commands (eval f) mkShellDesc language f = shellDesc' $ mkShellDescription commands (eval f)
where shellDesc' d = d { where shellDesc' d = d {
...@@ -98,10 +107,10 @@ commands = [ ...@@ -98,10 +107,10 @@ commands = [
helpCommand "h" helpCommand "h"
] ]
eval :: (String -> Result String) -> String -> Sh s' () eval :: (String -> Result String (Globals String String)) -> String -> Sh s' ()
eval f = either shellPutErrLn shellPutStrLn . f eval f = either shellPutErrLn shellPutStrLn . fmap fst . f
-- Get the current version -- | Get the current version
version' :: String version' :: String
version' = showVersion P.version version' = showVersion P.version
...@@ -2,7 +2,7 @@ ...@@ -2,7 +2,7 @@
-- --
-- see: https://github.com/sol/hpack -- see: https://github.com/sol/hpack
-- --
-- hash: 797b677552c81b80399ac8b69e2e398479887a332862d9878a7c508a259975ee -- hash: f7f43eaf08f4a2a78ad4d303404ea19c729aa53a0afa30fd0f99d8eb505b8306
name: lambda-calculator name: lambda-calculator
version: 2.0.0 version: 2.0.0
...@@ -55,6 +55,7 @@ executable lambda-calculator ...@@ -55,6 +55,7 @@ executable lambda-calculator
Shellac Shellac
, Shellac-haskeline , Shellac-haskeline
, base >=4.9 && <5 , base >=4.9 && <5
, containers
, lambda-calculator , lambda-calculator
, optparse-applicative >=0.13 , optparse-applicative >=0.13
default-language: Haskell2010 default-language: Haskell2010
......
...@@ -37,6 +37,7 @@ executables: ...@@ -37,6 +37,7 @@ executables:
- -rtsopts - -rtsopts
- -with-rtsopts=-N - -with-rtsopts=-N
dependencies: dependencies:
- containers
- lambda-calculator - lambda-calculator
- optparse-applicative >=0.13 - optparse-applicative >=0.13
- Shellac - Shellac
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment