added let and better env data structure

This commit is contained in:
Yann Esposito (Yogsototh) 2017-02-25 17:02:05 +01:00
parent a7b76a0e8f
commit 3433dc4d3d
Signed by untrusted user who does not match committer: yogsototh
GPG key ID: 7B19A4C650D59646
5 changed files with 53 additions and 24 deletions

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -7,15 +7,16 @@ 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)
toArg (Atom x) = return $ Just $ toS x toArg (Atom x) = return $ Just $ toS x
toArg (Str s) = return $ Just $ toS s toArg (Str s) = return $ Just $ toS s
toArg (Stream (Just h)) = fmap (Just . Text.strip .toS) (hGetContents h) toArg (Stream (Just h)) = fmap (Just . Text.strip .toS) (hGetContents h)
toArg _ = return $ Nothing toArg _ = return $ Nothing
@ -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

View file

@ -10,10 +10,11 @@ module Lish.Types
) )
where where
import qualified Data.Text as Text import qualified Data.Map.Strict as Map
import GHC.IO.Handle (Handle) import qualified Data.Text as Text
import GHC.Show (Show (..)) import GHC.IO.Handle (Handle)
import Protolude hiding (show) import GHC.Show (Show (..))
import Protolude hiding (show)
data SExp = Lambda [SExp] data SExp = Lambda [SExp]
| Atom Text | Atom Text
@ -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