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