added comment support
This commit is contained in:
parent
7716fe39c7
commit
87c9b2e553
4 changed files with 42 additions and 9 deletions
|
@ -1,5 +1,12 @@
|
||||||
def inc (fn [x] (+ x 1))
|
def inc (fn [x] (+ x 1))
|
||||||
def map (fn [f lst] (if (empty? lst) [] (cons (f (first lst)) (map f (rest lst)))))
|
def map (fn [f lst]
|
||||||
def test (fn [name expr] (if expr (prn (str name " OK")) (prn (str name " FAILED"))))
|
(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 "map" (= [2 3 4] (map inc [1 2 3]))
|
||||||
test "double map" (= [3 4 5] (map inc (map inc [1 2 3])))
|
test "double map" (= [3 4 5] (map inc (map inc [1 2 3])))
|
|
@ -52,10 +52,11 @@ mainLoop mc env previousPartialnput = do
|
||||||
, Just "exit"
|
, Just "exit"
|
||||||
, Just "logout"] -> outputStrLn "bye bye!"
|
, Just "logout"] -> outputStrLn "bye bye!"
|
||||||
|
|
||||||
Just line -> do
|
Just rawLine -> do
|
||||||
let exprs = previousPartialnput
|
let line = takeWhile (/= ';') rawLine -- remove comments
|
||||||
<> (if isJust mc then " " else "")
|
exprs = previousPartialnput
|
||||||
<> toS line
|
<> (if isJust mc then " " else "")
|
||||||
|
<> toS line
|
||||||
case checkBalanced exprs empty of
|
case checkBalanced exprs empty of
|
||||||
Unbalanced c -> mainLoop (Just c) env exprs
|
Unbalanced c -> mainLoop (Just c) env exprs
|
||||||
Balanced -> do
|
Balanced -> do
|
||||||
|
|
|
@ -14,6 +14,7 @@ import GHC.IO.Handle (hGetContents)
|
||||||
import Protolude hiding (show)
|
import Protolude hiding (show)
|
||||||
import System.Environment (setEnv)
|
import System.Environment (setEnv)
|
||||||
|
|
||||||
|
import Lish.Parser (parseCmd)
|
||||||
import Lish.Types
|
import Lish.Types
|
||||||
|
|
||||||
toArg :: SExp -> StateT Env IO (Maybe Text)
|
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))
|
bintest _ args = evalErr $ "bin test need two numbers got " <> (toS (show args))
|
||||||
|
|
||||||
isReduced :: SExp -> Bool
|
isReduced :: SExp -> Bool
|
||||||
isReduced (Atom _) = False
|
isReduced (Atom _) = False
|
||||||
isReduced (Lambda _) = False
|
isReduced (Lambda _) = False
|
||||||
isReduced _ = True
|
isReduced _ = True
|
||||||
|
|
||||||
deepReduce :: (Monad m) => (SExp -> m SExp) -> SExp -> m SExp
|
deepReduce :: (Monad m) => (SExp -> m SExp) -> SExp -> m SExp
|
||||||
deepReduce f x =
|
deepReduce f x =
|
||||||
|
@ -260,6 +261,21 @@ export r (n:value:[]) = do
|
||||||
export r (n:reducedVal:[])
|
export r (n:reducedVal:[])
|
||||||
export _ _ = evalErr $ "eval need an atom and a string (eval foo \"foo\")"
|
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 :: [(Text,InternalCommand)]
|
||||||
unstrictCommands = [ ("if", InternalCommand "if" lishIf)
|
unstrictCommands = [ ("if", InternalCommand "if" lishIf)
|
||||||
, ("def", InternalCommand "def" def)
|
, ("def", InternalCommand "def" def)
|
||||||
|
@ -267,6 +283,7 @@ unstrictCommands = [ ("if", InternalCommand "if" lishIf)
|
||||||
, ("do", InternalCommand "do" doCommand)
|
, ("do", InternalCommand "do" doCommand)
|
||||||
, ("=", InternalCommand "=" equal)
|
, ("=", InternalCommand "=" equal)
|
||||||
, ("export", InternalCommand "export" export)
|
, ("export", InternalCommand "export" export)
|
||||||
|
-- , ("eval", InternalCommand "eval" eval)
|
||||||
-- list ops
|
-- list ops
|
||||||
, ("empty?",InternalCommand "empty?" emptyCmd)
|
, ("empty?",InternalCommand "empty?" emptyCmd)
|
||||||
, ("first",InternalCommand "first" firstCmd)
|
, ("first",InternalCommand "first" firstCmd)
|
||||||
|
|
|
@ -6,6 +6,7 @@ module Lish.Parser
|
||||||
where
|
where
|
||||||
|
|
||||||
import Data.Fix
|
import Data.Fix
|
||||||
|
import qualified Data.Text as Text
|
||||||
import Protolude hiding (for, many, optional, try, (<|>))
|
import Protolude hiding (for, many, optional, try, (<|>))
|
||||||
import Text.Parsec
|
import Text.Parsec
|
||||||
import Text.Parsec.Text
|
import Text.Parsec.Text
|
||||||
|
@ -13,7 +14,14 @@ import Text.Parsec.Text
|
||||||
import Lish.Types
|
import Lish.Types
|
||||||
|
|
||||||
parseCmd :: Text -> Either ParseError Expr
|
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 :: Parser Expr
|
||||||
parseExpr = parseLambda
|
parseExpr = parseLambda
|
||||||
|
|
Loading…
Reference in a new issue