fix non recursive fns

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

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

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

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

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)

src/Lish/Types.hs

@@ -63,7 +63,7 @@ type Context = Map Text LishType
 
 repr :: ExprF Text -> Text
 repr (Atom s)          = s
-repr (Internal _)    = "<int-cmd>"
+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 <> "\""