added let and better env data structure
This commit is contained in:
parent
a7b76a0e8f
commit
3433dc4d3d
5 changed files with 53 additions and 24 deletions
|
@ -35,6 +35,7 @@ library
|
||||||
, Lish.Parser
|
, Lish.Parser
|
||||||
, Lish.Types
|
, Lish.Types
|
||||||
build-depends: base >= 4.8 && < 5
|
build-depends: base >= 4.8 && < 5
|
||||||
|
, containers
|
||||||
, haskeline
|
, haskeline
|
||||||
, parsec >= 3 && < 4
|
, parsec >= 3 && < 4
|
||||||
, pipes
|
, pipes
|
||||||
|
|
|
@ -6,11 +6,13 @@ module Lish.Core
|
||||||
runLish
|
runLish
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
import qualified Data.Map.Strict as Map
|
||||||
import GHC.IO.Handle (hGetContents)
|
import GHC.IO.Handle (hGetContents)
|
||||||
import Pipes
|
import Pipes
|
||||||
import Prelude (lines)
|
import Prelude (String, lines)
|
||||||
import Protolude hiding (for, many, show, (<|>))
|
import Protolude hiding (for, many, show, (<|>))
|
||||||
import System.Console.Haskeline
|
import System.Console.Haskeline
|
||||||
|
import System.Environment (getEnvironment)
|
||||||
import Text.Parsec (ParseError)
|
import Text.Parsec (ParseError)
|
||||||
|
|
||||||
import Lish.Eval
|
import Lish.Eval
|
||||||
|
@ -19,20 +21,34 @@ import Lish.Types
|
||||||
|
|
||||||
-- | Start an interactive lish shell
|
-- | Start an interactive lish shell
|
||||||
runLish :: IO ()
|
runLish :: IO ()
|
||||||
runLish = runInputT defaultSettings mainLoop
|
runLish = do
|
||||||
|
env <- toEnv <$> getEnvironment
|
||||||
|
runInputT defaultSettings (mainLoop env)
|
||||||
|
|
||||||
mainLoop :: InputT IO ()
|
-- | System Environment -> LISH Env
|
||||||
mainLoop = do
|
toEnv :: [(String,String)] -> Env
|
||||||
maybeLine <- getInputLine ":€ > "
|
toEnv env =
|
||||||
|
env &
|
||||||
|
map (\(k,v) -> (toS k, Str (toS v))) &
|
||||||
|
Map.fromList
|
||||||
|
|
||||||
|
-- | Main REPL loop / Interpreter
|
||||||
|
mainLoop :: Env -> InputT IO ()
|
||||||
|
mainLoop env = do
|
||||||
|
let prompt = case Map.lookup "PROMPT" env of
|
||||||
|
Just (Str p) -> p
|
||||||
|
_ -> ":€ > "
|
||||||
|
maybeLine <- getInputLine (toS prompt)
|
||||||
case maybeLine of
|
case maybeLine of
|
||||||
-- EOF / control-d
|
-- EOF / control-d
|
||||||
Nothing -> outputStrLn "bye bye!"
|
Nothing -> outputStrLn "bye bye!"
|
||||||
Just "exit" -> outputStrLn "bye bye!"
|
Just "exit" -> outputStrLn "bye bye!"
|
||||||
Just "logout" -> outputStrLn "bye bye!"
|
Just "logout" -> outputStrLn "bye bye!"
|
||||||
Just line -> do
|
Just line -> do
|
||||||
eval (parseCmd ("(" <> line <> ")"))
|
newenv <- eval env (parseCmd ("(" <> line <> ")"))
|
||||||
mainLoop
|
mainLoop newenv
|
||||||
|
|
||||||
|
-- | Eval the reduced form
|
||||||
evalReduced :: SExp -> IO ()
|
evalReduced :: SExp -> IO ()
|
||||||
evalReduced Void = return ()
|
evalReduced Void = return ()
|
||||||
evalReduced (Stream Nothing) = return ()
|
evalReduced (Stream Nothing) = return ()
|
||||||
|
@ -49,8 +65,11 @@ evalReduced (WaitingStream (Just h)) = do
|
||||||
runEffect (for producer (lift . putStrLn))
|
runEffect (for producer (lift . putStrLn))
|
||||||
evalReduced x = putStrLn (show x)
|
evalReduced x = putStrLn (show x)
|
||||||
|
|
||||||
eval :: Either ParseError SExp -> InputT IO ()
|
-- | Evaluate the parsed expr
|
||||||
eval parsed = case parsed of
|
eval :: Env -> Either ParseError SExp -> InputT IO Env
|
||||||
Right sexpr -> liftIO $
|
eval env parsed = case parsed of
|
||||||
runStateT (reduceLambda sexpr) [] >>= evalReduced . fst
|
Right sexpr -> liftIO $ do
|
||||||
Left err -> outputStrLn (show err)
|
(reduced,newenv) <- runStateT (reduceLambda sexpr) env
|
||||||
|
evalReduced reduced
|
||||||
|
return newenv
|
||||||
|
Left err -> outputStrLn (show err) >> return env
|
||||||
|
|
|
@ -7,7 +7,7 @@ module Lish.Eval
|
||||||
where
|
where
|
||||||
|
|
||||||
import qualified Control.Exception as Exception
|
import qualified Control.Exception as Exception
|
||||||
import qualified Prelude as Prelude
|
import qualified Data.Map.Strict as Map
|
||||||
import Protolude
|
import Protolude
|
||||||
import System.Process hiding (env)
|
import System.Process hiding (env)
|
||||||
|
|
||||||
|
@ -40,7 +40,7 @@ apply = undefined
|
||||||
tryEnvCommand :: Text -> [SExp] -> StateT Env IO (Maybe SExp)
|
tryEnvCommand :: Text -> [SExp] -> StateT Env IO (Maybe SExp)
|
||||||
tryEnvCommand f args = do
|
tryEnvCommand f args = do
|
||||||
envcmd <- get
|
envcmd <- get
|
||||||
case Prelude.lookup f envcmd of
|
case Map.lookup f envcmd of
|
||||||
Just fn -> Just <$> (apply fn args)
|
Just fn -> Just <$> (apply fn args)
|
||||||
_ -> return Nothing
|
_ -> return Nothing
|
||||||
|
|
||||||
|
|
|
@ -7,10 +7,11 @@ module Lish.InternalCommands
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
import qualified Prelude as Prelude
|
import qualified Data.Map.Strict as Map
|
||||||
import GHC.IO.Handle (hGetContents)
|
|
||||||
import qualified Data.Text as Text
|
import qualified Data.Text as Text
|
||||||
|
import GHC.IO.Handle (hGetContents)
|
||||||
import Lish.Types
|
import Lish.Types
|
||||||
|
import qualified Prelude as Prelude
|
||||||
import Protolude
|
import Protolude
|
||||||
|
|
||||||
toArg :: SExp -> IO (Maybe Text)
|
toArg :: SExp -> IO (Maybe Text)
|
||||||
|
@ -36,6 +37,12 @@ evalErr errmsg = do
|
||||||
putText $ "EvalError: " <> errmsg
|
putText $ "EvalError: " <> errmsg
|
||||||
return Void
|
return Void
|
||||||
|
|
||||||
|
llet :: Command
|
||||||
|
llet ((Atom name):v:[]) = do
|
||||||
|
modify (Map.insert name v)
|
||||||
|
return v
|
||||||
|
llet _ = return Void
|
||||||
|
|
||||||
replace :: Command
|
replace :: Command
|
||||||
replace ((Str old) : (Str new) : (Str str) : []) =
|
replace ((Str old) : (Str new) : (Str str) : []) =
|
||||||
return $ Str $ Text.replace old new str
|
return $ Str $ Text.replace old new str
|
||||||
|
@ -50,6 +57,7 @@ internalCommands = [ ("prn", prn)
|
||||||
, ("pr", pr)
|
, ("pr", pr)
|
||||||
, (">", toWaitingStream)
|
, (">", toWaitingStream)
|
||||||
, ("replace", replace)
|
, ("replace", replace)
|
||||||
|
, ("let",llet)
|
||||||
]
|
]
|
||||||
|
|
||||||
lookup :: Text -> Maybe Command
|
lookup :: Text -> Maybe Command
|
||||||
|
|
|
@ -10,6 +10,7 @@ module Lish.Types
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
|
import qualified Data.Map.Strict as Map
|
||||||
import qualified Data.Text as Text
|
import qualified Data.Text as Text
|
||||||
import GHC.IO.Handle (Handle)
|
import GHC.IO.Handle (Handle)
|
||||||
import GHC.Show (Show (..))
|
import GHC.Show (Show (..))
|
||||||
|
@ -37,5 +38,5 @@ repr (Stream _) = "<stream>"
|
||||||
repr (WaitingStream _) = "<w-stream>"
|
repr (WaitingStream _) = "<w-stream>"
|
||||||
|
|
||||||
type CmdStream = Maybe Handle
|
type CmdStream = Maybe Handle
|
||||||
type Env = [(Text,SExp)]
|
type Env = Map.Map Text SExp
|
||||||
type Command = [SExp] -> StateT Env IO SExp
|
type Command = [SExp] -> StateT Env IO SExp
|
||||||
|
|
Loading…
Reference in a new issue