load core + better getenv
This commit is contained in:
parent
89079016c2
commit
a0ca892fef
3 changed files with 29 additions and 17 deletions
|
@ -10,4 +10,6 @@
|
||||||
(if (empty? lst)
|
(if (empty? lst)
|
||||||
[]
|
[]
|
||||||
(cons (f (first lst))
|
(cons (f (first lst))
|
||||||
(map f (rest lst))))))
|
(map f (rest lst))))))
|
||||||
|
|
||||||
|
(prn "LISH core loaded")
|
|
@ -25,8 +25,13 @@ import Lish.Types
|
||||||
runLish :: IO ()
|
runLish :: IO ()
|
||||||
runLish = do
|
runLish = do
|
||||||
env <- toEnv <$> getEnvironment
|
env <- toEnv <$> getEnvironment
|
||||||
|
-- load core
|
||||||
runInputT (defaultSettings { historyFile = Just ".lish-history" })
|
runInputT (defaultSettings { historyFile = Just ".lish-history" })
|
||||||
(mainLoop Nothing env "")
|
(do
|
||||||
|
-- load lish core
|
||||||
|
fileContent <- liftIO $ readFile "lish/core.lsh"
|
||||||
|
newEnv <- eval env (fmap unFix (parseCmd ("(do " <> fileContent <> ")")))
|
||||||
|
mainLoop Nothing newEnv "")
|
||||||
|
|
||||||
-- | System Environment -> LISH Env
|
-- | System Environment -> LISH Env
|
||||||
toEnv :: [(String,String)] -> Env
|
toEnv :: [(String,String)] -> Env
|
||||||
|
@ -52,9 +57,8 @@ mainLoop mc env previousPartialnput = do
|
||||||
, Just "exit"
|
, Just "exit"
|
||||||
, Just "logout"] -> outputStrLn "bye bye!"
|
, Just "logout"] -> outputStrLn "bye bye!"
|
||||||
|
|
||||||
Just rawLine -> do
|
Just line -> do
|
||||||
let line = takeWhile (/= ';') rawLine -- remove comments
|
let exprs = previousPartialnput
|
||||||
exprs = previousPartialnput
|
|
||||||
<> (if isJust mc then " " else "")
|
<> (if isJust mc then " " else "")
|
||||||
<> toS line
|
<> toS line
|
||||||
case checkBalanced exprs empty of
|
case checkBalanced exprs empty of
|
||||||
|
|
|
@ -57,16 +57,6 @@ undef ((Atom name):[]) = do
|
||||||
return Void
|
return Void
|
||||||
undef x = evalErr $ "undef wait an atom got" <> toS (show x)
|
undef x = evalErr $ "undef wait an atom got" <> toS (show x)
|
||||||
|
|
||||||
-- | retrieve the value of a var
|
|
||||||
getenv :: ReduceUnawareCommand
|
|
||||||
getenv ((Atom varname):[]) = do
|
|
||||||
hm <- get
|
|
||||||
return $ fromMaybe Void (Map.lookup varname hm)
|
|
||||||
getenv ((Str varname):[]) = do
|
|
||||||
hm <- get
|
|
||||||
return $ fromMaybe Void (Map.lookup varname hm)
|
|
||||||
getenv _ = evalErr "getenv need on atom or a string as argument"
|
|
||||||
|
|
||||||
-- | replace à la `sed s/old/new/g text`
|
-- | replace à la `sed s/old/new/g text`
|
||||||
replace :: ReduceUnawareCommand
|
replace :: ReduceUnawareCommand
|
||||||
replace ((Str old) : (Str new) : (Str text) : []) =
|
replace ((Str old) : (Str new) : (Str text) : []) =
|
||||||
|
@ -151,8 +141,6 @@ strictCommands = [ ("prn", prn)
|
||||||
, (">", toWaitingStream)
|
, (">", toWaitingStream)
|
||||||
, ("replace", replace)
|
, ("replace", replace)
|
||||||
, ("undef",undef)
|
, ("undef",undef)
|
||||||
, ("getenv",getenv)
|
|
||||||
, ("$",getenv)
|
|
||||||
, ("str",str)
|
, ("str",str)
|
||||||
, ("atom",atom)
|
, ("atom",atom)
|
||||||
-- binary operators
|
-- binary operators
|
||||||
|
@ -278,6 +266,22 @@ evalStr r (x@(Lambda _):[]) = do
|
||||||
evalStr r (reduced:[])
|
evalStr r (reduced:[])
|
||||||
evalStr _ _ = evalErr "evalStr error"
|
evalStr _ _ = evalErr "evalStr error"
|
||||||
|
|
||||||
|
-- | retrieve the value of a var
|
||||||
|
getenv :: Command
|
||||||
|
getenv _ ((Atom varname):[]) = do
|
||||||
|
hm <- get
|
||||||
|
return $ fromMaybe Void (Map.lookup varname hm)
|
||||||
|
getenv _ ((Str varname):[]) = do
|
||||||
|
hm <- get
|
||||||
|
return $ fromMaybe Void (Map.lookup varname hm)
|
||||||
|
getenv r (expr:_) = do
|
||||||
|
reduced <- r expr
|
||||||
|
hm <- get
|
||||||
|
case reduced of
|
||||||
|
(Str varname) -> return $ fromMaybe Void (Map.lookup varname hm)
|
||||||
|
_ -> evalErr "getenv need on atom or a string as argument"
|
||||||
|
getenv _ _ = evalErr "getenv need on atom or a string as argument"
|
||||||
|
|
||||||
unstrictCommands :: [(Text,InternalCommand)]
|
unstrictCommands :: [(Text,InternalCommand)]
|
||||||
unstrictCommands = [ ("if", InternalCommand "if" lishIf)
|
unstrictCommands = [ ("if", InternalCommand "if" lishIf)
|
||||||
, ("def", InternalCommand "def" def)
|
, ("def", InternalCommand "def" def)
|
||||||
|
@ -286,6 +290,8 @@ unstrictCommands = [ ("if", InternalCommand "if" lishIf)
|
||||||
, ("=", InternalCommand "=" equal)
|
, ("=", InternalCommand "=" equal)
|
||||||
, ("export", InternalCommand "export" export)
|
, ("export", InternalCommand "export" export)
|
||||||
, ("eval", InternalCommand "eval" evalStr)
|
, ("eval", InternalCommand "eval" evalStr)
|
||||||
|
, ("getenv", InternalCommand "getenv" getenv)
|
||||||
|
, ("$", InternalCommand "$" getenv)
|
||||||
-- list ops
|
-- list ops
|
||||||
, ("empty?",InternalCommand "empty?" emptyCmd)
|
, ("empty?",InternalCommand "empty?" emptyCmd)
|
||||||
, ("first",InternalCommand "first" firstCmd)
|
, ("first",InternalCommand "first" firstCmd)
|
||||||
|
|
Loading…
Reference in a new issue