added let and better env data structure

lish.cabal

@@ -35,6 +35,7 @@ library
                    , Lish.Parser
                    , Lish.Types
   build-depends:     base >= 4.8 && < 5
+                   , containers
                    , haskeline
                    , parsec >= 3 && < 4
                    , pipes

src/Lish/Core.hs

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

src/Lish/Eval.hs

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

src/Lish/InternalCommands.hs

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

src/Lish/Types.hs

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