Browse Source

strict fns, recursive fns are working

recursive-fns
parent
commit
94eea6e32f
Signed by: yogsototh GPG Key ID: 7B19A4C650D59646
  1. 10
      lish.cabal
  2. 2
      package.yaml
  3. 2
      src/Lish/Core.hs
  4. 21
      src/Lish/Eval.hs

10
lish.cabal

@ -35,6 +35,8 @@ library
, parsec >= 3 && < 4
, pipes
, protolude
, pretty
, pretty-show
, process
, text
exposed-modules:
@ -61,6 +63,8 @@ executable lish
, parsec >= 3 && < 4
, pipes
, protolude
, pretty
, pretty-show
, process
, text
, lish
@ -80,6 +84,8 @@ test-suite lish-benchmark
, parsec >= 3 && < 4
, pipes
, protolude
, pretty
, pretty-show
, process
, text
, lish
@ -101,6 +107,8 @@ test-suite lish-doctest
, parsec >= 3 && < 4
, pipes
, protolude
, pretty
, pretty-show
, process
, text
, lish
@ -124,6 +132,8 @@ test-suite lish-test
, parsec >= 3 && < 4
, pipes
, protolude
, pretty
, pretty-show
, process
, text
, lish

2
package.yaml

@ -20,6 +20,8 @@ dependencies:
- parsec >= 3 && < 4
- pipes
- protolude
- pretty
- pretty-show
- process
- text

2
src/Lish/Core.hs

@ -26,7 +26,7 @@ runLish :: IO ()
runLish = do
env <- toEnv <$> getEnvironment
runInputT (defaultSettings { historyFile = Just ".lish-history" })
(mainLoop Nothing mempty "")
(mainLoop Nothing env "")
-- | System Environment -> LISH Env
toEnv :: [(String,String)] -> Env

21
src/Lish/Eval.hs

@ -13,6 +13,8 @@ import Data.Fix
import qualified Data.Map.Strict as Map
import Protolude
import System.Process hiding (env)
import Text.PrettyPrint (render)
import qualified Text.Show.Pretty as Pr
import Lish.InternalCommands (toArg)
import qualified Lish.InternalCommands as InternalCommands
@ -90,13 +92,15 @@ _reduceLambda x = return x
reduceLambda :: SExp -> StateT Env IO SExp
reduceLambda x = do
-- DEBUG --env <- get
-- DEBUG --liftIO $ do
-- DEBUG -- putText "------"
-- DEBUG -- putStr ("Env: " :: Text)
-- DEBUG -- print env
-- DEBUG -- putStr ("Arg: " :: Text)
-- DEBUG -- putStrLn $ pprint (Fix x)
env <- get
case (Map.lookup "LISH_DEBUG" env) of
Just _ -> liftIO $ do
putText "------"
putStr ("Env: " :: Text)
putStrLn $ Pr.ppShow env
putStr ("Arg: " :: Text)
putStrLn $ pprint (Fix x)
_ -> return ()
_reduceLambda x
@ -105,7 +109,8 @@ applyFn (Fn par bod clos _) args =
if length par /= length args
then shellErr "wrong number of arguments"
else do
let localClosure = bindVars clos (zip par args)
reducedArgs <- mapM reduceLambda args
let localClosure = bindVars clos (zip par reducedArgs)
currentEnv <- get
-- Run the function in its own closure
fmap fst $ liftIO $

Loading…
Cancel
Save