added comment support

examples/higher-order.lsh

@@ -1,5 +1,12 @@
 def inc (fn [x] (+ x 1))
-def map (fn [f lst] (if (empty? lst) [] (cons (f (first lst)) (map f (rest lst)))))
-def test (fn [name expr] (if expr (prn (str name " OK")) (prn (str name " FAILED"))))
+def map (fn [f lst]
+            (if (empty? lst)
+                []
+                (cons (f (first lst))
+                      (map f (rest lst)))))
+def test (fn [name expr]
+             (if expr
+                 (prn (str name " OK"))
+                 (prn (str name " FAILED"))))
 test "map" (= [2 3 4] (map inc [1 2 3]))
 test "double map" (= [3 4 5] (map inc (map inc [1 2 3])))

src/Lish/Core.hs

@@ -52,10 +52,11 @@ mainLoop mc env previousPartialnput = do
                  , Just "exit"
                  , Just "logout"] -> outputStrLn "bye bye!"
 
-    Just line -> do
-      let exprs = previousPartialnput
-                  <> (if isJust mc then " " else "")
-                  <> toS line
+    Just rawLine -> do
+      let line = takeWhile (/= ';') rawLine -- remove comments
+          exprs = previousPartialnput
+                    <> (if isJust mc then " " else "")
+                    <> toS line
       case checkBalanced exprs empty of
         Unbalanced c -> mainLoop (Just c) env exprs
         Balanced -> do

src/Lish/InternalCommands.hs

@@ -14,6 +14,7 @@ import           GHC.IO.Handle      (hGetContents)
 import           Protolude          hiding (show)
 import           System.Environment (setEnv)
 
+import           Lish.Parser        (parseCmd)
 import           Lish.Types
 
 toArg :: SExp -> StateT Env IO (Maybe Text)
@@ -107,9 +108,9 @@ bintest f ((Num x):(Num y):[]) = return $ Bool (f x y)
 bintest _ args = evalErr $ "bin test need two numbers got " <> (toS (show args))
 
 isReduced :: SExp -> Bool
-isReduced (Atom _) = False
+isReduced (Atom _)   = False
 isReduced (Lambda _) = False
-isReduced _ = True
+isReduced _          = True
 
 deepReduce :: (Monad m) => (SExp -> m SExp) -> SExp -> m SExp
 deepReduce f x =
@@ -260,6 +261,21 @@ export r (n:value:[]) = do
   export r (n:reducedVal:[])
 export _ _ = evalErr $ "eval need an atom and a string (eval foo \"foo\")"
 
+-- ## TODO
+-- eval :: Command
+-- eval r ((Str program):[]) = do
+--   let parsed = parseCmd program
+--   case parsed of
+--     Right expr -> r (unFix expr)
+--     _          -> evalErr "eval error"
+-- eval r (x@(Atom _):[]) = do
+--   reduced <- r x
+--   eval r (reduced:[])
+-- eval r (x@(Lambda _):[]) = do
+--   reduced <- r x
+--   eval r (reduced:[])
+-- eval _ _ = evalErr "eval error"
+
 unstrictCommands :: [(Text,InternalCommand)]
 unstrictCommands = [ ("if", InternalCommand "if" lishIf)
                    , ("def", InternalCommand "def" def)
@@ -267,6 +283,7 @@ unstrictCommands = [ ("if", InternalCommand "if" lishIf)
                    , ("do", InternalCommand "do" doCommand)
                    , ("=", InternalCommand "=" equal)
                    , ("export", InternalCommand "export" export)
+                   -- , ("eval", InternalCommand "eval" eval)
                    -- list ops
                    , ("empty?",InternalCommand "empty?" emptyCmd)
                    , ("first",InternalCommand "first" firstCmd)

src/Lish/Parser.hs

@@ -6,6 +6,7 @@ module Lish.Parser
   where
 
 import           Data.Fix
+import qualified Data.Text        as Text
 import           Protolude        hiding (for, many, optional, try, (<|>))
 import           Text.Parsec
 import           Text.Parsec.Text
@@ -13,7 +14,14 @@ import           Text.Parsec.Text
 import           Lish.Types
 
 parseCmd :: Text -> Either ParseError Expr
-parseCmd = parse parseExpr "S-Expr"
+parseCmd = parse parseExpr "S-Expr" . eatComment
+
+eatComment :: Text -> Text
+eatComment t =
+  t
+  & Text.lines
+  & map (Text.takeWhile (/= ';'))
+  & Text.unlines
 
 parseExpr :: Parser Expr
 parseExpr = parseLambda