diff --git a/lish.cabal b/lish.cabal index ec8d8bc..5d93de0 100644 --- a/lish.cabal +++ b/lish.cabal @@ -26,7 +26,7 @@ source-repository head library hs-source-dirs: src - ghc-options: -Wall -Werror -O2 + ghc-options: -Wall -O2 build-depends: base >= 4.8 && < 5 , containers @@ -52,7 +52,7 @@ executable lish main-is: Main.hs hs-source-dirs: src-exe - ghc-options: -Wall -Werror -O2 -Wall -Werror -O2 -threaded -rtsopts -with-rtsopts=-N + ghc-options: -Wall -O2 -threaded -rtsopts -with-rtsopts=-N build-depends: base >= 4.8 && < 5 , containers @@ -71,7 +71,7 @@ test-suite lish-benchmark main-is: Main.hs hs-source-dirs: src-benchmark - ghc-options: -Wall -Werror -O2 -Wall -Werror -O2 -threaded -rtsopts -with-rtsopts=-N + ghc-options: -Wall -O2 -threaded -rtsopts -with-rtsopts=-N build-depends: base >= 4.8 && < 5 , containers @@ -92,7 +92,7 @@ test-suite lish-doctest main-is: Main.hs hs-source-dirs: src-doctest - ghc-options: -Wall -Werror -O2 -Wall -Werror -O2 -threaded -rtsopts -with-rtsopts=-N + ghc-options: -Wall -O2 -threaded -rtsopts -with-rtsopts=-N build-depends: base >= 4.8 && < 5 , containers @@ -115,7 +115,7 @@ test-suite lish-test main-is: Main.hs hs-source-dirs: src-test - ghc-options: -Wall -Werror -O2 -Wall -Werror -O2 -threaded -rtsopts -with-rtsopts=-N + ghc-options: -Wall -O2 -threaded -rtsopts -with-rtsopts=-N build-depends: base >= 4.8 && < 5 , containers diff --git a/package.yaml b/package.yaml index 17263e6..43ed5ae 100644 --- a/package.yaml +++ b/package.yaml @@ -10,7 +10,7 @@ extra-source-files: - README.md - stack.yaml -ghc-options: -Wall -Werror -O2 +ghc-options: -Wall -O2 dependencies: - base >= 4.8 && < 5 @@ -28,7 +28,7 @@ library: executables: lish: - ghc-options: -Wall -Werror -O2 -threaded -rtsopts -with-rtsopts=-N + ghc-options: -threaded -rtsopts -with-rtsopts=-N main: Main.hs source-dirs: src-exe dependencies: @@ -38,7 +38,7 @@ tests: lish-test: source-dirs: src-test main: Main.hs - ghc-options: -Wall -Werror -O2 -threaded -rtsopts -with-rtsopts=-N + ghc-options: -threaded -rtsopts -with-rtsopts=-N dependencies: - lish - base >= 4.8 && < 5 @@ -50,7 +50,7 @@ tests: lish-doctest: source-dirs: src-doctest main: Main.hs - ghc-options: -Wall -Werror -O2 -threaded -rtsopts -with-rtsopts=-N + ghc-options: -threaded -rtsopts -with-rtsopts=-N dependencies: - lish - base >= 4.8 && < 5 @@ -60,7 +60,7 @@ tests: lish-benchmark: source-dirs: src-benchmark main: Main.hs - ghc-options: -Wall -Werror -O2 -threaded -rtsopts -with-rtsopts=-N + ghc-options: -threaded -rtsopts -with-rtsopts=-N dependencies: - lish - base >= 4.8 && < 5 diff --git a/src/Lish/Core.hs b/src/Lish/Core.hs index e76cf39..09c2475 100644 --- a/src/Lish/Core.hs +++ b/src/Lish/Core.hs @@ -26,7 +26,7 @@ runLish :: IO () runLish = do env <- toEnv <$> getEnvironment runInputT (defaultSettings { historyFile = Just ".lish-history" }) - (mainLoop Nothing env "") + (mainLoop Nothing mempty "") -- | System Environment -> LISH Env toEnv :: [(String,String)] -> Env diff --git a/src/Lish/Eval.hs b/src/Lish/Eval.hs index 77bdd66..28d0398 100644 --- a/src/Lish/Eval.hs +++ b/src/Lish/Eval.hs @@ -65,20 +65,12 @@ isReduced _ = True -- | The main evaluation function -- its real type should be something isomorphic to -- (SExp,Environment) -> IO (SExp, Environment) -reduceLambda :: SExp -> StateT Env IO SExp -reduceLambda (Lambda (Fix expr:fexprs)) = do +_reduceLambda :: SExp -> StateT Env IO SExp +_reduceLambda (Lambda (Fix expr:fexprs)) = do let exprs = map unFix fexprs reduced <- reduceLambda expr if isReduced reduced then do - -- DEBUG --env <- get - -- DEBUG --liftIO $ do - -- DEBUG -- putText "Lambda:" - -- DEBUG -- print $ (expr:exprs) - -- DEBUG -- putText "Env:" - -- DEBUG -- print env - -- DEBUG -- putText "Reduced Head:" - -- DEBUG -- print reduced case reduced of Internal command -> (_commandFn command) reduceLambda exprs f@(Fn _ _ _ _) -> applyFn f exprs @@ -86,15 +78,27 @@ reduceLambda (Lambda (Fix expr:fexprs)) = do reducedArgs <- mapM reduceLambda exprs executeCommand (Cmd (Fix s) (map Fix reducedArgs)) else reduceLambda (Lambda . map Fix $ (reduced:exprs)) -reduceLambda command@(Internal _) = executeCommand command -reduceLambda (Atom x) = do +_reduceLambda command@(Internal _) = executeCommand command +_reduceLambda (Atom x) = do env <- get case Map.lookup x env of Just s -> return s _ -> case InternalCommands.lookup x of Just cmd -> return (Internal cmd) _ -> return (Str x) -reduceLambda x = return x +_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) + _reduceLambda x + applyFn :: SExp -> ReduceUnawareCommand applyFn (Fn par bod clos _) args = @@ -105,7 +109,7 @@ applyFn (Fn par bod clos _) args = currentEnv <- get -- Run the function in its own closure fmap fst $ liftIO $ - runStateT (reduceLambda (unFix bod)) (Map.union currentEnv localClosure) + runStateT (reduceLambda (unFix bod)) (Map.union localClosure currentEnv) where bindVars oldenv newvars = Map.union oldenv (Map.fromList newvars) applyFn x _ = return x diff --git a/src/Lish/InternalCommands.hs b/src/Lish/InternalCommands.hs index 27a413a..468a9b2 100644 --- a/src/Lish/InternalCommands.hs +++ b/src/Lish/InternalCommands.hs @@ -129,12 +129,8 @@ deepReduce f x = deepReduce f reducedOnce toStrictCmd :: ReduceUnawareCommand -> Command -toStrictCmd f reducer sexps = do - reduced <- mapM (deepReduce reducer) sexps - liftIO $ putText "Reduced:" - liftIO $ print reduced - liftIO $ putText "----" - f reduced +toStrictCmd f reducer sexps = + f =<< mapM (deepReduce reducer) sexps -- | fn to declare a lish function -- (fn [arg1 arg2] body1 body2) diff --git a/src/Lish/Types.hs b/src/Lish/Types.hs index cd1cb3d..fb3ed30 100644 --- a/src/Lish/Types.hs +++ b/src/Lish/Types.hs @@ -63,7 +63,7 @@ type Context = Map Text LishType repr :: ExprF Text -> Text repr (Atom s) = s -repr (Internal _) = "" +repr (Internal (InternalCommand n _)) = n repr (Num n) = toS $ show n repr (Bool b) = if b then "true" else "false" repr (Str s) = "\"" <> toS s <> "\""