diff --git a/examples/higher-order.lsh b/examples/higher-order.lsh index f104ec7..d0de0f3 100644 --- a/examples/higher-order.lsh +++ b/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]))) \ No newline at end of file diff --git a/src/Lish/Core.hs b/src/Lish/Core.hs index e76cf39..a4c01de 100644 --- a/src/Lish/Core.hs +++ b/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 diff --git a/src/Lish/InternalCommands.hs b/src/Lish/InternalCommands.hs index d369da6..a3aef2c 100644 --- a/src/Lish/InternalCommands.hs +++ b/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) diff --git a/src/Lish/Parser.hs b/src/Lish/Parser.hs index 66ef9ff..cb5aa43 100644 --- a/src/Lish/Parser.hs +++ b/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